TITLE MM Mail Munger -- TOPS-20 mailsystem
SUBTTL Written by Michael McMahon /MMcM/TAH/SMC/MRC/TCR/KLH
;Version # stuff
VWHO==0 ;Who last edited (0=MM developers)
VMAJ==6 ;Major version (same as TOPS-20)
VMIN==1 ;Minor version
VEDIT==^D1153 ;Edit number, MM.EXE should be same
; The original version of MM was written by Michael McMahon at SRI
; International, presently at Symbolics. At the time, it used a unique
; command parser designed by McMahon (ULTCMD), and had a similar user
; interface to the then-popular Tenex MSG program. Stuart McLure Cracraft
; was also involved in early MM development and was primarily responsible
; for early popularizing of MM.
;
; In the summer of 1978, a version of MM came to DEC. Ted Hess at DEC
; converted it to MACRO and to use the COMND% JSYS instead of ULTCMD.
; At this point, MM and the program which was later to become DECmail/MS
; diverged. Today, the difference between the two is that MM is free
; and has had continuous development. DECmail/MS costs $15K and hasn't
; been touched much in the past few years.
;
; Since the summer of 1979 most of the MM maintenance and development
; has been done by Mark Crispin, with occasional contributions from others
; too numerous to name. MM has matured to become the standard mailsystem
; on most of the existing TOPS-20 systems. Extensive input from its
; numerous users has made MM a powerful and reliable mailsystem.
;
; Communications about MM should be addressed to:
;
; Mark Crispin
; PANDA PROGRAMMING
; 1802 Hackett Ave., Rainbow Suite
; Mountain View, CA 94043-4431
; USA
; +1 (415) 968-1052
;
[email protected] or
[email protected]
SUBTTL Definitions
SEARCH MACSYM,MONSYM ;System definitions
SALL ;Suppress macro expansions
ASUPPRESS ;Save some symbol table space
.DIRECTIVE FLBLST ;Sane listings for ASCIZ, etc.
.TEXT "/NOINITIAL" ;Suppress loading of JOBDAT
.TEXT "MM/SAVE" ;Save as MM.EXE
.TEXT "/SYMSEG:PSECT:CODE" ;Put symbol table and patch w/ code
.REQUIRE MMHELP ;Help strings
.REQUIRE MMUUO ;UUO handler
.REQUIRE FSCOPY ;Fast string copy
.REQUIRE HSTNAM ;Host name routines
.REQUIRE WAKEUP ;MMailr wakeup routines
.REQUIRE BLANKT ;Blank screen routines
.REQUIRE RELAY ;Relay hosts
.REQUIRE SYS:MACREL ;MACSYM support routines
IFNDEF OT%822,OT%822==:1
; Routines invoked externally
EXTERN FSCOPY
EXTERN UUOH,CRLF0,CRIF,CRLF
EXTERN H1CMDT,H1RCMD,H1SCMD,.HSETM,INIVTB,NINVRS
EXTERN $GTCAN,$GTLCL,$INRLY,$GTRLY,$RMREL
EXTERN $WAKE
EXTERN $BLANK
; Assembly values
IFNDEF NHSPGS,<NHSPGS==^D5> ;Number of pages for host strings in cache
IFNDEF NHPPGS,<NHPPGS==2> ;Number of pages for host cache pointers
NHOSTS==<NHPPGS*1000>-1 ;Maximum number of hosts in cache
IFNDEF NEDPGS,<NEDPGS==^D20> ;Number of pages between MM and editor
IFNDEF NKYPGS,<NKYPGS==1> ;Number of pages for keyword hacking
IFNDEF NMSGS,<NMSGS==2000> ;Number of messages we can handle
IFNDEF NMSWRN,<NMSWRN==^D100> ;Number free msgs before warning user
IFNDEF NPGWRN,<NPGWRN==^D40> ;Number free pages before warning
IFNDEF NTOPGS,<NTOPGS==4> ;Number of pages for TO/CC/etc addr blocks
IFNDEF NTXPGS,<NTXPGS==^D40> ;Number of pages for text input
IFNDEF MAXBBD,<MAXBBD==^D50> ;Maximum number of BBoards supported
IFNDEF DATSIZ,<DATSIZ==11> ;Size of data psect
IFNDEF CODSIZ,<CODSIZ==72> ;Size of code psect
IFNDEF DATORG,<DATORG==1000> ;Data on page 1
;;;Special version of FLDDB. which has default pointer instead of string
DEFINE FLDDF. (TYP,FLGS,DATA,HLPM,DEFM,LST) <
..XX==<FLD(TYP,CM%FNC)>+FLGS+<0,,LST>
IFNB <HLPM>,<..XX==CM%HPP!..XX>
IFNB <DEFM>,<..XX==CM%DPP!..XX>
..XX
DATA+0
IFNB <HLPM>,<-1,,[ASCIZ HLPM]>
IFB <HLPM>,<0>
IFNB <DEFM>,<-1,,DEFM>
>;DEFINE FLDDF.
DEFINE PUSHAE (AC,LIST) <
IRP LIST,<PUSH AC,LIST>
>;DEFINE PUSHAE
DEFINE POPAE (AC,LIST) <
IRP LIST,<POP AC,LIST>
>;DEFINE POPAE
DEFINE DEFERR (X,Y) <
DEFINE X (Z) <
IFB <Z>,<UERR Y,0>
IFNB <Z>,<UERR Y,[ASCIZ/Z/]>
>;DEFINE X
>;DEFINE DEFERR
DEFINE CMD (X,Y,Z) <
IFB <Z>,<
IFB <Y>,<[ASCIZ\X\],,.'X>
IFNB <Y>,<[ASCIZ\X\],,Y>>
IFNB <Z>,<
IFB <Y>,<[Z
ASCIZ\X\],,.'X>
IFNB <Y>,<[Z
ASCIZ\X\],,Y>>
>;DEFINE CMD
DEFINE CMD1 (X,Y,Z) <CMD (X,Y,<Z+CM%FW>)>
DEFINE VAR (X,Y,Z) <
[ASCIZ/X/],,[Z,,Y]
>;DEFINE VAR
DEFINE HDY (X,Y,Z) <
RADIX ^D10
[ASCIZ/X/],,[<Y-1>*512+<Z-1>,,DATHDY]
RADIX ^D8
>;DEFINE HDY
DEFINE CITYPE (X) <UTYPE 1,[ASCIZ/X/]>
DEFINE ETYPE (X) <UETYPE [ASCIZ/X/]>
DEFINE CETYPE (X) <UETYPE 10,[ASCIZ/X/]>
DEFINE CIETYP (X) <UETYPE 1,[ASCIZ/X/]>
DEFINE NOISE (X) <UNOI [ASCIZ/X/]>
DEFINE DEFALT (X) <UDEF [ASCIZ/X/]>
DEFINE PROMPT (X) <UPRMT [ASCIZ/X/]>
DEFINE CONFRM <CALL CONF>
DEFINE NOINT <CALL .NOINT> ;Trap CTRL/C's
DEFINE OKINT <CALL .OKINT> ;Untrap CTRL/C's
DEFERR WARN,3
DEFERR JWARN,7
DEFERR ERROR,11
DEFERR JERROR,15
DEFERR FATAL,12
DEFERR JFATAL,16
DEFERR SNARL,13 ;Snarl = "error, but return to caller"
DEFERR JSNARL,17
PURGE DEFERR
;;;AC's
F==:0 ;Flags
A=:1 ;Temp and JSYS
B=:2 ;Ditto
C=:3 ;Ditto
D=:4 ;Ditto
E=:5 ;Temp & local to routine
T=:6 ;Ditto
U=:7 ;Ditto
V=:10 ;Ditto
W=:11 ;Ditto
L=:12
M=:13 ;Current message if any
N=:14
O=:15
;CX=:16 ;MACSYM temporary AC
;P=:17
;;;OPDEF's
OPDEF PRINT [1B8]
OPDEF UTYPE [2B8]
OPDEF UETYPE [3B8]
OPDEF UERR [4B8]
OPDEF UNOI [5B8]
OPDEF UDEF [6B8]
OPDEF UPRMT [7B8]
OPDEF UHELP [10B8]
;;;Various useful characters
CHLAB=="<" ;Left broket
CHRAB==">" ;Right broket
;;;Flags
F%F1== 1B0 ;Temp
F%F2== 1B1
F%F3== 1B2
F%F4== 1B3
F%AT== 1B4 ;@ see in address
F%ADR== 1B5 ;Seen non-blank part of an address
F%QOT== 1B6 ;Inside a quoted string
F%SWRN==1B7 ;User has been warned about oversized mail file
F%BB== 1B8 ;Reading BBoard
F%RTE== 1B9 ;Return to EXEC eventually
F%CC== 1B10 ;In CC command
F%COMA==1B11 ;Type comma except before 1st field
F%TYPS==1B12 ;Type out numbers of messages handled
F%QUOT==1B13 ;Generate quoted host names
F%FST== 1B14 ;Fast parse in PRADDF
F%RELD==1B15 ;Include relative domains with host names
;;;;;;==1B16
;;;;;;==1B17
F%READ==1B18 ;Inside the READ command
F%SEND==1B19 ;Inside the SEND commands
F%RSCN==1B20 ;Called by command line
F%MOD== 1B21 ;Reading system mail
F%AMOD==1B22 ;Auto MOD handling
F%TECO==1B23 ;Using TECO based editor
F%RONL==1B24 ;Read only file
F%ALIA==1B25 ;Aliasing another user
F%ESND==1B26 ;Editor said send it off
F%TECP==1B27 ;Editor supports hairy TECO interface
F%TAK==:1B28 ;Take file in progress
F%HOER==:1B29 ;Halt on error
F%RSCC==1B30 ;Original parse of RSCAN% line
F%QUEU==1B31 ;Queued mail seen
F%DIRE==1B32 ;In message Dired mode
F%DIRR==1B33 ;Want to re-enter Dired having done reply
;;;;;;==1B34
;;;;;;==1B35
SUBTTL Page allocation
CODORG==DATORG+<DATSIZ*1000> ;Code starts after data
PAGORG==CODORG+<CODSIZ*1000> ;Paged stuff starts after code
.PSECT DATPAG,PAGORG ;Enter paged data
PAGSIZ==0 ;Init size of page PSECT
DEFINE DEFPAG (ADDR,LENGTH) <
ADDR:: IFB <LENGTH>,<BLOCK 1000
PAGSIZ==PAGSIZ+1>
IFNB <LENGTH>,<BLOCK 1000*LENGTH
PAGSIZ==PAGSIZ+LENGTH>
>;DEFINE DEFPAG
DEFPAG HDRPAG ;Headers
SUBBUF=HDRPAG+700 ;Address of subject buffer
SUBEND=.-1 ;End of subject buffer
SUBBSZ==<<SUBEND-SUBBUF>*5>+4 ;Length of subject buffer
DEFPAG TXTPAG,NTXPGS ;Message text page
DEFPAG TOPAG,NTOPGS ;Storage for TO/CC lists
;;;Addresses are kept in chained blocks of the following format:
ADRFLG==0 ;Flags
DEFSTR (ADINV,ADRFLG,0,1) ;Invisible address (don't show in sent message)
DEFSTR (ADTYP,ADRFLG,8,2) ;Type of address
AD.LCL==0 ;Local mailbox (must be 0)
AD.FIL==1 ;Local file (must = FILIST-LCLIST)
AD.NET==2 ;Remote user (must = NETLST-LCLIST)
AD.GRP==3 ;Group name
DEFSTR (ADSIZ,ADRFLG,17,9) ;Size of block
DEFSTR (ADPTR,ADRFLG,35,18) ;Pointer to next address in To/cc/bcc list
ADRLNK==1 ;Ptr (back,,fwd) LCLIST/FILIST/NETLST
ADRUSR==2 ;Local user number if AD.LCL
ADRHST==ADRUSR ;Host pointer if AD.NET
ADRSTR==3 ;First word of string
DEFPAG FWDPAG ;Page for mapping to MAILBOX/FINGER
DEFPAG HSTSTR,NHSPGS ;Host name string cache
DEFPAG HSTTAB,NHPPGS ;Pointers to above in TBLUK% format
DEFPAG FLGPAG ;For MAILER.FLAGS
DEFPAG EDBPAG,2 ;Editor buffer block page
DEFPAG EDPAGE,NEDPGS ;Editor pages for data
DEFPAG SRTPAG,0 ;Sorting free space (shared)
DEFPAG SPLPAG,0 ;SPELL pages for transfer (shared)
DEFPAG WRTPGS,NEDPGS ;Writeable pages
DEFPAG KEYPAG ;Page full of keyword names
DEFPAG KEYPGS,NKYPGS ;Pages for keyword lists/strings
DEFPAG UHDPAG ;Page for user generated headers
USRHDR=:UHDPAG ;Ptr to end header options/start user headers
;Free count after header options (negative)
USRHFP=USRHDR+2 ;Ptr to end of user headers
;Free count after user headers (negative)
USRHDT=USRHFP+2 ;Text of header options/user headers
; The "starting byte" for a message is the byte # relative to
; beginning of message-file pages (MSGPGS). All "offsets" are byte #s
; relative to this starting byte. The "whole msg" includes the
; initial date/length/flags line peculiar to TOPS-20 message files, whereas
; the "message body" does not include it (it does include the header).
; The "header" is everything in the message body up to and including
; the double CRLF separating it from the remainder of the body, which
; is the "text" of the message.
MSGALL==MSGPGS+0 ;Starting byte of message
MSGSAL==MSGPGS+1 ;Size of whole message
MSGBOD==MSGPGS+2 ;Size of message body,,offset to body
MSGFRM==MSGPGS+3 ;Size of from field,,offset to field
MSGSUB==MSGPGS+4 ;Size of subject,,offset to field
MSGDAT==MSGPGS+5 ;Date of message (GTAD fmt)
MSGFLG==MSGPGS+6 ;Flags,,offset to msg text
MSGHLN==MSGFLG ; Used for refs to RH above
MSGBTS==MSGPGS+7 ;Message bits
MSGFBS==MSGPGS+10 ;Message bits actually in file
MSGMID==MSGPGS+11 ;Message ID
MSGLEN==:12 ;Length of block
;Hard-wired flags kept in the RH of MSGBTS and MSGFBS.
M%SEEN==1 ;Message has been seen
M%DELE==2 ;Message is deleted
M%ATTN==4 ;Message wants attention (always-show)
M%RPLY==10 ;Message has been replied to
M%RSRV==20 ;Message flag reserved for expansion
M%RSR1==40 ;Message flag reserved for expansion
M%FLAG==M%SEEN!M%DELE!M%ATTN!M%RPLY!M%RSRV!M%RSR1 ;All message flags
M%KEYW==777777777700 ;Remaining flags are for keywords
;MM flags kept in the LH of MSGFLG.
M%RECE==1B0 ;Message is recent (sign bit)
M%FRME==1B1 ;Message is from me
M%FRNM==1B2 ;Messages is from someone else
NMSGPG==<NMSGS/1000*MSGLEN> ;Number of message pages
DEFPAG MSGPGS,NMSGPG ;Storage for message data
RLYPGS==:2
DEFPAG RLYTBL,RLYPGS ;TBLUK table for host/nicknames
MTXPGN==<PAGORG+<PAGSIZ*1000>>/1000 ;Start of MAIL.TXT file mapping area
NMTXPG==1000-MTXPGN ;Number of MAIL.TXT pages
DEFPAG MTXPAG,NMTXPG ;File mapping area
PURGE DEFPAG
.ENDPS
SUBTTL Impure storage
LOC 20
FRKACS: BLOCK 20 ;Setup for editor fork's ACs
JBUUO: BLOCK 1 ;UUO executed
JB41: CALL UUOH ;UUO handler
LCLHST: BLOCK 1 ;Local host pointer
MBXFIL: BLOCK 42 ;Home mailbox for COPY/MOVE default
HCSHFF: BLOCK 1 ;First free word in host cache
PRGNAM: BLOCK 2 ;Save area for subsystem/program names
MYUSR: BLOCK 1 ;Login user
MYCDIR: BLOCK 1 ;Connected directory
MYDIR: BLOCK 1 ;Login directory
MYPDIR: BLOCK 1 ;Post office box directory
MYAUSR: BLOCK 1 ;Alias "login user"
MYJOBN: BLOCK 1 ;Job number
BLOCK <116-.> ;.JBSYM must be at 116
JBSYM: BLOCK 1 ;Symbol table pointer
MUSRST: BLOCK 10 ;ASCII of login user
MAUSRS::BLOCK 10 ;ASCII of alias login user
BLOCK <140-.> ;Low segment must start at 140
RELOC ;Enter low segment
LCLHNM: BLOCK ^D13 ;Local host name string without relative domain
NPDL==277 ;Size of PDL
PDL: BLOCK NPDL ;Pushdown list
.PSECT DATA,DATORG ;Enter data area
NCPDL==477 ;Size of command PDL
CMDRET::BLOCK 1 ;Usual return dispatch for error
CMDSTK: BLOCK 1 ;Current command stack ptr
CMPDL: BLOCK NCPDL ;Command stack
HSTBFL==30
HSTBUF: BLOCK HSTBFL ;Host name buffer for HSTSTR routines
SAVMOD: BLOCK 5 ;Normal TTY modes
EDMOD: BLOCK 5 ;Editor modes
WCMDPT: BLOCK 1 ;Working copy of command ptr
PREVPT: BLOCK 1 ;Pointer to previous message list
PRVSEQ: BLOCK 1+<NMSGS/3> ;Previous message sequence list
PRVSQZ==.
MSGSEQ: BLOCK 1+<NMSGS/3> ;Table of numbers of messages
MSGSQZ==.
WRKSEQ: BLOCK 1+<NMSGS/3> ;Table of numbers of messages
ZERMEM==. ;Start clearing here at startup
SNDCAL: BLOCK 1 ;Caller of send subcommands
SEQCAL: BLOCK 1 ;Caller of header subcommands
OKTINT: BLOCK 1 ;Is it ok for timer to interrupt now?
CHKTIM: BLOCK 1 ;Next time to check for new messages
MSGJFN: BLOCK 1 ;JFN for current message file
MSGJF2: BLOCK 1 ;JFN to open for write
OUTJFN: BLOCK 1 ;Output file JFN
INIJFN: BLOCK 1 ;MM.INIT JFN
TMPJFN: BLOCK 1 ;Temporary files
HSTJFN: BLOCK 1 ;Host tables, etc.
MSCANF: BLOCK 1 ;Msg scan direction flag
GTSQDF: BLOCK 1 ;GETSEQ default sequence (if >0)
HDONLY: BLOCK 1 ;List msg headers only
SEPPGS: BLOCK 1 ;List msgs on separate pages
WRKMSG: BLOCK 1 ;Current working msg "number,,index"
LASTM: BLOCK 1 ;Number of messages in current file
LASTRD: BLOCK 1 ;Date file last fetched
;; The following must be in this exact order. They are filled by GTFDB%.
FILPGS: BLOCK 1 ;Size of the file in pages
FILSIZ: BLOCK 1 ;Size of the file (bytes)
FILCRV: BLOCK 1 ;Creation date
FILWRT: BLOCK 1 ;Write date
FILRD: BLOCK 1 ;Last read date of file
;; End GTFDB% block
NRECNT: BLOCK 1 ;Number of recent messages
NUNSEE: BLOCK 1 ;Number of unseen messages
NDELET: BLOCK 1 ;Number of deleted messages
PRIORM: BLOCK 1 ;Saved current message number
M.RPLY: BLOCK 1 ;Index to msg being replied to, -1=none
LSTMSG: BLOCK 1 ;Saved last message for typing out seq
DOMSG: BLOCK 1 ;Dispatch to process next message
NXTMSD: BLOCK 1 ;Dispatch to fetch next message
MSGSPT: BLOCK 1 ;Pointer into numerical msg sequence (MSGSEQ)
MSRNG: BLOCK 1 ;Range in progress flag: -1 if no range
; else ending msg number
PSIPC1: BLOCK 1 ;Saved pc from psi routine
PSIPC2: BLOCK 1 ;Ditto
INPSIF: BLOCK 1 ;Flag non-zero when in PSI code
CTCCNT: BLOCK 1 ;Count of CTRL/C's while trapped
EXECFK: BLOCK 1 ;Saved fork handle for EXEC
EDFORK: BLOCK 1 ;Editor fork
EFRKPC: BLOCK 1 ;Editor fork's PC
EDPAG0: BLOCK 1 ;First page of editor fork mapped in
SPLFRK: BLOCK 1 ;SPELL's fork handle
SPLIFL: BLOCK 1 ;Input file JFN
SPLOFL: BLOCK 1 ;Output file JFN
AFTDAT: BLOCK 1 ;After parameter in GTAD% format
DLVOPT: BLOCK 1 ;Delivery option index
TOLIST: BLOCK 1 ;TO list pointers tail,,head
CCLIST: BLOCK 1 ;CC list pointers tail,,head
BCCLST: BLOCK 1 ;BCC list
FREETO: BLOCK 1 ;Pointer to free space for to/cc lists
;;;Following three cells must be in this order and correspond to the ADTYP defs
LCLIST: BLOCK 1 ;List of local recipients
FILIST: BLOCK 1 ;List of file "recipients"
NETLST: BLOCK 1 ;List of network recipients
;;;End of critical order
MSGSIZ: BLOCK 1 ;Size of last message we sent
MOVDSP: BLOCK 1 ;Dispatch for typing or setting to, etc
REPDAT: BLOCK 1 ;Reply date
SAVU: BLOCK 1 ;Used by address parser
SAVL: BLOCK 1 ;Saved sequence pointer
SAVP: BLOCK 1 ;Used by sequence parser
NXTIME: BLOCK 1 ;Time for before/after/on filters
CLEVEL::BLOCK 1 ;Command/subcommand level
TPADD1: BLOCK 1 ;Top level command dispatch
TPADDR::BLOCK 1 ;Reparse address for COMND reparsing
REPARP: BLOCK 1 ;Save of stack for reparse
READPP: BLOCK 1 ;Save of P in READ for REDRET
SENDPP: BLOCK 1 ;Save of P in SEND for SNDRET
LSTCHR: BLOCK 1 ;Confirming character
BUFNAM: BLOCK 2 ;Name of the editor buffer
EDINAM: BLOCK 2 ;Type of edit being performed
UNTHDR: BLOCK 1 ;Save of unto header word
KEYPTR: BLOCK 1 ;Pointer to keyflag string area
KEYBTS: BLOCK 1 ;Keyflag bits in a message sequence
KEYBTM: BLOCK 1 ;Keyflag bits to modify
KEYLPF: BLOCK 1 ;Pointer to "find" keyword list
KEYLPM: BLOCK 1 ;Pointer to "modify" keyword list
KEYFRE: BLOCK 1 ;Pointer to free space in keywd pages
KYCPYF: BLOCK 1 ;Temp for KYCPY, add/del flag
KYCPYC: BLOCK 1 ;Temp for KYCPY, edit count
RMLPTR: BLOCK 1 ;String pointer and flag for REMAIL
RSTMOD: BLOCK 1 ;Type of restore draft
MNSMSG: BLOCK 1 ;Whether or not to include msg in REPLY
SRTFRE: BLOCK 1 ;Free space ptr for sorting msgs
SRTTAB: BLOCK 1 ;Start of msg sorting tree
SRTLFT: BLOCK 1 ;Ptr to node with earliest date
SRTRGT: BLOCK 1 ;Ptr to node with latest date
NSORTD: BLOCK 1 ;Number of nontrivial sorts
SRTIDX: BLOCK 1 ;Index to current temp block
SRTBLK: BLOCK 2 ;Temp block ptr
SRBLK0: BLOCK MSGLEN ;Temp storage for sorting
SRBLK1: BLOCK MSGLEN
; The following AC blocks are for routines which save ACs but don't need to
;save P
TMRACS: BLOCK 17 ;During timer interrupt routines
ABOACS: BLOCK 17 ;AC save during abort routines
ABOCAN: BLOCK 1 ;-1 to enable aborts
ABOIP: BLOCK 1 ;Abort In Progress if -1
ABOSTS: BLOCK 1 ;Current state of CTRL/N (-1 if armed)
ABORTF: BLOCK 1 ;Abort seen, set by unvectored CTRL/N
ABOPDP: BLOCK 1 ;APDL abort stack pointer
IFNDEF APDLLN,<APDLLN==20> ;Allow this many abort nestings
BLOCK 3 ;Zero-entry fence for abort stack
APDL: BLOCK APDLLN*3 ;Abort stack (3 wds/entry)
FRMSTL==^D99
FRMSAM: BLOCK <FRMSTL/5>+1 ;"From: " string for all msgs
FRMSCM: BLOCK <FRMSTL/5>+1 ;"From: " string for current msg
REPSAM: BLOCK <FRMSTL/5>+1 ;"Reply-to: " string for all msgs
REPSCM: BLOCK <FRMSTL/5>+1 ;"Reply-to: " string for current msg
COMNDB: BLOCK 1 ;AC2 of last COMND
DOMTBL: BLOCK 1 ;Address of domain TBLUK table. Actually
;used only as a flag that $INRLY has run
;;Storage for BBoard code
BBLWD: BLOCK 1 ;Last write date of current BBoard file
BBXPAG=WRTPGS ;Where to map index page to
UXPAG==20 ;Page in IDX file of user data
IDXJFN: BLOCK 1 ;Index file JFN
IDXNAM: BLOCK 20 ;Name of index file
BBXDAT: BLOCK 1 ;Last idx date known
BBCURR: BLOCK 1 ;Current BB for stepping
BBMAX: BLOCK 1 ;Max number of BBs for quick comparison
BBTAB:: BLOCK 1 ;TBLUK%-like table (not alphabetical)
BLOCK MAXBBD ;Entry: address of string,,0
ZEREND==.-1 ;End of where to clear
BBDTAB: BLOCK MAXBBD+1 ;BBoard table
BLOCK MAXBBD*4 ;String space for BBoards
BBDEND: BLOCK 10 ;Allow for overflow
BBDSTR: BLOCK 1 ;Pointer to first free BBoard string
;;;User variables
VARBEG==.
RSCFLG::BLOCK 1 ;Return to MAIL.TXT on BB rescan if .NE. 0
TRSTPR::BLOCK 1 ;Terse text prompt
LPTCFM::BLOCK 1 ;Lineprinter conformation
VBSBBD::BLOCK 1 ;Quiet flag for INDEX stuff
FLMAUT::BLOCK 1 ;Flagged messages autotype suppress
USEEDT::BLOCK 1 ;Use the editor automatically
RINCME::BLOCK 1 ;Include me in any replies by default
RCCOTH::BLOCK 1 ;Reply cc's everyone other than from
GTCNDR::BLOCK 1 ;>0 conn dir always, <0 postbox, 0 ask
INITER::BLOCK 1 ;-1 if an error occurred in MM.INIT
ESCSND::BLOCK 1 ;Escape sends automatically
JISMOD::BLOCK 1 ;JIS mode
SIMODE::BLOCK 1 ;SI/SO mode
REPDIS::BLOCK 1 ;Reply command automatically displays
RFMDEF::BLOCK 1 ;Reply<cr> means just from, not all
BLSCST::BLOCK 1 ;Blank screen on startup
BSPDSP::BLOCK 1 ;Output backspace instead of CTRL/H
CRSEND::BLOCK 1 ;Just return sends message
LSTHDR::BLOCK 1 ;Output a list of headers at the start
; of the listing
SNDVBS::BLOCK 1 ;Degree of sending verbosity
ABOFLG::BLOCK 1 ;CTRL/N aborts >0 always, 0 ask, <0 never
EDTFLG::BLOCK 1 ;CTRL/E edits >0 always, 0 ask, <0 never
LSTPAG::BLOCK 1 ;List messages on separate pages
SAVFIL::BLOCK 42 ;SAVED.MESSAGES file to use
MCPFIL::BLOCK 42 ;MAIL.CPY file to use
PERNAM::BLOCK 20 ;Personal name
DEFCCL::BLOCK 20 ;Default cc list
DEFBCL::BLOCK 20 ;Default bcc list
DEFPRO::BLOCK 1 ;Default protection for .TXT files
DEFPST::BLOCK 2 ;String version of above
KEYTBL::BLOCK <^D31> ;Table of keywords for messages
USRHTB::BLOCK <^D31> ;Table of user message headers
SPRHDR::BLOCK <^D31> ;Table of headers to not type out
ONLHDR::BLOCK <^D31> ;Table of headers to only type out
TOPRMT::BLOCK 10 ;Top-level prompt string
REPRMT::BLOCK 10 ;Read-level prompt string
SEPRMT::BLOCK 10 ;Send-level prompt string
MSPRMT::BLOCK 10 ;Message sequence prompt string
ASKBCC::BLOCK 1 ;Prompt for bcc recipients in send
LSTDEV::BLOCK 10 ;Listing device file name
INSMSG::BLOCK 1 ;Always insert msg in reply text
DFSHML::BLOCK 1 ;Default "short" msg length
DEFBBD::BLOCK 10 ;Default BBoard
VAREND==.-1
;;; COMND buffers
QPRMPT: BLOCK 24 ;Space for a prompt string
NXTPAT: BLOCK 1 ;Adr of cmd pattern string
PATFRE: BLOCK 1 ;Adr of next pattern string
CSBFSZ==2000
CSBUF: BLOCK CSBFSZ ;Command line buffer
PATSTR==CSBUF+CSBFSZ/2 ;Also used for from filters
CMDGTB: BLOCK .GJATR+1 ;GTJFN% block
CMDFLB::BLOCK 4 ;Individual field block
STRBSZ==2000
STRBUF::BLOCK STRBSZ ;Temporary string space
TMPBUF=STRBUF+400
FILNAM=STRBUF+STRBSZ-100
LEVPLN==20
LEVPDL=STRBUF+STRBSZ-LEVPLN
;;; Non-zeroed storage
SPLNAM: ASCIZ/SYS:SPELL.EXE/ ;Name of SPELL program
SPLOFF==2 ;Entry vector offset to run at
TTXTIB: .RDBRK ;Number of words in this block
BLOCK .RDBRK ;Remainder of block
TXTPTR==TTXTIB+.RDDBP ;Put updated pointer here
TXTCNT==TTXTIB+.RDDBC ;Put count here
CMDBLK::BLOCK .CMGJB+1 ;COMND state block
;Initial CSB contents
CMIBLK: REPARS ;.CMFLG Flag bits,,Reparse dispatch adr
.PRIIN,,.PRIOU ;.CMIOJ Input JFN,,Output JFN
0 ;.CMRTY Byte pointer to CTRL/R text
POINT 7,CSBUF ;.CMBFP Byte pointer to start of text
POINT 7,CSBUF ;.CMPTR Byte pointer to next input
CSBFSZ*5 ;.CMCNT Count of space left in buffer
0 ;.CMINC Count of chars left in buffer
POINT 7,STRBUF ;.CMABP Byte pointer to atom buffer
STRBSZ*5 ;.CMABC Size of atom buffer
CMDGTB ;.CMGJB Address of GTJFN% argument block
REQID=='MM' ;Request ID for our ENQing
ENQBLK: 1,,ENQBLL ;Number of locks, block size
REQID ;Interrupt channel, request ID
0 ;Flags, level number,,JFN
-1,,ENQNAM ;Pointer to name string
0 ; (this name used because MS uses it)
0
ENQBLL==.-ENQBLK ;Length of ENQ% BLOCK
ENQNAM: ASCIZ/Mail expunge interlock/
.ENDPS
SUBTTL Pure storage
.PSECT CODE,CODORG ;Enter code
;;;Mailbox file name strings
MLBXDV: ASCIZ/POBOX/
MLBXFN: ASCIZ/MAIL.TXT.1/
MLBXNM: ASCIZ/MAIL/
MLBXEX: ASCIZ/TXT/
BBDIR: ASCIZ/BBOARD/
;;;Break mask for slurping up a hostname
BRINI.
BRKCH. (.CHNUL,042) ;Everything below #, $
BRKCH. (045,054) ;...until -, .
BRKCH. (057) ;...until numerics
BRKCH. (072,100) ;...until uppercase alphabetics, [
BRKCH. (134) ;...until ]
BRKCH. (136,140) ;...until lowercase alphabetics
BRKCH. (173,177) ;...everything above "z"
HNMMSK: EXP W0.,W1.,W2.,W3. ;Mask for host name
;;;Break mask for slurping up a user name
BRINI.
BRKCH. (.CHNUL,042) ;Everything below #, $, %
BRKCH. (046,051) ;...until *
BRKCH. (053,054) ;...until -, .
BRKCH. (057) ;...until numerics
BRKCH. (072,100) ;...until uppercase alphabetics
BRKCH. (133,136) ;...until underscore
BRKCH. (140) ;...until lowercase alphabetics
BRKCH. (173,177) ;...everything above "z"
UNMMSK: EXP W0.,W1.,W2.,W3. ;Mask for user name
;;;Text input masks
BRINI.
BRKCH. (.CHCNB)
BRKCH. (.CHCND)
BRKCH. (.CHCNE)
BRKCH. (.CHVTB)
BRKCH. (.CHFFD)
BRKCH. (.CHCNZ)
BRKCH. (.CHESC)
TXTMSK: EXP W0.,W1.,W2.,W3. ;Mask for ordinary text input
;;;Japanese Industrial Standard masks
BRINI.
BRKCH. (.CHCNB)
BRKCH. (.CHCND)
BRKCH. (.CHCNE)
BRKCH. (.CHVTB)
BRKCH. (.CHFFD)
BRKCH. (.CHCNZ)
TXTJIS: EXP W0.,W1.,W2.,W3. ;Mask for JIS text entry
BRINI.
BRKCH. (.CHLFD)
BRKCH. (.CHCRT)
LINJIS: EXP W0.,W1.,W2.,W3. ;Mask for JIS line entry
;;;Table of special characters which are quoted
BRINI.
BRKCH. (.CHNUL,.CHSPC) ;all controls are special characters
BRKCH. (042) ;""""
BRKCH. (050,051) ;"(", ")"
BRKCH. (054) ;","
BRKCH. (072,074) ;":", ";", "<"
BRKCH. (076) ;">"
BRKCH. (100) ;"@"
BRKCH. (133) ;"["
BRKCH. (134) ;"\"
BRKCH. (135) ;"]"
SPCMSK: EXP W0.,W1.,W2.,W3. ;Form table of special characters
;;;Interrupt storage
LEVTAB: PSIPC1
PSIPC2
0
CHNTAB: PHASE 0
CTCCHN:!1,,CTCINT ;CTRL/C trap on chan 0
BLOCK 3
ABOCHN:!1,,ABOINT ;CTRL/N on chan 4
TMRCHN:!2,,TMRINT ;Timer on chan 5
BLOCK <^D36-.> ;Interrupt vector table
DEPHASE
;;;Entry vector
IFNDEF VI%DEC,< ;In case MACSYM is prior to release 6
VI%DEC==1B18
>;IFNDEF VI%DEC
EVEC: JRST GO ;Entry vector
JRST GOAMOD
VERNUM: VI%DEC!<FLD VWHO,VI%WHO>!<FLD VMAJ,VI%MAJ>!<FLD VMIN,VI%MIN>!<FLD VEDIT,VI%EDN>
EVECL==.-EVEC
SUBTTL Command tables
;;;Top level commands
CMDTAB: NCMDS,,NCMDS
CMD1 A,ENTANS,CM%ABR!CM%INV
CMD ALIAS
ENTANS: CMD ANSWER
CMD APPEND
CMD1 BB,ENTBB,CM%ABR!CM%INV
CMD BBDATE
ENTBB: CMD BBOARD
CMD BLANK
CMD BUG
CMD CHECK
CMD CONTINUE
CMD COPY
CMD COUNT
CMD CREATE-INIT,.CRINI
CMD1 D,ENTDEL,CM%ABR!CM%INV
CMD DAYTIME
ENTDEL: CMD DELETE
CMD DIRED
CMD DISABLE
CMD ECHO
CMD EDIT
CMD ENABLE
CMD1 EX,ENTXIT,CM%ABR!CM%INV
CMD EXAMINE
ENTXIT: CMD EXIT
CMD EXPUNGE
CMD FILE-LIST,.FLIST
CMD FIND
CMD FLAG
CMD FORWARD
CMD FROM
CMD GET
CMD1 H,ENTHDR,CM%ABR!CM%INV
ENTHDR: CMD HEADERS
CMD HELP
CMD IGNORE
CMD JUMP
CMD1 K,ENTKIL,CM%ABR!CM%INV
CMD KEYWORDS
ENTKIL: CMD KILL
CMD LIST
CMD LITERAL-TYPE,.LTYPE
CMD LOGOUT
CMD1 MA,ENTMRK,CM%ABR!CM%INV
CMD1 MAIL,.SEND,CM%INV
ENTMRK: CMD MARK
CMD MOVE
CMD1 N,ENTNXT,CM%ABR!CM%INV
CMD NET-MAIL,.MAILE
ENTNXT: CMD NEXT
CMD PREVIOUS
CMD PROFILE
CMD PUSH
CMD QUIT
CMD1 R,ENTRED,CM%ABR!CM%INV
CMD1 RE,ENTRED,CM%ABR!CM%INV
ENTRED: CMD READ
CMD REMAIL
CMD1 REP,ENTREP,CM%ABR!CM%INV
CMD1 REPL,ENTREP,CM%ABR!CM%INV
ENTREP: CMD REPLY,.ANSWER
CMD REPLY-TO,.REPTO
CMD RESTORE-DRAFT,.RESTO
CMD1 S,ENTSND,CM%ABR!CM%INV
CMD1 SE,ENTSND,CM%ABR!CM%INV
ENTSND: CMD SEND
CMD SET
CMD SHOW
CMD SORT
CMD STATUS
CMD STEP
CMD SYSTEM-MSGS,.SYSTE
CMD1 T,ENTTYP,CM%ABR!CM%INV
CMD TAKE
ENTTYP: CMD TYPE
CMD1 U,ENTUND,CM%ABR!CM%INV
CMD UNANSWER
ENTUND: CMD UNDELETE
CMD UNFLAG
CMD UNKEYWORDS
CMD UNMARK
CMD VERSION
NCMDS==.-CMDTAB-1
;;;READ commands
RCMDTB: NRCMDS,,NRCMDS
CMD1 ANSWER,.REPLY,CM%INV
CMD BLANK
CMD CONTINUE
CMD COPY
CMD1 D,ENTRDE,CM%ABR!CM%INV
CMD DAYTIME
ENTRDE: CMD DELETE,.RDELM
CMD ECHO
CMD EDIT,.REDIT
CMD FILE-LIST,.FLIST
CMD FLAG,.RFLAG
CMD FORWARD,.RFORW
CMD1 H,ENTRHE,CM%ABR!CM%INV
ENTRHE: CMD HEADER,.RHEAD
CMD HELP
CMD1 K,ENTRKI,CM%ABR!CM%INV
CMD KEYWORDS,.RKEYW
ENTRKI: CMD KILL,.RKILL
CMD LIST
CMD LITERAL-TYPE,.LRTYP
CMD1 M,ENTRMV,CM%ABR!CM%INV
CMD1 MAIL,.SEND,CM%INV
CMD MARK,.RMARK
ENTRMV: CMD MOVE
CMD1 N,ENTRNE,CM%ABR!CM%INV
CMD NET-MAIL,.MAILE
ENTRNE: CMD NEXT,.RNEXT
CMD1 P,ENTRPR,CM%ABR!CM%INV
ENTRPR: CMD PREVIOUS,.RPREV
CMD PUSH
CMD QUIT,.RQUIT
CMD1 R,ENTRRP,CM%ABR!CM%INV
CMD1 RE,ENTRRP,CM%ABR!CM%INV
CMD REMAIL,.RREMA
ENTRRP: CMD REPLY
CMD1 S,ENTSEN,CM%ABR!CM%INV
ENTSEN: CMD SEND
CMD SPELL,.RSPEL
CMD1 T,ENTRTY,CM%ABR!CM%INV
CMD TAKE
ENTRTY: CMD TYPE,.TYPMS
CMD1 U,ENTRUN,CM%ABR!CM%INV
CMD UNANSWER,.RUNAN
ENTRUN: CMD UNDELETE,.RUDLM
CMD UNFLAG,.RUFLG
CMD UNKEYWORDS,.RUKYW
CMD UNMARK,.RUMRK
NRCMDS==.-RCMDTB-1
;;;SEND (and REPLY) commands
SCMDTB: NSCMDS,,NSCMDS
CMD AFTER
CMD BCC
CMD BLANK
CMD CC
CMD1 D,ENTSDI,CM%ABR!CM%INV
CMD DAYTIME
CMD DELIVERY-OPTIONS,.DELIV
ENTSDI: CMD DISPLAY
CMD ECHO
CMD EDIT,.SEDIT
CMD ERASE
CMD FROM
CMD HELP
CMD INSERT,.INSFL
CMD LITERAL-TYPE,.LRTYP
CMD1 MAIL,.SSEND,CM%INV
CMD PUSH
CMD QUIT,.SQUIT
CMD REMOVE,.UNTO
CMD REPLY-TO,.REPTO
CMD RESTORE-DRAFT,.SREST
CMD1 S,ENTSDR,CM%ABR!CM%INV
CMD SAVE-DRAFT,.SSAVE
ENTSDR: CMD SEND,.SSEND
CMD SPELL,.SSPEL
CMD SUBJECT
CMD1 T,ENTSTY,CM%ABR!CM%INV
CMD TAKE
CMD TEXT
CMD TO
ENTSTY: CMD TYPE,.TYPMS
CMD USER-HEADER,.USHDR
NSCMDS==.-SCMDTB-1
;;;ERASE commands
ECMDTB: NECMDS,,NECMDS
CMD ALL,.ERSAL
CMD BCC,.ERSBC
CMD CC,.ERSCC
CMD REPLY-DATE,.ERSDT
CMD SUBJECT,.ERSSB
CMD TEXT,.ERSTX
CMD TO,.ERSTO
NECMDS==.-ECMDTB-1
;;;DISPLAY commands
DCMDTB: NDCMDS,,NDCMDS
CMD ALL,.DSALL
CMD BCC,.DSBCC
CMD CC,.DSCC
CMD FROM,.DSFRM
CMD HEADER,.DSHDR
CMD REPLY-TO,.DSREP
CMD SUBJECT,.DSSUB
CMD TEXT,.DSTXT
CMD TO,.DSTO
NDCMDS==.-DCMDTB-1
;;;EDIT commands
EDCMTB: NEDCMS,,NEDCMS
CMD HEADERS,.EDHEA
CMD TEXT,.EDTXT
NEDCMS==.-EDCMTB-1
;;;REPLY commands
RPCMTB: NRPCMS,,NRPCMS
CMD ALL,.REPAL
CMD SENDER,.REPFM
NRPCMS==.-RPCMTB-1
;;;Sequence commands
SQCMTB: NSQCMS,,NSQCMS
CMD1 A,ENTALL,CM%INV!CM%ABR
CMD1 AFTER,STQAFT,CM%INV
ENTALL: CMD ALL,STQALL
CMD ANSWERED,STQANS
CMD BEFORE,STQBEF
CMD1 C,ENTCUR,CM%INV!CM%ABR
CMD CC-ME,STQCCM
ENTCUR: CMD CURRENT,STQCUR
CMD DELETED,STQDEL
CMD1 F,ENTFRM,CM%INV!CM%ABR
CMD FLAGGED,STQFLG
CMD1 FR,ENTFRM,CM%INV!CM%ABR
CMD1 FRO,ENTFRM,CM%INV!CM%ABR
ENTFRM: CMD FROM,STQFRM
CMD FROM-ME,STQFMM
CMD INVERSE,STQREV
CMD KEYWORDS,STQKYW
CMD1 L,ENTLST,CM%INV!CM%ABR
ENTLST: CMD LAST,STQLST
CMD LONGER,STQLNG
CMD NEW,STQNEW
CMD ON,STQON
CMD PREVIOUS-SEQUENCE,STQPRV
CMD RECENT,STQREC
CMD SEEN,STQSEE
CMD SHORTER,STQSHT
CMD SINCE,STQAFT
CMD SUBJECT,STQSBJ
CMD1 T,ENTTO,CM%INV!CM%ABR
CMD TEXT,STQTXT
ENTTO: CMD TO,STQTO
CMD TO-ME,STQTOM
CMD1 U,ENTUNS,CM%ABR!CM%INV
CMD UNANSWERED,STQUNA
CMD UNDELETED,STQUND
CMD UNFLAGGED,STQUNF
CMD UNKEYWORDS,STQUKW
ENTUNS: CMD UNSEEN,STQUNS
NSQCMS==.-SQCMTB-1
;;;RSCAN commands
RSCMTB: NRSCMS,,NRSCMS
CMD ALIAS
CMD BBOARD
CMD BUG
CMD EXAMINE
CMD FIND
CMD GET
CMD HEADERS,.RSHEA
CMD1 R,ENTRSR,CM%INV!CM%ABR
ENTRSR: CMD READ,.RSREA
CMD RESTORE-DRAFT,.RESTO
CMD1 S,ENTSNR,CM%INV!CM%ABR
ENTSNR: CMD SEND
CMD SYSTEM-MSGS,.SYSTE
CMD1 T,ENTTYR,CM%ABR!CM%INV
CMD TAKE
ENTTYR: CMD TYPE,.RSTYP
NRSCMS==.-RSCMTB-1
;;;Date keywords
DATTAB: NDATBS,,NDATBS
VAR FRIDAY,DATDOW,4
VAR MONDAY,DATDOW,0
VAR SATURDAY,DATDOW,5
VAR SUNDAY,DATDOW,6
VAR THURSDAY,DATDOW,3
VAR TODAY,DATDAY,0
VAR TUESDAY,DATDOW,1
VAR WEDNESDAY,DATDOW,2
VAR YESTERDAY,DATDAY,1
NDATBS==.-DATTAB-1
FLTAB: NFLTAB,,NFLTAB
VAR FIRST,DATFST
VAR LAST,DATLST
VAR LOGIN,LOGLST
NFLTAB==.-FLTAB-1
PURGE VAR ;Last occurance
;;;Holiday keywords
HOLDAY: NHLDYS,,NHLDYS
HDY APRIL-FOOLS,4,1
HDY BASTILLE-DAY,7,14
HDY BEETHOVENS-BIRTHDAY,12,16
HDY BILBOS-BIRTHDAY,9,22
HDY CHRISTMAS,12,25
HDY COLUMBUS-DAY,10,12
HDY FLAG-DAY,6,14
HDY FRODOS-BIRTHDAY,9,22
HDY GONDORIAN-NEW-YEAR,3,25
HDY GROUND-HOGS-DAY,2,2
HDY GUY-FAWKES-DAY,11,5
HDY HALLOWEEN,10,31
HDY INDEPENDENCE-DAY,7,4
HDY LEAP-DAY,2,29
HDY LINCOLNS-BIRTHDAY,2,12
HDY MAY-DAY,5,1
HDY MEMORIAL-DAY,5,30
HDY NEW-YEARS,1,1
HDY SAINT-PATRICKS-DAY,3,17
HDY SHERLOCK-HOLMES-BIRTHDAY,1,6
HDY VALENTINES-DAY,2,14
HDY WASHINGTONS-BIRTHDAY,2,22
NHLDYS==.-HOLDAY-1
PURGE HDY
SUBTTL Interrupt routines
;;;Timer interrupt
TMRINT: MOVEM 16,TMRACS+16
MOVEI 16,TMRACS
BLT 16,TMRACS+15
CALL SETTIM ;Set next timer up
SKIPE OKTINT ;OK for timer at this time?
CALL CHECKT ;Yes, check for new messages
TMRIN0: MOVSI 16,TMRACS
BLT 16,16
DEBRK% ;No, return
SETTIM: MOVE A,[.FHSLF,,.TIMEL] ;Elapsed time
MOVE B,[^D<5*60*1000>] ;5 minutes
MOVEI C,TMRCHN ;Timer channel
TIMER%
NOP
RET
; Finds difference of two 7-bit byte pointers
; Returns A/ B - C
PTRDIF: SAVEAC <B,C>
STKVAR <PTRSAV>
MOVEM C,PTRSAV
MULI B,5 ;Convert to canonical form
ADD C,UADBP7(B) ; with help of magic table
MOVE A,C ;Save it
MOVE B,PTRSAV ;Now convert second BP in same way
MULI B,5
ADD C,UADBP7(B)
SUB A,C ;Get difference B-C
RET
ENDSV.
133500,,0 ;To handle -5 produced by 440700
BLOCK 4
UADBP7: -54300,,5
-104300,,4
-134300,,3
-164300,,2
-214300,,1
;;;Interrupt control routines
; Trap CTRL/C interrupts
NOINT: SAVEAC <A>
SETZM CTCCNT ;Clear accumulated count
MOVE A,[.TICCC,,0] ;Assign CTRL/C to channel 0
ATI%
ERJMP .+1 ;Oh well, we tried
RET
; Untrap CTRL/C interrupts
OKINT: SAVEAC <A>
MOVX A,.TICCC ;Deassign CTRL/C
DTI%
ERJMP .+1 ;Oh well, we tried
SKIPN A,CTCCNT ;Any seen?
RET
CAIG A,1 ;Hot call?
IFSKP.
MOVX A,.PRIIN ;Yes, clear buffers
CFIBF%
MOVX A,.PRIOU
CFOBF%
ENDIF.
SETZM CTCCNT ;Show these accounted for
HRROI A,[ASCIZ/^C/]
PSOUT% ;(Might be in UUO stuff)
HALTF% ;Return to upper fork now
RET ;Carry on
; CTRL/C interrupt comes here
CTCINT: AOS CTCCNT ;Count it
DEBRK% ;And return for now
;;;CTRL/N interrupt (abort) routines
; How to use the abort routines:
; Abort handling is set up in a structured fashion, so that low level
; routines can handle aborts without the higher level routines knowing
; about them. Likewise it is possible for routines to "undo" some things
; when aborted, before passing the abort higher up. In the simplest
; case an abort will just set a flag which the routine can check when it
; gets around to it. All this is done by means of an abort stack, APDL.
; Note that control-N can be be either "armed" or disabled without
; affecting the abort stack. An "abort" is usually but not necessarily
; generated by a control-N; in particular, the ABORET routine will trigger
; an abort. All aborts, at all levels, can be disabled by clearing ABOCAN.
;
; To initialize, CALL ABOINI. CTRL/N is left turned off.
; To specify an abort vector:
; SETABT <loc> ;The previous abort vector is pushed.
; ;An abort will reset P to its value at
; ;the time SETABT was done, and jump to <loc>.
; To unspecify a vector:
; RET ;Restores the previous vector and returns.
; Flags:
; ABORTF - set when aborted but vector is null.
; Cleared by ABOINI and by dispatch to a non-null vector.
; ABOSTS - state of CTRL/N. 0 = enabled, -1 = disabled.
; Saved by SETABT, restored by RET if ABOCAN permits it
; Also restored by abort, but actual CTRL/N state will be off.
; ABOCAN - 0 = keep CTRL/N and aborts off, -1 = can abort.
;
; An abort will:
; (1) ask the user for confirmation, if appropriate
; (2) pop the abort stack, restoring:
; PDL ptr saved from SETABT
; CTRL/N state saved from SETABT
; (3) turn off CTRL/N without altering "CTRL/N state", which now indicates
; whether it is OK to turn CTRL/N back on or not.
; (4) dispatch to the popped abort vector.
;
; The routine vectored to is responsible for re-enabling
; and/or propagating aborts by calling ABORET, since
; CTRL/N has been turned off to ensure the routine isn't
; itself clobbered until it's ready. If all levels call ABORET,
; an abort will percolate back up to the topmost layer in controlled
; fashion.
;
; Turning aborts off:
; The good way to turn aborts off within a section of code is:
; SETABT
; CALL ABNOFF
; ... code ...
; RET
; This is better than simply calling ABNOFF because the previous
; abort state is saved and restored. E.G. just doing ABNOFF and
; then ABNON would lose if aborts had been off prior to ABNOFF!
; ABOINI - Initialize abort routines. Clears stack, leaves ctl-N
; turned off. Does not touch ABOCAN.
ABOINI: CALL ABNOFF ;Turn off control-N first
SETZM ABOPDP ;Clear abort stack
SETZM ABOIP ;Clear abort-in-progress flag
SETZM ABORTF ;And abort-seen flag
RET
; SETABT <loc> - set abort vector, save PDL
; If no argument, default is that aborts just set the ABORTF flag.
; A routine can then just periodically check this with a SKIPGE.
DEFINE SETABT (LOC) <
CALL $ABSET
NOP LOC+0
>;DEFINE SETABT
$ABSET: PUSH P,A ;Preserve these AC's
PUSH P,B
SKIPN A,ABOPDP ;Get abort PDL ptr
MOVE A,[-APDLLN*3,,APDL-1]
PUSH A,ABOSTS ;Save CTRL/N state
HRRZ B,@-2(P) ;Save abort vector
PUSH A,B
MOVE B,P
ADJSP B,-3 ;Get P as of SETABT invocation
PUSH A,B ;Save that too.
MOVEM A,ABOPDP ;Update abort PDL ptr.
POP P,B ;Restore AC's
MOVE A,[PC%USR+$ABRET] ;Routine to undo $ABSET
EXCH A,-1(P) ;Stack it, get our return
EXCH A,(P) ;Restore A, stack return from $ABSET for RET
SKIPGE ABORTF ;If abort already attempted,
JRST ABORET ; trigger this level!
SKIPE ABOCAN ;If allowed to,
JRST ABNON ; return with ctl-N enabled
CALLRET ABNOFF ;Else make sure it's off.
;;;$ABRET - Pop abort vector and PDL, entered by CALLRET $ABRET.
;;;Triggers abort for next level if ABORTF flag is set. If the current
;;;stack level doesn't match the stack level for this abort, we run down
;;;the abort stack until we find the abort matching this stack level or
;;;we run out of space. This is so main stack backing up due to an error
;;;will work.
$ABRET: PUSH P,A ;Can't use SAVEAC because of test below
PUSH P,B
SKIPN A,ABOPDP ;Get abort PDL ptr
FATAL ($ABRET called without any abort context)
DO.
POP A,B ;Get PDL ptr saved by last SETABT
IFE. B
FATAL ($ABRET called at invalid stack level)
ENDIF.
ADJSP B,2 ;Compensate for stuff pushed on stack
ADJSP A,-1 ;Flush abort vector
CAMN B,P ;PDL must be same as when SETABT given.
IFSKP.
ADJSP A,-1 ;Flush CTRL/N status
LOOP. ;Now try a level lower
ENDIF.
ENDDO.
POP A,ABOSTS ;Restore CTRL/N state
SKIPE ABOSTS ;Should it be off?
SKIPN ABOCAN ; or did someone turn us off?
CALL ABNOFF ; Ensure off.
MOVEM A,ABOPDP ;Put back updated APDL ptr
POP P,B
POP P,A
SKIPE ABOSTS ;If new status wants it,
CALL ABNON ; ensure CTRL/N on.
SKIPN ABORTF ;If a "quiet" abort happened,
RET
CALLRET ABORET ; try to propagate it.
; ABNDIS - Disable CTRL/N (abort vector stack not reset)
ABNDIS: SETZM ABOSTS ;Say CTRL/N is off
ABNDS0: SAVEAC <A>
MOVX A,.TICCN ;Deassign CTRL/N
DTI%
ERJMP .+1
MOVX A,.TICCX ;Deassign CTRL/X
DTI%
ERJMP .+1
RET
; ABNOFF - Disallow CTRL/N abort (abort vector stack not reset)
; ABNON - Allow CTRL/N abort (abort vector stack not reset)
ABNOFF: SETZM ABOSTS ;Say CTRL/N is off
CAIA
ABNON: SETOM ABOSTS ;Say CTRL/N is on
SKIPGE ABOFLG ;Never arm if user doesn't want aborts
JRST ABNDS0
SAVEAC <A>
SKIPE SIMODE ;Don't do this if Katakana
IFSKP.
MOVE A,[.TICCN,,4] ;Assign CTRL/N on chan 4
ATI%
ERJMP .+1
ENDIF.
MOVE A,[.TICCX,,4] ;Assign CTRL/X on chan 4
ATI%
ERJMP .+1
RET
; ABORET - Re-invokes abort for current (just-popped) vector if allowed to.
; Returns from user vector routine.
ABORET: SETZM ABORTF ;Clear flag to avoid confusion
SKIPE ABOCAN ;Aborts disabled?
SKIPN ABOSTS ; or CTRL/N off at this level?
JRST ABNOFF ; Sigh, don't trigger higher abort.
CALL ABNON ;Hurray, ensure CTRL/N really on.
SAVEAC <A,B>
MOVX A,.FHSLF
MOVX B,1B4
IIC% ;Trigger an abort as if CTRL/N typed.
RET
; Abort interrupt routine
ABOINT: SKIPN ABOIP ;CTRL/N abort already in progress?
SKIPN ABOSTS ;Or, is CTRL/N action turned off?
DEBRK% ;Yes, go away peacefully, having eaten CTRL/N
MOVEM 16,ABOACS+16 ;Here on actual interrupt
MOVEI 16,ABOACS
BLT 16,ABOACS+15
MOVX A,.PRIIN
RFMOD%
TXZE B,TT%OSP ;Cancel CTRL/O if enabled
SFMOD%
DO.
SKIPGE A,ABOFLG ;Never abort?
EXIT. ;Yes, just dismiss
IFE. A ;Need confirmation?
CALL ABOCFM ;Yes, confirm abort
EXIT. ;User said no
ENDIF.
SKIPE A,ABOPDP ;Get abort PDL ptr
SKIPN -1(A) ;Make sure abort vector non-zero
IFSKP.
POP A,P ;Restore PDL ptr saved by SETABT.
POP A,PSIPC1 ;Put abort vector into dispatch loc
POP A,ABOSTS ;Restore CTRL/N status
MOVEM A,ABOPDP ;Put back updated abort-PDL ptr.
SETOM ABOIP ;Set abort in progress flag
SETZM ABORTF ;Clear flag, since action being taken.
ELSE.
SETOM ABORTF ;Here to set flag and return
ENDIF.
ENDDO.
MOVSI 16,ABOACS ;Restore Abort ACs
BLT 16,16
DEBRK%
;;;Confirm an abort. Saves state of command parse in case no abort
SBFLEN==20 ;Length of text/atom buffers stolen from stack
ABOCFM: STKVAR <ABSREP,<ABSCMD,<.CMGJB+1>>,<ABOTXB,SBFLEN>,<ABOATB,SBFLEN>>
MOVX A,.PRIIN ;Clear typeahead
CFIBF%
MOVE A,REPARP ;Save old reparse address
MOVEM A,ABSREP
HRLI A,CMDBLK ;Location of command block to save
HRRI A,ABSCMD ;Location where to save to
BLT A,.CMGJB+ABSCMD ;Save command block
JRST ABOPMT ;Can't do a PROMPT UUO here
ABOCF1: CALL YESNO ;Get answer, default to YES
TRNA ;Non-skip return
AOS (P) ;Skip return
HRLI A,ABSCMD ;Restore from our save area
HRRI A,CMDBLK ;Destination address
BLT A,CMDBLK+.CMGJB ;Restore old CMDBLK
MOVE A,ABSREP ;Restore reparse address
MOVEM A,REPARP
RET
; This strange spaghetti set of JRSTs is there for a reason. It simulates
;a PROMPT UUO, but without messing up UUO context or pushing anything on the
;stack. If we ever free up AC15 we could use TRVARs and this would be cleaner.
ABOPMT: MOVE A,[CMIBLK,,CMDBLK] ;Initialize CMDBLK to virgin state
BLT A,CMDBLK+.CMGJB
HRROI A,[ASCIZ/Abort? /] ;Set up prompt
MOVEM A,CMDBLK+.CMRTY
HRROI A,ABOTXB ;First bfr stolen from stack
MOVEM A,CMDBLK+.CMBFP ;Start of text pointer
MOVX B,5*SBFLEN ;Size of buffers in characters
DMOVEM A,CMDBLK+.CMPTR ;Next input pointer, space left
HRROI A,ABOATB ;Next buffer stole from stack
DMOVEM A,CMDBLK+.CMABP ;Atom buffer pointer/size
MOVEI B,[FLDDB. .CMINI]
CALL $COMND
JRST ABOCF1
ENDSV.
SUBTTL Main program
GO: TDZA F,F ;Reset flags
GOAMOD: MOVX F,F%AMOD ;Automatic mod handling
RESET%
MOVE P,[IOWD NPDL,PDL]
GJINF% ;Now get login user
DMOVEM A,MYUSR ;Save user/directory numbers
MOVEM C,MYJOBN ;Save job number
MOVEM A,MYAUSR ;Also ALIAS user
HRROI A,MUSRST ;Real login name for ALIAS default
MOVE B,MYUSR ;RCUSR% and DIRST% want number in B
DIRST%
NOP
SETZ A, ;Now get directory number
RCDIR%
MOVEM C,MYDIR ;Save that too
MOVEM C,MYPDIR ;And as post office box directory
CALL SETUSR ;Set internal login user
MOVE A,[SIXBIT/MM/] ;Set subsystem name
SETNM%
SETO A, ;Get our names
MOVE B,[-2,,PRGNAM]
MOVEI C,.JISNM
GETJI%
JFATAL
MOVE A,[JRST CMDRES] ;Setup initial return dispatch
MOVEM A,CMDRET
MOVE A,[CMIBLK,,CMDBLK] ;Initialize CMDBLK to virgin state
BLT A,CMDBLK+.CMGJB
MOVEI D,SAVMOD
CALL GETTYM ;Get current TTY modes
MOVE T,[SAVMOD,,EDMOD] ;Give a reasonable set of editor modes
BLT T,EDMOD+4
MOVX A,.FHSLF ;Setup interrupt stuff
RPCAP%
TXZ B,.RHALF ;Only enable lh caps at first
IOR C,B
EPCAP%
MOVE B,[LEVTAB,,CHNTAB]
SIR%
EIR%
MOVX B,<<1B<CTCCHN>>!<1B<ABOCHN>>!<1B<TMRCHN>>> ;CTRL/C, CTRL/N, timer
AIC%
CALL ABOINI ;Set up abort routines
CALL SETTIM ;Set up timer interrupt
HRROI A,MLBXDV ;Get post office box structure
STDEV%
IFJER.
HRROI A,STRBUF ;Failed, get logged-in directory string
MOVE B,MYDIR ;From logged-in directory
DIRST%
JFATAL
HRROI A,STRBUF ;Now get its device designator
STDEV%
JFATAL
DEVST% ;Now get just its device name
JFATAL
MOVX B,":" ;Append the device delimiter
IDPB B,A
SETZ B, ;Now null-terminate it
IDPB B,A
MOVX A,.CLNJB ;Create systemwide logical name
HRROI B,MLBXDV ; for post office box
HRROI C,STRBUF ;From login structure
CIETYP <[%2R: not found, defining as %3R]
>
CRLNM%
JFATAL
ELSE.
MOVE A,[POINT 7,STRBUF] ;Otherwise we need postbox directory
MOVEI B,[ASCIZ//] ;Null name
CALL MKPSTR ;Make postbox directory name
SETZ A, ;Now get directory number
HRROI B,STRBUF ; of postbox
RCDIR%
IFNJE.
TXNN A,RC%NOM!RC%AMB ;Found the direcotyr?
MOVEM C,MYPDIR ;Yes, use it as postbox
ENDIF.
ENDIF.
MOVEI A,MAXBBD ;Reset the BBoard table to empty
MOVEM A,BBDTAB
MOVEI A,BBDTAB+MAXBBD+1 ;Clear string space
MOVEM A,BBDSTR
MOVE A,[POINT 7,STRBUF] ;Make BBoard filename string
MOVEI B,MLBXDV ;Post office box structure
CALL MOVSTR
MOVEI B,[ASCIZ/:</]
CALL MOVSTR
MOVEI B,BBDIR ;BBoard directory
CALL MOVSTR
MOVEI B,[ASCIZ/*>*./] ;All files
CALL MOVSTR
MOVEI B,MLBXEX ;Only this extension
CALL MOVSTR
MOVEI B,[ASCIZ/.1/] ;Generation 1 only
CALL MOVST0
MOVX A,GJ%SHT!GJ%OLD!GJ%DEL!GJ%IFG
HRROI B,STRBUF
GTJFN%
IFNJE.
MOVE D,A ;Save JFN over this clobberage
DO.
HRRZ A,BBDSTR ;Current BBoard pointer
CAILE A,BBDEND ;Any space left?
IFSKP.
HRROS A ;Yes, make string pointer
HRRZ B,D ;JFN to output
MOVX C,1B8 ;Name only
JFNS% ;Insert BBoard name in string space
SETZ C, ;Tie off name
IDPB C,A
ADDI A,1 ;Next string begins on this word
HRLZ B,BBDSTR ;Pointer to this string for TBADD
MOVEM A,BBDSTR ;Update string pointer
MOVEI A,BBDTAB ;Add to the table
TBADD%
IFJER.
WARN <Too many BBoards, table truncated>
EXIT.
ENDIF.
MOVE A,D ;Retrieve JFN
GNJFN% ;Get next BBoard
ERJMP ENDLP. ;No more BBoards to do
LOOP.
ENDIF.
WARN <Insufficient string space for all bulletin boards>
ENDDO.
ENDIF.
HRRZ A,D ;Got all BBoards, release the JFN now
RLJFN%
ERJMP .+1
MOVEI A,NHOSTS ;Initialize host string cache
MOVEM A,HSTTAB
HRROI A,HSTSTR ;Initialize host strings
HRRZM A,LCLHST ;First string is local host name
CALL $GTLCL ;Get local host name
FATAL (Unable to get local host name)
IBP A ;Skip over following byte
MOVEI A,1(A) ;Start next string on next word
MOVEM A,HCSHFF ;Set up host cache first free
MOVEI A,HSTTAB ;Put local host name in cache
MOVS B,LCLHST
TBADD%
MOVE A,[POINT 7,LCLHNM] ;Now make copy of local name string
MOVE B,LCLHST
CALL MOVST0
HRROI A,LCLHNM ;Now remove its relative domain
CALL $RMREL
; JRST GOINIT
;;;Now ready to read in the user's MM.INIT
GOINIT: SETZM ZERMEM
MOVE A,[ZERMEM,,ZERMEM+1]
BLT A,ZEREND ;Clear out garbage stuff
SETOM WRKSEQ ;Show no previous sequence
AOS MSCANF ;Assume forward sequence scanning
CALL ININIT ;Initialize init variables
MOVE A,[POINT 7,STRBUF] ;Build init filename
MOVEI B,[ASCIZ/MM.INIT/]
CALL MAKSTR
MOVX A,GJ%OLD!GJ%SHT ;See if MM.INIT present
HRROI B,STRBUF
GTJFN%
IFNJE.
CALL DOINIT ;Init file present, parse it
ENDIF.
;;;Here go and lookup personal name if MM.INIT doesn't set it up
SKIPE PERNAM ;Did MM.INIT set it up?
JRST NOFING ;Don't need FINGER for this
MOVX A,GJ%OLD!GJ%SHT ;Look up FINGER
HRROI B,[ASCIZ/SYS:FINGER.EXE/]
GTJFN%
ERJMP NOFING ;FINGER not present
PUSH P,A ;Save JFN
MOVX A,CR%CAP ;Create a new fork
CFORK%
IFJER.
POP P,A ;Can't get fork, punt
RLJFN% ;Flush the JFN
NOP
JRST NOFING
ENDIF.
EXCH A,(P) ;Save fork handle, get JFN
PUSH P,A ;In case of error in GET
HRL A,-1(P) ;Get prog into fork
GET%
IFJER.
POP P,A ;Can't get program, punt
RLJFN% ;Flush the JFN
NOP
JRST NOFING
ENDIF.
ADJSP P,-1 ;Flush JFN
MOVE A,[.FHSLF,,FWDPAG/1000] ;Map page FWDPAG of this fork
HRLZ B,(P) ;From page 777 of FINGER
HRRI B,777
MOVX C,PM%RD!PM%WR!PM%PLD ;Read/write/preload
PMAP%
ERJMP FNGERR
HRROI A,FWDPAG ;Give our user name to FINGER
MOVE B,MYAUSR
DIRST%
ERJMP FNGERR ;???
MOVE A,(P) ;Get back fork handle
MOVEI B,3 ;Start inferior at offset 3
SFRKV%
ERJMP FNGERR
RFORK% ;Resume, in case it didn't get going
ERJMP FNGERR
WFORK% ;Sleep until fork is finished
ERJMP FNGERR
DMOVE A,PRGNAM ;Restore program name
SETSN%
JFATAL
MOVE A,(P) ;See if it finished okay
RFSTS%
HLRZ A,A
CAIE A,.RFHLT ;Fork halted?
IFSKP.
HRROI A,PERNAM ;Now copy personal name into PERNAM
HRROI B,FWDPAG
MOVEI C,117 ;Up to 20 words
MOVEI D,0 ;Terminated by a null
SOUT%
ENDIF.
FNGERR: SETO A, ;Unmap shared page
MOVE B,[.FHSLF,,FWDPAG/1000] ;Mapped to this fork's FWDPAG
SETZ C,
PMAP%
POP P,A ;Now kill the fork
KFORK%
MOVEI D,SAVMOD ;Restore TTY modes
CALL SETTYM
NOFING: SKIPL INITER ;Did an error happen?
IFSKP.
TMSG <
[The above error(s) indicate(s) some problem in MM.INIT, the file
which contains your personal MM profile parameters. If you have
not edited or otherwise altered your MM.INIT, it's likely that
your MM.INIT was created by an older version of MM, and is
referencing some obsolete feature that is no longer supported by
MM. If this is the case, answer YES to the following question.]
>
PROMPT <May I rewrite your MM.INIT file to correct these errors? >
CALL YESNO ;Yes, offer to fix it
ANSKP.
CALL CRINI0 ;Fix it
ENDIF.
;;;Here after INIT file has been processed
IFXN. F,F%AMOD ;Auto mod handling?
CALL SYSTE1 ;Yes, setup for system mail
SETZB CMDSTK ;No subcommands
MOVE L,[POINT 12,MSGSEQ,11] ;Pointer to where to store messages
CALL STQALL ;Assume all msgs will be considered
CALL PSHCMD ;NXTSEQ should always be the first function!!!
CALL STQNEW ;Setup sequencer
CALL PSHCMD
HLRE A,CMDSTK ;Compute number of entries
ADDI A,NCPDL
MOVNS A
HRLI A,CMPDL
MOVSM A,CMDSTK ;Save it
MOVE C,[POINT 12,MSGSEQ,23] ;Begin looking at this sequence first
MOVEM C,MSGSPT ;Save initial sequence pointer
SETOM WRKMSG ;Say sequence hasn't begun yet!
SETOM MSRNG ;Say no range in progress
MOVE L,[POINT 12,WRKSEQ,11] ;Init ptr to working sequence
MOVNI M,MSGLEN
MOVEI A,TYPE1 ;Msg processing routine
CALL DOMSGS ;Go do messages
PUSH P,[GO] ;In case of continue
CALLRET QUIT0 ;And exit
ENDIF.
CALL DORSCN ;Do RSCAN% hacking
AOSN INITER ;Error in init processing?
IFSKP.
SKIPE BLSCST ;Clear off the screen, maybe
CALL $BLANK ;Blank screen
ENDIF.
CALL .VERS1 ;Tell version
CALL GETFIL ;Get and parse file
MOVE A,[POINT 7,STRBUF] ;Now TAKE user's MM.CMD file
MOVEI B,[ASCIZ/MM.CMD/]
CALL MAKSTR ;Build file name with login directory
MOVX A,GJ%OLD!GJ%SHT
HRROI B,STRBUF
GTJFN% ;Try to find file
IFSKP. <CALL TAKE1> ;Do TAKE
SKIPLE MSGJFN ;Is there a mailbox?
CALL CMDSUM ;Yes, show summary
CMDRES::MOVE P,[IOWD NPDL,PDL] ;Errors that return to command level
; come here.
TXZ F,F%RSCC ;No more RSCAN% reparsing
CMDLUP: IFXE. F,F%TAK ;In TAKE file?
TXZE F,F%RSCN ;No, command line routine terminated?
CALL QUIT0 ;Yes, go get rid of file and stop
ENDIF.
SETZM KEYFRE ;Reset keyword buffer
CALL CHECK ;Check for new messages
SKIPGE M ;Make sure have a valid message
SKIPA M,PRIORM ;Don't, use last one then
MOVEM M,PRIORM ;Yes, save in case for next time
MOVE A,[TOPRMT,,CMDTAB] ;Pointer to current command
CALL CMDINI ;Init command state, etc.
CALL ABOINI ;Now re-init abort routines
SETOM OKTINT ;OK for timer interrupt here
SETOM ABOCAN ;OK to arm CTRL/N aborts.
CALL GETCMD
CALL (A)
JRST CMDLUP ;And keep going
CMDSUM: SETABT CMDABO ;May now allow abort of type-out
CALL RECENT ;Show data on recent messages
CALLRET SUMMRY ;And a summary of the files contents
; Standard abort vector for main command loop.
CMDABO: MOVX A,.PRIIN ;Make sure TTY input buffer empty
CFIBF%
ERJMP .+1
MOVEI D,SAVMOD ;Restore program's modes
CALL SETTYM
MOVEI A,CMDRES ;Restore return address
TXNE F,F%READ
MOVEI A,REDRET
TXNE F,F%SEND
MOVEI A,SNDRET
HRRM A,CMDRET
SETZM CMDFLB+.CMDEF ;Clear any default setup during this
SETZM ABOIP ;Clear abort in progress flag!
JRST (A)
SUBTTL Command routines
;;;Headers of messages
RSHEA: CALL RSCFIL ;RSCAN% call, get the file
HEADE: CALL DFSQTH ;Get sequence, default to current
MOVEI A,TYPHDR ;Setup to type out header
CALLRET DOMSGS ;And go handle them all
;;;Give status
STATU: CONFRM
CALL .STATF ;Print file status
CALL RECEN1 ;Get poop on new messages
CALL SUMMRY
SKIPL M ;Range check
CAMLE M,LASTM
SETZ M, ;Go to the beginning
CIETYP < Currently at message %M.
>
RET
;;;Print current alias and file name.
STATF: HRROI A,MAUSRS ;If an alias is in effect
TXNE F,F%ALIA ;Then let user know to whom
CIETYP < Alias: %1S>
SKIPG A,MSGJFN
ERROR <No current file>
CIETYP < File: %1J> ;Say what file we are using
RET
;;;Type messages
RSTYP: CALL RSCFIL ;Get file for RSCAN% command handling
TYPE: CALL DFSQTH
MOVEI A,TYPE1
CALLRET DOMSGS
TYPE1: CALL CHKDEL ;Not the deleted ones
RET
CALLRET TYPMSG
;;; Literal typing (no filters)
LTYPE: CALL DFSQTH
MOVEI A,LTYPE
CALLRET DOMSGS
LTYPE: CALL CHKDEL
RET
CALLRET TYPMSL
KILL: CALL .DELET ;Delete messages
CALLRET .NEXT0 ;Do an implicit NEXT
MARK: SKIPA A,[MRKMSG] ;Mark messages
DELET: MOVEI A,DELMSG ;Delete messages
DELET0: MOVEM A,DOMSG ;Set up handler
CALL DFSQTH ;Get sequence, default to current
DELET1: TXOA F,F%TYPS ;Say to print numbers of things done
DOMSGS: MOVEM A,DOMSG ;Here with routine to handle them in A
SETABT ;Allow peaceful aborts, arm CTRL/N
DO.
CALL NXTMSG ;Next message spec'd
RET ;None left, return
SKIPGE ABORTF ;If abort was requested,
ERROR <Aborted> ; stop processing sequence.
CALL @DOMSG ;Process the message
LOOP.
ENDDO.
;;;Put keywords on messages
UNKEY: SKIPA A,[UNKMSG]
KEYWO: MOVEI A,KEYMSG
PUSH P,A
CALL GETKY0 ;Get list of keywords
MOVEM U,KEYBTM ;Save keyflag mask bits
MOVEM V,KEYLPM ;And keyword list
POP P,A
CALLRET DELET0 ;And go handle sequence
NEXT: NOISE (MESSAGE)
CONFRM
NEXT0: SKIPG MSGJFN
ERROR <No current file>
CAMGE M,LASTM ;At last message?
IFSKP.
CIETYP < Currently at end, message %M.
>
RET
ENDIF.
ADDI M,MSGLEN ;Nope, increment him
NEXT1: CALL CHKDEL ;Deleted?
RET
CALLRET TYPMSG ;No, type the next one then
PREVI: NOISE (MESSAGE)
CONFRM
SKIPG MSGJFN
ERROR <No current file>
IFE. M
CIETYP < Currently at beginning, message %M.
>
RET
ENDIF.
SUBI M,MSGLEN
CALLRET .NEXT1
JUMP: STKVAR <JMPMSG>
SKIPG MSGJFN
ERROR <No current file>
NOISE (TO MESSAGE NUMBER)
MOVEI B,[FLDDB. .CMNUM,,^D10] ;Read a number
CALL CMDFLD
MOVEM B,JMPMSG
CONFRM
EXCH M,JMPMSG ;Get back number typed
SUBI M,1
IMULI M,MSGLEN ;Convert to msg pointer
CAMG M,LASTM
RET ;Number ok, return
MOVE M,JMPMSG ;Number bad, restore old pointer
BADNUM: ERROR <Number out of range>
ENDSV.
FLAG: SKIPA A,[FLGMSG] ;Flag messages
UNFLA: MOVEI A,UFLMSG ;Unflag messages
CALLRET DELET0
UNMAR: SKIPA A,[UMKMSG] ;Unmark messages
UNANS: MOVEI A,UANMSG ;Unanswer messages
CALLRET DELET0
UNDEL: MOVEI A,UNDMSG ;Set up handler
MOVEM A,DOMSG
MOVEI A,[ASCIZ/PREVIOUS-SEQUENCE/] ;Default to previous sequence
CALL DFSQA1
CALLRET DELET1
BLANK: NOISE (SCREEN)
CONFRM
CALLRET $BLANK
EXIT: NOISE (AND UPDATE MESSAGE FILE)
CONFRM
TXO F,F%F1 ;Re-Get mail file
SKIPLE MSGJFN ;If have a file,
CALL EXPUNG ;Expunge first
CALLRET QUIT0 ;And then quit
LOGOU: NOISE (AND UPDATE MESSAGE FILE)
CONFRM
TXZ F,F%F1 ;Don't bother getting mail file again
SKIPLE MSGJFN ;If have a file,
CALL EXPUNG ;Expunge first
SETO A, ;Flush us
LGOUT% ;Do the kill
JERROR <Logout failed> ;Woops, bombed?
EXPUN: NOISE (DELETED MESSAGES)
CONFRM
SKIPG MSGJFN
ERROR <No current file>
TXO F,F%F1 ;Re-Get mail file
; CALLRET EXPUNG
EXPUNG: TXNN F,F%RONL ;Not on system mail you don't
CALL GETJF2 ;Get write JFN so no one interferes
RET ;Failed, or system mail
SETOM WRKSEQ ;Show no previous sequence
SETZB L,E ;Clear offset, and count of bytes saved
MOVNI M,MSGLEN ;Begin with first message
DO.
ADDI M,MSGLEN ;Step to next message
MOVX A,M%DELE ;Deleted bit
TDNE A,MSGBTS(M) ;Is it deleted?
IFSKP.
MOVE C,MSGSAL(M) ;No, must save, get length of this message
ADD E,C ;Keep track of total
IFN. L ;If no bytes deleted yet, no moving
MOVE V,MSGALL(M) ;Get starting byte of message
CALL CHR2BP ;Get byte pointer in a to old msg
CALL FSCOPY ;Do a fast string copy
ADDM L,MSGALL(M) ;Update position in file of start
ENDIF.
ELSE.
IFE. L ;The first deleted msg we have seen?
MOVX A,EN%BLN ;Exclusive use, no level numbers
HRR A,MSGJFN ;File's JFN
MOVEM A,ENQBLK+.ENQLV
DMOVE A,[.ENQMA ;Change our lock to be exclusive
ENQBLK]
ENQ%
IFJER.
WARN <Can't do expunge - another process has the file open>
CALLRET CLSJF2 ;Get rid of the JFN we made
ENDIF.
MOVE V,E
CALL CHR2BP ;Yes, byte pointer to last saved byte
MOVE O,A ;Init pointer to output area
MOVEI A,MTXPAG ;And make messages private
HRRZ B,FILPGS
DO.
MOVES (A)
SOJLE B,ENDLP.
ADDI A,1000
LOOP.
ENDDO.
ENDIF.
SUB L,MSGSAL(M) ;Increment count of byte offset
ENDIF.
CAMGE M,LASTM ;At the last msg?
LOOP. ;No, do next then
ENDDO.
IFE. L ;Any messages deleted?
CITYPE < No messages deleted, so no update needed
>
CALLRET CLSJF2
ENDIF.
IFE. E
CITYPE < All messages deleted, deleting file
>
DMOVE A,[.DEQID ;Get rid of any locks we got
REQID]
DEQ%
ERJMP .+1 ;Ignore failure
SKIPLE A,MSGJFN ;Make damn sure this JFN is out of
CLOSF% ; the way, so the DELF% doesn't get a
NOP ; DELFX2 loser
SETOM MSGJFN
CALL CLSJF2
SETZM FILSIZ
HRRZ A,MSGJF2
TXO A,DF%EXP
DELF%
JWARN
HRRZ A,MSGJF2
RLJFN%
NOP
SETOM MSGJF2
RET
ENDIF.
CITYPE < Expunging deleted messages
>
NOINT ;CTRL/C from here on is deadly...
MOVE B,E ;See how many pages touched
IDIVI B,5000
JUMPE C,.+2
ADDI B,1
HRRZ C,FILPGS ;Number we had mapped to start
SUBI C,(B) ;Less number touched
IFN. C ;All pages touched?
PUSH P,B ;No, save new count for later
SETO A,
ADD B,[.FHSLF,,MTXPGN]
TXO C,PM%CNT
PMAP% ;Unmap those not touched
POP P,B ;Number of pages touched
HRL B,MSGJF2 ;Write msg file JFN
PMAP% ;Make pages in the file go away
IFJER.
JWARN <Can't unmap file pages, probably another user has file open>
ENDIF.
ENDIF.
HRRZ A,MSGJF2 ;Write msg file JFN
HRROI B,MTXPAG ;Write out new pages
MOVN C,E
SOUT%
HRLI A,.FBSIZ
SETO B,
MOVE C,E ;Update byte count
CHFDB%
LDB B,[POINT 6,FILPGS,11] ;Get byte size
CAIN B,7 ;If not 7,
IFSKP.
HRLI A,.FBBYV ;Make it be
MOVX B,FB%BSZ
MOVX C,7B11
CHFDB%
ENDIF.
CALL CLSJF2 ;Get rid of write JFN
MOVX A,EN%BLN!EN%SHR ;No level number, shared access
HRR A,MSGJFN
MOVEM A,ENQBLK+.ENQLV ;Change the access back to shared
DMOVE A,[.ENQMA
ENQBLK]
ENQ%
ERJMP .+1 ;Don't care
OKINT ;OK, let him CTRL/C now
JXE F,F%F1,R ;Should we get mail file back?
CALL SIZFIL ;Yes, go thru normal channels
PARSEA: SETZ M, ;Read entire file, remarking
CALL PARSEF ; recent msgs
CALLRET RECEN2
ANSWE: CALL DFSQTH ;Get in sequences, def to current
SETABT CMDABO
MOVEI A,ANSRET ;Return here on error
HRRM A,CMDRET
DO.
CALL NXTMSG ;Get next message
EXIT. ;Unless all done
CALL CHKDEL ;Deleted?
LOOP. ;Yes, forget it
MOVE A,[POINT 7,TMPBUF]
MOVEI B,[ASCIZ/ Send reply for message # /]
CALL MOVSTR
MOVEI B,MSGLEN(M)
IDIVI B,MSGLEN
MOVX C,^D10
NOUT%
JERROR
MOVEI B,[ASCIZ/ to: /]
CALL MOVST0
UPRMT TMPBUF ;Prompt for all/sender
MOVEM L,SAVL
SETOM CLEVEL ;Don't let CTRL/U go to top level
MOVEI A,ANSWE1 ;Set reparse address
HRRM A,CMDBLK+.CMFLG
MOVEM P,REPARP
ANSWE1: MOVE P,REPARP
CALL REPLY0 ;Reply to it
ANSRET: MOVE L,SAVL
LOOP. ;How about another?
ENDDO.
MOVEI A,CMDRES ;Reset the error handler
HRRM A,CMDRET
JRST CMDRES ;And back to snarf a command
;;;Count messages
COUNT: CALL DFSQAL ;Get sequence, default is all
SETZM NRECNT ;Place to store count
MOVEI A,CNTMSG
MOVEM A,DOMSG
CALL DELET1 ;Map over them, printing and counting
SKIPE A,NRECNT ;Get the total count
IFSKP.
CITYPE <No messages>
ELSE.
ETYPE < = %1D message%1P>
ENDIF.
RET
CNTMSG: AOS NRECNT
RET
;;;Append messages together
APPEN: STKVAR <APPMSG,APPPTR,APPLEN>
SKIPG MSGJFN ;Must have a file
ERROR <No current file>
CALL GETSEQ ;Get a bunch of messages no default
TXNE F,F%RONL ;File read-only?
ERROR (File is read-only)
TXO F,F%TYPS ;Type out numbers of messages
CALL APPNXM ;Get an undelete message sequence
RET ;Nothing to append
MOVEM M,APPMSG ;Save index of first msg
MOVE C,[POINT 7,TXTPAG] ;Lots of string space
MOVEM C,APPPTR
SETZM APPLEN ;Initially zero length
DO.
HRRZ V,MSGBOD(M)
CALL MCH2BP ;Get byte pointer to message
HLRZ C,MSGBOD(M) ;And length
ADDM C,APPLEN ;Update total length
MOVE O,APPPTR
CALL FSCOPY ;Copy in the message
MOVEM O,APPPTR
CALL APPNXM ;Get next message
EXIT. ;All done
CALL DELMSG ;Delete it
LOOP. ;For the whole sequence
ENDDO.
MOVE A,[POINT 7,TXTPAG]
MOVE C,APPLEN ;Get total length
MOVE M,APPMSG ;The appended msgs go here
CALL RPLMSG ;Go replace that message
ERROR <Append failed, message(s) deleted>
UETYPE [ASCIZ/ => %M/]
RET
ENDSV.
APPNXM: DO.
CALL NXTMSG ;Get first sequence
RET ;Nothing to append
CALL CHKDEL ;Is it deleted?
LOOP. ;Yes, ignore it, try for another
ENDDO.
RETSKP ;Here we have a message
RSREA: CALL RSCFIL ;Get file for RSCAN% command handling
READ: CALL DFSQNW ;Get sequence, default to unseen
CALL CHECKT ;Do a CHECK in case new mail came in
MOVEM P,READPP ;Save stack
TXO F,F%READ ;Say in read command
MOVE A,[POINT 12,PRVSEQ,11] ;Initialize previous sequence pointer
MOVEM A,PREVPT
MOVE A,[PRVSEQ,,PRVSEQ+1] ;Clear previous sequence list
SETOM PRVSEQ
BLT A,PRVSQZ-1
MOVEI A,REDRET ;Return here
HRRM A,CMDRET ;On error
READ0: MOVE A,PREVPT ;Paranoia check
CAMN A,[POINT 12,PRVSQZ-1,23] ;Reached end of list?
ERROR <Too many messages in read list>
ILDB A,PREVPT ;See if a next message from backup
CAIN A,7777 ;Is there a next message?
IFSKP.
IMULI A,MSGLEN ;Yes, convert to message index
MOVEI M,(A) ;Set current message to this
ELSE.
CALL NXTMSG ;Get next message
JRST RQUIT0 ;None, all done
MOVE A,M ;Convert index to msg # w/o zapping M
IDIVI A,MSGLEN
DPB A,PREVPT ;Save message on previous stack
ENDIF.
READ1: CALL CHKDEL ;Don't if deleted msg
JRST REDRET
SKIPE BLSCST ;Unless user doesn't want it
CALL $BLANK ;Clear the screen perhaps
CALL TYPMSG ;And type the message out
SKIPGE RINCME ;Special include me mode?
SETZM SAVFIL ;Yes, reset default moved to
REDRET: MOVE P,READPP ;Restore stack
REDCLP: MOVE A,[REPRMT,,RCMDTB] ;Read command
CALL CMDINI
DEFALT (NEXT) ;CR moves on to next message
SETZM KEYFRE ;Reset keyword buffer
CALL GETCMD
CALL (A)
JRST REDCLP ;Keep going
RNEXT: CONFRM
RNEX1: CALL UPDBIT ;Update message
CALL CHECK ;Check for new guys
CALLRET READ0
RQUIT: CONFRM
MOVEI B,7777
IDPB B,L ;Mark end of sequence
RQUIT0: CALL UPDBIT ;Update this message
MOVEI A,CMDRES
HRRM A,CMDRET
TXZ F,F%READ
MOVE P,READPP ;Restore stack to calling level
CALLRET CHECKT ;Check and return to top level
;;; Read mode previous command, determines the message from the history
RPREV: CONFRM
CALL UPDBIT ;Update file
SETO A, ;Back up previous sequence pointer
ADJBP A,PREVPT ;Note this ISN'T a 7-bit byte pointer
LDB B,A ;Get previous message number
CAIN B,7777 ;Backed up too far?
ERROR <Already at start of sequence>
MOVEM A,PREVPT ;No, update previous point
IMULI B,MSGLEN ;Convert to message index
MOVE M,B ;And set as current
CALLRET READ1 ;Return to READ code
;;;Sending subcommands
CONTI: NOISE (SENDING MESSAGE)
CONFRM
SKIPL SNDCAL
ERROR <There is no sending to continue>
SETZM LSTCHR ;Don't accidentally send it off
SETABT CMDABO ;Allow aborts to top-level
MOVEM P,SENDPP ;Save stack for SNDRET
SKIPL M.RPLY ;Continuing a reply?
MOVE M,M.RPLY ;Yes, insure we have the correct index!
CALLRET SEND1A ;Enter send mode, SNDCAL already set up
SEND: NOISE (MESSAGE TO)
SETABT CMDABO ;Allow aborts to top-level
CALL SNDIN0
CALL GETTO0 ;Get to: without prompting
HRRZ A,CMDRET ;Save where we came from
HRROM A,SNDCAL
MOVEM P,SENDPP ;Save stack for SNDRET
MOVEI A,SEND1A ;Enter SEND level here so error on CTRL/E
HRRM A,CMDRET ; leaves us at SEND level
SKIPN TOLIST
IFSKP.
CALL PRSCCL ;Add default lists
CALL GETMS1 ;Get message without cc or to
HRRZ A,SNDCAL ;Restore caller context
HRRM A,CMDRET
ELSE.
TXZ F,F%HOER ;User wants hand-holding, no more halt
CALL SNDIN0 ;Reset fields
CALL GETMSG ;Prompt for message
CALL PRSCCL ;Add default lists
HRRZ A,SNDCAL ;Restore caller context
HRRM A,CMDRET
ENDIF.
; CALLRET SEND0
;;;Here from several places to enter SEND level, possibly sending right away.
SEND0: MOVE A,LSTCHR ;Get last character
SKIPG ESCSND ;Escape sends automatically?
IFSKP.
CAIE A,.CHCND ;Yes, wants that?
CAIN A,.CHESC
JRST SSEND0 ;Yes, just send if off then
ELSE.
CAIE A,.CHCNZ ;No, got CTRL/Z?
ANSKP.
SKIPL ESCSND ;Yes, CTRL/Z sends automatically?
TXNE F,F%RSCN ;Or called in command line?
JRST SSEND0 ;Yes to either, send message
ENDIF.
SEND1: HRRZ A,CMDRET ;Save where we came from
HRROM A,SNDCAL ; flagging it is continuable
MOVEM P,SENDPP ;Save stack for SNDRET
;;;SEND1A is an alternative entry point if SNDCAL and SENDPP have been set up
SEND1A: MOVEI A,SNDRET ;Enter SEND level
HRRM A,CMDRET
TXO F,F%SEND
CALL ABNOFF ;Suppress CTRL/N but retain abort vector
SNDRET: MOVE P,SENDPP ;Reset stack
SNDLUP: TXZE F,F%ESND ;Editor said to send it?
JRST SSEND1 ;Yes, do that right away
MOVE A,[SEPRMT,,SCMDTB]
CALL CMDINI
SKIPE CRSEND ;Does bare CR send message?
DEFALT (SEND)
CALL GETCMD
CALL (A)
JRST SNDLUP
;;;Send off the message. Haven't yet entered SEND mode, do so now.
SSEND0: MOVEM P,SENDPP ;Save stack for SNDRET
HRRZ A,CMDRET ;Save where we came from
HRROM A,SNDCAL ; flagging it is continuable
MOVEI A,SNDRET ;Enter SEND level in case error
HRRM A,CMDRET
TXO F,F%SEND
CALL ABNOFF ;Suppress CTRL/N but retain abort vector
JRST SSEND1
SSEND: CONFRM
SSEND1: CALL SNDMSG ;Send it off
HRRZS SNDCAL ;Don't let user continue this one
SKIPGE M.RPLY ;Was this a reply we just sent?
IFSKP.
MOVE M,M.RPLY
MOVX A,M%RPLY ;Mark replying to this message
IORM A,MSGBTS(M)
CALL UPDBIT
ENDIF.
JXN F,F%RSCN,SQUI1 ;If called from command line then done
TXZ F,F%SEND ;Else, leave SEND (or REPLY) command
HRRZ A,SNDCAL ; (do same thing as SQUI1)
HRRM A,CMDRET
MOVE P,SENDPP
CALLRET CHECKT ;Now check for new messages
SQUIT: CONFRM
SQUI1: TXZ F,F%SEND ;Not in send command or a reply anymore
HRRZ A,SNDCAL ;Get where we entered from
HRRM A,CMDRET ;Set up to go back there
MOVE P,SENDPP ;Reset stack
RET ;And return to caller
SEDIT: DEFALT (TEXT)
MOVEI A,EDCMTB
CALLRET .ERAS2 ;Get field to edit
DELIV: NOISE (FOR THIS MESSAGE ARE)
MOVEI B,[FLDDB. .CMKEY,,DOPTTB]
CALL CMDFLD ;Get a keyword
HRRZ B,(B) ;Get keyword value
PUSH P,B ;Save value
CONFRM
POP P,DLVOPT ;Save delivery option
RET
DOPTTB: NQDOPS,,NQDOPS
DOPTAB: PHASE 0
[ASCIZ/MAIL/],,. ;Mail (MUST BE FIRST IN TABLE!!!!!!!!)
D%SAML:![ASCIZ/SAML/],,. ;Send and mail
[ASCIZ/SEND/],,. ;Send
D%SOML:![ASCIZ/SOML/],,. ;Send or mail
DEPHASE
NQDOPS=.-DOPTAB
AFTER: NOISE (DATE)
MOVEI B,[FLDDB. .CMTAD,,CM%IDA!CM%ITM,,,<[
FLDDB. .CMTAD,,CM%IDA,,,<[
FLDDB. .CMTAD,,CM%ITM]>]>]
CALL CMDFLD
PUSH P,B ;Remember date/time
CONFRM
POP P,AFTDAT ;Set date/time
RET
ERASE: NOISE (MESSAGE FIELD)
MOVEI A,ECMDTB
ERAS2: CALL SUBCMD
PUSH P,A
CONFRM
POP P,A
CALLRET (A)
DISPL: NOISE (MESSAGE FIELD)
DEFALT (ALL)
SETABT CMDABO ;Allow CTRL/N abort
MOVEI A,DCMDTB
CALLRET .ERAS2
REPLY: NOISE (TO)
REPLY0: MOVEI A,[ASCIZ/ALL/]
SKIPE RFMDEF
MOVEI A,[ASCIZ/SENDER/]
UDEF (A) ;Setup right default
MOVEI A,RPCMTB
CALL SUBCMD
PUSH P,A
MOVEI A,[ASCIZ/INCLUDING/]
SKIPN INSMSG
MOVEI A,[ASCIZ/NOT-INCLUDING/]
UDEF (A)
MOVEI A,RICMTB ;See if to include message text
CALL SUBCMD
HRREM A,MNSMSG ;Set insert message flag
NOISE (MESSAGE TEXT IN THE REPLY)
CONFRM
POP P,A
CALLRET (A)
RICMTB: NRICMS,,NRICMS
CMD INCLUDING,-1
CMD NOT-INCLUDING,0
NRICMS==.-RICMTB-1
REPAL: TXOA F,F%F3 ;Say reply to everyone
REPFM: TXZ F,F%F3 ;Say just reply to sender
REPL6: CALL SNDIN0 ;Erase drafts
MOVEM M,M.RPLY ;In reply mode
MOVEI T,[ASCIZ/
Date:/]
CALL FNDHDR
IFSKP.
SETZB B,C
IDTIM% ;Try to parse it
IFJER.
MOVE B,MSGDAT(M) ;Bad format, use recv date
ENDIF.
ENDIF.
MOVEM B,REPDAT ;Set up as reply date
CALL REPSUB ;Construct the subject
TXZ F,F%F1!F%F4!F%CC ;No Reply-To, barf on errors, put in To list
PUSH P,[0] ;Save default host name for PRTOCC
DO.
MOVEI T,[ASCIZ/
ReSent-Reply-To:/] ;This overrides all
CALL FNDHDR
IFNSK.
MOVEI T,[ASCIZ/
Reply-To:/] ;Look for overiding header
CALL FNDHDR
EXIT.
ENDIF.
TXO F,F%F1 ;Flag that we processed a Reply-To
SETZ E, ;No host name defaulting
CALL PRADDT ;Get the guy and add him in
JXE F,F%AT,ENDLP. ;Network address?
MOVE E,TOLIST ;Get default host
MOVE E,ADRHST(E)
MOVEM E,(P) ;Set it as default now just in case
ENDDO.
HRRZ V,MSGFRM(M) ;Handle From so we use host default
IFE. V ;Don't know who it's from?
CITYPE <%Can't tell who message is From>
CALL GETTO ;Ask him who it's to then...
ELSE.
CALL MCH2BP
SETZ E, ;No host name defaulting
TXNE F,F%F1 ;Doing Reply-To?
TXO F,F%F4 ;Yes, don't barf on errors here
CALL PRADDR ;Process the address
HRRZ U,FREETO ;Get block pointer returned by PRADDR
CAIN U,(W) ;Same as free pointer?
IFSKP.
SETZM (P) ;Set default to local host
ANDXN. F,F%AT ;Network address?
MOVE E,ADRHST(U) ;Yes, have new default
MOVEM E,(P) ;Set it as default now
ENDIF.
TXZN F,F%F1 ;Did we see a Reply-To just now?
CALL ADDTO ;No, add the address then
ENDIF.
MOVEI T,[ASCIZ/
To:/] ;Find start of addresses
TXZE F,F%F3 ;Wants reply to all addresses?
CALL FNDHDR
IFSKP.
MOVE E,(P) ;Get back default host address
CALL PRTOCC ;Get to and cc lists
MOVEI U,TOPAG+ADRSTR ;First recipient's name
MOVEI N,1 ;Allow only one occurance
CALL DOUNTO
MOVEI U,MAUSRS ;Remove me from the list
SETZ N, ;Allow 0 occurances
CALL DOUNTO
ENDIF.
POP P,E ;Recover stack
SKIPN RINCME ;Include me in replies?
IFSKP.
HRROI B,MAUSRS ;Yes, me
MOVE U,FREETO ;Get some free space
SETZM ADRFLG(U)
SETZM ADRLNK(U)
PUSH P,B
MOVEI A,ADRSTR(U)
HRLI A,(<POINT 7,>)
CALL MOVST0
MOVEI A,1(A) ;Point to next free word
MOVEI W,(A) ;Get new end of area
SUBI A,(U) ;Get length
STOR A,ADSIZ,(U) ;Store size field
POP P,B
MOVX A,RC%EMO ;Require an exact match
RCUSR%
MOVEM C,ADRUSR(U)
MOVEI T,CCLIST ;Add a cc from this string
CALL ADDTO0
SKIPL RINCME ;Want special cc to self?
ANSKP.
HLRZ B,CCLIST ;Yes, flag special user number for this file
SETOM ADRUSR(B)
ENDIF.
CALL PRSCCL ;Parse default bcc list here
HRRZ A,CMDRET ;Save where we came from
HRROM A,SNDCAL ; flagging it is continuable
MOVEM P,SENDPP ;Save stack for SNDRET
MOVEI A,SEND1A ;Enter SEND level if error
HRRM A,CMDRET
IFXN. F,F%DIRE ;From MMail Dired mode?
CALL .EDTXT ;Yes, go into edit right away
HRRZ A,SNDCAL ;Restore caller context
HRRM A,CMDRET
CALL SEND0
DMOVE A,[ASCIZ/Dired/]
DMOVEM A,BUFNAM
DMOVEM A,EDINAM
RET
ENDIF.
SKIPE MNSMSG ;Insert current msg text?
CALL FORMS2 ;Yes
SKIPE REPDIS ;Display reply at startup?
CALL .DSHDR ;Yes, do so
REPL7: CALL GETTXT ;Get text of reply
HRRZ A,SNDCAL ;Restore caller context
HRRM A,CMDRET
CALLRET SEND0 ;And go get more or send it off
;;;Add user headers
USHDR: SKIPN USRHTB ;Any user headers defined?
ERROR <No defined user headers>
MOVEI B,[FLDDB. .CMKEY,,USRHTB]
CALL CMDFLD ;Get a keyword
HLRZ U,(B) ;Save address of string
CALL GETLIN
CONFRM
CALL USHDRL ;New header line
MOVEI B,(U) ;Address of string
CALL USHDR1
MOVEI B,[ASCIZ/: /]
CALL USHDR1
MOVEI B,STRBUF ;And finally user's line
CALL USHDR1
DMOVEM D,USRHFP
IDPB C,D ;End with a null
RET
USHDRL: DMOVE D,USRHFP ;Get pointers so far
IFE. D
DMOVE D,[POINT 7,USRHDT
1-776*5]
RET ;First time out, init pointer
ENDIF.
MOVEI B,CRLF0 ;Else put in newline first
USHDR1: HRLI B,(<POINT 7,>) ;Copy a string and update count
DO.
ILDB C,B
JUMPE C,R
IDPB C,D
AOJL E,TOP.
ENDDO.
USHDRE: ERROR <String space exhausted>
;;;Save current message draft in a file
SSAVE: CALL GETOFI ;Get output file with no default
CONFRM
MOVE O,[POINT 7,HDRPAG]
MOVE A,[IDPB A,O]
MOVEM A,MOVDSP ;Set up to move into memory
SKIPN A,USRHDR ;Has any user headers?
IFSKP.
ILDB A,A ;Just header options?
ANDN. A ;Yes, go on to other header items
MOVE B,USRHDR ;Pointer to start of user headers
CALL MOVSB3 ;Go add that in
ENDIF.
TXO F,F%RELD ;Relative domains must be in
CALL MOVSB1 ;Insert subject
CALL MOVTO ;And To
CALL MOVCC ;And cc
CALL MOVREP ;And Reply-To
CALL MOVRDT ;And In-Reply-To
MOVEI B,[ASCIZ/
/]
CALL MOVSB2 ;And a couple blank lines
SETZ A,
IDPB A,O ;Mark end of this with a null too
MOVE A,OUTJFN
MOVX B,<<FLD 7,OF%BSZ>!OF%WR>
OPENF%
IFJER.
MOVE A,OUTJFN
JERROR <Can't open draft file "%1J">
ENDIF.
MOVE B,[POINT 7,HDRPAG,13]
SETZ C,
SOUT%
HRROI B,TXTPAG ;And put in text
SOUT%
CLOSFR: CLOSF%
NOP
SETZM OUTJFN
RET
;;;Restore saved message draft
RESTO: CALL .SREST ;Load it up
SKIPGE RSTMOD ;/SEND?
JRST SNDMSG ;Yes, just send it
SKIPE RSTMOD ;/COMMAND?
JRST SEND1 ;Yes, go to command mode right away
CALL .DSHDR ;Display what we brought back
SKIPE TXTPAG ;Is there text to the message?
IFSKP.
CALL GETTXT ;No, get text of reply
ELSE.
SETABT CMDABO ;Allow CTRL/N to abort back to toplevel
UTYPE [BYTE (7) 15,12,15,12,0]
HRRZ A,CMDRET ;Save where we came from
HRROM A,SNDCAL ; flagging it is continuable
MOVEM P,SENDPP ;Save stack for SNDRET
MOVEI A,SEND1A ;Enter SEND level if error
HRRM A,CMDRET
CALL .TEXT2 ;Typeout and get some more text
HRRZ A,SNDCAL ;Restore caller context
HRRM A,CMDRET
ENDIF.
CALLRET SEND0 ;And enter send mode
RSTLST: FLDDB. .CMCFM,,,,,<[FLDDB. .CMSWI,,RSTTAB]>
RSTTAB: RSTTBL,,RSTTBL
CMD COMMAND,1
CMD SEND,-1
CMD TEXT,0
RSTTBL==<.-RSTTAB>-1
SREST: NOISE (FROM FILE)
MOVEI B,[FLDDB. .CMIFI]
CALL CMDFLD ;Get the file
MOVEM B,TMPJFN
SETZM RSTMOD
MOVEI B,RSTLST
CALL CMDFLD
LOAD D,CM%FNC,(C)
CAIN D,.CMCFM ;Confirm?
JRST RESTO0 ;Yes
HRRE B,(B)
MOVEM B,RSTMOD
CONFRM
RESTO0: MOVE A,TMPJFN
MOVX B,<<FLD 7,OF%BSZ>!OF%RD>
OPENF%
IFJER.
MOVE A,TMPJFN
JERROR <Can't open draft file "%1J">
ENDIF.
CALL SNDIN0 ;Erase everything so far
MOVE A,TMPJFN
MOVEI C,5000
MOVEI D,.CHLFD ;Read a line at a time
MOVE B,[POINT 7,HDRPAG] ;Read the headers in
RESTO1: MOVE E,B ;Save the start of this line
SIN%
ERJMP .+1
ILDB T,E ;Get character at start of line
CAIE T,.CHCRT ;Blank line?
CAIN T,.CHLFD
TDZA T,T
JUMPN T,RESTO1
DPB T,E ;Make it end with a null anyway
SKIPA E,[POINT 7,HDRPAG]
RSTLUP: SKIPA E,B
RESTO2: MOVE B,E ;Get copy of pointer
MOVE C,[POINT 7,STRBUF]
SETZM STRBUF
SETZM STRBUF+1
RESTO3: ILDB T,B
JUMPE T,RSTTXT ;Done with headers
CAIE T,.CHCRT ;End of line before : is an error
CAIN T,.CHLFD
IFNSK.
MOVEI A,STRBUF
ERROR <%1S does not look like a header line>
ENDIF.
CAIL T,"a"
CAILE T,"z"
CAIA
SUBI T,"a"-"A" ;Make uppercase
IDPB T,C
CAIE T,":" ;End of the name of it?
JRST RESTO3
DMOVE C,STRBUF
CAME C,[ASCIZ/TO:/]
CAMN C,[ASCIZ/CC:/]
JRST RSTTO ;Parse a to or cc list
CAMN C,[ASCII /SUBJE/]
CAME D,[ASCIZ/CT:/]
JRST RSTRND ;Random line, insert as user option
DO.
ILDB T,B ;Flush whitespace
CAIE T,.CHSPC
CAIN T,.CHTAB
LOOP.
ENDDO.
MOVE C,[POINT 7,SUBBUF] ;Where the subject goes
IFN. T
DO.
CAIE T,.CHCRT
CAIN T,.CHLFD
EXIT.
IDPB T,C
ILDB T,B
JUMPN T,TOP.
ENDDO.
CAIN T,.CHCRT
IBP B ;Move over LF after CR
ENDIF.
MOVEI D,0
IDPB D,C
JUMPN T,RSTLUP
RSTTXT: CALL PRSCCL ;Add default lists
MOVE A,TMPJFN
RSTTX0: BIN%
JUMPE B,CLOSFR ;Eof, no text then
CAIE B,.CHCRT
CAIN B,.CHLFD
JRST RSTTX0 ;Flush CRLFs
BKJFN%
NOP
CALLRET INSFL3 ;And now insert the file as text
RSTRND: PUSH P,E ;Save current line
CALL USHDRL ;New header line
POP P,B ;Get line again
DO.
ILDB T,B
CAIE T,.CHCRT
CAIN T,.CHLFD
EXIT.
JUMPE T,ENDLP.
AOJGE E,USHDRE
IDPB T,D
LOOP.
ENDDO.
DMOVEM D,USRHFP ;Update pointers
CAIN T,.CHCRT
IBP B ;Move over LF after CR
MOVEI C,0
IDPB C,D
JUMPN T,RSTLUP
JRST RSTTXT
RSTTO: MOVE A,E ;Get start of line again
PUSH P,RCCOTH ;Don't change type of message
SETZB E,RCCOTH ;Assume default
CALL PRTOCC ;Parse to and cc lines
POP P,RCCOTH
MOVE E,A
DO.
LDB B,E ;Now back up to start of line that didn't match
CAIE B,.CHCRT
CAIN B,.CHLFD
JRST RESTO2
JUMPE B,RSTTXT
ADD E,[7B5]
SKIPGE E
SUB E,[43B5+1]
LOOP.
ENDDO.
;;;Move messages into files
COPY: SKIPA A,[PUTMSG]
MOVE: MOVEI A,MOVMSG
MOVEM A,DOMSG
TXNE F,F%READ ;In read command?
JRST .RCOP1 ;Yes
CALL GETOUT ;Get output file
CALL DFSQTH ;Get message sequence
MOVE A,OUTJFN
MOVX B,<<FLD 7,OF%BSZ>!OF%APP> ;Open for append
OPENF%
IFJER.
MOVE A,OUTJFN
JSNARL <Can't open "%1J"> ;Give error message
RLJFN%
NOP
SETZM OUTJFN
RET
ENDIF.
COPY1: CALL DELET1 ;Go handle the sequence
COPY2: SKIPL RINCME ;Special include me mode?
IFSKP.
HRROI A,SAVFIL ;Yes, update name of last moved file
MOVE B,OUTJFN
MOVE C,[111110,,JS%PAF]
JFNS%
ENDIF.
MOVE A,OUTJFN
CLOSF%
JERROR <Can't close output file>
SETZM OUTJFN
RET
RCOP1: CALL GETOUT ;Get output file
CONFRM
RCOPA: MOVE A,OUTJFN
MOVX B,<<FLD 7,OF%BSZ>!OF%APP> ;Open for append
OPENF%
IFJER.
MOVE A,OUTJFN
JSNARL <Can't open "%1J"> ;Give error message
RLJFN%
NOP
SETZM OUTJFN
RET
ENDIF.
RCOP2: CALL @DOMSG ;Process it
CALLRET .COPY2 ;And go close it up
LSWTAB: NLSWTB,,NLSWTB
CMD HEADERS-ONLY,HDONLY
CMD SEPARATE-PAGES,SEPPGS
NLSWTB==<.-LSWTAB>-1
FLIST: CALL GETOFI
JSP D,.LIST0 ;Do the work
NOP ;Command specific
LIST: SETZM OUTJFN ;Forget any old output file
JSP D,.LIST0 ;Do the work
NOISE (ON LISTING DEVICE) ;Command specific
LIST0: MOVEI A,LPTMSG
MOVEM A,DOMSG
SETZM HDONLY ;Default headers + msgs
SETZM SEPPGS ;Default no separate pgs
IFXN. F,F%READ
XCT 0(D) ;Do command specific inst. (NOISE, etc)
CONFRM
CALL GETLPT ;Open device
RET ;Failed
CALLRET .RCOP2 ;Now send that single message
ENDIF.
NOISE (OPTIONS)
MOVEI B,[FLDDB. .CMSWI,,LSWTAB,<message sequence
or optional LIST switch,>]
CALL $COMND
IFXE. A,CM%NOP ;Was a switch given?
HRRZ B,(B) ;Get flag to set
SETOM (B) ;And set it
ENDIF.
CALL DFSQTH ;Get sequence
CALL GETLPT ;Open device
RET ;He didn't really mean it
SKIPN LSTHDR ;Include headers in the list?
SKIPE HDONLY ;No, did user override with /HEADERS-ONLY?
IFSKP. <JRST .COPY1> ;No, just handle the sequence
MOVE A,[POINT 7,WRTPGS] ;Output file name identifier
MOVEI B,[ASCIZ/-- Messages from file: /]
CALL MOVSTR
MOVE B,MSGJFN
MOVE C,[111110,,JS%PAF]
JFNS%
MOVEI B,[ASCIZ/ --
/]
CALL MOVSTR
SETO B, ;Note date/time
MOVX C,OT%DAY!OT%FDY!OT%FMN!OT%4YR!OT%DAM!OT%SPA!OT%TMZ!OT%SCL
ODTIM%
MOVEI B,[ASCIZ/
/]
CALL MOVST0
MOVE A,OUTJFN ;Write it to the file
HRROI B,WRTPGS
SETZ C,
SOUT%
MOVE A,[POINT 12,PRVSEQ] ;Initialize previous sequence pointer
MOVEM A,PREVPT
TXO F,F%TYPS ;Say to print numbers of things done
LIST1: CALL NXTMSG ;Cycle through messages once
JRST .LIST2
MOVE A,PREVPT ;Paranoia check
CAMN A,[POINT 12,PRVSQZ-1,23] ;Reached end of list?
ERROR <Too many messages in list>
MOVEI A,(M) ;Get message index
IDIVI A,MSGLEN ;Convert to number
IDPB A,PREVPT
MOVE O,[POINT 7,WRTPGS]
CALL TYPHD0
MOVE A,OUTJFN
HRROI B,WRTPGS
SETZ C,
SOUT%
JRST .LIST1
LIST2: MOVEI A,7777 ;Tie off list
IDPB A,PREVPT
MOVE A,OUTJFN ;All done, put this on one page
HRROI B,CRLF0
SETZ C,
SOUT%
MOVX B,.CHFFD ;Form feed
BOUT%
SKIPE HDONLY ;Headers only?
IFSKP.
MOVE A,[POINT 12,PRVSEQ] ;Initialize previous sequence pointer
MOVEM A,PREVPT
DO.
MOVE A,M ;Save last message pointer
ILDB M,PREVPT ;Get message to output
CAIN M,7777 ;End of list?
IFSKP.
IMULI M,MSGLEN ;Convert to message index
CALL LPTMSG ;Output message on printer
LOOP. ;Get next message to output
ENDIF.
ENDDO.
MOVE M,A ;Done, get back M so current isn't 7777
ENDIF.
MOVE A,OUTJFN
CLOSF%
JERROR <Can't close output file>
SETZM OUTJFN
RET
RFORW: NOISE (MESSAGE TO)
CALL SNDIN0
CALL GETTO0 ;Get To: without prompting
JRST .FORW1 ;Join common code
FORWA: CALL DFSQTH ;Get message sequence, default to this
TXO F,F%TYPS ;Say to print numbers of things done
DO.
CALL NXTMSG ;Get next guy in list
ERROR <No messages to forward>
CALL CHKDEL ;Don't forward deleted msgs
LOOP.
ENDDO.
CALL SNDIN0 ;Reset message drafts
CALL GETTO ;Get recipients
FORW1: CALL PRSCCL ;Add default lists
CALL GETTXT ;Get initial comments
SETZB A,SUBBUF ;Init subject, get canonical pointer to text
ADJBP A,TXTPTR
CAMN A,[POINT 7,TXTPAG-1,34] ;Empty?
IFSKP.
LDB C,A ;Get last char
MOVEI B,CRLF0
CAIE C,.CHLFD ;Unless have crlf
CALL MOVSTR ;Put one in
MOVEI B,[ASCIZ/ ---------------
/]
CALL MOVSTR
MOVEM A,TXTPTR ;Update pointer
ENDIF.
IFXN. F,F%READ ;If in read
CALL FORMSG ;Forward current message
ELSE.
; Here in full command mode. First output a header list if more than 1.
SETZM NRECNT ;Zero msg counter
PUSH P,TXTPTR ;Save starting text ptr
MOVE A,[POINT 12,PRVSEQ] ;Initialize previous sequence pointer
MOVEM A,PREVPT
CALL CRIF ;CRLF first if needed
DO.
CALL CHKDEL ;Deleted?
IFSKP.
MOVE A,PREVPT ;Paranoia check
CAMN A,[POINT 12,PRVSQZ-1,23] ;Reached end of list?
ERROR <Too many messages in list>
MOVEI A,(M) ;Get message index
IDIVI A,MSGLEN ;Convert to number
IDPB A,PREVPT
MOVE A,TXTPTR ;Output msg #
AOS B,NRECNT
MOVX C,NO%LFL!NO%OOV!4B17!^D10
NOUT%
NOP
MOVEI B,")"
IDPB B,A
MOVEM A,TXTPTR ;Save the pointer
CALL FWDHDR ;Set up header string
MOVE A,TXTPTR ;Now add it to the text
MOVEI B,WRTPGS
CALL MOVSTR
MOVEM A,TXTPTR ;Save new ending ptr
ENDIF.
CALL NXTMSG ;Get next guy in list
EXIT. ;Done
LOOP. ;Do next message
ENDDO.
; Here we check on overwriting the headers if only 1 msg going
MOVEI A,7777 ;Tie off list
IDPB A,PREVPT
POP P,A ;Recover starting text ptr
MOVE B,NRECNT ;More than 1 msg?
CAILE B,1
IFSKP.
MOVEM A,TXTPTR ;No, overwrite headers
CALL FORMSG ;Just do the one
ELSE.
SETZM NRECNT ;And the msg counter
MOVE A,[POINT 12,PRVSEQ] ;Initialize previous sequence pointer
MOVEM A,PREVPT
DO.
MOVE A,M ;Save current sequence
ILDB M,PREVPT ;Get message to output
CAIN M,7777 ;End of list?
IFSKP.
IMULI M,MSGLEN ;No, convert to message index
MOVE A,TXTPTR ;Output msg #
MOVEI B,[ASCIZ/
Message /]
CALL MOVSTR
AOS B,NRECNT
MOVEI C,^D10
NOUT%
NOP
MOVEI B,[ASCIZ/ -- ************************
/]
CALL MOVSTR
MOVEM A,TXTPTR ;Save the pointer
CALL FORMSG ;Forward this one too
LOOP.
ENDIF.
ENDDO.
; Here the last forwarded msg has been copied
MOVE M,A ;Restore current message so not 7777
ENDIF.
ENDIF.
MOVE A,TXTPTR
SETZ B, ;Finish with null
IDPB B,A
CALLRET SEND0 ;Maybe send it off or get more
;;;Remail a message to someone
RREMA: NOISE (MESSAGE TO)
CALL SNDIN0
CALL GETTO0 ;Get To: without prompting
JRST RMLMSG ;Join common code
REMAI: CALL DFSQTH ;Get a sequence and default it
CALL SNDIN0 ;Erase the message draft
CALL GETTO ;Get the to: list
MOVEI A,RMLMSG
CALLRET DOMSGS ;Handle list of messages
SYSTE: CONFRM
SYSTE1: MOVX A,GJ%OLD!GJ%SHT!GJ%ACC
MOVEI B,[ASCIZ/SYSTEM/]
CALL GETMFL
ERROR <No system message file>
PUSH P,A ;Save JFN
TXO F,F%MOD!F%RONL ;Flag for doing system mail
TXZ F,F%F1 ;Not the examine command
CALLRET GETF1
;;; BBoard command and facility
BBOAR: MOVSI A,[GJ%OLD!GJ%XTN+1
.-.
-1,,MLBXDV
-1,,BBDIR
-1,,MLBXNM
-1,,MLBXEX
0
0
0
0
0
0
0
0
0] ;.GJATR
HRRI A,CMDGTB ;Initialize GTJFN% block
BLT A,CMDGTB+.GJATR
MOVEI B,[FLDDF. .CMKEY,,BBDTAB,<bulletin board mailbox,>,DEFBBD,<[
FLDDB. .CMFIL]>]
CALL $COMND ; "MAIL.TXT.1" default
IFXN. A,CM%NOP ;Was a file name recognized?
HLLZS CMDGTB+.GJGEN ;No, toss away generation 1 default
SETZM CMDGTB+.GJDEV ;Toss all defaults
SETZM CMDGTB+.GJDIR
SETZM CMDGTB+.GJNAM ;Toss away "MAIL" default
SETZM CMDGTB+.GJEXT ;Toss away "TXT" default
MOVEI B,[FLDDF. .CMKEY,,BBDTAB,<bulletin board mailbox,>,DEFBBD,<[
FLDDB. .CMFIL]>]
CALL CMDFLD ;No defaults
ENDIF.
PUSH P,B ;Save data
LOAD T,CM%FNC,(C) ;Get field type parsed
MOVEI B,CNFCMD ;Have user confirm this command
CALL $COMND
IFXN. A,CM%NOP ;Okay?
POP P,A ;No, release JFN
CAIN T,.CMFIL ;If it was a JFN...
RLJFN%
NOP
JERROR ;And go away
ENDIF.
TXO F,F%BB!F%F1 ;BBoard time, F%F1 signals RONLY later
CAIN T,.CMFIL ;File spec?
JRST GETFA ;Join get/exam code with JFN pushed
MOVE A,[POINT 7,STRBUF] ;Construct bulletin board name
MOVEI B,MLBXDV ;Start with device
CALL MOVSTR
MOVX B,":"
IDPB B,A
MOVX B,.CHLAB
IDPB B,A
MOVEI B,BBDIR
CALL MOVSTR
MOVX B,"*"
IDPB B,A
MOVX B,.CHRAB
IDPB B,A
POP P,D ;Pop index to BBoard table
HLRO B,0(D)
SOUT%
MOVX B,"."
BOUT%
HRROI B,MLBXEX
SOUT% ;Tie off with null
IDPB C,A
MOVX A,GJ%OLD!GJ%SHT!GJ%ACC!GJ%IFG
HRROI B,STRBUF
GTJFN%
IFJER.
MOVX A,GJ%OLD!GJ%SHT!GJ%ACC!GJ%DEL!GJ%IFG ;Maybe deleted?
HRROI B,STRBUF ;Same file name
GTJFN% ;Is it there now?
JERROR <No BBoard message file>
RLJFN% ;Yeah, don't want it
NOP ;Shouldn't fail
ERROR <Empty BBoard message file>
ENDIF.
HRRZS A ;Flush flags
PUSH P,A ;Save JFN, and
JRST GETFA ;Join get/exam code
DAYTI: CONFRM
MOVX A,.PRIOU
SETOB B,C
ODTIM% ;Give us ye old daytime
RET
ALIAS: STKVAR <<ACCBLK,<.ACJOB+1>>,ACCDIR>
MOVE A,[FLDDB. .CMUSR] ;Parse user name
MOVEM A,CMDFLB
UDEF MUSRST ;Default to login user name
MOVEI B,CMDFLB
CALL CMDFLD
MOVEM B,ACCDIR ;Remember directory number
CONFRM
TXZN F,F%ALIA ;Already accessing a directory?
IFSKP.
MOVX A,AC%REM!.ACJOB+1 ;Remove access of what's in blk
MOVEI B,ACCBLK
ACCES%
ERJMP .+1
ENDIF.
SETZ A, ;No flags
MOVE B,ACCDIR ;Pick up required user to access
RCDIR% ;Convert to directory number
MOVEM C,.ACDIR+ACCBLK
SETZM .ACPSW+ACCBLK ;First try without password
SETOM .ACJOB+ACCBLK
DO.
MOVX A,AC%OWN!.ACJOB+1 ;ACCESS and not CONNECT
MOVEI B,ACCBLK ;Try the access
ACCES%
IFJER.
MOVX A,.FHSLF ;Failed, see if need a psw
GETER%
HRRZS B
CAIE B,ACESX3
ERROR <Unable to access user directory because: %2E>
CALL GETPSW ;Get a password
HRROI B,STRBUF ;Try again with the password
MOVEM B,.ACPSW+ACCBLK
LOOP.
ENDIF.
ENDDO.
HRROI A,[ASCIZ//] ;Only do this once
RSCAN%
NOP
MOVE B,ACCDIR
CALL UNTAKE ;Cancel any pending TAKE file
CAMN B,MYUSR ;Aliased to self?
TDZA F,F ;Yes, clear all flags
MOVX F,F%ALIA ;Else clear all flags except ALIAS flag
CALL SETUSR
SKIPLE MSGJFN ;Do we presently have a file?
CALL UNMAPF ;Yes, unmap file
SETZM LASTM ;No more messages
CALL CLOSEF ;Release old cruft if present
CALL CLOSEI ;Old index if present as well
CALL KILED0 ;Kill editor too
MOVE P,[IOWD NPDL,PDL] ;Reset stack
CALLRET GOINIT ;Reenter MM doing init file, etc.
ENDSV.
;;;Set user number in B as login user name
SETUSR: HRROI A,MAUSRS ;Temp name for speed
MOVEM B,MYAUSR ;Set up alias user number
DIRST%
NOP
MOVE A,[POINT 7,MBXFIL]
MOVEI B,MLBXFN ;Make mailbox string
CALLRET MKPSTR
; Routine to fetch a password string
; Call: CALL GETPSW
; Return: +1, string in STRBUF
GETPSW: PROMPT <Password: >
MOVX A,.PRIIN ;Get current TTY mode
RFMOD%
PUSH P,B ;Save for later
TXZ B,TT%ECO!TT%ECM ;Kill echo
TXO B,TT%LIC ;Raise input
SFMOD%
STPAR%
CALL GETLNC ;Get password string
CALL CRLF ;Echo a CRLF
MOVX A,.PRIIN ;Restore echo
POP P,B
SFMOD%
STPAR%
RET
;;;Give user help
HELP: NOISE (ON TOPIC)
DEFALT (GENERAL)
MOVEI A,H1CMDT ;Otherwise, help for top-level
TXNE F,F%READ ;In read command?
MOVEI A,H1RCMD
TXNE F,F%SEND ;In send command?
MOVEI A,H1SCMD
CALL SUBCMD
HLRZ B,(A) ;Code (LH.NE.0) or a string adr?
JUMPN B,(A) ;Datum is code, go do it
PUSH P,A
CONFRM
POP P,A
SETABT CMDABO ;Allow CTRL/N aborting
MOVE B,(A) ;Pick up string
HRROI A,(B)
PSOUT%
RET
; HELP for SET command
HSET:: MOVEI B,[FLDDB. .CMKEY,,INIVTB,,,<[FLDDB. .CMCFM]>]
CALL CMDFLD
LOAD C,CM%FNC,(C) ;Get the type parsed
CAIE C,.CMCFM ;HELP SET <RETURN>?
IFSKP.
HRROI A,.HSETM ;Yes, output default msg
PSOUT%
RET
ENDIF.
PUSH P,B ;Stash the help address for now
CONFRM ;Confirm command
POP P,U ;Restore help pointer
SETABT CMDABO ;Allow CTRL/N aborting
MOVX A,.PRIOU ;Set up output for CRISHW
MOVEM A,TMPJFN
HRRZ A,(U) ;Ptr to TBLUK% data
HLRZ A,(A) ;Ptr to user data [INIDTA,,HLPMSG]
HRRO A,(A) ;Pick up as string pointer
PSOUT% ;Output help
HRROI A,[ASCIZ/
This variable is currently set to:
/]
PSOUT%
CALLRET CRISHW ;And go print current value for user
; General help
GENER::CONFRM
HRROI B,[ASCIZ/HLP:MM.HLP/]
MOVX A,GJ%OLD!GJ%SHT
GTJFN%
JERROR <No help available>
MOVEM A,TMPJFN
MOVX B,<<FLD 7,OF%BSZ>!OF%RD>
OPENF%
IFJER.
JWARN <Can't open help file>
ELSE.
DO.
MOVE A,TMPJFN
BIN%
IFNJE.
MOVX A,.PRIOU
BOUT%
LOOP.
ENDIF.
ENDDO.
ENDIF.
CLSTMP: SKIPLE A,TMPJFN
CALL $CLOSF
SETOM TMPJFN
RET
ECHO: NOISE (TO THE TERMINAL)
CALL GETLIN ;Get line from user
CONFRM
HRROI A,STRBUF ;Echo the input line
PSOUT%
RET
ENABL: NOISE (CAPABILITIES)
CONFRM
TXZE F,F%RONL ;This may let us mung a file
CALL LCKFIL ;Lock the file
MOVX A,.FHSLF
SETO C,
EPCAP%
RET
LCKFIL: MOVX A,EN%SHR!EN%BLN ;Shared access, no level #'s
HRR A,MSGJFN ;This file
MOVEM A,ENQBLK+.ENQLV
DO.
DMOVE A,[.ENQAA ;Try and get lock, but don't wait
ENQBLK]
ENQ%
IFJER.
WARN <File is locked, waiting...>
MOVEI A,^D5000 ;Wait a bit
DISMS%
LOOP. ;Now try again
ENDIF.
ENDDO.
RET
DISAB: NOISE (CAPABILITIES)
CONFRM
TXOE F,F%RONL ;Don't allow any more file munging
IFSKP.
DMOVE A,[.DEQID ;Get rid of any locks we got
REQID]
DEQ%
ERJMP .+1 ;Ignore failure
ENDIF.
MOVX A,.FHSLF
RPCAP%
TXZ C,.RHALF
EPCAP%
RET
QUIT: CONFRM
QUIT0: CALL UNMAPF ;Unmap old file
SKIPG MSGJFN ;Have a JFN?
IFSKP.
DMOVE A,[.DEQID ;Yes, get rid of any locks we got
REQID]
DEQ%
ERJMP .+1 ;Ignore failure
MOVE A,MSGJFN
CALL $CLOSK
ENDIF.
CALL CLOSF1
HALTF% ;Quit back to the EXEC
SKIPG A,MSGJFN ;If we have JFN
RET
PUSH P,M ;Save current message number
PUSH P,LASTM ;And total number of messages
PUSH P,LASTRD ;And original read date
TXO F,F%AMOD ;Hack to not print stuff
TXNN F,F%MOD ;Reading system mail?
TXNN F,F%RONL ;No, is file read-only?
TXZA F,F%F1 ;System mail or not read only
TXO F,F%F1 ;Read only, don't update dates
CALL GETF3 ;Get file back
TXZ F,F%AMOD ;Undo mischief
POP P,LASTRD ;Restore first read date
CALL RECEN2 ;Remark recent msgs
POP P,A ;Get former last message
POP P,M ;And current message
CALLRET CHECKN ;Print any new messages
;;;List of recipients of bug reports for this version of MM
BUGLST: ASCIZ/Bug-MM/
BUG: CONFRM
CALL SNDINI ;Setup for sending a message
MOVE A,[POINT 7,BUGLST] ;Process list of bug report recipients
SETZ E, ;Set the folks up
TXZ F,F%CC ;As to recipients
TXO F,F%F4 ;Ignore error in setup
CALL PRADDT ;Process the list
SKIPE TOLIST ;Could we parse any of them?
IFSKP.
MOVE A,[POINT 7,[ASCIZ/Operator/]] ;Use OPERATOR as last resort
SETZ E, ;Set up
TXZ F,F%CC!F%F4 ;As to recipients
CALL PRADDT ;Process the list
ENDIF.
MOVE A,[POINT 7,SUBBUF]
MOVEI B,[ASCIZ/Bug in/]
CALL MOVSTR ;Setup default subject for this
PUSH P,A
CALL GETVER ;Tell what version is buggy
POP P,A
MOVEI B,STRBUF
CALL MOVST0
CITYPE < Please enter your MM comments or suggestions.
>
HRRZ A,CMDRET ;Save where we came from
HRROM A,SNDCAL ; flagging it is continuable
MOVEM P,SENDPP ;Save stack for SNDRET
MOVEI A,SEND1A ;Enter SEND level if error
HRRM A,CMDRET
CALL GETTXT ;Get text of reply
HRRZ A,SNDCAL ;Restore caller context
HRRM A,CMDRET
CALLRET SEND0 ;And go get more or send it off
VERSI: CONFRM
VERS1: HRRO A,LCLHST ;Output local host name
PSOUT%
CALL GETVER
UTYPE STRBUF
RET
SET: NOISE (VARIABLE)
MOVEI B,[FLDDB. .CMKEY,,INIVTB]
CALL CMDFLD ;Get the name of the variable
HRRZ T,(B)
HLRZ N,(T) ;N points to [INIDTA,,HLPMSG]
HRR T,(T) ;Get pointer to variable
HLL T,(N) ;Get data
NOISE (TO)
HLRE N,T ;Get length of string
JUMPE N,.VROCT ;Not a string, get an octal number
CAIN N,INIDEC ;Want decimal number?
JRST .VRDEC ;Yes
CALL GETLIN ;Read a line
CONFRM
IFG. N
MOVEI U,(T) ;Do routine if specified
MOVE T,[POINT 7,STRBUF]
JRST (N)
ENDIF.
MOVE B,[POINT 7,STRBUF] ;Trim the trailing white space
CALL TRMTW
HRROI A,(T) ;Where it goes
HRLI A,440700
MOVE B,[POINT 7,STRBUF]
MOVM D,N
; CALLRET STRCPY
;;;Copy a string, source in B, destination in A, length in D
STRCPY: STKVAR <DSTPTR>
MOVEM A,DSTPTR ;Save destination ptr in case overflow
DO.
ILDB C,B ;Copy the string
IDPB C,A
SKIPE C
SOJGE D,TOP.
ENDDO.
CALL TRMSTR ;Clear last word of string
JUMPGE D,R ;Okay if no overflow
SETZ C, ;Tie off string (for 1 out of 5 case)
DPB C,A
MOVE C,DSTPTR
WARN <String truncated to "%3S">
RET
ENDSV.
;;;Fetch a decimal or octal number
VRDEC: SKIPA B,[[FLDDB. .CMNUM,,^D10]]
VROCT: MOVEI B,[FLDDB. .CMNUM,,^D8]
CALL CMDFLD
PUSH P,B
CONFRM
POP P,(T)
RET
;;;Trim trailing white space from string
TRMTW: ILDB C,B ;Find next occurrence
CAIE C,.CHSPC ; of white space
CAIN C,.CHTAB
JRST TRMTW1
JUMPN C,TRMTW ;Keep looking til end-of-string
RET
TRMTW1: MOVE A,B ;Remember where white begins
ILDB C,B ;Follow white space
CAIE C,.CHSPC ; as far as it goes
CAIN C,.CHTAB
JRST .-3
JUMPN C,TRMTW ;End-of-string?
DPB C,A ;Yes, terminate where white began
TRMSTR: HLRZ B,A ;Get pointer info
LSH B,-^D12 ;Reduce to position
SETO C, ;Initial mask
LSHC B,(B) ;Shift mask to bits to keep
ANDM C,0(A) ;Apply to last word of string
RET
FROM: NOISE (NAME)
CALL GETLIN ;Get line from user
CONFRM
MOVSI A,774000 ;If there was no text entered,
TDNE A,STRBUF ; then consider 'from self'
IFSKP.
SETZM FRMSCM ;Special indication of from self
SETZM REPSCM ;Don't need Reply-To: set up
TXNE F,F%READ!F%SEND ;If top-level command
RET
SETZM FRMSAM ;Make it apply for all subsequent msgs
SETZM REPSAM
RET
ENDIF.
MOVE B,[POINT 7,STRBUF] ;Trim trailing white space
CALL TRMTW
DMOVE A,[POINT 7,FRMSCM ;Keep from field string here
POINT 7,STRBUF]
MOVEI D,FRMSTL
CALL STRCPY ;Copy the string
IFXE. F,F%READ!F%SEND ;If top-level command
MOVE A,[POINT 7,FRMSAM] ;Make it apply for all subsequent msgs
HRROI B,FRMSCM
CALL MOVST0
ENDIF.
REPT1: MOVE A,[POINT 7,REPSCM] ;Set up default Reply-To string here
MOVEI B,MAUSRS ;My name
CALL MOVSTR ;Put it in
MOVE O,A ;Set up string pointer for MOVDSP
MOVE A,[IDPB A,O] ;Set up output to memory
MOVEM A,MOVDSP
TXZ F,F%QUOT!F%RELD ;Don't quote it
CALL MOVMHN ;Put in @SITE
SETZ A, ;Tie off string
IDPB A,O
TXNE F,F%READ!F%SEND ;If top-level command
RET
MOVE A,[POINT 7,REPSAM] ;Similarly for the Reply-to field
HRROI B,REPSCM
CALLRET MOVST0
REPTO: NOISE (ADDRESS)
CALL GETLIN ;Get line from user
CONFRM
MOVSI A,774000 ;If there was no text entered,
TDNE A,STRBUF ; then consider 'from self'
IFSKP.
SKIPE FRMSCM ;Is there a user-specified From?
JRST .REPT1
SETZM REPSCM ;Don't need Reply-To: set up
TXNN F,F%READ!F%SEND ;If top-level command
SETZM REPSAM ;Make it apply for all subsequent msgs
RET
ENDIF.
MOVE B,[POINT 7,STRBUF] ;Trim trailing white space
CALL TRMTW
DMOVE A,[POINT 7,REPSCM ;Keep from field string here
POINT 7,STRBUF]
MOVEI D,FRMSTL
CALL STRCPY ;Copy the string
TXNE F,F%READ!F%SEND ;If top-level command
RET
MOVE A,[POINT 7,REPSAM] ;Make it apply for all subsequent msgs
HRROI B,REPSCM
CALLRET MOVST0
SORT: NOISE (CHRONOLOGICALLY)
CALL DFSQAL ;Get sequence, default to all
TXO F,F%TYPS ;Print numbers of msgs done
CALL INISRT ;Initialize sorting stuff
MOVEI A,SRTMSG ;Go sort selected msgs
CALL DOMSGS
CALL PSTSRT ;Organize sorted msgs
SKIPE NSORTD ;Anything sorted?
CALLRET CPYSRT ;Yes, copy sorted file
RET
SUBTTL Command subroutines
RFLAG: CONFRM
FLGMSG: MOVX A,M%ATTN ;Flag message
IORM A,MSGBTS(M)
CALLRET UPDBIT
RKILL: CONFRM ;Confirm first
CALL DELMSG ;Delete message
CALLRET .RNEX1 ;Go to next message
RMARK: CONFRM ;Confirm first
CALLRET MRKMSG ;Now mark as seen
RDELM: CONFRM ;Confirm first
DELMSG: SKIPA A,[M%DELE] ;Mark as deleted
MRKMSG: MOVX A,M%SEEN ;Mark as seen
PUSH P,A ;Save bits
MOVE A,MSGDAT(M) ;Get date of message
IFXN. F,F%BB ;Playing with BBoards?
CAMLE A,BBXDAT ;Later than last one written?
CALL SXDAT ;Set it into index file
ENDIF.
POP P,A ;Restore bits
IORM A,MSGBTS(M)
CALLRET UPDBIT ;Go update the message bits, maybe
RUFLG: CONFRM
UFLMSG: MOVX A,M%ATTN ;Unflag message
CALLRET CLRBIT
RUNAN: CONFRM
UANMSG: MOVX A,M%RPLY ;Unanswer message
CALLRET CLRBIT
RUMRK: CONFRM
CALLRET UMKMSG ;Go mark as unseen
RUDLM: CONFRM
UNDMSG: SKIPA A,[M%DELE] ;Mark as undeleted
UMKMSG: MOVX A,M%SEEN ;Mark as unseen
CLRBIT: ANDCAM A,MSGBTS(M)
CALLRET UPDBIT ;Go update the message bits, maybe
RUKYW: CALL GETKEY ;Remove keywords
MOVEM U,KEYBTM ;Save keyflag mask bits
MOVEM V,KEYLPM ;and keyword list
CONFRM
UNKMSG: MOVE A,KEYBTM
CALL CLRBIT ;Clear keyflags
SKIPE A,KEYLPM
CALL KWDEL ;Delete keywords
RET
RKEYW: CALL GETKEY ;Add keywords
MOVEM U,KEYBTM ;Save keyflag mask bits
MOVEM V,KEYLPM ; and keyword list
CONFRM
KEYMSG: MOVE A,KEYBTM ;Set keyflags
IORM A,MSGBTS(M)
CALL UPDBIT ;Go update the message bits
SKIPE A,KEYLPM
CALL KWADD ;Add keywords
RET
;;; Get an output file, defaulting to the SAVED-MESSAGES-FILE file if known,
;;; giving it the NEW-FILE-PROTECTION protection. GETOFI doesn't have the
;;; SAVED-MESSAGES-FILE default, although it still defaults the protection.
GETOUT: SETZM CMDGTB+.GJGEN ;Default to highest generation
MOVEI B,[FLDDF. .CMFIL,CM%SDH,,output filespec,SAVFIL]
TXNE F,F%BB
MOVEI B,[FLDDF. .CMFIL,CM%SDH,,output filespec,MBXFIL]
JRST GETOU2 ;Join common code
GETOFI: MOVX A,.GJNHG ;Use next higher generation
MOVEM A,CMDGTB+.GJGEN
GETOU0: MOVEI B,[FLDDB. .CMFIL,CM%SDH,,output filespec]
GETOU2: PUSH P,B ;Save block we selected
SKIPLE A,OUTJFN ;Flush old output JFN
CLOSF%
ERJMP .+1
NOISE (INTO FILE) ;Get an output file
SETZM CMDGTB+.GJSRC ;Get space for GTJFN%
MOVE A,[CMDGTB+.GJSRC,,CMDGTB+.GJSRC+1]
BLT A,CMDGTB+.GJATR
SKIPN B,DEFPRO ;Have default protection?
IFSKP.
HRROI A,DEFPST ;Where to put string
MOVEM A,CMDGTB+.GJPRO ;Set up pointer to default
MOVE C,[6,,^D8] ;Columns,,radix
NOUT%
JERROR <New file protection error>
ENDIF.
POP P,B ;Get back block user specified
CALL CMDFLD ;Get the file
MOVEM B,OUTJFN ;Save it
RET
GETLPT: SKIPLE A,OUTJFN
IFSKP.
SKIPE LPTCFM
IFSKP.
PROMPT <Do you really want to output to the lineprinter? >
CALL YESNO1
IFNSK.
TMSG <
Use the TYPE command to type a message on your terminal. Use
the FILE-LIST command to list a message to a file, or the COPY
command if you want to write the file in mail file format.
>
RET
ENDIF.
ENDIF.
MOVX A,GJ%FOU!GJ%SHT
HRROI B,LSTDEV
GTJFN%
JERROR <Can't get listing device>
ENDIF.
MOVEM A,OUTJFN
MOVX B,<<FLD 7,OF%BSZ>!OF%WR>
OPENF%
IFJER.
MOVE A,OUTJFN
SETZM OUTJFN
JERROR <Can't open listing device "%1J">
ENDIF.
RETSKP
LPTMSG: MOVE A,OUTJFN ;Print msg number separator
HRROI B,[ASCIZ/
Message /]
SETZ C,
SOUT%
MOVEI B,0(M)
IDIVI B,MSGLEN
ADDI B,1
MOVEI C,^D10
NOUT%
NOP ;???
HRROI B,[ASCIZ/ -- ************************
/]
SETZ C,
SOUT%
CALL PUTMS1 ;Output the message
SKIPN LSTPAG ;Always separate pages?
SKIPE SEPPGS ;No, want it this time?
CAIA ;Yes
RET ;No, done
HRROI B,[BYTE (7) .CHCRT,.CHLFD,.CHFFD,.CHCRT,.CHLFD]
MOVNI C,5
SOUT%
RET
PUTMSG: CALL CHKDEL ;Not deleted msgs
RET
PUTMS1: MOVE V,MSGALL(M) ;Get start of the message
CALL CHR2BP
MOVE B,A
MOVN C,MSGSAL(M) ;Length
MOVE A,OUTJFN ;Where it goes
SOUT% ;That's it
RET
;;; Make up the correct subject for a reply to the current message
REPSUB: SKIPN A,MSGSUB(M)
RET ;No subject
MOVE B,[POINT 7,STRBUF]
CALL FORMSS ;Move it to temp space
SETZ D,
IDPB D,B ;And a null
MOVE A,STRBUF ;Get start of it
ANDCM A,[<BYTE (7) 40,40,0,0,177>+1];Uppercase and clear last byte
CAMN A,[ASCIZ/RE: /] ;Already a response?
IFSKP.
MOVE A,[ASCIZ/Re: /]
MOVEM A,SUBBUF ;Start subject off right
MOVE A,[POINT 7,SUBBUF,27] ;Start going into last byte
ELSE.
MOVE A,[POINT 7,SUBBUF] ;Start at start of subject
ENDIF.
MOVEI B,STRBUF ;From here
CALLRET MOVST0 ;Move it and the null
MOVMSG: CALL PUTMSG ;Move the message
CALLRET DELMSG ;And delete it afterwards
;;; Forward the current message
FORMSG: SKIPE A,MSGFRM(M) ;Has an author?
SKIPE SUBBUF ;Yes, need subject?
IFSKP.
MOVE B,[POINT 7,SUBBUF]
MOVEI C,"["
IDPB C,B
CALL FORMSS
MOVEI C,":"
IDPB C,B
SKIPN A,MSGSUB(M)
IFSKP.
MOVX C,.CHSPC
IDPB C,B
CALL FORMSS
ENDIF.
MOVEI C,"]"
IDPB C,B
SETZ C,
IDPB C,B
ENDIF.
FORMS2: MOVE A,MSGBOD(M) ;Body of the message
MOVE B,TXTPTR
CALL FORMSN
MOVEM B,TXTPTR
RET
;;;Output the portion of the message pointed to by A into byte pointer in B,
;;;suppressing leading white space.
FORMSS: HLRZ C,A
JUMPE C,R ;None to do
MOVEI V,(A) ;Get byte offset of field
CALL MCH2BP ;Get byte pointer to it
FRMSS1: ILDB D,A ;Get char
JUMPE D,FRMSS2 ;Never put in a null
CAIE D,.CHTAB ;Ignore whitespace
CAIN D,.CHSPC
FRMSS2: SOJG C,FRMSS1
JUMPE C,R ;Nothing to do
JRST FRMSN2 ;Join code in FORMSN
;;;Similar, but without whitespace suppression
FORMSN: HRRZ C,B ;Get address of text
CAIL C,TXTPAG+<1000*NTXPGS>-100 ;See if cutting it too close
ERROR <Too much text to forward> ;Loser
HLRZ C,A
JUMPE C,R ;None to do
MOVEI V,(A) ;Get byte offset of field
CALL MCH2BP ;Get byte pointer to it
FRMSN1: ILDB D,A
FRMSN2: SKIPE D ;Never put in a null
IDPB D,B
SOJG C,FRMSN1
RET
;;;Remail a single message
RMLMSG: CALL .ERSTX ;Erase vestiges of previous REMAIL
HRRZ V,MSGBOD(M) ;Get pointer to message body
CALL MCH2BP
HLRZ C,MSGBOD(M) ;Length of it
MOVE B,[POINT 7,HDRPAG] ;Start of some headers
MOVEI E,.CHLFD ;Start at new line
RMLMS1: SOJL C,[ERROR <Badly formatted message>]
ILDB D,A ;Get character
IDPB D,B ;Stick it in
EXCH D,E
CAIN E,.CHCRT ;This char a CR?
CAIE D,.CHLFD ;And previous LF
JRST RMLMS1 ;No, continue
ADD B,[7B5]
MOVEM B,RMLPTR ;This is the pointer to end of headers
SOJL C,RMLMS2 ;If there is more text
IBP A ;Move over the LF
MOVE B,TXTPTR ;Move the rest of it into text
CALL FRMSN1
MOVEM B,TXTPTR ;Update text pointer
IDPB C,B ;Make sure it ends with a null
RMLMS2: CALLRET SNDMSG ;Go send the message off
;;;Replace current message
RPLMSG: SAVEAC <A,C,M>
STKVAR <RPLPTR,RPLCNT,RPLPGO,RPLCPG,RPLDPG,RPLPGC,CURMSG>
MOVEM A,RPLPTR ;Save byte pointer
MOVEM C,RPLCNT ;And byte count
MOVEM M,CURMSG ;And current message
CALL GETJF2 ;Get a write JFN
RET ;Failed
CALL ABNOFF ;No aborts
NOINT ;No outside diddling
MOVEM A,OUTJFN ;Save it here as well
MOVE B,MSGALL(M) ;Get start of whole message
IDIVI B,5000 ;Round down to start of page
MOVEM C,RPLPGO ;Save remainder
IMULI B,5000 ;Set to start of page
SFPTR%
IFJER.
CALL CLSJF2 ;Clean up file (or what's left)
OKINT ;CTRL/C OK now
JSNARL ;Output error
RET
ENDIF.
MOVE V,MSGALL(M)
CALL CHR2BP ;Get byte pointer to message
MOVE E,A ;Save it
ANDI A,777000 ;Get page number of start
MOVEM A,RPLCPG ;Save start of core page
MOVEI B,-MTXPAG(A) ;Get page offset
LSH B,-9
MOVEM B,RPLDPG ;Save starting disk page
HRRZ C,FILPGS ;Get number of pages in the file
SUBI C,(B) ;Less where we started
MOVEM C,RPLPGC ;Save count
DO.
MOVES (A) ;Make all pages after that private
ADDI A,1000
SOJG C,TOP.
ENDDO.
;;;Remove the old pages from the file
SETO A, ;Remove these pages from file
MOVE B,RPLDPG ;Starting page
HRL B,MSGJF2 ;JFN
MOVE C,RPLPGC ;Count
TXO C,PM%CNT
PMAP% ;Kill the old copies from file
ERJMP .+1
;;;Copy from start of first page up to message we are concerned with
HRRZ A,MSGJF2 ;Get write JFN again
HRRO B,RPLCPG ;Start of first page
MOVN C,RPLPGO ;Negate: use exact count
SKIPE C ;Forget if count=0
SOUT% ;Copy to file
;;;Now put out revised message
DO.
ILDB B,E ;Get character
BOUT%
CAIE B,"," ;Until start of byte count
LOOP.
ENDDO.
MOVE B,RPLCNT ;New byte count
MOVEI C,^D10
NOUT%
IFJER.
CALL CLSJF2 ;Clean up file (or what's left)
OKINT ;CTRL/C OK now
JSNARL
RET
ENDIF.
DO.
ILDB B,E
CAIE B,";" ;Now look for start of message bits
LOOP.
ENDDO.
DO.
BOUT%
ILDB B,E
CAIE B,.CHLFD ;Until end of line
LOOP.
ENDDO.
BOUT% ;And that as well
MOVE B,RPLPTR ;Get byte pointer
MOVN C,RPLCNT ;And byte count
SKIPE C
SOUT% ;Put that in now
ADDI M,MSGLEN
CAMLE M,LASTM ;Reached end of file?
IFSKP.
MOVE V,MSGALL(M) ;No, beginning byte of remainder of file
MOVE E,LASTM
MOVN C,MSGALL(E) ;Compute last byte of file
SUB C,MSGSAL(E)
ADD C,V ;The "difference" is what to copy
CALL CHR2BP ;Compute the byte pointer
MOVE B,A
MOVE A,MSGJF2
SOUT% ;Send rest of file out
ENDIF.
MOVE A,OUTJFN
RFPTR%
IFJER.
CALL CLSJF2 ;Clean up file (or what's left)
OKINT ;CTRL/C OK now
JSNARL
RET
ENDIF.
HRLI A,.FBSIZ
MOVE C,B ;Current position
SETO B,
CHFDB% ;Make this the new end of the file
CALL CLSJF2 ;Close off file
OKINT ;CTRL/C OK now
CALL SIZFIL ;Get its new size info
MOVE M,CURMSG ;Get back current message
CALL PARSEF ;Reparse the file
CALL RECEN2
RETSKP ;Return +2
ENDSV.
;;;Get TTY modes
GETTYM: MOVX A,RT%DIM!.FHJOB ;Get job's interrupt word
RTIW%
DMOVEM B,3(D)
MOVX A,.PRIOU
RFMOD%
MOVEM B,0(D)
RFCOC%
DMOVEM B,1(D)
RET
;;;Set TTY modes
SETTYM: MOVX A,ST%DIM!.FHJOB
DMOVE B,3(D)
STIW%
ERJMP .+1
MOVX A,.PRIOU
RFMOD% ;Get current mode
ANDX B,TT%OSP ; so we preserve TT%OSP state
IOR B,0(D)
SFMOD%
DMOVE B,1(D)
SFCOC%
RET
CHECK: NOISE (FOR NEW MESSAGES)
CONFRM
SKIPLE MSGJFN ;Have mail file?
IFSKP.
CALL CHKNEW ;No, see if one now
RET ;Nope, return
ELSE.
CALL SIZFIL ;Get current file poop
ENDIF.
CALLRET CHECKS ;Force check now
;;;Check for new messages periodically
CHECK: GTAD% ;Get time now
CAMG A,CHKTIM ;Time we had a look?
RET ;No, just return
CHECKT: CALL CHECK1 ;Check for change in file size
IFNSK.
SKIPG MSGJFN ;No change, found a message file?
RET ;No, return
SKIPE A,FILWRT ;See when/if last written
CAMG A,FILRD ;Written since last read?
RET ;No, nothing changed
ENDIF.
;;;Print message when there are new guys
CHECKS: STKVAR <CURMSG,CURLST>
MOVE A,MSGJFN
CALL SETREF ;Set read date
MOVEM M,CURMSG ;Save current message
MOVE M,LASTM ;Start at the end
MOVEM M,CURLST ;Save number of messages
ADDI M,MSGLEN ;From that one on,
CALL PARSEF ;Parse these new ones
SKIPL CURLST ;Started from scratch?
IFSKP.
SETZ A, ;Yes, find first really new msg
DO.
CAMLE A,LASTM ;More msgs?
IFSKP.
MOVE B,MSGDAT(A) ;Yes, date before file read date?
CAML B,LASTRD
ANSKP.
ADDI A,MSGLEN ;Yes, step to next msg
LOOP.
ENDIF.
ENDDO.
;;; Here A points to first msg to be considered new
SUBI A,MSGLEN ;OK, step back to last "old" msg
MOVEM A,CURLST ;Update previous LASTM
SKIPLE A ;Really starting at 0?
MOVEM A,CURMSG ;No, update prev "current" msg
CIETYP <
> ;Separator line
CALL .STATF ;Be sure user knows about file name
ENDIF.
MOVE A,CURLST ;Get old last message in A
MOVE M,CURMSG ;Get current message in M
CALLRET CHECKN
ENDSV.
; Here with A/ old last message, M/ current message
CHECKN: STKVAR <CURMSG,OLDLST,OLDLRD>
MOVEM A,OLDLST ;Save old last message
MOVEM M,CURMSG ;Save current message
SUB A,LASTM ;Get number of new guys
JUMPE A,R ;Done if no new ones
MOVE B,LASTRD ;Save date file fetched
MOVEM B,OLDLRD
SKIPGE B,OLDLST ;Get old message if any
IFSKP.
TXNE F,F%BB ;Reading a BBoard file?
SKIPA B,BBXDAT ;Yes, fake last read date
MOVE B,MSGDAT(B) ;Otherwise use date of last
MOVEM B,LASTRD ; previous real msg
ENDIF.
IDIVI A,MSGLEN
MOVMS A
MOVEI B,[ASCIZ/are/]
CAIN A,1
MOVEI B,[ASCIZ/is/]
CIETYP < There %2S %1D additional message%1P
>
CALL RECENT ;Give the headers of the recent ones
MOVE B,OLDLRD ;Restore date file fetched
MOVEM B,LASTRD
SKIPL M,CURMSG ;Restore current message
CAMLE M,LASTM ;Range check
SETZ M, ;Else go to the beginning
CIETYP < Currently at message %M.
>
RET
ENDSV.
;;; Check for change in file size. Used when read/write dates already updated
CHECK1: GTAD% ;Get current date/time
ADDI A,<5B17/^D<24*60>> ;Five minutes from now
MOVEM A,CHKTIM ;Is next time to look
SKIPG MSGJFN ;Have a file?
JRST CHKNEW
PUSH P,FILSIZ ;Save current size
CALL SIZFIL ;Get the current poop on it
POP P,T ;Get back old size
CAME T,FILSIZ ;Size changed?
RETSKP ;Yes, skip return
RET ;No
;;;Check if MAIL.TXT has been undeleted
CHKNEW: CALL FNDFL0 ;Has it?
RET ;Nope, return
SKIPE FILSIZ ;If file is empty, ignore it
IFSKP.
RLJFN% ;Get rid of the file
NOP ;Ignore failure
RET
ENDIF.
TXNN F,F%RONL ;Only do if want to write
CALL LCKFIL
MOVNI A,MSGLEN ;Flag for full parse
MOVEM A,LASTM
MOVE A,FILRD ;Save date when file read
MOVEM A,LASTRD
SETZ M,
RETSKP
;;;Build string of version number in STRBUF
GETVER: STKVAR <BASE>
TMNN VI%DEC,VERNUM ;Decimal versions?
SKIPA A,[^D8] ;No, octal for typeout
MOVX A,^D10 ;Yes, output in decimal
MOVEM A,BASE
MOVE A,[POINT 7,STRBUF]
MOVEI B,[ASCIZ/ MM-20 /]
CALL MOVSTR
LOAD B,VI%MAJ,VERNUM
IFN. B
MOVE C,BASE
NOUT%
NOP
ENDIF.
LOAD B,VI%MIN,VERNUM
IFN. B
MOVEI C,"." ;New DEC minor version convention
IDPB C,A ; is . followed by number
MOVE C,BASE
NOUT%
NOP
ENDIF.
LOAD B,<VI%EDN&^-VI%DEC>,VERNUM
IFN. B
MOVEI C,"("
IDPB C,A
MOVE C,BASE
NOUT%
NOP
MOVEI C,")"
IDPB C,A
ENDIF.
LOAD B,VI%WHO,VERNUM
IFN. B
MOVEI C,"-"
IDPB C,A
MOVE C,BASE
NOUT%
NOP
ENDIF.
SETZ C, ;Put null in at end
IDPB C,A
RET
ENDSV.
; Routine to initialize structure for sorting msgs by date:
; SRTPAG = adr of "shuffle" table. Each entry has the form,
; source msg,,destination msg
; where at entry I,
; "source" = index of msg block moving to I
; "destination" = index of msg block I moves to
; SRTTAB = sort tree for msgs. Each node has the structure,
; lh ptr,,rh ptr
; index of msg at this node
; where,
; lh ptr points to nodes with earlier dates
; rh ptr points to nodes with later dates
; SRTFRE = adr of next free cell
; Call: CALL INISRT
; Return: +1
INISRT: MOVE B,LASTM ;Leave room for all msgs in
IDIVI B,MSGLEN ; shuffle table
ADDI B,1
MOVEI A,SRTPAG(B) ;a := start of sorting tree
HRROM A,SRTTAB ;Flag it as 1st node of tree
MOVEM A,SRTFRE ;Also as free space ptr
MOVNS B ;b := aobjn ptr to shuffle table
MOVSI B,(B)
SETZ A, ;Init shuffle tbl
DO.
MOVEM A,SRTPAG(B)
ADD A,[MSGLEN,,MSGLEN] ;Bump to,,from ptrs
AOBJN B,TOP. ;Do all msgs
ENDDO.
RET ;Done
; Routine to add a msg into the sorting tree. Since msgs are expected
; to be fairly well ordered, we keep separate ptrs to the leftmost and
; rightmost branches of the tree for easy appending.
; Entry: m = adr of msg block
; Call: CALL SRTMSG
; Return: +1, new node linked in to sort tree
SRTMSG: SAVEAC <E,N>
STKVAR <NEWNOD,PRVNOD>
SETZM NEWNOD ;No nodes initially
SETZM PRVNOD
SKIPLE E,SRTTAB ;Empty tree?
IFSKP.
HRRZS SRTTAB ;Yes, clear lh flag and bypass search
ELSE.
MOVE N,MSGDAT(M) ;n := date of current msg
MOVE B,SRTLFT ;New date lowest in group?
MOVE A,1(B)
CAMLE N,MSGDAT(A)
IFSKP.
MOVE E,B ;Yes, start search here
HLLOS NEWNOD ;Can't be new rightmost node
ELSE.
MOVE B,SRTRGT ;New date highest in group?
MOVE A,1(B)
CAMGE N,MSGDAT(A)
IFSKP.
MOVE E,B ;Yes, start search here
HRROS NEWNOD ;Can't be new leftmost node
ENDIF.
ENDIF.
;; Here to scan down the tree to find the proper place to append the
;; new msg
DO.
IFN. E ;Quit if last link
MOVEM E,PRVNOD ;More, save this one as prior node
MOVE A,1(E) ;a := adr of msg block for this node
CAML N,MSGDAT(A)
IFSKP.
HLRZ E,0(E) ;New date < node, put it to left
HRROS PRVNOD ;Flag lefthand ptr from prior node
HLLOS NEWNOD ;Can't be new rightmost node
LOOP. ;See if more on tree
ENDIF.
CAMG N,MSGDAT(A)
IFSKP.
HRRZ E,0(E) ;New date > node, put it to right
HRROS NEWNOD ;Can't be new leftmost node
LOOP. ;See if more on tree
ENDIF.
SKIPL MSCANF ;Inverse scan?
IFSKP.
HLRZ E,0(E) ;Yes, put it to left
HRROS PRVNOD ;Flag lefthand ptr from prior node
HLLOS NEWNOD ;Can't be new rightmost node
LOOP. ;See if more on tree
ELSE.
HRRZ E,0(E) ;No, put it to right
HRROS NEWNOD ;Can't be new leftmost node
LOOP. ;See if more on tree
ENDIF.
ENDIF.
ENDDO.
ENDIF.
;; Here we are at the end of the current tree. Enter the new node.
MOVE A,SRTFRE ;a := adr of next free entry
SETZM 0(A) ;Init the new entry
MOVEM M,1(A) ;Save index to current msg in node
MOVEI B,2(A) ;Update the free ptr
MOVEM B,SRTFRE
MOVE E,NEWNOD ;x := new left/rightmost node flag
TXNN E,.LHALF ;New leftmost node?
MOVEM A,SRTLFT ;Yes
TXNN E,.RHALF ;New rightmost node?
MOVEM A,SRTRGT ;Yes
MOVE E,PRVNOD ;x := adr of previous node
IFN. E ;If 1st one, quit
TXNE E,.LHALF ;LH link?
HRLZS A ;Yes, put link adr in lh
IORM A,0(E) ;Install it in the proper half
ENDIF.
MOVEI A,(M) ;Flag shuffle table that msg sorted
IDIVI A,MSGLEN
SETOM SRTPAG(A)
RET
ENDSV.
; Routine to linearize a sorted tree of msgs and to shuffle the msg
; blocks appropriately.
; Call: CALL PSTSRT
; Return: +1
PSTSRT: SETZM NSORTD ;Clear count of non-trivial sorts
SKIPG SRTTAB ;Anything in tree?
RET ;No, just return
SAVEAC <T,E>
MOVEI T,SRTPAG-1 ;Assume forward scan
SKIPG MSCANF ;Unless reversed
HRRZ T,SRTTAB ;Then start at top of table
CALL SRTREE ;Sort the tree
SKIPG NSORTD ;Any real movement?
IFSKP.
MOVEI T,SRTPAG ;Yes, really shuffle the msg blocks now
DO.
CAML T,SRTTAB ;Done whole table?
IFSKP.
SKIPGE (T) ;No, marked as already done?
AOJA T,TOP. ;Yes, look at next one
HLRZ A,(T) ;a := msg # coming here
IDIVI A,MSGLEN
CAIE A,-SRTPAG(T) ;Move to self?
CALL SMVMSG ;No, migrate this chain
AOJA T,TOP. ;Try the next one
ENDIF.
ENDDO.
ENDIF.
SETO A, ;Unmap pages used for sort
MOVE B,[.FHSLF,,<SRTPAG/1000>]
MOVE C,SRTFRE
SUBI C,1 ;Last word actually used
LSH C,-^D9 ;Last page touched
SUBI C,-1(B) ;Number of pages to unmap
TXO C,PM%CNT
PMAP%
RET
; Routine to traverse a sorted tree and linearly order the nodes in
; sequential open entries in the shuffle table
; Entry: t = ptr to shuffle table
; Call: CALL SRTREE
; Return: +1
SRTREE: HRRZ E,SRTTAB ;Set up X to head of tree
JUMPE E,R ;If end of tree, quit
DO.
PUSH P,E ;No, save adr of this node
HLRZ E,0(E) ;Point to lh branch
SKIPE E
CALL TOP. ;Check it out
POP P,E ;None on left, use this one
CALL NXTSHF ;Find next shuffle table entry
HRRZ A,1(E) ;a := index of sorted msg
HRLM A,(T) ;Put it in the table
IDIVI A,MSGLEN ;a := number of sorted msg
MOVEI B,-SRTPAG(T) ;b := index of where it goes
IMULI B,MSGLEN
HRRM B,SRTPAG(A)
CAIE A,-SRTPAG(T) ;Move in place?
AOS NSORTD ;No, bump count
HRRZ E,0(E) ;x := link to right (later dates)
JUMPN E,TOP. ;Check out that branch
ENDDO.
RET
;; Routine to find next shuffle table entry
; Entry: t = previous table ptr
; Call: CALL NXTSHF
; Return: +1
NXTSHF: SKIPLE MSCANF ;Forward scan
IFSKP.
DO.
SOJL T,NXTSHX ;Step to earlier entry (bomb on error)
SKIPL (T) ;Sorted entry
LOOP. ;No, look further
ENDDO.
ELSE.
DO.
ADDI T,1 ;Yes, step to next entry
CAML T,SRTTAB ;Beyond table?
NXTSHX: FATAL <Error finding shuffle table entry>
SKIPL (T) ;Sorted entry?
LOOP. ;No, look further
ENDDO.
ENDIF.
RET ;OK, return this one
;; Routine to move msg blocks around according to the shuffle table
;; entries. Shuffle table entry I contains SRC,,DST where SRC is the
;; msg block to be moved to I and DST is the msg block to which I is to
;; move.
; Entry: t = current entry requiring movement
; Call: CALL SMVMSG
; Return: +1, msg blocks chained to t moved.
SMVMSG: SAVEAC <T> ;Save current shuffle table index
DMOVE A,[SRBLK0
SRBLK1] ;Init temp storage ptrs
DMOVEM A,SRTBLK
SETZM SRTIDX
HLRZ A,(T) ;Save source block coming here
MOVSI A,MSGPGS(A)
HRRI A,SRBLK0
BLT A,SRBLK0+MSGLEN-1
DO.
MOVEI A,-SRTPAG(T) ;a := adr of current msg block
IMULI A,MSGLEN
ADDI A,MSGPGS
PUSH P,SRTIDX ;Save current temp buffer index
HRR B,(T) ;b := dst for current msg block
IDIVI B,MSGLEN
SKIPGE SRTPAG(B) ;Already transferred?
IFSKP.
AOS B,SRTIDX ;No, b := index to free temp buffer
TRNN B,1
SETZB B,SRTIDX
MOVE B,SRTBLK(B) ;Save current contents of msg block
HRLI B,(A)
MOVEI C,MSGLEN-1(B)
BLT B,(C)
ENDIF.
POP P,B ;Recover index to temp bfr to move here
HRL A,SRTBLK(B) ;Install new sorted msg block
MOVEI B,MSGLEN-1(A)
BLT A,(B)
HRROS (T) ;Mark this entry as updated
HRRZ A,(T) ;a := dst msg #
IDIVI A,MSGLEN
MOVEI T,SRTPAG(A) ;t := ptr to dst shuffle table entry
SKIPL (T) ;Dst already updated?
LOOP. ;No, more on this chain
ENDDO.
RET
;;; Copy sorted msgs to the file
CPYSRT: SAVEAC <M>
JXN F,F%RONL,R ;Can't change read only file
CALL GETJF2 ;Get a write JFN
RET ;Failed
CALL ABNOFF ;No aborts
NOINT ;No outside diddling
MOVEI A,MTXPAG ;Core adr of first file page
HRRZ B,FILPGS ;b := # of pages in the file
DO.
MOVES (A) ;Make all pages private
ADDI A,1000
SOJG B,TOP.
ENDDO.
SETO A, ;Remove all pages from file
HRLZ B,MSGJF2 ;JFN,,first page
HRRZ C,FILPGS ;Count
TXO C,PM%CNT
PMAP% ;Kill the old copies from file
ERJMP .+1
SETZ M, ;Do all msgs
DO.
MOVE V,MSGALL(M) ;Get byte ptr to start of msg
CALL CHR2BP
MOVE B,A ;Copy this msg out
HRRZ A,MSGJF2
MOVN C,MSGSAL(M) ;Negative number of bytes in msg
SOUT%
ADDI M,MSGLEN ;Step to next msg
CAMG M,LASTM ;All done?
LOOP. ;No
ENDDO.
CALL CLSJF2 ;Close off file
OKINT ;CTRL/C OK now
CALL SIZFIL ;Get its new size info
CALLRET PARSEA ;Reparse the entire file
SUBTTL Lower level subroutines
;;;Copy a file name string from B to A, prefixing login directory.
MAKSTR: PUSH P,B
PUSH P,A
SETZ A, ;Convert alias user to alias directory
MOVE B,MYAUSR
RCDIR%
POP P,A
MOVE B,C
DIRST%
JFATAL
POP P,B
CALLRET MOVST0
;;;Copy a file name string from B to A, prefixing postbox directory.
MKPSTR: PUSH P,B
MOVEI B,MLBXDV
CALL MOVSTR
MOVX C,":"
IDPB C,A
MOVX C,.CHLAB
IDPB C,A
MOVEI B,MAUSRS
CALL MOVSTR
MOVX C,.CHRAB
IDPB C,A
POP P,B
; CALLRET MOVST0
;;;Move string and terminating null
MOVST0: HRLI B,(<POINT 7,>)
MOVST2: DO.
ILDB C,B
IDPB C,A
JUMPN C,TOP.
ENDDO.
RET
;;;Move a string from B to A
MOVSTR: HRLI B,(<POINT 7,>)
MOVST1::DO.
ILDB C,B
IFN. C
IDPB C,A
LOOP.
ENDIF.
ENDDO.
RET
;;; Make a copy of string in A, return address in B, count in C
CPYSTR::PUSH P,A ;Save address
HRLI A,(<POINT 7,0>)
SETZ C,
DO.
ILDB D,A
JUMPE D,ENDLP.
AOJA C,TOP.
ENDDO.
MOVEI A,5(C) ;Account for null and round wd cnt up
IDIVI A,5
CALL ALCBLK
FATAL <Memory exhausted>
HRL B,(P)
HRRZM B,(P)
ADDI A,(B)
BLT B,-1(A)
POP P,B
RET
;;;Unmap pages from file
UNMAPF: SETO A,
MOVE B,[.FHSLF,,MTXPGN]
HRRZ C,FILPGS ;Number of pages
HRLI C,(PM%CNT)
PMAP%
RET
;;;Close the INDEX file
CLOSEI: SKIPLE A,IDXJFN ;Is there one?
CALL $CLOSF ;Yes, throw it away
SETZM IDXJFN ;Isn't one any more
RET
;;;Close the file
CLOSEF: SKIPG MSGJFN
IFSKP.
DMOVE A,[.DEQID ;Get rid of any locks we got
REQID]
DEQ%
ERJMP .+1 ;Ignore failure
SKIPLE A,MSGJFN
CALL $CLOSF
SETOM MSGJFN
ENDIF.
CLOSF1: SKIPLE A,MSGJF2
CALL $CLOSF
SETOM MSGJF2
TXZ F,F%SWRN ;Disable size warning now
RET
$CLOSF: GTSTS% ;Get file status
TXNN B,GS%NAM ;Valid JFN?
RET
IFXN. B,GS%OPN ;Yes, do CLOSF% if file open
CLOSF%
NOP
ELSE.
RLJFN%
NOP
ENDIF.
RET
$CLOSK: GTSTS% ;Get file status
TXNE B,GS%NAM ;Valid JFN?
TXNN B,GS%OPN ;Yes, file open?
RET
TXO A,CO%NRJ ;Yes, close file while keeping JFN
CLOSF%
NOP
RET
SUBTTL File parsing subroutines
GETFLB: CALL CLOSEI ;Flush any old index
SKIPE FILSIZ ;Is the file empty?
IFSKP.
MOVE A,MSGJFN ;Yes, get JFN for error message
SKIPN VBSBBD ;Want noisy behavior?
TXNN F,F%RSCN ;No, bother anyway unless rescanning
CIETYP <There are no messages in %1J>
CALL CLOSEF ;Clear out JFNs
JRST CMDRES
ENDIF.
HRRZ A,MSGJFN ;Get file JFN
MOVE B,[1,,.FBWRT] ;Date of last user-write
MOVEI C,BBLWD ;Save in BB-Last-Write-Date
GTFDB%
MOVE B,A ;Get JFN into B
HRROI A,IDXNAM ;Create a file-name.idx
MOVE C,[1B2!1B5!1B8!JS%PAF] ;Dump it
JFNS%
HRROI B,[ASCIZ/.IDX.1;P777070/] ;Find the index file
SETZ C,
SOUT% ;Copy the .idx
IDPB C,A ;Tie off name with null
DO.
SKIPE A,IDXJFN ;Have JFN yet?
IFSKP.
MOVX A,GJ%OLD!GJ%SHT ;See if the file is there
HRROI B,IDXNAM
GTJFN%
IFJER.
CAIE A,GJFX18 ;No such file name,
CAIN A,GJFX19 ;Or no such file type?
MOVEI A,GJFX24 ;Yes, normalize to File-not-found
CAIN A,GJFX24 ;File not found?
IFSKP.
SKIPLE MSGJFN
CALL UNMAPF
CALL CLOSEF ;No, real problem
JERROR
ENDIF.
TXO F,F%F4 ;Flag we require a new file here
CALL MAKIDX ;Call the indexer
JRST GETFBX ;Lost, just do examine
EXIT. ;And continue on through
ENDIF.
MOVEM A,IDXJFN ;Save copy of JFN
ENDIF.
HRRZ A,IDXJFN
MOVE B,[1,,.FBCRV] ;Get date of file creation
MOVEI C,D ; gets set to the
GTFDB% ; time/date BBoard was written
CAML D,BBLWD ;Is index current?
EXIT.
CALL MAKIDX
JRST GETFBX ;Lost, just do examine
ENDDO.
HRRZ A,IDXJFN ;JFN
MOVE B,[1,,.FBSIZ] ;Get number of bytes
MOVEI C,E ;Into E
GTFDB%
MOVX B,OF%RD!OF%THW!OF%WR ;Thawed access (writeable for date update)
DO.
OPENF%
IFJER.
CAIE A,OPNX9 ;Somebody else using file?
IFSKP.
TMSG <
Waiting for access...>
MOVEI A,^D2000
DISMS%
MOVE A,IDXJFN ;Restore JFN
LOOP. ;And retry the OPENF%
ENDIF.
PUSH P,A ;Save error code
CALL CLOSEI ;Throw away half-opened thing
SKIPLE MSGJFN
CALL UNMAPF
CALL CLOSEF ;And message file
POP P,A
ERROR <Can't open index for BBoard file - %1E>
ENDIF.
ENDDO.
HRRZ A,A ;Specify page 0 to start in left half
FFFFP% ;Find first free file page (love those f's)
HRRZ C,A ;First free is number of pages to map
MOVE D,C ;Copy of count in D for lower loop
CAIG C,NMSGPG ;Is index file too big?
IFSKP.
CALL CLOSEI ;Yup, get rid of it
SKIPLE MSGJFN
CALL UNMAPF
CALL CLOSEF ;And message file
ERROR <Index file too big> ;Uh, yeah, it is
ENDIF.
HLLZ A,A ;JFN in left for PMAP%
MOVE B,[.FHSLF,,<MSGPGS/1000>] ;Where to map to
HRLI C,(PM%CNT!PM%RD!PM%PLD!PM%CPY) ;Read, load, copy
PMAP%
IFJER.
MOVX A,.FHSLF ;Get error code
GETER%
HRRZS B
PUSH P,B
CALL CLOSEI
SKIPLE MSGJFN
CALL UNMAPF
CALL CLOSEF
POP P,A
ERROR <Can't map in index pages - %1E>
ENDIF.
MOVEI B,MSGPGS ;Point to first page
DO.
MOVES (B) ;Touch each page
ADDI B,1000 ;Step pages
SOJG D,TOP. ;And iterate
ENDDO.
PUSH P,E
CALL GXDAT ;Find last read date from IDX file
POP P,E
MOVEM A,LASTRD ;Store last read date
SUBI E,MSGLEN-1 ;Point to beginning of last message
MOVEM E,LASTM ;In known place
SETZ M, ;Parse all messages
CALLRET PARSEI ;Parse the file using already loaded index
GETFBX: TXZ F,F%BB ;No longer reading a BBoard
TXO F,F%MOD!F%RONL ;Treat like system mail
CALL CLOSEI ;Flush any index JFN
SETO A, ;This job
HRROI B,FILRD ;Where to stick info
MOVEI C,.JILLN ;Get time of last login to use as the date/time
GETJI% ; the file was last read
SETZM FILRD ;None, assume prehistoric times
CITYPE <[Proceeding by doing an implicit "EXAMINE" using the previous login date
as the "last read" date]>
CALLRET GETFL1
;Here to get the last read date out of the index file and set
; the new read date to (A)
SXDAT: SKIPA E,[MOVEM D,BBXPAG(C)] ;Instruction to SET date
GXDAT: MOVE E,[MOVE D,BBXPAG(C)] ;Instruction to GET date
SKIPN IDXJFN ;Is there an index file?
ERROR <Can't set new date with no index file>
PUSH P,A ;Save new read date
LDB A,[POINT 8,MYAUSR,26] ;Load user-number/ 1000
ADDI A,UXPAG ;Offset into file for page number
HRL A,IDXJFN ;Get the JFN for the index file
MOVE B,[.FHSLF,,BBXPAG/1000] ;Where to map to
HRLI C,(PM%WR!PM%RD!PM%PLD) ;Get the page from the file
PMAP%
IFJER.
JSNARL <Can't map index data page> ;Failed, foo
ADJSP P,-1 ;Flush read date
RET
ENDIF.
LDB C,[POINT 9,MYAUSR,35] ;Get index into page
POP P,D ;Get new read date to set
XCT E ;Either GET or SET date here
SETO A, ;Unmap the IDX page now
SETZ C, ;B should be ok, clear C
PMAP% ;Throw away idx page now
IFJER.
JSNARL <Can't unmap index data page> ;Shouldn't fail
RET
ENDIF.
SKIPN A,D ;Return date in A
SETO A, ;Never read should be -1
MOVEM A,BBXDAT ;Save last date known to be in file
MOVEM A,LASTRD ;Here also for status command
RET
;Here to make an index of the BB file
MAKIDX: MOVE A,MSGJFN ;JFN for message
SETZ M, ;And start at message 0
SKIPN VBSBBD ;Requested quiet?
IFSKP.
IFXE. F,F%F4 ;No, require new file?
ETYPE <Creating new index for %1J
>
ELSE.
ETYPE <Index file out of date, updating index for %1J
>
ENDIF.
ENDIF.
CALL PARSEF ;Read in the whole file
SKIPE A,IDXJFN
IFSKP.
HRROI B,IDXNAM ;No JFN yet, get one
TXNE F,F%F4 ;Need new file?
SKIPA A,[GJ%NEW!GJ%SHT] ;Yes, be sure to get a new one
MOVX A,GJ%OLD!GJ%SHT ;Old file
GTJFN%
IFJER.
WARN <Can't get BBoard index - %1E
>
RET
ENDIF.
MOVEM A,IDXJFN ;Save JFN
ENDIF.
MOVX B,OF%WR!OF%RD!OF%THW ;Write the index file, but leave thawed
OPENF%
IFJER.
WARN <Can't open BBoard index - %1E
>
CALLRET CLOSEI ;Flush index JFN, return non-skip
ENDIF.
MOVE C,LASTM ;Get pointer to last message
ADDI C,MSGLEN+1000-1 ;Add length of block, normalize to 1
LSH C,-^D9 ;Shift right for page count
HRLZ B,A ;Put JFN in b
MOVE A,[.FHSLF,,<MSGPGS/1000>] ;Page to map out
HRLI C,(PM%CNT!PM%WR) ;Set bits in count word
PMAP%
IFJER.
MOVX A,.FHSLF ;Get error code
GETER%
HRRZS B
PUSH P,B
CALL CLOSEI
SKIPLE MSGJFN
CALL UNMAPF
CALL CLOSEF
POP P,A
ERROR <Can't map out index pages - %1E
>
ENDIF.
EXCH A,B ;Get file in A, fork in B
HLLZ A,A ;Start on file page 0
HRLI C,(PM%CNT!PM%CPY!PM%PLD) ;Magic PMAP% bits
PMAP%
IFJER.
MOVX A,.FHSLF ;Get error code
GETER%
HRRZS B
PUSH P,B
CALL CLOSEI
SKIPLE MSGJFN
CALL UNMAPF
CALL CLOSEF
POP P,A
ERROR <Can't map in index pages - %1E
>
ENDIF.
HRRZ C,C ;Get page count isolated in C
MOVEI B,MSGPGS ;Point to first page
DO.
MOVES (B) ;Touch each page
ADDI B,1000 ;Step pages
SOJG C,TOP. ;And iterate
ENDDO.
HLRZ A,A ;Get JFN back in right half
TXO A,CO%NRJ ;Don't release JFN
CLOSF%
JERROR
HRLI A,.FBCRV(CF%NUD) ;Set user word in fdb (do not update)
SETO B, ; to date that BBoard file
MOVE C,BBLWD ; was last written
CHFDB%
ERJMP .+1
HRLI A,.FBSIZ ;Set number of bytes (words)
MOVE C,LASTM ;Offset to last message
ADDI C,MSGLEN-1 ;Plus size of last block
CHFDB%
ERJMP .+1
RETSKP
GETFIL: TXZ F,F%BB ;No longer reading a BBoard
CALL FNDFIL ;Try to find it first
RET ;Not there, forget it
GETFL1: SKIPE FILSIZ ;Is the file empty?
IFSKP.
MOVE A,MSGJFN ;Yes, get JFN for error message
CIETYP <There are no messages in %1J>
CALL CLOSEF ;Clear out JFNs
JRST CMDRES
ENDIF.
TXNN F,F%RONL ;Only do if want to write
CALL LCKFIL
MOVE A,FILRD ;Save date when file read
MOVEM A,LASTRD
SETZ M, ;Parse all messages
CALLRET PARSEF ;Now return
;;;Try to find a MAIL.TXT
FNDFIL: TXNN F,F%RSCN ;Can't ask if RSCAN%
TXZA F,F%F1 ;Ok to type messages if none there
FNDFL0: TXO F,F%F1 ;Don't type anything
CALL CLOSEF ;Get rid of old file perhaps
GJINF% ;Get current connected directory
MOVEM B,MYCDIR ;Keep this updated
DO.
TXNN F,F%ALIA ;Aliasing another user?
SKIPGE GTCNDR ;Or always get postbox directory?
IFSKP.
CAME B,MYPDIR ;No, are we connected to postbox?
CAMN B,MYDIR ; or to login?
ANSKP.
MOVX A,GJ%OLD!GJ%SHT!GJ%ACC ;No, must investigate further
HRROI B,MLBXFN
GTJFN% ;Find file on connected directory
IFJER.
MOVE A,MYPDIR ;Failed, get post office box directory
MOVE B,MYCDIR ;and connected
MOVEI C,MLBXFN
TXNN F,F%F1 ;Suppress messages?
CIETYP < No %3S in %2U, trying %1U...>
ELSE.
MOVEM A,MSGJFN ;Save the JFN away
JXN F,F%F1,ENDLP. ;If silence requested then we are done
MOVE B,MYCDIR ;Ready to compare postbox vs connected
SKIPG GTCNDR ;Always get connected directory?
CAMN B,MYPDIR ;Are they the same?
EXIT. ;Yes, done
CIETYP <You are connected to directory %2U>
MOVE A,[POINT 7,QPRMPT] ;Compose prompt string..
HRROI B,[ASCIZ/Read /]
CALL MOVSTR
HRROI B,MLBXFN
CALL MOVSTR
HRROI B,[ASCIZ/ here? /]
CALL MOVST0
UPRMT QPRMPT
CALL YESNO
IFSKP. <EXIT.> ;User said yes
CALL FNDFLX ;Answer was no. Flush connected directory
SETOM GTCNDR ;Make sure get from postbox at check time
MOVE C,MYPDIR ;Select postbox directory
CIETYP <Trying %3U...>
ENDIF.
ENDIF.
MOVE A,[POINT 7,FILNAM] ;Get postbox directory
MOVEI B,MLBXFN
CALL MKPSTR
MOVX A,GJ%OLD!GJ%SHT!GJ%ACC
HRROI B,FILNAM
GTJFN%
IFJER.
MOVEI C,MLBXFN
TXNN F,F%F1 ;Suppress messages here?
CIETYP < You have no %3S>
RET
ENDIF.
MOVEM A,MSGJFN
ENDDO.
CALL SIZFIL ;Get the size of the file, etc.
MOVX B,<<FLD 7,OF%BSZ>!OF%RD> ;Try to open it
OPENF%
IFNJE. <RETSKP>
MOVEI C,MLBXFN
TXNN F,F%F1
CIETYP < Can't open %3S>
FNDFLX: SKIPLE A,MSGJFN ;Get rid of stray JFN
RLJFN%
NOP
SETOM MSGJFN ;Remember there is no mailbox!
RET
;;; Here to get a YES or NO reply, skip if YES
;Call: PROMPT <...prompt string...?>
; CALL YESNO or CALL YESNO1
; <user answered NO return>
; <user answered YES return>
; Note!! YESNO always re-executes the instruction prior to the CALL
;that invoked it, under the assumption that it's a PROMPT UUO. Any
;place that calls here without that must arrange for the previous
;instruction to serve the function of a prompt (see ABOCFM for the
;only case that needs to worry about this as of this writing).
YSNOCM: FLDDB. .CMKEY,CM%SDH,YSNOTB,YES or NO
YSNOCD: FLDDB. .CMKEY,CM%SDH,YSNOTB,YES or NO,YES
YSNOTB: 2,,2
CMD NO,0
CMD YES,-1
YESNO1: MOVEM P,REPARP ;Entry for no default
YESN01: MOVE P,REPARP
MOVEI A,YESN01
MOVEI B,YSNOCM
JRST YESNO2
YESNO: MOVEM P,REPARP ;Entry to default to YES
YESNO0: MOVE P,REPARP
MOVEI A,YESNO0 ;Set reparse address back to here
MOVEI B,YSNOCD
YESNO2: HRRM A,CMDBLK+.CMFLG
CALL $COMND
TXNE A,CM%NOP ;Make sure valid answer
JRST YESNOE
HRRE D,(B) ;Get answer
MOVEI B,CNFCMD ;Make sure confirmed
CALL $COMND
TXNE A,CM%NOP
JRST YESNOE
JUMPN D,RSKP
RET
YESNOE: SNARL <Please answer YES or NO>
SOS (P)
SOS (P)
RET
FSCMDT: NFSCMD,,NFSCMD ;Short table, 1 choice
CMD FIRST,FINDF
NFSCMD==.-FSCMDT-1
FLCMDT: NFLCMD,,NFLCMD ;2 choices
CMD FIRST,FINDF
CMD NEXT,BSTP1
NFLCMD==.-FLCMDT-1
FIND: SKIPN BBCURR ;BBoards started to be scanned yet?
IFSKP.
DEFALT (NEXT) ; Yes, default is next one
MOVEI A,FLCMDT ; Use table with FIRST and NEXT options
ELSE.
DEFALT (FIRST) ;Default is FIRST if just starting
MOVEI A,FSCMDT ;And use table with only FIRST option
ENDIF.
CALL SUBCMD ;Get user's command
PUSH P,A ;Save response a moment
NOISE (BBOARD WITH NEW MAIL)
CONFRM
POP P,A ;Restore table entry
JRST (A) ;And jump to routine
FINDF: HLRZ T,BBTAB ;Get the number of BBoards to T
IFE. T
ERROR <No BBoards loaded into table>
ENDIF.
MOVEM T,BBMAX ;Save number of BBoards total
SETZM BBCURR ;Set current one to 0
CALLRET BSTP1 ;And fall into stepping code
IGNOR: NOISE (THIS BBOARD AND FIND NEXT ONE)
CONFRM
TXNN F,F%BB ;Hacking BBoards?
ERROR <Can only IGNORE BBoard files>
GTAD%
CALL SXDAT ;Set "now" to last read date
JRST BSTP1 ;And step to next BBoard
STEP: NOISE (TO NEXT BBOARD FILE WITH NEW MAIL)
CONFRM
BSTP1: TXO F,F%BB ;Let world know we are BB hacking
TXZ F,F%MOD ;No more system mail hacking if that
AOS T,BBCURR ;Get current BBoard and step
CAMG T,BBMAX ;Anything to look at?
IFSKP.
TXNE F,F%RSCN ;Message if not rescan, or
SKIPE VBSBBD ; if user wants noise
CITYPE <No BBoards with new mail>
SETZM BBCURR ;Reset to start over if requested
SKIPG MSGJFN ;Any current file?
IFSKP.
CALL CLOSEI
SETZM LASTM ;No more messages
CALL UNMAPF ;Unmap old file
CALL CLOSEF ;Release old cruft
ENDIF.
TXZ F,F%BB!F%RONL ;Not hacking BB any more
TXZN F,F%RSCN ;If still RSCANing, or
TXNE F,F%RTE ;If returning to EXEC,
SKIPE RSCFLG ; and user wants EXEC return,
IFSKP.
TXO F,F%RSCN ;Set flag indicating to QUIT
RET ;And return back to top level
ENDIF.
CALL GETFIL
CALL RECENT
CALLRET SUMMRY
ENDIF.
MOVSI A,[GJ%OLD!GJ%XTN+1 ;Setup defaults
.-.
-1,,MLBXDV
-1,,BBDIR
-1,,MLBXNM
-1,,MLBXEX
0
0
0
0
0
0
0
0
0] ;.GJATR
HRRI A,CMDGTB ;Initialize GTJFN% block
BLT A,CMDGTB+.GJATR
HLRO B,BBTAB(T) ;Make pointer to BB string
MOVE A,[.NULIO,,.NULIO] ;Need this to make GTJFN% work
MOVEM A,CMDGTB+.GJSRC
MOVEI A,CMDGTB ;Point to block again
GTJFN% ;Find the file
IFJER.
MOVX A,GJ%DEL ;Maybe it's deleted?
IORM A,CMDGTB ;Allow deleted files
MOVEI A,CMDGTB ;Point to block
GTJFN% ;Get it now?
IFNJE.
RLJFN% ;Got it, was deleted, so ignore it
NOP ;Errors don't count
JRST BSTP1 ;Loop for more files
ENDIF.
CAIE A,GJFX18 ;No such file name,
CAIN A,GJFX19 ;Or no such file type?
MOVX A,GJFX24 ;Yes, normalize to File-not-found
CAIE A,GJFX24 ;File not found?
JERROR ; No, real problem
CIETYP <BBoard file not found: >
HLRO A,BBTAB(T) ;Get string again
PSOUT% ;Type file name
TMSG <, ignored> ;And disposition
JRST BSTP1 ;Not there, just try next one
ENDIF.
PUSH P,A ;Save JFN
TXO F,F%RONL ;Read only for BB command
SKIPG MSGJFN ;Any current file?
IFSKP.
SETZM LASTM ;No more messages
CALL UNMAPF ;Yes, unmap old file
CALL CLOSEF ;Release old cruft
ENDIF.
POP P,MSGJFN ;Restore new MSGJFN
CALL SIZFIL ;And the size
SKIPN FILSIZ ;Is it an empty file?
JRST BSTP1 ;Yeah, move on to next one
MOVE B,[<FLD 7,OF%BSZ>!OF%RD!OF%PDT] ;Read access, no updates
OPENF%
IFJER.
JSNARL <Can't open file>
JRST BSTP1
ENDIF.
CALL GETFLB ;Special read for BBoard files
CALL RECENT ;Find recent messages, type headers
SKIPN NUNSEE ;Any mail here?
JRST BSTP1 ;No, step along
TXZE F,F%RSCN ;No RSCAN%, stay at comnd level.
TXO F,F%RTE ;But return to EXEC (maybe...)
CALLRET SUMMRY ;Print summary, return with file in
;;;Set date of BBoard message file
BBDAT: NOISE (OF LAST MESSAGE SEEN IS)
CALL GETDAT
PUSH P,B
CONFRM
POP P,A
CALLRET SXDAT
;;;Get another message file
EXAMI: TXOA F,F%F1 ;Examine command
GET: TXZ F,F%F1 ;Get command
TXZ F,F%BB!F%RTE ;Not BB, don't return to EXEC
NOISE (MSGS FROM FILE)
MOVSI A,[GJ%OLD!GJ%XTN+1 ;Setup file defaults
.-.
0
0
-1,,MLBXNM
-1,,MLBXEX
0
0
0
0
0
0
0
0
0] ;.GJATR
HRRI A,CMDGTB ;Initialize GTJFN% block
BLT A,CMDGTB+.GJATR
MOVEI B,[FLDDB. .CMFIL] ;Want existing file name with
CALL $COMND ; "MAIL.TXT.1" default
IFXN. A,CM%NOP ;Was a file name recognized?
HLLZS CMDGTB+.GJGEN ;No, toss away generation 1 default
SETZM CMDGTB+.GJDEV ;Toss all defaults
SETZM CMDGTB+.GJDIR
SETZM CMDGTB+.GJNAM ;Toss away "MAIL" default
SETZM CMDGTB+.GJEXT ;Toss away "TXT" default
MOVEI B,[FLDDB. .CMFIL] ;Now try again with
CALL CMDFLD ; no defaults
ENDIF.
PUSH P,B ;Save JFN
MOVEI B,CNFCMD ;Have user confirm this command
CALL $COMND
IFXN. A,CM%NOP ;Okay?
POP P,A ;No, release JFN, and
RLJFN%
NOP
JERROR ; and go away
ENDIF.
GETFA: TXZ F,F%AMOD!F%MOD!F%RONL ;Not hacking system mail any more
TXNE F,F%F1
TXO F,F%RONL ;Read only for examine command
GETF1: SKIPG MSGJFN ;Any current file?
IFSKP.
SETZM LASTM ;No more messages
CALL UNMAPF ;Unmap old file
CALL CLOSEF ;Release old cruft
ENDIF.
POP P,MSGJFN ;Restore new MSGJFN
GETF3: CALL SIZFIL ;And the size
MOVX B,<<FLD 7,OF%BSZ>!OF%RD> ;Read access
TXNE F,F%F1 ;Examine command?
TRO B,OF%PDT ;Yes, don't update anything
OPENF%
IFJER.
MOVE A,MSGJFN
JSNARL <Can't open message file "%1J">
JRST FNDFLX
ENDIF.
HRROI A,STRBUF ;Create a file-name.init
MOVE B,MSGJFN ;Pick up the msg file
MOVE C,[1B2!1B5!1B8!JS%PAF] ;Dump it
JFNS%
HRROI B,[ASCIZ/.MM-INIT/] ;So we can have mail-specific init
SETZ C,
SOUT% ;Copy the .init
IDPB C,A ;Tie off name with null
MOVX A,GJ%OLD!GJ%SHT ;See if the file is there
HRROI B,STRBUF
GTJFN%
IFSKP.
PUSH P,A ;Save JFN
CALL ININIT ;Erase previous init file parameters
POP P,A
CALL DOINIT ;Init from the file
ENDIF.
IFXN. F,F%BB ;Reading BBoard file?
CALL GETFLB ;Special read for BBoard files
TXO F,F%F1 ;Always type headers
ELSE.
CALL GETFL1 ;Get file and parse it, barf if empty
TXNN F,F%AMOD ;Unless auto mod
TXNN F,F%MOD ;Mod prints headers
TXNE F,F%RSCN ;Allow return to top-level
TXOA F,F%F1 ;Type headers if from command line
TXZ F,F%F1
ENDIF.
CALL RECEN0 ;Remark new messages
SKIPE RSCFLG ;If user wants to stay in MM
TXNN F,F%BB ;And we are reading a BB,
SKIPA
TXZ F,F%RSCN ;Then don't allow return to EXEC
SKIPG NUNSEE ;If mail to read
TXNN F,F%BB ; or not reading a BBoard, then
TXZ F,F%RSCN ; no RSCAN%, stay at comnd level.
TXNN F,F%RSCN ;So, if still rscanning, no summary
TXNE F,F%AMOD ;No summary if auto mod
SKIPA
CALL SUMMRY
RET
;;;Get JFN on local mailbox
; A/ GTJFN% flags
; B/ location of local user name string
; CALL GETMFL
; Ret +1; GTJFN% error
; Ret +2; GTJFN% okay, A/ JFN
GETMFL: STKVAR <FLAGS,USER>
MOVEM A,FLAGS ;Save GTJFN% flags
MOVEM B,USER ;Save user string
MOVE A,[POINT 7,FILNAM] ;Deliver local mail right away
MOVEI B,MLBXDV ;Set up post office box name
CALL MOVSTR
MOVX B,":" ;Device delimiter
IDPB B,A
MOVX B,.CHLAB ;Directory delimiter
IDPB B,A
MOVE B,USER ;Get back user string
CALL MOVSTR ;Now, the local user name
MOVX C,.CHRAB
IDPB C,A
MOVEI B,MLBXFN ;And the mailbox name
CALL MOVST0
MOVE A,FLAGS
HRROI B,FILNAM
GTJFN%
ERJMP R ;Let caller decide action on error
RETSKP ;Skip return okay
ENDSV.
;;;Get size of current file, return MSGJFN in A
SIZFIL: SKIPG A,MSGJFN
RET
MOVE B,[5,,.FBBYV]
MOVEI C,FILPGS
GTFDB% ;Get the size stuff
IFJER.
JSNARL
RET
ENDIF.
IFXN. F,F%MOD ;Getting system mail?
SETO A, ;This job
HRROI B,FILRD ;Where to stick info
MOVEI C,.JILLN ;Get time of last login
GETJI%
SETZM FILRD
MOVE A,MSGJFN ;Get back JFN
ENDIF.
LDB U,[POINT 6,FILPGS,11] ;Get byte size
MOVE V,FILSIZ ;Else get the size now
CAIN U,7 ;If 7 bit,
IFSKP.
CAIN U,^D36 ;36 bit is easier
IFSKP.
MOVEI T,^D36
IDIVI T,(U) ;Get number of bytes in a word
IDIVI V,(T) ;Get number of words
ENDIF.
IMULI V,5 ;Into bytes
MOVEM V,FILSIZ ;Save the size
ENDIF.
IDIVI V,5000 ;Since we have the file open, the
JUMPE V+1,.+2 ;Page count may be too little
ADDI V,1 ;So, we must check against the
HRRZ T,FILPGS ;Size according to the byte count
CAIN V,(T) ;If GTFDB% equals computed,
RET ;Then done
MOVE A,MSGJFN ;Find first free page,
GTSTS% ;If file is open
IFXE. B,GS%OPN ;Is it open?
HRRM V,FILPGS ;No, use what we have
RET
ENDIF.
FFFFP% ;Get first free page
HRRM A,FILPGS ;And use it
MOVE A,MSGJFN ;Callers expect JFN in A
RET
;;;Parse the file from message (M) on
PARSEI: TXOA F,F%F3 ;Flag index already loaded
PARSEF: TXZ F,F%F3 ;No index, do the work
HRRZ A,MSGJFN ;Check status of JFN
GTSTS%
TXNN B,GS%NAM ;Legal JFN?
ERROR <Message file disappeared>
IFXE. B,GS%OPN ;Open?
MOVX B,<<FLD 7,OF%BSZ>!OF%RD> ;Try to open it
OPENF%
IFJER.
MOVE A,MSGJFN
JERROR <Can't open message file "%1J">
ENDIF.
ENDIF.
HRRZ C,FILPGS
CAIG C,NMTXPG ;Enough room?
IFSKP.
TXZ F,F%BB!F%RONL ;No longer BBoard hacking
SETZM FILPGS ;Keep UNMAPF from getting confused
CALL CLOSEF ;Get rid of JFN, etc
MOVEI V,NMTXPG
ERROR <File size (%3D pages) is larger than MM's limit of %10D>
ENDIF.
SKIPN V,M ;Start with first message
IFSKP.
MOVE V,MSGALL-MSGLEN(M) ;No, get start of message
ADD V,MSGSAL-MSGLEN(M)
ENDIF.
MOVEI A,^D5000 ;Compute first page of transfer
IDIVM V,A ; from starting byte
SUBI C,(A) ;Compute number of pages to read
MOVEI B,MTXPGN(A) ;First page here to map into
HRL A,MSGJFN ;File they come from
HRLI B,.FHSLF
TXO C,PM%CNT!PM%RD!PM%PLD!PM%CPY ;Map read copy-write preloaded
PMAP%
DO.
TXZE F,F%F3 ;Already have index?
EXIT. ;Yes, check sizes and return
SETZM MSGPGS(M) ;Clear out this entry by zapping
MOVSI A,MSGPGS(M) ;1st word, then set up
HRRI A,MSGPGS+1(M) ;BLT word to flush rest of entry.
BLT A,MSGPGS+MSGLEN-1(M) ;(standard flush code)
CALL CHR2BP ;Get byte pointer to this
CAMGE V,FILSIZ ;Are we at the end of file?
IFSKP.
CAME V,FILSIZ ;Really at EOF?
WARN <File has bad format: last message extends beyond EOF>
EXIT. ;Don't look for a new message
ENDIF.
MOVEM V,MSGALL(M) ;Start of whole message
DO.
MOVE B,A ;Copy current pointer
ILDB T,A ;Get character
CALL BP2CHR ;Get character pointer
CAML V,FILSIZ ;Running off end of file?
EXIT. ;Yes, not interested in trailing nulls
JUMPE T,TOP. ;Ignore nulls
MOVE A,B ;Restore current pointer
SETZB B,C ;Use default parsing
IDTIM% ;Parse the date/time
IFJER.
TXON F,F%F3 ;Note warning given
WARN <File has bad format: message %M has no receive date>
SETO B,
ENDIF.
CALL BP2CHR ;Get character pointer
CAMGE V,FILSIZ ;Ran off EOF?
IFSKP.
WARN <File has bad format: spurious message header at EOF>
EXIT. ;Ignore bad msg, make final size checks
ENDIF.
MOVEM B,MSGDAT(M) ;Receive date
LDB T,A ;Get character
CAIN T,","
IFSKP.
CALL PARMSB ;Message in bad format, advance to next
EXIT. ;No more messages
LOOP. ;Possible message here
ENDIF.
MOVEI C,^D10 ;Decimal
CALL $NIN
HRLM B,MSGBOD(M) ;Save length of real message
MOVEI C,10 ;Octal
CALL $NIN
MOVEM B,MSGBTS(M) ;Save message bits
MOVEM B,MSGFBS(M)
SETZM MSGFLG(M)
DO. ;Search for end of line
ILDB T,A ;Get character
CALL BP2CHR ;Get character pointer
CAML V,FILSIZ ;Running off end of file?
EXIT. ;Yes, leave this
JUMPE T,TOP. ;Ignore nulls
CAIE T,.CHCRT ;Ignore CR's
CAIN T,.CHSPC ;Ignore spaces; HERMES inserts 'em
LOOP.
ENDDO.
CAMGE V,FILSIZ ;Ran off EOF?
IFSKP.
WARN <File has bad format: spurious message header at EOF>
EXIT. ;Ignore bad msg, make final size checks
ENDIF.
CAIN T,.CHLFD ;Saw end of line?
IFSKP.
CALL PARMSB ;Message in bad format, advance to next
EXIT. ;No more messages
LOOP. ;Possible message here
ENDIF.
TXZ F,F%F3 ;Clear error flag
CALL BP2MCH ;Get character position
HRRM V,MSGBOD(M) ;Save start of real message
HLRZ B,MSGBOD(M) ;Get size again
ADDI B,(V) ;Get end of whole thing
MOVEM B,MSGSAL(M) ;Save size of whole message
ADD B,MSGALL(M) ;Compute absolute byte of end of msg
PUSH P,B ;Save it for later
MOVEI T,[ASCIZ/
From:/]
CALL FNDHDC ;Find it and count it
IFNSK.
MOVEI T,[ASCIZ/
Sender:/]
CALL FNDHDC
NOP ;Guess there is none
ENDIF.
HRRZM V,MSGFRM(M)
HRLM W,MSGFRM(M)
MOVEI T,[ASCIZ/
Subject:/]
CALL FNDHDC ;Find header and count bytes
NOP ;Don't care if fails
HRRZM V,MSGSUB(M)
HRLM W,MSGSUB(M) ;Save position and size
MOVEI T,[ASCIZ/
Message-ID:/]
CALL FNDHDC ;Find header and count bytes
NOP ;Don't care if fails
HRRZM V,MSGMID(M)
HRLM W,MSGMID(M) ;Save position and size
POP P,V ;Recover ending address
MOVEM M,LASTM ;Update total number of messages
ENDDO.
TXZ F,F%F3 ;Clear error flag
CAML V,FILSIZ ;Is this the last one?
EXIT. ;Yes, now make final size checks
CAIGE M,MSGLEN*<NMSGS-1> ;Got all we can handle?
IFSKP.
SETZM FILPGS ;Keep UNMAPF from getting confused
CALL CLOSEF ;Get rid of JFN, etc.
MOVEI C,NMSGS
ERROR <Message file has more messages than MM's limit of %3D>
ENDIF.
ADDI M,MSGLEN ;No, go to next message
LOOP.
ENDDO.
IFXE. F,F%SWRN ;Has warning already been given?
MOVE B,LASTM ;See if we are getting close
IDIVI B,MSGLEN ; to the maximum msg count
ADDI B,1 ;yduJ pacification
MOVEI C,NMSGS
CAIL B,-NMSWRN(C)
WARN <Number of messages (%2D) is approaching MM's limit of %3D>
HRRZ V,FILPGS ;See if we are getting close
MOVEI C,NMTXPG ; to the maximum file size
CAIL V,-NPGWRN(C)
WARN <Message file size (%10D pages) is approaching MM's limit of %3D>
MOVE M,LASTM
CAIGE M,MSGLEN*<NMSGS-NMSWRN>
CAIL V,<NMTXPG-NPGWRN>
ANNSK.
TXO F,F%SWRN ;Flag warning given
CIETYP <
If either the number of messages or the size of the message file exceeds
MM's limit, then MM will be unable to process the message file. To
prevent this, you should either "DELETE" some messages or split up your
mail file by "MOVE"ing some messages to another file. Then use the EXPUNGE
command to remove those messages from your mail file.
>
ENDIF.
RET
;;;Here when encountered a bad message header. Advance to the next line.
;;;Non-skip if at EOF or too many messages
;;;Skips if should try parsing another message.
PARMSB: SKIPE MSGDAT(M) ;Was previous msg bad too?
IFSKP.
WARN <File has bad format: invalid header for message %M>
SETOM MSGDAT(M) ;Mark this one bad.
ADDI M,MSGLEN ;Bump to start reading next msg.
CAIL M,MSGLEN*<NMSGS-1>
RET
ENDIF.
DO.
ILDB T,A ;Search for LF
CALL BP2CHR
CAMGE V,FILSIZ ;Ran off EOF?
IFSKP.
WARN <Garbage extends to end of file>
RET ;Ignore bad msg, make final size checks
ENDIF.
CAIE T,.CHLFD ;Found that LF?
LOOP. ;No
ENDDO.
SETOM MSGDAT(M) ;Set flag saying prev msg was bad
CALL BP2CHR ;Get new V for this BP
MOVE B,V
SUB B,MSGALL-MSGLEN(M) ;Find length of garbage thus far
MOVEM B,MSGSAL-MSGLEN(M) ;Update total length of bad msg
HRLZM B,MSGBOD-MSGLEN(M) ;Set "body" to all of bad msg.
MOVEM V,MSGALL(M)
RETSKP ;Return, letting caller see if another there
;;; Our own version of NIN, does not hack negative or anything like that
$NIN: SETZ B,
DO.
ILDB D,A
ERJMP R ;In case of non-ex page
CAIL D,"0"
CAILE D,"0"-1(C)
RET ;Done
CAIN C,^D8 ;This makes overflow not happen
LSH B,3
CAIE C,^D8
IMULI B,(C)
ADDI B,-"0"(D)
LOOP.
ENDDO.
; Find header and count the bytes in it
FNDHDC: CALL FNDHDR
IFNSK.
SETZB V,W ;Say we didn't find it
RET
ENDIF.
SETZ W, ;Count size of field in w
CALL CNTHDL ;Count this header line we found
RETSKP ;Success return
; Count bytes in this header line into current count in w
CNTHDL: DO.
ILDB T,A ;Get char
CAIE T,.CHCRT ;Until the CR
AOJA W,TOP.
ENDDO.
RET
;;;Try to find a header in the message body
FNDHDR: HRRZ W,MSGHLN(M) ;Length of header
JUMPN W,FNDHD1
HLRZ W,MSGBOD(M) ;Number of bytes in whole
PUSH P,T
MOVEI T,[BYTE (7) 15,12,15,12]
CALL FNDHD1 ;Find blank line indicating end
SETZ V,
POP P,T
HRRM V,MSGHLN(M) ;Save length of header
SKIPN W,V
HLRZ W,MSGBOD(M)
FNDHD1: HRRZ V,MSGBOD(M) ;Starting byte
CALL SEARCH ;Try to find it
RET ;No good
AOS (P)
CALLRET BP2MCH ;And get char pointer
;;;Try to match a pattern string within a given portion of a msg
SEARCH: HRLI T,(<POINT 7,>)
TDZA A,A
SEARC1: ADDI A,1 ;One more char in search table
ILDB B,T ;Get a character
MOVEM B,STRBUF(A) ;Compile search table
JUMPN B,SEARC1
IFE. A
SKIPE W ;If there is no pattern
RET ; fail if there is text
RETSKP ; else say there is a match!
ENDIF.
SUBI W,(A) ;Difference between text and pattern
JUMPL W,R ; lengths is the maximum # of times
; to check for the presence of pattern
CALL MCH2BP ;Get byte pointer
SKIPL A ;Aligned to word boundary already
JSP U,SEARQ ;Pattern may begin within this word
MOVE N,STRBUF ;First character
IMUL N,[BYTE (1)0 (7)1,1,1,1,1]
MOVE O,N
XOR O,[BYTE (1)0 (7)40,40,40,40,40]
JSP U,.+1 ;Come back to top if pattern not found
DO.
MOVE B,N ;Pattern to match
MOVE C,O ;Case indept one
MOVE D,(A) ;Word to try
LSH D,-1 ;Right justify text word
MOVE E,D
EQVB D,B ;If the first pattern char is present
EQVB E,C ; this results in '177' at that char
ADD D,[BYTE (1)1 (7)1,1,1,1,1] ;Add 1 to each char complementing LSB,
ADD E,[BYTE (1)1 (7)1,1,1,1,1] ; but note that any carry from '177'
EQV D,B ; un-complements LSB of left char!
EQV E,C ;Check sameness of each char LSB
TDNN D,[BYTE (1)1 (7)1,1,1,1,1] ;If any char LSB remains the same
TDNE E,[BYTE (1)1 (7)1,1,1,1,1] ; then there is at least one match!
JRST SEARQ ; Yes, go see!
SUBI W,5 ;We just tested five chars
JUMPL W,R ;Not found
AOJA A,TOP. ;Try some more
ENDDO.
SEARQ: MOVE E,A ;Remember where we begin
DO.
SETZ B,
DO.
SKIPN C,STRBUF(B) ;Get next char
RETSKP ;Null, we found a match
ILDB D,A ;Get next char
TRC D,(C) ;XOR text and pattern chars
CAIE D,0 ;Exact match?
CAIN D,40 ;No, 'other case' match?
AOJA B,TOP. ;Yes, keep trying
ENDDO.
SOJL W,R ;No, Quit if we've run out of text
IBP E ;Incrememt pointer to next char in word
MOVE A,E ;Get back pointer
TLNE E,760000 ;Stop at end of word
LOOP.
ENDDO.
MOVEI A,1(E) ;Point to start of next word
HRLI A,440700
JRST 0(U) ;Not found this word, try some more
;;;Convert byte count in V to byte pointer in A
MCH2BP: ADD V,MSGALL(M) ;Enter here with relative byte count
CHR2BP: SAVEAC <B>
MOVE A,V
IDIVI A,5
ADDI A,MTXPAG ;Offset it right
HLL A,BPS(B)
RET
;;;Vice versa
BP2MCH: CALL BP2CHR
SUB V,MSGALL(M) ;Return relative byte count
RET
BP2CHR: LDB C,[POINT 6,A,5] ;Get position field
MOVEI V,1-MTXPAG(A) ;Clear out bp field
IMULI V,5
IDIVI C,7
SUBI V,(C)
RET
BPS: POINT 7,0
POINT 7,0,6
POINT 7,0,13
POINT 7,0,20
POINT 7,0,27
POINT 7,0,34
;;;Parse the rest of this line as addresses from byte pointer in A,
;;;Inserting default host name pointed to by E,
;;;Using free space from FREETO. F%F4 set means no error messages from here.
LEVPDP: IOWD LEVPLN,LEVPDL ;Level stack pointer
PRADDF: TXOA F,F%FST!F%F4 ;Entry for fast parse
PRADDR: TXZ F,F%FST ;Slow parse entry
MOVE W,FREETO ;Start pointer out right
PRADD0: SETZ C, ;Not looking for anything
MOVE V,LEVPDP ;Get some room for pdl
MOVEI U,STRBUF ;Get some random string space
PRAD00: MOVEI T,(U) ;Save start of address
HRLI U,(<POINT 7,>) ;Make byte pointer for storing name
TXZ F,F%F2!F%AT!F%ADR!F%QOT ;Clear state flags
PRAD01: ILDB B,A ;Get char
CAIN B,","
JRST PRADD0 ;Null address, forget it
JUMPE B,PRADD5 ;End of address prematurely
CAIN B,.CHCRT ;Ignore CR
JRST PRAD01
CAIE B,.CHLFD ;Saw LF?
IFSKP.
MOVE B,A ;Sniff ahead at next character
ILDB B,B
CAIE B,.CHTAB ;Was it whitespace?
CAIN B,.CHSPC
JRST PRAD01 ;Yes, saw a continuation line
JRST PRADD5
ENDIF.
CAIE B,.CHTAB
CAIN B,.CHSPC
JRST PRAD01 ;Flush leading white space
JRST PRAD10 ;Start with this character
;;;Here is the main parsing loop
PRADD1: ILDB B,A ;Get next character
PRAD10: CAIN B,.CHCRT ;Ignore random CR
ILDB B,A
CAIE B,.CHLFD ;End of line?
IFSKP.
MOVE B,A
ILDB B,B ;See if continuation
CAIE B,.CHSPC
CAIN B,.CHTAB
JRST PRADD1 ;Continuation, continue parse
JRST PRADD5 ;End of line, do address
ENDIF.
JUMPE B,PRADD5
JUMPE C,PRAD11 ;Looking for a special character?
CAIN B,(C) ;Yes, found it?
JRST PRAD14 ;Yes
IFGE. C
CAIN B,"(" ;If addresses not allowed inside,
ADDI D,1 ;Bump count if going up another level
JXN F,F%F2,PRADD1 ;Toss it out if ignoring characters
JRST PRAD12 ;No, go ahead and process it
ENDIF.
;;;This is a hack. Its purpose is to get a reasonable parse for:
;;; <foo:bar@rag>
;;;e.g. where the terminating ";" is missing. It accomplishes this by
;;;considering right broket to always close off a level even if inner
;;;levels weren't closed.
CAIE B,.CHRAB ;Close broket?
JRST PRAD11 ;No, some text character
PUSH P,V ;Save current level state
PUSH P,C ;Also current level search character
PRAD09: CAMN V,LEVPDP ;Gone down too many levels?
IFSKP.
POP V,C ;Back up one level
CAIE B,(C) ;Does it match this level?
JRST PRAD09 ;No, back up further
ADJSP P,-2 ;Success, toss out old levels
JRST PRAD14 ;Do level completion stuff
ENDIF.
POP P,C ;Yes, retrieve level search character
POP P,V ;And level state
PRAD11: JXN F,F%F2,PRADD1 ;Go away if ignoring characters
CAIE B,"""" ;Start or end of quoted string?
IFSKP.
TXC F,F%QOT ;Complement " state
JRST PRADD1 ;And go get some more
ENDIF.
JXN F,F%QOT,PRAD13 ;If quoted string, insert all other characters
CAIN B,"," ;End of address?
JRST PRADD5 ;Yes, finish up
CAIN B,.CHLAB ;Start of address after junk?
JRST PRAD22 ;Yes, set to look for matching broket
CAIN B,":" ;Or group name: junk;?
JRST PRAD23 ;Yes, look for ;
CAIN B,"(" ;Start of comment?
JRST PRAD24 ;Yes, look for )
PRAD12: CAIN B,.CHSPC ;End of a token?
JRST PRADD3 ;Yes, check for things like "@"
CAIN B,"@" ;Start of some hostname?
JRST PRADD4
CAIE B,.CHLAB ;Don't let these filter in
CAIN B,";"
JRST PRADD1
PRAD13: CALL PRADPB ;Ordinary character, just stick it in
TXO F,F%ADR ;This address is non-null
JRST PRADD1 ;And on for more
PRAD14: CAIN B,")" ;Close paren?
SOJG D,PRAD11 ;If count unexpired, treat as ordinary
MOVE D,C ;Found matching frob
POP V,C
TXZ F,F%F2 ;Don't ignore any more chars
TLNN D,200000 ;Don't insert char?
JRST PRAD13 ;No, insert it then
DO.
ILDB B,A ;Flush trailing whitespace
CAIE B,.CHTAB
CAIN B,.CHSPC
LOOP.
ENDDO.
JRST PRAD10
PRAD22: SKIPA B,[.CHRAB]
PRAD23: MOVEI B,";"
PUSH V,C ;Save previous state
HRROI C,(B) ;Allow nesting with these
MOVEI U,(T) ;Flush whatever there was before
JRST PRAD00 ;And go re-init all fields
PRAD24: PUSH V,C
MOVEI C,")" ;Will look for matching close
TXO F,F%F2 ;This is a comment, ignore it
TLO C,200000 ;Comments don't insert when done
MOVEI D,1 ;Init nesting count
JRST PRADD1
;;;End of a token, check for @
PRADD3: PUSH P,A ;Save where we are now
PUSH P,B ;And the current character
PRAD30: ILDB B,A ;Get next one
PRAD36: CAIE B,.CHTAB
CAIN B,.CHSPC
JRST PRAD30 ;Flush whitespace
CAIN B,.CHCRT ;Ignore random CR
ILDB B,A
CAIE B,.CHLFD ;Line feed?
IFSKP.
MOVE B,A ;Yes, peek at next character
ILDB B,A ;Continuation?
CAIE B,.CHTAB
CAIN B,.CHSPC
JRST PRAD36 ;Yes, handle it
ELSE.
CAIN B,"("
JRST PRAD32
CAIE B,"@"
ANSKP.
ILDB B,A ;Allow continuation
CAIN B,.CHCRT ;Ignore random CR
ILDB B,A
CAIN B,.CHLFD ;Line feed?
ILDB B,A ;Yes, maybe a continuation line
CAIE B,.CHTAB
CAIN B,.CHSPC
JRST PRAD33 ;Matched, go treat like "@"
ENDIF.
POP P,B ;Get back character that fooled us
POP P,A ;And byte pointer after it
JRST PRAD13 ;And go treat like normal one
PRAD32: ADJSP P,-2
JRST PRAD10
PRAD33: ADJSP P,-2 ;Flush what we saved and enter @ code
PUSH P,A ;Save current pointer
PRAD35: ILDB B,A
CAIE B,.CHTAB ;Ignore excess whitespace
CAIN B,.CHSPC
JRST PRAD35
CAIN B,.CHCRT ;Ignore CR too
ILDB B,A
CAIN B,.CHLFD ;Linefeed?
IFSKP.
POP P,A ;No, assume start of host name
JRST PRADD4
ENDIF.
ILDB B,A ;Yes, continuation line?
CAIE B,.CHTAB
CAIN B,.CHSPC
IFNSK.
ADJSP P,-1 ;Yes, update pointer to here
JRST PRADD4
ENDIF.
POP P,A ;This is a wierd case
PRADD4: TXO F,F%AT ;Flag @ seen
MOVEM U,SAVU
SETZ B,
IDPB B,U ;Stick a null onto end of address
MOVEI U,1(U) ;Point to next word
HRLI T,(U) ;This will be the start of the hostname
HRLI U,(<POINT 7,>)
JRST PRAD01
;;;Here when we have finished parsing the address, stick in any host default
;;;and build up the final block
PRADD5: PUSH P,A ;Save byte pointer
CAIE B,","
TXZA F,F%COMA
TXO F,F%COMA
PRAD50: LDB B,U ;Flush trailing whitespace
CAIE B,.CHSPC
CAIN B,.CHTAB
IFNSK.
ADD U,[7B5]
SKIPGE U
SUB U,[43B5+1]
JRST PRAD50
ENDIF.
SETZ B,
IDPB B,U ;End with null
MOVSI B,(<POINT 7,(T),6>) ;See if got a non-null address
LDB B,B
JUMPE B,PRAD53 ;Flush address if empty
MOVEI U,(W)
MOVEM U,SAVU ;In case of final parse error
SETZM ADRFLG(U)
SETZM ADRLNK(U)
MOVEI A,ADRSTR(W)
HRLI A,(<POINT 7,>)
MOVEI B,(T)
CALL MOVST0 ;Move in user name
MOVEI A,1(A) ;Point to next free word
SUBM A,W ;Get length
EXCH A,W
STOR A,ADSIZ,(U) ;Store size field
JXN F,F%AT,PRAD54 ;Handle net recipient if host name seen
SKIPE C,E ;Was there a default host?
JRST PRAD52 ;Yes, use it then
PRAD51: TXZ F,F%AT ;Make sure this is clear for REPLY
HRROI B,(T) ;User name
HRROI A,[ASCIZ/System/] ;Is address SYSTEM?
STCMP%
IFE. A
MOVX C,SYSCOD ;Yes, pick up system code
JRST PRA520 ;Set type as local user
ENDIF.
HRROI B,(T) ;User name
MOVX A,RC%EMO
RCUSR%
IFNJE.
JXE A,<RC%NOM!RC%AMB>,PRA520 ;Bad local user?
ENDIF.
HRROI A,(T) ;Yes, maybe forwarded or something
TXNN F,F%FST ;Fast parse requested?
CALL CHKFWD ;Forwarded?
JRST PRAD55 ;No, assume error
MOVE C,LCLHST ;Get host string pointer
JRST PRAD52
PRA520: TDZA A,A ;Local recipient
PRAD52: MOVEI A,AD.NET ;Network recipient
STOR A,ADTYP,(U) ;Store type field
MOVEM C,ADRUSR(U) ;And host/user number
PRAD53: POP P,A ;Get back byte pointer
JXN F,F%COMA,PRADD0 ;Unless end of line get next one as well
RET ;All done, return
PRAD54: JXN F,F%FST,PRAD59 ;Fast parse requested?
HLRO A,T ;Host name to look up
CALL HSTNAM ;See if name known
JRST PRAD57 ;Name not found
CAMN A,LCLHST ;Really our local host?
JRST PRAD51 ;Yes, make local address
MOVE C,A ;Else network address, get host pointer
JRST PRAD52
PRA550: PUSH P,A
SKIPA B,[[ASCIZ/local file/]]
PRAD55: MOVEI B,[ASCIZ/local user/]
MOVEI C,(T)
PRAD56: TXNN F,F%F4 ;Unless silence requested
CIETYP < No such %2S as "%3R", address ignored
>
PRAD59: TXZ F,F%AT ;No network address, etc.
MOVE W,SAVU
JRST PRAD53
PRAD57: MOVEI B,[ASCIZ/host/]
HLRZ C,T
JRST PRAD56
;;;Deposit header byte into buffer after checking for overflow (some insanely
;;;long header, etc.)
PRADPB: PUSH P,B ;Save character
HRRZ B,U
CAIL B,LEVPDL ;Beyond a reasonable maximum?
JRST CPPOPJ ;Yes, ignore request
POP P,B
IDPB B,U
RET
;;;Get To and cc lists from message, default host in E
PRTOCC: SKIPE RCCOTH ;Make everybody cc?
TXOA F,F%CC ;Yes, do this from the start
TXZ F,F%CC ;Not in CC yet
PRTO11: CALL PRADDT ;Parse this line
LDB B,A ;Get terminating character
JUMPE B,R ;Null means all done now
CAIN B,.CHCRT ;Was it a CR?
IBP A ;Yes, move over the LF too
PRTO12: ILDB B,A ;Get next char
JUMPE B,R
CAIE B,.CHTAB ;Whitespace indicates continuation
CAIN B,.CHSPC
JRST PRTO11
JRST PRTO15 ;Look for To/cc
PRTO14: ILDB B,A ;Here if don't allow continuation
JUMPE B,R ;Punt if done
PRTO15: CAIE B,"T" ;More to maybe
CAIN B,"t"
JRST PRTO20
CAIE B,"C" ;Or maybe start of cc
CAIN B,"c"
JRST PRTO30
CAIN B,.CHCRT ;Look like CR?
ILDB B,A ;Yes, get the LF?
CAIN B,.CHLFD ;Blank line?
RET ;Yes, done with headers
PRTO13: ILDB B,A ;Otherwise soak up line
CAIN B,.CHLFD ;Saw linefeed yet?
JRST PRTO14 ;Yes, try this line (no continuation)
JUMPN B,PRTO13 ;Keep on going unless EOM
RET
PRTO20: ILDB B,A
CAIE B,"O"
CAIN B,"o"
CAIA
RET
ILDB B,A
CAIE B,":"
RET ;No good I guess
JRST PRTO11 ;Get rest of this line then
PRTO30: ILDB B,A
CAIE B,"C"
CAIN B,"c"
CAIA
RET
ILDB B,A
CAIE B,":"
RET
TXO F,F%CC ;Now doing cc
JRST PRTO11 ;And now go get more
;;;Add new recipients to the appropriate lists
ADDTO: TXNE F,F%CC
SKIPA T,[CCLIST]
MOVEI T,TOLIST
ADDTO0: HRRZ U,FREETO
HRRZM W,FREETO ;Update free pointer now
DO.
CAIN U,(W) ;Got to where we left off?
RET ;Yes, done
LOAD B,ADTYP,(U) ;Get type field
MOVEI B,LCLIST(B)
CALL ADDLST ;Add into transmission medium list
IFSKP.
SKIPN (T) ;Not duplicate, this the first entry?
HRRM U,(T) ;Yes, store it as head then
HLRZ B,(T) ;Get old tail
IFN. B
STOR U,ADPTR,(B) ;Link to old tail
ENDIF.
HRLM U,(T) ;This is new tail
ENDIF.
LOAD B,ADSIZ,(U) ;Get size
ADDI U,(B)
LOOP.
ENDDO.
;;;Thread block in U into list in B
ADDLST: MOVE C,ADRUSR(U)
SKIPE V,(B)
IFSKP.
HRRM U,(B) ;No previous, store this at the end
RETSKP
ENDIF.
DO.
CAMG C,ADRUSR(V)
IFSKP.
HRRZ D,ADRLNK(V) ;Get next element of list
JUMPE D,ENDLP. ;None there, put on end of list
MOVEI V,(D)
LOOP.
ELSE.
CAIN B,LCLIST
CAME C,ADRUSR(V) ;Local user matches exactly?
SKIPA D,V
RET ;Yes, flush it
HRRM V,ADRLNK(U) ;Link to next
HLRZ V,ADRLNK(V) ;Get previous
HRLM U,ADRLNK(D) ;Link to previous
IFE. V
HRRM U,(B) ;No previous, store this at the end
RETSKP
ENDIF.
ENDIF.
ENDDO.
HRRM U,ADRLNK(V) ;Add this to end of list
HRLM V,ADRLNK(U) ;Link to previous
RETSKP
;;;Remove element in W from transmission medium list
REMLST: HLRZ A,ADRLNK(W) ;Link to previous this medium
HRRZ B,ADRLNK(W) ;Link to next this transmission medium
SKIPE B ;Unless tail of list...
HRLM A,ADRLNK(B) ;New link to previous for next element
SKIPE A ;Unless head of list...
HLRM B,ADRLNK(A) ;New link to next for previous element
IFE. A ;If this was the head of the list
LOAD A,ADTYP,(W) ;Get transmission medium type
HRRM B,LCLIST(A) ;Set as starting pointer
ELSE.
HRRM B,ADRLNK(A) ;Link as next
ENDIF.
RET
SUBTTL Message handling subroutines
;;;Type out header of a message
RHEAD: CONFRM ;Type header of current message
TYPHDR: SETABT CMDABO ;Allow CTRL/N abort
CALL TYPINI ;Init CCOC state
CALL CRIF ;Get a fresh line
MOVE O,[POINT 7,WRTPGS] ;Place to put the string
CALL TYPHD1
HRROI A,WRTPGS ;Now type it out
PSOUT%
MOVEI D,SAVMOD
CALLRET SETTYM
;;;Stick the header for a message into the string in O
TYPHD0: TXZA F,F%F3 ;Not to TTY
TYPHD1: TXO F,F%F3 ;To TTY
MOVE T,MSGBTS(M) ;Get messages bits
MOVX A,.CHSPC ;This if message not recent
SKIPL MSGFLG(M) ;Message recent?
IFSKP.
MOVEI A,"R" ;Yes, note as recent
TXON T,M%SEEN ;Unseen as well?
MOVEI A,"N" ;Yes, is new then
ENDIF.
IDPB A,O
TXNE T,M%SEEN
SKIPA A,[.CHSPC]
MOVEI A,"U" ;Unseen
IDPB A,O
TXNN T,M%ATTN ;Flagged
SKIPA A,[.CHSPC]
MOVEI A,"F"
IDPB A,O
TXNN T,M%RPLY ;Answered
SKIPA A,[.CHSPC]
MOVEI A,"A"
IDPB A,O
TXNN T,M%DELE
SKIPA A,[.CHSPC]
MOVEI A,"D" ;Deleted
IDPB A,O
MOVEI B,MSGLEN(M) ;Message number
IDIVI B,MSGLEN
CAIGE B,^D1000 ;yduJ pacification
IFSKP.
MOVEI A,"*" ;Indicate 1000 or over
IDPB A,O
SUBI B,^D1000
MOVX C,NO%LFL!NO%ZRO!2B17!^D10
ELSE.
MOVX C,NO%LFL!3B17!^D10
ENDIF.
MOVE A,O
NOUT%
NOP
MOVEI B,[ASCIZ/) /]
CALL MOVSTR
PUSH P,A
SKIPLE B,MSGDAT(M) ;Date
IFSKP.
DMOVE T,[ASCIZ/ /] ;Fill with spaces if not there
ELSE.
HRROI A,T ;Where to stick string
MOVX C,OT%NTM
ODTIM%
TLZ U,(<BYTE (7) 0,177>) ;Clear out year and anything else
ENDIF.
MOVE A,(P)
MOVEI B,T
CALL MOVSTR
MOVEM A,(P)
CALL FRMMEP ;Check if message is from me or not
MOVE A,MSGFRM(M) ;Isn't, show From field
MOVEI B,^D15 ;Limited to 15 chars
POP P,O ;Get back string pointer
CALL TYPHDX
IFN. B ;None more needed
MOVX A,.CHSPC
DO.
IDPB A,O
SOJG B,TOP. ;Fill with spaces
ENDDO.
ENDIF.
MOVE A,MSGBTS(M) ;Relevant keyword flags
CALL KEYSTR ;Insert string for that
MOVE A,MSGSUB(M) ;Subject field
IFXE. F,F%F3 ;Outputting to TTY?
MOVEI B,^D200 ;No, use a very large limit then!
CALL TYPHDS ;Output subject
MOVE A,O
ELSE.
MOVEI B,^D33 ;Limit to 33 chars
SUBI B,(T) ;Less what we used for keywords
CAIGE B,4 ;Yes, do sanity check on count
ANSKP.
SKIPE JISMOD ;JIS terminal?
SUBI B,2
SKIPE SIMODE ;Katakana?
SUBI B,1
CALL TYPHDS ;Output subject
MOVE A,O
MOVEI B,[ASCIZ/(B/] ;Reset to romanji from kanji
SKIPE JISMOD
CALL MOVSTR
MOVEI B,.CHCNO ;Reset to romanji from katakana
SKIPE SIMODE
IDPB B,A
ENDIF.
MOVEI B,[ASCIZ/ (/]
CALL MOVSTR
HLRZ B,MSGBOD(M) ;Length of message
MOVEI C,^D10
NOUT%
NOP
MOVEI B,[ASCIZ/ chars)
/]
CALL MOVST0
ADD A,[7B5] ;Return pointer before null
SKIPG O,A
SUB A,[43B5+1]
RET
; Routine to set up msg header for forwarding
FWDHDR: MOVE A,[POINT 7,WRTPGS] ;Place to put the string
MOVEI B,.CHSPC
IDPB B,A
PUSH P,A ;Save current ptr
SKIPLE B,MSGDAT(M) ;Date
IFSKP.
DMOVE T,[ASCIZ/ /] ;Fill with spaces if not there
ELSE.
HRROI A,T ;Where to stick string
MOVX C,OT%NTM
ODTIM%
TLZ U,(<BYTE (7) 0,177>) ;Clear out year etc.
ENDIF.
MOVE A,(P)
MOVEI B,T
CALL MOVSTR
MOVEM A,(P)
CALL FRMMEP ;Check if message is from me or not
MOVE A,MSGFRM(M) ;Isn't, show From field
MOVEI B,^D20 ;Limited to 20 chars
POP P,O ;Get back string pointer
CALL TYPHDX
IFN. B ;None more needed?
MOVX A,.CHSPC
DO.
IDPB A,O
SOJG B,TOP. ;Fill with spaces
ENDDO.
ENDIF.
MOVE A,MSGSUB(M) ;Subject field
MOVEI B,^D45 ;Limited to 45 chars
CALL TYPHDS
MOVE A,O
MOVEI B,CRLF0
CALLRET MOVST0
TYPHDS: TDZA E,E ;Don't ignore addresses
TYPHDX: SETO E, ;Ignore addresses within brokets
MOVEI D,.CHSPC
IDPB D,O
JUMPE A,R ;Nothing there to type
HRRZ V,A ;Start of field
HLRZ C,A ;Length
JUMPE C,R ;If empty, give up
CALL MCH2BP ;Get byte pointer
DO.
ILDB D,A ;Get first character
CAIE D,.CHSPC ;Saw whitespace?
CAIN D,.CHTAB
SOJG C,TOP. ;Yes, ignore it
JUMPE C,R ;If nothing left, lost
IFN. E ;If flushing things in brokets
CAIN D,.CHLAB ;Start of broketed address?
RET ;Yes, lost. Don't use remaining characters
ENDIF.
ENDDO.
CAILE C,(B) ;Number of eligible chars too large?
MOVEI C,(B) ;Yes, truncate
SUBI B,(C) ;Get number of chars needed to fill
IDPB D,O ;Stash character in string
SOJLE C,R ;Count it
DO.
ILDB D,A
CAIE D,.CHLAB ;Start of address?
IFSKP.
ANDN. E
ADDI B,(C) ;Yes, don't use remaining characters
RET
ENDIF.
IDPB D,O
SOJG C,TOP.
ENDDO.
RET
;;;Check if message is from me, and setup to type out To: field if so
FRMMEP: MOVE A,MSGFLG(M)
IFXE. A,M%FRME!M%FRNM ;See if we have done this before
HRRZ V,MSGFRM(M) ;No, have to check
MOVX A,M%FRNM ;Not from me if don't know who it's from
IFN. V ;Know who it's from?
CALL MCH2BP
SETZ E, ;No host name defaulting
PUSH P,F ;Save all flags
MOVEI W,TOPAG
SKIPN FREETO ;Make sure have some free space to work with
MOVEM W,FREETO
CALL PRADDF ;Get the guy, but don't add to anything
POP P,F
MOVE W,FREETO ;Get the address just added
HRROI A,MAUSRS
HRROI B,ADRSTR(W)
STCMP%
SKIPN A ;Match?
SKIPA A,[M%FRME] ;Yes, from me
MOVX A,M%FRNM ;Not from me
ENDIF.
IORB A,MSGFLG(M)
ENDIF.
JXE A,M%FRME,R ;Single return to use From if not me
MOVEI T,[ASCIZ/
To:/]
CALL FNDHDC ;Find To: field
RET ;Not found, use From
HRREI A,-3(V) ;Include length of "To:"
JUMPL A,R ;Didn't find to, still need From
HRLI A,3(W) ;Length of string plus "To: " header
RETSKP
;;; Translate bits into string, byte pointer in O, bits in A
;;; Returns bytes output in T
KEYSTR: TXZ F,F%COMA
SETZ T, ;Init count
TXZ A,M%FLAG
JUMPE A,R
KEYST1: JFFO A,KEYST2 ;{
MOVEI C,"}"
TXZE F,F%COMA ;Anything output?
IDPB C,O ;Yes, finish it up
RET
KEYST2: MOVSI C,400000
MOVN D,B
LSH C,(D)
XOR A,C ;Clear out the bit in question
HLRZ C,KEYTBL ;Number of entries in table
MOVEI D,KEYTBL+1 ;Start of table
KEYST3: SOJL C,KEYST1 ;Failed to find anything, forget it
HRRZ E,(D) ;Get number for this frob
CAIE E,(B) ;Matches?
AOJA D,KEYST3 ;Keep looking
TXOE F,F%COMA ;Started list yet?
IFSKP.
MOVEI C,.CHSPC ;No, start it up with space and bracket
IDPB C,O
ADDI T,1
MOVEI C,"{" ;}
AOJA T,KEYST4
ENDIF.
MOVEI C,","
KEYST4: IDPB C,O
ADDI T,1 ;{ "," or "}"
HLRZ D,(D)
HRLI D,(<POINT 7,>)
KEYST5: ILDB C,D
JUMPE C,KEYST1
IDPB C,O
AOJA T,KEYST5
;;;Type out a message
LRTYP: SKIPG MSGJFN
ERROR <No current file>
CONFRM ;Confirm first
CALLRET TYPMSL
TYPMS: SKIPG MSGJFN
ERROR <No current file>
CONFRM ;Confirm first
TYPMSG: TXZA F,F%F2 ;Normal filtering
TYPMSL: TXO F,F%F2 ;Literally from message
CALL TYPINI ;Init CCOC state
SETABT CMDABO ;Allow aborts during typeout
HLRZ C,MSGBOD(M) ;Length of message
CIETYP < Message %M (%3D characters):
>
JUMPE C,TYPMS4 ;If empty message output nothing more
MOVN C,C
HRRZ V,MSGBOD(M)
CALL MCH2BP
MOVE B,A
TXNE F,F%F2 ;Unless literal headers requested
JRST TYPMS3
SKIPN SPRHDR ;Any suppressed headers?
SKIPE ONLHDR ;Or only certain ones?
JRST TYPSHD ;Yes, process the slow way then
TYPMS3: MOVX A,.PRIOU
SOUT% ;Print the message out
TYPMS4: MOVEI D,SAVMOD ;Restore program's modes
CALL SETTYM
MOVX A,M%SEEN ;Mark message as seen
IORM A,MSGBTS(M)
MOVE A,MSGDAT(M) ;Get date of message
CAMLE A,BBXDAT ;Later than last one written?
TXNN F,F%BB ;Playing with BBoards now?
SKIPA ;No or no, don't write anything
CALL SXDAT ;Set it into index file
CALLRET UPDBIT ;And maybe update
;;;Message typeout init routine
TXTINI: SAVEAC <A,B,C>
SKIPN SIMODE ;If Katakana terminal...
IFSKP.
MOVX A,.TICCN ;Deassign CTRL/N to undo any previous assign
DTI%
ERJMP .+1
MOVX A,ST%DIM!.FHJOB ;Cancel special handling of CTRL/O
DMOVE B,SAVMOD+3
TXZ B,1B<.CHCNO>
STIW%
ERJMP .+1 ;We tried...
ENDIF.
JRST TYPIN0
TYPINI: SAVEAC <A,B,C>
TYPIN0: MOVX A,.PRIOU ;Yes, current CCOC
RFCOC%
SKIPN BSPDSP ;User want image backspaces?
IFSKP.
TXZ B,1B17 ;Want 2B17 for image backspace
TXO B,2B17
ENDIF.
SKIPN SIMODE ;User want image SI/SO?
IFSKP.
TXZ B,1B29!1B31
TXO B,2B29!2B31
ENDIF.
SKIPN JISMOD ;User want image escapes?
IFSKP.
TXZ C,1B19
TXO C,2B19
ENDIF.
SFCOC% ;Set updates
RET
;;;Type out the headers not in the suppressed list only, count in C, bp in B
TYPSHD: TXZ F,F%F2 ;Clear state flag
TYPSH0: ILDB D,B ;Get first character of line
CAIE D,.CHCRT ;Start of blank line?
IFSKP.
ADD B,[7B5] ;Yes, back over it
JRST TYPMS3 ;And type rest of message
ENDIF.
SETZ E, ;Reset pointer to :
CAIE D,.CHSPC ;Space
CAIN D,.CHTAB ;Or tab is continuation line
ADDI E,1 ;Remember this specially
SKIPA A,[POINT 7,STRBUF] ;Save header here
TYPSH1: ILDB D,B ;Get next character
AOJGE C,TYPMS4 ;Nothing but headers
IDPB D,A ;Stick it in
JUMPN E,TYPSH2 ;Unless already saw a :
CAIN D,":" ;If this is one
SKIPA E,A ;Remember it's position
TYPSH2: CAIE D,.CHLFD ;End of a line?
JRST TYPSH1 ;No, continue accumulating
SETZ D, ;See if this is a losing header
IDPB D,A ;Make line end with null
JUMPE E,TYPSH3 ;Didn't see a :, type the line out
CAIN E,1 ;Continuation line?
JRST TYPSH4 ;Yes, check against last case
DPB D,E
PUSH P,B ;Save current pointer
HRROI B,STRBUF
PUSH P,C
SKIPN ONLHDR ;Have headers to type out explicitly?
IFSKP.
MOVEI A,ONLHDR
TBLUK%
TXNE B,TL%NOM!TL%AMB!TL%ABR ;Complement the flags,
TDZA A,A ;if no match, say it matched
MOVX A,TL%NOM
ELSE.
MOVEI A,SPRHDR
TBLUK% ;Look for it
HLLZ A,B ;Get result flags
ENDIF.
POP P,C
POP P,B
TXNN A,TL%NOM!TL%AMB!TL%ABR ;One we know to flush?
TXOA F,F%F2 ;Yes, remember we flushed it
TXZA F,F%F2 ;No, will print it
JRST TYPSH0 ;Handle next line
MOVEI D,":" ;Put back in the :
DPB D,E
TYPSH3: HRROI A,STRBUF
PSOUT% ;Type out a winning line
JRST TYPSH0 ;And continue to next one
TYPSH4: TXNE F,F%F2 ;Continuation line, last one flushed?
JRST TYPSH0 ;Yes, flush this too
JRST TYPSH3 ;No, type this part too
CHKDEL: MOVX A,M%DELE
TDNN A,MSGBTS(M) ;Deleted?
RETSKP ;No, skip return
CIETYP < Message %M deleted, ignored.
>
RET ;Single return
;;;Type out headers of recent messages
RECEN1: SAVEAC <M>
RECEN2: TXZA F,F%F1 ;Don't type headers
RECENT: TXO F,F%F1 ;Say type headers
RECEN0: SKIPG MSGJFN ;Any message file?
RET ;No, don't do anything
SETZB M,NRECNT
SETZM NUNSEE
SETZM NDELET
TXO F,F%F2 ;No BB banner typed yet
DO.
DO.
SKIPLE B,MSGDAT(M) ;Get recv date of message
CAMG B,LASTRD ;Check against last read date
IFNSK.
TXNN F,F%BB ;If BBoard mail, or
TXNE F,F%MOD ;If doing system mail
IFNSK.
MOVX A,M%SEEN
IORM A,MSGBTS(M) ;Make all old messages seen
EXIT.
ENDIF.
MOVE A,MSGBTS(M) ;a := msg bits
SKIPE FLMAUT ;Suppress showing flagged messages?
EXIT. ;Yes, don't print header
JXN A,M%DELE,ENDLP. ;Don't print header if msg deleted
JXE A,M%ATTN,ENDLP. ;Don't print header if not flagged
ELSE.
MOVX A,M%RECE ;Bit to set if recent
IORM A,MSGFLG(M) ;Say it's recent
AOS NRECNT ;Count one more
ANDXN. F,F%BB!F%MOD ;If BBoard or system mail,
MOVX A,M%SEEN
ANDCAM A,MSGBTS(M) ;Make all recent unseen
ENDIF.
IFXN. F,F%F1 ;Want headers?
MOVE A,MSGJFN ;Yes, get JFN for possible banner
TXNE F,F%BB ;If not BBoard file,
TXZN F,F%F2 ;Or we already typed banner,
TRNA ;Then don't do it again. Else,
CIETYP <Reading BBoard file %1J>
CALL TYPHDR ;Type the header
ENDIF.
ENDDO.
MOVE A,MSGBTS(M)
TXNN A,M%SEEN ;Count unseen and deleted messages
AOS NUNSEE
TXNE A,M%DELE
AOS NDELET
CAML M,LASTM ;Thru with all msgs?
IFSKP.
ADDI M,MSGLEN
LOOP. ;No
ENDIF.
ENDDO.
MOVE A,NRECNT
IMULI A,MSGLEN
SKIPE M ;Unless all messages are new,
SUBI M,(A) ;Set current msg to last non-recent
MOVNI A,MSGLEN ;Set prior M to -1 in case all new
MOVEM A,PRIORM
RET
;;;Type out summary of the current file
SUMMRY: SKIPG MSGJFN ;Is there a file?
RET ;No, nothing to say here
MOVE A,LASTM ;Get number of messages
IDIVI A,MSGLEN
AOS D,A
MOVEI B,[ASCIZ/Last read: %3T/]
TXNE F,F%MOD ;Special message for system mail
MOVEI B,[ASCIZ/Last login: %3T/]
SKIPG C,LASTRD ;Last read date
MOVEI B,[ASCIZ/Never read/]
SUB D,NRECNT ;Number of old messages
SKIPN NRECNT
TDZA E,E
MOVEI E,[ASCIZ/ (%4D old)/]
HRRZ T,FILPGS ;Number of pages
CETYPE < %2S, %1D message%1P%5S, %6D page%6P>
MOVE T,NUNSEE
SUB T,NRECNT
SKIPG T
TDZA E,E
MOVEI E,[ASCIZ/ %6D message%6P unseen/]
SETZ C,
SKIPG D,NDELET
IFSKP.
MOVEI C,[ASCIZ/; %4D deleted/]
SKIPG T
MOVEI C,[ASCIZ/ %4D message%4P deleted/]
ENDIF.
CETYPE <%5S%3S>
RET
;;;Update the file copy of the message bits, unless in read command
UPDBIT: MOVE B,MSGBTS(M) ;Get new copy of bits
TXNN F,F%RONL ;Don't try to munge system mail
CAMN B,MSGFBS(M) ;Old matches new?
RET ;Yes, no need to do any more
CALL GETJF2 ;Get a second JFN if don't already
RET ;Failed
CALL ABNOFF ;No aborts
NOINT ;No outside diddling
MOVE V,MSGALL(M) ;Start of the message header
CALL CHR2BP ;Get byte pointer
DO.
ILDB B,A ;Get char
CAIE B,.CHCRT ;At end of line??
IFSKP.
CALL CLSJF2 ;Ugh. Put away the JFN
SETO B, ;And see if message known to be bad.
CAME B,MSGDAT(M) ;Skip if known bad.
WARN <File has bad format: unable to find message flag field>
ELSE.
CAIE B,";" ;At start of bits?
LOOP.
PUSH P,A ;Save the core pointer
SUBI A,MTXPAG ;Get absolute pointer
TLNN A,760000 ;Make sure point to correct first word
ADD A,[43B5+1]
PUSH P,A ;Save that pointer
ANDI A,-1
IDIVI A,1000 ;Get page number we need
HRL A,MSGJF2
CAIL B,775 ;If near end of page
SKIPA C,[PM%CNT+PM%WR+PM%RD+2] ;Map two pages
MOVX C,PM%WR!PM%RD
MOVE B,[.FHSLF,,WRTPGS/1000]
PMAP%
POP P,D ;Get back byte pointer
TXZ D,777000 ;Just relative to page
ADDI D,WRTPGS ;Offset right
POP P,A ;Get back core pointer
MOVE B,MSGBTS(M) ;Bits to set out
MOVEM B,MSGFBS(M) ;Set file bits since we're changing it
MOVEI E,^D12 ;There are twelve chars..
DO.
SETZ C, ;Compose next "digit"
ROTC B,3
ADDI C,"0"
IDPB C,D ;Update disk file
SOJG E,TOP.
ENDDO.
SETO A,
MOVE B,[.FHSLF,,WRTPGS/1000]
MOVE C,[PM%CNT+2]
PMAP% ;Unmap the pages
CALL CLSJF2 ;Close up the file
ENDIF.
ENDDO.
OKINT ;Reenable interrupts
RET
;;; Here to close out writable version of msg file
CLSJF2: HRLZ A,MSGJF2 ;JFN,,first file page
MOVEI B,777 ;Update all pages
UFPGS%
JWARN <File update failed>
HRRZ A,MSGJF2
TXO A,CO%NRJ ;Keep this JFN around
CLOSF%
ERJMP .+1
HRRZ A,MSGJF2
; CALLRET SETREF ;Set read date to now
SETREF: JXN F,F%RONL,R ;Never set reference date if read-only
MOVE C,A ;Save JFN
GTAD% ;Set read date to now
EXCH C,A ;Get back JFN
HRLI A,.FBREF
SETO B, ;Cause we are going to reparse
CHFDB%
ERJMP .+1 ;Maybe no access, don't worry
HRRZS A ;Flush the LH to purify JFN value
RET ;Done
GETJF2: JXN F,F%RONL,R ;Don't open second handle if read-only
SKIPLE A,MSGJF2 ;Have one already?
IFSKP.
HRROI A,FILNAM ;No, make a new one
MOVE B,MSGJFN ;One we do have
MOVE C,[111110,,JS%PAF]
JFNS%
MOVX A,GJ%OLD!GJ%SHT!GJ%ACC
HRROI B,FILNAM
GTJFN%
JERROR <Can't get second handle on file>
MOVEM A,MSGJF2 ;Save JFN
ENDIF.
MOVE B,[<FLD 7,OF%BSZ>!OF%RD!OF%WR!OF%DUD] ;Open for write
; No DDMP dribble so that the disk copy isn't left in
; an inconsistant state
OPENF% ;(Now write-locked against new msgs).
IFJER.
CAIE A,OPNX9 ;File busy?
IFSKP.
MOVX A,^D2000 ;Wait 2 seconds and try again
DISMS%
JRST GETJF2
ENDIF.
MOVE A,MSGJF2
JWARN <Can't open "%1J" for write>
RET
ENDIF.
CALL CHECK1 ;File size change? (dates changed)
IFSKP.
CALL CLSJF2 ;Close our write JFN
CALL CHECKS ;Update new msgs
JRST GETJF2 ;And try again
ENDIF.
MOVE A,MSGJF2 ;Return value
RETSKP
SUBTTL Message sequence subroutines
;All messages = 1:n
STQALL: MOVE A,[BYTE (12) 7777,0,6000]
MOVEM A,MSGSEQ
SETOM MSGSEQ+1
CALLRET GTSQNS
;Previous-sequence
STQPRV: LDB A,[POINT 12,WRKSEQ,23] ;Was there a previous sequence?
CAIN A,7777
ERROR <No previous sequence>
MOVE A,[WRKSEQ,,MSGSEQ] ;Copy previous working sequence
BLT A,MSGSEQ+<NMSGS/3-1>
CALLRET GTSQNS ;Handle like numeric sequence
STQUND: SKIPA A,[NXTUND] ;Undeleted
STQDEL: MOVEI A,NXTDEL ;Deleted
STQDL0: MOVEM A,NXTMSD
RET
; Headers only or separate pages when listing msgs
STQSEE: SKIPA A,[NXTSEE] ;Seen
STQUNS: MOVEI A,NXTUNS ;Unseen
CALLRET STQDL0
STQREC: SKIPA A,[NXTREC] ;Recent
STQNEW: MOVEI A,NXTNEW ;New
CALLRET STQDL0
STQFLG: SKIPA A,[NXTFLG] ;Flagged
STQUNF: MOVEI A,NXTUNF ;Unflagged
CALLRET STQDL0
STQANS: SKIPA A,[NXTANS] ;Answered
STQUNA: MOVEI A,NXTUNA ;Unanswered
CALLRET STQDL0
;Sequences which are really flag setting commands
STQREV: MOVNS MSCANF ;Invert scan direction
SETZM NXTMSD ;No need to qualify each msg
RET
STQLST: NOISE (NUMBER OF MESSAGES) ;Last n
MOVEI B,[FLDDB. .CMNUM,,^D10,,1]
CALL CMDFLD ;Get a number
JUMPLE B,BADNUM ;Must be positive number
CAIN B,1 ;Just one?
JRST STQLS1 ;Last one message
MOVE C,LASTM
IDIVI C,MSGLEN
SUBM C,B ;Starting message of sequence
AOJL B,BADNUM ;Number out of range
CALL GTSQLC ;Put that in as the start
MOVEI B,2000(C) ;Last message as end of sequence
CALLRET STQLS2 ;And go handle that sequence
STQCUR: SKIPGE B,M ;Current message
MOVE B,PRIORM ;No valid current, try prior current
JUMPL B,[ERROR <No current message>]
SKIPA
STQLS1: MOVE B,LASTM ;Just last message
IDIVI B,MSGLEN
STQLS2: CALL GTSQLC ;Save on list
CALLRET GTSQNR ;Done with list
STQTO: SKIPA A,[NXTTO] ;Match to string
STQFRM: MOVEI A,NXTFRM ;Match from string
CALLRET STQSB0 ;Common routine to get pattern
STQFMM: MOVEI A,NXTFRM ;Match "from me" string
JRST STQCC0
STQTOM: SKIPA A,[NXTTOM] ;Match "to me" string
STQCCM: MOVEI A,NXTCCM ;Match "cc me" string
STQCC0: MOVEM A,NXTMSD
HRROI B,MAUSRS ;Use my alias string
CALLRET STQSB2 ;Install pattern
STQTXT: SKIPA A,[NXTTXT] ;Match text substring
STQSBJ: MOVEI A,NXTSBJ ;Match subject string
STQSB0: MOVEM A,NXTMSD
NOISE (STRING)
MOVEI B,[FLDDB. .CMQST,,,,,<[FLDDB. .CMTXT]>]
CALL CMDFLD ;Read quoted string, or text line
HRROI B,STRBUF ;Copy string to pattern buffer
STQSB2: HRRO A,PATFRE
HRRZM A,NXTPAT ;Save ptr to start
SETZ C,
SOUT%
TLNN A,760000 ;Final null in next word?
ADDI A,1 ;Yes, skip over it
MOVEI A,1(A)
MOVEM A,PATFRE ;Update free ptr
CAIL A,<CSBUF+CSBFSZ> ;Overflow?
ERROR <Pattern string space overflow>
RET
; Discriminate by msg size
STQSHT: SKIPA A,[NXTSHT] ;"Shorter than" spec
STQLNG: MOVEI A,NXTLNG ;"Longer than" spec
MOVEM A,NXTMSD ;Save the processing routine
HRROI A,STRBUF ;Set up default number string
MOVE B,DFSHML
MOVEI C,^D10
NOUT%
ERJMP BADNUM
NOISE (THAN NUMBER OF CHARACTERS)
MOVEI B,[FLDDF. .CMNUM,,^D10,,STRBUF]
CALL CMDFLD ;Get a number
JUMPL B,BADNUM ;Must be positive number
MOVEM B,NXTIME ;Borrow time cell for length
RET
PURGE FLDDF. ;Last occurance in MM
STQBEF: SKIPA A,[NXTBEF] ;Before date
STQAFT: MOVEI A,NXTAFT ;After date
CALLRET STQON1
STQON: MOVEI A,NXTON ;On date
STQON1: MOVEM A,NXTMSD
NOISE (DATE)
CALL GETDAT
MOVEM B,NXTIME
RET
STQKYW: SKIPA A,[NXTKEY] ;Keyword
STQUKW: MOVEI A,NXTUNK ;Unkeyword
MOVEM A,NXTMSD
CALL GETKEY
MOVEM U,KEYBTS ;Save keyflag bits to hunt for
MOVEM V,KEYLPF ;and keyword list
RET
;;;Get sequence, default to current message
DFSQTH: SKIPA A,[[ASCIZ/CURRENT/]] ;Setup default number to this message
DFSQNW: MOVEI A,[ASCIZ/UNSEEN/] ;Default to unseen
CALLRET DFSQA1
DFSQRC: SKIPA A,[[ASCIZ/RECENT/]] ;Default to recent
DFSQAL: MOVEI A,[ASCIZ/ALL/] ;Default to all messages
DFSQA1: SKIPG MSGJFN ;Must have a file
ERROR <No current file>
UDEF (A) ;This is the default
; CALLRET GETSEQ
;;;Message sequence handler
; Flags:
; F%F1 on Subcommands being entered on separate lines
; F%F2 on Current line had a command
; F%F3 on Negation in progress [hook only for now]
; F%F4 on Negation just seen [hook only for now]
GETSEQ: NOISE (MESSAGES)
SETABT CMDABO ;Allow abort out of sequence type-in
CALL ABNOFF ;Don't CTRL/N out until subcommand level
TXZ F,F%F1!F%F2!F%F3!F%F4!F%TYPS ;Default don't type sequence #'s
SETOB E,LSTMSG
MOVE A,CMDRET ;Get caller's CMDRET
MOVEM A,SEQCAL ;Save it in case subcommands change it
SETZB A,CMDSTK ;No subcommands yet
MOVE L,[POINT 12,MSGSEQ,11] ;Pointer to where to store messages
CALL STQALL ;Assume all msgs will be considered
CALL PSHCMD ;NXTSEQ should always be the first function!!!
MOVMS MSCANF ;Assume forward scan
MOVEI A,PATSTR ;Init pattern string space
MOVEM A,PATFRE
PUSH P,M ;Place for msg ptr at line start
PUSH P,L ;Place for seq ptr at line start
PUSH P,MSCANF ;Place for MSCANF at line start
PUSH P,CMDSTK ;Place for CMDSTK at line start
MOVEM P,SAVP ;Save the main stack ptr
MOVE A,[FLDDB. .CMCMA,CM%SDH,,,,GTNBK3]
MOVEM A,CMDFLB
UHELP [ASCIZ/"," to enter message-sequence subcommand mode/]
MOVX B,CM%DPP
SKIPE A,CMDFLB+.CMDEF ;Default provided?
IORM B,CMDFLB+.CMFNP ;Yes, say there is one
HRRZM A,GTSQDF ;Remember default (if any)
MOVEI B,CMDFLB ;Keep default if any
CALL $COMND ;Parse it with comma possible
IFXN. A,CM%NOP ;Did it win?
MOVEI B,GTNBK5 ;No, parse it again to get good error
CALL CMDFLD
FATAL <Impossible non-error after error in GETSEQ>
ENDIF.
LOAD A,CM%FNC,(C) ;Get field type
CAIE A,.CMCMA ;Comma?
IFSKP.
TXO F,F%F1 ;Yes, flag start of subcommands
CONFRM ;Better be end of line
MOVEI A,GETSQR ;Go here on command error
HRRM A,CMDRET ;Set as error return
CALL ABNON ;Allow abort out of sequence type-in
JRST GETSQ3
ENDIF.
JRST GETSQ2
GETSQ0: TXZ F,F%F3!F%F4 ;Reset negation flags
GETSQ1: MOVE A,[FLDDB. .CMCFM,,,,,GTNBK3]
MOVEM A,CMDFLB
SKIPLE A,GTSQDF ;Is there (still) a default?
UDEF (A) ;Yes, set it up
MOVEI B,CMDFLB
CALL CMDFLD ;Parse the field
LOAD A,CM%FNC,(C) ;Get field type
GETSQ2: CAIE A,.CMTOK ;Token?
IFSKP.
CALL GETSQT ;Yes, parse token
CALL PSHCMD ;Put command on stack
JXN F,F%F1,GETSQ3 ;Subcommands on separate lines?
JRST GETSQ5 ;No, all done then
ENDIF.
CAIE A,.CMNUM ;Number?
IFSKP.
CALL GETSQN ;Yes, collect sequence
CALL PSHCMD ;Put command on stack
JXN F,F%F1,GETSQ3 ;Subcommands on separate lines?
JRST GETSQ5 ;No, all done then
ENDIF.
CAIE A,.CMCFM ;Is it the end?
IFSKP.
SKIPE CMDSTK ;Any prior commands?
IFSKP.
CALL STQCUR ;Default use current msg
CALL PSHCMD ;Install it
JRST GETSQ5 ;And finish up
ENDIF.
TXNE F,F%F1 ;Subcommands on separate lines?
TXZN F,F%F2 ;Yes, any on this line?
JRST GETSQ5 ;No, finish up
JRST GETSQ3 ;Get some more
ENDIF.
HRRZ A,(B) ;No, get routine addrs
CALL (A) ;Go there and return
TXZE F,F%F4 ;Negation just set?
JRST GETSQ1 ;Yes, do rest of command
CALL PSHCMD ;Stack this command
JRST GETSQ0 ;Get next subcommand
; Here to begin a new line
GETSQ3: MOVEM M,-3(P) ;Save msg ptr for next line
MOVEM L,-2(P) ;Save seq ptr for next line
MOVE A,MSCANF ;Save scan dir for next line
MOVEM A,-1(P)
MOVE A,CMDSTK ;Save cmd ptr for next line
MOVEM A,0(P)
GETSQI: MOVSI A,MSPRMT ;Reinit COMND parser
CALL CMDIN1 ;Reinit block
; We come here to reparse the input if necessary!
GETSQ4: MOVE P,SAVP ;Reset the main stack
MOVE A,0(P) ;Reset the command stack
MOVEM A,CMDSTK
MOVE A,-1(P) ;Reset the scan direction
MOVEM A,MSCANF
MOVE L,-2(P) ;Reset the seq ptr
MOVE M,-3(P) ;Reset the msg ptr
TXZ F,F%F2 ;No commands yet on this line
JRST GETSQ0
; Here to finish preparation of a sequence subcommand stack
GETSQ5: MOVE A,SEQCAL ;Restore caller's CMDRET
MOVEM A,CMDRET
HLRE A,CMDSTK ;Compute number of entries
ADDI A,NCPDL
MOVNS A
HRLI A,CMPDL
MOVSM A,CMDSTK ;Save it
MOVE C,[POINT 12,MSGSEQ,23] ;Begin looking at this sequence first
MOVEM C,MSGSPT ;Save initial sequence pointer
SKIPL C,MSCANF ;Done if forward scan
IFSKP.
DO.
ILDB A,MSGSPT ;Else, find end of sequence list
CAIE A,7777
LOOP.
ENDDO.
ADJBP C,MSGSPT ;Back up to last msg index
MOVEM C,MSGSPT
ENDIF.
SETOM WRKMSG ;Say sequence hasn't begun yet!
SETOM MSRNG ;Say no range in progress
MOVE L,[POINT 12,WRKSEQ,11] ;Init ptr to working sequence
ADJSP P,-4 ;Reset stack ptr
RET
; Here command entry error
GETSQR: MOVE P,SAVP ;Reset main stack
JRST GETSQI ;Continue at subcommand level
; Routine to put a new command frame on the sequence subcommand stack
; Entry: CMDSTK = current subcommand stack ptr
; NXTMSD = latest subcommand dispatch
; NXTPAT = string arg adr for subcommand
; NXTIME = Time argument for SINCE, BEFORE, AFTER, etc.
; KEYBTS = keyword bits argument for keyword subcommand
; KEYLPM = keyword modify list
; Call: CALL PSHCMD
; Return: +1
PSHCMD: TXO F,F%F2 ;Note at least 1 cmd this line
SKIPG NXTMSD ;Is there any search routine?
RET ;No, probably a flag setting command
SKIPL B,CMDSTK ;Stack started?
MOVE B,[IOWD NCPDL,CMPDL] ;No, init command stack
MOVX A,F%F3 ;Negation command?
TXZE F,F%F3
IORM A,NXTMSD ;Yes, note it
HRRZ A,NXTMSD ;Check the func
CAIN A,NXTSEQ ;Numerical sequence given?
JRST PSHCM1 ;Yes, handle specially
SETOM GTSQDF ;Cancel any default
PSHCM0: PUSH B,NXTMSD ;Save search routine
PUSH B,NXTPAT ;and string pattern adr
PUSH B,NXTIME ;Save time argument
PUSH B,KEYBTS ;Save keyword bits
PUSH B,KEYLPM ;And modify keywords list
MOVEM B,CMDSTK ;Save the new ptr
RET
PSHCM1: SKIPL CMDSTK ;Is the numerical sequence on the stack?
JRST PSHCM0 ;No, simply put it there (it will be first!)
SETOM GTSQDF ;Cancel any default
MOVE A,NXTMSD ;Reset search routine entry on stack
MOVEM A,CMPDL ; (it may change the negation flag)
RET ;The other entries don't matter for this
;;;Token - check for % or . and supply number
GETSQT: MOVEI B,4000 ;Special number meaning "last msg"
LDB A,[POINT 7,STRBUF,6] ;Get token character
CAIE A,"." ;. = current message
JRST GETST1
SKIPGE B,M ;Current message
MOVE B,PRIORM ;No valid current, try prior current
JUMPL B,[ERROR <No current message>]
IDIVI B,MSGLEN
JRST GETST1
;;;Number parsed - handle n:m n,m or n alone
GETSQN: JUMPE B,BADNUM ;Range error
SOJL B,BADNUM
MOVE C,LASTM
IDIVI C,MSGLEN
CAILE B,(C) ;His number > last message?
JRST BADNUM
GETST1: JUMPGE E,GTSQ2N ;2nd in series n:m
CALL GTSQLC ;Save number on list
MOVEI B,GTNBK1 ;Now try for <cr> ! , ! : ! #
GTSQNF: CALL CMDFLD
LOAD A,CM%FNC,(C) ;Get fcn parsed
CAIN A,.CMCFM ;EOL?
JRST GTSQNR ;Yes - done
CAIE A,.CMCMA ;Comma?
LDB E,[POINT 7,STRBUF,6] ;No, get token for later guidance
MOVEI B,GTNBK4 ;Yes - try for <number> ! . ! %
CALL CMDFLD
LOAD A,CM%FNC,(C) ;Get fcn parsed
CAIN A,.CMCFM ;EOL?
JRST GTSQNR ;Yes - done
CAIE A,.CMNUM ;Number?
IFSKP.
LDB A,L ;Get first number
CAIN E,"#" ;Are we handling a msg set?
ADDI B,(A) ;Yes, second number is n+m-1
JRST GETSQN ;Yes - handle
ENDIF.
CALLRET GETSQT ;Handle token
GTSQLC: CAMN L,[POINT 12,MSGSQZ-1,23] ;Reached end of list?
ERROR <Too many messages in list>
IDPB B,L ;Save number in list
SETOM NXTMSD ;Flag previous sequence clobbered
RET
;;;2nd in range seen - fill list
GTSQ2N: TRO B,2000 ;Mark as end of range
CALL GTSQLC ;Save in table
; CALLRET GTSQNC ;Go try for more
GTSQNC: SETO E, ;Say looking for 1st number of pair
MOVEI B,GTNBK2 ;Try for <cr> ! ,
CALLRET GTSQNF
;;;EOL seen, wrapup numbers
GTSQNR: MOVEI B,7777 ;Mark end of list
IDPB B,L
GTSQNS: MOVE L,[POINT 12,MSGSEQ,11] ;Reset list
MOVEI A,NXTSEQ ;Numeric sequence is basis
MOVEM A,NXTMSD ;Setup as dispatch
SETZM NXTPAT ;Init storage for seq ptr
RET ;Return
GTNBK1: FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ/:/]>,<":" to specify a message range>,,GTNB11
GTNB11: FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ/#/]>,<"#" to specify a message set>,,GTNBK2
GTNBK2: FLDDB. .CMCMA,CM%SDH,,<"," to specify another message number>,,CNFCMD
GTNBK3: FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ/%/]>,<"%" to specify the last message>,,GTNB31
GTNB31: FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ/./]>,<"." to specify the current message>,,GTNB32
GTNB32: FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ/*/]>,<"*" to specify the last message>,,GTNB33
GTNB33: FLDDB. .CMNUM,CM%SDH,^D10,<a single message number
or range of message numbers n:m
or set of message numbers n#m (m messages beginning with n)>,,GTNBK5
GTNBK5: FLDDB. .CMKEY,,SQCMTB,<message sequence,>
;;;Same as GTNBK3, but without the SQCMTB table keywords. It has to be done
;;;this way because keywords have to be parsed after tokens if a keyword is
;;;a default, otherwise the default keyword will be taken if a token is input.
GTNBK4: FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ/%/]>,<"%" to specify the last message>,,GTNB41
GTNB41: FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ/./]>,<"." to specify the current message>,,GTNB42
GTNB42: FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ/*/]>,<"*" to specify the last message>,,GTNB43
GTNB43: FLDDB. .CMNUM,CM%SDH,^D10,<a single message number
or range of message numbers n:m
or set of message numbers n#m (m messages beginning with n)>
;;;Get the next message in this sequence and maybe type out its number
NXTMSG: SKIPL A,CMDSTK ;Anything on command stack?
JRST NXTMS6 ;No, just quit
NXTMSL: MOVEM A,WCMDPT ;Save working ptr
MOVE B,0(A) ;Get command fct
MOVEM B,NXTMSD
MOVE B,1(A) ;And any pattern string
MOVEM B,NXTPAT
MOVE B,2(A) ;Time argument
MOVEM B,NXTIME
MOVE B,3(A) ;Keyflag bits
MOVEM B,KEYBTS
MOVE B,4(A) ;Keyword string arguments
MOVEM B,KEYLPM
CALL @NXTMSD ;Check out the next msg
JRST NXTMSG ;No go, step to next msg
MOVE A,WCMDPT ;Try for next command frame
ADJSP A,4
AOBJN A,NXTMSL
NXTMS0: AOS (P) ;Found one, set to skip return
HRRZ M,WRKMSG ;Get msg index
HLRZ A,WRKMSG ; and msg number
JUMPL L,NXTMS1 ;Always start new when beginning
LDB B,L ;Get last one out
TRZN B,2000 ;Already a range?
HRROS B ;No, must use next slot
CAIN A,1(B) ;Next in numeric order?
TROA A,2000 ;Yes, construct a range
CAIA
JUMPGE B,[DPB A,L ;Put it in place
JRST NXTMS2]
NXTMS1: IDPB A,L ;Use next slot
NXTMS2: TXNN F,F%TAK ;Don't type out sequences in a TAKE
TXNN F,F%TYPS ;Want to type out numbers?
RET ;No, all done
SKIPGE A,LSTMSG ;Any last message?
JRST NXTMS5 ;No, install this one then
CAIN M,MSGLEN(A) ;Yes, is this one the next one?
JRST NXTMS4 ;Yes, keep accumulating
CALL PRTSEQ ;Print what is there now otherwise
NXTMS3: HRLM M,LSTMSG ;And set ourselves up as start
NXTMS4: HRRM M,LSTMSG ;Set ourselves up as next link in chain
RET
NXTMS5: TXZ F,F%COMA ;Reset comma flag
JRST NXTMS3
NXTMS6: MOVEI B,7777
IDPB B,L ;Mark end of sequence
TXNE F,F%TAK ;Don't type sequence if TAKE file
RET
TXNE F,F%TYPS ;Finishing up, type last number?
SKIPGE LSTMSG ;And have non-empty sequence
RET ;No, done
PRTSEQ: TXOE F,F%COMA ;Maybe a comma first
PRINT ","
PRINT .CHSPC
MOVX A,.PRIOU
HLRZ T,LSTMSG ;Get start of sequence
MOVEI B,MSGLEN(T)
IDIVI B,MSGLEN
MOVEI C,^D10
NOUT%
NOP
HRRZ B,LSTMSG ;Get end
CAIN B,(T) ;Same?
RET ;Yes, that's it
PRINT ":"
ADDI B,MSGLEN
IDIVI B,MSGLEN
MOVEI C,^D10
NOUT%
NOP
RET
;;;Get next message selecting routines
NXTSQ0: SETOM MSRNG ;Say not stepping range
NXTSEQ: MOVE B,LASTM ;Determine number of last msg
IDIVI B,MSGLEN ; ..
SKIPL MSRNG ;Are we in a range?
JRST NXTSQR ;Yes, special handling
LDB A,MSGSPT ;Get the next msg to do
CAIE A,7777 ;Reached the end of the sequence?
IFSKP.
HLRZS CMDSTK ;Yes, save command stack size while
RET ; causing NXTMSG to terminate!
ENDIF.
NXTSQ2: MOVE C,MSCANF ;Advance the sequence pointer
ADJBP C,MSGSPT
MOVEM C,MSGSPT
TRZE A,2000 ;Is this the end of a range?
JRST NXTSQ4 ;Yes, handle
CAMLE A,B ;Special check for "last msg" number
MOVE A,B ; ..
NXTSQ1: HRLZM A,WRKMSG ;Return msg number
IMULI A,MSGLEN
HRRM A,WRKMSG ;Return msg index
RETSKP ;Say there is another msg
NXTSQ4: MOVEM A,MSRNG ;Remember end of (forward) scan
SKIPL MSCANF ;Backward scan?
JRST NXTSQR ;No, step forward
LDB C,C ;Yes, get beginning of range
MOVEM C,MSRNG ;Remember when range ends!
JRST NXTSQ2
NXTSQR: HLRZ A,WRKMSG ;Get number of previous msg
CAMN A,MSRNG ;Are we at boundary of range?
JRST NXTSQ0 ;Yes, done with range
CAMG A,MSRNG ;Compare current with range
AOSA A ;Current less than range, increment
SOJL A,NXTMS0 ;Current greater than range, decrement
CAMLE A,B ;Paranoia: is sequence still valid?
JRST NXTSQ0 ;No, too high
JRST NXTSQ1 ;Yes, use this msg number
NXTANS: SKIPA B,[M%RPLY] ;Answered
NXTSEE: MOVEI B,M%SEEN ;Seen
CALLRET NXTDL0
NXTFLG: SKIPA B,[M%ATTN] ;Flagged
NXTDEL: MOVEI B,M%DELE ;Deleted
NXTDL0: SKIPA C,[TDNE B,MSGBTS(A)] ;Bit must be set
NXTREC: MOVE C,[SKIPGE MSGFLG(A)] ;Recent
CALLRET NXTAL0
NXTUNA: SKIPA B,[M%RPLY] ;Unanswered
NXTUNF: MOVEI B,M%ATTN ;Unflagged
CALLRET NXTUD0
NXTUNS: SKIPA B,[M%SEEN] ;Unseen
NXTUND: MOVEI B,M%DELE ;Undeleted
NXTUD0: MOVE C,[TDNN B,MSGBTS(A)] ;Bit must be clear
NXTAL0: HRRZ A,WRKMSG ;Start here
XCT C ;Test it out
RETSKP ;Matches
RET ;No go
NXTNEW: HRRZ A,WRKMSG ;New
MOVEI B,M%SEEN
SKIPGE MSGFLG(A) ;New are recent
TDNE B,MSGBTS(A) ; & unseen messages
CAIA
RETSKP
RET ;No go
NXTKEY: MOVE C,[CALL NXTKY0]
CALLRET NXTAL0
;Enter here to trigger if keyflag or keyword found
NXTKY0: MOVE B,KEYBTS
TDNE B,MSGBTS(A) ;Keyflag found?
RET ;Yes, take no-skip win return.
CALL NXTKW ;Hmm, try looking for keyword.
RETSKP ;Failed, take skip return.
RET ;Won.
NXTUNK: MOVE C,[CALL NXUNK1]
CALLRET NXTAL0
;Enter here to trigger if keyflag or keyword NOT found
NXUNK1: MOVE B,KEYBTS
TDNE B,MSGBTS(A) ;Keyflag there?
RETSKP ;Yes, so take skip loss return.
;No, fall thru to see if keyword there.
NXTKW: PUSH P,M ;Save current-msg ptr
MOVEI M,(A)
SKIPE A,KEYLPF ;Search with given keyword list
CALL KWFND
CAIE A, ;Failed to find keyword?
AOS -1(P) ;Found it! Take skip return
MOVEI A,(M) ;Restore A
POP P,M ;and current msg.
RET
; Discriminate msgs by length
NXTSHT: SKIPA C,[CAMG B,NXTIME] ;Shorter than limit
NXTLNG: MOVE C,[CAML B,NXTIME] ;Longer than limit
HRRZ A,WRKMSG ;Msg to check
HLRZ B,MSGBOD(A) ;b := its body length
XCT C
RETSKP ;OK, use it
RET ;No go
;;;Find substring in From field
NXTSBJ: SKIPA C,[CALL SBJSTR] ;Routine to match Subject string
NXTFRM: MOVE C,[CALL FRMSTR] ;Routine to match From string
CALLRET NXTAL0 ;Use common loop
NXTTO: SKIPA C,[CALL TCCSTR] ;Routine to match To/Cc string
NXTTXT: MOVE C,[CALL TXTSTR] ;Routine to match text substring
CALLRET NXTAL0
NXTTOM: SKIPA C,[CALL TOSTR] ;Routine to match To string
NXTCCM: MOVE C,[CALL CCSTR] ;Routine to match Cc string
CALLRET NXTAL0
FRMSTR: HRRZ V,MSGFRM(A) ;From field for this message
HLRZ W,MSGFRM(A)
FRMST2: SAVEAC <A,C,M>
HRRZM A,M ;Setup this temporarily so search works
HRRZ T,NXTPAT ;String to match
CALL SEARCH ;Look for string
RETSKP ;Didn't find it, skip return
RET
SBJSTR: HRRZ V,MSGSUB(A) ;Subject field for this message
HLRZ W,MSGSUB(A)
CALLRET FRMST2
TXTSTR: HRRZ V,MSGBOD(A)
HLRZ W,MSGBOD(A)
CALLRET FRMST2
;;;Match a To: or cc:
TCCSTR: CALL TOSTR ;Check To-list
RET ;Won
CALLRET CCSTR ;To-list failed, try cc list
TOSTR: SAVEAC <A,C,M> ;Messages with string in to field
STKVAR <TOTMPA,TOTMPM>
MOVEM A,TOTMPA
MOVEM M,TOTMPM
MOVEI M,(A) ;Temporarily point to right message
MOVEI T,[ASCIZ/
To:/]
CALL FNDHDR
RETSKP ;Didn't find it, skip return
MOVE M,TOTMPM
TDZA W,W
TOSTR1: ADDI W,2 ;Count the crlf too
CALL CNTHDL ;Count characters in this line
IBP A ;Skip LF too
ILDB T,A
CAIE T,.CHTAB
CAIN T,.CHSPC ;Continuation line?
AOJA W,TOSTR1 ;Yes, get some more
CAIE T,"T"
CAIN T,"t"
IFNSK.
ILDB T,A ;Looking for TO:
CAIE T,"O"
CAIN T,"o"
ANNSK.
ILDB T,A
CAIE T,":"
ANSKP.
ADDI W,3 ;Count TO: itself
JRST TOSTR1
ENDIF.
MOVE A,TOTMPA
HRRZM A,M ;Setup this temporarily so search works
HRRZ T,NXTPAT ;String to match
CALL SEARCH ;Look for string
RETSKP ;Didn't find it, skip return
RET
ENDSV.
CCSTR: SAVEAC <A,C,M> ;Messages with string in CC field
STKVAR <CCTMPA,CCTMPM>
MOVEM A,CCTMPA
MOVEM M,CCTMPM
MOVEI M,(A) ;Temporarily point to right message
MOVEI T,[ASCIZ/
cc:/]
CALL FNDHDR
RETSKP ;Didn't find it, skip return
MOVE M,CCTMPM
TDZA W,W
CCSTR1: ADDI W,2 ;Count the crlf too
CALL CNTHDL ;Count characters in this line
IBP A ;Skip LF too
ILDB T,A
CAIE T,.CHTAB
CAIN T,.CHSPC ;Continuation line?
AOJA W,CCSTR1 ;Yes, get some more
CAIE T,"C"
CAIN T,"c"
IFNSK.
ILDB T,A ;Looking for cc:
CAIE T,"C"
CAIN T,"c"
ANNSK.
ILDB T,A
CAIE T,":"
ANSKP.
ADDI W,3 ;Count TO: itself
JRST CCSTR1
ENDIF.
MOVE A,CCTMPA
HRRZM A,M ;Setup this temporarily so search works
HRRZ T,NXTPAT ;String to match
CALL SEARCH ;Look for string
RETSKP ;Didn't find it, skip return
RET
NXTBEF: SKIPA C,[CAMLE B,MSGDAT(A)] ;Before date
NXTAFT: MOVE C,[CAMG B,MSGDAT(A)] ;After date
MOVE B,NXTIME
CALLRET NXTAL0
NXTON: MOVE C,[CALL NXTON1] ;On date
CALLRET NXTAL0
NXTON1: MOVE B,MSGDAT(A)
SUB B,NXTIME
TLNE B,-1 ;More than a day's difference?
AOS (P) ;Yes, fail
RET
SUBTTL Sending subroutines
SNDINI: CALL SNDIN0
PRSCCL: SKIPN DEFCCL ;Any default cc list?
JRST PRSCC0 ;No
MOVE A,[POINT 7,DEFCCL]
SETZ E,
TXO F,F%CC ;As cc recipients
TXZ F,F%F4
CALL PRADDR ;Process default CC list
MOVEI T,CCLIST ;Set up CC list
CALL ADDTO0 ;Go add whole bunch to list then
PRSCC0: SKIPN DEFBCL ;Any default bcc list?
RET ;No
MOVE A,[POINT 7,DEFBCL]
SETZ E,
TXO F,F%CC ;As cc recipients
TXZ F,F%F4
CALL PRADDR ;Process default BCC list
MOVEI T,BCCLST ;Set up BCC list
CALLRET ADDTO0 ;Go add whole bunch to list then
;;; Version of SNDINI that does not parse DEFCCL
SNDIN0: SETOM M.RPLY ;Assume not a reply to anyone
CALL .ERSAL ;Go erase everything
SETZM RMLPTR ;Not remail yet
SETZM FRMSCM ;Assume from user
MOVE A,[POINT 7,FRMSCM]
HRROI B,FRMSAM
SKIPE FRMSAM ;Unless
CALL MOVST0 ; the user requested something else!
SETZM REPSCM ;Assume reply to user
MOVE A,[POINT 7,REPSCM]
HRROI B,REPSAM
SKIPE REPSAM ;Unless
CALL MOVST0 ; the user requested something else!
RET
PRADDT: TXZ F,F%F4 ;Barf on errors
PRADT1: CALL PRADDR ;Process list
CALLRET ADDTO ;Go add whole bunch to list then
;;;Look up a host name with byte pointer A and return the address of its
;;; canonical name string in A. Skips if name found
HSTNAM: SAVEAC <B,C,D>
STKVAR <HSTPTR>
MOVEM A,HSTPTR
MOVEI A,HSTTAB ;See if in cache already
MOVE B,HSTPTR
TBLUK%
IFXN. B,TL%EXM ;Already in the table?
HLRZ A,(A) ;Great, get the string address
RETSKP ;Return success
ENDIF.
MOVE A,HSTPTR
HRRO B,HCSHFF ;Store name in free area in host cache
SETZ C, ;Use any protocol, don't care about address
CALL $GTCAN ;Canonicalize the name
IFNSK.
SKIPE DOMTBL ;Failed, see if pseudo-domains are initialized
IFSKP.
MOVEI A,ALCBLK ;No, do so. Routine to assign memory
SETZ B, ;Say don't bother making relay lists
CALL $INRLY
MOVEM A,DOMTBL ;Save fact that we are initialized
ENDIF.
MOVE A,HSTPTR ;Get back A
CALL $GTRLY ;Try relays
RET
MOVE B,A ;Canonical name
HRR A,HCSHFF ;To free area
HRLI A,(<POINT 7,>)
CALL MOVST2 ;Copy it
ENDIF.
IBP A ;Make sure we include at least one null
MOVEI D,1(A) ;Pointer to next word after name returned
CAIL D,HSTSTR+<NHSPGS*1000>
FATAL <Host name cache overflowed>
MOVEI A,HSTTAB ;See if in cache already
HRRO B,HCSHFF
TBLUK%
IFXE. B,TL%EXM ;Already in the table?
MOVEI A,HSTTAB ;Point to the table
HRLZ B,HCSHFF
TBADD% ;Add it to table
MOVEM D,HCSHFF ;Update current host cache free pointer
ENDIF.
HLRZ A,(A) ;Get the string address
RETSKP ;Return success
ENDSV.
;;;Routine to assign memory from free storage; presently we use the host cache.
;;;Accepts:
;;; A/ size of block to assign
;;; CALL ALCBLK
;;;+1: Failure
;;;+2: Success, with:
;;; B/ address of block assigned
ALCBLK: SAVEAC <A>
MOVE B,HCSHFF ;Get free block from here
ADD A,B ;First address after block
CAIL A,HSTSTR+<NHSPGS*1000> ;Make sure it fits
RET ;No
MOVEM A,HCSHFF ;Put back as next free
RETSKP
;;;Send the current message off
SNDMS5: CALL GETTO ;Insist upon having a to-list
SNDMSG: STKVAR <JFNTAD,SIZE>
SKIPE TOLIST ;Is there a to-list?
IFSKP.
SKIPN A,CCLIST ;Try moving cc-list to to-list
JRST SNDMS5 ;No recipients, demand some
SETZM CCLIST
MOVEM A,TOLIST ;Move appropriate list to to-list
ENDIF.
TXZ F,F%F2 ;Haven't got funny SAVFIL yet
MOVE A,TXTPTR ;Get end of message
MOVEI B,CRLF0
LDB C,A
CAIN C,.CHLFD ;Unless ended with CRLF
IFSKP.
CALL MOVST0 ;Put one in now
ADD A,[7B5] ;And back over the null
ENDIF.
MOVEM A,TXTPTR
LDB A,[POINT 7,MCPFIL,6] ;Is there a mail copy file?
IFN. A ;Only do it if so
DMOVE A,[POINT 7,FILNAM ;Copy mail copy filename string
POINT 7,MCPFIL]
CALL MOVSTR
MOVEI B,[ASCIZ/;P770000;T/] ;Set protection and temporary
CALL MOVST0 ;Complete filename string
MOVX A,GJ%FOU!GJ%NEW!GJ%SHT!.GJNHG
HRROI B,FILNAM ;Get it back
GTJFN%
IFJER.
HRROI B,FILNAM
JWARN <Can't get mail copy file "%2S">
ELSE.
MOVEM A,JFNTAD ;Save JFN in case OPENF% fails
DO.
MOVX B,<<FLD ^D7,OF%BSZ>!OF%WR>
OPENF%
IFJER.
MOVE A,JFNTAD ;Let user try CONTINUE
JWARN <Can't open mail copy file "%1J">
PROMPT <Should I try again? >
CALL YESNO ;Offer to create file for user
EXIT.
CITYPE <[Type CONTINUE when ready to retry]
>
MOVE A,JFNTAD
HALTF%
LOOP.
ENDIF.
HRROI B,TXTPAG
SETZ C,
SOUT%
TXO A,CO%NRJ
CLOSF%
NOP
ENDDO.
MOVE A,JFNTAD ;Flush saved JFN
RLJFN%
NOP ;Ignore failure
ENDIF.
ENDIF.
HRRZ B,TXTPTR ;Compute number of characters in text
SUBI B,TXTPAG-1 ;1+End addr-Start addr
IMULI B,5 ;Times 5 chars/word
LDB C,[POINT 6,TXTPTR,5] ;Get terminating pointer offset
IDIVI C,7 ;C=# of free bytes in word
SUBI B,(C)
SKIPN RMLPTR ;Unless remail
ADDI B,9 ;Count for dashes later
MOVEM B,MSGSIZ ;Save size of text portion of message
MOVEM B,SIZE
GTAD% ;Get date/time now
MOVEM A,JFNTAD ;Save for later
SKIPN LCLIST ;Any local recipients?
SKIPE FILIST ;Or file recipients?
IFSKP.
SKIPE SAVFIL ;Or uses SAVED.MESSAGES feature
ANSKP. ;No, just go send network out then
ELSE.
TXZ F,F%RELD ;Setup headers for local recipients
CALL SETHDR
CALL SNDLCL ;Try to send local messages
CALL SNDFIL ;Try to send file messages
SKIPL RINCME ;Special include me mode?
IFSKP.
TXZN F,F%F2 ;Yes, did we see that address?
SETZM SAVFIL ;No, don't send any file guy then
ENDIF.
CALL FILMSG ;Store SAVED.MESSAGES
MOVE A,SIZE ;Restore MSGSIZ in case ever needed again
MOVEM A,MSGSIZ
ENDIF.
SKIPN NETLST ;Any network recipients?
RET
MOVE A,JFNTAD ;Restore TAD
TXO F,F%QUOT!F%RELD ;Set headers for network recipients
CALL SETHDR
CALL SNDNET ;Queue mail
CALL MAIFLG ;Queued to user directory, update flags
CALLRET $WAKE ;Send wakeup call to MMailr
ENDSV.
;;;Setup header of message for this kind of recipient, A/ TAD for this header
SETHDR: STKVAR <HDRTAD>
MOVEM A,HDRTAD ;Save date/time user wants to show
SKIPE O,RMLPTR ;Doing remail command?
IFSKP.
MOVE O,[POINT 7,HDRPAG] ;Set up header block
MOVE A,TXTPTR
MOVEI B,[ASCIZ/-------
/]
CALL MOVST0 ;Put in dashes at end
MOVEI B,[ASCIZ/Date: /]
ELSE.
MOVEI B,[ASCIZ/ReSent-Date: /]
ENDIF.
MOVE A,[IDPB A,O] ;Set up to move into memory
MOVEM A,MOVDSP
CALL MOVSB2
MOVE A,O ;Current pointer
MOVE B,HDRTAD ;User's argument
MOVX C,OT%DAY!OT%SPA!OT%TMZ!OT%SCL!OT%822 ; RFC 822 standard date/time
ODTIM%
MOVE O,A ;Update header pointer
SKIPN RMLPTR ;Doing Remail?
IFSKP.
MOVEI B,[ASCIZ/
ReSent-From: /]
CALL MOVFRR
MOVEI B,[ASCIZ/
ReSent-Sender: /]
TXNN F,F%ALIA ;Aliased?
SKIPE FRMSCM ;Or is there a "From:" other than user?
CALL MOVSRR ;Yes, output sender
MOVEI T,[ASCIZ/
ReSent-To: /]
CALL MOVTRM
MOVEI B,[ASCIZ/
ReSent-/]
CALL MOVSB2
ELSE.
CALL MOVFRM ;Output From
CALL MOVSUB ;Insert subject
TXNN F,F%ALIA ;Aliased?
SKIPE FRMSCM ;Or is there a "From:" other than user?
CALL MOVSDR ;Yes, output sender
CALL MOVTO ;And To
CALL MOVCC ;And cc
CALL MOVREP ;And Reply-To
CALL MOVRDT ;And In-Reply-To
CALL MOVUSH ;Insert user-generated headers
MOVEI B,[ASCIZ/
/]
CALL MOVSB2 ;Prepare for Message-ID
ENDIF.
MOVEI B,[ASCIZ/Message-ID: </]
CALL MOVSB2
MOVE A,O ;Current pointer
MOVE B,HDRTAD ;User's argument
MOVX C,^D10
NOUT%
JFATAL
MOVX B,"."
IDPB B,A
MOVE B,MYJOBN
NOUT%
JFATAL
MOVX B,"."
IDPB B,A
MOVE B,MYUSR ;Login directory
DIRST%
JFATAL
MOVE O,A ;Update pointer
MOVX A,"@" ;Output "@host" in absolute form
XCT MOVDSP
MOVEI B,LCLHNM
CALL MOVSB2
MOVX A,.CHRAB ;Close it off
XCT MOVDSP
MOVEI B,[ASCIZ/
/]
CALL MOVSB2 ;And a couple blank lines
SETZ A,
IDPB A,O ;Mark end of this with a null too
MOVEI A,1-HDRPAG(O)
IMULI A,5 ;Compute characters used in headers
LDB B,[POINT 6,O,5]
IDIVI B,7
SUBI A,1(B)
ADDM A,MSGSIZ ;Update size of whole thing
RET
ENDSV.
;;;File away the message in SAVED.MESSAGES if in logged directory
FILMSG: SKIPN RMLPTR ;Doing remail?
SKIPN SAVFIL ;Wants one at all?
RET ;Doing remail or no saved messages file
MOVEI T,M%SEEN ;Mark message as seen
MOVX A,GJ%OLD!GJ%SHT ;Enter here to send to a file
DO.
HRROI B,SAVFIL
GTJFN% ;Try to get guy's SAVED.MESSAGES
IFJER.
HRROI B,SAVFIL
JWARN <Can't get output file "%2S">
CAIE A,GJFX24 ;File not found error?
RET ;No, probably bad filename
PROMPT <May I create it? >
CALL YESNO ;Offer to create file for user
RET ;User said no
MOVX A,GJ%NEW!GJ%SHT ;Make a new file
LOOP. ;Try again
ENDIF.
ENDDO.
FILMS1: PUSH P,A ;Save JFN
MOVX B,<<FLD 7,OF%BSZ>!OF%APP> ;Open for append
OPENF%
IFJER.
POP P,A ;Get JFN back
JWARN <Can't open output file "%1J">
RLJFN% ;Flush the JFN
NOP
RET
ENDIF.
POP P,A
SKIPLE SNDVBS ;Verbose sending mode?
TXOA F,F%F1 ;Yes, type out file name
FILMS2: TXZ F,F%F1 ;Don't type out file name
SETO B, ;Now
MOVX C,OT%TMZ ;Timezone as well
ODTIM%
MOVEI B,","
BOUT%
MOVE B,MSGSIZ ;Get back size
MOVX C,^D10 ;Decimal
NOUT%
JERROR
MOVEI B,";"
BOUT%
MOVE B,T ;Bits to put in
MOVE C,[NO%LFL!NO%ZRO!NO%MAG!14B17!^D8] ;"000000000000"
NOUT%
JERROR
HRROI B,CRLF0
SETZ C,
SOUT% ;Write header bits and crlf
HRROI B,HDRPAG
SOUT% ;Copy the headers
HRROI B,TXTPAG
SOUT% ;And the text
TXZE F,F%F1 ;Want file name?
CIETYP < *%1J -- ok>
CLOSF%
JWARN <Couldn't close output file>
SETZM OUTJFN
RET
;;;Send other disk file recipients
SNDFIL: HRRZ W,FILIST
DO.
JUMPE W,R ;Done with file recipients
MOVEI T,0 ;Mark as unseen
MOVX A,GJ%SHT
HRROI B,ADRSTR(W) ;Get name of file
GTJFN% ;Try to get file
IFJER.
HRROI B,ADRSTR(W)
JWARN <Can't get output file "%2S">
ELSE.
CALL FILMS1 ;Send it off
ENDIF.
HRRZ W,ADRLNK(W) ;Get next one
LOOP.
ENDDO.
;;;Queue network mail
SNDNET: TXZ F,F%QUOT
TXO F,F%QUEU ;Flag we have queued mail
MOVE A,[POINT 7,STRBUF] ;Build name in STRBUF
MOVEI B,[ASCIZ/MAILQ:[--QUEUED-MAIL--]/]
CALL MOVSTR ;Copy initial string
CALL MOVQNM ;Set unique extension
CALL GNTQFL ;Make a network queue file
IFSKP.
AOS (P) ;Flag no need to update mailer flags
ELSE.
MOVE A,[POINT 7,STRBUF] ;No MAILQ:, use login directory
MOVEI B,[ASCIZ/[--QUEUED-MAIL--]/]
CALL MAKSTR ;Put in start of file name
ADD A,[7B5] ;Back up over null
CALL MOVQNM ;Set unique extension
CALL GNTQFL ;Make a network queue file
JERROR <Can't get queue file>
ENDIF.
MOVEM A,OUTJFN
MOVX B,.CHFFD ;Write delivery options line
BOUT%
HRROI B,[ASCIZ/=DELIVERY-OPTIONS:/]
SETZ C,
SOUT%
MOVE B,DLVOPT ;Get delivery option
HLRO B,DOPTAB(B)
SOUT% ;Output it
HRROI B,CRLF0
SOUT%
SKIPN AFTDAT ;AFTER parameter?
IFSKP.
MOVX B,.CHFFD ;Write after line
BOUT%
HRROI B,[ASCIZ/=AFTER:/]
SOUT%
MOVE B,AFTDAT ;Output After date/time
MOVX C,OT%NSC!OT%SCL
ODTIM%
HRROI B,CRLF0
SETZ C,
SOUT%
ENDIF.
SETO E, ;Clear last host sent
HRRZ W,NETLST ;Get start of network list
SKIPN W ;Output it
FATAL (No recipients in SNDNET)
DO.
MOVE A,OUTJFN ;Get back JFN for output
SKIPN B,ADRHST(W) ;Get host address
MOVE B,LCLHST ;Use local host-name if zero
CAMN B,E ;Same as last time?
IFSKP.
MOVE E,B ;Set new "last host"
MOVEI B,.CHFFD ;Formfeed separates hosts
BOUT%
HRRO B,E
SOUT% ;Output the host
SETZ C,
HRROI B,CRLF0
SOUT%
ENDIF.
HRROI B,ADRSTR(W) ;Name of recipient
SETZ C,
SOUT%
HRROI B,CRLF0
SOUT%
SKIPG SNDVBS ;Super-verbose sending?
IFSKP.
MOVEI A,ADRSTR(W) ;Yes, get guy's name
SKIPN B,ADRHST(W) ;Get host pointer
MOVE B,LCLHST ;Local host if 0
CIETYP < %1R@%2R -- queued
>
ENDIF.
HRRZ W,ADRLNK(W) ;Get next one to do
JUMPN W,TOP. ;Do it if it exists
ENDDO.
MOVE A,OUTJFN ;Get back JFN for output
HRROI B,[BYTE (7) .CHFFD,.CHCRT,.CHLFD,0] ;Otherwise finish up
SETZ C, ;With <form><crlf>
SOUT%
HRROI B,HDRPAG ;Start of headers
SETZ C,
SOUT%
HRROI B,TXTPAG ;Start of text
SOUT%
CLOSF% ;All there is to it
JSNARL <Can't close message file>
SETZM OUTJFN
RET ;All done, return
;;;Build a unique queued mail file extension string, source pointer in A
MOVQNM: MOVEI B,[ASCIZ/.NEW-/]
CALL MOVSTR ;Copy initial string
PUSH P,A ;Create frame to save string pointer
GTAD% ;Now output date/time
MOVE B,A
POP P,A
MOVX C,^D8 ;Output in octal
NOUT%
JFATAL ;Can't happen
MOVEI B,[ASCIZ/-MM-J/]
CALL MOVSTR
MOVE B,MYJOBN ;Get job number in B
MOVX C,^D10 ;Output in octal
NOUT%
JFATAL ;Can't happen
MOVEI B,[ASCIZ/.-1;P770000/] ;Next generation, set protection
CALLRET MOVST0 ;Finish string, tie off with null
;;;Set mailer flags
MAIFLG: TXZN F,F%QUEU ;Any queued mail to do?
RET
MOVX A,GJ%OLD!GJ%SHT!GJ%PHY ;Set the mailer flags
HRROI B,[ASCIZ/MAIL:MAILER.FLAGS.1/]
GTJFN% ;Get JFN on flags file
IFJER.
JWARN <Unable to get mailer flags>
RET
ENDIF.
PUSH P,A
MOVX B,OF%THW!OF%WR!OF%RD
OPENF%
IFJER.
POP P,A
RLJFN%
NOP
JWARN <Unable to open mailer flags>
RET
ENDIF.
HRLZ A,(P) ;Page 0
MOVE B,[.FHSLF,,FLGPAG/1000]
MOVX C,PM%RD!PM%WR
PMAP%
HRRZ C,MYAUSR ;Alias login directory
IDIVI C,^D36
MOVSI A,(1B0)
MOVN D,D
ROT A,(D)
IORM A,FLGPAG(C) ;Set my bit
SETO A,
MOVE B,[.FHSLF,,FLGPAG/1000]
SETZ C,
PMAP%
POP P,A
CLOSF%
NOP
RET
; Routine to create a queue file for network mail.
; Entry: strbuf = file name string
; Call: CALL GNTQFL
; Return: +1, error
; +2, success, a = JFN
GNTQFL: STKVAR <QFLJFN>
DO.
MOVX A,GJ%NEW!GJ%FOU!GJ%PHY!GJ%SHT ;Standard flags plus physical
HRROI B,STRBUF ; for MAILQ:
GTJFN%
ERJMP R ;No go
MOVEM A,QFLJFN ;Save the JFN
MOVX B,<<FLD 7,OF%BSZ>!OF%WR>
OPENF%
IFJER.
PUSH P,A ;Save error code
MOVE A,QFLJFN ;Get losing JFN
RLJFN% ;Release it
NOP
POP P,A ;Recover error code
CAIE A,OPNX9 ;If file busy, try again
CAIN A,OPNX2 ;File disappeared?
LOOP. ;Yes, try again
CAIE A,OPNX23 ;Over allocation?
RET ;No, return failure
JSNARL <Can't open queue file>
HALTF%
LOOP.
ENDIF.
ENDDO.
HRLI A,.FBBYV ;Set to keep all versions
MOVX B,FB%RET
SETZ C,
CHFDB% ;Keep all versions
ERJMP .+1
HRRZ A,QFLJFN ;A := clean output JFN
RETSKP ;And return +2
ENDSV.
;;;Run MMailr to send off what we queued
MAILE: NOISE (QUEUED MESSAGES)
CONFRM
CALL $WAKE ;Send wakeup to daemon
MOVX A,GJ%OLD!GJ%SHT
HRROI B,[ASCIZ/SYS:MMAILR.EXE/]
GTJFN%
JERROR <Couldn't find file to run>
CALL RUNFL0
KFORK% ;Don't need it any more
CALLRET .PUSH1 ;Do an automatic CHECK
RUNFIL: TXZA F,F%F3 ;Run enabled
RUNFL0: TXO F,F%F3 ;Don't run enabled
PUSH P,A ;Save the JFN
TXNE F,F%F3 ;Wants to run enabled?
TDZA A,A ;No
MOVX A,CR%CAP ;Yes, give it our caps
CFORK%
JERROR <Couldn't create fork>
PUSH P,C ;Make sure users can use MMAILR
SETO B, ;All priv's possible
SETZ C, ;But none enabled
TXZE F,F%F3 ;If not to be enabled
EPCAP% ;At least give him possibles
POP P,C
EXCH A,(P) ;Get back JFN
HRL A,(P)
GET%
IFJER.
JERROR <Couldn't get file to run>
ENDIF.
POP P,A ;Get back fork handle
RUNFL2: PUSH P,CMDRET ;Save original command return
PUSH P,F ; and flags.
MOVEI B,RUNRES ;Go here if error
HRRM B,CMDRET
TXZ F,F%READ!F%SEND ;Don't let these misdirect!
SETZ B,
SFRKV% ;At regular startup point
WFORK%
RUNRES: POP P,F ;Restore original flags
POP P,CMDRET ; and command return
SAVEAC <A,C,D>
DMOVE A,PRGNAM ;Restore names
SETSN%
JFATAL
MOVEI D,SAVMOD ;Restore TTY modes
CALLRET SETTYM
PUSH: CONFRM
SETABT ;Save previous abort state
CALL ABNDIS ;Don't CTRL/N out of EXEC
SKIPLE A,EXECFK ;Have a fork yet?
IFSKP.
MOVX A,GJ%OLD!GJ%SHT
HRROI B,[ASCIZ/DEFAULT-EXEC:/]
GTJFN%
IFJER.
MOVX A,GJ%OLD!GJ%SHT
HRROI B,[ASCIZ/SYSTEM:EXEC.EXE/]
GTJFN%
JERROR <Couldn't find file to run>
ENDIF.
CALL RUNFIL ;No, make a fork and run it
MOVEM A,EXECFK ;And keep the fork handle
ELSE.
CALL RUNFL2 ;Already have one, just run it
ENDIF.
PUSH1: SAVEAC <M>
SKIPG MSGJFN ;Do we have a mail file?
RET ;No, don't do any check then
CALL CHECKT ;Check for new messages and report
CALLRET PARSEA ;Reparse entire file in case bits changed
;;;Erase fields
ERSAL: SETZM SUBBUF ;Reset subject
SETZM TOLIST ;Reset to and cc pointers
SETZM CCLIST
SETZM BCCLST
SETZM LCLIST
SETZM FILIST
SETZM NETLST
SETZM REPDAT ;No reply date
SETZM AFTDAT ;No after date
SETZM DLVOPT ;Delivery option is MAIL
MOVEI A,TOPAG
MOVEM A,FREETO ;Reset free space pointer
ERSTX: MOVE A,[POINT 7,TXTPAG]
MOVEM A,TXTPTR ;Reset pointer to text space
SETZM TXTPAG ;And make sure it starts with null
MOVX A,<5*NTXPGS*1000>-^D10 ;Text buffer size-10.
MOVEM A,TXTCNT
DMOVE A,USRHDR ;User's headers from init file
DMOVEM A,USRHFP ;Set up as current user headers
MOVEI B,0
IDPB B,A ;Make sure they end with a null
RET
ERSDT: SETZM REPDAT ;No reply date
RET
ERSSB: SETZM SUBBUF
RET
ERSBC: MOVEI T,BCCLST ;Erase bcc list
CALLRET ERSTO0
ERSCC: SKIPA T,[CCLIST] ;Erase cc list
ERSTO: MOVEI T,TOLIST ;Erase to list
ERSTO0: HRRZ W,(T)
IFN. W
DO.
CALL REMLST ;Remove from transmission medium list
LOAD W,ADPTR,(W) ;Get next in list
JUMPN W,TOP.
ENDDO.
ENDIF.
SETZM (T)
SKIPN CCLIST ;All list empty now?
SKIPE TOLIST
RET
SKIPE BCCLST
RET
MOVEI A,TOPAG ;Yes, reset free pointer
MOVEM A,FREETO
RET
;;;Display fields
DSHDR: CALL DISHDR
MOVEI D,SAVMOD
CALLRET SETTYM
DSALL: CALL DISHDR
CALL MOVTX1
MOVEI D,SAVMOD
CALLRET SETTYM
DISHDR: CALL TYPINI
MOVE A,[PBOUT%] ;Set up to type it out to tty
TXO F,F%RELD ;Show relative domains
CALL MOVFR0
CALL MOVSB1
CALL MOVTO1
CALL MOVCC1
CALL MOVBC1
CALL MOVRP1
CALL MOVRDT
CALLRET MOVUS1
DSFRM: SKIPA B,[MOVFR0]
DSREP: MOVEI B,MOVRP0
CALLRET .DSCC1
DSSUB: SKIPA B,[MOVSB0]
DSTXT: MOVEI B,MOVTX0
CALLRET .DSCC1
DSTO: SKIPA B,[MOVTO0]
DSCC: MOVEI B,MOVCC0
DSCC1: CALL TYPINI
MOVE A,[PBOUT%]
TXO F,F%RELD ;Show relative domains
CALL (B)
MOVEI D,SAVMOD
CALLRET SETTYM
DSBCC: MOVEI B,MOVBC0
CALLRET .DSCC1
MOVFRM: MOVE A,[IDPB A,O]
MOVFR0: MOVEM A,MOVDSP ;Set up instruction
MOVFR1: MOVEI B,[ASCIZ/
From: /]
MOVFRR: CALL MOVSB2
SKIPN FRMSCM ;If the user has given a "From:"
IFSKP.
MOVEI B,FRMSCM ; then use it
CALLRET MOVSB2
ENDIF.
SKIPN PERNAM ;Has a personal name?
IFSKP.
MOVEI B,PERNAM
CALL MOVSB2
MOVX A,.CHSPC
XCT MOVDSP
MOVX A,.CHLAB
XCT MOVDSP
ENDIF.
MOVEI B,MAUSRS ;My name
CALL MOVSB2 ;Put it in
CALL MOVMHN ;Put in@SITE
SKIPN PERNAM ;Has a personal name?
RET ;No, all done
MOVX A,.CHRAB
XCT MOVDSP
RET
MOVSDR: MOVE A,[IDPB A,O] ;Output Sender
MOVSD0: MOVEM A,MOVDSP ;Set up to move into memory
MOVSD1: MOVEI B,[ASCIZ/
Sender: /]
MOVSRR: CALL MOVSB2
MOVE A,O
MOVE B,MYUSR ;Login directory
DIRST%
JFATAL
MOVE O,A ;Update pointer
CALLRET MOVMHN ;Output local host
MOVREP: MOVE A,[IDPB A,O] ;Output Reply-To
MOVRP0: MOVEM A,MOVDSP ;Set up to move into memory
MOVRP1: SKIPN REPSCM ;Did user specify a Reply-To?
RET ;No, return now
MOVEI B,[ASCIZ/
Reply-To: /] ;Yes, use it
CALL MOVSB2
HRROI B,REPSCM ;Move in the text and return
CALLRET MOVSB2
MOVUSH: MOVE A,[IDPB A,O]
MOVUS0: MOVEM A,MOVDSP ;Set up to move into memory
MOVUS1: SKIPN USRHFP ;Has any user headers?
RET ;No, none
MOVEI B,CRLF0 ;Put in crlf first
CALL MOVSB2
MOVEI B,USRHDT
CALLRET MOVSB2 ;Go add that in
MOVSUB: MOVE A,[IDPB A,O] ;Output subject
MOVSB0: MOVEM A,MOVDSP ;Set up to move into memory
MOVSB1: LDB A,[POINT 7,SUBBUF,6]
JUMPE A,R ;No subject
MOVEI B,[ASCIZ/
Subject: /]
CALL MOVSB2 ;Print header part
MOVEI B,SUBBUF ;Start of actual string
MOVSB2: HRLI B,(<POINT 7,>)
MOVSB3: ILDB A,B ;Get char
JUMPE A,R ;Done
XCT MOVDSP ;Handle it
JRST MOVSB3
MOVTXT: MOVE A,[IDPB A,O] ;Output text
MOVTX0: MOVEM A,MOVDSP ;Set up to move into memory
MOVTX1: MOVEI B,[ASCIZ/
/]
CALL MOVSB2
MOVEI B,TXTPAG
CALL MOVSB2
LDB A,TXTPTR
MOVEI B,CRLF0
CAIE A,.CHLFD ;Unless ended with CRLF
CALL MOVSB2 ;Put one in
MOVEI B,[ASCIZ/-------
/]
CALLRET MOVSB2 ;And end it up
MOVBC0: MOVEM A,MOVDSP ;Output BCC
MOVBC1: MOVEI T,[ASCIZ/
Bcc: /]
HRRZ W,BCCLST
CALLRET MOVTO2
MOVCC: MOVE A,[IDPB A,O] ;Output CC
MOVCC0: MOVEM A,MOVDSP
MOVCC1: MOVEI T,[ASCIZ/
cc: /]
HRRZ W,CCLIST
CALLRET MOVTO2
MOVTO: MOVE A,[IDPB A,O] ;Output to
MOVTO0: MOVEM A,MOVDSP
MOVTO1: MOVEI T,[ASCIZ/
To: /]
MOVTRM: HRRZ W,TOLIST
MOVTO2: DO.
JUMPE W,R ;None here, forget it
IFQN. ADINV,(W) ;Don't print if invisible requested
LOAD W,ADPTR,(W) ;Get next in list
LOOP.
ENDIF.
ENDDO.
SKIPA B,T ;Use keyword for first time
MOVTO3: MOVEI B,[ASCIZ/
/] ;Yes, just indent
CALL MOVSB2 ;Print header
MOVEI D,3 ;Init horizontal position
MOVTO4: MOVEI B,ADRSTR(W) ;Get name
TXZ F,F%QOT ;Currently not a quoted string
HRLI B,(<POINT 7,>) ;Make string pointer to address
LOAD C,ADTYP,(W) ;Get type field
CAIE C,AD.FIL ;File recipient?
IFSKP.
TXO F,F%QOT ;Yes, flag must quote
MOVEI A,"""" ;Yes, start the quote
XCT MOVDSP
MOVEI A,"*" ;Now splat
XCT MOVDSP
ELSE.
PUSH P,B ;Save string pointer
PUSH P,C ;And type
PUSH P,D ;And byte count
DO. ;Search string for specials
ILDB C,B
IFN. C
IDIVI C,^D32 ;C/ word to check, D/ bit to check
MOVNS D
MOVX A,1B0 ;Make bit to check
LSH A,(D)
TDNN A,SPCMSK(C) ;Is it a special character?
LOOP. ;No, continue search
TXO F,F%QOT ;Must quote this address
ENDIF.
ENDDO.
POP P,D ;Restore byte count
POP P,C ;And type
POP P,B ;Restore string pointer
ANDXN. F,F%QOT ;Need to quote?
MOVEI A,"""" ;Yes, do so
XCT MOVDSP
ENDIF.
DO. ;Copy string to designated output
ILDB A,B
IFN. A
XCT MOVDSP
AOJA D,TOP.
ENDIF.
ENDDO.
IFXN. F,F%QOT ;Need to quote?
MOVEI A,""""
XCT MOVDSP
ENDIF.
CAIE C,AD.GRP ;Distribution list?
IFSKP.
MOVEI B,[ASCIZ/: ;/] ;Yes, set up empty list
ELSE.
CAIE C,AD.NET ;Network recipient?
IFSKP.
HRRO B,ADRHST(W) ;Yes, get host pointer
IFXE. F,F%RELD ;Include relative domains?
MOVE A,[POINT 7,TMPBUF] ;No, copy it to temporary space
CALL MOVST0
HRROI A,TMPBUF ;Remove relative domains from it
CALL $RMREL
HRROI B,TMPBUF ;Continue with pointer to it
ENDIF.
ELSE.
TXNN F,F%RELD ;Include relative domain?
SKIPA B,[POINT 7,LCLHNM] ;No, use absolute local hostname
HRRO B,LCLHST ;Else use relative local hostname
ENDIF.
MOVE A,[POINT 7,STRBUF] ;Write host name here temporarily
IFXN. F,F%QUOT ;Need to write rubouts around it?
MOVX C,.CHDEL
IDPB C,A
ENDIF.
SETZ C,
SOUT% ;Output name string
IFXN. F,F%QUOT
MOVEI B,.CHDEL
IDPB B,A
ENDIF.
IDPB C,A ;Tie off string with null
MOVEI A,"@" ;Output at delimiter
XCT MOVDSP
ADDI D,1 ;Count 1 char for this
MOVEI B,STRBUF
ENDIF.
HRLI B,(<POINT 7,>) ;Make string pointer to address
DO. ;Copy string to designated output
ILDB A,B
IFN. A
XCT MOVDSP
AOJA D,TOP.
ENDIF.
ENDDO.
DO.
LOAD W,ADPTR,(W) ;Get next in list
JUMPE W,R
JN ADINV,(W),TOP. ;Don't print if invisible requested
ENDDO.
MOVEI A,","
XCT MOVDSP
TXNE F,F%QUOT ;Always generate continuation line
AOJA E,MOVTO3
CAIL D,^D65 ;Near end?
AOJA E,MOVTO3 ;Yes, get new line for more then
MOVX A,.CHSPC
XCT MOVDSP
ADDI D,2
JRST MOVTO4
MOVRDT: SKIPG REPDAT ;Has a reply date?
RET ;No
HLRZ C,MSGMID(M) ;Get size of Message-ID field
IFN. C ;If have an ID
MOVEI B,[ASCIZ/
In-Reply-To: /]
CALL MOVSB2
HRRZ V,MSGMID(M) ;Get byte offset of field
CALL MCH2BP ;Get byte pointer to it
MOVE B,A
HLRZ C,MSGMID(M) ;And counter
DO. ;Ignore leading whitespace
ILDB A,B
CAIE A,.CHSPC
CAIN A,.CHTAB
SOJG C,TOP.
JUMPE C,R
SKIPE A
XCT MOVDSP
SOJE C,R
ENDDO.
DO.
ILDB A,B
SKIPE A ;Never put in a null
XCT MOVDSP
SOJG C,TOP.
ENDDO.
RET
ENDIF.
MOVEI B,[ASCIZ/
In-Reply-To: Message/]
CALL MOVSB2
HLRZ C,MSGFRM(M) ;Get size of From: field
IFN. C ;Has an author?
HRRZ V,MSGFRM(M) ;Get byte offset of field
CALL MCH2BP ;Get byte pointer to it
MOVE B,A ;Put pointer in A
DO. ;Flush leading whitespace
ILDB A,B ;Get char
IFE. A ;Ignore nulls
SOJG C,TOP.
ELSE.
CAIE A,.CHTAB ;Ignore whitespace
CAIN A,.CHSPC
SOJG C,TOP.
ENDIF.
ENDDO.
IFN. C
SETO A, ;Back up pointer by 1
ADJBP A,B
PUSH P,A ;And save it for below
MOVEI B,[ASCIZ/ from "/]
CALL MOVSB2
POP P,B ;Retrieve pointer
DO.
ILDB A,B
SKIPE A ;Never put in a null
XCT MOVDSP
SOJG C,TOP.
ENDDO.
MOVEI A,""""
XCT MOVDSP
ENDIF.
ENDIF.
MOVEI B,[ASCIZ/ of /]
CALL MOVSB2
SETZ A,
MOVE B,MOVDSP ;Get instruction
CAMN B,[IDPB A,O] ;Output to string?
MOVE A,O ;Yes, get current BP
CAMN B,[PBOUT%] ;Output to TTY?
MOVX A,.PRIOU ;Yes, select terminal output
MOVE B,REPDAT
MOVX C,OT%DAY!OT%SPA!OT%TMZ!OT%SCL!OT%822 ; RFC 822 standard date/time
ODTIM%
CAIE A,.PRIOU ;Unless going to current output
MOVE O,A ;Set byte pointer to value from ODTIM%
RET
MOVMHN: MOVX A,"@" ;Now put in an "@"
XCT MOVDSP
TXNE F,F%RELD ;Include relative domain?
SKIPA B,LCLHST ;Yes, output host name string
MOVEI B,LCLHNM ;No, output absolute name
MOVE A,MOVDSP ;Get current output
CAME A,[PBOUT%] ;If output to TTY
TXNN F,F%QUOT ;Or no quoted host names
JRST MOVSB2 ;Just output host name string
MOVX A,.CHDEL
XCT MOVDSP
CALL MOVSB2
MOVX A,.CHDEL
XCT MOVDSP
RET
;;;Get some more text
GETTXT: SKIPE USEEDT ;Go straight to editor?
JRST TXTED ;Yes, do so
SKIPE TRSTPR ;Terse or verbose?
IFSKP.
SKIPE JISMOD ;JIS terminal?
SKIPA A,[[ASCIZ\CTRL/D\]]
MOVEI A,[ASCIZ\ESCAPE or CTRL/D\]
MOVEI B,[ASCIZ\or CTRL/Z\]
TXNN F,F%RSCN
SKIPGE ESCSND
MOVEI B,[ASCIZ\to get to send command level, CTRL/Z to send\]
SKIPLE ESCSND
MOVEI B,[ASCIZ\to send, CTRL/Z to get to send command level\]
SKIPE SIMODE ;Katakana terminal?
SKIPA C,[[ASCIZ\, CTRL/X to abort.\]]
MOVEI C,[ASCIZ\, CTRL/N or CTRL/X to abort.\]
SKIPGE ABOFLG ;Wants abort?
MOVEI C,[ASCIZ\.\]
UETYPE 1,[ASCIZ" Message:
(End with %1S %2S.
Use CTRL/B to insert a file, CTRL/E to enter editor, CTRL/K to redisplay
message, CTRL/L to clear screen and redisplay%3S)
"] ;UETYPE 1, = CIETYPE
ELSE.
CITYPE < Msg:
>
ENDIF.
CALLRET .TEXT0
TEXT: CONFRM
TEXT0: SKIPE ABOSTS ;Unless vector already exists,
IFSKP.
SETABT CMDABO ;Allow abort back to toplevel
ENDIF.
TEXT1: SKIPE USEEDT ;Go straight to editor?
JRST TXTED ;Yes, do so
CALL TXTINI
MOVX A,RD%JFN ;Set up flags
MOVEM A,TTXTIB+.RDFLG
MOVE A,CMDBLK+.CMIOJ ;Get where I/O is going
MOVEM A,TTXTIB+.RDIOJ ;Let TEXTI% know about it
MOVE A,[POINT 7,TXTPAG] ;Where it starts
MOVEM A,TTXTIB+.RDBFP
SKIPE JISMOD ;Kanji user?
SKIPA A,[TXTJIS] ;Yes, use JIS break mask
MOVEI A,TXTMSK ;Else use regular break mask
MOVEM A,TTXTIB+.RDBRK
MOVEI A,TTXTIB
TEXTI%
JERROR
MOVEI D,SAVMOD ;Restore program's modes
CALL SETTYM
LDB B,TXTPTR
MOVEM B,LSTCHR ;Save terminator
SETZ A,
DPB A,TXTPTR ;Replace terminator with null
SETO A,
ADJBP A,TXTPTR
MOVEM A,TXTPTR
AOS TXTCNT
CAIN B,.CHCNB ;CTRL/B inserts file
JRST TXTFIL
CAIN B,.CHCNE ;CTRL/E - enter editor on text
JRST TXTEDC
CAIN B,.CHVTB ;Wants retype of whole thing?
JRST .TEXT2
CAIE B,.CHFFD ;Clear and retype?
RET ;No, must have terminated right
CALL $BLANK ;Yes
CITYPE < Msg:>
TEXT2: CALL CRIF
CALL TYPINI ;Init CCOC words
HRROI A,TXTPAG ;Start of stuff
PSOUT%
MOVEI D,SAVMOD ;Restore program's modes
CALL SETTYM
JRST .TEXT1 ;And go get some more
TXTFIL: PROMPT <(Insert file: >
MOVEI B,TXTFL1
HRRM B,CMDBLK+.CMFLG
MOVEM P,REPARP
TXTFL1: MOVE P,REPARP
MOVEI B,[FLDDB. .CMIFI,,,,,[
FLDDB. .CMCFM,CM%SDH,,<return to cancel file insertion>]]
CALL $COMND
JXN A,CM%NOP,TXTFLE
LOAD A,CM%FNC,(C) ;Get field type
CAIE A,.CMCFM ;Confirm?
IFSKP.
TMSG <...No file inserted)
> ;Yes, abort CTRL/B input
JRST .TEXT1
ENDIF.
MOVEM B,TMPJFN
MOVEI B,CNFCMD
CALL $COMND ;Confirm
JXN A,CM%NOP,TXTFLE
MOVE A,TMPJFN
MOVX B,<<FLD 7,OF%BSZ>!OF%RD>
OPENF%
ERJMP TXTFLE
CALL INSFL3
TMSG <...EOF)
>
JRST .TEXT1
TXTFLE: JWARN ;Error getting file, return for text
CALL CRLF
JRST .TEXT1
TXTEDC: SKIPLE A,EDTFLG ;Editing always done?
IFSKP.
IFE. A ;No, do we ask?
PROMPT <Edit message text? > ;Yes
CALL YESNO ;Confirm edit
JRST .TEXT1 ;User said no
ELSE.
IDPB B,TXTPTR ;No, put the character in the buffer
SOS TXTCNT
JRST .TEXT1
ENDIF.
ENDIF.
TXTED: CALL CRIF ;Edit text, get fresh line
CALLRET .EDTXT ;And go start doing it
INSFL: MOVEI B,[FLDDB. .CMIFI]
CALL CMDFLD ;Get the file
MOVEM B,TMPJFN
CONFRM
MOVE A,TMPJFN
MOVX B,<<FLD 7,OF%BSZ>!OF%RD>
OPENF%
IFJER.
MOVE A,TMPJFN
JWARN <Can't open input file "%1J">
CALLRET CRLF
ENDIF.
INSFL3: MOVE B,TXTPTR
MOVN C,TXTCNT
SIN%
ERJMP .+1
CLOSF%
NOP
SETOM TMPJFN
IFGE. C ;A fencepost but what the hell
SETZ C, ;Full buffer
SNARL <Buffer overflow - file too large>
ENDIF.
EXCH B,TXTPTR ;B - source of copy to remove nulls
MOVE A,B ;A - dest of copy
MOVNM C,TXTCNT ;C - current character
DO.
CAMN B,TXTPTR ;TXTPTR - end of source text
IFSKP.
ILDB C,B ;Copy
SKIPE C ;Removing nulls
IDPB C,A
SKIPN C ;Each one skipped increases free space
AOS TXTCNT
LOOP.
ENDIF.
ENDDO.
MOVEM A,TXTPTR ;Updated end of text
RET
;;;Get a new subject
SUBJE: SKIPN SIMODE ;If not a funny terminal...
SKIPE JISMOD
IFSKP.
CALL GETLIN ;The easy way...
CONFRM
JUMPE B,.ERSSB ;None given, erase the subject then
MOVE A,[STRBUF,,SUBBUF]
BLT A,SUBEND ;Move over the subject
RET
ENDIF.
CONFRM ;Else do it the hard way...
GETSUB: TXZ F,F%HOER ;No more error halting
SKIPE ABOSTS ;Unless vector already exists,
IFSKP.
SETABT CMDABO ;Allow abort back to toplevel
ENDIF.
TMSG < Subject: >
STKVAR <<TSUBIB,.RDBRK+1>>
MOVX A,.RDBRK ;Size of block
MOVEM A,.RDCWB+TSUBIB
MOVX A,RD%JFN ;Set up flags
MOVEM A,.RDFLG+TSUBIB
MOVE A,CMDBLK+.CMIOJ ;Get where I/O is going
MOVEM A,.RDIOJ+TSUBIB ;Let TEXTI% know about it
MOVE A,[POINT 7,SUBBUF] ;Where it starts
MOVEM A,.RDDBP+TSUBIB
MOVEM A,.RDBFP+TSUBIB
MOVX A,SUBBSZ ;Subject buffer length
MOVEM A,.RDDBC+TSUBIB
HRROI A,[ASCIZ/ Subject: /]
MOVEM A,.RDRTY+TSUBIB
MOVEI A,LINJIS ;Use JIS line break mask
MOVEM A,.RDBRK+TSUBIB
SKIPN SIMODE ;Katakana mode?
SKIPE JISMOD ;JIS mode?
CALL TXTINI ;Yes, init
MOVEI A,TSUBIB
TEXTI%
JERROR
MOVEI D,SAVMOD ;Restore program's modes
CALL SETTYM
LDB A,.RDDBP+TSUBIB ;See if need to eat an LF
CAIN A,.CHCRT ;Well?
PBIN% ;Yes, do so
SETZ A, ;Tie off line at the break
DPB A,.RDDBP+TSUBIB
RET
GETBCC: PROMPT < bcc: >
SKIPE ABOSTS ;Unless vector already exists,
IFSKP.
SETABT CMDABO ;Allow abort back to toplevel
ENDIF.
BCC: PUSH P,[BCCLST] ;Add someone to bcc list
CALLRET CC1
GETCC: PROMPT < cc: >
SKIPE ABOSTS ;Unless vector already exists,
IFSKP.
SETABT CMDABO ;Allow abort back to toplevel
ENDIF.
CC: PUSH P,[CCLIST]
CC1: TXO F,F%CC ;Say in cc command
CALLRET .TO2 ;And enter TO command
GETTO: PROMPT < To: >
TXZ F,F%RSCC ;Now out of RSCAN% code
GETTO0: SKIPE ABOSTS ;Unless vector already exists,
IFSKP.
SETABT CMDABO ;Allow abort back to toplevel.
ENDIF.
TO: PUSH P,[TOLIST] ;What list to add to
TXZ F,F%CC
TO2: TXZ F,F%F3!F%COMA!F%F4 ;Don't allow funny local names
MOVE W,FREETO ;Start with some free space
PUSH P,CMDRET ;Save error dispatch
DO.
CALL GETUSR ;Get the user name
IFSKP.
TXNE F,F%COMA ;Got one, comma seen?
LOOP. ;Yes, get another then
ENDIF.
ENDDO.
POP P,CMDRET
POP P,T ;Get list to add to
CALLRET ADDTO0 ;Now add the whole line in and return
;;;Get prompted message
GETMSG: CALL GETTO
GETMS0: CALL GETCC
SKIPE ASKBCC ;Prompt for bcc?
CALL GETBCC
GETMS1: CALL GETSUB
CALLRET GETTXT
;;;Remove user
UNTO: TXZ F,F%COMA!F%F4 ;No comma seen yet
TXO F,F%F3 ;Allow funny addresses
MOVE W,FREETO ;Some random space to use
DO.
CALL GETUSR ;Get a user name
ERROR <Null address invalid>
JXN F,F%COMA,TOP. ;Wants more?
ENDDO.
HRRZS W ;Just in case
PUSH P,W ;Save tail of list
HRRZ U,FREETO ;Get head of list
DO.
PUSH P,U ;Save current pointer
MOVEI U,ADRSTR(U) ;Point to text of name
SETZ N, ;Allow 0 occurances of that name
CALL DOUNTO ;Remove the name
IFE. N
ERROR <Address "%7S" not found>
ENDIF.
POP P,U
LOAD B,ADSIZ,(U) ;Get size
ADDI U,(B)
CAME U,(P) ;End of list yet?
LOOP.
ENDDO.
CPPOPJ: ADJSP P,-1 ;No more, fix up stack and return
RET
;;;Remove name from string in U, allowing only (n) occurances
DOUNTO: MOVEI V,TOLIST ;Get to pointers
CALL DOUNTL
MOVEI V,CCLIST
CALL DOUNTL
MOVEI V,BCCLST
DOUNTL: MOVEM V,UNTHDR ;Save header address for fixing last
DO.
LOAD W,ADPTR,(V)
JUMPE W,R ;None of this class
MOVEI B,(U) ;Target string
HRLI B,(<POINT 7,>)
MOVEI A,ADRSTR(W) ;This particular one
HRLI A,(<POINT 7,>)
DO.
ILDB C,B ;Get char from target
ILDB D,A
IFN. C ;Null means it matches
CAIN D,(C)
LOOP. ;Chars match?
TRC D,(C)
CAIN D,.CHSPC ;Case only?
LOOP. ;Yes, keep looking
ELSE.
IFE. D
SOSL N ;Count one more occurance
ANSKP.
LOAD A,ADSIZ,(W) ;Get length of this block
ADDI A,(W) ;Point to start of next block
CAMN A,FREETO ;Was this the last entry?
MOVEM W,FREETO ;Yes, just update end pointer
CALL REMLST ;Remove from transmission medium list
LOAD W,ADPTR,(W) ;Get next link in to/cc list
STOR W,ADPTR,(V) ;Relink previous
IFE. W ;If this is the end of the list now
HRLM V,@UNTHDR ;Update last (this fixes a bug)
CAIE V,TOLIST ;Was this the head of the list?
CAIN V,CCLIST
SETZM (V) ;Yes, clear whole thing
CAIN V,BCCLST
SETZM (V)
ENDIF.
EXIT. ;A-okay here
ENDIF.
ENDIF.
MOVEI V,(W) ;Setup to get next in list
ENDDO.
LOOP.
ENDDO.
SUBTTL SPELL interfacing subroutines
;;;SEND/REPLY command entry
SSPEL: CONFRM
CALL SPLSET ;Set up for SPELL
MOVE A,[POINT 7,TXTPAG] ;Starting byte pointer
MOVE B,TXTPTR ;Ending one
CALL SPLLEN ;Compute size of field
CALL SPLICP ;Copy it into SPELL's input file
CALL SPLGET ;Set up the SPELL fork
CALL SPLRUN ;Run SPELL
RET
MOVE A,[POINT 7,TXTPAG] ;Put updated text here
MOVEI C,NTXPGS*1000*5 ;Maximum size of receiving area
CALL SPLOCP ;Get the updated text
MOVEM B,TXTPTR ;Update end of text pointer
SETZ C,
IDPB C,B ;End it with a null too
CALLRET SPLCLN ;Cleanup and return
;;;READ command entry
RSPEL: CONFRM ;Spell check this message
CALL CHKDEL ;Make sure there is a message
RET
CALL SPLSET ;Set up for SPELL
HRRZ V,MSGBOD(M)
CALL MCH2BP ;Get byte pointer to the message
HLRZ C,MSGBOD(M) ;And its length
CALL SPLICP ;Copy the msg and return
CALL SPLGET ;Set up the SPELL fork
CALL SPLRUN ;Run SPELL
RET
MOVE A,[POINT 7,SPLPAG] ;Get the updated msg into here
MOVEI C,NEDPGS*1000*5 ;Size of that area
CALL SPLOCP ;Get the updated msg
CALL RPLMSG ;Replace the current msg with it
SNARL <Unable to update text from Spell>
CALLRET SPLCLN ;Cleanup and return
;;;Routine to set up temp file for SPELL to use as input
;;;On exit:
;;; SPLIFL/ JFN to the text to correct
;;; SPLOFL/ JFN of temp file for SPELL to return text in
;;;Clobbers ACs: A, B
SPLSET: MOVX A,GJ%FOU!GJ%SHT!GJ%TMP ;Get a temp file for SPELL input
HRROI B,[ASCIZ/MM-SPELL-IN.TMP;P770000/]
GTJFN%
JERROR <Can't get SPELL input temporary file>
MOVX B,<<FLD 7,OF%BSZ>!OF%WR> ;We want to write msg into it
OPENF%
JERROR <Can't open SPELL input temporary file>
MOVEM A,SPLIFL ;Save it
MOVX A,GJ%FOU!GJ%SHT!GJ%TMP ;Get SPELL's output file
HRROI B,[ASCIZ/MM-SPELL-OUT.TMP;P770000/]
GTJFN%
JERROR <Can't get SPELL output temporary file>
MOVEM A,SPLOFL
RET
;;;Routine to compute the size of the current TEXT field
;;;On entry:
;;; A/ start byte pointer of field
;;; b/ end byte pointer of field
;;;On exit:
;;; C/ size of field in characters
;;;Clobbers ACs: B
SPLLEN: LDB C,[POINT 6,B,5]
IDIVI C,7 ;Get chars within word
SUBI B,(A)
HRREI B,(B) ;Get number of words
IMULI B,5 ;Into chars
SUBI B,(C) ;Get total number of chars
LDB C,[POINT 6,A,5]
IDIVI C,7
ADDI B,(C)
MOVE C,B ;Leave size in AC c
RET
;;;Routine to copy text into SPELL's input file
;;;On entry:
;;; A/ start of text pointer
;;; C/ length of field in characters
;;; SPLIFL/ SPELL's input file opened for write
;;;On exit:
;;; SPLIFL/ good JFN, but closed
;;;Clobbers ACs: A, B, C
SPLICP: MOVE B,A
MOVE A,SPLIFL
MOVNS C
SOUT%
TXO A,CO%NRJ ;Don't release the JFN
CLOSF%
JFATAL
RET
;;;Routine to get a SPELL fork
;;;On exit:
;;; A/ fork handle just gotten
;;; SPLFRK/ fork handle which is ready to run SPELL in
;;;Clobbers ACs: a,b
SPLGET: SKIPE SPLFRK ;Do we have a fork yet?
IFSKP.
MOVX A,CR%CAP ;Create a fork for SPELL
CFORK%
JERROR <Can't create SPELL fork>
MOVEM A,SPLFRK ;Save the fork handle
ENDIF.
MOVX A,GJ%OLD!GJ%SHT
HRROI B,SPLNAM ;Name of SPELL program
GTJFN%
JERROR <Can't find find SPELL program>
HRL A,SPLFRK ;Get the fork handle again
GET%
MOVE A,SPLFRK ;Return with the fork handle in A
RET
;;;Routine to run SPELL
;;;On entry:
;;; SPLFRK/ fork handle of SPELL or 0 if none yet
;;; SPLIFL/ JFN of the text to correct (should be in the file already)
;;; SPLOFL/ JFN of where to write the corrected code
;;;Clobbers ACs: A, B, C
SPLRUN: SAVEAC <D>
STKVAR <<SPLACS,20>>
MOVEI B,SPLACS ;Get the old ACs
RFACS%
IFJER.
JSNARL <Can't access SPELL>
CALLRET SPLPNT ;Punt SPELL
ENDIF.
MOVE C,SPLIFL ;Set the input
MOVEM C,A(B)
MOVE C,SPLOFL ;And output JFNs in SPELL's ACs
MOVEM C,B(B)
SFACS%
MOVEI B,SPLOFF ;Start SPELL, HERMES entry point
SFRKV%
IFJER.
JSNARL <Can't start SPELL, probably wrong version>
CALLRET SPLPNT
ENDIF.
WFORK% ;And wait for SPELL to finish
DMOVE A,PRGNAM ;Restore our program name
SETSN%
JFATAL
MOVEI D,SAVMOD ;Restore TTY modes
CALL SETTYM
RETSKP
ENDSV.
;;;Routine to get (into the edit buffer) the changed text
;;;On entry:
;;; A/ pointer to where to put the text
;;; C/ size of where to put the text
;;; SPLOFL/ JFN for SPELL's output file (not opened)
;;;On exit:
;;; SPLOFL/ same JFN, but closed
;;; A/ pointer to buffer
;;; B/ pointer to end of buffer
;;; C/ count (in characters) of size of buffer
;;;Clobbers AC: B
SPLOCP: PUSH P,A ;Save where to put the text
PUSH P,C ;And size of area
MOVE A,SPLOFL ;Get the JFN again
MOVX B,<<FLD 7,OF%BSZ>!OF%RD> ;Open for read this time
OPENF%
JERROR
MOVE B,-1(P) ;Get the start of the area
MOVN C,(P) ;Maximum count
SIN% ;Read it in there
ERJMP .+1
SKIPL C
SNARL <Buffer overflow - file too large>
TXO A,CO%NRJ ;Don't release the JFN (yet)
CLOSF%
NOP
ADD C,(P) ;Compute byte count
ADJSP P,-1
POP P,A ;And point to start of text
RET
;;;Routine to punt SPELL after an error (execute-only, wrong version, etc.)
SPLPNT: CALL SPLCLN ;Clean up
SKIPE A,SPLFRK ;Now kill the fork
KFORK%
SETZM SPLFRK
SAVEAC <B,C,D>
MOVEI D,SAVMOD ;Restore TTY modes
CALLRET SETTYM
;;;Routine to clean up after finishing with SPELL this time
;;;On exit:
;;; SPLIFL/ garbage
;;; SPLOFL/ garbage
;;;Clobbers ACs: a
SPLCLN: HRRZ A,SPLIFL
TXO A,DF%EXP ;Delete and expunge the input file
DELF%
ERJMP .+1 ;Ignore errors
HRR A,SPLOFL ;Same here
DELF%
ERJMP .+1
RET
SUBTTL Editor interfacing subroutines
;;;Edit commands
EDIT: CALL DFSQTH ;Edit specifies messages
MOVX A,.REDI1
CALLRET DOMSGS
REDIT: CONFRM ;Edit this message
REDI1: CALL CHKDEL
RET
TXNE F,F%RONL ;File read-only?
ERROR (File is read-only)
CALL SEDMSG ;Set editor to munge current message
IFXN. F,F%TECO ;TECO based?
MOVE A,EDBPAG+0(T) ;BJ
MOVEM A,EDBPAG+2(T)
ENDIF.
DMOVE A,[ASCIZ/Message/]
DMOVEM A,EDINAM
DMOVEM A,BUFNAM
CALL RESTED ;Now edit it
CALL GEDBUF ;Get the editted text
CALL .EDFIN ;Go restore TTY modes
CALL RPLMSG ;Replace current message with that
SNARL <Unable to update text from editor>
MOVX A,M%SEEN ;Mark message as seen
IORM A,MSGBTS(M)
RET
;;;Prepare for editting the current message
SEDMSG: DMOVE A,[ASCIZ/Message/]
DMOVEM A,BUFNAM
HRRZ V,MSGBOD(M)
CALL MCH2BP ;Get byte pointer to message
HLRZ B,MSGBOD(M) ;And length
CALLRET EDREPL ;Load message into the editor
;;;Edit message text
EDTXT: SETABT ;Save previous abort state
CALL ABNDIS ;Don't CTRL/N out of editor
DMOVE A,[ASCIZ/Reply/] ;Name of the buffer
DMOVEM A,BUFNAM
SKIPGE M.RPLY
MOVE A,[ASCIZ/Send/] ;Only 5 chars needed here
DMOVEM A,EDINAM ;Name of edit type
MOVE A,[POINT 7,TXTPAG] ;Starting byte pointer
MOVE B,TXTPTR ;Ending one
CALL SEDBUF ;Setup editor text
IFXN. F,F%TECP ;Hairy interface?
CALL SEDMSG ;Yes, put message in the message buffer
CALL SEDHDR ;And headers in the headers buffer
ENDIF.
DMOVE A,[ASCIZ/Reply/]
DMOVEM A,BUFNAM
CALL RESTED ;Run the editor
CALL GEDTXT ;Get the new text
TXNE F,F%TECP
CALL GEDHDR ;Get updated headers if need be
CALLRET .EDFIN
;;;Get it back and update if necessary
GEDTXT: DMOVE A,[ASCIZ/Reply/]
DMOVEM A,BUFNAM
CALL GEDBUF ;Get the editted text
MOVE B,[POINT 7,TXTPAG] ;Replace it here
CALL FRMSN1 ;Move string
MOVEM B,TXTPTR ;Update pointer
SETZ D,
IDPB D,B ;And end with a null too
RET
;;;All done, restore TTY modes for program
EDFIN: SAVEAC <A,B,C,D>
MOVEI D,EDMOD ;Save editor modes
CALL GETTYM
MOVEI D,SAVMOD ;And restore ours
CALLRET SETTYM
;;;Edit headers
EDHEA: DMOVE A,[ASCIZ/Default/]
DMOVEM A,EDINAM
CALL SEDHDR ;Put in headers
CALL RESTED ;Edit them
CALL GEDHDR ;Get new ones
CALLRET .EDFIN ;And all done
;;;Put in headers
SEDHDR: MOVE O,[POINT 7,WRTPGS] ;Some temp space
TXZ F,F%QUOT ;Don't quote it
TXO F,F%RELD ;Include relative domains
CALL MOVTO
CALL MOVCC1
CALL MOVSUB
CALL MOVREP ;And Reply-To
DMOVE A,[ASCIZ/Headers/]
DMOVEM A,BUFNAM
MOVE A,[POINT 7,WRTPGS] ;Starting pointer
DO.
ILDB B,A
CAIE B,.CHCRT ;Move over blank lines
CAIN B,.CHLFD
LOOP.
ENDDO.
ADD A,[7B5]
MOVE B,O ;Ending one
CALLRET SEDBUF ;Setup editor for that
;;;Get the new headers
GEDHDR: DMOVE A,[ASCIZ/Headers/]
DMOVEM A,BUFNAM
CALL GEDBUF ;Get what it gave back
PUSH P,A ;Save pointers to editor text
PUSH P,C
CALL .ERSTO ;Erase to field
CALL .ERSCC ;And cc field
CALL .ERSSB ;And subject field
POP P,C ;Get back pointers
POP P,A
JUMPLE C,R ;No text there
ADJBP C,A ;Get ending byte pointer
SETZ D,
IDPB D,C ;Put a null at the end
TXZ F,F%CC ;Start with to field
TXO F,F%RELD ;Include relative domains
SETZ E, ;No default host name
GEDHD1: ILDB B,A ;Get next char
CAIE B,.CHTAB ;Whitespace indicates continuation
CAIN B,.CHSPC
JRST GEDHDS
CAIE B,"T" ;More to maybe
CAIN B,"t"
JRST GEDHTO
CAIE B,"C" ;Or maybe start of cc
CAIN B,"c"
JRST GEDHCC
CAIE B,"s"
CAIN B,"S"
JRST EDSUBJ ;Get the subject now
GEDHD2: CAIN B,.CHLFD ;Saw linefeed yet?
JRST GEDHD1 ;Yes, try this line
JUMPE B,R ;Keep on going unless EOM
ILDB B,A ;Otherwise soak up line
JRST GEDHD2
GEDHTO: ILDB B,A
CAIE B,"O"
CAIN B,"o"
CAIA
JRST GEDHD2 ;Soak up line if no match
ILDB B,A
CAIE B,":"
JRST GEDHD2 ;No good I guess
GEDHDS: CALL PRADDT ;Parse this line
LDB B,A ;Get terminating character
JUMPE B,R ;Null means all done now
CAIN B,.CHCRT ;Was terminator CR?
IBP A ;Yes, move over the LF too
JRST GEDHD1 ;Try for another line
GEDHCC: ILDB B,A
CAIE B,"C"
CAIN B,"c"
CAIA
JRST GEDHD2
ILDB B,A
CAIE B,":"
JRST GEDHD2
TXO F,F%CC ;Now doing cc
JRST GEDHDS ;And now go get addresses
EDSUBJ: ILDB B,A
CAIE B,"U"
CAIN B,"u"
CAIA
JRST GEDHD2
ILDB B,A
CAIE B,"B"
CAIN B,"b"
CAIA
JRST GEDHD2
ILDB B,A
CAIE B,"J"
CAIN B,"j"
CAIA
JRST GEDHD2
ILDB B,A
CAIE B,"E"
CAIN B,"e"
CAIA
JRST GEDHD2
ILDB B,A
CAIE B,"C"
CAIN B,"c"
CAIA
JRST GEDHD2
ILDB B,A
CAIE B,"T"
CAIN B,"t"
CAIA
JRST GEDHD2
ILDB B,A
CAIE B,":"
JRST GEDHD2
EDSUB1: ILDB B,A
JUMPE B,R
CAIE B,.CHLFD
CAIN B,.CHCRT
JRST GEDHD2
CAIE B,.CHSPC
CAIN B,.CHTAB
JRST EDSUB1
MOVE C,[POINT 7,SUBBUF]
EDSUB2: IDPB B,C
ILDB B,A
CAIE B,.CHCRT
CAIN B,.CHLFD
SETZ B,
JUMPN B,EDSUB2
IDPB B,C
JRST GEDHD2
;;;Setup the editor's text
SEDBUF: LDB C,[POINT 6,B,5]
IDIVI C,7 ;Get chars within word
SUBI B,(A)
HRREI B,(B) ;Get number of words
IMULI B,5 ;Into chars
SUBI B,(C) ;Get total number of chars
LDB C,[POINT 6,A,5]
IDIVI C,7
ADDI B,(C)
; CALLRET EDREPL ;Run editor over this field
;;;Replace the editor's buffer with a given string, BP in A, byte count in B
EDREPL: STKVAR <EDTBYT,EDTCNT,EDTJFN,EDTCMD>
MOVEM A,EDTBYT ;Save byte pointer
MOVEM B,EDTCNT ;Save character count
CAIG B,5*^D512*NEDPGS ;Larger than buffer?
IFSKP.
CALL KILED0 ;Kill the editor fork
ERROR <Buffer overflow - Message is too large to be EDITed>
ENDIF.
SUBI B,5*^D512*NEDPGS ;Get difference (do it this way so we
MOVMS B ; have difference for warning message)
CAILE B,^D5000 ;Within 5000 characters of limit?
IFSKP.
WARN <Message is very large; only %2D free characters in the edit buffer>
TXNE F,F%SEND ;Inside SEND level?
SKIPA A,[[ASCIZ/SAVE-DRAFT/]]
MOVEI A,[ASCIZ/MOVE/]
CIETYP <
If your editing will add more than %2D characters you should "%1S"
the message to a temporary file and edit it that way. If your editor
is an MIT-TECO based editor you have even less space due to TECO
overhead storage.
>
MOVEI A,^D5000 ;Be sure the warning message stays on
DISMS% ; the screen long enough to be seen
ENDIF.
SKIPG EDFORK ;If don't have a fork yet,
IFSKP.
MOVEI D,EDMOD ;Yes, Restore editor TTY modes
CALL SETTYM ; in case clobbered by error
ELSE.
CALL GETED ;Get one now
IFXE. F,F%TECO ;If it isn't TECO based, must use temp file
MOVEM A,EDTCMD ;Save start of rescan
MOVX A,GJ%SHT!GJ%FOU ;Note: can't use GJ%TMP because of
MOVX B,<<FLD 7,OF%BSZ>!OF%WR> ; of cretinous EDIT-20
CALL GEDTMP
CIETYP <[You must write out file %1J when done editing]
>
MOVEM A,EDTJFN ;Save JFN of temp file to edit
MOVEI A,^D5000 ; if they run TV, etc...
DISMS%
MOVE A,EDTCMD ;Get back pointer for rescan
MOVE B,EDTJFN ;File name to output
MOVE C,[001110,,JS%PAF]
JFNS%
MOVEI B,CRLF0 ;Finish up command line
CALL MOVST0
MOVE A,EDTJFN ;Recover JFN
MOVE B,EDTBYT ;Recover pointer
MOVN C,EDTCNT ;Recover count
SOUT% ;Write it out
CLOSF%
NOP
CALLRET RUNED ;And go start it
ENDIF.
MOVEI B,[ASCIZ/0FSExit/] ;Telling it to return right away,
CALL MOVST0
CALL RUNED ;Start up the editor
SKIPN FRKACS+3 ;Exitted other than with 0?
ANSKP.
TXO F,F%TECP ;Say have hairy editor interface
CALL RESTE0 ;And continue it
ENDIF.
LDB T,[POINT 9,FRKACS+2,35] ;Get position in page
IFXE. F,F%TECP ;Fancy interface, FS Superior will do it all
MOVE B,EDBPAG+5(T) ;Save addr of end of buffer
MOVSI A,EDBPAG+0(T) ;Start with beginning addr
HRRI A,EDBPAG+1(T) ;Into virtual beg
BLT A,EDBPAG+5(T) ;Up to end pointer
SUB B,EDBPAG+5(T) ;See how many chars we "deleted"
ADDM B,EDBPAG+6(T) ;Increase the gap that many
SETZM EDBPAG+11(T) ;Not modified yet
ENDIF.
MOVE B,EDTCNT ;Get char count
CALL EDINSC ;Request it to insert
MOVE A,EDBPAG+2(T) ;Address of current position
SUB A,EDTCNT ;Back over the chars to be inserted
CALL EDCHRP ;Get byte pointer
MOVE B,EDTBYT ;Get back byte pointer
MOVE C,EDTCNT ; and character count
DO.
ILDB D,B
IDPB D,A
SOJG C,TOP. ;For all requested
ENDDO.
RET
ENDSV.
;;; Generate a temp file unique to this job
GEDTMP: STKVAR <GTJARG,OPNARG,<TMPFIL,10>>
MOVEM B,OPNARG ;Save OPENF% args
MOVEM A,GTJARG ;Save GTJFN% args
HRROI A,TMPFIL ;Some string space
MOVE B,MYJOBN ;Job number
MOVX C,<NO%LFL!NO%ZRO+3B17+^D10>
NOUT%
MOVE A,[POINT 7,TMPFIL]
MOVEI B,[ASCIZ/MM.TMP.0;P770000/] ;Can't be ;T -- EDIT detests it!
CALL MOVST0
MOVE A,GTJARG
HRROI B,TMPFIL
GTJFN%
IFJER.
CALL KILED0
JERROR <Can't get TMP file>
ENDIF.
MOVE B,OPNARG
OPENF%
IFJER.
CALL KILED0
JERROR <Can't open TMP file>
ENDIF.
RET
;;;Here to make a new editor, returns with start of JCL in A and F%TECO
;;;setup correctly
GETED: SETZM CMDGTB ;Get space for GTJFN%
MOVE A,[CMDGTB,,CMDGTB+1] ;Allows:
BLT A,CMDGTB+.GJATR ; DEFINE EDITOR:SYS:EMACS
MOVX A,GJ%OLD ;to work instead of only:
MOVEM A,CMDGTB+.GJGEN ; DEFINE EDITOR:SYS:EMACS.EXE
MOVE A,[.NULIO,,.NULIO] ;--subtle, but consistent with
MOVEM A,CMDGTB+.GJSRC ; how EXEC handles same...
HRROI A,[ASCIZ/EXE/]
MOVEM A,CMDGTB+.GJEXT
MOVEI A,CMDGTB
HRROI B,[ASCIZ/EDITOR:/]
GTJFN%
JERROR <Can't get editor>
; JRST GETED0 ;Fall through
GETED0: PUSH P,A ;Save JFN around fork creation
MOVX A,CR%CAP!CR%ACS
MOVEI B,FRKACS ;Set these initial ac's
CFORK%
IFJER.
POP P,A ;Release editor JFN
RLJFN%
NOP
JERROR <Can't create editor fork>
ENDIF.
MOVEM A,EDFORK ;Save it
POP P,A ;Restore JFN
MOVE B,[1,,.FBUSW]
MOVEI C,C
GTFDB% ;Get user word
TXZ F,F%TECO!F%TECP ;Assume not TECO based
HLRZ C,C
CAIN C,(<SIXBIT /TEC/>) ;Check for TECO based
TXOA F,F%TECO ;It is, remember that
CIETYP <[%1J is not MIT-TECO based]>
HRL A,EDFORK
GET% ;Get in the editor
IFJER.
CALL KILED0
JERROR <Can't load editor>
ENDIF.
DMOVE A,[POINT 7,STRBUF+1 ;Load pointer to JCL string
ASCII/EDIT /] ;"EDIT" works better than pgm name
MOVEM B,STRBUF ; because some editors check job name
RET ; and others only know CREATE/EDIT
;;;Here to run the editor
RUNED: HRROI A,STRBUF ;Set that up for user
RSCAN%
NOP
MOVE A,EDFORK
SETZ B, ;Start at normal entry
MOVE C,[SFRKV%]
JRST WAITED
;;;Here to restart fork to edit something
RESTED: TXNN F,F%TECO ;Already all done if not TECO based
RET
TXNN F,F%TECP ;Hairy interface?
JRST RESTE0 ;Just resume editor
MOVE A,[POINT 7,STRBUF] ;Else setup to tell all that's going on
MOVEI B,[ASCIZ/FOO /]
CALL MOVSTR
MOVEI B,BUFNAM
CALL MOVSTR
MOVEI B,.CHESC
IDPB B,A
MOVEI B,EDINAM
CALL MOVSTR
MOVEI B,CRLF0
CALL MOVST0
CALLRET RUNED ;Start over so ..L run again
RESTE0: MOVE B,EFRKPC ;Forks old PC
MOVE C,[SFORK%]
; JRST WAITED
;;;Here to wait for the editor fork
WAITED: CALL WAITE1 ;Run editor, allow CTRL/Ns
DMOVE A,PRGNAM ;Restore our name
SETSN%
JFATAL
MOVE A,EDFORK
TXNE F,F%TECO ;TECO based?
JRST EDFTRM ;Yes, check on it's status
KFORK% ;No, can't reuse it
SETOM EDFORK ;Forget we had it at all
RET
WAITE1: SETABT ;Save previous abort state
CALL ABNDIS ;Don't abort out of editor
MOVE A,EDFORK
XCT C ;Do SFRKV% or SFORK%
RFORK% ;Thaw it
WFORK% ;And wait for it to terminate
SETZM ABORTF ;Clear abort flag
RET
;;;Here when fork terminates
EDFTRM: FFORK% ;Freeze it
RFSTS% ;Get its status
TXZ A,RF%FRZ ;We know it's frozen already
HLRZ A,A
CAIE A,.RFHLT ;Voluntary termination?
JRST KILLED ;No, kill it off, it's bombed
MOVEM B,EFRKPC ;Save the PC for restarting it
MOVE A,EDFORK ;Need fork again
RWM% ;See why it stopped
TXNE B,1B1 ;Level 1 in progress?
JRST CTLCED ;Yes, means the guy CTRL/C'd out
MOVE A,EDFORK
MOVEI B,FRKACS ;Get its AC's
RFACS%
MOVE A,FRKACS+2 ;Pointer to buffer block
IDIVI A,1000 ;Get page number of block
MOVEI T,(B) ;Save position in page
HRL A,EDFORK
MOVE B,[.FHSLF,,EDBPAG/1000] ;Into our area
MOVX C,PM%CNT!PM%RD!PM%WR!2 ;Read write
PMAP%
MOVE A,EDBPAG(T) ;Char address of beginning of buffer
IDIVI A,5000 ;Get page number
HRL A,EDFORK
MOVE B,[.FHSLF,,EDPAGE/1000]
MOVX C,PM%CNT!PM%RD!PM%WR!NEDPGS
PMAP% ;Map those pages too, read/write
LSH A,9 ;Get word address
HRREI A,-EDPAGE(A)
MOVEM A,EDPAG0 ;Save address of first page mapped
;;;
;;; The argument to FS Exit has not been well-defined in the past, so here
;;;is its definition today:
;;; LH RH Action
;;;---------------------------
;;; .GE. 0 No special action (1 at setup indicates MMAIL loaded)
;;; .LT. 0 .GE. 0 LH is command, RH is new current message
;;; -1 .LT. 0 Entire value is command
;;;.LT. -1 .LT. 0 LH is command, RH ignored
;;;
;;; The commands are:
;;; -1 Send the message off
;;; -2 Return without updating message
;;; -3 Return, updating the message
;;; -4 Reply to the current message
HLRE A,FRKACS+3 ;Negative argument to FS Exit?
JUMPGE A,R ;No, done
HRRE B,FRKACS+3 ;Select a different message?
IFL. B
CAMN A,[-1] ;No; was LH -1?
MOVE A,FRKACS+3 ;Yes, then RH may be significant
ELSE.
IMULI B,MSGLEN
CAMG B,LASTM ;And in range
MOVE M,B ;Select it
ENDIF.
AOJE A,FSEXT1
AOJE A,FSEXT2
AOJE A,FSEXT3
AOJE A,FSEXT4
RET
FSEXT1: TXO F,F%ESND ;-1FS Exit -- send the message off
RET
FSEXT2: CALL .EDFIN ;-2FS Exit -- don't update fields
ERROR <Edit aborted by editor>
FSEXT3: CALL SEDMSG ;-3FS Exit -- update current msg
CALLRET RESTE0
FSEXT4: CALL .REPL6 ;-4FS Exit -- reply to message
TXNE F,F%DIRE ;Dired mode?
TXO F,F%DIRR ;Yes, indicate want reentry
RET
;;;Editor terminated badly
KILLED: CALL KILED0 ;Kill editor
ERROR <Editor fork terminated involuntarily, edit lost>
KILED0: SKIPLE A,EDFORK
KFORK% ;Kill it off
SETOM EDFORK ;And forget about it
MOVEI D,SAVMOD ;Restore program's modes
CALLRET SETTYM
;;;CTRL/C typed from editor, make it percolate up
CTLCED: HALTF%
CALLRET RESTE0 ;And resume it afterwards
;;;Get the editted field
GEDBUF: TXNN F,F%TECO ;Was this TECO based editor
JRST GEDBF2 ;No, get updated version of file
MOVE B,EDBPAG+4(T)
MOVEM B,EDBPAG+2(T) ;ZJ
TXNN F,F%TECP ;Ordinary TECO,
TDZA B,B ;Insert 0 chars
SETO B, ;Else negative so don't kill
CALL EDINSC ;Move gap to end
MOVE C,EDBPAG+4(T)
SUB C,EDBPAG+1(T) ;Number of chars in it
MOVE A,EDBPAG+1(T) ;Start of virtual buffer
CAML A,EDBPAG+3(T)
ADD A,EDBPAG+6(T)
; CALLRET EDCHRP ;Get byte pointer and return
;;;Convert char address to byte pointer, taking gap into account
EDCHRP: STKVAR <EDTADR,<EDTACS,4>>
IDIVI A,5
SUB A,EDPAG0 ;Make absolute
MOVEM B,EDTADR ;Save address
MOVEI B,EDPAGE+<^D512*NEDPGS> ;Last possible address of edited text
SUBI B,(A) ;Free words
IMULI B,5 ;Number of characters free
SUB B,EDTADR ;...after offsetting for partial word
CAMG C,B ;Count from editor greater than buffer?
IFSKP.
DMOVEM A,EDTACS
DMOVEM C,2+EDTACS
MOVEI D,SAVMOD ;Restore program's modes
CALL SETTYM
DMOVE B,1+EDTACS ;Get buffer arguments
WARN <Edited text (%3D characters) too large, text truncated to %2D characters
>
PROMPT <Do you want to abort the edit and cancel all changes? >
CALL YESNO1
IFSKP.
CALL KILED0
ERROR <Edit aborted>
ENDIF.
MOVEI D,EDMOD ;Restore editor tty modes
CALL SETTYM
MOVE A,EDTACS ;Restore AC's
MOVE C,1+EDTACS ;Set message size to what we can get
MOVE D,3+EDTACS
ENDIF.
MOVE B,EDTADR ;Get editing address
HLL A,BPS(B) ;Make byte pointer
RET
ENDSV.
; Here for text retrieval from non-EMACS editor
GEDBF2: STKVAR <FILJFN,<FILINF,2>>
MOVX A,GJ%OLD!GJ%SHT
MOVX B,<<FLD 7,OF%BSZ>!OF%RD>
CALL GEDTMP ;Find the temp file again
MOVEM A,FILJFN ;Save JFN
HRROI B,EDPAGE ;Where to put it
MOVX C,-<NEDPGS*1000*5>
SIN%
ERJMP .+1
IFGE. C
MOVE B,[2,,.FBBYV] ;Get file I/O info and byte size
MOVEI C,FILINF ;Get file info into there
GTFDB%
MOVE C,1+FILINF ;Get byte count
LOAD B,FB%BSZ,FILINF ;Get byte size
CAIN B,7 ;If not 7-bit, must figure things out
ANSKP.
CAIN B,^D36 ;If not 36 bit, we have to do it the hard way
IFSKP.
MOVEI A,^D36
IDIVI A,(B) ;Get number of bytes/word
IDIVI C,(A) ;Now number of words
ENDIF.
IMULI C,5 ;Convert words into bytes
ENDIF.
MOVE A,FILJFN
SETZ B, ;Editor may have made new non-temp vers
DELNF%
NOP
CLOSF%
NOP
;;;At this point C either has a positive file byte count if the file was too
;;;large or a negative free space byte count.
IFL. C ;Free space exists?
ADDI C,NEDPGS*1000*5 ;Yes, compute byte count used by text
ELSE.
MOVE B,C ;Else get size of file in B
MOVX C,NEDPGS*1000*5 ;Get size of our buffer in C
CAMN B,C ;File exactly fits into buffer?
ANSKP.
WARN <Edited text (%2D characters) too large, text truncated to %3D characters
>
PROMPT <Do you want to abort the edit and cancel all changes? >
CALL YESNO1
ANSKP.
CALL KILED0
ERROR <Edit aborted>
ENDIF.
MOVE A,[POINT 7,EDPAGE]
RET
ENDSV.
;;;Request editor to insert (b) chars at PT
EDINSC: MOVEM B,EDBPAG+8(T) ;Set up as SUPARG
MOVE A,[POINT 7,STRBUF]
MOVEI B,[ASCIZ/FOO /] ;Be stupid or TECO will outsmart itself
CALL MOVSTR
MOVEI B,BUFNAM
CALL MOVSTR
MOVEI B,CRLF0
CALL MOVST0
HRROI A,STRBUF ;Tell it which buffer to use
RSCAN%
NOP
MOVE A,EDFORK
HRRZ B,EDBPAG+7(T) ;Where to start it
SFORK% ;Start it
RFORK% ;Thaw it
WFORK% ;Wait for it
MOVEI D,EDMOD ;Save editor modes
CALL GETTYM
DMOVE A,PRGNAM ;Restore our name
SETSN%
JFATAL
MOVE A,EDFORK
CALLRET EDFTRM ;Remap the right page, etc
;;;Message dired mode
DIRED: CALL DFSQAL ;Get sequence, default to all messages
TXO F,F%DIRE ;Entering dired mode
PUSH P,[POINT 7,WRTPGS] ;Get some string space
DO.
CALL NXTMSG
EXIT.
MOVE O,(P)
CALL TYPHD0 ;Insert the headers
MOVEM O,(P)
LOOP.
ENDDO.
DMOVE A,[ASCIZ/Dired/]
DMOVEM A,BUFNAM
DMOVEM A,EDINAM
MOVE A,[POINT 7,WRTPGS] ;Starting pointer
POP P,B ;Ending
CALL SEDBUF ;Stick it in the editor
IFXE. F,F%TECP
WARN <You do not have the EMACS MMail interface loaded
Type "HELP DIRED" at MM top-level for more information
>
MOVEI A,^D5000 ;Make sure message stays around a bit
DISMS%
ENDIF.
TXZ F,F%DIRR ;Don't need to loop yet
DO.
CALL RESTED ;Run the editor over it
TXZE F,F%DIRR ;Reenter?
LOOP. ;Yes, do so
ENDDO.
TXZ F,F%DIRE ;Done with dired mode
DMOVE A,[ASCIZ/Dired/]
DMOVEM A,BUFNAM
CALL GEDBUF ;Get what it gave back
JUMPLE C,R ;No text there
ADJBP C,A ;Get ending byte pointer
SETZ D,
IDPB D,C ;Put a null at the end
DIRED3: ILDB B,A ;Get start of line
JUMPE B,.EDFIN ;All done
SETZ E, ;Accumulate bits here
ILDB B,A ;Seen
CAIN B,.CHSPC
TRO E,M%SEEN
ILDB B,A ;Flagged
CAIE B,.CHSPC
TRO E,M%ATTN
ILDB B,A
CAIE B,.CHSPC
TRO E,M%RPLY
ILDB B,A
CAIE B,.CHSPC
TRO E,M%DELE
MOVEI C,^D10
NIN%
IFNJE.
IMULI B,MSGLEN
MOVEI M,-MSGLEN(B)
MOVEI B,M%SEEN!M%ATTN!M%DELE ;Change these bits
ANDCAM B,MSGBTS(M)
IORM E,MSGBTS(M)
PUSH P,A
CALL UPDBIT
POP P,A
ENDIF.
DO.
ILDB B,A ;Flush the rest of the line
JUMPE B,.EDFIN
CAIE B,.CHLFD
LOOP.
ENDDO.
JRST DIRED3
SUBTTL Init file handler
;;;For the time being the syntax is just
;;;<variable> <val><crlf>, where val is just an octal number or string
;;;Reset all init file variables
ININIT: SETZM VARBEG ;Most variables are zero
MOVE A,[VARBEG,,VARBEG+1]
BLT A,VAREND
SETOM RFMDEF ;Reply<cr> means just from, not all
SETOM BLSCST ;Blank screen on startup
SETOM CRSEND ;Just return sends message
SETOM LSTHDR ;Output a list of headers in listings
SETOM RCCOTH ;Reply CC's others (less confusion)
AOS SNDVBS ;Degree of sending verbosity
AOS EDTFLG ;Always edit on ^E
MOVEI A,^D1500 ;Default "short" msg length
MOVEM A,DFSHML
DMOVE A,[ASCII/MM>/ ;Top-level prompt
ASCII/M>/] ;Message-sequence prompt
MOVEM A,TOPRMT
MOVEM B,MSPRMT
DMOVE A,[ASCII/R>/ ;Read prompt
ASCII/S>/] ;Send prompt
MOVEM A,REPRMT
MOVEM B,SEPRMT
MOVE A,[POINT 7,LSTDEV] ;Set default listing device
HRROI B,[ASCIZ/LPT:MM.LST/]
CALL MOVST0
MOVE A,[POINT 7,MCPFIL] ;Set mail copy filename
HRROI B,[ASCIZ/MAIL.CPY/]
CALL MKPSTR ;Make file name string
MOVEI A,KEYPAG
MOVEM A,KEYPTR ;Initialize pointer free space
SETZM USRHDR ;Reset user headers
MOVE A,[POINT 7,DEFBBD] ;Setup a default for everybody
MOVEI B,MLBXDV ;Post office box name
CALL MOVSTR
MOVX B,":" ;Device delimiter
IDPB B,A
MOVX B,.CHLAB ;Directory delimiter
IDPB B,A
MOVEI B,BBDIR ;BBoard directory
CALL MOVSTR
MOVX B,.CHRAB ;Directory delimiter
IDPB B,A
MOVEI B,MLBXFN ;Filename
CALLRET MOVST0 ;Set it up and return to caller
;;;Here to process an init file with JFN in A
DOINIT: MOVX B,<<FLD 7,OF%BSZ>!OF%RD>
OPENF%
IFJER.
RLJFN% ;Discard JFN
NOP ;Don't care
MOVEI A,STRBUF
JWARN <Can't open init file "%1S">
RET
ENDIF.
MOVEM A,INIJFN ;Save this for later
INILUP: SKIPG A,INIJFN
RET ;Bug trap
HRROI B,STRBUF
MOVEI C,STRBSZ*5
MOVEI D,.CHLFD ;Read a line
SIN%
ERJMP CLSINI ;All done with it
MOVE T,[POINT 7,STRBUF] ;Handle this line
INILP1: ILDB C,T
CAIE C,.CHCRT ;Reached end of line
CAIN C,.CHLFD
JRST INILPX ;Can't understand it then
CAIE C,.CHTAB ;Tab or space ok
CAIN C,.CHSPC
JRST INILP2
JRST INILP1
INILP2: SETZ C,
DPB C,T ;Stick in a null
MOVEI A,INIVTB ;Init file variables
HRROI B,STRBUF
TBLUK%
TXNE B,TL%NOM!TL%AMB ;No good?
JRST INILPX ;Yes, complain
HRRZ A,(A)
HRRZ U,(A) ;Get address of corresponding variable
HLRZ E,(A) ;E points to [INIDTA,,HLPMSG]
HLRE E,(E) ;Get string length allowed
JUMPE E,INIOCT ;Zero means variable is fixnum
CAIN E,INIDEC ;Want decimal number?
JRST INIDEC
IFG. E
CALL (E) ;Call routine if there is one
JRST INILUP
ENDIF.
HRLI U,(<POINT 7,>) ;Make byte pointer to it
DO. ;Now process string
ILDB C,T
IFN. C
CAIE C,.CHCRT ;Exit if end of line
CAIN C,.CHLFD
EXIT.
AOJG E,INILPX ;Ran out of room in variable
IDPB C,U
LOOP.
ENDIF.
ENDDO.
MOVEI C,0
IDPB C,U
JRST INILUP
;; Get user name
INIUNM::CAIE U,MAUSRS ;Bug check
FATAL <INIUNM call error>
MOVE A,[POINT 7,MAUSRS] ;Set up pointer
MOVNI E,^D39 ;Maximum characters in user name
DO. ;Now process string
ILDB C,T
IFN. C
CAIE C,.CHCRT ;Exit if end of line
CAIN C,.CHLFD
EXIT.
IDPB C,A
AOJLE E,TOP.
SNARL <User name too long>
JRST INIUNX
ENDIF.
ENDDO.
MOVEI C,0
IDPB C,A
MOVX A,RC%EMO ;Require exact match
HRROI B,MAUSRS ;Get pointer
RCUSR% ;Get user number
IFNJE.
IFXE. A,RC%NOM!RC%AMB ;Valid user name?
CAMN C,MYAUSR ;Same as alias user?
RET ;Yes, return success
MOVE A,MYAUSR ;Get alias user number
SNARL <User "%7S" differs from alias "%1U">
ELSE.
SNARL <No such user as "%7S">
ENDIF.
ELSE.
SNARL <Invalid user name>
ENDIF.
INIUNX: HRROI A,MAUSRS ;Invalid user name, set name
MOVE B,MYAUSR ; to Alias user name
DIRST%
JFATAL
SKIPN INIJFN ;Init file in progress?
RET ;No, just return
ADJSP P,-1 ;Yes, flush caller
JRST INIERR ;Treat as init file error
;; Number conversion
INIDEC::SKIPA D,["9"] ;Decimal conversion
INIOCT: MOVEI D,"7" ;Octal conversion
SETZB A,B ;Here to input a fixnum variable
DO.
ILDB C,T ;Get next char
IFN. C
CAIE C,.CHTAB
CAIN C,.CHSPC
LOOP. ;Ignore blanks
CAIE C,.CHCRT
CAIN C,.CHLFD ;End of line?
EXIT.
CAIN C,"-"
AOJA A,TOP. ;Negativize
CAIL C,"0"
CAILE C,(D)
JRST INILPX ;Not a proper digit, barf
IMULI B,1-"0"(D) ;Scale what we have by one digit
ADDI B,-"0"(C)
LOOP.
ENDIF.
ENDDO.
TRNE A,1 ;Did it get negative?
MOVN B,B ;Yes
MOVEM B,(U) ;Save variable value
JRST INILUP
INILPX: CALL INIERR ;Log error
JRST INILUP
CLSINI: MOVE A,INIJFN
CLOSF%
JERROR
SETZM INIJFN
RET
;;; Initialize a table of keywords from a comma separated list
INIBB:: TXOA F,F%F4 ;Flag BB list
INIKEY:: TXZ F,F%F4 ;Flag as Key list
SETZM (U) ;Originally no keywords
INIKY0: ILDB C,T ;Get first character
CAIE C,.CHTAB
CAIN C,.CHSPC
JRST INIKY0
CAIE C,.CHCRT ;No entries
CAIN C,.CHLFD
RET
JUMPE C,R ;This will happen from SET command
TXNN F,F%F4 ;BBoard?
SKIPA A,[^D30] ;Initialize header of table
MOVEI A,MAXBBD ;Yes, use this value
MOVEM A,(U)
HRLZ B,KEYPTR ;Initial string pntr,,0 (for TBADD%)
MOVSI D,(<POINT 7,>)
HLR D,B ;Byte pointer to string
INIKY2: CAIN C,"," ;End of keyword?
JRST INIKY3
IDPB C,D ;Store as a keyword character
INIKY1: ILDB C,T ;Get next character
CAIE C,.CHTAB
CAIN C,.CHSPC
JRST INIKY1
CAIE C,.CHCRT
CAIN C,.CHLFD
JRST INIKY3
JUMPE C,INIKY3 ;This will happen from SET command
JRST INIKY2
INIKY3: HLRZ A,D ;Check pointer
CAIE A,(<POINT 7,>) ;Was the keyword null?
IFSKP.
SNARL <Null keyword invalid>
JRST INIERR
ENDIF.
SETZ A,
IDPB A,D
MOVEI A,(U) ;Table pointer
IFXN. F,F%F4 ;BBoard hacking?
HLRZ E,(A) ;Yes, simulate TBADD% stuff
HRRZ A,(A)
AOS E ;Point to next free entry
CAMG E,A ;Room left in table?
IFSKP.
JSNARL <BBoard table full>
JRST INIERR
ENDIF.
HRLM E,(U) ;Update table header with new count
ADD E,U ;Make pointer into table for new entry
MOVEM B,(E) ;Save string in table
ELSE.
TBADD%
IFJER.
JSNARL <Keyword setup error>
JRST INIERR
ENDIF.
ENDIF.
ADDI D,1 ;Update pointer
CAIN C,"," ;More to come?
IFSKP.
HRRZM D,KEYPTR ;No, update free string pointer
RET
ENDIF.
HRLI D,(<POINT 7,>) ;Yes, make byte pointer
HRLI B,(D) ;Update TBADD% copy as well
AOJA B,INIKY1
;;; Init a string that gets extended by lines
INILNS::ILDB C,T
CAIE C,.CHTAB
CAIN C,.CHSPC
JRST INILNS ;Flush whitespace
ADD T,[7B5] ;Back over first character
SKIPE D,(U) ;Is there something already?
IFSKP.
MOVNI E,776*5-1 ;No, init to start at after 4 words
MOVEI D,4(U)
HRLI D,(<POINT 7,>)
ELSE.
AOS E,1(U) ;Extend it with a crlf
AOJGE E,INIERR
MOVEI C,.CHCRT
IDPB C,D
MOVEI C,.CHLFD
IDPB C,D
ENDIF.
DO.
AOJGE E,INIERR ;Ran out of room in variable
ILDB C,T
JUMPE C,ENDLP.
CAIE C,.CHCRT
CAIN C,.CHLFD
EXIT.
JUMPE C,ENDLP. ;This will happen with SET command
IDPB C,D
LOOP.
ENDDO.
DMOVEM D,(U) ;Store ending pointer and count
MOVEI C,0 ;And end string with null
IDPB C,D
RET
INIERR: SKIPN INIJFN ;Init file in progress?
RET ;No, don't do this barfage
MOVEI A,STRBUF ;Tell user the losing line
SNARL <Error in MM.INIT: "%1S">
SETOM INITER ;Note an error happened
RET
;;; Create a new MM.INIT prompting in ENGLISH!
PROFI: CONFRM
SETABT CMDABO ;Allow aborts to top-level
;;;SEND-VERBOSE-FLAG
MOVEI A,1 ;Set up for super-verbose
MOVEM A,SNDVBS
CITYPE <Normally, when you send a message you are told the disposition of
each address; whether it was delivered or queued for later delivery.
>
PROMPT <Do you want to suppress this typeout? >
CALL YESNO1
CAIA ;No
SETOM SNDVBS ;Yes, super-terse
;;;REPLY-INCLUDE-ME
SETZM RINCME ;Set up for no replies to me
PROMPT <Do you want to receive copies of your replies to messages? >
CALL YESNO1
CAIA ;No
AOS RINCME ;Yes, include me in replies
;;;REPLY-SENDER-ONLY-DEFAULT
SETZM RFMDEF ;Set up for reply to everybody
CITYPE <Normally, when you REPLY to or ANSWER a message, the reply will
default to only sending to the person you got the message from.
You can have MM default instead to replying to everybody listed in
the message header.>
PROMPT <Do you want REPLY to default to everybody? >
CALL YESNO1
SETOM RFMDEF ;No, reply to sender only
;;;BLANK-SCREEN-STARTUP
SETOM BLSCST ;Set up for screen blanking
PROMPT <Do you want to erase the screen at startup and between messages? >
CALL YESNO1
SETZM BLSCST ;No, no screen blanking
;;;CONTROL-N-ABORT
SETZM ABOFLG ;Set up to ask before aborting
CITYPE <Normally the abort command control-N asks for confirmation before
aborting.>
PROMPT <Do you want control-N to abort without asking? >
CALL YESNO1
CAIA ;No
AOS ABOFLG ;Yes, abort without asking
CITYPE <Other profile options may be set by using the SET command to set the
option, and CREATE-INIT to update your MM.INIT profile file. You may
also edit MM.INIT with an editor. Use the "HELP SET variable-name"
command for a desriptions of individual MM.INIT options, and the SHOW
command to list the complete environment.
>
CALLRET CRINI0
;;;Show init file parameters
SHOW: NOISE (INIT FILE PARAMETERS)
CONFRM
MOVX A,.PRIOU
JRST SHOW1
;;;Create the guy an init file
CRINI: CONFRM
CRINI0: MOVE A,[POINT 7,STRBUF]
MOVEI B,[ASCIZ/MM.INIT/]
CALL MAKSTR
MOVX A,GJ%NEW!GJ%FOU!GJ%SHT
HRROI B,STRBUF
GTJFN%
JERROR <Can't get init file>
MOVX B,<<FLD 7,OF%BSZ>!OF%WR>
OPENF%
JWARN <Can't open init file>
SHOW1: MOVEM A,TMPJFN ;Save this for later
MOVE U,[-NINVRS,,INIVTB+1]
; CALLRET CRILUP
CRILUP: CALL CRISHW ;Call common entry with HELP SET code
AOBJN U,CRILUP
CLOSF%
JWARN <Couldn't close init file>
SETOM TMPJFN
RET
CRISHW: HRRZ T,(U) ;U points to INIVTB entry
HLRZ A,(T) ;A points to [INIDTA,,HLPMSG]
HRR T,(T) ;Variable
HLL T,(A) ;Initial data
MOVE A,TMPJFN
HLRO B,(U) ;Get name of variable
SETZ C,
TXNE T,.LHALF ;Check for routine type entry
JUMPG T,CRILP4
CRILP0: SOUT%
MOVEI B,.CHSPC
BOUT%
TXNE T,.LHALF ;A string
JRST CRILP3 ;Yes
MOVEI C,^D8
CRILP2: MOVE B,(T)
NOUT%
JWARN
CRILP1: HRROI B,CRLF0
SETZ C,
SOUT%
RET ;Return
; String-type entry
CRILP3: HRROI B,(T) ;Type out string
SOUT%
JRST CRILP1
; Routine-type entry. We must handle each of these as a special case
CRILP4: HLRZ D,T ;Get dispatch item
CAIE D,INIUNM ;User name?
IFSKP.
HRROS T ;Yes, set up as string
JRST CRILP0
ENDIF.
CAIE D,INIDEC ;Decimal number?
IFSKP.
SOUT% ;Yes, print string
MOVEI B,.CHSPC ;And space
BOUT%
MOVEI C,^D10 ;Set radix
JRST CRILP2
ENDIF.
CAIE D,INILNS ;HEADER-OPTIONS?
IFSKP.
SKIPN USRHDR ;Are there any user headers?
RET ;Return
SOUT% ;Yes, write out option name
MOVEI B,.CHSPC
BOUT%
MOVE T,[POINT 7,USRHDT] ;Get pointer to string
DO.
ILDB B,T ;Get byte from string
JUMPE B,CRILP1 ;Null means all done
BOUT% ;Write byte in file
CAIE B,.CHLFD ;Line feed?
IFSKP.
HRROI B,[ASCIZ/HEADER-OPTIONS /] ;Yes, write new header
SOUT%
ENDIF.
LOOP.
ENDDO.
ENDIF.
CAIE D,INIBB ;BB table?
IFSKP.
HLRZ D,(T) ;Is there anything in this table?
JUMPE D,R ;No, don't hack it -- go get next item
SOUT% ;Yes, write out option name
MOVEI B,.CHSPC
BOUT%
HLLO D,(T) ;Get size of table
EQVI D,(T) ;Form AOBJN pointer to table
ADJSP D,1 ;Skip past header word
DO.
HLRO B,(D) ;Get a keyword string entry
SOUT%
AOBJP D,CRILP1
MOVEI B,"," ;Insert comma delimiter
BOUT%
LOOP.
ENDDO.
ENDIF.
CAIE D,INIKEY ;Keyword table?
IFSKP.
HLRZ D,(T) ;Is there anything in this table?
JUMPE D,R ;No, don't hack it -- go get next item
SOUT% ;Yes, write out option name
MOVEI B,.CHSPC
BOUT%
HLLO D,(T) ;Get size of table
EQVI D,(T) ;Form AOBJN pointer to table
ADJSP D,1 ;Skip past header word
PUSH P,D ;Save the table pointer
HLLZ T,D ;Set up outside loop counter
DO.
HRRZ B,(D) ;Get the keyword index for this entry
CAIE B,(T) ;Is this the index we want?
AOBJN D,TOP. ;No, try again
JUMPGE D,[FATAL <Keyword table messed up>] ;Bug trap
HLRO B,(D) ;Found the index, now output its string
SOUT%
AOBJP T,ENDLP.
MOVEI B,"," ;Insert comma delimiter if more to come
BOUT%
MOVE D,(P) ;Restore search pointer
LOOP.
ENDDO.
ADJSP P,-1 ;Clean up stack
JRST CRILP1 ;Now try next index
ENDIF.
HLRZ B,(U) ;Something new; get the losing string
WARN <Unprocessable SET option "%2S"
>
RET
SUBTTL Keyword manipulating routines
; OVERVIEW
; There are two different kinds of keywords that MM understands.
; To distinguish them, they are called "keyflags" and "keywords". The
; keyflags are what MM used to call keywords -- they are bit flags set
; in the preamble to the message, and are only meaningful on a per-user
; basis. The number of these flags is limited to 30.
; By contrast, keywords are text strings appearing in the "Keywords"
; field of the message header. These are per-message and stay with it.
; There is no limit to how many keywords a message can have. MM knows
; how to add and delete keywords (in effect modifying the message header);
; in some cases MM can insert extra spaces so as to leave room for
; easily adding new keywords later without having to change the overall
; length of the message.
; When keywords are specified by the user, they are stored in a keyword
; list of cells; each keyword cell has the format
; cell: <# chars>,,<addr of next cell>
; <byte ptr to string>
; Keyword strings are not necessarily terminated with a null, since
; sometimes the string may reside in a read-only page of the message file.
; The "find" list is used when putting together a message sequence; the
; "modify" list is used when adding or deleting keywords. Both may
; be active simultaneously.
; KWADD - Add keywords
; A/ keyword list ptr
; M/ message to add keywords to
KWADD: JUMPE A,R ;Ensure list exists
TXNE F,F%RONL ;Don't try to hack read-only files
RET
SETO B,
CAMN B,MSGDAT(M) ;If message looks like a baddie
RET ; then don't even try.
PUSH P,A
MOVEI T,[ASCIZ/
Keywords:/]
CALL FNDFLD
IFSKP.
MOVE D,A ;Found one, skip cons-up code.
MOVE C,W ;Set up char cnt & BP in C & D.
JRST KWADD2
ENDIF.
; Set up keyword buffer with field name, and adjust vars
; so that "field loc" is at end of msg header, with zero length.
HRRZ V,MSGHLN(M) ;Get offset to start of msg text
HRRZ A,MSGBOD(M) ;For compare get start of body offset
CAIG A,-4(V) ;Make sure at least 4 chars in header!
IFSKP.
WARN <Message %M has bad format, keyword not added>
JRST KWADD9 ;Ugh, we're probably losing
ENDIF.
SUBI V,4 ;Get offset to point before CRLFCRLF
PUSH P,V
CALL MCH2BP ;Convert to BP in A
POP P,V
MOVE D,A ;Store as BP to old field string.
SETO C, ;Say count-1 to invoke fieldname insert
; Copy field into keyword buffer, adding any words which don't
; already exist. If none were added, can just return.
KWADD2: MOVE A,(P) ;Furnish keyword list
SETZ B, ;Say to add them
CALL KYCPY ;Copy field, with keyword fixes.
JRST KWADD9 ;No changes? Win...
; At this point we must have
; A/ # chars in new field string, B/ BP to same
; C/ # chars in old field string, D/ BP to same (in file pages)
; V/ offset from start of msg to place D points to.
; Check - new field size less or eq to current?
KWADD3: CAMG A,C ;Compare char counts
JRST KWDEL3 ;Less, super win! Hand off to KWDEL.
; Must insert cruft. Pad out the rest of the last line with blanks,
; so as to leave some scratch space for future edits.
KWADD4: CAIL W,^D70 ;Has some room?
JRST KWADD5 ;Naw, don't bother.
SUBI W,^D70 ;Has some, get neg # of blanks to add.
PUSH P,A
ADJBP A,B ;Get BP in A pointing to end of string
MOVEI E,.CHSPC
IDPB E,A ;Append blanks
AOJL W,.-1
POP P,A
; Copy header into buffer, inserting new field. Append body.
KWADD5: MOVE E,A ;Save # chars in new field string
MOVE T,B ;Save BP to new field string.
MOVE D,C ;Save # chars in old field string
MOVE C,V ;Count is # chars to start of field
HRRZ V,MSGBOD(M) ;Find offset to actual msg body
SUBI C,(V) ;Get proper count
MOVE W,C ;Copy into overall length count.
CALL MCH2BP ;Convert V into BP in A, pt to msg body
MOVE V,C ;Get # bytes of pre-field body, plus
ADD V,D ;# bytes of old-fld, let sit in V
MOVE B,[POINT 7,TXTPAG] ;Destination is text-input area
CALL MOVASC ;Copy the stuff
ADJBP D,A ;Skip over old fld, put skipped BP in D
MOVE A,T ;Restore BP to new fld
MOVE C,E ; and count
ADD W,C ;Update overall length
CALL MOVASC ;Copy new field into header
MOVE A,D ;Now point to rest of message
HLRZ C,MSGBOD(M) ;Find # chars left - get msg size
SUB C,V ;And subtract stuff to end of old fld.
ADD W,C ;Update overall length
CALL MOVASC ;Now move all of rest of msg!
MOVE A,[POINT 7,TXTPAG] ;BP to message
MOVE C,W ;# chars
CALL RPLMSG
SNARL <Unable to update keywords>
KWADD9: POP P,A
RET
; KWDEL - Delete keywords
; A/ keyword list ptr
; M/ message to delete keywords from
KWDEL: JUMPE A,R ;Ensure list exists
TXNE F,F%RONL ;Don't try to hack read-only files
RET
PUSH P,A
CALL KWFNDX ;Find keywords field, see if any match.
JRST KWDEL9
; Match exists. Copy field into keyword buffer,
; ignoring words given in keyword list.
MOVE A,(P) ;Furnish keyword list
SETO B, ;Say to flush matches
CALL KYCPY ;Copy field, modulo keyword fixes.
JRST KWDEL9 ;No changes? Win...
; Check - new field should have size less or eq to current.
; If NOT, then should insert. For now, error.
CAMLE A,C ;Compare char counts
JRST KWADD4 ;Must insert, fooey.
IFE. A ;Make old-field string include fld name
ADDI C,^D11 ;Add to total length
SUBI V,^D11 ;Move start offset back
MOVNI E,^D11 ;and adjust start BP back
ADJBP E,D ;also.
MOVE D,E
JRST KWADD5
ENDIF.
KWDEL3: MOVE E,C
SUB E,A ;Find # of blanks to pad with
JUMPLE E,KWDEL4 ;Might be equal, esp. if no change.
ADJBP A,B ;Get BP to end of new string
MOVEI T,.CHSPC
IDPB T,A
SOJG E,.-1
MOVE A,C ;Count becomes same as original.
; Open write JFN, point to right place, and stick new stuff
; in, overwriting old field.
KWDEL4: PUSHAE P,<B,C,D> ;Save count, BP, and BP into file
NOINT ;No outside diddling
CALL GETJF2 ;Get write JFN
IFNSK.
POPAE P,<D,C,B> ;Failed, just return.
OKINT
JRST KWDEL9
ENDIF.
POP P,A ;Note file BP restored to A
MULI A,5 ;Do magic to get
ADD B,UADBP7(A) ; canonical # bytes from loc 0 into B
SUB B,[5*MTXPAG] ;Get absolute # bytes from beg of file
MOVE A,MSGJF2
SFPTR% ;Set output ptr to this loc
IFJER.
CALL CLSJF2
OKINT
JERROR <Can't point to message keyword field>
ENDIF.
POP P,C ;Restore # chars
MOVNS C ;Neg for SOUT%
POP P,B ;Restore BP to new field string
SOUT% ;Smash old string!
CALL CLSJF2 ;Done, close up shop.
OKINT
KWDEL9: POP P,A
RET
; KWFND - Find keywords in message
; A/ keyword list ptr
; M/ message to look in
; Returns A/ ptr to winning keyword cell
; or 0 if found none.
KWFND: JUMPE A,R ;Avoid this fuss if possible.
SAVEAC <B,C,D,T,V,W>
CALL KWFNDX
SETZ A, ;Loss return.
RET
; KWFNDX - Auxiliary for KWFND and KWDEL. Hunts up keyword field
; and sees if any of the specified keywords are present.
; A/ keyword list ptr
; Returns .+1 if failed, .+2 if success
; A/ ptr to winning keyword cell
; C/ # chars in keyword field string
; D/ BP to keyword field string
; Clobbers B,T,W, etc.
KWFNDX: STKVAR <KWFPTR>
MOVEM A,KWFPTR
MOVEI T,[ASCIZ/
Keywords:/]
CALL FNDFLD
IFSKP.
MOVE D,A ;Set up BP to field string
MOVE C,W ; and # chars in string
MOVE T,KWFPTR ;Set initial ptr to keyword cell
DO.
HLRZ A,(T) ;Get # chars in keyword
MOVE B,1(T) ; and BP to keyword string.
CALL LKFNDW ;See if keyword exists in field string.
IFSKP.
MOVEI A,(T)
RETSKP ;Found one!
ENDIF.
HRRZ T,(T) ;Loop: get next ptr
JUMPN T,TOP. ;If run out, nothing to delete!
ENDDO.
ENDIF.
MOVE A,KWFPTR ;Nothing found, restore pointer and return
RET
ENDSV.
; FNDFLD - Finds field in message header.
; T/ addr of ASCIZ name of field
; M/ message to look in
; Returns .+1 if failed, .+2 if won.
; A/ BP to start of field
; W/ # chars in field (includes continuation lines)
; V/ offset from start of msg.
FNDFLD: CALL FNDHDR
RET
AOS (P) ;We won, so ensure skip return.
PUSH P,A
TDZA W,W ;Start counting # chars in field
FNDFD2: ADDI W,2 ;Here for continuation line, count CRLF
CALL CNTHDL ;Count up to but not including CR
IBP A ;Skip LF too
ILDB T,A ;See if continuation line
CAIE T,.CHTAB
CAIN T,.CHSPC
AOJA W,FNDFD2 ;Yes, count whitespace and loop.
POP P,A
RET
; KYCPY - Copy keyword field string, modulo specified keyword edits.
; A/ keyword list ptr
; B/ 0 to add, -1 to delete keywords
; C/ # chars in field string (if -1, furnishes fieldname)
; D/ BP to field string
; Returns .+1 if no changes, .+2 if string hacked.
; A/ # chars in new string
; B/ BP to new string
KYCPY: SKIPN U,A ;Move keyword list ptr to U
RET ;No list, no skip.
MOVEM B,KYCPYF ;Save flag
SKIPN B,KEYFRE ;Set up BP to 1st free
MOVEI B,KEYPGS
HRLI B,(<POINT 7,>) ;loc in keyword pages.
MOVEI A,(B)
SUBI A,KEYPGS ;Find # words used
IMUL A,[-5] ; then - # chars used
ADD A,[NKYPGS*1000*5] ; and finally get # chars available.
SETZ W, ;Cheat - smash current column.
PUSHAE P,<B,C,D,E,T,V,A>
SETZM KYCPYC ;Clear local count of edits
MOVE E,A
JUMPGE C,KYCPY1 ;If field string count is -1,
; means we want fieldname inserted...
MOVE A,[POINT 7,[ASCIZ/
Keywords:/]]
MOVEI C,^D11
CALL MOVASC ;Move string in as prefix.
SUBI E,(C) ;Update # chars left
MOVEI W,-2(C) ; and column count (note CRLF clears)
SETZ C,
KYCPY1: MOVE T,B
MOVE V,B ;Save orig BP to dest in V
HRLZS U ;Keep orig keyword list ptr in LH
KYCPY2: CALL LKGETW ;Get word (A,B) from string (C,D)
JRST KYCPY6 ;EOF, all copied.
PUSHAE P,<C,D>
HLR U,U ;Init ptr to keyword cells
CAIA
KYCPY3: HRR U,(U) ;Get next
TXNN U,.RHALF ;Any more?
JRST KYCPY4 ;No, stop comparing.
HLRZ C,(U) ;Get char cnt
TXZ C,1B18 ;(flush sign bit which says if already saw)
MOVE D,1(U) ; and BP
CALL LKWCMP ;Compare words...
JRST KYCPY3 ;No match, try another keyword
SKIPN KYCPYF ;Found a keyword! Deleting or adding?
SKIPGE (U) ;Adding if already seen, pretend Delete
JRST KYCPY5 ;Deleting, just skip the copy.
MOVSI D,(1B0) ;Adding but word already there, so
IORM D,(U) ; mark it seen, then drop thru to copy
KYCPY4: CALL KYCPYS ;Invoke little subroutine to do it.
CAIA
KYCPY5: AOS KYCPYC ;Skipped copy, bump count of edits.
POPAE P,<D,C>
JRST KYCPY2 ;Now go get another word.
KYCPYS: CAIG E,3(A) ;Ensure enough room for word&separators
ERROR <Keyword field too big>
SUBI E,(A) ;We'll use this much for sure
ADDI W,(A) ;Update line length, ditto.
CAME T,V ;First word copied? (Comp BP with orig)
IFSKP.
MOVEI C,.CHSPC ;Yes, just space out
IDPB C,T
SUBI E,1
AOJA W,KYCPS3
ENDIF.
MOVEI C,","
IDPB C,T
SUBI E,2
ADDI W,2 ;Update line length (anticipate space)
CAIL W,^D71 ;See if it would be too big
IFSKP.
MOVEI C,.CHSPC ;Nope, is OK. Just tack on space
IDPB C,T
ELSE.
MOVEI C,.CHCRT ;Sigh, must create continuation line.
IDPB C,T
MOVEI C,.CHLFD
IDPB C,T
MOVEI C,.CHTAB
IDPB C,T
SUBI E,2 ;Update # chars left (extra LF, TAB)
MOVEI W,^D8 ;Reset line length (tabbed out)
ENDIF.
KYCPS3: MOVE C,A
MOVE A,B
MOVE B,T
CALL MOVASC ;Copy word
MOVE T,B ;Get back updated BP
RET
; EOF hit on field string.
KYCPY6: SKIPE KYCPYF ;Were we adding?
JRST KYCPY9 ;Nope, all's done.
HLR U,U
CAIA
KYCPY7: HRR U,(U)
JXE U,.RHALF,KYCPY9 ;Really all done now
SKIPL A,(U) ;See if sign bit set for this keyword
IFSKP.
TXZ A,1B0 ;Yes, already in. Clear it
MOVEM A,(U) ; so as to leave list in original state
JRST KYCPY7
ENDIF.
HLRZS A ;Must add word. Get char cnt
MOVE B,1(U) ; and BP
CALL KYCPYS ;Invoke subroutine to do copy
AOS KYCPYC ;Bump count of edits
JRST KYCPY7 ;And get another keyword.
KYCPY9: HLRZS U ;Return orig keyword list ptr to RH.
POP P,A ;Get back original cnt of # chars left
SUB A,E ;Find # chars written to string
POPAE P,<V,T,E,D,C,B>
CAIGE C,0 ;Make sure a -1 value
SETZ C, ; is fixed to 0 on exit.
SKIPE KYCPYC ;Were any edits done?
AOS (P) ;Yes, take skip return.
RET
; LKFNDW - skips if finds word in string.
; A/ # chars in word
; B/ BP to word
; C/ # chars in string to search
; D/ BP to string
; Mustn't clobber C,D
LKFNDW: JUMPLE A,R
PUSHAE P,<E,C,D,A,B>
LKFDW2: CALL LKGETW ;Get word from string.
JRST LKFDW9
CAME A,-1(P) ;Strings same length?
JRST LKFDW2
PUSH P,C
PUSH P,D
MOVE E,-2(P) ;Retrieve BP to search word
LKFDW4: ILDB C,B ; get char from string
ILDB D,E ;And from search word
CAIL C,"a"
CAILE C,"z"
CAIA
SUBI C,"a"-"A"
CAIL D,"a"
CAILE D,"z"
CAIA
SUBI D,"a"-"A"
CAIN C,(D)
IFSKP.
POP P,D
POP P,C
JRST LKFDW2
ENDIF.
SOJG A,LKFDW4
POP P,D
POP P,C
AOS -5(P)
LKFDW9: POPAE P,<B,A,D,C,E>
RET
; LKWCMP - Word compare.
; A/ <#> for A
; B/ BP for A
; C/ <#> for B
; D/ BP for B
; Skips on success.
LKWCMP: CAIE A,(C) ;Counts must be equal.
RET ;Quickie...
JUMPE A,RSKP
PUSHAE P,<A,B,C,D,E>
LKWCM2: ILDB E,B
ILDB A,D
CAIN A,(E)
JRST LKWCM7
XORI A,(E) ;Fold into each other
CAIE A,40 ;If result is 40, possibly match.
JRST LKWCM9 ;Else definitely don't.
CAIL E,"A" ;If one original not between 140
CAILE E,"z" ; and 172 inclusive,
JRST LKWCM9 ;Can fail immediately.
CAILE E,"Z"
CAIL E,"a"
CAIA
JRST LKWCM9
LKWCM7: SOJG C,LKWCM2
AOS -5(P)
LKWCM9: POPAE P,<E,D,C,B,A>
RET
; LKGETW - Get word from string of format "FOO, BAR ZAP, ETC"
; Words are ended by anything that SCNTRM skips on.
; C/ # chars
; D/ BP to string
; Fails if EOF
; Return .+2
; A/ # chars
; B/ BP to word
; C/ updated # chars left
; D/ updated BP to rest of string
LKGETW: JUMPLE C,R
PUSH P,C
PUSH P,D
LKGTW2: MOVEM D,(P) ;Store BP at beg of word
CALL SCNTRM ;Scan for terminators
CAIA
JRST LKGTW2 ;Loop till hit first real char.
IFL. A
ADJSP P,-2 ;Jump if EOF, nothing to return.
RET
ENDIF.
MOVEM C,-1(P) ;Store char cnt at start of word
CALL SCNTRM ;Scan again for terminators
JUMPGE A,.-1 ;Scan over text.
POP P,B
POP P,A
SUB A,C ;Find # chars in word.
RETSKP
SCNTRM: SOJL C,[SETO A,
RET]
ILDB A,D
CAIE A,.CHCRT
CAIN A,.CHLFD
JRST SCNTR8
CAIN A,.CHTAB
JRST SCNTR8
CAIE A,.CHSPC
CAIN A,","
SCNTR8: AOS (P)
RET
; Source BP in A, Dest BP in B, count in C
; Updates A,B but not C.
MOVASC: JUMPLE C,R
PUSH P,C
PUSH P,D
ILDB D,A
IDPB D,B
SOJG C,.-2
POP P,D
POP P,C
RET
SUBTTL Command parsing routines
COMNDX: TXNN F,F%TAK ;TAKE file in progress?
JFATAL ;No, we have lost badly
MOVX A,.FHSLF ;Yes, check last error
GETER%
HRRZS B ;Only want error code
CAIE B,IOX4 ;End of TAKE file?
JFATAL
CALL UNTAKE ;Yes, leave TAKE file
IFXN. F,F%RSCN ;Calling from command line?
SETZ A, ;Yes, pretend we did a COMND, here is A
MOVEI B,[QUIT0] ;Here is B, pretend QUIT command
RET ;Return
ENDIF.
MOVE A,CMDBLK+.CMRTY ;Retype prompt
PSOUT%
MOVE A,CMDBLK+.CMBFP ;And any input
PSOUT% ; (A bit kludgy, but oh well...)
SKIPA B,COMNDB ;Reload function and retry
$COMND: MOVEM B,COMNDB ;Save first function block addr
MOVEI A,CMDBLK
COMND% ;Only one in MM
ERJMP COMNDX ;Handle unusual conditions
RET ;Let caller decide what is good
;;;TAKE commands from file
TAKE: TXZN F,F%TAK ;TAKE in progress?
IFSKP.
CONFRM ;Yes, confirm here
HLRZ A,CMDBLK+.CMIOJ ;Get TAKE file JFN back
JRST UNTAK0 ;Untake with no message and return
ENDIF.
NOISE (COMMANDS FROM FILE)
SETZM CMDGTB ;Clear GTJFN% block
MOVE A,[CMDGTB,,CMDGTB+1]
BLT A,CMDGTB+.GJATR
MOVX A,GJ%OLD ;Require old file
MOVEM A,CMDGTB+.GJGEN
HRROI A,[ASCIZ/CMD/] ;Default extension is .CMD
MOVEM A,CMDGTB+.GJEXT
MOVEI B,[FLDDB. .CMFIL] ;File name with defaults
CALL CMDFLD ;Parse it
PUSH P,B ;Save JFN over confirm
CONFRM
POP P,A
TAKE1: MOVX B,<<FLD 7,OF%BSZ>!OF%RD> ;Need read access only
OPENF%
JERROR <Can't open TAKE file>
HRLS A ;Input JFN in left half
HRRI A,.NULIO ;No output
MOVEM A,CMDBLK+.CMIOJ ;Set as new I/O JFNs
TXO F,F%TAK ;Flag TAKE in progress
RET
;;;Restore terminal as command input source
UNTAKE: TXZN F,F%TAK ;Flag no more TAKE file
RET ;No TAKE in progress, ignore
HLRZ A,CMDBLK+.CMIOJ ;Get TAKE file JFN back
CIETYP <[End of %1J]
> ;Indicate end of TAKE file
UNTAK0::CLOSF% ;Close it
NOP ;In case called from UUO handler
MOVE A,[.PRIIN,,.PRIOU] ;Restore command input from primaries
MOVEM A,CMDBLK+.CMIOJ
RET
;;;Initialize command line
CMDINI::SKIPA B,[REPARS] ;Entry for normal reparsing
CMDIN1: MOVEI B,REPAR1 ;Entry for no-JFN clobber reparsing
TXZ F,F%HOER ;No more exiting on errors if command
; level (user typed ESC or something)
HLROM A,CMDBLK+.CMRTY ;Set up prompt string
MOVEM A,TPADD1 ;Save command pointers
MOVEM B,CMDBLK+.CMFLG ;Store reparse address
SKIPN A,TPADDR ;Set some kind of reparse handler
MOVEI A,CMDIN2 ;Use after .CMINI (this prevents too
MOVEM A,TPADDR ; much embarassment if a confirm bug)
MOVEI B,[FLDDB. .CMINI] ;Init command block
CALL $COMND
CMDIN2: POP P,TPADDR ;Save address of caller
MOVEM P,REPARP ;Save reparse P
HRRZ A,CMDBLK+.CMFLG ;Get reparse address
JRST (A) ;Dispatch to it
;;;Normally the JRST (A) above will merely drop into the normal reparse
;;;routine here. But in some cases (e.g. multiple-line sequence) you do
;;;not want reparsing to clear OUTJFN or temporaries.
REPARS: CALL CLSTMP ;Get rid of stray JFNs
SKIPLE A,OUTJFN
CLOSF%
NOP
SETZM OUTJFN
REPAR1: SETZM CMDFLB ;Init command field block
MOVE A,[CMDFLB,,CMDFLB+1]
BLT A,CMDFLB+3
MOVE P,REPARP ;Get back reparse P
MOVE A,TPADD1 ;Get back command pointers
JRST @TPADDR ;And return
CONF: MOVEI B,CNFCMD ;Get confirmation
CALLRET CMDFLD
CNFCMD: FLDDB. .CMCFM
;;;Normal command levels
SUBCMD: AOSA CLEVEL ;One level deeper
GETCMD: SETZM CLEVEL ;At the top
HRRZM A,CMDFLB+.CMDAT ;Address of keyword table
SETZM CMDFLB+.CMFNP ;.CMKEY = 0
CALL CMDNO2 ;Parse the field
SETZM CMDFLB+.CMHLP ;Reset default and help messages
SETZM CMDFLB+.CMDEF
HRRZ A,(B) ;Get address of routine
SETZM OKTINT ;No more timer ints now
AOS CLEVEL ;Know that we aren't top-level
RET
CMDNO1::MOVEM A,CMDFLB+.CMDAT
CMDNO2: MOVX A,CM%DPP
SKIPE CMDFLB+.CMDEF ;Default provided?
IORM A,CMDFLB+.CMFNP ;Yes, say there is one
MOVX A,CM%HPP
SKIPE CMDFLB+.CMHLP ;Help provided?
IORM A,CMDFLB+.CMFNP ;Yes, say there is help
MOVEI B,CMDFLB
; CALLRET CMDFLD
;;;Parse an arbitrary field
CMDFLD: CALL $COMND
TXNE A,CM%NOP
JERROR ;Give JSYS error message and return
RET ;Did ok
;;;Read in a text line
GETLIN: MOVEI B,[FLDDB. .CMTXT] ;Get a text line
CALLRET CMDFLD
GETLNC: MOVEI A,GETLN0 ;Get a text line, with confirm
HRRM A,CMDBLK+.CMFLG ;Reparse address is just us if at top
MOVEM P,REPARP
GETLN0: MOVE P,REPARP
MOVEI B,[FLDDB. .CMCFM,CM%SDH,,,,[FLDDB. .CMTXT]]
SETZM STRBUF ;Else make sure atom buffer clear
CALL CMDFLD ;Go read a line
LOAD A,CM%FNC,(C)
CAIE A,.CMCFM ;Confirm?
CONFRM ;No, do it now then
RET
;;;Parse a date
GETDAT: MOVEI B,DATFLB
CALL CMDFLD
LOAD T,CM%FNC,(C) ;Get field type parsed
CAIN T,.CMTAD ;Date and time?
RET ;Yes, just return that time
CAIN T,.CMTOK ;Token? (must be "-, #, %, *")
JRST DOTOK
HRRZ T,(B) ;Else get data for it
MOVE T,(T)
CALLRET (T) ;And call the right routine
DATFLB: FLDDB. .CMTAD,,CM%IDA!CM%ITM,,,DATFL1
DATFL1: FLDDB. .CMTAD,,CM%IDA,,,DATFL2
DATFL2: FLDDB. .CMTAD,,CM%ITM,,,DATFL3
DATFL3: FLDDB. .CMKEY,,DATTAB,,,DATFL4
DATFL4: FLDDB. .CMKEY,,FLTAB,,,DATFL5
DATFL5: FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ/-/]>,<"-" followed by the number of days in the past>,,DATFL6
DATFL6: FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ/*/]>,<"*" to use the receive date of the last message>,,DATFL7
DATFL7: FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ/%/]>,<"%" to use the receive date of the last message>,,DATFL8
DATFL8: FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ/#/]>,<"#" followed by a message number to use the receive date for that message>,,DATFL9
DATFL9: FLDDB. .CMKEY,,HOLDAY,<holiday,>
DOTOK: MOVE B,.CMDAT(C) ;Get pointer
HRLI B,(<POINT 7,>)
ILDB T,B ;And load first byte of token
CAIN T,"-" ;Minus?
JRST OFFDAT ;Yes, it's a date offset
CAIN T,"#" ;Message number?
JRST MSGNUM ;Else, "#" means message number
JRST DATLST ;*, % mean date of last message
MSGNUM: NOISE (MESSAGE NUMBER)
MOVEI B,[FLDDB. .CMNUM,,^D10] ;Read a number
CALL CMDFLD
SOS B ;Convert to normal form
IMULI B,MSGLEN ;Convert
SKIPL B ;Can't be lt zero,
CAMLE B,LASTM ;Or greater than last one
ERROR <Message number out of range>
MOVE B,MSGDAT(B) ;Use receive date for this message
RET
DATFST: MOVE B,MSGDAT ;Get date of first message
RET
DATLST: MOVEI B,MSGDAT
ADD B,LASTM
MOVE B,(B) ;Get date of last message
RET
LOGLST: SETO A, ;Date/time of last login
MOVE B,[-1,,D]
MOVEI C,.JISTM
GETJI%
TDZA B,B ;If failed, use tad 0
MOVE B,D
RET
OFFDAT: NOISE (NUMBER OF DAYS)
MOVEI B,[FLDDB. .CMNUM,,^D10] ;Read a number
CALL CMDFLD
SKIPG B
ERROR <Number of days in past must be positive>
HRLZ B,B ;Get number of days to left half
JRST DAT.1 ;And join day-of-week code
DATDOW: SETO B,
SETZ D,
ODCNV%
MOVSI C,8(C) ;Get day of week into lh
SUBM C,T ;Get difference from desired
DATDAY: HLLZ B,T ;Get number of days to offset
CAMLE B,[7,,0] ;If week wrapped around,
SUB B,[7,,0] ;Take next one
DAT.1: GTAD%
SUBM A,B
SETZ D,
ODCNV%
SETZ D, ;Midnight of that day
IDCNV%
SETO B,
RET
DATHDY: GTAD% ;Get now for later
SETO B,
SETZ D,
ODCNV%
HLRZ E,B ;Save year
DATHD1: LDB B,[POINT 9,T,8] ;Get month
HRLI B,(E) ;Get year
HLLZ C,T
TLZ C,777000 ;Get day of month
SETZ D,
IDCNV%
SETO B,
CAML B,A ;Must be before today
SOJA E,DATHD1 ;Else try last year
RET
;;;Get User@site string, W/ addr where to stick block, return in U
USRLST: FLDDB. .CMCFM,,,,,USRLS1
USRLS1: FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ/*/]>,<"*" for sending to a file
or "@" to send indirect from a file>,,USRLS2
USRLS2: FLDDB. .CMUSR,,,,,USRLS3
USRLS3: FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ/./]>,<"." for yourself>,,USRLS4
USRLS4: FLDDB. .CMKEY,,<[1,,1
[ASCIZ/SYSTEM/],,SYSCOD]>,<special mailbox,>,,USRLS5
USRLS5: FLDDB. .CMQST,,,,,USRLS6
USRLS6: FLDBK. .CMFLD,,,<network address>,,UNMMSK
ADRLST: FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ/@/]>,<confirm with carriage return
or "," for another address
or "@" for a network host name
or ":" to make this a group name>,,ADRLS1
ADRLS1: FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ/:/]>
;;;Here when an error occurs in a user parse, to get it again
CMDUSE: MOVE P,REPARP ;Restore saved P
TXZE F,F%RSCC ;Error from RSCAN% call?
RET ;Yes, just return
MOVEI B,[FLDDB. .CMINI] ;Re-init comnd state block
CALL $COMND
CMDUS0: MOVX A,CM%XIF ;Here for reparse
ANDCAM A,CMDBLK+.CMFLG
MOVE P,REPARP ;Restore saved P
MOVE W,TPADD1 ;Reset list as of start
TXZ F,F%COMA!F%F4
; JRST GETUSR
;;;Here's where we actually go and parse addresses
GETUSR: MOVEI B,USRLST ;Set up user command list
TXZE F,F%COMA ;Is this the first one?
SKIPA B,[USRLS1] ;Yes, don't allow CRLF
SKIPE CLEVEL ;At top level?
IFSKP.
MOVEI A,CMDUS0 ;Setup local reparse address
HRRM A,CMDBLK+.CMFLG
MOVEI A,CMDUSE ;Setup error dispatch
HRRM A,CMDRET
MOVEM P,REPARP
MOVEM W,TPADD1 ;Save list so far
ENDIF.
CALL CMDFLD ;Parse a field
LOAD E,CM%FNC,(C)
CAIN E,.CMCFM
RET ;Null field, return
MOVEI U,(W)
SETZM ADRFLG(U)
SETZM ADRLNK(U)
IFXN. F,F%F4
SETONE ADINV,(U)
ENDIF.
CAIE E,.CMKEY ;Keyword?
CAIN E,.CMUSR ;Username?
MOVEM B,ADRUSR(U) ;Save keyword pointer or user number
CAIE E,.CMTOK ;Token?
IFSKP.
MOVE A,.CMDAT(C) ;Yes
HRLI A,(<POINT 7,>)
ILDB A,A ;Get first char of token
CAIE A,"*" ;File type?
IFSKP.
SETZM CMDGTB ;Get space for GTJFN%
MOVE A,[CMDGTB,,CMDGTB+1] ;Note that .CMOFI is NOT used since
BLT A,CMDGTB+.GJATR ; it uses existing gen# + 1
MOVEI B,[FLDDB. .CMFIL,CM%SDH,,<file name to output message to>]
CALL CMDFLD
HRROI A,ADRSTR(W) ;Output string for this name
MOVX C,JS%SPC ;Output everything
JFNS%
PUSH P,A ;Save updated string pointer
MOVEI A,(B)
RLJFN% ;Don't need it till later
NOP
MOVX A,AD.FIL ;File recipient
STOR A,ADTYP,(U)
SETZM ADRUSR(U)
POP P,A ;Restore updated string pointer
ELSE.
MOVE B,MYAUSR ;Must be . meaning me
MOVEM B,ADRUSR(U)
MOVEI A,ADRSTR(W)
HRLI A,(<POINT 7,>)
MOVEI B,MAUSRS ;Use my name string too
CALL MOVST0 ;Move in user name
ENDIF.
ELSE.
MOVEI A,ADRSTR(W)
HRLI A,(<POINT 7,>)
MOVEI B,STRBUF ;Set up pointer to string
CALL MOVST0 ;Move in user name
ENDIF.
MOVEI A,1(A) ;Point to next free word
SUBM A,W ;Get length
EXCH A,W
STOR A,ADSIZ,(U) ;Store it away
MOVEI B,ADRLST
MOVX D,CM%XIF
IORM D,CMDBLK+.CMFLG
CALL $COMND
ANDCAM D,CMDBLK+.CMFLG
IFXE. A,CM%NOP ;Was it @ or :?
MOVE A,.CMDAT(C) ;Yes, get token
HRLI A,(<POINT 7,>)
ILDB A,A
CAIE A,":" ;Distribution list
IFSKP.
TXO F,F%F4!F%COMA ;Say we are within a distribution list
;Also pretend there was a comma so the
; reparse setup code isn't confused
MOVX A,AD.GRP ;Distribution list type recipient
STOR A,ADTYP,(U)
JRST GETUSR ;And go get some more guys
ENDIF.
MOVEI B,[FLDBK. .CMFLD,,,host name,,HNMMSK]
CALL CMDFLD ;Parse it
HRROI A,STRBUF
CALL HSTNAM ;See if name known
IFNSK.
MOVEI A,STRBUF
ERROR <Unrecognized host name "%1S">
ENDIF.
MOVEM A,ADRHST(U) ;Save host address
MOVX A,AD.NET ;Network recipient
STOR A,ADTYP,(U)
MOVEI B,[FLDDB. .CMCFM,,,,,<[FLDDB. .CMCMA]>]
CALL CMDFLD
LOAD D,CM%FNC,(C)
CAIN D,.CMCMA
TXO F,F%COMA
ELSE.
CAIE E,.CMUSR ;Was it a user before?
TXNE F,F%F3 ;Or funny addresses ok?
IFSKP.
CAIN E,.CMTOK ;File name/token?
ANSKP.
CAIE E,.CMKEY ;Was it System?
IFSKP.
MOVX B,SYSCOD ;Yes, get the special user number
MOVEM B,ADRUSR(U) ;Set it in the block
MOVEI B,[ASCIZ/System/] ;User name for string
MOVEI W,(U) ;Re-initialize W from base in U
MOVEI A,ADRSTR(W) ;Pointer to string area
HRLI A,(<POINT 7,>)
CALL MOVST0 ;Move in file name string
MOVEI A,1(A) ;Point to next free word
SUBM A,W ;Get length
EXCH A,W
STOR A,ADSIZ,(U) ;Store it away
ELSE.
HRROI A,ADRSTR(U) ;Local addr, not user, try forwarding
CALL CHKFWD ;Did we find it?
ERROR <No such local user as "%1R">
MOVE A,LCLHST ;Get host string pointer
MOVEM A,ADRHST(U) ;Set up host properly
MOVX A,AD.NET ;Network recipient
STOR A,ADTYP,(U)
ENDIF.
ENDIF.
MOVEI B,[FLDDB. .CMCFM,,,,,<[FLDDB. .CMCMA]>]
CALL CMDFLD ;Must be comma or confirm here
LOAD D,CM%FNC,(C) ;Get field type
CAIN D,.CMCMA
TXO F,F%COMA
ENDIF.
RETSKP
;;; GETKEY - Parse list of keywords.
; Returns U/ keyflag bit mask
; V/ keyword list ptr
KEYLST: FLDDB. .CMTOK,,<POINT 7,[ASCIZ/*/]>,,,KEYLS1
KEYLS1: FLDDB. .CMKEY,,KEYTBL,,,KEYLS2
KEYLS2: FLDDB. .CMFLD,,,<keyword>
GETKEY: SKIPA B,[[FLDDB. .CMCMA,CM%SDH,,<","
or confirm with carriage return>]]
GETKY0: MOVEI B,[FLDDB. .CMCMA,CM%SDH,,<","
or message sequence>]
PUSH P,B
SETZ U, ;Init bits
MOVEI B,KEYLST
SETZ V, ;Clear keyword list
CALL CMDFLD
LOAD D,CM%FNC,(C)
CAIE D,.CMTOK ;Was "*" typed?
JRST GETKY2 ;No, assume got a keyword.
HRROI U,777700 ;Yes, do crock = set all flag bits!
JRST CPPOPJ
GETKY1: MOVEI B,[FLDDB. .CMKEY,,KEYTBL,,,<[FLDDB. .CMFLD]>]
CALL CMDFLD ;Get a keyword
GETKY2: LOAD D,CM%FNC,(C) ;Find which function won
CAIN D,.CMKEY ;If twas a keyflag,
JRST GETKY7 ;go handle the bits.
;Store keyword onto keyword list.
SKIPN D,KEYFRE ;Get keyword freespace ptr
MOVEI D,KEYPGS ;Initialize if necessary.
HRLI D,(<POINT 7,>) ;Make it a BP
MOVE A,D
MOVE B,[POINT 7,STRBUF]
CALL MOVST2 ;Move string, with null for good luck
MOVEM D,2(A) ;Store ptr to string in cell following
MOVEI D,1(A) ;Save addr to keyword cell
MOVE C,[POINT 7,STRBUF] ;Set up for B-C
CALL PTRDIF ;Return B-C in A
SUBI A,1 ;Minus 1 cuz of the null
CAIG A, ;Check. For now, complain, but
ERROR <Null keyword> ;Later just get another keyword.
HRLZM A,(D) ;Store count in keyword cell
HRRM V,(D) ;Link new cell to rest of list
MOVEI V,(D) ;Cell now linked in!
ADDI D,2
MOVEM D,KEYFRE ;Update freespace pointer.
JRST GETKY8 ;Now go get another keyword.
GETKY7: HRRZ B,(B) ;Handle a keyflag.
MOVNS B
MOVSI A,400000
LSH A,(B)
IOR U,A ;Set the given bit
GETKY8: MOVE B,(P) ;See if a comma follows
CALL $COMND
JXE A,CM%NOP,GETKY1 ;Yup, get more stuff.
JRST CPPOPJ ;Not a comma, return
;;;Check for forwarding. Pointer to string in A, skip returns if exists
CHKFWD: TXC A,.LHALF ;Fix software pointer to hardware pointer
TXCN A,.LHALF
HRLI A,(<POINT 7,>)
SAVEAC <A,D>
STKVAR <PTR,JFN,FRK>
MOVEM A,PTR ;Save pointer
MOVX A,GJ%OLD!GJ%SHT ;Get JFN of forwarder
HRROI B,[ASCIZ/SYS:MMAILBOX.EXE/]
GTJFN%
ERJMP R ;Can't
MOVEM A,JFN ;Save JFN
MOVX A,CR%CAP ;Create an inferior fork
CFORK%
JERROR <Can't create forwarding fork>
MOVEM A,FRK ;Save fork handle
MOVE A,JFN ;Get back JFN
HRL A,FRK ;Get prog into fork
GET%
IFJER.
MOVE A,JFN ;Flush the JFN
RLJFN%
ERJMP .+1
ELSE.
HRLZ A,FRK ;Page 0 of inferior
MOVE B,[.FHSLF,,FWDPAG/1000] ;Mapped to this fork's FWDPAG
MOVX C,PM%RD!PM%WR ;Read+write access
PMAP%
..TAGF (ERJMP,) ;I sure wish ANNJE. existed!
MOVE A,PTR ;Get string pointer
MOVE B,[POINT 7,FWDPAG+200] ;Copy string
DO.
ILDB C,A
IDPB C,B
JUMPN C,TOP.
ENDDO.
MOVE A,FRK ;Set inferior's AC1 to 1 for local site
MOVEI B,4 ;Start up inferior
SFRKV%
IFNJE.
WFORK%
..TAGF (ERJMP,) ;I sure wish ANNJE. existed!
RFSTS% ;See if it finished ok
..TAGF (ERJMP,) ;I sure wish ANNJE. existed!
LOAD A,RF%STS,A ;Get status
CAIE A,.RFHLT ;HALTF%?
ANSKP.
SKIPLE FWDPAG+177 ;Success answer?
AOS (P) ;Indicate success
ENDIF.
MOVEI D,SAVMOD ;Restore TTY modes
CALL SETTYM
SETO A, ;Unmap shared page
MOVE B,[.FHSLF,,FWDPAG/1000] ;Mapped to this fork's FWDPAG
SETZ C,
PMAP%
ERJMP .+1
ENDIF.
MOVE A,FRK ;Flush the fork
KFORK%
ERJMP .+1
RET
ENDSV.
;;;Parse command line
RSPRTB: NRSPTB,,NRSPTB
CMD BB,0
CMD MAIL,.SEND
CMD MM,0
CMD NMM,0
CMD SNDMSG,.SEND
NRSPTB==<.-RSPRTB>-1
DORSCN: SETZ A,
RSCAN%
SETZ A,
JUMPE A,R ;No command line
MOVSI A,[ASCIZ//] ;Dummy prompt
TXO F,F%RSCC ;Note RSCAN% command
CALL CMDINI ;Init COMND state block
SETZM CLEVEL ;At top level now
MOVEI A,CMDRES ;Reinit error dispatch
HRRM A,CMDRET
MOVEI B,[FLDDB. .CMKEY,,RSPRTB]
CALL $COMND
JXN A,CM%NOP,DORSCE ;If error, flush line
HRRZ A,(B)
IFN. A
NOISE (TO) ;In case EXEC has (TO) noise word
TXO F,F%HOER ;Return to EXEC on any error
AOS CLEVEL ;Now a level deeper
SETOM ABOCAN ;OK to arm CTRL/N aborts
ELSE.
MOVEI B,[FLDDB. .CMKEY,,RSCMTB] ;Parse MM RSCAN% command
CALL $COMND
JXN A,CM%NOP,DORSCE
HRRZ A,(B) ;Get dispatch address
ENDIF.
TXO F,F%RSCN ;Say called from command line
AOS CLEVEL ;Now a level deeper
SETOM ABOCAN ;OK to arm CTRL/N aborts.
CALL (A)
JRST CMDRES ;And go to top-level
; Here on COMND error. Either the rescanned command was garbage, or
; it wasn't an MM-related command at all (e.g. some EXEC command). Just
; ignore it instead of trying to figure out every possible case.
DORSCE: MOVX A,.PRIOU ;Flush rest of line
BKJFN%
NOP
DO.
SIBE% ;Don't hang on this BIN%
IFNSK.
BIN%
CAIE B,.CHLFD
LOOP.
ENDIF.
ENDDO.
DMOVE A,[POINT 7,CSBUF ;Avoid embarassment if user types CTRL/H
CSBFSZ*5] ; first thing
DMOVEM A,CMDBLK+.CMPTR
RET ;Now return to upper level
;;;Read in file for RSCAN% command handling
RSCFIL: CALL GETFIL ;For read from command line
SKIPG MSGJFN ;Is there a mailbox?
XCT CMDRET ;No, error
CALLRET RECEN2 ;Remark new messages w/o headers
SUBTTL Deliver local mail using MMailr
;;;Queue local mail to MMailr
SYSCOD==-2 ;Special user number for SYSTEM
SNDLCL: SKIPN W,LCLIST ;Get start of local recipients
RET
DO.
MOVE A,ADRUSR(W) ;Is this special local recipient?
CAME A,[-1]
IFSKP.
TXON F,F%F2 ;Yes, setup as saved.messages file
SKIPE SAVFIL ;Unless have one from moving
IFSKP.
HRROI A,SAVFIL
MOVE B,MSGJFN
MOVE C,[111110,,JS%PAF]
JFNS%
ENDIF.
HRRZ W,ADRLNK(W) ;Get next in line
JUMPN W,TOP.
RET
ENDIF.
CAME A,[SYSCOD] ;Mailing to SYSTEM?
IFSKP.
MOVX A,GJ%OLD!GJ%DEL!GJ%PHY!GJ%SHT ;Verify it exists
HRROI B,[ASCIZ/POBOX:<SYSTEM>MAIL.TXT.1/]
GTJFN%
..TAGF (ERJMP,) ;I sure wish ANNJE. existed!
RLJFN% ;Now get rid of this JFN
NOP
MOVX A,GJ%FOU!GJ%DEL!GJ%PHY!GJ%SHT ;Get the JFN we really want
HRROI B,[ASCIZ/POBOX:<SYSTEM>MAIL.TXT.1/]
GTJFN% ;Try to get mail file
..TAGF (ERJMP,) ;I sure wish ANNJE. existed!
MOVEM A,OUTJFN ;Save it
MOVX B,<<FLD 7,OF%BSZ>!OF%APP> ;Open for append
OPENF%
IFJER.
MOVE A,OUTJFN
RLJFN%
NOP
ELSE.
SETZ T, ;Mark as unseen
CALL FILMS2 ;Go actually append it
MOVEI A,ADRSTR(W) ;Get the guy's name again
SKIPL SNDVBS ;Super-terse sending?
CIETYP < SYSTEM -- ok> ;No, tell of local sending
SETO A, ;Shout there's a new system message
HRROI B,[ASCIZ/
[From SYSTEM: New Message-of-the-Day available]
/]
TTMSG% ;Tell everybody
ERJMP .+1 ;Ignore ITRAP
HRRZ W,ADRLNK(W) ;Get next in list
JUMPN W,TOP.
RET
ENDIF.
ENDIF.
CALL REMLST ;Prevent circular list
SETZM ADRUSR(W) ;Clear host/user number for this guy
MOVEI B,NETLST ;Thread entry into network recipients
MOVEI U,(W)
HRRZ W,ADRLNK(W) ;Get next link for next time
SETZM ADRLNK(U) ;Clear any previous links
CALL ADDLST ;Add onto this list
NOP ;Don't worry about duplicate
JUMPN W,TOP.
ENDDO.
RET
SUBTTL End of program
XLIST ;For clean listings
LIT
LIST ;Literals are XLISTed out
END <EVECL,,EVEC>
