Trailing-Edge
-
PDP-10 Archives
-
BB-KL11J-BM_1990
-
t20src/msseq.mac
There are 14 other files named msseq.mac in the archive. Click here to see a list.
;This software is furnished under a license and may only be used
; or copied in accordance with the terms of such license.
;
;Copyright (C) 1979,1980,1981,1982 by Digital Equipment Corporation
; 1983,1984,1985,1986 Maynard, Massachusetts, USA
TITLE MSSEQ - Message sequence parsing routines for MS
SEARCH GLXMAC,MSUNV
PROLOG (MSSEQ)
CPYRYT
MSINIT
;Define globals
GLOBS ; Storage
GLOBRS ; Routines
;Global routines defined elsewhere
;MSUTL.MAC
EXTERNAL CMDER1, RFIELD, MOVST0, SSEARC, SETSFL, REMAP, GTBFL
;Global data items defined elsewhere
;MSUTL.MAC
EXTERNAL ATMBUF, MSGFAD, WBOT, WTOP, CMDRES, MSGSSQ, MSGSQE
;Local storage
IMPUR0
MSGSEQ: EXP 0 ; Table of numbers of messages adress
LSTMSG: BLOCK 1 ; Saved last message for typing out seq
SAVEM: BLOCK 1 ; Saved current message number
COMPDT: BLOCK 1 ; Date/time for "since" and "before"
NXTMSG: BLOCK 1 ; Dispatch to fetch next message
PATSTR: BLOCK 40 ; String pattern for from/subj matching
ANDFLG: BLOCK 1 ; Qualifiers being ANDed
PRIORM: BLOCK 1
RECLVL: EXP 0
MSGQLN: BLOCK 1
HEADNR: BLOCK 1
PURE
SUBTTL Message sequence subroutines
; Get sequence
DFSQNW: MOVEI A,DEFNEW ; Default to new (unseen)
JRST GETSEQ
DFSQTH: MOVEI A,DEFCUR ; Default to current message
GETSEQ: PUSH P,A ; Save command block addrs
SETZM LCNT ; Say no matches seen yet
SKIPG MSGJFN ; Have a message file?
CWARN (No current mail file)
NOISE (messages)
MOVEI A,MSGSSQ
SKIPN MSGSEQ
MOVEM A,MSGSEQ ;SET UP ADRESS IF NECESSARY
MOVE L,MSGSEQ
ADD L,[POINT 18,0]
SETOB X,LSTMSG
POP P,A ; Restore command block
CALL RFIELD ; Get command field
MOVE A,CR.COD(A) ; Get code
CAIN A,.CMKEY ; Keyword?
JRST GETSQK ; Yes - done
CAIN A,.CMNUM ; Number?
JRST GETSQN ; Yes - proceed
JRST GETSQT ; Must be token (% or .)
;Keyword seen , handle defaulting and return
GETSQK: HRRZ A,(B) ; Get routine addrs
JRST (A)
;Token - check for % or . and supply number
GETSQT: LDB A,[POINT 7,ATMBUF,6] ; Get token character
CAIN A,"%"
SKIPA B,LASTM ; % = last message number
MOVEI B,(M) ; . = current message number
AOJA B,GETSQN ; Handle as number now
;Number parsed - handle n:m n,m or n alone
GETSQN: JUMPE B,GTSQNE ; Range error
SOJL B,GTSQNE
CAMLE B,LASTM
JRST GTSQNE
JUMPGE X,GTSQN2 ; 2nd in series n:m
IDPB B,L ; Save number in list
CALL CHKL ;CHECK THE RANGE
MOVEI A,GTNBK1 ; Now try for <cr> ! , ! :
GTSQNA: CALL RFIELD
MOVE A,CR.COD(A) ; Get function code parsed
CAIN A,.CMCFM ; EOL?
JRST GTSQNR ; Yes - done
CAIE A,.CMCMA ; Comma?
LDB X,L ; Must be ":" ,setup for 2nd arg
MOVEI A,DEFLST ; Yes - try for <number> ! . ! %
CALL RFIELD
MOVE A,CR.COD(A) ; Get function code
CAIN A,.CMCFM ; EOL?
JRST GTSQNR ; Yes - done
CAIN A,.CMNUM ; Number?
JRST GETSQN ; Yes - handle
CAIN A,.CMKEY ; Keyword?
JRST GETSQK ; Yep, go handle it
JRST GETSQT ; Handle token
;2nd in range seen - fill list
GTSQN2: CAIN X,(B) ; Done with range
JRST GTSQNC ; Look for next field
CAIG X,(B) ; If going forwards,
AOSA X ; increment,
SOS X ; else decrement
IDPB X,L ; Save in table
CALL CHKL ;CHECK THE RANGE
JRST GTSQN2 ; Loop till done
GTSQNC: SETO X, ; Say looking for 1st number of pair
MOVEI A,GTNBK3 ; Try for <cr> ! ,
JRST GTSQNA
;EOL seen , wrapup numbers
GTSQNR: MOVEI B,777777 ; Mark end of list
IDPB B,L
MOVEI A,NXTSEQ ; Next in the sequence
MOVEM A,NXTMSG ; Setup as dispatch
MOVE A,MSGSEQ
ADD A,[POINT 18,0]
EXCH A,L ; Reset L, get old contents
MOVE B,MSGSEQ
ADD B,[POINT 18,0,17]
CAMN A,B ;ANY MESSAGES AT THE LISTAT ALL ?
RET ; No -- leave M alone then
PUSH P,L ; Save these for a bit
PUSH P,M
SETZM LCNT ; Zero msg count
GTSQN3: ILDB M,L ; Check to see all msgs are parsed
CAIN M,777777 ; End of list?
JRST GTSQN4 ; Yes, all done
AOS LCNT ; Count messages in this sequence
GTMBL (M,B) ; Get ptr to message block
MOVX A,M%VALI ; Valid info for this message?
TDNN A,MSGBTS(B) ; ..
CALL PRSMS0 ; No, get some then
JRST GTSQN3 ; Check all msgs in sequence
GTSQN4: POP P,M
POP P,L ; Finish up
RET ; Return
GTSQNE: CMERR (Invalid message number)
JRST CMDER1
DEFCUR: FLDDB1 (.CMNUM,CM%SDH,^D10,<-1,,SEQHLP>,<current>,DEFDEF)
DEFNEW: FLDDB1 (.CMNUM,CM%SDH,^D10,<-1,,SEQHLP>,<new>,DEFDEF)
DEFALL: FLDDB1 (.CMNUM,CM%SDH,^D10,<-1,,SEQHLP>,<all>,DEFDEF)
DEFLST: FLDDB1 (.CMNUM,CM%SDH,^D10,<-1,,SEQHLP>,<last>,DEFDEF)
DEFDEF: FLDDB1 (.CMTOK,,<POINT 7,[ASCII "%"]>,,,TKNDOT)
TKNDOT: FLDDB1 (.CMTOK,,<POINT 7,[ASCII "."]>,,,[FLDDB1 (.CMKEY,,SQCMTB)])
GTNBK1: FLDDB1 (.CMCFM,,,,,[FLDDB1 (.CMCMA,,,,,[FLDDB1 (.CMTOK,,<POINT 7,[ASCII ":"]>)])])
GTNBK3: FLDDB1 (.CMCFM,,,,,[FLDDB1 (.CMCMA)])
SEQHLP: ASCIZ \message sequence, one of the following:
message number
or list of numbers (4,14,11,...)
or range of numbers (11:37)\
SQCMTB: NSQCMS,,NSQCMS
CMD1 (A,ENTALL,CM%INV!CM%ABR)
ENTALL: CMD1 (All,STQALL)
CMD1 (Answered,STQANS)
CMD1 (Before,STQTMB)
CMD1 (Current,STQCUR)
CMD1 (Deleted,STQDEL)
CMD1 (F,ENTFRM,CM%INV!CM%ABR)
CMD1 (First,STQFRS)
CMD1 (Flagged,STQFLG)
ENTFRM: CMD1 (From,STQFRM)
CMD1 (Inverse,STQREV)
CMD1 (Keyword,STQKWD)
CMD1 (L,ENTLST,CM%INV!CM%ABR)
CMD1 (Larger,STQLRG)
ENTLST: CMD1 (Last,STQLST)
CMD1 (N,ENTNEW,CM%INV!CM%ABR)
ENTNEW: CMD1 (New,STQNEW)
CMD1 (Next,STQNXT)
CMD1 (Old,STQOLD)
CMD1 (Related-to,STQREL)
CMD1 (Same,STQSAM)
CMD1 (Since,STQTMS)
CMD1 (Smaller,STQSML)
CMD1 (Sorted,STQSOR)
CMD1 (Subject,STQSBJ)
CMD1 (To,STQTO)
CMD1 (Unanswered,STQUNA)
CMD1 (Undeleted,STQUND)
CMD1 (Unflagged,STQUNF)
NSQCMS==.-SQCMTB-1
STQSRC: STQSRN,,STQSRN
CMD1 (Date-time,SQSRDT)
STQSRN==.-STQSRC-1
STQSAM: NOISE (as last sequence)
CONFRM
MOVE C,MSGSEQ
HRLI C,(POINT 18)
MOVE L,C ;RETURN THIS IN L
SETZ D,
STQSA0: ILDB A,C ; Get msg number
CAIE A,777777 ; Check for terminator
AOJA D,STQSA0
STQSA1: MOVEM D,LCNT ; Save count
CAIG D,0 ; If none...
WARN <No previous sequence exists> ;Complain here
RET
;Larger (than) n (characters)
STQLRG: CALL STQLR0 ; Parse character count
STQLR1: GTMBL (M,A) ; Get ptr to message block
CAMGE B,MSGBON(A) ; Is this one big enough?
IDPB M,L ; Yes, add to sequence
CALL CHKL ;CHECK THE RANGE
CAME M,LASTM ; Loop through all messages
AOJA M,STQLR1 ; ..
JRST GTSQNR ; Finished
;Smaller (than) n (characters)
STQSML: CALL STQLR0 ; Parse character count
STQSM1: GTMBL (M,A) ; Get ptr to message block
CAMLE B,MSGBON(A) ; Match?
IDPB M,L ; Yes, stuff into sequence
CALL CHKL ;CHECK THE RANGE
CAME M,LASTM ; Loop over all msgs
AOJA M,STQSM1 ; ..
JRST GTSQNR ; Done
STQLR0: NOISE (than)
MOVEI A,[FLDDB. (.CMNUM,CM%SDH,^D10,<character count>)]
CALL RFIELD
SETZ M, ; Init message pointer
PUSH P,B ; Save size limit
NOISE (characters)
CONFRM
POP P,B ; Restore size limit
RET
STQSOR: NOISE (by)
MOVEI A,[FLDDB. (.CMKEY,,STQSRC,,<Date-time>)]
CALL RFIELD
HRRZ A,(B) ; Dispatch to sort routine
CALLRET (A)
;Sort by date/time
SQSRDT: TRVAR <LOW,LOWM> ; Low date/time, and its M
CONFRM
SETZ M,
SQSRD0: GTMBL (M,B) ; Get ptr to message block
MOVX A,M%TEMP ; Temporary marker bit
ANDCAM A,MSGBTS(B) ; Clear markers
MOVX A,M%VALI ; Parsed this one yet?
TDNN A,MSGBTS(B) ; ..
CALL PRSMS0 ; No, insure it has a date/time
CAME M,LASTM ; for all messagges
AOJA M,SQSRD0
SETOM LOWM ; Flag nothing found yet
MOVE A,[377777,,777777] ; Get largest integer
MOVEM A,LOW ; Init floor counter
SETZ M,
SQSRD1: GTMBL (M,B) ; Get ptr to message block
MOVX A,M%TEMP ; Skip this message
TDNE A,MSGBTS(B) ; if already done
JRST SQSRD2 ; ..
MOVE A,MSGDAT(B) ; Get this msgs date
CAMGE A,LOW ; Is this lowest yet?
JRST [ MOVEM M,LOWM ; Yes, remember it
MOVEM A,LOW ; and its date/time
JRST .+1]
SQSRD2: CAME M,LASTM ; Check all msgs
AOJA M,SQSRD1 ; ..
SKIPGE M,LOWM ; Did we find one?
JRST GTSQNR ; No, all done then - tie off sequence
IDPB M,L ; Yes, stuff into sequence
CALL CHKL ;CHECK THE RANGE
GTMBL (M,B) ; Get ptr to message block
MOVX A,M%TEMP ; Mark this one as gotten
IORM A,MSGBTS(B) ; ..
SETZ M, ; Begin scan again
SETOM LOWM ; Flag nothing found this scan yet
MOVE A,[377777,,777777] ; Init ceiling again
MOVEM A,LOW ; ..
JRST SQSRD1 ; ..
STQALL: SKIPA A,[NXTALL]
STQDEL: MOVEI A,NXTDEL
STQDL0: MOVEM A,NXTMSG
CONFRM ; Get confirmation
MOVEM M,SAVEM ; Save current in case none in list
STQDL2: SETO M,
STQDL1: CALL @NXTMSG ; Get next in sequence
JRST GTSQNR ; No more, finish up
IDPB M,L ; Save this one in list
CALL CHKL ;CHECK THE RANGE
JRST STQDL1 ; Go for more
STQFLG: SKIPA A,[NXTFLG]
STQUND: MOVEI A,NXTUND
JRST STQDL0
STQNEW: SKIPA A,[NXTNEW]
STQOLD: MOVEI A,NXTOLD
JRST STQDL0
;Related-to (messages)
STQREL: CALL DFSQTH ; Get sequence, default to current
PUSH P,[-1] ; Put a marker on the stack
STQRL0: CALL NXTSEQ ; Get next message from sequence of originals
JRST STQRL1 ; None left
PUSH P,M ; Push this message number
JRST STQRL0 ; Push all message numbers from original seq.
STQRL1: MOVE L,MSGSEQ
ADD L,[POINT 18,0] ;RESET SEQUENCE POINTER
STQRL2: POP P,M ; Get a message from the original sequence
CAMN M,[-1] ; Hit the marker (end of stack) yet?
JRST GTSQNR ; Yes, done then, tie off sequence and return
MOVEM M,HEADNR ;SAVE HEAD NUMBER
CALL RELSEQ ; No, add msgs related to this one to sequence
JFCL ; Don't care if none found
JRST STQRL2 ; Repeat for all msgs in original sequence
STQLST: CALL STQLSS ; Get number of messages to put into list
JRST GTSQNE ; Range error
MOVE C,LASTM ; Number of last message
JUMPL X,STQLS2 ; If no previous no. with colon, this is easy
MOVE B,C ; There was one, set up to count from there
JRST GTSQN2 ; Go count from number to end
STQLS2: IDPB C,L ; Stuff message numbers
CALL CHKL ;CHECK THE RANGE
SUBI C,1 ; Next message from end
SOJG A,STQLS2 ; Do for all in list
CONFRM
JRST GTSQNR ; Done with list
STQNXT: CALL STQLSS
JRST GTSQNE
JUMPGE X,RANNXT
MOVE C,M ;START FROM WHERE WE WERE
CAML C,LASTM ;MAKE SURE NOT AT END
JRST GTSQNE ;GO COMPLAIN
STQNX2: ADDI C,1 ;+1
IDPB C,L
CALL CHKL
CAMGE C,LASTM ;AT END? QUIT NICELY
SOJG A,STQNX2 ;CAN STILL GO ON
JRST GTSQNC ;GO PARSE MORE
RANNXT: MOVE B,X ;Start from beginning of range
ADD B,A ;up by arg to NEXT
CAMLE B,LASTM
MOVE B,LASTM ;MAX fo LASTM
JRST GTSQN2 ;GO FILL RANGE
STQFRS: CALL STQLSS ; Similarly, first n messages
JRST GTSQNE ; ..
SETZ C, ; ..
STQFR2: IDPB C,L ; ..
CALL CHKL ;CHECK THE RANGE
ADDI C,1 ; ..
SOJG A,STQFR2 ; ..
CONFRM
JRST GTSQNR ; ..
STQLSS: MOVEI A,[FLDDB. (.CMNUM,,^D10,,<1>)]
CALL RFIELD
PUSH P,B ; NOISEs clobber this
CAIE B,1 ; Singular?
JRST STQLS0 ; No, use plural
NOISE (message)
JRST STQLS1
STQLS0: NOISE (messages)
STQLS1: POP P,A ; Restore number typed
JUMPLE A,R ; Range check
SUBI A,1 ; LASTM is counted from zero
CAMLE A,LASTM ; ..
RET ; ..
ADDI A,1 ; recorrect A
RETSKP ; Good return
STQCUR: MOVEI B,(M) ; Default to current
IDPB B,L ; Save on list
CALL CHKL ;CHECK THE RANGE
CONFRM ; Grntee EOL
JRST GTSQNR ; Done with list
STQUNF: SKIPA A,[NXTUNF]
STQREV: MOVEI A,NXTREV ; Reverse order
JRST STQDL0
STQANS: SKIPA A,[NXTANS] ; Answered
STQUNA: MOVEI A,NXTUNA ; Unanswered
JRST STQDL0
STQFRM: MOVEI X,NXTFRM ; Match "from" string
MOVEI A,[FLDDB. (.CMCFM,CM%SDH,,,,[FLDDB. (.CMQST,,,<string to find in "From" field,
>,,[FLDDB. (.CMTXT)])])]
JRST STQSB0 ; Common routine to get pattern
STQTO: MOVEI X,NXTTO ; Find "to" string
MOVEI A,[FLDDB. (.CMCFM,CM%SDH,,,,[FLDDB. (.CMQST,,,<string to find in "To" field,
>,,[FLDDB. (.CMTXT)])])]
JRST STQSB0
STQKWD: MOVEI X,NXTKWD ; Match keyword in header or text
MOVEI A,[FLDDB. (.CMCFM,CM%SDH,,,,[FLDDB. (.CMQST,,,<string to find anywhere in message,
>,,[FLDDB. (.CMTXT)])])]
JRST STQSB0
STQSBJ: MOVEI X,NXTSBJ ; Match subject string
MOVEI A,[FLDDB. (.CMCFM,CM%SDH,,,,[FLDDB. (.CMQST,,,<string to find in "Subject" field,
>,,[FLDDB. (.CMTXT)])])]
STQSB0: PUSH P,A ; Save arg
NOISE (string)
POP P,A
CALL RFIELD ; Read subject line or crlf
MOVE A,CR.COD(A) ; Get code
CAIN A,.CMCFM ; Just CR?
JRST [ CMERR <No string given.> ; Yes - error
JRST CMDER1]
CAIN A,.CMQST ; Quoted string?
SETOM ANDFLG ; Yes, flag that we might "and" qualifiers
MOVEI B,ATMBUF ; Copy string to pattern buffer
MOVEI A,PATSTR
HRLI A,(POINT 7,)
CALL MOVST0
MOVE A,X ; Routine addrs
JRST STQDL0
;Find substring in From, To, or Subject field
NXTKWD: SKIPA C,[CALL KWDSTR] ; Routine to match keyword in message
NXTTO: MOVE C,[CALL TOSTR] ; Routine to match To string
JRST NXTAL0 ; Join common loop
NXTSBJ: SKIPA C,[CALL SBJSTR] ; Routine to match Subject string
NXTFRM: MOVE C,[CALL FRMSTR] ; Routine to match From string
JRST NXTAL0 ; Use common loop
;Test routines to check for a string match in a message. These are all
; called with D/ pointer to message block (MSGIDX(M))
FRMSTR: $SAVE <A,C> ; Save these regs
MOVEI T,PATSTR ; String to match
MOVE V,MSGFRM(D) ; From field for this message
MOVE W,MSGFRN(D)
CALL SETSFL ;MAKE SURE 1 PAGE IS IN THE WINDOW
MOVE A,MSGFAD
IMULI A,5
SUB V,WBOT
ADD V,A ;MAKE NORMAL CHAR POINTER
CALL SSEARC ; Look for string
RETSKP ; Not found - try next
RET ; Found - use this
SBJSTR: $SAVE <A,C> ; Save these regs
MOVEI T,PATSTR ; String to match
MOVE V,MSGSUB(D) ; Subject field for this message
MOVE W,MSGSUN(D)
CALL SETSFL ;MAKE SURE 1 PAGE IS IN THE WINDOW
MOVE A,MSGFAD
IMULI A,5
SUB V,WBOT
ADD V,A ;MAKE NORMAL CHAR POINTER
CALL SSEARC ; Look for string
RETSKP ; Not found - try next
RET ; Found - use this
TOSTR: $SAVE <A,C> ; Save these regs
PUSH P,D
MOVEI T,PATSTR ; String to match
MOVE V,MSGTO(D) ; To field for this message
MOVE W,MSGTOK(D) ; Use entire To field
CALL SETSFL ;MAKE SURE 1 PAGE IS IN THE WINDOW
MOVE A,MSGFAD
IMULI A,5
SUB V,WBOT
ADD V,A ;MAKE NORMAL CHAR POINTER
CALL SSEARC
SKIPA ; Not found, try CC field
JRST [ POP P,D ; Found... but don't jump into garbage!
RET ]
POP P,D ; SSearch trashes many things...
SKIPN V,MSGCC(D) ; Is there any CC field to search?
RETSKP ; Apparently not...
MOVE W,MSGCCN(D)
MOVEI T,PATSTR ; SSearch trashes this too!
MOVE A,MSGFAD
IMULI A,5
SUB V,WBOT
ADD V,A ; Make char pointer
CALL SSEARC
RETSKP ; Not in CC either
RET ; Got it!
KWDSTR: $SAVE <A,C> ; Save these regs
STKVAR <COUNT>
MOVE V,MSGBOD(D) ; Point to entire message
MOVE W,MSGBON(D) ; ..
CALL SETSFL ;make sure we are all right
KWDS1: MOVEI T,PATSTR ; String to match
MOVNM W,COUNT ;COMMON COUNT (NEGATIVE)
ADD W,V ;POINTER TO THE END OF THE FIELD
CAMLE W,WTOP ;FIT ?
MOVE W,WTOP ;NO
SUB W,V ;ACTUAL LENGHT
ADDM W,COUNT ;UPDATE COUNT
MOVE A,MSGFAD
IMULI A,5
SUB V,WBOT
ADD V,A
CALL SSEARC ; Check for this string
SKIPA
RET ; Found
SKIPN W,COUNT ; Not found
RETSKP ;AND NOTHING TO SEARCH FOR
MOVN W,W ;NEW COUNT
MOVE V,WTOP ;NOW BEGIN FROM THE TOP
SUBI V,40 ;A LITTLE BACK UP
CALL REMAP ;REMAP
JRST KWDS1 ;AND LOOK MORE
; Get date-time arg for "before" and "since" keywords
STQTMB: MOVEI X,NXTTMB ; Rountine addrs
MOVEI A,DEFTMB ; Date/time parse
JRST STQTIM
STQTMS: MOVEI X,NXTTMS ; Routine addrs
MOVEI A,DEFTMS ; Date/time parse
STQTIM: PUSH P,A ; Save arg
NOISE (Date and Time)
POP P,A ; Restore arg
CALL RFIELD
MOVEM B,COMPDT ; Save it for compare
MOVE A,X ; Copy routine to a
JRST STQDL0 ; Common exit
DEFTMB: FLDDB1 (.CMTAD,CM%SDH,<CM%IDA!CM%ITM!TOPS10<CM%PST>>,<-1,,TMBTXT>,,DEFTIM)
DEFTMS: FLDDB1 (.CMTAD,CM%SDH,<CM%IDA!CM%ITM!TOPS10<CM%PST>>,<-1,,TMSTXT>,,DEFTIM)
DEFTIM: FLDDB1 (.CMTAD,CM%SDH,<CM%IDA!TOPS10<CM%PST>>,,,[FLDDB1 (.CMTAD,CM%SDH,<CM%ITM!TOPS10<CM%PST>>)])
TMBTXT: ASCIZ \Date and Time:
Only messages with date-times prior to the specified
date and time will be used.\
TMSTXT: ASCIZ \Date and Time:
Only messages with date-times greater than or equal to the
specified date and time will be used.\
; Compare date/time
NXTTMB: SKIPA C,[CAMLE B,MSGDAT(D)]
NXTTMS: MOVE C,[CAMG B,MSGDAT(D)]
MOVE B,COMPDT ; Date/time to compare against
JRST NXTAL0 ; Use common rountine
; Print out sequence
PRTSEQ: SKIPGE A,LSTMSG ; Any last message?
JRST PRTSQ3 ; No, install this one then
CAIE M,-1(A) ; Yes, is this next or previous?
CAIN M,1(A) ; ..
JRST PRTSQ2 ; Yes, keep accumulating
CALL PRTSQS ; Print what is there now otherwise
PRTSQ1: HRLM M,LSTMSG ; And set ourselves up as start
PRTSQ2: HRRM M,LSTMSG ; Set ourselves up as next link in chain
RET
PRTSQ3: TXZ F,F%CMA ; Reset comma flag
JRST PRTSQ1
PRTSQS: SKIPGE LSTMSG ; Any messages selected at all?
JRST [ WARN <No messages match this specification>
RET]
TXOE F,F%CMA ; Maybe a comma first
$TEXT (KBFTOR,<,^A>)
HLRZ A,LSTMSG ; Start of sequence
ADDI A,1 ; Make real message number
$TEXT (KBFTOR,< ^D/A/^A>)
HRRZ B,LSTMSG ; End of sequence
CAIN A,1(B) ; Same (ie., sequence of one)?
JRST PRTSQ0 ; Yes, quit
ADDI B,1 ; Actual is 1 more than LSTMSG
$TEXT (KBFTOR,<:^D/B/^A>)
PRTSQ0: $CALL K%FLSH ; This can be slow, so say something
RET ; Return
; Get next messages
NXTSEQ: PUSH P,L ; Save msg pointer
ILDB A,L ; Get next byte
CAIE A,777777 ; End?
JRST NXTSQ0 ; No, return msg number in M
POP P,L ; Yes, restore L to prevent running past fence
RET ; Yes,single return
NXTSQ0: POP P,M ; Adjust stack
MOVEI M,(A) ; No, this is next message
RETSKP ; Skip return
NXTSQ1: MOVEI M,(A) ; No, this is next message
RETSKP ; Skip return
;Routines to select messages based on message flag bits.
; These routines need not parse the messages (unless a match is found,
; in which case GTSQNR will parse them.)
NXTANS: SKIPA B,[M%RPLY] ; Answered
NXTOLD: MOVX B,M%SEEN ; Old := seen bit set
JRST NXTDL0
NXTFLG: SKIPA B,[M%ATTN] ; Flagged
NXTDEL: MOVX B,M%DELE ; Deleted
NXTDL0: MOVE C,[TDNE B,MSGBTS(D)] ; Bit must be set
JRST NXTAL4
NXTUNA: SKIPA B,[M%RPLY] ; Unanswered
NXTUNF: MOVX B,M%ATTN ; Unflagged
JRST NXTUD0
NXTNEW: SKIPA B,[M%SEEN] ; New := seen bit clear
NXTUND: MOVX B,M%DELE ; Undeleted
NXTUD0: MOVE C,[TDNN B,MSGBTS(D)] ; Bit must be clear
NXTAL4: MOVEI A,1(M) ; Start here
NXTAL5: CAMLE A,LASTM ; Done?
JRST NXTEND ; Yes, see if any found
GTMBL (A,D) ; Get ptr to message block
XCT C ; Test this message
JRST NXTSQ1 ; Matches -- add to list
AOJA A,NXTAL5 ; No match, check next
;If selecting messages based on contents, must insure that the
; message is parsed before calling selection routine
NXTALL: MOVSI C,(<JFCL>) ; All := pass all thru
NXTAL0: MOVEI A,1(M) ; Start here
NXTAL1: CAMLE A,LASTM ; Done?
JRST NXTEND ; Check if any done
PUSH P,E
GTMBL (A,D) ; Get ptr to message block
MOVX E,M%VALI ; Valid info for this msg?
TDNN E,MSGBTS(D) ; If not, must parse it before testing it
JRST [ EXCH A,M ; Msg to parse is c(A)
PUSH P,C ; Save test instruction
CALL PRSMSG ; Go parse it
POP P,C
EXCH A,M ; Restore ACs
JRST .+1] ; Go test it now
POP P,E
XCT C ; Test it out
JRST NXTSQ1 ; Matches
AOJA A,NXTAL1 ; No good, try next one
NXTEND: JUMPGE M,R ; Ok if not -1
HRRZ M,SAVEM ; else restore prior current msg
RET
NXTREV: JUMPGE M,NXTRV1 ; First time here?
HRRZ A,LASTM ; Yes - start at end
JRST NXTSQ1
NXTRV1: MOVEI A,(M) ; Try next
SOJGE A,NXTSQ1 ; Keep going till all done
RET
;Form message sequence of messages related to current one
;Return +1: no related messages found
; +2: related messages found and sequence stored
RELSEQ: TRVAR <MIDX,THISL,THISM>
MOVEM L,THISL ; Save current sequence pointer
MOVEM M,THISM ; Save current M
GTMBL (M,B) ; Get ptr to message block
MOVEM B,MIDX ; Save in safe place
MOVX A,M%VALI ; Insure we've got valid information
TDNN A,MSGBTS(B) ; for this message
CALL PRSMS0 ; ..
MOVE B,MIDX ; Get index back
SKIPN V,MSGREF(B) ; Any 'Reference:' field?
JRST RELSQ0 ; No, go check for replies to this then
MOVE W,MSGRFN(B) ; Yes, get its length
CALL FEQMID ; Find equal message-ID's
RELSQ0: MOVE B,MIDX ; Restore Msg index, clobbered by FEQMID
SKIPN V,MSGMID(B) ; Does this message have a message-ID?
JRST RELSQX ; Doesn't have one, all done
MOVE W,MSGMIN(B) ; Yes, get its length
MOVE M,THISM ; Restore M for FEQREF
CALL FEQREF ; Find equal reference fields
RELSQX: MOVE M,THISM ; Restore M
CAMN L,THISL ; Any messages added to sequence?
RET ; No, failure return
RETSKP
;FEQMID - Find message-ID's with equal contents to string
;FEQREF - Find references with equal contents to string
;Recurses up-level to RELSEQ to find messages related to messages related to...
;Call:
; V/ character address of test string
; W/ length of test string
;Return +1: always, messages added to sequence via IDPB M,L
FEQMID: MOVEI A,MSGMID ; Load address of field we're searching
MOVEI B,MSGMIN ; and its length
JRST FEQ0 ; Go join common code
FEQREF: MOVEI A,MSGREF ; Same for reference field
MOVEI B,MSGRFN ; ..
FEQ0: TRVAR <VW2,<MN2,2>,BADR,BLEN,MM>
MOVEM W,VW2 ; Save pointer and length to test string
DMOVEM A,MN2 ; and pointers to ptr and length of object
MOVEM M,MM ;STORE MESSAGE NUMBER
;NOW MOVE TEST STRING
MOVE A,W ;SIZE OF TEST STRING
ADDI A,5
IDIVI A,5 ;IN WORDS
MOVEM A,BLEN
$CALL M%GMEM ;GET MEMORY
JUMPF [WARN (SHORTAGE OF MEMORY IN FEQMID)
RET]
MOVEM B,BADR ;STORE THE ADRESS
ADD B,[POINT 7,0]
EQQ1: CALL GTBFL
AOS V
IDPB A,B ;MOVE BYTE
SOJG W,EQQ1 ;LOOP UNTIL DONE
SETZ M, ; Scan all messages
EQFSQ0: CAME M,MM ;DON'T CHECK ITSELF
CALL CHKPRS ; Check for presence of this msg already
JRST EQFSQ2 ; Already present, don't recurse infinitely
CAMN M,HEADNR ;DON'T CHECK ROOT NUMBER
JRST EQFSQ2
MOVX A,M%VALI ; Have valid data for this message yet?
GTMBL (M,B) ; Get ptr to message block
TDNN A,MSGBTS(B) ; ..
CALL PRSMS0 ; No, go parse it then
DMOVE A,MN2 ; Get ptr and length for MSGMID/MSGREF
PUSH P,A
GTMBL (M,A) ; Get ptr to message block
ADD A,(P) ; Index to current message
ADJSP P,-1
SKIPN V,(A) ; Get appropriate character pointer
JRST EQFSQ2 ; Doesn't have one, so skip it
PUSH P,B
GTMBL (M,B) ; Get ptr to message block
ADD B,(P) ; Index to current message
ADJSP P,-1
SKIPN D,(B) ; Get length of object string
JRST EQFSQ2 ; Zero length, skip this
MOVE W,VW2 ; Get length of test string
CAMLE W,D ; Use MIN of object length and test length
MOVE W,D ; ..
MOVE D,BADR
ADD D,[POINT 7,0] ;CHAR POINTER
EQFSQ1: CALL GTBFL ; Get character of header contents
AOS V
ILDB B,D ; Get character of test string
CAME A,B ; Matching?
JRST EQFSQ2 ; No, skip this message then
SOJG W,EQFSQ1 ; Yes, do for all chars in test string
IDPB M,L ; This message matches, add to sequence
CALL CHKL ;CHECK THE RANGE
CALL RELSEQ ; Now add msgs related to this one, recursively
JFCL ; Don't care if none found here
EQFSQ2: CAME M,LASTM ; At last message?
AOJA M,EQFSQ0 ; Not yet, keep going
MOVE A,BLEN
MOVE B,BADR
$CALL M%RMEM
RET ; Yes, return
;CHECK TO SEE IF THERE IS MEMORY TO STORE 1 ELEMENT
CHKL: PUSH P,L
MOVEI L,1
ADJBP L,(P) ;EVALUATING I
TLZ L,777777 ;ADRESS
CAIN L,MSGSQE ;LAST WORD ?
JRST NOMEM ;YES, ALARM
POP P,L
RET ;RETURN
NOMEM: MOVE A,MSGSEQ
CAIE A,MSGSSQ ;ARE WE AT THE VERY BEGINNING ?
JRST [ PUSH P,F ;NO
JSP F,RESMSQ ;RESTORE CONTEXT
POP P,F
JRST .+1]
;**;[3107] Change 1 line at NOMEM+6 Ned 9-Sep-88
CMERR <ADDRESS SPACE TO STORE SEQUENCE EXHAUSTED>
JRST CMDER1 ;AND GO TO THE START
;Check to see if a message, M, is already in the list
;Return +1: already present
; +2: not there yet
CHKPRS: MOVE D,MSGSEQ
ADD D,[POINT 18,0]
CHKPR0: CAMN D,L ; Reached end of list yet?
JRST RSKP ; Yes, give good return
ILDB A,D ; No, get next message number
CAME A,M ; Is this message it?
JRST CHKPR0 ; No, keep looking
RET ; Yes, give nonskip return
;SEQUENCE SAVE/RESTORE ROUTINES
;SAVE MESSAGE SEQUENCE
SAVMSQ: TRVAR <<SAVLM,2>,SAVPRI,SVLCNT>
DMOVEM L,SAVLM ; Save current read mode context L,M
MOVE A,PRIORM ; ..
MOVEM A,SAVPRI ; ..
MOVE A,LCNT ; Save count of msgs in this sequence
MOVEM A,SVLCNT ; ..
JUMPE A,RRR ; If no msgs to save, don't!
ADDI A,2 ;NO,COMPUTE BLOCK LENGHT
ASH A,-1 ;IN WORDS
MOVE B,MSGSEQ ;SEQUENCE START ADRESS
ADD A,B ;NEXT SEQUENCE START ADRESS
CAIL A,MSGSQE ;NO MEMORY ?
JRST NOMEM ;NO ANYMORE
MOVEM A,MSGSEQ ;SAVE ITS ADRESS
RRR: JRST (F) ;RETURN
;RESTORE MESSAGE SEQUENCE
RESMSQ: MOVE A,SVLCNT ; Get count of saved messages
MOVEM A,LCNT ; Restore
JUMPE A,RES1 ; If none, this is easy
ADDI A,2 ;NO,COMPUTE BLOCK LENGHT
ASH A,-1 ;IN WORDS
MOVE B,MSGSEQ ;GET ITS ADRESS
SUB B,A ; Compute BLT fence
MOVEM B,MSGSEQ ; RESTORE message sequence
RES1: MOVE A,SAVPRI ;; ..
MOVEM A,PRIORM ;; ..
DMOVE L,SAVLM ;; ..
JRST (F) ;DONE
END
; Edit 2452 to MSSEQ.MAC by MAYO on 18-Oct-85
; "verb SAME" shouldn't always claim %No previous sequence exists
; *** Edit 2486 to MSSEQ.MAC by PRATT on 22-Nov-85
; Copyright statements
; *** Edit 2494 to MSSEQ.MAC by MAYO on 5-Dec-85
; Add NEXT n for commands like READ, SUMMAR, etc.
; *** Edit 2601 to MSSEQ.MAC by MAYO on 5-Dec-85
; Allow number:NEXT n to do useful things.
; Edit= 3107 to MSSEQ.MAC on 23-Sep-88 by SANTEE
;Address was spelled incorrectly.