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 ; MRC@PANDA.PANDA.COM or MRC@SIMTEL20.ARPA 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, ;Number of pages for host strings in cache IFNDEF NHPPGS, ;Number of pages for host cache pointers NHOSTS==-1 ;Maximum number of hosts in cache IFNDEF NEDPGS, ;Number of pages between MM and editor IFNDEF NKYPGS, ;Number of pages for keyword hacking IFNDEF NMSGS, ;Number of messages we can handle IFNDEF NMSWRN, ;Number free msgs before warning user IFNDEF NPGWRN, ;Number free pages before warning IFNDEF NTOPGS, ;Number of pages for TO/CC/etc addr blocks IFNDEF NTXPGS, ;Number of pages for text input IFNDEF MAXBBD, ;Maximum number of BBoards supported IFNDEF DATSIZ, ;Size of data psect IFNDEF CODSIZ, ;Size of code psect IFNDEF DATORG, ;Data on page 1 ;;;Special version of FLDDB. which has default pointer instead of string DEFINE FLDDF. (TYP,FLGS,DATA,HLPM,DEFM,LST) < ..XX==+FLGS+<0,,LST> IFNB ,<..XX==CM%HPP!..XX> IFNB ,<..XX==CM%DPP!..XX> ..XX DATA+0 IFNB ,<-1,,[ASCIZ HLPM]> IFB ,<0> IFNB ,<-1,,DEFM> >;DEFINE FLDDF. DEFINE PUSHAE (AC,LIST) < IRP LIST, >;DEFINE PUSHAE DEFINE POPAE (AC,LIST) < IRP LIST, >;DEFINE POPAE DEFINE DEFERR (X,Y) < DEFINE X (Z) < IFB , IFNB , >;DEFINE X >;DEFINE DEFERR DEFINE CMD (X,Y,Z) < IFB ,< IFB ,<[ASCIZ\X\],,.'X> IFNB ,<[ASCIZ\X\],,Y>> IFNB ,< IFB ,<[Z ASCIZ\X\],,.'X> IFNB ,<[Z ASCIZ\X\],,Y>> >;DEFINE CMD DEFINE CMD1 (X,Y,Z) )> DEFINE VAR (X,Y,Z) < [ASCIZ/X/],,[Z,,Y] >;DEFINE VAR DEFINE HDY (X,Y,Z) < RADIX ^D10 [ASCIZ/X/],,[*512+,,DATHDY] RADIX ^D8 >;DEFINE HDY DEFINE CITYPE (X) DEFINE ETYPE (X) DEFINE CETYPE (X) DEFINE CIETYP (X) DEFINE NOISE (X) DEFINE DEFALT (X) DEFINE PROMPT (X) DEFINE CONFRM DEFINE NOINT ;Trap CTRL/C's DEFINE 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+ ;Code starts after data PAGORG==CODORG+ ;Paged stuff starts after code .PSECT DATPAG,PAGORG ;Enter paged data PAGSIZ==0 ;Init size of page PSECT DEFINE DEFPAG (ADDR,LENGTH) < ADDR:: IFB , IFNB , >;DEFINE DEFPAG DEFPAG HDRPAG ;Headers SUBBUF=HDRPAG+700 ;Address of subject buffer SUBEND=.-1 ;End of subject buffer SUBBSZ==<*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== ;Number of message pages DEFPAG MSGPGS,NMSGPG ;Storage for message data RLYPGS==:2 DEFPAG RLYTBL,RLYPGS ;TBLUK table for host/nicknames MTXPGN==>/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+ ;Previous message sequence list PRVSQZ==. MSGSEQ: BLOCK 1+ ;Table of numbers of messages MSGSQZ==. WRKSEQ: BLOCK 1+ ;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, ;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 +1 ;"From: " string for all msgs FRMSCM: BLOCK +1 ;"From: " string for current msg REPSAM: BLOCK +1 ;"Reply-to: " string for all msgs REPSCM: BLOCK +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 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!!!! 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 STKVAR 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 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 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 ;The previous abort vector is pushed. ; ;An abort will reset P to its value at ; ;the time SETABT was done, and jump to . ; 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 - 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 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 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 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 >,,> 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>!<1B>!<1B>> ;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/:*./] ;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 EXIT. ENDIF. MOVE A,D ;Retrieve JFN GNJFN% ;Get next BBoard ERJMP ENDLP. ;No more BBoards to do LOOP. ENDIF. WARN 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 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. ;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 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 ; 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 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 IFE. M CIETYP < Currently at beginning, message %M. > RET ENDIF. SUBI M,MSGLEN CALLRET .NEXT1 .JUMP: STKVAR SKIPG MSGJFN ERROR 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 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 ;Woops, bombed? .EXPUN: NOISE (DELETED MESSAGES) CONFRM SKIPG MSGJFN ERROR 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 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 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 ELSE. ETYPE < = %1D message%1P> ENDIF. RET CNTMSG: AOS NRECNT RET ;;;Append messages together .APPEN: STKVAR SKIPG MSGJFN ;Must have a file ERROR 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 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 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 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 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,() 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 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,() ;Copy a string and update count DO. ILDB C,B JUMPE C,R IDPB C,D AOJL E,TOP. ENDDO. USHDRE: ERROR ;;;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,<!OF%WR> OPENF% IFJER. MOVE A,OUTJFN JERROR 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,<!OF%RD> OPENF% IFJER. MOVE A,TMPJFN JERROR 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,<!OF%APP> ;Open for append OPENF% IFJER. MOVE A,OUTJFN JSNARL ;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 SETZM OUTJFN RET .RCOP1: CALL GETOUT ;Get output file CONFRM .RCOPA: MOVE A,OUTJFN MOVX B,<!OF%APP> ;Open for append OPENF% IFJER. MOVE A,OUTJFN JSNARL ;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,] 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. ;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 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 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 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 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 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,,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,,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 RLJFN% ;Yeah, don't want it NOP ;Shouldn't fail ERROR 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 <>,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 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 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 ? 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 MOVEM A,TMPJFN MOVX B,<!OF%RD> OPENF% IFJER. JWARN 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 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 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 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 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 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 ENDIF. MOVEM A,OUTJFN MOVX B,<!OF%WR> OPENF% IFJER. MOVE A,OUTJFN SETZM OUTJFN JERROR 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,[+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 ;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 ] 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 STKVAR 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 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 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 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,,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 STKVAR 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 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,,] 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 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 ;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 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,() MOVST2: DO. ILDB C,B IDPB C,A JUMPN C,TOP. ENDDO. RET ;;;Move a string from B to A MOVSTR: HRLI B,() 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,() 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 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 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 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 ;Uh, yeah, it is ENDIF. HLLZ A,A ;JFN in left for PMAP% MOVE B,[.FHSLF,,] ;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 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 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 ;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 ;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 ELSE. ETYPE 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 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 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,,] ;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 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 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 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 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. ;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 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,<!OF%RD> ;Try to open it OPENF% IFNJE. 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 ; ; ; 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 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 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 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 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 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,[!OF%RD!OF%PDT] ;Read access, no updates OPENF% IFJER. JSNARL 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,<!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 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 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 IFXE. B,GS%OPN ;Open? MOVX B,<!OF%RD> ;Try to open it OPENF% IFJER. MOVE A,MSGJFN JERROR 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 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 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 SETO B, ENDIF. CALL BP2CHR ;Get character pointer CAMGE V,FILSIZ ;Ran off EOF? IFSKP. WARN 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 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* ;Got all we can handle? IFSKP. SETZM FILPGS ;Keep UNMAPF from getting confused CALL CLOSEF ;Get rid of JFN, etc. MOVEI C,NMSGS ERROR 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 HRRZ V,FILPGS ;See if we are getting close MOVEI C,NMTXPG ; to the maximum file size CAIL V,-NPGWRN(C) WARN MOVE M,LASTM CAIGE M,MSGLEN* CAIL V, 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 SETOM MSGDAT(M) ;Mark this one bad. ADDI M,MSGLEN ;Bump to start reading next msg. CAIL M,MSGLEN* RET ENDIF. DO. ILDB T,A ;Search for LF CALL BP2CHR CAMGE V,FILSIZ ;Ran off EOF? IFSKP. WARN 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,() 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 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,() ;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: ;;; ;;;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,() 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,() ;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,() 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,,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,() ;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,() ;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,() KEYST5: ILDB C,D JUMPE C,KEYST1 IDPB C,O AOJA T,KEYST5 ;;;Type out a message .LRTYP: SKIPG MSGJFN ERROR CONFRM ;Confirm first CALLRET TYPMSL .TYPMS: SKIPG MSGJFN ERROR 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 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 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 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 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 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 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 MOVEM A,MSGJF2 ;Save JFN ENDIF. MOVE B,[!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 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 MOVE A,[WRKSEQ,,MSGSEQ] ;Copy previous working sequence BLT A,MSGSEQ+ 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 ] 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, ;Overflow? ERROR 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 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 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 ] 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 ! , ! : ! # 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 ! . ! % 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 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 ! , 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,,,GTNBK5 GTNBK5: FLDDB. .CMKEY,,SQCMTB, ;;;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, ;;;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 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 ;Messages with string in to field STKVAR 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 ;Messages with string in CC field STKVAR 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 STKVAR 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,() 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+ FATAL 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 MOVE B,HCSHFF ;Get free block from here ADD A,B ;First address after block CAIL A,HSTSTR+ ;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 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 ELSE. MOVEM A,JFNTAD ;Save JFN in case OPENF% fails DO. MOVX B,<!OF%WR> OPENF% IFJER. MOVE A,JFNTAD ;Let user try CONTINUE JWARN PROMPT 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 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: CAIE A,GJFX24 ;File not found error? RET ;No, probably bad filename PROMPT 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,<!OF%APP> ;Open for append OPENF% IFJER. POP P,A ;Get JFN back JWARN 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 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 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 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
SOUT% HRROI B,HDRPAG ;Start of headers SETZ C, SOUT% HRROI B,TXTPAG ;Start of text SOUT% CLOSF% ;All there is to it JSNARL 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 RET ENDIF. PUSH P,A MOVX B,OF%THW!OF%WR!OF%RD OPENF% IFJER. POP P,A RLJFN% NOP JWARN 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 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,<!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 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 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 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 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 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 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 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,() 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,() ;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,() ;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,,]] 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,<!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 ;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,<!OF%RD> OPENF% IFJER. MOVE A,TMPJFN JWARN 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 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 <> 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 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
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,() MOVEI A,ADRSTR(W) ;This particular one HRLI A,() 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 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 MOVX B,<!OF%WR> ;We want to write msg into it OPENF% JERROR 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 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 MOVEM A,SPLFRK ;Save the fork handle ENDIF. MOVX A,GJ%OLD!GJ%SHT HRROI B,SPLNAM ;Name of SPELL program GTJFN% JERROR 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 STKVAR <> MOVEI B,SPLACS ;Get the old ACs RFACS% IFJER. JSNARL 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 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,<!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 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 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 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 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 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 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 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,<!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 > 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, 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 ENDIF. MOVE B,OPNARG OPENF% IFJER. CALL KILED0 JERROR 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 ; 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 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,() ;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 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 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 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 > 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 PROMPT CALL YESNO1 IFSKP. CALL KILED0 ERROR 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 > MOVX A,GJ%OLD!GJ%SHT MOVX B,<!OF%RD> CALL GEDTMP ;Find the temp file again MOVEM A,FILJFN ;Save JFN HRROI B,EDPAGE ;Where to put it MOVX C,- 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 PROMPT CALL YESNO1 ANSKP. CALL KILED0 ERROR 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 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 ;;; , 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 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,<!OF%RD> OPENF% IFJER. RLJFN% ;Discard JFN NOP ;Don't care MOVEI A,STRBUF JWARN 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,() ;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 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 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 ELSE. SNARL ENDIF. ELSE. SNARL 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,() 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,() ;Was the keyword null? IFSKP. SNARL 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 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 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,() ;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,() 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 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 PROMPT CALL YESNO1 CAIA ;No SETOM SNDVBS ;Yes, super-terse ;;;REPLY-INCLUDE-ME SETZM RINCME ;Set up for no replies to me PROMPT CALL YESNO1 CAIA ;No AOS RINCME ;Yes, include me in replies ;;;REPLY-SENDER-ONLY-DEFAULT SETZM RFMDEF ;Set up for reply to everybody CITYPE PROMPT CALL YESNO1 SETOM RFMDEF ;No, reply to sender only ;;;BLANK-SCREEN-STARTUP SETOM BLSCST ;Set up for screen blanking PROMPT CALL YESNO1 SETZM BLSCST ;No, no screen blanking ;;;CONTROL-N-ABORT SETZM ABOFLG ;Set up to ask before aborting CITYPE PROMPT CALL YESNO1 CAIA ;No AOS ABOFLG ;Yes, abort without asking CITYPE 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 MOVX B,<!OF%WR> OPENF% JWARN 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 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 ] ;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 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>,, ; ; 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 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 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, ;Save count, BP, and BP into file NOINT ;No outside diddling CALL GETJF2 ;Get write JFN IFNSK. POPAE P, ;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 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 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 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,() ;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, 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, 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, JRST KYCPY2 ;Now go get another word. KYCPYS: CAIG E,3(A) ;Ensure enough room for word&separators ERROR 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, 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, 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, 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, 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, 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,<!OF%RD> ;Need read access only OPENF% JERROR 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, DOTOK: MOVE B,.CMDAT(C) ;Get pointer HRLI B,() 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 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 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]>,,,USRLS5 USRLS5: FLDDB. .CMQST,,,,,USRLS6 USRLS6: FLDBK. .CMFLD,,,,,UNMMSK ADRLST: FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ/@/]>,,,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,() 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,,] 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,() MOVEI B,MAUSRS ;Use my name string too CALL MOVST0 ;Move in user name ENDIF. ELSE. MOVEI A,ADRSTR(W) HRLI A,() 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,() 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 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,() 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 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,,,,,KEYLS1 KEYLS1: FLDDB. .CMKEY,,KEYTBL,,,KEYLS2 KEYLS2: FLDDB. .CMFLD,,, 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,() ;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 ;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,() SAVEAC STKVAR 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 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: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:MAIL.TXT.1/] GTJFN% ;Try to get mail file ..TAGF (ERJMP,) ;I sure wish ANNJE. existed! MOVEM A,OUTJFN ;Save it MOVX B,<!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