home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Internet Tools 1993 July / Internet Tools.iso / RockRidge / mail / pine / imap-3.0 / mapser / mapser.mac < prev    next >
Encoding:
Text File  |  1990-04-02  |  110.0 KB  |  4,367 lines

  1.     TITLE MAPSER TOPS-20 Interactive Mail Access Protocol server
  2.     SUBTTL Written by Mark Crispin
  3.  
  4. ; Version components
  5.  
  6. MAPWHO==0            ; who last edited MAPSER (0=developers)
  7. MAPMAJ==7            ; MAPSER's release version (matches monitor's)
  8. MAPMIN==0            ; MAPSER's minor version
  9. MAPEDT==^D352            ; MAPSER's edit version
  10.  
  11.     SEARCH MACSYM,MONSYM    ; system definitions
  12. IFNDEF OT%822,OT%822==:1B35    ; in case old monitor
  13.     SALL            ; suppress macro expansions
  14.     .DIRECTIVE FLBLST    ; sane listings for ASCIZ, etc.
  15.     .TEXT "/NOINITIAL"    ; suppress loading of JOBDAT
  16.     .TEXT "MAPSER/SAVE"    ; save as MAPSER.EXE
  17.     .TEXT "/SYMSEG:PSECT:CODE" ; put symbol table and patch area in CODE
  18.     .TEXT "/REDIRECT:CODE"    ; put MACREL in CODE
  19.     .TEXT "/PVBLOCK:PSECT:PDV" ; put PDV's in PDV
  20.     .REQUIRE SYS:MACREL    ; MACSYM support routines
  21.     .REQUIRE SYS:HSTNAM    ; host name support routines
  22.  
  23. ;  MAPSER is the server to access electronic mail from another system via
  24. ; a network.  It implements the server half of IMAP2 (Interactive Mail Access
  25. ; Protocol 2), the electronic mail access protocol defined by Mark Crispin in
  26. ; RFC 1064, and documented online on the Internet as:
  27. ;    [NIC.DDN.MIL]RFC:RFC1064.TXT
  28. ;
  29. ;  MAPSER also implements the read-only/read-write notification, FIND, BBOARD,
  30. ; and VERSION extensions.
  31. ;
  32. ;  While nominally MAPSER will be used layered on top of the DoD transport
  33. ; protocols (TCP/IP) in the Internet environment, it has been designed so
  34. ; that this is not necessary.  All I/O is done via primary I/O, and the
  35. ; Internet system call dependencies have been kept to a minimum so that the
  36. ; server can essentially support any network.
  37. ;
  38. ;  MAPSER runs on TOPS-20 release 6.1 and later monitors on model B CPU's
  39. ; only.
  40.     SUBTTL Definitions
  41.  
  42. IFNDEF PDVORG,<PDVORG==1,,1000>    ; PDV's on page 1001
  43. IFNDEF CODORG,<CODORG==1,,2000> ; code on page 1002
  44. IFNDEF DATORG,<DATORG==1,,30000> ; data on page 1030
  45. IFNDEF PRVSEC,<PRVSEC==2>    ; first of two private data sections
  46. IFNDEF MBXSEC,<MBXSEC==PRVSEC+2> ; mailbox section
  47. IFNDEF MBXSCN,<MBXSCN==37-MBXSEC> ; number of mailbox buffer sections
  48. IFNDEF TIMOCT,<TIMOCT==^D<12*60>> ; number of 5-second ticks before autologout
  49. IFNDEF LOGMAX,<LOGMAX==5>    ; maximum number of login tries
  50. IFNDEF TXTLEN,<TXTLEN==^D10000>    ; length of a text line
  51. IFNDEF ARGLEN,<ARGLEN==^D39>    ; length of a string argument
  52. IFNDEF HSTNML,<HSTNML==^D64>    ; length of a host name
  53. IFNDEF UXPAG,<UXPAG==20>    ; page number of date vector in index file
  54.     UXADR==UXPAG*1000    ; address of date vector
  55.  
  56. MAPVER==<FLD MAPWHO,VI%WHO>!<FLD MAPMAJ,VI%MAJ>!<FLD MAPMIN,VI%MIN>!VI%DEC!<FLD MAPEDT,VI%EDN>
  57.  
  58. ; Routines invoked externally
  59.  
  60.     EXTERN $GTLCL,$RMREL
  61.  
  62. ; AC definitions
  63.  
  64. F==:0                ; flags
  65. A=:1                ; JSYS, temporary ACs
  66. B=:2
  67. C=:3
  68. D=:4
  69. CX=:16                ; scratch
  70. P=:17                ; stack pointer
  71.  
  72. ; Flags
  73.  
  74.     MSKSTR F%LOG,F,1B0    ; logged in
  75.     MSKSTR F%REE,F,1B1    ; reenter
  76.     MSKSTR F%NVT,F,1B2    ; on a network terminal, must log out when done
  77.     MSKSTR F%EOL,F,1B3    ; EOL seen
  78.     MSKSTR F%ELP,F,1B4    ; buffer began with EOL
  79.     MSKSTR F%RON,F,1B5    ; read-only file
  80.     MSKSTR F%NCL,F,1B6    ; suppress close parenthesis
  81.     MSKSTR F%BBD,F,1B7    ; BBOARD vs. SELECT comand
  82.  
  83. ; Substitute TMSG
  84.  
  85. DEFINE TMSG (STRING) <
  86.     HRROI A,[ASCIZ ~STRING~]
  87.     PSOUT%
  88. >;DEFINE TMSG
  89.  
  90. DEFINE TAGMSG (STRING) <
  91.     CALL DMPTAG
  92.     TMSG <STRING>
  93. >;DEFINE TAGMSG
  94.  
  95. ; Here's a macro that really should be in MACSYM!
  96.  
  97. DEFINE ANNJE. <..TAGF (ERJMP,)>
  98.  
  99. ; Fatal assembly error macro
  100.  
  101. DEFINE .FATAL (MESSAGE) <
  102.  PASS2
  103.  PRINTX ?'MESSAGE
  104.  END
  105. >;DEFINE .FATAL
  106.  
  107. .CHLPR==:"("            ; work around various macro lossages
  108. .CHRPR==:")"
  109. .CHLAB==:"<"
  110. .CHRAB==:">"
  111.     SUBTTL Impure storage
  112.  
  113.     .PSECT DATA,DATORG    ; enter data area
  114.  
  115. WINDOW:    BLOCK 2000        ; 2 page window for mapping flags
  116.     WINPAG==WINDOW/1000    ; first window page
  117. INDEX:    BLOCK 1000        ; window for mapping index file
  118.     IDXPAG==INDEX/1000
  119.     SEQLSN==1000
  120. SEQLST:    BLOCK SEQLSN        ; message sequence list
  121.     MAXMGS==<.-SEQLST>*^D36    ; maximum number of messages
  122. FATACS:    BLOCK 20        ; save of fatal AC's
  123. PDL:    BLOCK <PDLLEN==:600>    ; stack
  124. FRKS:    BLOCK <FKSLEN==4>    ; readin area for GFRKS%
  125. CMDBUF:    BLOCK <TXTLEN/5>+1    ; command buffer
  126. CMDCNT:    BLOCK 1            ; free characters in command buffer
  127. TAGCNT:    BLOCK 1            ; count of tag character in command
  128. IN2ACS:    BLOCK 3            ; save area for ACs A-C, level 2
  129. LEV1PC:    BLOCK 2            ; PSI level 1 PC
  130. LEV2PC:    BLOCK 2            ; PSI level 2 PC
  131. LEV3PC:    BLOCK 2            ; PSI level 3 PC
  132. TIMOUT:    BLOCK 1            ; timeout count
  133. LOGCNT:    BLOCK 1            ; login failure count
  134. ATOM:    BLOCK 1            ; atomic argument for search
  135. FSFREE:    BLOCK 1            ; first free storage free location
  136.  
  137. INICBG==.            ; first location cleared at once-only init
  138. MBXJFN:    BLOCK 1            ; JFN on currently SELECTed mailbox
  139. MBXBSZ:    BLOCK 1            ; size of mailbox in bytes
  140. MBXMGS:    BLOCK 1            ; number of messages in mailbox
  141. MBXNMS:    BLOCK 1            ; number of new messages in mailbox
  142. MBXRDT:    BLOCK 1            ; last reference of mailbox
  143. IDXJFN:    BLOCK 1            ; index JFN on currently SELECTed mailbox
  144. IDXADR:    BLOCK 1            ; address within index
  145. LGUSRN:    BLOCK 1            ; login user number
  146. LGDIRN:    BLOCK 1            ; login user directory
  147. LGUSRS:    BLOCK 10        ; login user string
  148. MYUSRN:    BLOCK 1            ; my user number
  149.     ; Following two lines must be in this order
  150. MYJOBN:    BLOCK 1            ; my job number
  151. MYTTYN:    BLOCK 1            ; my TTY number
  152.     ; end of critical order data
  153.  
  154. REQID=='MM'            ; request ID for ENQ%'ing
  155. ENQBLS==1            ; number of ENQ% blocks
  156. ENQBLL==ENQBLS*<.ENQMS+1>    ; length of ENQ% block
  157. ENQBLK:    BLOCK ENQBLL        ; block for ENQ%'ing
  158. LCLHST:    BLOCK <HSTNML/5>+1    ; local host name
  159.  
  160.  NFLAGS==^D36            ; number of flags
  161.  NFLINI==^D6            ; number of initial flags
  162.  NKYFLG==NFLAGS-NFLINI        ; number of keyword flags
  163. FLGTAB:    BLOCK NFLAGS        ; table of flag strings indexed by flag number
  164. FLGBUF:    BLOCK <TXTLEN/5>+1    ; buffer for keyword flags
  165.  
  166. INICEN==.-1            ; last location cleared at once-only init
  167.  
  168. ; Following data block must be the last in this PSECT
  169.  
  170. MSG1:!
  171. MSGIPT:    BLOCK 1            ; pointer to internal header for message #1
  172. MSGPTR:    BLOCK 1            ; pointer for message #1
  173. MSGTAD:    BLOCK 1            ; date/time for message #1
  174. MSGSIZ:    BLOCK 1            ; length in bytes of message #1
  175. MSGHSZ:    BLOCK 1            ; length in bytes of header of message #1
  176. MSGFLG:    BLOCK 1            ; flags for message #1
  177. MSGENV:    BLOCK 1            ; pointer to envelope for message
  178. MSGLEN==.-MSG1            ; length of a message data block
  179.     BLOCK <MAXMGS*MSGLEN>    ; space for many many messages
  180.  
  181.     .ENDPS
  182.  
  183.     .PSECT BUFSEC,<PRVSEC,,0>
  184. ARGBUF:    BLOCK <ARGBSZ==300000>    ; argument buffer
  185. WRKBUF:    BLOCK <AR2BSZ==100000>    ; work buffer
  186. OUTBFR:    BLOCK <1000000-<ARGBSZ+AR2BSZ>> ; output buffer
  187.     .ENDPS
  188.  
  189.     .PSECT FREE,<<PRVSEC+1>,,0>
  190.     BLOCK 777777        ; free storage
  191.     .ENDPS
  192.  
  193.     .PSECT MBXBUF,<MBXSEC,,0>
  194.     BLOCK 1            ; mailbox buffer
  195.     .ENDPS
  196.     SUBTTL Start of program
  197.  
  198.     .PSECT CODE,CODORG    ; pure code
  199.  
  200. MAPSER:    TDZA F,F        ; clear flags
  201. MAPREE:     MOVX F,F%REE
  202.     RESET%            ; flush all I/O
  203.     MOVE P,[IOWD PDLLEN,PDL] ; init stack context
  204.     SETZM INICBG        ; clear once-only area
  205.     MOVE A,[INICBG,,INICBG+1]
  206.     BLT A,INICEN
  207.     MOVE A,[FREE]        ; initialize free storage pointer
  208.     MOVEM A,FSFREE
  209.     MOVNI A,TIMOCT        ; reset timeout count
  210.     MOVEM A,TIMOUT
  211.     MOVNI A,LOGMAX        ; reset logout count
  212.     MOVEM A,LOGCNT
  213.     MOVE A,[FLGINI,,FLGTAB+NKYFLG] ; copy initial flags
  214.     BLT A,FLGTAB+NKYFLG+NFLINI-1
  215.     SETZ A,            ; create private section
  216.     MOVE B,[.FHSLF,,PRVSEC]    ; this process,,our private sections
  217.     MOVX C,SM%RD!SM%WR!2    ; read/write access
  218.     SMAP%
  219.      ERCAL FATAL
  220.     CALL SETPSI        ; set up PSIs
  221.  
  222. ; Get host info
  223.  
  224.     HRROI A,LCLHST        ; get local host name
  225.     CALL $GTLCL
  226.     IFNSK.
  227.       TMSG <* BYE Unable to get local host name>
  228.       JRST IMPERR
  229.     ENDIF.
  230.     HRROI A,LCLHST        ; remove relative domain from name we got
  231.     CALL $RMREL
  232.  
  233. ;  See if top-level fork, and if so assume we're a network server on an NVT.
  234. ; Note that all I/O is done via primary I/O.  This allows several ways we can
  235. ; be set up, e.g.:
  236. ; . traditional CRJOB% style running as a job on an NVT
  237. ; . on a physical terminal, as in a "TTY network" environment
  238. ; . with primary I/O remapped to the network JFN's
  239.  
  240.     GJINF%            ; get job info
  241.     MOVEM A,MYUSRN        ; save my user number
  242.     DMOVEM C,MYJOBN        ; save job number/TTY number for later use
  243.     IFGE. D            ; can be NVT server only if attached
  244.       MOVX A,.FHSLF        ; see what my primary I/O looks like.  If
  245.       GPJFN%        ;  AC2 isn't -1 (.CTTRM,,.CTTRM), then we
  246.       ..TAGF (<AOJN B,>,)    ;  can assume setup process init'd TTY
  247.       MOVX A,.FHTOP        ; top fork
  248.       SETZ B,        ; no handles or status
  249.       MOVE C,[-FKSLEN,,FRKS] ; fork structure area
  250.       GFRKS%        ; look at fork structure
  251.        ERJMP .+1        ; ignore error (probably GFKSX1)
  252.       HRRZ A,FRKS+1        ; get the top fork's handle
  253.       CAIE A,.FHSLF        ; same as me?
  254.       IFSKP.
  255.         MOVX A,.PRIIN    ; set terminal type to ideal
  256.         MOVX B,.TTIDL
  257.         STTYP%
  258.         MOVE B,[TT%MFF!TT%TAB!TT%LCA!TT%WKF!TT%WKN!TT%WKP!TT%WKA!<FLD .TTASC,TT%DAM>!<FLD .TTLDX,TT%DUM>]
  259.         SFMOD%        ; has formfeed, tab, lowercase, all wakeup,
  260.         STPAR%        ;  no translate ASCII, line half-duplex
  261.         DMOVE B,[BYTE (2)2,2,2,0,2,2,2,2,2,2,2,2,2,2,2,2,2,2
  262.              BYTE (2)2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2]
  263.         SFCOC%        ; disable all echoing on controls
  264.         MOVX A,TL%CRO!TL%COR!TL%SAB!.RHALF ; break and refuse links
  265.         MOVX B,.RHALF
  266.         TLINK%
  267.          ERCAL FATAL
  268.         MOVX A,.PRIIN    ; refuse system messages
  269.         MOVX B,.MOSNT
  270.         MOVX C,.MOSMN
  271.         MTOPR%
  272.          ERCAL FATAL
  273.         MOVE A,[SIXBIT/MAPSER/] ; set our name
  274.         SETNM%
  275.         MOVX A,.PRIIN    ; clear possible crud in our input buffer
  276.         CFIBF%        ;  from an earlier connection
  277.          ERJMP .+1
  278.         TQO F%NVT        ; flag an NVT server
  279.       ENDIF.
  280.     ENDIF.
  281.  
  282. ; Output banner
  283.  
  284.     TMSG <* OK >        ; start banner
  285.     HRROI A,LCLHST        ; output host name
  286.     PSOUT%
  287.     TMSG < Interactive Mail Access Protocol server >
  288.     MOVX A,.PRIOU        ; set up for primary output
  289.     LOAD B,VI%MAJ,EVEC+2    ; get major version
  290.     MOVX C,^D8        ; octal output for all version components
  291.     NOUT%
  292.      ERCAL FATAL
  293.     LOAD B,VI%MIN,EVEC+2    ; get minor version
  294.     IFN. B            ; ignore if no minor version
  295.       MOVX A,"."        ; output delimiting dot
  296.       PBOUT%
  297.       MOVX A,.PRIOU        ; now output the minor version
  298.       NOUT%
  299.        ERCAL FATAL
  300.     ENDIF.
  301.     LOAD B,VI%EDN,EVEC+2    ; get edit version
  302.     IFN. B            ; ignore if no edit version
  303.       MOVX A,.CHLPR        ; edit delimiter
  304.       PBOUT%
  305.       TMNE VI%DEC,EVEC+2    ; decimal version?
  306.        MOVX C,^D10        ; yes, use decimal radix
  307.       MOVX A,.PRIOU        ; now output the edit version
  308.       NOUT%
  309.        ERCAL FATAL
  310.       MOVX A,.CHRPR        ; edit close delimiter
  311.       PBOUT%
  312.     ENDIF.
  313.     LOAD B,VI%WHO,EVEC+2    ; get who last edited
  314.     IFN. B            ; ignore if last edited at DEC
  315.       MOVX A,"-"        ; output delimiting hyphen
  316.       PBOUT%
  317.       MOVX A,.PRIOU        ; now output the who version
  318.       NOUT%
  319.        ERCAL FATAL
  320.     ENDIF.
  321.     TMSG < at >
  322.     MOVX A,.PRIOU        ; output date/time
  323.     SETO B,            ; time now
  324.     MOVX C,OT%DAY!OT%SPA!OT%TMZ!OT%SCL!OT%822 ; standard date/time
  325.     ODTIM%
  326.      ERCAL FATAL
  327.     SUBTTL Command loop
  328.  
  329.     DO.
  330.       MOVE P,[IOWD PDLLEN,PDL] ; re-init stack context
  331.       CALL CRLF        ; terminate reply with CRLF
  332.       MOVNI A,TIMOCT    ; reset timeout count
  333.       MOVEM A,TIMOUT
  334.       CALL QCHECK        ; do a quick check
  335.        NOP
  336.       SETZM CMDBUF        ; clear out old crud in CMDBUF
  337.       MOVE A,[CMDBUF,,CMDBUF+1]
  338.       BLT A,CMDBUF+<TXTLEN/5>
  339.       HRROI B,CMDBUF    ; pointer to command buffer
  340.       MOVX C,TXTLEN-1    ; up to this many characters
  341.       CALL GETCMD        ; get command
  342.        LOOP.        ; error
  343.       MOVE D,[POINT 7,CMDBUF]
  344.       SETZM TAGCNT        ; init tag count
  345.       DO.            ; search for end of tag
  346.         AOS TAGCNT        ; bump tag count
  347.         ILDB A,D
  348.         CAIE A,.CHSPC
  349.          JUMPN A,TOP.
  350.       ENDDO.
  351.       IFE. A
  352.         TMSG <* BAD Missing tag: >
  353.         CALL DMPCOM
  354.         LOOP.
  355.       ENDIF.
  356.       MOVSI C,-CMDTBL    ; length of command table
  357.       DO.
  358.         HLRO A,CMDTAB(C)    ; point to command string
  359.         MOVE B,D        ; point to start of command
  360.         STCMP%        ; compare strings
  361.         IFN. A        ; found it?
  362.           IFXN. A,SC%SUB    ; if subset
  363.         ILDB A,B    ; get delimiting byte
  364.         CAIN A,.CHSPC    ; was it a space?
  365.          EXIT.        ; won, argument forthcoming
  366.           ENDIF.
  367.           AOBJN C,TOP.    ; try next command
  368.         ENDIF.
  369.       ENDDO.
  370.       HRRO C,CMDTAB(C)    ; get routine address
  371.       CALL (C)        ; dispatch to it
  372.       LOOP.            ; do next command
  373.     ENDDO.
  374.  
  375. ; Get command (or command continuation)
  376. ; Accepts: B/ pointer to buffer
  377. ;       C/ number of available bytes
  378. ;    CALL GETCMD
  379. ; Returns: +1 Error
  380. ;       +2 Success
  381.  
  382. GETCMD:    SAVEAC <A,B,C,D>
  383.     MOVX A,.PRIIN        ; from primary input
  384.     MOVX D,.CHCRT        ; terminate on carriage return
  385.     SIN%            ; read a command
  386.      ERJMP INPEOF        ; finish up on error
  387.     IFE. C            ; if count unsatisfied, must have seen CR
  388.       LDB A,B        ; get last byte
  389.       CAIN A,.CHCRT        ; was it a CR?
  390.     ANSKP.
  391.       TMSG <* BAD Line too long: >
  392.       CALLRET DMPCOM
  393.     ENDIF.
  394.     PBIN%            ; get expected LF
  395.      ERJMP INPEOF        ; finish up on error
  396.     CAIN A,.CHLFD        ; was it a line feed?
  397.     IFSKP.
  398.       MOVE B,A        ; copy loser
  399.       TMSG <* BAD Line does not end with CRLF: >
  400.       MOVX A,.PRIOU        ; output the loser
  401.       MOVX C,^D8        ; in octal
  402.       NOUT%
  403.        ERCAL FATAL
  404.       TMSG < >
  405.       CALLRET DMPCOM
  406.     ENDIF.
  407.     SETZ A,            ; make command null-terminated
  408.     DPB A,B
  409.     MOVEM C,CMDCNT        ; save number of free characters
  410.     RETSKP
  411.     SUBTTL Command table and dispatch
  412.  
  413. DEFINE COMMANDS <
  414.     CMD NOOP
  415.     CMD LOGIN
  416.     CMD LOGOUT
  417.     CMD FIND
  418.     CMD SELECT
  419.     CMD BBOARD
  420.     CMD CHECK
  421.     CMD EXPUNGE
  422.     CMD COPY
  423.     CMD FETCH
  424.     CMD STORE
  425.     CMD SEARCH
  426.     CMD VERSION
  427. >;DEFINE COMMANDS
  428.  
  429. DEFINE CMD (CM) <[ASCIZ/'CM'/],,.'CM>
  430.  
  431. CMDTAB:    COMMANDS        ; command names
  432. CMDTBL==.-CMDTAB
  433.     BADCOM
  434.     SUBTTL Command service routines
  435.  
  436. ; NOOP - no-operation
  437.  
  438. .NOOP:    TAGMSG <OK No-op accepted>
  439.     RET
  440.  
  441.  
  442. ; VERSION - set protocol version
  443.  
  444. .VERSI:    STKVAR <<VERSIO,<<ARGLEN/5>+1>>>
  445.     HRROI A,VERSIO        ; copy version
  446.     MOVX C,ARGLEN+1        ; bounded by this many characters
  447.     CALL ARGCPY
  448.      RET
  449.     JUMPN B,BADARG        ; no arguments after this
  450.     HRROI A,VERSIO        ; parse version
  451.     MOVX C,^D10        ; in decimal
  452.     NIN%
  453.      ERJMP SYNERR
  454.     LDB A,A            ; sniff at terminator
  455.     CAIE A,"."        ; in case this is given
  456.      JUMPN A,SYNERR        ; barf if non-null
  457.     JUMPLE B,SYNERR        ; versions .LE. 0 are bad
  458.     CAIGE B,4        ; versions .GE. 4 are unimplemented
  459.     IFSKP.
  460.       TAGMSG <NO Unsupported version>
  461.       RET
  462.     ENDIF.
  463.     TAGMSG <OK Version accepted>
  464.     RET
  465.  
  466. ; LOGIN - log in to mail service
  467.  
  468. .LOGIN:    STKVAR <<ACCBLK,.ACJOB+1>,<USRNAM,<<ARGLEN/5>+1>>,<PASSWD,<<ARGLEN/5>+1>>>
  469.     IFQN. F%LOG        ; make sure not doing this twice
  470.       TAGMSG <NO Already logged in>
  471.       RET
  472.     ENDIF.
  473.     JUMPE A,MISARG        ; error if no username
  474.     HRROI A,USRNAM        ; copy user name string
  475.     MOVX C,ARGLEN+1        ; bounded by this many characters
  476.     CALL ARGCPY
  477.      RET
  478.     JUMPE B,MISARG        ; error if no password
  479.     HRROI A,PASSWD        ; copy password string
  480.     MOVX C,ARGLEN+1        ; bounded by this many characters
  481.     CALL ARGCPY
  482.      RET
  483.     JUMPN B,BADARG        ; error if subsequent argument
  484.     MOVX A,RC%EMO        ; require exact match
  485.     HRROI B,USRNAM
  486.     RCUSR%            ; parse user name string
  487.     IFJER.
  488.       TAGMSG <NO Error in user name>
  489.       CALLRET ERROUT
  490.     ENDIF.
  491.     IFXN. A,RC%NOM!RC%AMB    ; bogus name?
  492.       TAGMSG <NO Invalid user name>
  493.       RET
  494.     ENDIF.
  495.     MOVEM C,LGUSRN        ; save login user number
  496.     SETZ A,            ; get PS: directory of user in C
  497.     MOVE B,LGUSRN
  498.     RCDIR%
  499.      ERCAL FATAL        ; can't fail
  500.     MOVEM C,LGDIRN        ; save login directory
  501.  
  502. ; Now try to log in
  503.  
  504.     SKIPN MYUSRN        ; is job already logged in?
  505.     IFSKP.
  506.       MOVEM C,.ACDIR+ACCBLK    ; directory number to check
  507.       HRROI C,PASSWD    ; password
  508.       MOVEM C,.ACPSW+ACCBLK
  509.       SETOM .ACJOB+ACCBLK    ; this job
  510.       MOVX A,AC%PWD!.ACJOB+1 ; validate password
  511.       XMOVEI B,ACCBLK
  512.       ACCES%
  513.       IFJER.
  514.         AOSGE LOGCNT    ; count up another failing login attempt
  515.         IFSKP.
  516.           TAGMSG <NO Too many login failures, go away>
  517.           JRST IMPERR
  518.         ENDIF.
  519.         TAGMSG <NO Login failed>
  520.         CALLRET ERROUT
  521.       ENDIF.
  522.     ELSE.
  523.       MOVE A,LGUSRN        ; user number to log in as
  524.       HRROI B,PASSWD    ; password
  525.       SETZ C,        ; account
  526.       LOGIN%        ; do the login
  527.       IFJER.
  528.         AOSGE LOGCNT    ; count up another failing login attempt
  529.         IFSKP.
  530.           TAGMSG <NO Too many login failures, go away>
  531.           JRST IMPERR
  532.         ENDIF.
  533.         TAGMSG <NO Login failed>
  534.         CALLRET ERROUT
  535.       ENDIF.
  536.       MOVX A,.FHSLF        ; get my capabilities
  537.       RPCAP%
  538.       IOR C,B        ; enable as many capabilities as we can
  539.       EPCAP%
  540.        ERJMP .+1        ; ignore possible ACJ ITRAP
  541.       MOVE A,LGUSRN        ; we're now logged in
  542.       MOVEM A,MYUSRN    ; so note that fact
  543.     ENDIF.
  544.  
  545. ; Job logged in, report success
  546.  
  547.     TQO F%LOG        ; flag logged in
  548.     TAGMSG <OK User >
  549.     HRROI A,LGUSRS        ; make login user string
  550.     MOVE B,LGUSRN
  551.     DIRST%
  552.      ERCAL FATAL
  553.     HRROI A,LGUSRS        ; output user name
  554.     PSOUT%
  555.     TMSG < logged in at >
  556.     MOVX A,.PRIOU        ; output date/time
  557.     SETO B,            ; time now
  558.     MOVX C,OT%DAY!OT%SPA!OT%TMZ!OT%SCL!OT%822 ; standard date/time
  559.     ODTIM%
  560.      ERCAL FATAL
  561.     TMSG <, job >
  562.     MOVX A,.PRIOU        ; output job number
  563.     MOVE B,MYJOBN
  564.     MOVX C,^D10        ; in decimal
  565.     NOUT%
  566.      ERCAL FATAL
  567.     RET
  568.  
  569.     ENDSV.
  570.  
  571. ; LOGOUT - log out of mail service
  572.  
  573. .LOGOU:    JUMPN A,BADARG        ; must not have an argument
  574.     TMSG <* BYE DEC-20 IMAP server terminating connection
  575. >
  576.     TAGMSG <OK >        ; start acknowledgement
  577.     HRROI A,LCLHST        ; output our host name
  578.     PSOUT%
  579.     TMSG < Interactive Mail Access Protocol server logout>
  580. IMPERR:    CALL CRLF
  581. INPEOF:    CALL CLSMBX        ; close off mailbox
  582.     CALL HANGUP        ; hang up the connection
  583.     JRST MAPSER        ; restart program
  584.  
  585. HANGUP:    MOVX A,.PRIOU        ; wait until the output happens
  586.     DOBE%
  587.      ERJMP .+1
  588.     IFQN. F%NVT        ; NVT server?
  589.       DTACH%        ; detach the job to prevent "Killed..." message
  590.        ERJMP .+1
  591.       SETO A,        ; now log myself out
  592.       LGOUT%
  593.        ERJMP .+1
  594.     ENDIF.
  595.     HALTF%            ; stop
  596.     RET
  597.  
  598. ; FIND - file mailbox/bulletin board names
  599.  
  600. .FIND:    JE F%LOG,,NOTLOG    ; must log in first
  601.     JUMPE A,MISARG        ; must have an argument
  602.     STKVAR <FNDJFN,TMPPTR,<CHKBLK,.CKAUD+1>,<GTJBLK,.GJJFN+1>,<MBXNAM,<<ARGLEN/5>+1>>,<FILBUF,^D60>>
  603.     HRROI A,MBXNAM        ; copy argument type
  604.     MOVX C,ARGLEN+1        ; bounded by this many characters
  605.     CALL ARGCPY
  606.      RET
  607.     JUMPE B,MISARG        ; must have another argument
  608.     MOVEM B,TMPPTR
  609.     HRROI A,MBXNAM        ; see what type it is
  610.     HRROI B,[ASCIZ/MAILBOXES/] ; try mailboxes first
  611.     STCMP%
  612.     IFN. A            ; if no match
  613.       HRROI A,MBXNAM    ; try BBoards
  614.       HRROI B,[ASCIZ/BBOARDS/]
  615.       STCMP%        ; well?
  616.       JUMPN A,BADCOM    ; sorry
  617.       TQO F%BBD        ; hunt through BBoards
  618.     ELSE.
  619.       TQZ F%BBD        ; mailbox
  620.     ENDIF.
  621.     HRROI A,MBXNAM        ; copy mailbox
  622.     MOVE B,TMPPTR
  623.     MOVX C,ARGLEN+1        ; bounded by this many characters
  624.     CALL ARGCPY
  625.      RET
  626.     JUMPN B,BADARG        ; no arguments after this
  627.  
  628. ;  Get file, using POBOX:<loginuser>.TXT as default to user's argument for
  629. ; FIND MAILBOXES command and POBOX:<BBOARD>{arg}.TXT for FIND BBOARDS command
  630.  
  631.     IFQN. F%BBD        ; BBOARD command?
  632.       HRROI A,FILBUF    ; yes, only allow name
  633.       HRROI B,POBOX        ; fill in device name
  634.       SETZ C,
  635.       SOUT%
  636.       HRROI B,[ASCIZ/:</]    ; delimit
  637.       SOUT%
  638.       HRROI B,BBOARD    ; fill in directory name
  639.       SOUT%
  640.       MOVX B,.CHRAB        ; delimit
  641.       IDPB B,A
  642.       HRROI B,MBXNAM    ; fill in filename
  643.       SOUT%
  644.       MOVX B,"."        ; delimit
  645.       IDPB B,A
  646.       HRROI B,TXT        ; fill in extension
  647.       SOUT%
  648.       HRROI B,[ASCIZ/.1/]    ; and generation
  649.       SOUT%
  650.       MOVX A,GJ%OLD!GJ%IFG!GJ%SHT ; require extant file, wildcards, short
  651.       HRROI B,FILBUF
  652.     ELSE.
  653.       MOVX A,GJ%OLD!GJ%IFG!1 ; require extant file, wildcards, gen 1
  654.       MOVEM A,.GJGEN+GTJBLK
  655.       MOVE A,[.NULIO,,.NULIO] ; only use the string
  656.       MOVEM A,.GJSRC+GTJBLK
  657.       HRROI A,POBOX        ; default device
  658.       MOVEM A,.GJDEV+GTJBLK
  659.       HRROI A,LGUSRS    ; will fill this in
  660.       MOVEM A,.GJDIR+GTJBLK
  661.       SETZM .GJNAM+GTJBLK    ; no default filename
  662.       HRROI A,TXT        ; default extension
  663.       MOVEM A,.GJEXT+GTJBLK
  664.       SETZM .GJPRO+GTJBLK    ; no special default protection
  665.       SETZM .GJACT+GTJBLK    ; no special default account
  666.       SETZM .GJJFN+GTJBLK    ; no special JFN
  667.       MOVEI A,GTJBLK    ; long form GTJFN%
  668.       HRROI B,MBXNAM    ; user's argument
  669.     ENDIF.
  670.     GTJFN%
  671.     IFJER.
  672.       TAGMSG <NO Can't FIND anything>
  673.       CALLRET ERROUT
  674.     ENDIF.
  675.  
  676. ; Have JFN, validate access and report it if OK
  677.  
  678.     IFXN. A,GJ%DEV!GJ%UNT!GJ%DIR ; check for possible crackers...
  679.       HRRZ A,FNDJFN        ; flush the JFN
  680.       RLJFN%
  681.        ERJMP .+1
  682.       TAGMSG <NO Can't FIND such a mailbox>
  683.       RET
  684.     ENDIF.
  685.     MOVEM A,FNDJFN
  686.     MOVE B,[OWGP. 7,OUTBFR]    ; initialize buffer pointer
  687.     MOVEM B,TMPPTR
  688.     DO.
  689.       HRRZS A        ; only want JFN
  690.       MOVX B,.CKADL        ; check list access
  691.       MOVEM B,.CKAAC+CHKBLK
  692.       MOVE B,LGUSRN        ; our user number
  693.       MOVEM B,.CKALD+CHKBLK
  694.       MOVE B,LGDIRN        ; login directory is connected
  695.       MOVEM B,.CKACD+CHKBLK
  696.       SETZM .CKAEC+CHKBLK    ; no capabilities enabled
  697.       MOVEM A,.CKAUD+CHKBLK    ; JFN of file to check
  698.       MOVX A,CK%JFN!.CKAUD+1 ; validate access to file given JFN
  699.       XMOVEI B,CHKBLK
  700.       CHKAC%        ; validate access
  701.        ERCAL FATAL
  702.       IFN. A        ; access ok?
  703.         MOVE A,TMPPTR    ; yes, get buffer pointer
  704.         IFQN. F%BBD        ; which sort of FIND?
  705.           HRROI B,[ASCIZ/* BBOARD /]
  706.           CALL BFSOUT
  707.           MOVX C,<FLD .JSAOF,JS%NAM> ; only output filename
  708.         ELSE.
  709.           HRROI B,[ASCIZ/* MAILBOX /]
  710.           CALL BFSOUT
  711.           SETZ C,        ; output full path name
  712.         ENDIF.
  713.         HRRZ B,FNDJFN    ; this file
  714.         JFNS%        ; output name
  715.         HRROI B,[ASCIZ/
  716. /]
  717.         CALL BFSOUT
  718.         MOVEM A,TMPPTR    ; save updated pointer
  719.       ENDIF.
  720.       MOVE A,FNDJFN        ; try for next match
  721.       GNJFN%
  722.       IFNJE. <LOOP.>    ; found one, go do it
  723.     ENDDO.
  724.  
  725. ; Return the results to the user
  726.  
  727.     SETZ C,            ; tie off buffer
  728.     IDPB C,TMPPTR
  729.     MOVX A,.PRIOU        ; now blat the buffer
  730.     MOVE B,[OWGP. 7,OUTBFR]
  731.     SOUT%
  732.      ERJMP .+1
  733.     HRRZ A,FNDJFN        ; flush the JFN
  734.     RLJFN%
  735.      ERJMP .+1
  736.     TAGMSG <OK FIND completed>
  737.     RET
  738.  
  739.     ENDSV.
  740.  
  741. ; SELECT - select a mailbox
  742.  
  743. .SELEC:    TQZA F%BBD        ; not BBOARD command
  744. .BBOAR:     TQO F%BBD        ; BBOARD command
  745.     JE F%LOG,,NOTLOG    ; must log in first
  746.     JUMPE A,MISARG        ; must have an argument
  747.     STKVAR <<CHKBLK,.CKAUD+1>,INIJFN,<GTJBLK,.GJJFN+1>,<MBXNAM,<<ARGLEN/5>+1>>,<FILBUF,^D60>>
  748.     HRROI A,MBXNAM        ; copy mailbox
  749.     MOVX C,ARGLEN+1        ; bounded by this many characters
  750.     CALL ARGCPY
  751.      RET
  752.     JUMPN B,BADARG        ; no arguments after this
  753.     IFQE. F%BBD        ; BBOARD command?
  754.       HRROI A,MBXNAM    ; compare user's argument
  755.       HRROI B,INBOX        ;  with special name INBOX
  756.       STCMP%
  757.     ANDE. A            ; if user wants the INBOX
  758.       MOVE A,MAIL        ; he really wants MAIL.TXT
  759.       MOVEM A,MBXNAM
  760.     ENDIF.
  761.     SKIPE MBXJFN        ; have a mailbox JFN open already?
  762.      CALL CLSMBX        ; yes, close it
  763.  
  764. ;  Get file, using POBOX:<loginuser>.TXT as default to user's argument for
  765. ; SELECT command and POBOX:<BBOARD>.TXT for BBOARD command
  766.  
  767.     MOVX A,GJ%OLD!1        ; require extant file, default gen 1
  768.     MOVEM A,.GJGEN+GTJBLK
  769.     MOVE A,[.NULIO,,.NULIO]    ; only use the string
  770.     MOVEM A,.GJSRC+GTJBLK
  771.     HRROI A,POBOX        ; default device
  772.     MOVEM A,.GJDEV+GTJBLK
  773.     TQNE F%BBD        ; BBOARD command?
  774.      SKIPA A,[-1,,BBOARD]
  775.       HRROI A,LGUSRS    ; will fill this in
  776.     MOVEM A,.GJDIR+GTJBLK
  777.     SETZM .GJNAM+GTJBLK    ; no default filename
  778.     HRROI A,TXT        ; default extension
  779.     MOVEM A,.GJEXT+GTJBLK
  780.     SETZM .GJPRO+GTJBLK    ; no special default protection
  781.     SETZM .GJACT+GTJBLK    ; no special default account
  782.     SETZM .GJJFN+GTJBLK    ; no special JFN
  783.     MOVEI A,GTJBLK        ; long form GTJFN%
  784.     HRROI B,MBXNAM        ; user's argument
  785.     GTJFN%
  786.     IFJER.
  787.       SETZRO .RHALF,.GJGEN+GTJBLK ; try any generation
  788.       MOVEI A,GTJBLK    ; and try the GTJFN again
  789.       HRROI B,MBXNAM
  790.       GTJFN%
  791.       IFJER.
  792.         TAGMSG <NO Can't get mailbox>
  793.         CALLRET ERROUT
  794.       ENDIF.
  795.     ENDIF.
  796.  
  797. ; Have file, validate access
  798.  
  799.     MOVEM A,MBXJFN
  800.     MOVX B,.CKARD        ; first check read access
  801.     MOVEM B,.CKAAC+CHKBLK
  802.     MOVE B,LGUSRN        ; our user number
  803.     MOVEM B,.CKALD+CHKBLK
  804.     MOVE B,LGDIRN        ; login directory is connected
  805.     MOVEM B,.CKACD+CHKBLK
  806.     SETZM .CKAEC+CHKBLK    ; no capabilities enabled
  807.     MOVEM A,.CKAUD+CHKBLK    ; JFN of file to check
  808.     MOVX A,CK%JFN!.CKAUD+1    ; validate access to file given JFN
  809.     XMOVEI B,CHKBLK
  810.     CHKAC%            ; validate access
  811.      ERCAL FATAL
  812.     IFE. A            ; access ok?
  813.       TAGMSG <NO Can't access mailbox>
  814.       MOVE A,MBXJFN        ; flush the JFN
  815.       RLJFN%
  816.        ERJMP .+1
  817.       SETZM MBXJFN        ; and note no file open
  818.       RET
  819.     ENDIF.
  820.     MOVX A,.CKAWR        ; now see if write access
  821.     MOVEM A,.CKAAC+CHKBLK
  822.     MOVX A,CK%JFN!.CKAUD+1    ; validate access to file given JFN
  823.     XMOVEI B,CHKBLK
  824.     CHKAC%             ; validate access
  825.      ERCAL FATAL
  826.     SKIPN A
  827.      TQOA F%RON        ; read-only file
  828.       TQZ F%RON        ; read/write file
  829.  
  830. ; Access OK, open file and seize the lock
  831.  
  832.     MOVE A,MBXJFN
  833.     MOVX B,<1,,.FBREF>    ; get last file read TAD
  834.     XMOVEI C,MBXRDT        ; into this location
  835.     GTFDB%
  836.      ERCAL FATAL
  837.     MOVX B,<<FLD 7,OF%BSZ>!OF%RD> ; now open for read
  838.     OPENF%
  839.     IFJER.
  840.       TAGMSG <NO Can't open mailbox>
  841.       CALL ERROUT
  842.       MOVE A,MBXJFN        ; flush the JFN
  843.       RLJFN%
  844.        ERJMP .+1
  845.       SETZM MBXJFN        ; and note no file open
  846.       RET
  847.     ENDIF.
  848.     MOVX A,<ENQBLS,,ENQBLL>    ; number of locks,,block length
  849.     MOVEM A,ENQBLK+.ENQLN
  850.     MOVX A,REQID        ; PSI channel,,request ID
  851.     MOVEM A,ENQBLK+.ENQID
  852.     MOVX A,EN%SHR!EN%BLN    ; shared access, no level #'s
  853.     HRR A,MBXJFN        ; this file
  854.     MOVEM A,ENQBLK+.ENQLV
  855.     HRROI A,[ASCIZ/Mail expunge interlock/] ; starting pointer
  856.     MOVEM A,ENQBLK+.ENQUC    ; ENQ% lock string
  857.     SETZM ENQBLK+.ENQRS    ; resources/group
  858.     SETZM ENQBLK+.ENQMS    ; resource mask block
  859.     MOVX A,.ENQBL        ; try and get lock, but don't wait
  860.     XMOVEI B,ENQBLK
  861.     ENQ%
  862.      ERCAL FATAL
  863.  
  864. ; If file has an index, grab it and get its date
  865.  
  866.     HRROI A,FILBUF        ; create POBOX:<user>file-name.IDX
  867.     MOVE B,MBXJFN
  868.     MOVX C,<<FLD .JSAOF,JS%DEV>!<FLD .JSAOF,JS%DIR>!<FLD .JSAOF,JS%NAM>!JS%PAF>
  869.     JFNS%            ; dump it
  870.     HRROI B,[ASCIZ/.IDX/]    ; output index's extension
  871.     SETZ C,
  872.     SOUT%            ; copy the .IDX
  873.     MOVX A,GJ%OLD!GJ%SHT    ; see if there's an index file
  874.     HRROI B,FILBUF
  875.     GTJFN%
  876.     IFNJE.
  877.       MOVEM A,IDXJFN
  878.       MOVX B,OF%RD!OF%WR!OF%THW ; now open it, thawed
  879.       OPENF%
  880.       IFJER.
  881.         MOVE A,IDXJFN    ; can't open init, flush JFN
  882.         RLJFN%
  883.          ERJMP .+1
  884.       ELSE.
  885.         HRRZ A,LGUSRN    ; get RH of user number
  886.         ADDI A,UXADR    ; plus well-known offset of BBoard poop
  887.         IDIVI A,1000    ; A/ page number, B/ address in page
  888.         MOVEM B,IDXADR    ; save index address for later
  889.         HRL A,IDXJFN    ; A/ JFN,,page #
  890.         MOVE B,LODIPG    ; B/ process,,page #
  891.         MOVX C,PM%RD!PM%WR    ; want read/write access
  892.         PMAP%        ; seize access
  893.          ERCAL FATAL
  894.         XMOVEI A,INDEX    ; make address pointer absolute
  895.         ADDM A,IDXADR
  896.         MOVE A,@IDXADR    ; get index last read TAD
  897.         IFNJE.
  898.           MOVEM A,MBXRDT    ; use as last file read TAD
  899.         ELSE.
  900.           SETZM IDXADR    ; ugh
  901.         ENDIF.
  902.       ENDIF.
  903.     ENDIF.
  904.  
  905. ; File opened, now attempt to find init file for it
  906.  
  907.     HRROI A,MBXNAM        ; get actual filename
  908.     MOVE B,MBXJFN        ; from JFN
  909.     MOVX C,<FLD .JSAOF,JS%NAM>
  910.     JFNS%
  911.      ERCAL FATAL
  912.     HRROI A,MBXNAM        ; are we reading our MAIL.TXT?
  913.     HRROI B,[ASCIZ/MAIL/]
  914.     STCMP%
  915.     IFN. A            ; if user doesn't wants the INBOX
  916.       HRROI A,FILBUF    ; create POBOX:<directory>file-name.MM-INIT
  917.       MOVE B,MBXJFN
  918.       MOVX C,<<FLD .JSAOF,JS%DEV>!<FLD .JSAOF,JS%DIR>!<FLD .JSAOF,JS%NAM>!JS%PAF>
  919.       JFNS%            ; dump it
  920.       HRROI B,[ASCIZ/.MM-INIT/] ; output init's extension
  921.       SETZ C,
  922.       SOUT%            ; copy the .INIT
  923.       IDPB C,A        ; tie off name with null
  924.       MOVX A,GJ%OLD!GJ%SHT    ; see if there's an init file
  925.       HRROI B,FILBUF
  926.       GTJFN%
  927.     ANNJE.            ; this mailbox has a special init
  928.     ELSE.
  929.       HRROI A,FILBUF    ; MAIL.TXT or special init fails
  930.       MOVE B,MBXJFN        ; create POBOX:<directory>MM.INIT
  931.       MOVX C,<<FLD .JSAOF,JS%DEV>!<FLD .JSAOF,JS%DIR>!JS%PAF>
  932.       JFNS%            ; dump it
  933.       HRROI B,[ASCIZ/MM.INIT/] ; output init's name and extension
  934.       SETZ C,
  935.       SOUT%
  936.       IDPB C,A        ; tie off name with null
  937.       MOVX A,GJ%OLD!GJ%SHT    ; see if there's an init file
  938.       HRROI B,FILBUF
  939.       GTJFN%
  940.        SETZ A,        ; no INIT file at all
  941.     ENDIF.
  942.     IFN. A            ; got an INIT file?
  943.       MOVEM A,INIJFN
  944.       MOVX B,<<FLD 7,OF%BSZ>!OF%RD> ; now open it
  945.       OPENF%
  946.       IFJER.
  947.         MOVE A,INIJFN    ; can't open init, flush JFN
  948.         RLJFN%
  949.          ERJMP .+1
  950.       ELSE.
  951.  
  952. ; Have an init file to parse, do so
  953.  
  954.         DO.
  955.           MOVE A,INIJFN    ; reload JFN
  956.           HRROI B,FLGBUF    ; read in an init file line
  957.           MOVX C,TXTLEN-1    ; up to this many bytes
  958.           MOVX D,.CHCRT    ; terminate on linefeed
  959.           SIN%        ; read a line
  960.            ERJMP ENDLP.    ; finish up
  961.           IFE. C
  962.         LDB C,B        ; get last byte
  963.         CAIE C,.CHCRT    ; was it a CR?
  964.          EXIT.        ; no, line too long, punt this init
  965.           ENDIF.
  966.           SETZ C,        ; null-terminate line
  967.           DPB C,B
  968.           BIN%        ; get expected LF
  969.            ERJMP ENDLP.
  970.           CAIE B,.CHLFD    ; validate it
  971.            EXIT.        ; init file bogus
  972.           HRROI A,[ASCIZ/KEYWORDS/] ; see if KEYWORDS line found
  973.           HRROI B,FLGBUF
  974.           STCMP%
  975.           JXN A,SC%LSS!SC%GTR,TOP. ; line not found
  976.           ILDB A,B        ; get delimiting byte
  977.           CAIE A,.CHSPC    ; expected space?
  978.            EXIT.        ; no -- lose
  979.           SETZ C,        ; start with flag 0
  980.           DO.
  981.             MOVEM B,FLGTAB(C) ; save pointer to flag 0
  982.         DO.
  983.           ILDB A,B    ; get next byte
  984.           CAIE A,","    ; if not comma or null then uninteresting
  985.            JUMPN A,TOP.
  986.         ENDDO.
  987.         JUMPE A,ENDLP.    ; if a null then we're done
  988.         SETZ A,        ; else tie off previous flag
  989.         DPB A,B
  990.         SKIPN FLGTAB+1(C) ; make sure not overwriting system flags
  991.          AOJA C,TOP.    ; and record start of new flag
  992.           ENDDO.
  993.         ENDDO.
  994.         MOVE A,INIJFN    ; now close init JFN
  995.         CLOSF%
  996.          ERJMP .+1
  997.       ENDIF.
  998.     ENDIF.
  999.  
  1000. ; Output list of flags
  1001.  
  1002.     TMSG <* FLAGS (>
  1003.     MOVSI B,-^D36        ; maximum number of flags
  1004.     DO.
  1005.       SKIPN A,FLGTAB(B)    ; get name of this flag if any
  1006.        AOBJN B,TOP.        ; none here, try next (note can't fail here)
  1007.       PSOUT%        ; have one, output it
  1008.       AOBJP B,ENDLP.    ; done if last flag
  1009.       MOVX A,.CHSPC        ; delimit
  1010.       PBOUT%
  1011.       LOOP.            ; do next flag
  1012.     ENDDO.
  1013.     TMSG <)
  1014. >
  1015.  
  1016. ; Map the file in and parse it
  1017.  
  1018.     MOVE A,MBXJFN        ; get JFN
  1019.     CALL FILSIZ        ; return file size
  1020.     MOVEM A,MBXBSZ        ; save number of characters
  1021.     CALL GETMBX        ; finally get the mailbox
  1022.     IFSKP.
  1023.       TAGMSG <OK >
  1024.       IFQN. F%RON        ; read-only file?
  1025.         TMSG <[READ-ONLY] for >
  1026.       ELSE.
  1027.         TMSG <[READ-WRITE] for >
  1028.       ENDIF.
  1029.       MOVX A,.PRIOU        ; output filename
  1030.       MOVE B,MBXJFN
  1031.       MOVX C,JS%SPC        ; entire spec please
  1032.       JFNS%
  1033.        ERCAL FATAL
  1034.       SKIPN IDXJFN        ; indexed file?
  1035.     ANSKP.
  1036.       TMSG <, mailbox is indexed>
  1037.     ENDIF.
  1038.     RET
  1039.  
  1040.     ENDSV.
  1041.  
  1042. ; Message flags
  1043.  
  1044. DEFINE FLAG (STRING) <
  1045.  M%'STRING==:1B<NKYFLG+<.-FLGINI>>
  1046.  -1,,[ASCIZ/\'STRING'/]
  1047. >;DEFINE FLAG
  1048.  
  1049. FLGINI:    FLAG XXXX
  1050.     FLAG YYYY
  1051.     FLAG Answered
  1052.     FLAG Flagged
  1053.     FLAG Deleted
  1054.     FLAG Seen
  1055. IFN <NFLINI-<.-FLGINI>>,<.FATAL Wrong number of initial flags>
  1056.  
  1057. ; CHECK - check for new messages in mailbox
  1058.  
  1059. .CHECK:    JE F%LOG,,NOTLOG    ; must log in first
  1060.     JUMPN A,BADARG        ; must not have an argument
  1061.     SKIPN MBXJFN        ; must have a mailbox open
  1062.      JRST NOMBX
  1063.     CALL FCHECK        ; do a full check
  1064.     IFSKP. <TAGMSG <OK Check completed>>
  1065.     RET
  1066.  
  1067. ; FCHECK is called when the entire mail file should be reparsed
  1068. ; QCHECK is called when nothing should be done if the file size is the same
  1069.  
  1070. FCHECK:    TDZA A,A        ; want a full check
  1071. QCHECK:     SETO A,        ; want a quick check
  1072.     STKVAR <FSTCHK>
  1073.     MOVEM A,FSTCHK        ; save fast check flag
  1074.     SKIPN A,MBXJFN        ; get JFN
  1075.      RETSKP            ; return immediately if none
  1076.     CALL FILSIZ        ; return file size
  1077.     SKIPE FSTCHK        ; want a fast check?
  1078.      CAME A,MBXBSZ        ; yes, return now if size unchanged
  1079.     IFSKP. <RETSKP>
  1080.     CAML A,MBXBSZ        ; did it shrink?
  1081.     IFSKP.
  1082.       TAGMSG <BYE Message file byte size appears to have shrunk>
  1083.       CALL CLSMBX        ; close file off
  1084.       JRST IMPERR
  1085.     ENDIF.
  1086.     MOVEM A,MBXBSZ        ; save number of characters
  1087.     CALLRET GETMBX
  1088.  
  1089.     ENDSV.
  1090.  
  1091. ; EXPUNGE - remove deleted messages from mailbox
  1092.  
  1093. .EXPUN:    JE F%LOG,,NOTLOG    ; must log in first
  1094.     JUMPN A,BADARG        ; must not have an argument
  1095.     SKIPN MBXJFN        ; must have a mailbox open
  1096.      JRST NOMBX
  1097.     IFQN. F%RON        ; read-only?
  1098.       TAGMSG <OK EXPUNGE ignored for read-only file>
  1099.       RET
  1100.     ENDIF.
  1101.     ACVAR <M,Q0,Q1,Q2,Q3,Q4,Q5>
  1102.     TRVAR <MBXJF2,EXPMSG>
  1103.  
  1104. ; See if there are any deleted messages to expunge
  1105.  
  1106.     SKIPE A,MBXMGS        ; get number of messages
  1107.     IFSKP.
  1108.       TAGMSG <OK Mail file empty> ; tell user and go away
  1109.       RET
  1110.     ENDIF.
  1111.     SETZ M,            ; start check with first message
  1112.     DO.
  1113.       JN M%DELE,MSGFLG(M),ENDLP. ; if found deleted message, must expunge
  1114.       ADDI M,MSGLEN        ; else bump to next index
  1115.       SOJG A,TOP.        ; and count down another message
  1116.       TAGMSG <OK No messages deleted, so no update needed>
  1117.       RET            ; nothing to do then
  1118.     ENDDO.
  1119.  
  1120. ; Some deleted messages exist, get the file for write and exclusive access
  1121.  
  1122.     CALL MBXWRT        ; open mailbox for write
  1123.      RET            ; can't get it for write
  1124.     MOVEM A,MBXJF2        ; save JFN we got
  1125.     SETZM EXPMSG        ; number of messages expunged
  1126.     MOVX A,EN%SHR        ; turn off share bit
  1127.     ANDCAM A,ENQBLK+.ENQLV
  1128.     MOVX A,.ENQMA        ; change our lock to be exclusive
  1129.     XMOVEI B,ENQBLK
  1130.     ENQ%
  1131.     IFJER.
  1132.       TAGMSG <NO Mailbox in use by another process, try again later>
  1133.       RET
  1134.     ENDIF.
  1135.     CALL FCHECK        ; do a full check first
  1136.      RET
  1137.     HRRZ A,MBXJFN        ; page 0,,JFN
  1138.     FFFFP%            ; find size of contiguous file pages
  1139.      ERCAL FATAL
  1140.     LDB C,[POINT 9,A,26]    ; get number of sections of file
  1141.     TRNE A,777        ; any fractional section?
  1142.      ADDI C,1        ; plus 1 for fractional section
  1143.     HRLZ A,MBXJF2        ; source JFN,,start at section 0
  1144.     MOVE B,[.FHSLF,,MBXSEC] ; our process,,mailbox section
  1145.     TXO C,SM%RD!SM%WR    ; read/write access,,this many sections
  1146.     SMAP%
  1147.      ERCAL FATAL
  1148.  
  1149. ; Go through mail file, blatting subsequent messages on top of deleted ones
  1150.  
  1151.     MOVE A,[OWGP. 7,OUTBFR]    ; initialize buffer pointer
  1152.     HRLO D,MBXMGS        ; get number of messages,,-1
  1153.     SETCA D,        ; -<msgs+1>,,0
  1154.     AOBJP D,.+1        ; -msgs,,1
  1155.     SETZ M,            ; start check with first message
  1156.     MOVE Q4,MSGIPT(M)    ; initial destination pointer is first message
  1157.     SETZ Q5,        ; with no GBP stuff
  1158.     DO.
  1159.       IFQN. M%DELE,MSGFLG(M) ; this message deleted?
  1160.         HRROI B,[ASCIZ/* /]    ; mark unsolicited
  1161.         CALL BFSOUT
  1162.         MOVEI B,(D)        ; output expunged message #
  1163.         SUB B,EXPMSG    ; offset by the number already done
  1164.         CALL BFNOUT
  1165.         HRROI B,[ASCIZ/ EXPUNGE
  1166. /]
  1167.         CALL BFSOUT
  1168.         AOS EXPMSG        ; bump the expunged messages count
  1169.         SOS MBXMGS        ; and decrement the current messages count
  1170.       ELSE.
  1171.         SKIPE EXPMSG    ; anything expunged yet?
  1172.         IFSKP.
  1173.           MOVE Q4,MSGIPT+MSGLEN(M) ; no, destination pointer is next message
  1174.           SETZ Q5,        ; with no GBP stuff
  1175.         ELSE.
  1176.           MOVE Q1,MSGIPT(M)    ; init source with internal header of this message
  1177.           SETZ Q2,        ; clear any previous GBP stuff
  1178.           DO.
  1179.         ILDB C,Q1    ; copy the internal header
  1180.         IDPB C,Q4
  1181.         CAIE C,.CHLFD    ; got to the LF yet?
  1182.          LOOP.        ; no, continue copy
  1183.           ENDDO.
  1184.           MOVE Q0,MSGSIZ(M)    ; source copy of bytes to copy
  1185.           MOVE Q3,Q0    ; destination count of byte to copy
  1186.           EXTEND Q0,[MOVSLJ    ; blat the string
  1187.              0]    ; with a zero fill
  1188.            CALL MOVBOG    ; this cannot happen
  1189.         ENDIF.
  1190.       ENDIF.
  1191.       ADDI M,MSGLEN        ; bump to next index
  1192.       AOBJN D,TOP.        ; and count down another message
  1193.     ENDDO.
  1194.     SETZ C,            ; tie off status buffer
  1195.     IDPB C,A
  1196.     MOVX A,.PRIOU        ; now send status buffer to client
  1197.     MOVE B,[OWGP. 7,OUTBFR]
  1198.     SOUTR%
  1199.      ERJMP .+1
  1200.  
  1201. ; Compute new byte count for mail file
  1202.  
  1203.     IFN. Q5            ; got a GBP address?
  1204.       TLC Q4,000740        ; clear bits for "global POINT 7,0,35"
  1205.       TXNE Q4,<MASKB 6,35>    ; make sure no bozo bits set
  1206.        CALL MOVBOG
  1207.       LDB A,[POINT 6,Q4,5]    ; get position
  1208.       IDIVI A,7        ; divide by bytesize
  1209.       CAIG A,OWG7SZ
  1210.        CAIE B,1        ; is remainder correct?
  1211.         CALL MOVBOG        ; foo
  1212.       MOVE Q4,OWG7TB(A)    ; get correct pointer
  1213.       DPB Q5,[POINT 30,Q4,35] ; fill in GBP address
  1214.     ENDIF.
  1215.     LDB C,[POINT 30,Q4,35]    ; get final destination address
  1216.     LDB D,[POINT 30,MSGIPT,35] ; get initial destination address
  1217.     SUB C,D            ; get number of words difference
  1218.     IMULI C,5        ; convert to characters
  1219.     LDB D,[POINT 3,MSGIPT,5] ; subtract initial position from count
  1220.     SUB C,D
  1221.     LDB D,[POINT 3,Q4,5]    ; add final position to count
  1222.     ADD C,D
  1223.     MOVEM C,MBXBSZ        ; save new file size
  1224.  
  1225. ; Set new file byte count and byte size
  1226.  
  1227.     MOVE A,MBXJF2        ; get the write JFN
  1228.     HRLI A,.FBBYV        ; want to change file I/O poop
  1229.     TXO A,CF%NUD        ; don't update the disk yet
  1230.     MOVX B,FB%BSZ        ; now change bytesize
  1231.     MOVX C,<FLD 7,FB%BSZ>    ; to 7-bit bytes
  1232.     CHFDB%
  1233.      ERCAL FATAL
  1234.     HRLI A,.FBSIZ        ; want to change file size
  1235.     TXO A,CF%NUD        ; don't update the disk yet
  1236.     SETO B,            ; change all bits
  1237.     MOVE C,MBXBSZ        ; get new file size
  1238.     CHFDB%            ; set the new size
  1239.      ERCAL FATAL
  1240.  
  1241. ;  Check for and delete extraneous mail file pages.  Note that since page
  1242. ; numbers are zero-origin, the size of the file in pages is the first page
  1243. ; number to delete.
  1244.  
  1245.     IDIVI C,^D<5*512>    ; get number of pages in mailbox
  1246.     SKIPE D            ; is there a fractional page?
  1247.      ADDI C,1        ; yes, add that in
  1248.     HRRZ A,MBXJF2        ; see where the guy ends
  1249.     FFFFP%
  1250.      ERCAL FATAL
  1251.     HRRZS A            ; first page that doesn't exist
  1252.     CAMG A,C        ; file has more pages than we need?
  1253.     IFSKP.
  1254.       HRL B,MBXJF2        ; yes, need to flush pages
  1255.       HRR B,C        ; JFN,,first page to flush
  1256.       SUBM A,C        ; # of pages to flush
  1257.       TXO C,PM%CNT        ; let monitor know we're giving it a count
  1258.       SETO A,        ; want to delete pages
  1259.       PMAP%            ; zap!
  1260.       IFJER.
  1261.         TMSG <* BAD Unable to delete extra file pages>
  1262.         CALL ERROUT
  1263.       ENDIF.
  1264.     ENDIF.
  1265.  
  1266. ; Report final results of expunge to client
  1267.  
  1268.     SKIPE MBXMGS        ; any messages left?
  1269.     IFSKP.
  1270.       MOVE A,MBXJF2        ; no, prepare to flush the file
  1271.       TXO A,DF%NRJ        ; don't flush the JFN though
  1272.       DELF%            ; sayonara
  1273.        ERCAL FATAL
  1274.       TAGMSG <OK All messages expunged, file deleted>
  1275.     ELSE.
  1276.       CALL FCHECK        ; now do a full check
  1277.        RET
  1278.       TAGMSG <OK Expunged >    ; and output confirmation
  1279.       MOVX A,.PRIOU
  1280.       MOVE B,EXPMSG
  1281.       MOVX C,^D10
  1282.       NOUT%
  1283.        ERCAL FATAL
  1284.       TMSG < messages>
  1285.     ENDIF.
  1286.     MOVX A,EN%SHR        ; turn on share bit
  1287.     IORM A,ENQBLK+.ENQLV
  1288.     MOVX A,.ENQMA        ; change the access back to shared
  1289.     XMOVEI B,ENQBLK
  1290.     ENQ%
  1291.      ERJMP .+1
  1292.     RET
  1293.  
  1294.     ENDTV.
  1295.     ENDAV.
  1296.  
  1297. ; COPY - copy messages to another mailbox
  1298.  
  1299. .COPY:    JE F%LOG,,NOTLOG    ; must log in first
  1300.     JUMPE A,MISARG        ; must have an argument
  1301.     SKIPN MBXJFN        ; must have a mailbox open
  1302.      JRST NOMBX
  1303.     TRVAR <<CHKBLK,.CKAUD+1>,CPYJFN,<GTJBLK,.GJJFN+1>,<MBXNAM,<<ARGLEN/5>+1>>>
  1304.     CALL GETSEQ        ; get message sequence
  1305.      RET            ; failed
  1306.     JUMPE A,MISARG        ; must have a mailbox name following
  1307.     HRROI A,MBXNAM        ; copy mailbox
  1308.     MOVX C,ARGLEN+1        ; bounded by this many characters
  1309.     CALL ARGCPY
  1310.      RET
  1311.     JUMPN B,BADARG        ; no arguments after this
  1312.     HRROI A,MBXNAM        ; compare user's argument
  1313.     HRROI B,INBOX        ;  with special name INBOX
  1314.     STCMP%
  1315.     IFE. A            ; if user wants the INBOX
  1316.       MOVE A,MAIL        ; he really wants MAIL.TXT
  1317.       MOVEM A,MBXNAM
  1318.     ENDIF.
  1319.     MOVX A,1        ; default gen 1
  1320.     MOVEM A,.GJGEN+GTJBLK
  1321.     MOVE A,[.NULIO,,.NULIO]    ; only use the string
  1322.     MOVEM A,.GJSRC+GTJBLK
  1323.     HRROI A,POBOX        ; default device
  1324.     MOVEM A,.GJDEV+GTJBLK
  1325.     HRROI A,LGUSRS        ; will fill this in
  1326.     MOVEM A,.GJDIR+GTJBLK
  1327.     SETZM .GJNAM+GTJBLK    ; no default filename
  1328.     HRROI A,TXT        ; default extension
  1329.     MOVEM A,.GJEXT+GTJBLK
  1330.     SETZM .GJPRO+GTJBLK    ; no special default protection
  1331.     SETZM .GJACT+GTJBLK    ; no special default account
  1332.     SETZM .GJJFN+GTJBLK    ; no special JFN
  1333.     MOVEI A,GTJBLK        ; long form GTJFN%
  1334.     HRROI B,MBXNAM        ; user's argument
  1335.     GTJFN%
  1336.     IFJER.
  1337.       SETZRO .RHALF,.GJGEN+GTJBLK ; try any generation
  1338.       MOVEI A,GTJBLK    ; and try the GTJFN again
  1339.       HRROI B,MBXNAM
  1340.       GTJFN%
  1341.       IFJER.
  1342.         TAGMSG <NO Can't get destination mailbox>
  1343.         CALLRET ERROUT
  1344.       ENDIF.
  1345.     ENDIF.
  1346.  
  1347. ; Verify access and open for write
  1348.  
  1349.     MOVEM A,CPYJFN
  1350.     MOVEM A,.CKAUD+CHKBLK    ; JFN of file to check
  1351.     MOVX B,OF%RD        ; see if file exists
  1352.     OPENF%
  1353.     IFJER.
  1354.       MOVX B,.CKACF        ; no, we need to see if we can create it
  1355.     ELSE.
  1356.       TXO A,CO%NRJ        ; close but don't release...
  1357.       CLOSF%
  1358.        ERJMP +1
  1359.       MOVX B,.CKAAP        ; see if we have append access
  1360.     ENDIF.
  1361.     MOVEM B,.CKAAC+CHKBLK
  1362.     MOVE B,LGUSRN        ; our user number
  1363.     MOVEM B,.CKALD+CHKBLK
  1364.     MOVE B,LGDIRN        ; login directory is connected
  1365.     MOVEM B,.CKACD+CHKBLK
  1366.     SETZM .CKAEC+CHKBLK    ; no capabilities enabled
  1367.     MOVX A,CK%JFN!.CKAUD+1    ; validate access to file given JFN
  1368.     XMOVEI B,CHKBLK
  1369.     CHKAC%            ; validate access
  1370.      ERCAL FATAL
  1371.     IFE. A            ; access ok?
  1372.       TAGMSG <NO Can't access destination mailbox>
  1373.       MOVE A,CPYJFN        ; flush the JFN
  1374.       RLJFN%
  1375.        ERJMP .+1
  1376.       SETZM CPYJFN        ; and note no file open
  1377.       RET
  1378.     ENDIF.
  1379.     MOVE A,CPYJFN
  1380.     MOVX B,<<FLD 7,OF%BSZ>!OF%APP> ; now open for append
  1381.     OPENF%
  1382.     IFJER.
  1383.       TAGMSG <NO Can't open mailbox>
  1384.       CALL ERROUT
  1385.       MOVE A,CPYJFN        ; flush the JFN
  1386.       RLJFN%
  1387.        ERJMP .+1
  1388.       RET
  1389.     ENDIF.
  1390.  
  1391. ; Now do the copy
  1392.  
  1393.     HRROI A,[ASCIZ/ Copy
  1394. /]
  1395.     XMOVEI B,CPYMSG        ; set up message copy routine
  1396.     CALL SEQDSP        ; do for each sequence
  1397.     IFSKP. <TAGMSG <OK Copy completed>>
  1398.     MOVE A,CPYJFN        ; now close off the file
  1399.     CLOSF%
  1400.      ERCAL FATAL
  1401.     RET            ; all done
  1402.  
  1403. ; Routine to copy a single message
  1404.  
  1405. CPYMSG:    SAVEAC <A,B,C>
  1406.     ACVAR <M>
  1407.     STKVAR <MSG>
  1408.     MOVEM B,MSG        ; save message number in case error
  1409.     MOVEI M,-1(B)        ; determine index into data structure
  1410.     IMULI M,MSGLEN
  1411.     MOVE A,CPYJFN        ; set up JFN for output
  1412.     MOVE B,MSGTAD(M)    ; now output date/time
  1413.     MOVX C,OT%TMZ
  1414.     ODTIM%
  1415.     IFNJE.
  1416.       MOVX B,","        ; output delimiter
  1417.       BOUT%
  1418.     ANNJE.
  1419.       MOVE B,MSGSIZ(M)    ; output size
  1420.       MOVX C,^D10        ; in decimal
  1421.       NOUT%
  1422.     ANNJE.
  1423.       MOVX B,";"        ; output delimiter
  1424.       BOUT%
  1425.     ANNJE.
  1426.       MOVE B,MSGFLG(M)    ; output flags
  1427.       MOVX C,<NO%LFL!NO%ZRO!NO%MAG!<FLD ^D12,NO%COL>!<FLD ^D8,NO%RDX>>
  1428.       NOUT%
  1429.     ANNJE.
  1430.       HRROI B,[ASCIZ/
  1431. /]                ; output CRLF before message
  1432.       SETZ C,
  1433.       SOUT%
  1434.     ANNJE.
  1435.       MOVE B,MSGPTR(M)    ; from this byte
  1436.       MOVN C,MSGSIZ(M)    ; and this many bytes
  1437.       SOUT%
  1438.       RET            ; all done
  1439.     ENDIF.
  1440.     TAGMSG <NO Unable to copy message >
  1441.     MOVX A,.PRIOU        ; output message number
  1442.     MOVE B,MSG
  1443.     MOVX C,^D10
  1444.     NOUT%
  1445.      ERCAL FATAL
  1446.     CALL ERROUT        ; output last error string
  1447.     RETSKP            ; abort the sequence
  1448.  
  1449.     ENDSV.
  1450.     ENDAV.
  1451.     ENDTV.
  1452.  
  1453. ; FETCH - fetch attributes
  1454.  
  1455. MAXATT==^D100            ; lots of attributes
  1456.  
  1457. .FETCH:    JE F%LOG,,NOTLOG    ; must log in first
  1458.     JUMPE A,MISARG        ; must have an argument
  1459.     SKIPN MBXJFN        ; must have a mailbox open
  1460.      JRST NOMBX
  1461.     STKVAR <ATTPTR,<ATTLST,MAXATT+2>>
  1462.     CALL GETSEQ        ; get message sequence
  1463.      RET            ; failed
  1464.     JUMPE A,MISARG        ; must have an attribute following
  1465.     MOVE A,B        ; sniff at attribute
  1466.     ILDB A,A
  1467.  
  1468. ; Parse attribute list
  1469.  
  1470.     CAIE A,"("        ; attribute list?
  1471.     IFSKP.
  1472.       IBP B            ; yes, skip the open paren
  1473.       MOVE A,[TQO <F%NCL>]    ; we have a list of attributes
  1474.       MOVEM A,ATTLST
  1475.       MOVSI D,-MAXATT    ; set up pointer to attribute list
  1476.       HRRI D,1+ATTLST
  1477.       DO.
  1478.         CALL GETATT        ; get attribute
  1479.          RET        ; failed
  1480.         HLR C,(C)        ; get dispatch address
  1481.         CAIE A,.CHSPC    ; more attributes coming?
  1482.          EXIT.        ; no
  1483.         HRLI C,<(CALL)>    ; yes, make into a CALL <address> instruction
  1484.         MOVEM C,(D)        ; store the instruction
  1485.         AOBJN D,TOP.    ; get next attribute
  1486.         TAGMSG <NO Too many attributes for FETCH>
  1487.         RET
  1488.       ENDDO.
  1489.       CAIE A,")"        ; saw a close paren?
  1490.        JRST SYNERR
  1491.       MOVE A,[TQZ <F%NCL>]    ; this attribute is the last one
  1492.       MOVEM A,(D)        ; store the instruction
  1493.       HRLI C,<(CALLRET)>    ; make a CALLRET <address> instruction
  1494.       MOVEM C,1(D)        ; store as final instruction
  1495.       ILDB A,B        ; sniff past the close paren
  1496.       XMOVEI B,ATTLST    ; set up dispatch to routine we compiled
  1497.  
  1498. ; Atomic attribute
  1499.  
  1500.     ELSE.
  1501.       MOVEM B,ATTPTR    ; save pointer
  1502.       HRROI A,[ASCIZ/ALL/]    ; user want all?
  1503.       STCMP%
  1504.       IFE. A        ; must be exact
  1505.         XMOVEI B,.FTALL    ; win
  1506.       ELSE.
  1507.         HRROI A,[ASCIZ/FAST/] ; no, then try for fast
  1508.         MOVE B,ATTPTR
  1509.         STCMP%
  1510.         IFE. A
  1511.           XMOVEI B,.FTFST    ; win
  1512.         ELSE.
  1513.           MOVE B,ATTPTR
  1514.           CALL GETATT    ; user probably wants a single attribute
  1515.            RET        ; failed
  1516.           HLRZ B,(C)    ; get dispatch address
  1517.           XHLLI B,
  1518.         ENDIF.
  1519.       ENDIF.
  1520.       TQZ <F%NCL>        ; make sure this is initialized
  1521.     ENDIF.
  1522.     JUMPN A,BADARG        ; must be end of arguments
  1523.  
  1524. ; Now, do the fetching
  1525.  
  1526.     HRROI A,[ASCIZ/ Fetch (/]
  1527.     CALL SEQDSP        ; do per-sequence dispatch
  1528.     IFSKP. <TAGMSG <OK Fetch completed>>
  1529.     RET
  1530.  
  1531.     ENDSV.
  1532.  
  1533. ; Fetch all for message in B
  1534.  
  1535. .FTALL:    TQO <F%NCL>
  1536.     CALL .FTFLG
  1537.     CALL .FTDAT
  1538.     CALL .FTSIZ
  1539.     TQZ <F%NCL>
  1540.     CALLRET .FTENV
  1541.  
  1542. ; Fetch all fast attributes for message in B
  1543.  
  1544. .FTFST:    TQO <F%NCL>
  1545.     CALL .FTFLG
  1546.     CALL .FTDAT
  1547.     TQZ <F%NCL>
  1548.     CALLRET .FTSIZ
  1549.  
  1550. ; Fetch envelope for message indexed in B
  1551.  
  1552. .FTENV:    SAVEAC <B,C,D>
  1553.     ACVAR <M>
  1554.     MOVEI M,-1(B)        ; determine index into data structure
  1555.     IMULI M,MSGLEN
  1556.     SKIPN D,MSGENV(M)    ; get envelope block pointer
  1557.      CALL GETENV
  1558.     HRROI B,[ASCIZ/Envelope (/]
  1559.     CALL BFSOUT
  1560.     SKIPE B,ENVDAT(D)    ; get envelope date
  1561.     IFSKP.
  1562.       MOVE B,MSGTAD(M)    ; default Date
  1563.       MOVX C,""""        ; quote the string
  1564.       IDPB C,A
  1565.       MOVX C,OT%DAY!OT%SPA!OT%TMZ!OT%SCL!OT%822 ; standard date/time
  1566.       ODTIM%
  1567.        ERCAL FATAL
  1568.       HRROI B,[ASCIZ/" /]
  1569.       CALL BFSOUT
  1570.     ELSE.
  1571.       CALL BFSTR
  1572.     ENDIF.
  1573.     MOVE B,ENVSUB(D)    ; get envelope Subject
  1574.     CALL BFSTR
  1575.     MOVE B,ENVFRM(D)    ; get envelope From
  1576.     CALL BFADR
  1577.     MOVE B,ENVSDR(D)    ; get envelope Sender
  1578.     CALL BFADR
  1579.     MOVE B,ENVREP(D)    ; get envelope Reply-To
  1580.     CALL BFADR
  1581.     MOVE B,ENVTO(D)        ; get envelope To
  1582.     CALL BFADR
  1583.     MOVE B,ENVCC(D)        ; get envelope cc
  1584.     CALL BFADR
  1585.     MOVE B,ENVBCC(D)    ; get envelope bcc
  1586.     CALL BFADR
  1587.     MOVE B,ENVIRT(D)    ; get envelope In-Reply-To
  1588.     CALL BFSTR
  1589.     MOVE B,ENVMID(D)    ; get envelope Message-ID
  1590.     CALL BFSTR
  1591.     MOVEI B,")"        ; close off the envelope
  1592.     DPB B,A
  1593.     CALLRET BFCRLF
  1594.  
  1595.     ENDAV.
  1596.  
  1597. ; Fetch flags for message in B
  1598.  
  1599. .FTFLG:    SAVEAC <B,C,D>
  1600.     ACVAR <M,FLG,FLGX>    ; FLGX must be FLG+1
  1601.     MOVEI M,-1(B)        ; determine index into data structure
  1602.     IMULI M,MSGLEN
  1603.     HRROI B,[ASCIZ/Flags (/]
  1604.     CALL BFSOUT
  1605.     MOVE FLG,MSGFLG(M)    ; get message flags
  1606.     MOVE B,MSGTAD(M)    ; get date of this message
  1607.     CAMG B,MBXRDT        ; is this a recent message?
  1608.     IFSKP.
  1609.       HRROI B,[ASCIZ/\Recent/] ; yes, indicate it as such
  1610.       CALL BFSOUT
  1611.     ANDN. FLG        ; any flags set?
  1612.       MOVX B,.CHSPC        ; yes, output delimiter
  1613.       IDPB B,A
  1614.     ENDIF.
  1615.     IFN. FLG        ; any flags set?
  1616.       DO.
  1617.         JFFO FLG,.+2    ; get bit position
  1618.          EXIT.        ; last bit in this word
  1619.         SKIPE B,FLGTAB(FLGX) ; is this flag defined?
  1620.         IFSKP.
  1621.           HRROI B,[ASCIZ/\UndefinedFlag#/]
  1622.           CALL BFSOUT
  1623.           MOVE B,FLGX    ; bit to output
  1624.           CALL BFNOUT
  1625.         ELSE.
  1626.           CALL BFSOUT    ; defined flag, output it
  1627.         ENDIF.
  1628.         ANDCM FLG,BITS(FLGX) ; clear this flag
  1629.         IFN. FLG
  1630.           MOVX B,.CHSPC    ; delimit with space
  1631.           IDPB B,A
  1632.           LOOP.
  1633.         ENDIF.
  1634.       ENDDO.
  1635.     ENDIF.
  1636.     MOVEI B,")"
  1637.     IDPB B,A
  1638.     CALLRET BFCRLF
  1639.  
  1640.     ENDAV.
  1641.  
  1642. ; Fetch internal date in B
  1643.  
  1644. .FTDAT:    SAVEAC <B,C,D>
  1645.     ACVAR <M>
  1646.     MOVEI M,-1(B)        ; determine index into data structure
  1647.     IMULI M,MSGLEN
  1648.     HRROI B,[ASCIZ/InternalDate "/]
  1649.     CALL BFSOUT
  1650.     MOVE B,MSGIPT(M)    ; output date directly from the file
  1651.     DO.
  1652.       ILDB D,B
  1653.       JUMPE D,TOP.        ; ignore leading nulls
  1654.       CAIE D,.CHSPC        ; and leading whitespace
  1655.        CAIN D,.CHTAB
  1656.         LOOP.
  1657.     ENDDO.
  1658.     CAIL D,"0"        ; numeric?
  1659.      CAILE D,"9"
  1660.     IFSKP.
  1661.       ILDB C,B        ; sniff at next character too
  1662.       CAIL C,"0"        ; numeric?
  1663.        CAILE C,"9"
  1664.       IFNSK.
  1665.         MOVX M,.CHSPC    ; no, start with leading space
  1666.         IDPB M,A
  1667.       ENDIF.
  1668.       IDPB D,A        ; ship first character (second in C)
  1669.       DO.
  1670.         IDPB C,A        ; ship this character
  1671.         ILDB C,B        ; get next character
  1672.         CAIE C,","        ; start of next field?
  1673.          LOOP.        ; no, output remainder of field
  1674.       ENDDO.
  1675.     ELSE.
  1676.       MOVE B,MSGTAD(M)    ; strange, better use the slow way then...
  1677.       MOVX C,OT%TMZ
  1678.       ODTIM%
  1679.        ERCAL FATAL
  1680.     ENDIF.
  1681.     MOVX B,""""
  1682.     IDPB B,A
  1683.     CALLRET BFCRLF
  1684.  
  1685.     ENDAV.
  1686.  
  1687. ; Fetch RFC 822 size in B
  1688.  
  1689. .FTSIZ:    SAVEAC <B,C>
  1690.     ACVAR <M>
  1691.     MOVEI M,-1(B)        ; determine index into data structure
  1692.     IMULI M,MSGLEN
  1693.     HRROI B,[ASCIZ/RFC822.Size /]
  1694.     CALL BFSOUT
  1695.     MOVE B,MSGSIZ(M)    ; now output size
  1696.     CALL BFNOUT
  1697.     CALLRET BFCRLF
  1698.  
  1699.     ENDAV.
  1700.  
  1701. ; Fetch RFC 822 format message in B
  1702.  
  1703. .FT822:    SAVEAC <B,C,D>
  1704.     ACVAR <M>
  1705.     MOVEI M,-1(B)        ; determine index into data structure
  1706.     IMULI M,MSGLEN
  1707.     CALL MRKMSG        ; mark this message as having been seen
  1708.     MOVE B,MSGPTR(M)    ; output message from this byte
  1709.     MOVE C,MSGSIZ(M)    ; and this many bytes
  1710.     HRROI D,[ASCIZ/RFC822/]
  1711.     CALL BFBLAT
  1712.     CALLRET BFCRLF
  1713.  
  1714.     ENDAV.
  1715.  
  1716. ; Fetch RFC 822 format header in B
  1717.  
  1718. .FTHDR:    SAVEAC <B,C,D>
  1719.     ACVAR <M>
  1720.     MOVEI M,-1(B)        ; determine index into data structure
  1721.     IMULI M,MSGLEN
  1722.     SKIPE C,MSGHSZ(M)    ; get header size
  1723.     IFSKP.
  1724.       MOVE B,M        ; not known yet, set up index
  1725.       CALL FNDHSZ        ; find the header
  1726.     ENDIF.
  1727.     MOVE B,MSGPTR(M)    ; output body of message from this byte
  1728.     HRROI D,[ASCIZ/RFC822.Header/]
  1729.     CALL BFBLAT
  1730.     CALLRET BFCRLF
  1731.  
  1732.     ENDAV.
  1733.  
  1734. ; Fetch text from RFC 822 format message in B
  1735.  
  1736. .FTTXT:    SAVEAC <B,C,D>
  1737.     ACVAR <M>
  1738.     MOVEI M,-1(B)        ; determine index into data structure
  1739.     IMULI M,MSGLEN
  1740.     CALL MRKMSG        ; mark message as having been seen
  1741.     SKIPE C,MSGHSZ(M)    ; get header size
  1742.     IFSKP.
  1743.       MOVE B,M        ; not known yet, set up index
  1744.       CALL FNDHSZ        ; find the header
  1745.     ENDIF.
  1746.     MOVE B,MSGSIZ(M)    ; get full message size
  1747.     SUBB B,C        ; save message size
  1748.     MOVE B,MSGHSZ(M)    ; output body of message
  1749.     ADJBP B,MSGPTR(M)    ; from this byte
  1750.     HRROI D,[ASCIZ/RFC822.Text/]
  1751.     CALL BFBLAT
  1752.     CALLRET BFCRLF
  1753.  
  1754.     ENDAV.
  1755.  
  1756. ; STORE - store attributes
  1757.  
  1758. .STORE:    JE F%LOG,,NOTLOG    ; must log in first
  1759.     JUMPE A,MISARG        ; must have an argument
  1760.     SKIPN MBXJFN        ; must have a mailbox open
  1761.      JRST NOMBX
  1762.     IFQN. F%RON        ; read-only?
  1763.       TAGMSG <OK STORE ignored for read-only file>
  1764.       RET
  1765.     ENDIF.
  1766.     STKVAR <ARGDSP>
  1767.     CALL GETSEQ        ; get message sequence
  1768.      RET            ; failed
  1769.     JUMPE A,MISARG        ; must have an attribute following
  1770.     CALL GETATT        ; get attribute
  1771.      RET            ; failed
  1772.     CAIN A,")"        ; make sure delimiter is right
  1773.      JRST SYNERR
  1774.     HRRZ C,(C)        ; get dispatch address
  1775.     MOVEM C,ARGDSP        ; save dispatch
  1776.     IFN. A
  1777.       MOVE A,[OWGP. 7,ARGBUF] ; starting pointer
  1778.       MOVX C,-<<5*ARGBSZ>-1> ; wholeline argument is very large
  1779.       CALL ARGCPY        ; copy the argument
  1780.        RET
  1781.       JUMPN B,BADARG    ; must be last argument
  1782.     ELSE.
  1783.       SETZM @[ARGBUF]    ; make argument empty
  1784.     ENDIF.
  1785.     HRROI A,[ASCIZ/ Store (/]
  1786.     HRRZ B,ARGDSP        ; get dispatch address
  1787.     XHLLI B,
  1788.     CALL SEQDSP        ; do attribute dispatch
  1789.     IFSKP. <TAGMSG <OK Store completed>>
  1790.     RET
  1791.  
  1792.     ENDSV.
  1793.  
  1794. .STBAD:    TAGMSG <BAD Not valid to store this attribute>
  1795.     RETSKP
  1796.  
  1797. .STNIM:    TAGMSG <NO Store not implemented yet for this attribute>
  1798.     RETSKP
  1799.  
  1800. ; Store flags for message in B
  1801.  
  1802. .STFLG:    SAVEAC <C>
  1803.     CALL GETFLG        ; parse user's flag list
  1804.      RETSKP            ; failed
  1805.     CALL STOFLG        ; store these flags
  1806.      RETSKP
  1807.     CALLRET .FTFLG        ; and do a fetch of the new flags
  1808.  
  1809. ; Store additional flags for message in B
  1810.  
  1811. .STPFL:    SAVEAC <C>
  1812.     ACVAR <M>
  1813.     MOVEI M,-1(B)        ; determine index into data structure
  1814.     IMULI M,MSGLEN
  1815.     CALL GETFLG        ; parse user's flag list
  1816.      RETSKP            ; failed
  1817.     IOR C,MSGFLG(M)        ; new flags are the OR function
  1818.     CALL STOFLG        ; store these flags
  1819.      RETSKP
  1820.     CALLRET .FTFLG        ; and do a fetch of the new flags
  1821.  
  1822.     ENDAV.
  1823.  
  1824. ; Store cleared flags for message in B
  1825.  
  1826. .STMFL:    SAVEAC <C>
  1827.     ACVAR <M>
  1828.     MOVEI M,-1(B)        ; determine index into data structure
  1829.     IMULI M,MSGLEN
  1830.     CALL GETFLG        ; parse user's flag list
  1831.      RETSKP            ; failed
  1832.     ANDCA C,MSGFLG(M)    ; new flags are the AND of complement function
  1833.     CALL STOFLG        ; store these flags
  1834.      RETSKP
  1835.     CALLRET .FTFLG        ; and do a fetch of the new flags
  1836.  
  1837.     ENDAV.
  1838.  
  1839. ; SEARCH - search for message with attributes
  1840.  
  1841. .SEARC:    JE F%LOG,,NOTLOG    ; must log in first
  1842.     JUMPE A,MISARG        ; must have an argument
  1843.     SKIPN MBXJFN        ; must have a mailbox open
  1844.      JRST NOMBX
  1845.     SKIPE MBXMGS        ; is there at least one message?
  1846.     IFSKP.
  1847.       TAGMSG <NO Mailbox is empty>
  1848.       RET
  1849.     ENDIF.
  1850.     ACVAR <<VEC,2>,SEQ,PTR>
  1851.     STKVAR <CURPTR>
  1852.     MOVEM B,CURPTR        ; save pointer to current search command
  1853.     SETOM SEQLST        ; initialize sequence list to ALL
  1854.     MOVE A,[SEQLST,,SEQLST+1]
  1855.     BLT A,SEQLST+SEQLSN-1
  1856.  
  1857. ; Pass 1: parse each criterion, and deselect messages which fail it
  1858.  
  1859.     DO.
  1860.       MOVSI C,-SRCTBL    ; length of command table
  1861.       DO.
  1862.         HLRO A,SRCTAB(C)    ; point to command string
  1863.         MOVE B,CURPTR    ; point to base
  1864.         STCMP%        ; compare
  1865.         JUMPE A,ENDLP.    ; done if match
  1866.         IFXN. A,SC%SUB    ; subset?
  1867.           ILDB A,B        ; yes, get delimiting byte
  1868.           CAIN A,.CHSPC    ; OK if something follows
  1869.            EXIT.
  1870.         ENDIF.
  1871.         AOBJN C,TOP.
  1872.         JRST BADCOM
  1873.       ENDDO.
  1874.       SKIPN A        ; possibility of an argument?
  1875.        SETZ B,        ; no, end of string
  1876.       HRRZ D,SRCTAB(C)    ; get pointer to argument,,command dispatch
  1877.       MOVE D,(D)        ; get argument,,command dispatch
  1878.       IFXN. D,.LHALF    ; command takes an argument?
  1879.         SETZM @[ARGBUF]    ; initialize argument
  1880.         SETZM ATOM
  1881.       ANDN. A        ; yes, is there one in the buffer
  1882.         MOVE A,[OWGP. 7,ARGBUF] ; starting pointer
  1883.         MOVX C,<5*ARGBSZ>-1    ; buffer is very large
  1884.         CALL ARGCPY        ; copy the argument
  1885.          RET
  1886.         HLRO C,D        ; get routine that will process the argument
  1887.         CALL (C)        ; go process it
  1888.          RET        ; argument processor was unhappy with it
  1889.       ENDIF.
  1890.       HRRO C,D        ; get routine to handle command
  1891.       MOVEM B,CURPTR    ; save pointer to current search command
  1892.       MOVX D,1        ; start at first message
  1893.       DO.
  1894.         MOVEI A,-1(D)    ; copy sequence
  1895.         IDIVI A,^D36    ; split into vector index and bit number
  1896.         MOVE B,BITS(B)    ; get the desired bit
  1897.         TDNE B,SEQLST(A)    ; is this message eligible to be checked?
  1898.          CALL (C)        ; yes, check it
  1899.           ANDCAM B,SEQLST(A) ; bit is now ineligible
  1900.         CAMGE D,MBXMGS    ; at the last message?
  1901.          AOJA D,TOP.    ; no, try next message
  1902.       ENDDO.
  1903.       SKIPE B,CURPTR    ; restore pointer
  1904.        LOOP.        ; do next search spec if there is one
  1905.     ENDDO.
  1906.  
  1907. ; Pass 2: output the messages which match the search
  1908.  
  1909.     MOVE A,[OWGP. 7,OUTBFR]    ; initialize buffer pointer
  1910.     HRROI B,[ASCIZ/* SEARCH/] ; start search reply
  1911.     CALL BFSOUT
  1912.     SETZ PTR,        ; and sequence pointer
  1913.     MOVE VEC,SEQLST        ; get first word from bit vector
  1914.     DO.
  1915.       JFFO VEC,.+2        ; find a bit out of it
  1916.       IFSKP.
  1917.         MOVE SEQ,PTR    ; get vector index
  1918.         IMULI SEQ,^D36    ; times number of bits in vector element
  1919.         ADDI SEQ,1(VEC+1)    ; plus bit position gives this sequence
  1920.         CAMLE SEQ,MBXMGS    ; off the end?
  1921.          EXIT.        ; yes, all done
  1922.         ANDCM VEC,BITS(VEC+1) ; flush this bit for next time
  1923.         MOVX B,.CHSPC    ; delimit
  1924.         IDPB B,A
  1925.         MOVE B,SEQ        ; get sequence again
  1926.         CALL BFNOUT        ; output sequence
  1927.         LOOP.
  1928.       ENDIF.
  1929.       CAIN PTR,SEQLSN    ; at end?
  1930.        EXIT.        ; yes, done with sequence
  1931.       MOVE VEC,SEQLST+1(PTR) ; get next word from bit vector
  1932.       AOJA PTR,TOP.        ; charge on
  1933.     ENDDO.
  1934.     HRROI B,[ASCIZ/
  1935. /]
  1936.     CALL BFSOUT
  1937.     SETZ C,            ; tie off buffer
  1938.     IDPB C,A
  1939.     MOVX A,.PRIOU        ; now blat the buffer
  1940.     MOVE B,[OWGP. 7,OUTBFR]
  1941.     SOUT%
  1942.      ERJMP .+1
  1943.     TAGMSG <OK SEARCH completed>
  1944.     RET
  1945.  
  1946.     ENDSV.
  1947.     ENDAV.
  1948.  
  1949. DEFINE SRC (NAME,DSP,ARG) <[ASCIZ/'NAME'/],,[ARG,,DSP]>
  1950.  
  1951. SRCTAB:    SRC All,RSKP
  1952.     SRC Answered,.SEANS
  1953.     SRC Bcc,.SEBCC,RSKP
  1954.     SRC Before,.SEBEF,.SEDAT
  1955.     SRC Body,.SEBOD,RSKP
  1956.     SRC Cc,.SECC,RSKP
  1957.     SRC Deleted,.SEDEL
  1958.     SRC Flagged,.SEFLG
  1959.     SRC From,.SEFRM,RSKP
  1960.     SRC Keyword,.SEKEY,.SEFLA
  1961.     SRC New,.SENEW
  1962.     SRC Old,.SEOLD
  1963.     SRC On,.SEON,.SEDAT
  1964.     SRC Recent,.SEREC
  1965.     SRC Seen,.SESEE
  1966.     SRC Since,.SESIN,.SEDAT
  1967.     SRC Subject,.SESUB,RSKP
  1968.     SRC Text,.SETEX,RSKP
  1969.     SRC To,.SETO,RSKP
  1970.     SRC Unanswered,.SEUAN
  1971.     SRC Undeleted,.SEUDE
  1972.     SRC Unflagged,.SEUFL
  1973.     SRC Unkeyword,.SEUKE,.SEFLA
  1974.     SRC Unseen,.SEUSE
  1975. SRCTBL==.-SRCTAB
  1976.  
  1977. ; Parse a date
  1978.  
  1979. .SEDAT:    SAVEAC <A,B,C,D>
  1980.     MOVE A,[OWGP. 7,ARGBUF]    ; pointer to the thing
  1981.     MOVX B,IT%NTI        ; don't bother with the time
  1982.     IDTNC%
  1983.      ERJMP SYNERR
  1984.     IDCNV%
  1985.      ERJMP SYNERR
  1986.     LDB A,A            ; better be the end
  1987.     JUMPN A,SYNERR        ; it wasn't
  1988.     MOVEM B,ATOM        ; time is OK
  1989.     RETSKP
  1990.  
  1991. ; Parse a keyword flag
  1992.  
  1993. .SEFLA:    SAVEAC <A,B,C>
  1994.     MOVSI C,-^D30
  1995.     DO.
  1996.       MOVE A,FLGTAB(C)    ; flag to consider
  1997.       MOVE B,[OWGP. 7,ARGBUF] ; point to the thing
  1998.       STCMP%
  1999.       IFN. A        ; exact match?
  2000.         AOBJN C,TOP.    ; no, try next flag
  2001.         TAGMSG <NO Undefined flag>
  2002.         RET
  2003.       ENDIF.
  2004.     ENDDO.
  2005.     MOVE A,BITS(C)        ; get the flag
  2006.     MOVEM A,ATOM
  2007.     RETSKP
  2008.  
  2009. ; Skip if text matches
  2010.  
  2011. .SETEX:    SAVEAC <A,B>
  2012.     MOVEI B,-1(D)        ; determine index into data structure
  2013.     IMULI B,MSGLEN
  2014.     MOVE A,MSGPTR(B)    ; text of message
  2015.     MOVE B,MSGSIZ(B)    ; size of message
  2016.     CALLRET SEARCH        ; search for it!
  2017.  
  2018. ; Skip if text in body of message matches
  2019.  
  2020. .SEBOD:    SAVEAC <A,B,C>
  2021.     MOVEI B,-1(D)        ; determine index into data structure
  2022.     IMULI B,MSGLEN
  2023.     SKIPN C,MSGHSZ(B)    ; get header size
  2024.      CALL FNDHSZ        ; find the header's size
  2025.     MOVE A,C        ; get pointer to start of text
  2026.     ADJBP A,MSGPTR(B)
  2027.     MOVE B,MSGSIZ(B)    ; size of entire message
  2028.     SUB B,C            ; size of text only
  2029.     CALLRET SEARCH        ; search for it!
  2030.  
  2031. ; Skip if text in subject of message matches
  2032.  
  2033. .SESUB:    SAVEAC <A,B,C,D>
  2034.     MOVEI B,-1(D)        ; determine index into data structure
  2035.     IMULI B,MSGLEN
  2036.     EXCH B,D        ; B has message number for GETENV
  2037.     SKIPN D,MSGENV(D)    ; get envelope
  2038.      CALL GETENV
  2039.     MOVE A,ENVSUB(D)    ; get pointer to subject
  2040.     SETZ B,            ; count characters in subject
  2041.     DO.
  2042.       ILDB C,A
  2043.       JUMPE C,ENDLP.
  2044.       AOJA B,TOP.
  2045.     ENDDO.
  2046.     MOVE A,ENVSUB(D)    ; get pointer to subject
  2047.     CALLRET SEARCH
  2048.  
  2049. ; Skip if From matches
  2050.  
  2051. .SEFRM:    SAVEAC <B,D>
  2052.     MOVEI B,-1(D)        ; determine index into data structure
  2053.     IMULI B,MSGLEN
  2054.     EXCH B,D        ; B has message number for GETENV
  2055.     SKIPN D,MSGENV(D)    ; get envelope
  2056.      CALL GETENV
  2057.     MOVE D,ENVFRM(D)    ; get From
  2058.     CALLRET .SEADR
  2059.  
  2060. ; Skip if To matches
  2061.  
  2062. .SETO:    SAVEAC <B,D>
  2063.     MOVEI B,-1(D)        ; determine index into data structure
  2064.     IMULI B,MSGLEN
  2065.     EXCH B,D        ; B has message number for GETENV
  2066.     SKIPN D,MSGENV(D)    ; get envelope
  2067.      CALL GETENV
  2068.     MOVE D,ENVTO(D)        ; get To
  2069.     CALLRET .SEADR
  2070.  
  2071. ; Skip if cc matches
  2072.  
  2073. .SECC:    SAVEAC <B,D>
  2074.     MOVEI B,-1(D)        ; determine index into data structure
  2075.     IMULI B,MSGLEN
  2076.     EXCH B,D        ; B has message number for GETENV
  2077.     SKIPN D,MSGENV(D)    ; get envelope
  2078.      CALL GETENV
  2079.     MOVE D,ENVCC(D)        ; get cc
  2080.     CALLRET .SEADR
  2081.  
  2082. ; Skip if bcc matches
  2083.  
  2084. .SEBCC:    SAVEAC <B,D>
  2085.     MOVEI B,-1(D)        ; determine index into data structure
  2086.     IMULI B,MSGLEN
  2087.     EXCH B,D        ; B has message number for GETENV
  2088.     SKIPN D,MSGENV(D)    ; get envelope
  2089.      CALL GETENV
  2090.     MOVE D,ENVBCC(D)    ; get bcc
  2091.     CALLRET .SEADR
  2092.  
  2093. ; Skip on match for address list in D
  2094.  
  2095. .SEADR:    ACVAR <ADR>
  2096.     SKIPN ADR,D        ; get address list
  2097.      RET            ; if empty address always fails
  2098.     SAVEAC <A,B,C,D>
  2099.     MOVE A,[OWGP. 7,WRKBUF]    ; destination buffer
  2100.     SETZ B,            ; init byte count
  2101.     DO.
  2102.       SKIPN D,ADRNAM(ADR)    ; output personal name
  2103.       IFSKP.
  2104.         DO.
  2105.           ILDB C,D
  2106.           IFN. C
  2107.         IDPB C,A
  2108.         AOJA B,TOP.
  2109.           ENDIF.
  2110.         ENDDO.
  2111.         MOVX C,.CHSPC    ; and space as delimiter
  2112.         IDPB C,A
  2113.         ADDI B,1
  2114.       ENDIF.
  2115.  
  2116.       SKIPN D,ADRMBX(ADR)    ; output mailbox
  2117.       IFSKP.
  2118.         MOVX C,.CHLAB    ; output left broket
  2119.         IDPB C,A
  2120.         ADDI B,1
  2121.         DO.
  2122.           ILDB C,D
  2123.           IFN. C
  2124.         IDPB C,A
  2125.         AOJA B,TOP.
  2126.           ENDIF.
  2127.         ENDDO.
  2128.         SKIPN D,ADRHST(ADR)    ; output host
  2129.         IFSKP.
  2130.           MOVX C,"@"    ; delimiter
  2131.           IDPB C,A
  2132.           ADDI B,1
  2133.           DO.
  2134.         ILDB C,D
  2135.         IFN. C
  2136.           IDPB C,A
  2137.           AOJA B,TOP.
  2138.         ENDIF.
  2139.           ENDDO.
  2140.         ENDIF.
  2141.         MOVX C,.CHRAB    ; close broket
  2142.         IDPB C,A
  2143.         MOVX C,.CHSPC    ; and space
  2144.         IDPB C,A
  2145.         ADDI B,2
  2146.       ENDIF.
  2147.       MOVE ADR,ADRCDR(ADR)    ; try next address
  2148.       JUMPN ADR,TOP.    ; do it if there is one
  2149.     ENDDO.
  2150.     IDPB ADR,A        ; tie off the string
  2151.     JUMPE B,R        ; one last paranoia check
  2152.     MOVE A,[OWGP. 7,WRKBUF]    ; destination buffer
  2153.     CALLRET SEARCH        ; now do the search
  2154.  
  2155.     ENDAV.
  2156.  
  2157. ; Skip on flag set for message in D
  2158.  
  2159. .SEANS:    SAVEAC <A>
  2160.     MOVEI A,-1(D)        ; determine index into data structure
  2161.     IMULI A,MSGLEN
  2162.     MOVE A,MSGFLG(A)    ; get flags
  2163.     JXN A,M%ANSW,RSKP    ; skip if answered
  2164.     RET
  2165.  
  2166. .SEDEL:    SAVEAC <A>
  2167.     MOVEI A,-1(D)        ; determine index into data structure
  2168.     IMULI A,MSGLEN
  2169.     MOVE A,MSGFLG(A)    ; get flags
  2170.     JXN A,M%DELE,RSKP    ; skip if deleted
  2171.     RET
  2172.  
  2173. .SEFLG:    SAVEAC <A>
  2174.     MOVEI A,-1(D)        ; determine index into data structure
  2175.     IMULI A,MSGLEN
  2176.     MOVE A,MSGFLG(A)    ; get flags
  2177.     JXN A,M%FLAG,RSKP    ; skip if flagged
  2178.     RET
  2179.  
  2180. .SEKEY:    SAVEAC <A>
  2181.     MOVEI A,-1(D)        ; determine index into data structure
  2182.     IMULI A,MSGLEN
  2183.     MOVE A,MSGFLG(A)    ; get flags
  2184.     TDNE A,ATOM        ; is the keyword set?
  2185.      RETSKP
  2186.     RET
  2187.  
  2188. .SESEE:    SAVEAC <A>
  2189.     MOVEI A,-1(D)        ; determine index into data structure
  2190.     IMULI A,MSGLEN
  2191.     MOVE A,MSGFLG(A)    ; get flags
  2192.     JXN A,M%SEEN,RSKP    ; skip if seen
  2193.     RET
  2194.  
  2195. ; Skip if flag not set for message in D
  2196.  
  2197. .SEUAN:    SAVEAC <A>
  2198.     MOVEI A,-1(D)        ; determine index into data structure
  2199.     IMULI A,MSGLEN
  2200.     MOVE A,MSGFLG(A)    ; get flags
  2201.     JXE A,M%ANSW,RSKP    ; skip if unanswered
  2202.     RET
  2203.  
  2204. .SEUDE:    SAVEAC <A>
  2205.     MOVEI A,-1(D)        ; determine index into data structure
  2206.     IMULI A,MSGLEN
  2207.     MOVE A,MSGFLG(A)    ; get flags
  2208.     JXE A,M%DELE,RSKP    ; skip if undeleted
  2209.     RET
  2210.  
  2211. .SEUFL:    SAVEAC <A>
  2212.     MOVEI A,-1(D)        ; determine index into data structure
  2213.     IMULI A,MSGLEN
  2214.     MOVE A,MSGFLG(A)    ; get flags
  2215.     JXE A,M%FLAG,RSKP    ; skip if unflagged
  2216.     RET
  2217.  
  2218. .SEUKE:    SAVEAC <A>
  2219.     MOVEI A,-1(D)        ; determine index into data structure
  2220.     IMULI A,MSGLEN
  2221.     MOVE A,MSGFLG(A)    ; get flags
  2222.     TDNN A,ATOM        ; is the keyword clear?
  2223.      RETSKP
  2224.     RET
  2225.  
  2226. .SEUSE:    SAVEAC <A>
  2227.     MOVEI A,-1(D)        ; determine index into data structure
  2228.     IMULI A,MSGLEN
  2229.     MOVE A,MSGFLG(A)    ; get flags
  2230.     JXE A,M%SEEN,RSKP    ; skip if unseen
  2231.     RET
  2232.  
  2233. ; Skip based on date of message
  2234.  
  2235. .SENEW:    CALL .SEREC        ; is it recent?
  2236.      RET            ; no
  2237.     CALLRET .SEUSE        ; yes, then it's new if unseen
  2238.  
  2239. .SEREC:    SAVEAC <A>
  2240.     MOVEI A,-1(D)        ; determine index into data structure
  2241.     IMULI A,MSGLEN
  2242.     MOVE A,MSGTAD(A)    ; get date of this message
  2243.     CAMG A,MBXRDT        ; is this a recent message?
  2244.      RET
  2245.     RETSKP            ; yes, message is new
  2246.  
  2247. .SEOLD:    SAVEAC <A>
  2248.     MOVEI A,-1(D)        ; determine index into data structure
  2249.     IMULI A,MSGLEN
  2250.     MOVE A,MSGTAD(A)    ; get date of this message
  2251.     CAMLE A,MBXRDT        ; is this a recent message?
  2252.      RET
  2253.     RETSKP            ; yes, message is new
  2254.  
  2255. ; Skip if message suits a particular date/time range
  2256.  
  2257. .SEBEF:    SAVEAC <A>
  2258.     MOVEI A,-1(D)        ; determine index into data structure
  2259.     IMULI A,MSGLEN
  2260.     MOVE A,MSGTAD(A)    ; get TAD
  2261.     CAML A,ATOM        ; before the date?
  2262.      RET
  2263.     RETSKP
  2264.  
  2265. .SEON:    SAVEAC <A>
  2266.     MOVEI A,-1(D)        ; determine index into data structure
  2267.     IMULI A,MSGLEN
  2268.     MOVE A,MSGTAD(A)    ; get TAD
  2269.     CAMGE A,ATOM        ; since the date?
  2270.      RET
  2271.     SUB A,[1B17]        ; yes, back the TAD off by 1 day
  2272.     CAML A,ATOM        ; if it's now before the date then it's that day
  2273.      RET
  2274.     RETSKP
  2275.  
  2276. .SESIN:    SAVEAC <A>
  2277.     MOVEI A,-1(D)        ; determine index into data structure
  2278.     IMULI A,MSGLEN
  2279.     MOVE A,MSGTAD(A)    ; get TAD
  2280.     CAMGE A,ATOM        ; since the date?
  2281.      RET
  2282.     RETSKP
  2283.     SUBTTL RFC 822 => Envelope handling routines
  2284.  
  2285. ; Format of an envelope block
  2286.  
  2287. ENVDAT==0            ; envelope Date
  2288. ENVSUB==1            ; address of envelope Subject
  2289. ENVFRM==2            ; address of envelope From
  2290. ENVSDR==3            ; address of envelope Sender
  2291. ENVREP==4            ; address of envelope Reply-To
  2292. ENVTO==5            ; address of envelope To
  2293. ENVCC==7            ; address of envelope cc
  2294. ENVBCC==10            ; address of envelope bcc
  2295. ENVIRT==11            ; address of envelope In-Reply-To
  2296. ENVMID==12            ; address of envelope Message-ID
  2297. ENVLEN==13            ; length of envelope block
  2298.  
  2299. ; Format of an address block
  2300.  
  2301. ADRNAM==0            ; address personal name
  2302. ADRADL==1            ; address route list (a-d-l)
  2303. ADRMBX==2            ; address mailbox
  2304. ADRHST==3            ; address host
  2305. ADRCDR==4            ; pointer to next address
  2306. ADRLEN==5            ; length of an address block
  2307.  
  2308. ; Get an envelope for a message
  2309. ; Accepts: B/ message number
  2310. ;    CALL GETENV
  2311. ; Returns +1: Always, envelope pointer in D
  2312.  
  2313. GETENV:    SAVEAC <A,B,C>
  2314.     ACVAR <M,PTR,CTR>
  2315.     TRVAR <<HDRPTR,2>,<HEADER,3>>
  2316.     MOVEI M,-1(B)        ; determine index into data structure
  2317.     IMULI M,MSGLEN
  2318.     MOVX D,ENVLEN        ; length of envelope block
  2319.     CALL FSGET
  2320.     MOVEM D,MSGENV(M)    ; save envelope pointer
  2321.     SKIPE CTR,MSGHSZ(M)    ; get header size
  2322.     IFSKP.
  2323.       MOVE B,M        ; not known yet, set up index
  2324.       CALL FNDHSZ        ; find the header
  2325.       MOVE CTR,MSGHSZ(M)
  2326.     ENDIF.
  2327.     MOVE PTR,MSGPTR(M)    ; pointer to header
  2328.     DO.
  2329.       CALL GETLIN        ; get an RFC 822 text line
  2330.        EXIT.        ; didn't get one
  2331.       DMOVE A,[OWGP. 7,WRKBUF ; point to header line
  2332.            POINT 7,HEADER] ; and to where we store the item
  2333.       DMOVEM A,HDRPTR
  2334.       SETZM HEADER        ; init item
  2335.       SETZM 1+HEADER
  2336.       SETZM 2+HEADER
  2337.       MOVEI A,^D15        ; maximum header item length
  2338.       DO.
  2339.         ILDB C,HDRPTR    ; copy string, converting to uppercase
  2340.         JUMPE C,ENDLP.    ; with appropriate terminating cases...
  2341.         CAIE C,.CHSPC
  2342.          CAIN C,.CHTAB
  2343.           EXIT.
  2344.         CAIN C,":"
  2345.          EXIT.
  2346.         CAIL C,"a"
  2347.          CAILE C,"z"
  2348.           TRNA
  2349.            SUBI C,"a"-"A"
  2350.         IDPB C,1+HDRPTR
  2351.         SOJG A,TOP.
  2352.       ENDDO.
  2353.       JUMPLE A,TOP.        ; can't possibly win if ran out
  2354.       CAIN C,":"        ; saw the delimiter
  2355.       IFSKP.
  2356.         CALL SKIPWS
  2357.         ILDB C,HDRPTR    ; get delimiter
  2358.         CAIE C,":"        ; saw appropriate delimiter?
  2359.          LOOP.        ; no, this line can't possibly win then
  2360.       ENDIF.
  2361.  
  2362. ; Do appropriate processing for this header line
  2363.  
  2364.       CALL SKIPWS
  2365.       DMOVE A,HEADER    ; now, get the header item
  2366.       MOVE C,2+HEADER
  2367.       CAME A,[ASCII/DATE/]
  2368.       IFSKP.
  2369.         MOVE A,HDRPTR    ; text to copy
  2370.         CALL CPYSTR
  2371.         MOVEM A,ENVDAT(D)    ; store the date we parsed
  2372.         LOOP.
  2373.       ENDIF.
  2374.       CAMN A,[ASCII/SUBJE/]
  2375.        CAME B,[ASCII/CT/]
  2376.       IFSKP.
  2377.         MOVE A,HDRPTR    ; text to copy
  2378.         CALL CPYSTR
  2379.         MOVEM A,ENVSUB(D)    ; save pointer to subject in envelope
  2380.         LOOP.
  2381.       ENDIF.
  2382.       CAME A,[ASCII/FROM/]
  2383.       IFSKP.
  2384.         MOVE A,HDRPTR    ; string to parse
  2385.         XMOVEI B,ENVFRM(D)    ; location to store address list
  2386.         CALL GETADR        ; parse address
  2387.         LOOP.
  2388.       ENDIF.
  2389.       CAMN A,[ASCII/SENDE/]
  2390.        CAME B,[ASCII/R/]
  2391.       IFSKP.
  2392.         MOVE A,HDRPTR    ; string to parse
  2393.         XMOVEI B,ENVSDR(D)    ; location to store address list
  2394.         CALL GETADR        ; parse address
  2395.         LOOP.
  2396.       ENDIF.
  2397.       CAMN A,[ASCII/REPLY/]
  2398.        CAME B,[ASCII/-TO/]
  2399.       IFSKP.
  2400.         MOVE A,HDRPTR    ; string to parse
  2401.         XMOVEI B,ENVREP(D)    ; location to store address list
  2402.         CALL GETADR        ; parse address
  2403.         LOOP.
  2404.       ENDIF.
  2405.  
  2406.       CAME A,[ASCII/TO/]
  2407.       IFSKP.
  2408.         MOVE A,HDRPTR    ; string to parse
  2409.         XMOVEI B,ENVTO(D)    ; location to store address list
  2410.         CALL GETADR        ; parse address
  2411.         LOOP.
  2412.       ENDIF.
  2413.       CAME A,[ASCII/CC/]
  2414.       IFSKP.
  2415.         MOVE A,HDRPTR    ; string to parse
  2416.         XMOVEI B,ENVCC(D)    ; location to store address list
  2417.         CALL GETADR        ; parse address
  2418.         LOOP.
  2419.       ENDIF.
  2420.       CAME A,[ASCII/BCC/]
  2421.       IFSKP.
  2422.         MOVE A,HDRPTR    ; string to parse
  2423.         XMOVEI B,ENVBCC(D)    ; location to store address list
  2424.         CALL GETADR        ; parse address
  2425.         LOOP.
  2426.       ENDIF.
  2427.       CAMN A,[ASCII/IN-RE/]
  2428.        CAME B,[ASCII/PLY-T/]
  2429.       IFSKP.
  2430.         CAME C,[ASCII/O/]
  2431.       ANSKP.
  2432.         MOVE A,HDRPTR    ; treat as text for now
  2433.         CALL CPYSTR
  2434.         MOVEM A,ENVIRT(D)    ; save pointer in envelope
  2435.         LOOP.
  2436.       ENDIF.
  2437.       CAMN A,[ASCII/MESSA/]
  2438.        CAME B,[ASCII/GE-ID/]
  2439.       IFSKP.
  2440.       ANDE. C
  2441.         MOVE A,HDRPTR    ; treat as text for now
  2442.         CALL CPYSTR
  2443.         MOVEM A,ENVMID(D)    ; save pointer in envelope
  2444.         LOOP.
  2445.       ENDIF.
  2446.       LOOP.
  2447.     ENDDO.
  2448.  
  2449. ; Default parts of the envelope
  2450.  
  2451.     MOVE B,ENVFRM(D)    ; default Sender and Reply-to
  2452.     SKIPN ENVSDR(D)        ; set default Sender if none in header
  2453.      MOVEM B,ENVSDR(D)
  2454.     SKIPN ENVREP(D)        ; set default Reply-to if none in header
  2455.      MOVEM B,ENVREP(D)
  2456.     RET
  2457.  
  2458. SKIPWS:    SAVEAC <A>
  2459.     DO.
  2460.       MOVE A,HDRPTR        ; skip whitespace
  2461.       ILDB A,A
  2462.       CAIE A,.CHSPC
  2463.        CAIN A,.CHTAB
  2464.       IFNSK.
  2465.         IBP HDRPTR
  2466.         LOOP.
  2467.       ENDIF.
  2468.     ENDDO.
  2469.     RET
  2470.  
  2471.     ENDTV.
  2472.  
  2473. ; Get an RFC822 line, called only from GETENV
  2474. ; Accepts: PTR/ current RFC822 header pointer
  2475. ;       CTR/ number of bytes left in header
  2476. ;    CALL GETLIN
  2477. ; Returns +1: Didn't get a line
  2478. ;      +2: Got a line in WRKBUF
  2479.  
  2480. GETLIN:    SAVEAC <A,B,C,D>    ; D used as a flag for unparsed text
  2481.     MOVE A,[OWGP. 7,WRKBUF] ; stash line in here
  2482.     SETZB D,@[WRKBUF]    ; empty line
  2483.  
  2484. ;  Flush any leading whitespace or otherwise strange things.  This is
  2485. ; paranoia code and none of these conditions should ever happen with a
  2486. ; well-formed RFC822 header.
  2487.  
  2488.     DO.
  2489.       MOVE C,PTR        ; guard against perverse start of line
  2490.       CAIE C,.CHSPC        ; LWSP
  2491.        CAIN C,.CHTAB
  2492.       IFSKP.
  2493.         CAIE C,.CHCRT    ; CR
  2494.          CAIN C,"("        ; start of comment
  2495.       ANSKP.        ; looks OK
  2496.       ELSE.
  2497.         SOJL CTR,R        ; ugh, skip over this crap
  2498.         ILDB C,PTR
  2499.         LOOP.        ; let's hope the next one is nicer...
  2500.       ENDIF.
  2501.     ENDDO.
  2502.  
  2503. ; Copy line
  2504.  
  2505.     DO.
  2506.       SOJL CTR,R        ; quit if out of header
  2507.       ILDB C,PTR        ; get character from header
  2508.       IFE. D        ; if we don't know whether text or not
  2509.         CAIE C,":"        ; have delimiting colon?
  2510.       ANSKP.
  2511.         IDPB C,A        ; yes, stash it in the string
  2512.         LDB B,[OWGP. 7,WRKBUF+1,<^D20>] ; sniff at delimiting character
  2513.         CAIN B,":"        ; is it expected ":"
  2514.         IFSKP.
  2515.           CAIE B,.CHTAB    ; no, then it had better be whitespace!
  2516.            CAIN B,.CHSPC
  2517.         ANSKP.
  2518.           AOJA D,TOP.    ; it isn't, so assume we must parse it!
  2519.         ENDIF.
  2520.         DMOVE B,@[WRKBUF]    ; get first two words of line
  2521.         AND B,[BYTE (7) 137,137,137,137,137] ; make sure uppercase
  2522.         AND C,[BYTE (7) 137,137,0,0,0]
  2523.         CAMN B,[ASCII/SUBJE/] ; look like a Subject: line?
  2524.          CAME C,[ASCII/CT/]
  2525.           AOJA D,TOP.    ; no, flag that we must parse it
  2526.         SOJA D,TOP.        ; yes, flag that it's non-parsed text
  2527.       ENDIF.
  2528.       IFGE. D        ; needs pre-parsing?
  2529.         CAIE C,"\"        ; yes, quoted-pair?
  2530.         IFSKP.
  2531.           IDPB C,A        ; yes, store it in string
  2532.           SOJL CTR,R    ; get next character
  2533.           ILDB C,PTR
  2534.           IDPB C,A
  2535.          LOOP.
  2536.         ENDIF.
  2537.  
  2538. ; Handle quoted string
  2539.  
  2540.         CAIE C,""""        ; quoted-string?
  2541.         IFSKP.
  2542.           IDPB C,A        ; store open quote
  2543.           DO.
  2544.         SOJL CTR,R
  2545.         ILDB C,PTR
  2546.         CAIE C,.CHCRT    ; end of line?
  2547.         IFSKP.
  2548.           SOJL CTR,R    ; get expected LF
  2549.           ILDB C,PTR
  2550.           CAIE C,.CHLFD
  2551.         ANSKP.
  2552.           SOJL CTR,R    ; get expected LWSP-char
  2553.           ILDB C,PTR
  2554.         ENDIF.
  2555.         IDPB C,A    ; store character in the string
  2556.         CAIE C,"\"    ; quoted-pair?
  2557.         IFSKP.
  2558.           SOJL CTR,R    ; get next character
  2559.               ILDB C,PTR
  2560.               IDPB C,A
  2561.               LOOP.
  2562.         ENDIF.
  2563.         CAIE C,""""    ; end of quote?
  2564.          LOOP.        ; no, get next character
  2565.           ENDDO.
  2566.           LOOP.
  2567.         ENDIF.
  2568.  
  2569. ; Handle comment
  2570.  
  2571.         CAIE C,"("        ; comment?
  2572.         IFSKP.
  2573.           SETZ B,        ; initialize nesting count
  2574.           DO.
  2575.         SOJL CTR,R
  2576.         ILDB C,PTR    ; get next character
  2577.         CAIE C,.CHCRT    ; end of line?
  2578.         IFSKP.
  2579.           SOJL CTR,R    ; get expected LF
  2580.           ILDB C,PTR
  2581.           CAIE C,.CHLFD
  2582.         ANSKP.
  2583.           SOJL CTR,R    ; get expected LWSP-char
  2584.           ILDB C,PTR
  2585.         ENDIF.
  2586.         CAIE C,"\"    ; quoted-pair?
  2587.         IFSKP.
  2588.               SOJL CTR,R    ; yes, skip next character
  2589.               ILDB C,PTR
  2590.           LOOP.
  2591.         ENDIF.
  2592.         CAIN C,"("    ; nested comment?
  2593.          AOJA B,TOP.    ; yes, increment nest count
  2594.         CAIE C,")"    ; end of comment?
  2595.          LOOP.        ; no
  2596.         SOJGE B,TOP.    ; yes, decrement nest count and maybe finish
  2597.           ENDDO.
  2598.           MOVX C,.CHSPC    ; make it into LWSP
  2599.         ENDIF.
  2600.  
  2601. ; Whitespace
  2602.  
  2603.         CAIE C,.CHTAB    ; LWSP-char?
  2604.          CAIN C,.CHSPC
  2605.       ANNSK.
  2606.         DO.
  2607.           MOVE C,PTR    ; sniff at next character
  2608.           ILDB C,C
  2609.           CAIE C,.CHTAB    ; LWSP-char?
  2610.            CAIN C,.CHSPC
  2611.           IFNSK.
  2612.         SOJL CTR,R    ; yes, skip this character
  2613.         IBP PTR
  2614.         LOOP.
  2615.           ENDIF.
  2616.         ENDDO.
  2617.         LDB B,A        ; see if LWSP already stored
  2618.         CAIN B,.CHSPC
  2619.         IFSKP.
  2620.           MOVX B,.CHSPC    ; no, store a single LWSP
  2621.           IDPB B,A
  2622.         ENDIF.
  2623.         LOOP.        ; try next character
  2624.       ENDIF.
  2625.  
  2626.  
  2627. ; End of line (always come here whether or not parsable)
  2628.  
  2629.       CAIE C,.CHCRT        ; end of line?
  2630.       IFSKP.
  2631.         MOVE B,PTR        ; could be, sniff at next character
  2632.         ILDB B,B
  2633.         CAIE B,.CHLFD    ; so, is it really EOL?
  2634.       ANSKP.
  2635.         SETZ C,        ; yes, tie off line here
  2636.         MOVE B,A        ; but be prepared for continuation so don't
  2637.         IDPB C,B        ;  step on A
  2638.         IBP PTR        ; skip past the LF
  2639.         SOJLE CTR,ENDLP.    ; guard against the header ending
  2640.         MOVE C,PTR        ; sniff at next line
  2641.         ILDB C,C
  2642.         CAIE C,.CHTAB    ; LWSP-char?
  2643.          CAIN C,.CHSPC
  2644.           LOOP.        ; yes, continue eating text
  2645.       ELSE.
  2646.         IDPB C,A        ; no, store this character
  2647.         LOOP.        ; and get more text
  2648.       ENDIF.
  2649.     ENDDO.
  2650.     SKIPN @[WRKBUF]        ; did we get any line at all?
  2651.      RET            ; no, probably end of header
  2652.     RETSKP
  2653.  
  2654.     ENDAV.
  2655.  
  2656. ; Get an RFC 822 address list
  2657. ; Accepts: A/ pointer to address list string
  2658. ;       B/ address of location to store list pointer
  2659. ;    CALL GETADR
  2660. ; Returns +1: Always
  2661. ;  This routine is quite a bit more generous than RFC 822 in what it will
  2662. ; swallow, since there are still all sorts of gross address composers out
  2663. ; there that generate flagrantly illegal addresses.
  2664.  
  2665. GETADR:    SAVEAC <C,D>
  2666.     TRVAR <CURPTR,NWSPTR,GRPCNT>
  2667.     CALL CPYSTR        ; copy string to free storage
  2668.     SETZM GRPCNT        ; init group count
  2669.     DO.
  2670.       SKIPN D,(B)        ; run down this address list until at the
  2671.       IFSKP.        ;  end, since something may already be there.
  2672.         XMOVEI B,ADRCDR(D)    ;  B will have the address of the slot to put
  2673.         LOOP.        ;  in any new addresses
  2674.       ENDIF.
  2675.     ENDDO.
  2676.  
  2677. ; Loop for each address
  2678.  
  2679.     DO.
  2680.       DO.
  2681.         MOVE C,A        ; skip leading whitespace
  2682.         ILDB C,C
  2683.         CAIE C,.CHSPC
  2684.          CAIN C,.CHTAB
  2685.         IFNSK.
  2686.           IBP A
  2687.           LOOP.
  2688.         ENDIF.
  2689.       ENDDO.
  2690.       MOVEM A,CURPTR    ; init "current pointer"
  2691.       SETZM NWSPTR        ; init "non-whitespace pointer"
  2692.  
  2693. ; Handle a possible personal name
  2694.  
  2695.       DO.            ; slurp up a phrase
  2696.         ILDB C,A
  2697.         JUMPE C,ENDLP.    ; end of string
  2698.         CAIE C,"\"        ; quoted character?
  2699.         IFSKP.
  2700.           IBP A        ; yes, skip next character
  2701.           MOVEM A,NWSPTR
  2702.           LOOP.
  2703.         ENDIF.
  2704.         CAIE C,""""        ; quoted string?
  2705.         IFSKP.
  2706.           DO.
  2707.         ILDB C,A    ; yes, search for unquote
  2708.         CAIN C,"\"    ; in case quoted quote
  2709.          IBP A
  2710.         CAIE C,""""    ; found unquote yet?
  2711.          JUMPN C,TOP.    ; nope
  2712.           ENDDO.
  2713.           MOVEM A,NWSPTR    ; new end of whitespace
  2714.         ENDIF.
  2715.  
  2716. ; Deal with the possibility of <group>: <stuff> ;
  2717.  
  2718.         CAIE C,":"        ; definite group phrase?
  2719.         IFSKP.
  2720.           DO.
  2721.         MOVE C,A    ; yes, skip any whitespace
  2722.         ILDB C,C
  2723.         CAIE C,.CHSPC
  2724.          CAIN C,.CHTAB
  2725.         IFNSK.
  2726.           IBP A        ; another bit of whitespace to skip
  2727.           LOOP.
  2728.         ENDIF.
  2729.           ENDDO.
  2730.           AOS GRPCNT    ; bump number of groups
  2731.           SETZM NWSPTR    ; toss out this entire phrase!
  2732.           MOVEM A,CURPTR
  2733.           EXIT.
  2734.         ENDIF.
  2735.         SKIPE GRPCNT    ; group in effect?
  2736.          CAIE C,";"        ; yes, end of group?
  2737.         IFSKP.
  2738.           SOS GRPCNT    ; yes, decrement number of groups
  2739.           MOVX C,","    ; and treat like comma
  2740.         ENDIF.
  2741.         CAIE C,.CHLAB    ; saw a definite route-addr?
  2742.          CAIN C,","        ; or definite end of this address?
  2743.         IFSKP.
  2744.           CAIE C,.CHSPC    ; not yet, is it whitespace?
  2745.            CAIN C,.CHTAB
  2746.           IFSKP. <MOVEM A,NWSPTR> ; no, save non-whitespace pointer
  2747.           LOOP.        ; continue scan
  2748.         ENDIF.
  2749.       ENDDO.
  2750.  
  2751. ; End of a phrase.  If NWSPTR is zero then there's nothing to look at
  2752.  
  2753.       SKIPN C        ; end of line?
  2754.        SETZ A,        ; yes, note that
  2755.       SKIPN NWSPTR        ; parsed anything at all?
  2756.        CAIN C,.CHLAB    ; no, but do we see an address now?
  2757.       IFNSK.
  2758.         MOVX D,ADRLEN    ; yes to either, get an address block
  2759.         CALL FSGET
  2760.         MOVEM D,(B)        ; cons it to the end of the old list
  2761.  
  2762. ; See if need to handle route-addr
  2763.  
  2764.         CAIE C,.CHLAB    ; route-addr following?
  2765.         IFSKP.
  2766.           SETZ C,        ; tie off string we parsed
  2767.           SKIPN NWSPTR    ; only do this if we saw a phrase
  2768.           IFSKP.
  2769.         IDPB C,NWSPTR
  2770.         MOVE C,CURPTR    ; save phrase as personal name
  2771.           ENDIF.
  2772.           MOVEM C,ADRNAM(D)
  2773.           DO.
  2774.         MOVE C,A    ; skip whitespace
  2775.         ILDB C,C
  2776.         CAIE C,.CHSPC
  2777.          CAIN C,.CHTAB
  2778.         IFNSK.
  2779.           IBP A
  2780.           LOOP.
  2781.         ENDIF.
  2782.           ENDDO.
  2783.  
  2784. ; Handle A-D-L
  2785.  
  2786.           MOVE C,A        ; see if there's an A-D-L
  2787.           ILDB C,C
  2788.           CAIE C,"@"    ; is there?
  2789.           IFSKP.
  2790.         MOVEM A,ADRADL(D) ; yes, save that pointer
  2791.         DO.
  2792.           ILDB C,A    ; look for end of A-D-L
  2793.           CAIN C,"\"    ; handle quotes
  2794.            IBP A
  2795.           CAIE C,""""    ; and this form too
  2796.           IFSKP.
  2797.             DO.
  2798.               ILDB C,A
  2799.               CAIE C,"\"
  2800.                IBP A
  2801.               CAIE C,""""
  2802.                JUMPN C,TOP.
  2803.             ENDDO.
  2804.           ENDIF.
  2805.           CAIE C,":"    ; end of A-D-L?
  2806.           IFSKP.
  2807.             SETZ C,
  2808.             DPB C,A
  2809.           ENDIF.
  2810.           JUMPN C,TOP.
  2811.         ENDDO.
  2812.           ENDIF.
  2813.           MOVEM A,CURPTR    ; note current pointer
  2814.           MOVEM A,NWSPTR
  2815.  
  2816. ; Look for end of route-addr
  2817.  
  2818.           DO.
  2819.         ILDB C,A    ; look for closing broket
  2820.         CAIN C,"\"    ; handle quotes
  2821.          IBP A
  2822.         CAIE C,""""    ; and this form too
  2823.         IFSKP.
  2824.           DO.
  2825.             ILDB C,A
  2826.             CAIE C,"\"
  2827.              IBP A
  2828.             CAIE C,""""
  2829.              JUMPN C,TOP.
  2830.           ENDDO.
  2831.         ENDIF.
  2832.         CAIN C,.CHRAB
  2833.          EXIT.
  2834.         CAIE C,.CHSPC    ; so we can skip over whitespace
  2835.          CAIN C,.CHTAB
  2836.         IFSKP. <MOVEM A,NWSPTR>
  2837.         JUMPN C,TOP.
  2838.         SETZ A,        ; note line ended
  2839.           ENDDO.
  2840.           CAIE C,.CHRAB    ; this terminated it?
  2841.         ANSKP.
  2842.           DO.
  2843.         ILDB C,A    ; flush until a comma
  2844.         CAIE C,","
  2845.          JUMPN C,TOP.
  2846.           ENDDO.
  2847.           SKIPN C        ; end of line?
  2848.            SETZ A,        ; yes, note that
  2849.         ENDIF.
  2850.  
  2851. ; Found end of route-addr or there wasn't a route-addr.  Now know mailbox
  2852.  
  2853.         SETZ C,        ; tie off string we parsed
  2854.         IDPB C,NWSPTR
  2855.         MOVE C,CURPTR    ; get pointer to mailbox name
  2856.         MOVEM C,NWSPTR
  2857.         MOVEM C,ADRMBX(D)    ; save it
  2858.  
  2859. ; Locate host
  2860.  
  2861.         DO.
  2862.           ILDB C,CURPTR    ; search for host delimiter
  2863.           JUMPE C,ENDLP.
  2864.           CAIN C,"\"    ; quoted character?
  2865.            IBP CURPTR    ; yes, skip next character
  2866.           CAIE C,""""    ; quoted string?
  2867.           IFSKP.
  2868.         DO.
  2869.           ILDB C,CURPTR    ; yes, look for unquote
  2870.           CAIN C,"\"
  2871.           IBP CURPTR
  2872.           CAIE C,""""
  2873.           JUMPN C,TOP.
  2874.         ENDDO.
  2875.           ENDIF.
  2876.           CAIE C,"@"    ; saw host?
  2877.           IFSKP.
  2878.         SETZ C,        ; tie off string
  2879.         IDPB C,NWSPTR
  2880.         DO.
  2881.           MOVE C,CURPTR    ; flush leading whitespace
  2882.           ILDB C,C
  2883.           CAIE C,.CHSPC
  2884.            CAIN C,.CHTAB
  2885.           IFNSK.
  2886.             IBP CURPTR
  2887.             LOOP.
  2888.           ENDIF.
  2889.         ENDDO.
  2890.             MOVE C,CURPTR    ; store host
  2891.             MOVEM C,ADRHST(D)
  2892.           ENDIF.
  2893.           CAIE C,.CHSPC    ; not yet, is it whitespace?
  2894.            CAIN C,.CHTAB
  2895.           IFSKP.
  2896.         MOVE C,CURPTR    ; no, save as non-whitespace pointer
  2897.         MOVEM C,NWSPTR
  2898.           ENDIF.
  2899.           LOOP.        ; continue scan
  2900.         ENDDO.
  2901.       ENDIF.
  2902.  
  2903. ; Have all the envelope fields, now get rid of RFC 822 quoting conventions
  2904.  
  2905.       SKIPE B,ADRNAM(D)    ; remove RFC 822 quotes from the fields
  2906.        CALL FLSQOT
  2907.       SKIPE B,ADRADL(D)
  2908.        CALL FLSQOT
  2909.       SKIPE B,ADRMBX(D)
  2910.        CALL FLSQOT
  2911.       SKIPE B,ADRHST(D)
  2912.        CALL FLSQOT
  2913.       XMOVEI B,ADRCDR(D)    ; set up new end of list pointer
  2914.       JUMPN A,TOP.        ; parse remainder of string
  2915.     ENDDO.
  2916.     RET
  2917.  
  2918.     ENDTV.
  2919.  
  2920. ; Flush RFC 822 quotes from string
  2921. ; Accepts: B/ source/destination string pointer
  2922. ;     CALL FLSQOT
  2923. ; Returns +1: Always
  2924.  
  2925. FLSQOT:    SAVEAC <A,C>
  2926.     MOVE A,B        ; destination will overwrite source
  2927.     DO.
  2928.       ILDB C,A        ; copy from source
  2929.       CAIE C,""""        ; quoted string
  2930.       IFSKP.
  2931.         DO.
  2932.           ILDB C,A
  2933.           CAIN C,""""    ; end of string?
  2934.            EXIT.        ; yes
  2935.           CAIE C,"\"    ; quoted character?
  2936.           IFSKP.
  2937.         ILDB C,A    ; yes, copy next character without checking
  2938.         IDPB C,B
  2939.           ELSE.
  2940.         IDPB C,B    ; else copy this one and quit if end of string
  2941.         JUMPE C,R
  2942.           ENDIF.
  2943.           LOOP.        ; do next character in quoted string
  2944.         ENDDO.
  2945.         LOOP.        ; do next character in primary string
  2946.       ENDIF.
  2947.       CAIE C,"\"        ; quoted character?
  2948.       IFSKP.
  2949.         ILDB C,A        ; yes, get next character literally
  2950.         IDPB C,B        ; copy to destination
  2951.       ELSE.
  2952.         IDPB C,B        ; copy to destination
  2953.         JUMPE C,R
  2954.       ENDIF.
  2955.       LOOP.
  2956.     ENDDO.
  2957.     SUBTTL Output buffer routines
  2958.  
  2959. ; Output address to buffer
  2960. ; Accepts: A/ destination buffer poitner
  2961. ;       B/ address
  2962. ;    CALL BFADR
  2963. ; Returns +1: Always
  2964.  
  2965. BFADR:    ACVAR <ADR>
  2966.     SKIPN ADR,B        ; get address in ADR
  2967.      JRST BFNIL        ; if NIL then punt now
  2968.     MOVEI B,"("        ; open the address list
  2969.     IDPB B,A
  2970.     DO.
  2971.       MOVEI B,"("        ; open the address
  2972.       IDPB B,A
  2973.       MOVE B,ADRNAM(ADR)    ; get personal name
  2974.       CALL BFSTR
  2975.       MOVE B,ADRADL(ADR)    ; get route list
  2976.       CALL BFSTR
  2977.       MOVE B,ADRMBX(ADR)    ; get mailbox
  2978.       CALL BFSTR
  2979.       MOVE B,ADRHST(ADR)    ; get host
  2980.       CALL BFSTR
  2981.       MOVEI B,")"        ; terminate address
  2982.       DPB B,A
  2983.       MOVE ADR,ADRCDR(ADR)    ; see if any more addresses
  2984.       JUMPN ADR,TOP.
  2985.     ENDDO.
  2986.     MOVEI B,")"        ; terminate address list
  2987.     IDPB B,A
  2988.     MOVX B,.CHSPC
  2989.     IDPB B,A
  2990.     RET
  2991.  
  2992.     ENDAV.
  2993.  
  2994. ; Output NIL to buffer
  2995. ; Accepts: A/ destination buffer poitner
  2996. ;    CALL BFNIL
  2997. ; Returns +1: Always
  2998.  
  2999. BFNIL:    SAVEAC <B>
  3000.     HRROI B,[ASCIZ/NIL /]    ; dump a NIL to the buffer
  3001.     CALLRET BFSOUT
  3002.  
  3003. ; Output string to buffer, using IMAP literal form if necessary
  3004. ; Accepts: A/ destination buffer poitner
  3005. ;       B/ string
  3006. ;    CALL BFSTR
  3007. ; Returns +1: Always
  3008.  
  3009. BFSTR:    SAVEAC <C,D>
  3010.     ACVAR <PTR,FLG>
  3011.     JUMPE B,BFNIL        ; NIL if empty
  3012.     MOVE PTR,B        ; copy pointer
  3013.     SETZB C,FLG        ; initialize count
  3014.     DO.
  3015.       ILDB D,PTR        ; sniff at string
  3016.       JUMPE D,ENDLP.
  3017.       CAIE D,""""        ; have a special?
  3018.        CAIN D,"{"
  3019.       IFSKP.
  3020.         CAIE D,.CHCRT    ; this makes it special too
  3021.          CAIN D,.CHLFD    ; paranoia
  3022.       ANSKP.
  3023.         CAIE D,"%"        ; coddle Interlisp
  3024.          CAIN D,"\"        ; coddle Commonlisp
  3025.       ANSKP.
  3026.       ELSE.
  3027.         SETO FLG,        ; mark as special
  3028.       ENDIF.
  3029.       AOJA C,TOP.        ; count character and continue
  3030.     ENDDO.
  3031.     IFN. FLG
  3032.       CALL BFBLAT        ; blat the string if there are specials
  3033.     ELSE.
  3034.       MOVX C,""""        ; quote the string
  3035.       IDPB C,A
  3036.       CALL BFSOUT        ; output the string
  3037.       MOVX C,""""        ; quote the string
  3038.       IDPB C,A
  3039.     ENDIF.
  3040.     MOVX C,.CHSPC        ; output a trailing space
  3041.     IDPB C,A
  3042.     RET
  3043.  
  3044.     ENDAV.
  3045.  
  3046. ; Output decimal number to buffer
  3047. ; Accepts: A/ destination buffer poitner
  3048. ;       B/ number
  3049. ;    CALL BFNOUT
  3050. ; Returns +1: Always
  3051.  
  3052. BFNOUT:    SAVEAC <B,C>
  3053.     DO.
  3054.       IDIVI B,^D10        ; get low-order digit
  3055.       PUSH P,C        ; save for later
  3056.       SKIPE B        ; any more?
  3057.        CALL TOP.        ; yes, recurse
  3058.     ENDDO.
  3059.     POP P,B            ; get digit back
  3060.     ADDI B,"0"        ; make decimal
  3061.     IDPB B,A        ; output it
  3062.     RET            ; decurse
  3063.  
  3064. ; Output CRLF to buffer, with parenthesis closing if necessary
  3065. ; Accepts: A/ destination buffer poitner
  3066. ;    CALL BFCRLF
  3067. ; Returns +1: Always
  3068.  
  3069. BFCRLF:    IFQE. <F%NCL>
  3070.       HRROI B,[ASCIZ/)
  3071. /]
  3072.     ELSE.
  3073.       HRROI B,[ASCIZ/ /]
  3074.     ENDIF.
  3075. ;    CALLRET BFSOUT
  3076.  
  3077. ; Output string to buffer
  3078. ; Accepts: A/ destination buffer poitner
  3079. ;       B/ source string pointer
  3080. ;    CALL BFSOUT
  3081. ; Returns +1: Always
  3082.  
  3083. BFSOUT:    SAVEAC <C>
  3084.     TXC B,.LHALF        ; check for -1 type pointer
  3085.     TXCN B,.LHALF
  3086.      HRLI B,<(POINT 7,)>
  3087.     DO.            ; boring string copy...
  3088.       ILDB C,B
  3089.       IFN. C
  3090.         IDPB C,A
  3091.         LOOP.
  3092.       ENDIF.
  3093.     ENDDO.
  3094.     RET
  3095.  
  3096. ; Blat a literal from string to buffer
  3097. ; Accepts: A/ destination buffer pointer
  3098. ;       B/ pointer to string
  3099. ;       C/ length of string
  3100. ;       D/ leading string to output
  3101. ;    CALL BFBLAT
  3102. ; Returns: +1 Always
  3103.  
  3104. BFBLAT:    ACVAR <Q0,Q1,Q2,Q3,Q4,Q5> ; get a bunch of AC's
  3105.     MOVE Q0,C        ; source count
  3106.     MOVE Q1,B        ; source byte pointer
  3107.     SKIPN B,D        ; output property name
  3108.     IFSKP.
  3109.       CALL BFSOUT
  3110.       MOVX B,.CHSPC
  3111.       IDPB B,A
  3112.     ENDIF.
  3113.     MOVX B,"{"        ; start literal
  3114.     IDPB B,A
  3115.     MOVE B,Q0        ; output count
  3116.     CALL BFNOUT
  3117.     HRROI B,[ASCIZ/}
  3118. /]
  3119.     CALL BFSOUT
  3120.     SETZB Q2,Q5        ; we're using 1-word byte pointers
  3121.     MOVE Q3,C        ; destination count
  3122.     MOVE Q4,A        ; destination byte pointer
  3123.     EXTEND Q0,[MOVSLJ    ; blat the string
  3124.            0]        ; with a zero fill
  3125.      CALL MOVBOG        ; this absolutely cannot happen
  3126.     IFE. Q5            ; got a OWGBP or a GBP?
  3127.       MOVE A,Q4        ; this microcode gives us a OWGBP back
  3128.     ELSE.
  3129.       TLC Q4,000740        ; clear bits for "global POINT 7,0,35"
  3130.       TXNE Q4,<MASKB 6,35>    ; make sure no bozo bits set
  3131.        CALL MOVBOG
  3132.       LDB Q0,[POINT 6,Q4,5]    ; get position
  3133.       IDIVI Q0,7        ; divide by bytesize
  3134.       CAIG Q0,OWG7SZ
  3135.        CAIE Q1,1        ; is remainder correct?
  3136.         CALL MOVBOG        ; foo
  3137.       MOVE A,OWG7TB(Q0)    ; get correct pointer
  3138.       DPB Q5,[POINT 30,A,35] ; fill in GBP address
  3139.     ENDIF.
  3140.     RET
  3141.  
  3142.     ENDAV.
  3143.  
  3144.     RADIX 10
  3145.  
  3146. OWG7TB:    OWGP. 7,0,34
  3147.     OWGP. 7,0,27
  3148.     OWGP. 7,0,20
  3149.     OWGP. 7,0,13
  3150.     OWGP. 7,0,6
  3151.     OWGP. 7,0        ; I don't think this can happen
  3152. OWG7SZ==.-OWG7TB
  3153.  
  3154.     RADIX 8
  3155.  
  3156. MOVBOG:    TAGMSG <NO Impossible MOVSLJ error -- please report this!!>
  3157.     JRST IMPERR
  3158.     SUBTTL Free storage routines
  3159.  
  3160. ; Carve out a piece of free storage
  3161. ; Accepts: D/ length of desired block
  3162. ;    CALL FSGET
  3163. ; Returns +1: Always, with address of block in D
  3164.  
  3165. FSGET:    SAVEAC <A>
  3166.     EXCH D,FSFREE        ; get current free address
  3167.     ADDM D,FSFREE        ; claim the block
  3168.     SETZM (D)        ; clear first word of the block
  3169.     HRL A,D            ; set up BLT pointer
  3170.     HRRI A,1(D)
  3171.     BLT A,@FSFREE        ; zap the block
  3172.     RET
  3173.  
  3174. ; Copy text to free storage string
  3175. ; Accepts: A/ pointer to source string
  3176. ;    CALL CPYSTR
  3177. ; Returns +1: Always, address of string in A
  3178.  
  3179. CPYSTR:    TRVAR <SRC>
  3180.     MOVEM A,SRC
  3181.     MOVE A,[OWGP. 7,0]    ; copy remainder of line to free storage
  3182.     ADD A,FSFREE
  3183.     SAVEAC <A,C>        ; return address to caller
  3184.     DO.
  3185.       ILDB C,SRC
  3186.       IDPB C,A
  3187.       JUMPN C,TOP.
  3188.     ENDDO.
  3189.     ADDI A,1        ; move to next word of free space
  3190.     DPB A,[POINT 30,FSFREE,35] ; claim this free block
  3191.     RET
  3192.  
  3193.     ENDTV.
  3194.     SUBTTL Flag manipulation routines
  3195.  
  3196. ; Mark message as having been seen
  3197. ; Accepts: A/ buffer pointer
  3198. ;       B/ message number
  3199. ;    CALL MRKMSG
  3200. ; Returns +1: Always
  3201.  
  3202. MRKMSG:    SAVEAC <C,D>
  3203.     ACVAR <M>
  3204.     MOVEI M,-1(B)        ; determine index into data structure
  3205.     IMULI M,MSGLEN
  3206.     SKIPN IDXADR        ; have an index file?
  3207.     IFSKP.
  3208.       MOVE C,@IDXADR    ; get index last read TAD
  3209.       IFNJE.
  3210.         CAML C,MSGTAD(M)    ; is it earlier than this message?
  3211.       ANSKP.
  3212.         MOVE C,MSGTAD(M)    ; yes, update index
  3213.         MOVEM C,@IDXADR
  3214.       ENDIF.
  3215.     ELSE.
  3216.       MOVX C,M%SEEN        ; no, mark the message as having been seen
  3217.       IOR C,MSGFLG(M)
  3218.       CAMN C,MSGFLG(M)    ; was it already so marked?
  3219.     ANSKP.
  3220.       CALL STOFLG
  3221.        NOP
  3222.       XMOVEI D,[TQZ F%NCL    ; clear the flag
  3223.             RET]
  3224.       TQON F%NCL        ; temporarily say don't close the fetch
  3225.        PUSH P,D
  3226.       CALL .FTFLG        ; do a fetch of the new flags
  3227.     ENDIF.
  3228.     RET
  3229.  
  3230.     ENDAV.
  3231.  
  3232. ; Parse a list of flags
  3233. ; Accepts: ARGBUF/ output buffer
  3234. ;     CALL GETFLG
  3235. ; Returns +1: Failure, reason output
  3236. ;      +2: Success, flags in C
  3237.  
  3238. GETFLG:    SAVEAC <A,B,D>
  3239.     ACVAR <PTR,LST>
  3240.     SETZ C,            ; initially 0 flags
  3241.     MOVE PTR,[OWGP. 7,ARGBUF] ; starting pointer
  3242.     MOVE A,PTR
  3243.     ILDB A,A        ; get starting byte of flags argument
  3244.     IFN. A
  3245.       CAIN A,"("        ; start of a list?
  3246.        SKIPA LST,[-1]    ; yes, note that in list format
  3247.         TDZA LST,LST    ; no, not a list
  3248.          IBP PTR        ; skip over start of list
  3249.       DO.
  3250.         MOVSI D,-^D36    ; initialize iteration counter
  3251.         DO.
  3252.           MOVE A,FLGTAB(D)    ; flag to consider
  3253.           MOVE B,PTR    ; current flags argument
  3254.           STCMP%        ; test this flag
  3255.           IFN. A        ; exact match?
  3256.         IFXN. A,SC%SUB    ; no, see if subset
  3257.           ILDB A,B    ; it was a subset, get delimiting byte
  3258.           CAIE A,")"    ; end of list?
  3259.            CAIN A,.CHSPC ; was it a space?
  3260.             EXIT.    ; yes, found flag
  3261.         ENDIF.
  3262.         AOBJN D,TOP.    ; no win, see if matches next flag
  3263.         TAGMSG <NO Undefined flag>
  3264.         RET
  3265.           ELSE.        ; here if found flag at end of line
  3266.           ANDN. LST        ; was end of list required?
  3267.         TAGMSG <BAD Unterminated flag list>
  3268.         RET
  3269.           ENDIF.
  3270.         ENDDO.
  3271.         MOVEM B,PTR        ; update pointer
  3272.         IOR C,BITS(D)    ; update flag
  3273.         CAIE A,")"        ; end of list?
  3274.          JUMPN A,TOP.    ; no, if more flags to do go to them
  3275.       ENDDO.
  3276.     ENDIF.
  3277.     RETSKP
  3278.  
  3279.     ENDAV.
  3280.  
  3281. ; Store flags in mailbox
  3282. ; Accepts: B/ message number
  3283. ;       C/ new flags
  3284. ;    CALL STOFLG
  3285. ; Returns +1: Failure
  3286. ;      +2: Success
  3287.  
  3288. STOFLG:    JN F%RON,,RSKP        ; always fail if read-only
  3289.     SAVEAC <A,B,C,D>
  3290.     ACVAR <M,FLG>
  3291.     MOVEI M,-1(B)        ; determine index into data structure
  3292.     IMULI M,MSGLEN
  3293.     TRVAR <JFN>
  3294.     MOVE FLG,C
  3295.     CAMN FLG,MSGFLG(M)    ; same value as flags had before?
  3296.      RETSKP            ; yes, just return
  3297.     CALL MBXWRT        ; want to write into mailbox now
  3298.      RET            ; can't get it for write
  3299.     MOVEM A,JFN        ; save the JFN we got
  3300.     MOVE D,MSGIPT(M)    ; point to start of internal header
  3301.     DO.
  3302.       ILDB C,D        ; get header byte
  3303.       CAIE C,.CHCRT        ; at end of line??
  3304.       IFSKP.
  3305.         TAGMSG <NO Can't locate flags for this message>
  3306.         RET            ; sick mail file
  3307.       ENDIF.
  3308.       CAIE C,";"        ; at start of bits?
  3309.        LOOP.        ; not yet
  3310.     ENDDO.
  3311.     MOVE A,D        ; sniff ahead to see that they're flags
  3312.     MOVX C,^D12
  3313.     DO.
  3314.       ILDB B,A        ; sniff at a byte
  3315.       CAIL B,"0"        ; see if numeric
  3316.        CAILE B,"9"        ; well?
  3317.       IFNSK.
  3318.         TAGMSG <NO Improperly formatted flags for this message>
  3319.         RET            ; sick sick sick
  3320.       ENDIF.
  3321.       SOJG C,TOP.
  3322.     ENDDO.
  3323.  
  3324. ; Now change the flags
  3325.  
  3326.     LDB B,[POINT 21,D,26]    ; get page number of core address
  3327.     SUBI B,<MBXBUF/1000>    ; make disk page number
  3328.     HRL A,JFN        ; A/ JFN,,disk page
  3329.     HRR A,B            ;  . . .
  3330. LODWPG:!MOVE B,[.FHSLF,,WINPAG]    ; into our window page
  3331.     MOVX C,PM%CNT!PM%WR!PM%RD!2 ; map two pages with write access
  3332.     PMAP%
  3333.      ERCAL FATAL        ; blew it
  3334.     MOVEI B,WINPAG        ; get core address of window
  3335.     DPB B,[POINT 21,D,26]    ; set that in our pointer
  3336.     MOVE A,FLG        ; get flags to write
  3337.     MOVX C,^D12        ; there are twelve chars..
  3338.     DO.
  3339.       SETZ B,        ; compose next "digit"
  3340.       ROTC A,3
  3341.       ADDI B,"0"
  3342.       IDPB B,D        ; update this triplet
  3343.       SOJG C,TOP.
  3344.     ENDDO.
  3345.     SETO A,            ; now unmap the window pages
  3346. ;;;  On 21 October, 1986, I wasted over 4 hours in tracking down the cause of
  3347. ;;; phase errors due to the LIT area being 1 location bigger in pass 2 than in
  3348. ;;; pass 1.  I finally narrowed it down to this instruction.
  3349. ;;;    MOVE B,[.FHSLF,,WINPAG]
  3350.     XCT LODWPG        ; take that, you goddamned bagbiting assembler!
  3351.     MOVX C,PM%CNT!2
  3352.     PMAP%
  3353.      ERCAL FATAL
  3354.     MOVEM FLG,MSGFLG(M)    ; update core copy of flags
  3355.     RETSKP
  3356.  
  3357.     ENDTV.
  3358.     ENDAV.
  3359.     SUBTTL String search routine
  3360.  
  3361. ; Bounded search for pattern within string
  3362. ; Accepts: A/ OWGBP pointer to string to search in
  3363. ;       B/ string length
  3364. ;       ATOM/ pattern length
  3365. ;       ARGBUF/ pattern to search for
  3366. ;    CALL SEARCH
  3367. ; Returns +1: pattern not found
  3368. ;      +2: pattern found, A/ position of pattern within string
  3369.  
  3370. SEARCH:    SAVEAC <B,D>
  3371.     ACVAR <Q1,Q2,Q3,Q4,Q5,Q6>
  3372.     SKIPLE ATOM
  3373.     IFSKP.
  3374.       JUMPLE B,RSKP        ; win if there's no pattern
  3375.       RET            ; otherwise return failure
  3376.     ENDIF.
  3377.     SUB B,ATOM        ; difference between text and pattern
  3378.     JUMPL B,R        ;  lengths is the maximum # of tries
  3379.     LDB Q1,[POINT 6,A,5]    ; get byte position
  3380.     CAIE Q1,66        ; aligned on previous word boundary?
  3381.     IFSKP.
  3382.       TXC A,7B5        ; yes, normalize to 61 form
  3383.       ADDI A,1        ; by complementing 61#66 and adding 1
  3384.     ELSE.
  3385.       CAIE Q1,61        ; aligned to word boundary?
  3386.        JSP D,SEARQ        ; no, pattern may begin within this word
  3387.     ENDIF.
  3388.     LDB Q5,[OWGP. 7,ARGBUF,6] ; first character
  3389.     IMUL Q5,[BYTE (1)0 (7)1,1,1,1,1]
  3390.     MOVE Q6,Q5
  3391.     XOR Q6,[BYTE (1)0 (7)40,40,40,40,40]
  3392.     JSP D,.+1        ; come back to top if pattern not found
  3393.     DO.
  3394.       MOVE Q1,Q5        ; pattern to match
  3395.       MOVE Q2,Q6        ; case independent one
  3396.       LDB Q3,[POINT 30,A,35]
  3397.       MOVE Q3,(Q3)        ; word to try
  3398.       LSH Q3,-1        ; right justify text word
  3399.       MOVE Q4,Q3
  3400.       EQVB Q3,Q1        ; if the first pattern char is present
  3401.       EQVB Q4,Q2        ;  this results in '177' at that char
  3402.       ADD Q3,[BYTE (1)1 (7)1,1,1,1,1] ; add 1 to each char complementing LSB,
  3403.       ADD Q4,[BYTE (1)1 (7)1,1,1,1,1] ;  but note that any carry from '177'
  3404.       EQV Q3,Q1        ;  un-complements LSB of left char!
  3405.       EQV Q4,Q2        ; check sameness of each char LSB
  3406.       TDNN Q3,[BYTE (1)1 (7)1,1,1,1,1] ; if any char LSB remains the same
  3407.        TDNE Q4,[BYTE (1)1 (7)1,1,1,1,1] ;  then there is at least one match!
  3408.         JRST SEARQ        ; yes, go see!
  3409.       SUBI B,5        ; we just tested five chars
  3410.       JUMPL B,R        ; not found
  3411.       AOJA A,TOP.        ; try some more
  3412.     ENDDO.
  3413.  
  3414. SEARQ:    MOVE Q4,A        ; remember where we begin
  3415.     DO.
  3416.       MOVE Q1,[OWGP. 7,ARGBUF]
  3417.       DO.
  3418.         ILDB Q2,Q1        ; get next character
  3419.         JUMPE Q2,RSKP    ; null, we found a match
  3420.         ILDB Q3,A        ; get next char
  3421.         TRC Q3,(Q2)        ; XOR text and pattern chars
  3422.         SKIPE Q3        ; exact match?
  3423.          CAIN Q3,40        ; no, other case match?
  3424.           LOOP.        ; yes to either, try some more
  3425.       ENDDO.
  3426.       SOJL B,R        ; no, quit if we've run out of text
  3427.       IBP Q4        ; increment pointer to next char in word
  3428.       MOVE A,Q4        ; get back pointer
  3429.       LDB Q1,[POINT 6,A,5]    ; get position
  3430.       CAIE Q1,66        ; at end of word?
  3431.        LOOP.        ; no, keep on looking
  3432.     ENDDO.
  3433.     LDB A,[POINT 30,Q4,35]    ; address of this word
  3434.     ADD A,[OWGP. 7,1]    ; point to start of next word
  3435.     JRST (D)        ; not found this word, try some more
  3436.  
  3437.     ENDAV.
  3438.     SUBTTL Argument parsing routine
  3439.  
  3440. ; Copy an argument
  3441. ; Accepts: A/ destination pointer
  3442. ;       B/ current argument pointer
  3443. ;       C/ maximum length (negative if wholeline)
  3444. ;    CALL ARGCPY
  3445. ; Returns: +1 Failed
  3446. ;       +2 Success, A, B/ updated pointer or 0 if end of line,
  3447. ;        C/ argument length (also stored in ATOM)
  3448.  
  3449. ARGCPY:    SAVEAC <D>
  3450.     STKVAR <DEST,PTR>
  3451.     TLC A,-1        ; is LH -1?
  3452.     TLCN A,-1
  3453.      HRLI A,(<POINT 7,>)    ; make byte pointer
  3454.     ILDB D,B        ; sniff at first byte
  3455.     CAIE D,"{"        ; extended argument?
  3456.     IFSKP.
  3457.       MOVEM A,DEST        ; save destination pointer
  3458.       MOVMM C,ATOM        ; save maximum size
  3459.       MOVE A,B        ; source string for size string
  3460.       MOVX C,^D10        ; decimal radix
  3461.       NIN%
  3462.        ERJMP SYNERR        ; syntax error if bad
  3463.       SKIPLE B        ; value must be .GE. 0
  3464.        CAMLE B,ATOM        ; and not too large
  3465.       IFNSK.
  3466.         TAGMSG <BAD Literal argument too long>
  3467.         RET
  3468.       ENDIF.
  3469.       MOVEM B,ATOM        ; save argument length
  3470.       LDB C,A        ; check for termination
  3471.       CAIE C,"}"
  3472.        JRST SYNERR
  3473.       MOVEM A,PTR        ; save pointer
  3474.       ILDB C,A        ; get next command byte
  3475.       JUMPN C,SYNERR    ; better be end of line
  3476.       TMSG <+ Ready for argument>
  3477.       CALL CRLF
  3478.  
  3479. ; Get argument
  3480.  
  3481.       MOVX A,.PRIIN        ; from primary input
  3482.       MOVE B,DEST        ; where to put the string
  3483.       MOVN C,ATOM        ; size of string to read
  3484.       SIN%            ; read it in
  3485.        ERJMP INPEOF
  3486.       IDPB C,B        ; tie off string with null
  3487.       MOVE B,PTR        ; get return pointer
  3488.       MOVE C,CMDCNT        ; and free characters
  3489.       CALL GETCMD        ; get more of command
  3490.        RET            ; failed
  3491.       ILDB C,B        ; see what that character was
  3492.       CAIN C,.CHSPC        ; more arguments to come?
  3493.       IFSKP.
  3494.         JUMPN C,SYNERR    ; no, better be end of line then
  3495.         SETZ B,        ; flag that the line ends here
  3496.       ENDIF.
  3497.  
  3498. ; Parse atomic argument
  3499.  
  3500.     ELSE.
  3501.       SETZM ATOM        ; zap argument length
  3502.       CAIE D,""""        ; argument quoted this way?
  3503.       IFSKP.
  3504.         MOVMS C        ; if so then always atomic
  3505.         DO.
  3506.           ILDB D,B        ; get next byte
  3507.           JUMPE D,SYNERR    ; if buffer ends then command is sick
  3508.           CAIN D,""""    ; end of string?
  3509.           IFSKP.
  3510.         IDPB D,A    ; no, stuff the buffer
  3511.         AOS ATOM    ; bump argument length
  3512.         SOJG C,TOP.    ; get more bytes if we can
  3513.         TAGMSG <BAD Quoted argument too long>
  3514.         RET
  3515.           ELSE.
  3516.         SETZ D,        ; yes, tie off string
  3517.         IDPB D,A    ; stuff the buffer
  3518.           ENDIF.
  3519.           ILDB D,B        ; see if an argument follows
  3520.           CAIN D,.CHSPC    ; argument delimiter?
  3521.           IFSKP.
  3522.         JUMPN D,SYNERR    ; no, error if not end of buffer
  3523.         SETZ B,        ; no more arguments
  3524.           ENDIF.
  3525.         ENDDO.
  3526.  
  3527. ; Atomic unquoted argument
  3528.  
  3529.       ELSE.
  3530.         DO.
  3531.           SKIPN D        ; end of string?
  3532.            SETZ B,        ; yes, clear argument pointer
  3533.           IFG. C        ; atomic argument?
  3534.         CAIN D,.CHSPC    ; yes, have argument delimiter?
  3535.          SETZ D,    ; yes, end of string
  3536.           ENDIF.
  3537.           IDPB D,A
  3538.           JUMPE D,ENDLP.    ; done if end of string
  3539.           AOS ATOM        ; bump argument length
  3540.           ILDB D,B        ; get next byte
  3541.           IFG. C        ; what kind of argument?
  3542.         SOJG C,TOP.    ; otherwise get more bytes
  3543.         TAGMSG <BAD Atomic argument too long>
  3544.           ELSE.
  3545.         AOJL C,TOP.    ; otherwise get more bytes
  3546.         TAGMSG <BAD Wholeline argument too long>
  3547.           ENDIF.
  3548.           RET
  3549.         ENDDO.
  3550.       ENDIF.
  3551.     ENDIF.
  3552.     MOVE C,ATOM        ; return argument length
  3553.     RETSKP
  3554.  
  3555.     ENDSV.
  3556.     SUBTTL Sequence handling routines
  3557.  
  3558. ; Store sequence
  3559. ; Accepts: B/ sequence
  3560. ;       C/ sequence bit vector
  3561. ;    CALL STOSEQ
  3562. ; Returns: +1: Failure
  3563. ;        +2: Success
  3564.  
  3565. STOSEQ:    SAVEAC <A,B>
  3566.     IFG. B            ; must be .GE. 1
  3567.       CAMLE B,MBXMGS    ;  and .LE. number of messages
  3568.     ANSKP.            ; was it?
  3569.     ELSE.            ; clearly not!
  3570.       TAGMSG <NO Message sequence not in range>
  3571.       RET
  3572.     ENDIF.
  3573.     MOVEI A,-1(B)        ; copy sequence
  3574.     IDIVI A,^D36        ; split into vector index and bit number
  3575.     ADD A,C            ; get vector address
  3576.     MOVE B,BITS(B)        ; get the bit
  3577.     IORM B,(A)        ; set the bit
  3578.     RETSKP
  3579.  
  3580. ; Dispatch to command service routines based on a sequence
  3581. ; Accepts: A/ pointer to type string
  3582. ;       B/ dispatch address
  3583. ;       SEQLST/ message sequence bit vector
  3584. ;    CALL SEQDSP
  3585. ; Returns +1: Failure
  3586. ;      +2: Success, must output OK message
  3587.  
  3588. SEQDSP:    SAVEAC <A,B,C>
  3589.     ACVAR <<VEC,2>,SEQ,PTR>
  3590.     STKVAR <TYPE,DSP>
  3591.     MOVEM A,TYPE        ; save type
  3592.     MOVEM B,DSP
  3593.     MOVE A,[OWGP. 7,OUTBFR]    ; initialize buffer pointer
  3594.     SETZ PTR,        ; and sequence pointer
  3595.     MOVE VEC,SEQLST        ; get first word from bit vector
  3596.     DO.
  3597.       JFFO VEC,.+2        ; find a bit out of it
  3598.       IFSKP.
  3599.         MOVE SEQ,PTR    ; get vector index
  3600.         IMULI SEQ,^D36    ; times number of bits in vector element
  3601.         ADDI SEQ,1(VEC+1)    ; plus bit position gives this sequence
  3602.         ANDCM VEC,BITS(VEC+1) ; flush this bit for next time
  3603.         HRROI B,[ASCIZ/* /]    ; mark unsolicited
  3604.         CALL BFSOUT
  3605.         MOVE B,SEQ        ; get sequence again
  3606.         CALL BFNOUT        ; output sequence
  3607.         MOVE B,TYPE        ; output type
  3608.         CALL BFSOUT
  3609.         MOVE B,SEQ        ; get sequence again
  3610.         CALL @DSP        ; dispatch to it
  3611.          LOOP.        ; ok, get next in list
  3612.         RET            ; sequence aborted prematurely
  3613.       ELSE.
  3614.         CAIN PTR,SEQLSN    ; at end?
  3615.          EXIT.        ; yes, done with sequence
  3616.         MOVE VEC,SEQLST+1(PTR) ; get next word from bit vector
  3617.         AOJA PTR,TOP.    ; charge on
  3618.       ENDIF.
  3619.     ENDDO.
  3620.     LDB C,[POINT 30,A,35]    ; get trailing address
  3621.     SUB C,[OUTBFR]        ; compute number of fullwords comsumed
  3622.     IMULI C,5        ; number of characters in word
  3623.     LDB A,[POINT 6,A,5]    ; get position of final byte
  3624.     ADDI C,-61(A)        ; add residual byte count
  3625.     MOVX A,.PRIOU        ; now blat the buffer
  3626.     MOVE B,[OWGP. 7,OUTBFR]
  3627.     SOUTR%
  3628.      ERJMP .+1
  3629.     RETSKP            ; done
  3630.  
  3631.     ENDSV.
  3632.     ENDAV.
  3633.  
  3634. ; Get a message sequence list
  3635. ; Accepts: B/ pointer to string
  3636. ;    CALL GETSEQ
  3637. ; Returns: +1: Failed
  3638. ;        +2: Success, A/ delimiter, B/ updated string pointer
  3639.  
  3640. GETSEQ:    SAVEAC <C>
  3641.     STKVAR <SEQTMP>
  3642.     SETZM SEQLST        ; initialize sequence list
  3643.     MOVE A,[SEQLST,,SEQLST+1]
  3644.     BLT A,SEQLST+SEQLSN-1
  3645.     MOVE A,B        ; copy string pointer
  3646.     DO.
  3647.       MOVX C,^D10        ; get a sequence
  3648.       NIN%
  3649.        ERJMP SYNERR        ; barf if bad
  3650.       LDB C,A        ; get delimiter
  3651.       CAIE C,":"        ; multiple sequence?
  3652.       IFSKP.
  3653.         MOVEM B,SEQTMP    ; yes, save starting sequence temporarily
  3654.         MOVX C,^D10        ; get trailing sequence
  3655.         NIN%
  3656.          ERJMP SYNERR
  3657.         EXCH B,SEQTMP    ; get starting sequence
  3658.         DO.
  3659.           XMOVEI C,SEQLST
  3660.           CALL STOSEQ    ; store the sequence
  3661.            RET
  3662.           CAMN B,SEQTMP    ; end of sequence?
  3663.            EXIT.        ; yes, done
  3664.           CAMG B,SEQTMP    ; sequence going up?
  3665.            AOJA B,TOP.    ; yes, increment sequence
  3666.           SOJA B,TOP.    ; no, decrement sequence
  3667.         ENDDO.
  3668.       ELSE.
  3669.         XMOVEI C,SEQLST
  3670.         CALL STOSEQ        ; store this sequence
  3671.          RET
  3672.       ENDIF.
  3673.       LDB C,A        ; get delimiter
  3674.       IFN. C
  3675.         CAIN C,.CHSPC    ; end of list?
  3676.       ANSKP.
  3677.         CAIN C,","        ; another sequence coming?
  3678.          LOOP.        ; yes, get it!
  3679.         JRST SYNERR
  3680.       ENDIF.
  3681.     ENDDO.
  3682.     MOVE B,A        ; return updated pointer
  3683.     MOVE A,C        ; and delimiter
  3684.     RETSKP
  3685.  
  3686.     ENDSV.
  3687.     SUBTTL Attribute parsing
  3688.  
  3689. ; Get a message attribute name
  3690. ; Accepts: B/ pointer to string
  3691. ;    CALL GETATT
  3692. ; Returns +1: Failed
  3693. ;      +2: Success, A/ delimiter, B/ updated string pointer,
  3694. ;        C/ dispatch vector
  3695.  
  3696. GETATT:    STKVAR <ATTPTR>
  3697.     MOVEM B,ATTPTR        ; save attribute pointer
  3698.     MOVSI C,-ATTTBL        ; length of command table
  3699.     DO.
  3700.       HLRO A,ATTTAB(C)    ; point to command string
  3701.       MOVE B,ATTPTR        ; point to base
  3702.       STCMP%        ; compare strings
  3703.       JUMPE A,ENDLP.    ; match?
  3704.       IFXN. A,SC%SUB    ; if subset
  3705.         ILDB A,B        ; get delimiting byte
  3706.         CAIE A,")"        ; is it the end of a list?
  3707.          CAIN A,.CHSPC    ; was it a space?
  3708.           EXIT.        ; yes, win with another argument coming
  3709.       ENDIF.
  3710.       AOBJN C,TOP.        ; try next command
  3711.       TAGMSG <BAD Invalid attribute requested>
  3712.       RET
  3713.     ENDDO.
  3714.     HRRZ C,ATTTAB(C)    ; get address of dispatch pair
  3715.     RETSKP
  3716.  
  3717.     ENDSV.
  3718.  
  3719. ; Attribute names
  3720.  
  3721. DEFINE ATT (NAME,FETCH,STORE) <[ASCIZ/'NAME'/],,[FETCH,,STORE]>
  3722.  
  3723. ATTTAB:    ATT Envelope,.FTENV,.STBAD
  3724.     ATT +Flags,.FTFLG,.STPFL
  3725.     ATT -Flags,.FTFLG,.STMFL
  3726.     ATT Flags,.FTFLG,.STFLG
  3727.     ATT InternalDate,.FTDAT,.STBAD
  3728.     ATT RFC822,.FT822,.STNIM
  3729.     ATT RFC822.Header,.FTHDR,.STNIM
  3730.     ATT RFC822.Size,.FTSIZ,.STBAD
  3731.     ATT RFC822.Text,.FTTXT,.STNIM
  3732. ATTTBL==.-ATTTAB
  3733.     SUBTTL File management routines
  3734.  
  3735. ; Return size of file
  3736. ; Accepts: A/ JFN of file
  3737. ;    CALL FILSIZ
  3738. ; Returns: +1 Always, A/ file size
  3739.  
  3740. FILSIZ:    SAVEAC <B,C>
  3741.     STKVAR <<MBXSIZ,<.FBSIZ+1-.FBBYV>>>
  3742.     MOVE B,[<.FBSIZ+1-.FBBYV>,,.FBBYV] ; file size
  3743.     MOVEI C,MBXSIZ        ; into MBXSIZ
  3744.     GTFDB%
  3745.     LOAD B,FB%BSZ,MBXSIZ    ; get file byte size
  3746.     CAIE B,7        ; already the right byte size?
  3747.     IFSKP.
  3748.       MOVE A,<.FBSIZ-.FBBYV>+MBXSIZ ; yes, use exact byte count
  3749.     ELSE.
  3750.       MOVEI A,^D36        ; compute total bytes per word
  3751.       IDIVI A,(B)
  3752.       EXCH A,<.FBSIZ-.FBBYV>+MBXSIZ
  3753.       IDIV A,<.FBSIZ-.FBBYV>+MBXSIZ ; compute number of words
  3754.       IMULI A,5        ; compute # of characters
  3755.     ENDIF.
  3756.     RET
  3757.  
  3758.     ENDSV.
  3759.  
  3760. ; Load mailbox, output number of messages
  3761. ;    CALL GETMBX
  3762. ; Returns +1: Failure
  3763. ;      +2: Success
  3764.  
  3765. GETMBX:    CALL MAPMBX        ; map in mailbox
  3766.      RET            ; percolate error
  3767.     SETZM MBXMGS        ; initially no messages
  3768.     SETZM MBXNMS
  3769.     MOVE A,[OWGP. 7,MBXBUF]    ; starting pointer
  3770.     MOVE B,MBXBSZ        ; number of bytes to parse
  3771.     CALL MBXPRS        ; parse mailbox
  3772.     IFNSK.
  3773.       TAGMSG <NO Message file is not in TOPS-20 mail format>
  3774.       CALLRET CLSMBX
  3775.     ENDIF.
  3776.     TMSG <* >
  3777.     MOVEI A,.PRIOU        ; output number of messages we have now
  3778.     MOVE B,MBXMGS
  3779.     MOVX C,^D10
  3780.     NOUT%
  3781.      ERCAL FATAL
  3782.     TMSG < EXISTS
  3783. * >
  3784.     MOVEI A,.PRIOU        ; output number of messages we have now
  3785.     MOVE B,MBXNMS
  3786.     MOVX C,^D10
  3787.     NOUT%
  3788.      ERCAL FATAL
  3789.     TMSG < RECENT
  3790. >
  3791.     RETSKP
  3792.  
  3793. ; Map mailbox
  3794. ;    CALL MAPMBX
  3795. ; Returns +1: Failure
  3796. ;      +2: Success
  3797.  
  3798. MAPMBX:    SAVEAC <A,B,C>
  3799.     STKVAR <MBXPGS>
  3800.     HRRZ A,MBXJFN        ; page 0,,JFN
  3801.     FFFFP%            ; find size of contiguous file pages
  3802.      ERCAL FATAL
  3803.     HRRZM A,MBXPGS        ; save # of mailbox pages
  3804.     MOVE A,MBXBSZ
  3805.     IDIVI A,5000        ; make into pages
  3806.     SKIPE B            ; if a remainder
  3807.      ADDI A,1        ; count one more page
  3808.     CAMG A,MBXPGS        ; is byte size reasonable?
  3809.     IFSKP.
  3810.       TAGMSG <NO Message file doesn't have valid size>
  3811.       CALLRET CLSMBX    ; close file off
  3812.     ENDIF.
  3813.     HRLZ A,MBXJFN        ; source JFN,,start at section 0
  3814.     MOVE B,[.FHSLF,,MBXSEC] ; our process,,mailbox section
  3815.     LDB C,[POINT 9,MBXPGS,26] ; get number of sections of file
  3816.     ADDI C,1        ; plus 1 for fractional section
  3817.     CAIG C,MBXSCN        ; too many sections?
  3818.     IFSKP.
  3819.       TAGMSG <NO Message file too large>
  3820.       CALLRET CLSMBX
  3821.     ENDIF.
  3822.     TXO C,SM%RD        ; read access,,this many sections
  3823.     SMAP%
  3824.      ERCAL FATAL
  3825.     RETSKP
  3826.  
  3827.     ENDSV.
  3828.  
  3829. ; Parse a mailbox
  3830. ; Accepts: A/ pointer to mailbox to parse
  3831. ;       B/ number of bytes to parse
  3832. ;    CALL MBXPRS
  3833. ; Returns: +1 Bad format file
  3834. ;       +2 Success, MBXMGS incremented appropriately
  3835.  
  3836. HDRBFL==^D20            ; length of header buffer
  3837.  
  3838. MBXPRS:    SAVEAC <A,B,C,D>
  3839.     ACVAR <M>        ; holds current message
  3840.     STKVAR <TPTR,<HDRBUF,HDRBFL>>
  3841.     JUMPLE B,RSKP        ; sanity check
  3842.     ADJBP B,A        ; determine trailing pointer in B
  3843.     MOVEM B,TPTR
  3844.     DO.
  3845.       MOVE M,MBXMGS        ; current message number
  3846.       IMULI M,MSGLEN    ;  times length of block
  3847.       DO.
  3848.         CAMN A,TPTR        ; gotten to end of file yet?
  3849.          RETSKP        ; yes, all done
  3850.         MOVEM A,MSGIPT(M)    ; save start of internal pointer
  3851.         ILDB C,A        ; sniff past any nulls
  3852.         JUMPE C,TOP.
  3853.       ENDDO.
  3854.       MOVE B,[POINT 7,HDRBUF] ; set up header copy buffer
  3855.       IDPB C,B        ; store this first byte there
  3856.       MOVX D,<5*HDRBFL>-2    ; number of bytes left in header buffer
  3857.       DO.
  3858.         CAMN A,TPTR        ; gotten to end of file?
  3859.          RET        ; yes, garbage at end of file!
  3860.         ILDB C,A        ; get next byte
  3861.         JUMPE C,TOP.    ; ignore nulls
  3862.         CAIN C,.CHCRT    ; saw terminating CR yet?
  3863.         IFSKP.
  3864.           IDPB C,B        ; no, copy this byte to buffer
  3865.           SOJG D,TOP.    ; continue if more to go
  3866.           RET        ; totally bogus line
  3867.         ENDIF.
  3868.         SETZ C,        ; tie off string
  3869.         IDPB C,B
  3870.       ENDDO.
  3871.       CAMN A,TPTR        ; end of file?
  3872.        RET            ; yes, bad format
  3873.       ILDB C,A        ; get expected LF
  3874.       CAIE C,.CHLFD        ; well?
  3875.        RET            ; bad format mail file
  3876.       MOVEM A,MSGPTR(M)    ; save current pointer
  3877.  
  3878. ; Parse time
  3879.  
  3880.       HRROI A,HDRBUF    ; parse header
  3881.       SETZ B,        ; parse date/time in normal format
  3882.       IDTIM%
  3883.        ERJMP R        ; bad date/time
  3884.       MOVEM B,MSGTAD(M)    ; save date/time
  3885.       CAMLE B,MBXRDT    ; later than the file read time?
  3886.        AOS MBXNMS        ; yes, bump number of recent messages
  3887.       LDB B,A        ; get delimiter
  3888.       CAIE B,","        ; was it what we expected?
  3889.        RET            ; bad delimiter
  3890.  
  3891. ; Parse size
  3892.  
  3893.       SETZB B,MSGHSZ(M)    ; start sizes at 0
  3894.       DO.
  3895.         ILDB C,A        ; get possible size byte
  3896.         CAIN C,";"        ; saw terminator?
  3897.         IFSKP.
  3898.           CAIL C,"0"    ; no, is it numeric?
  3899.            CAILE C,"9"
  3900.         RET        ; bad size character
  3901.           IMULI B,^D10    ; numeric, bump size a decade
  3902.           ADDI B,-"0"(C)    ; add in new byte
  3903.           LOOP.        ; get next byte
  3904.         ENDIF.
  3905.       ENDDO.
  3906.       MOVEM B,MSGSIZ(M)    ; save size
  3907.  
  3908. ; Parse flags
  3909.  
  3910.       SETZ B,        ; start flags at 0
  3911.       DO.
  3912.         ILDB C,A        ; get possible flags byte
  3913.         CAIL C,"0"        ; no, is it numeric?
  3914.          CAILE C,"7"
  3915.         IFSKP.
  3916.           LSH B,3        ; numeric, bump flags a octade
  3917.           ADDI B,-"0"(C)    ; add in new byte
  3918.           LOOP.        ; get next byte
  3919.         ENDIF.
  3920.       ENDDO.
  3921.       MOVEM B,MSGFLG(M)    ; save flags
  3922.       IFN. C        ; if non-null after flags
  3923.         DO.
  3924.           CAIE C,.CHSPC    ; ignore spaces inserted by Hermes
  3925.            RET        ; else it is a bogon
  3926.           ILDB C,A        ; get next byte
  3927.           JUMPN C,TOP.    ; continue if non-null
  3928.         ENDDO.
  3929.       ENDIF.
  3930.       MOVE A,MSGSIZ(M)    ; get length of message
  3931.       ADJBP A,MSGPTR(M)    ; get pointer after end of this message
  3932.       LDB B,[POINT 30,A,35]    ; get address of this pointer
  3933.       LDB C,[POINT 30,TPTR,35] ; and of trailing pointer
  3934.       CAMLE B,C        ; message extends past end of file?
  3935.        RET            ; sorry, this file is bogus
  3936.       CAME B,C        ; at same address as end of file?
  3937.       IFSKP.
  3938.         LDB B,[POINT 6,A,5]    ; yes, get position of this pointer
  3939.         LDB C,[POINT 6,TPTR,5] ; and of trailing pointer
  3940.         CAMLE B,C        ; if .LE. trailing still could be ok
  3941.          RET        ; extends beyond end of file
  3942.       ENDIF.
  3943.       SETZM MSGENV(M)    ; don't have any envelope yet
  3944.       AOS B,MBXMGS        ; count up another message
  3945.       CAIG B,MAXMGS        ; more than we support?
  3946.        LOOP.
  3947.       RET            ; too many messages!
  3948.     ENDDO.
  3949.  
  3950.     ENDSV.
  3951.     ENDAV.
  3952.  
  3953. ; Find header size for message indexed in B
  3954.  
  3955. FNDHSZ:    SAVEAC <A,B>
  3956.     ACVAR <M>
  3957.     MOVE M,B        ; set up index
  3958.     MOVE A,MSGPTR(M)    ; get pointer for header
  3959.     SETZM MSGHSZ(M)
  3960.     MOVE B,MSGSIZ(M)    ; get size of message
  3961.     DO.            ; look for end of header
  3962. REPEAT 2,<
  3963.       AOS MSGHSZ(M)        ; bump header size
  3964.       ILDB C,A        ; sniff at next byte
  3965.       CAIE C,.CHCRT        ; found CR?
  3966.        SOJG B,TOP.        ; no, sniff further
  3967.       SOJLE B,ENDLP.    ; yes or end of message, continue or exit
  3968.       AOS MSGHSZ(M)        ; bump header size
  3969.       ILDB C,A        ; sniff at next byte
  3970.       CAIE C,.CHLFD        ; found LF?
  3971.        SOJG B,TOP.        ; no, sniff further
  3972.       SOJLE B,ENDLP.    ; yes or end of message, continue or exit
  3973. >;REPEAT 2
  3974.     ENDDO.
  3975.     MOVE C,MSGHSZ(M)    ; return header size
  3976.     RET
  3977.  
  3978.     ENDAV.
  3979.  
  3980. ; Open current mailbox for write
  3981. ;    CALL MBXWRT
  3982. ; Returns +1: Failed
  3983. ;      +2: Success, A/ write JFN
  3984. ;  Note: This routine inserts its own unwind mechanism on the stack;
  3985. ; consequently, any prior STKVAR context is invalidated.  TRVAR's are
  3986. ; okay though.
  3987.  
  3988. MBXWRT:    IFQN. F%RON        ; always fail if read-only
  3989.       TAGMSG <NO Can't get read-only mailbox for write>
  3990.       RET
  3991.     ENDIF.
  3992.     POP P,A            ; get return PC of caller
  3993.     SAVEAC <B,C>        ; silly
  3994.     STKVAR <RETADR,MBXJF2,<FILBUF,^D60>>
  3995.     MOVEM A,RETADR        ; save return address
  3996.     HRROI A,FILBUF        ; get copy of mailbox file name
  3997.     MOVE B,MBXJFN
  3998.     MOVX C,JS%SPC        ; entire spec please
  3999.     JFNS%
  4000.      ERCAL FATAL
  4001.     MOVX A,GJ%OLD!GJ%SHT    ; now get a write JFN on it
  4002.     HRROI B,FILBUF
  4003.     GTJFN%
  4004.     IFJER.
  4005.       TAGMSG <NO Can't get mailbox for write>
  4006.       CALL ERROUT
  4007.       JRST @RETADR
  4008.     ENDIF.
  4009.     MOVEM A,MBXJF2        ; save JFN
  4010.  
  4011. ; Now open the file
  4012.  
  4013.     DO.
  4014.       MOVX B,<<FLD 7,OF%BSZ>!OF%RD!OF%WR!OF%DUD> ; now open for write
  4015.       OPENF%
  4016.       IFJER.
  4017.         CAIE A,OPNX9    ; file busy is probably okay
  4018.         IFSKP.
  4019.           MOVX A,^D2000    ; wait two seconds and try again
  4020.           DISMS%
  4021.           MOVE A,MBXJF2    ; get back JFN
  4022.           LOOP.
  4023.         ENDIF.
  4024.         TAGMSG <NO Can't open mailbox for write>
  4025.         CALL ERROUT
  4026.         MOVE A,MBXJF2    ; flush the JFN
  4027.         RLJFN%
  4028.          ERJMP .+1
  4029.         JRST @RETADR
  4030.       ENDIF.
  4031.     ENDDO.
  4032.     AOS CX,RETADR        ; file open, set up for "skip" return
  4033.     CALL (CX)        ; "return" to caller as coroutine
  4034.      TRNA            ; caller wants non-skip
  4035.       AOS (P)        ; caller wants skip
  4036.  
  4037. ; Here to force any file data or FDB updates that were done before
  4038.  
  4039.     HRLZ A,MBXJF2        ; write JFN,,page 0
  4040.     MOVX B,MBXSCN*^D512    ; all possible file pages
  4041.     UFPGS%            ; write the pages
  4042.      ERCAL FATAL
  4043.     GTAD%            ; get the time now
  4044.     MOVE C,A        ; put it in C for CHFDB% below
  4045.     MOVE A,MBXJF2        ; get back our JFN
  4046.     HRLI A,.FBREF        ; prepare to step on read time
  4047.     SETO B,            ; change all bits
  4048.     CHFDB%            ; set the new read time and update FDB
  4049.      ERCAL FATAL
  4050.     CLOSF%            ; close the file
  4051.      ERJMP .+1        ; error shouldn't happen
  4052.     SETZ A,            ; trash this AC
  4053.     RET            ; return
  4054.  
  4055.     ENDSV.
  4056.  
  4057. ; Close current mailbox
  4058.  
  4059. CLSMBX:    SAVEAC <A,B,C>
  4060.     SETO A,            ; unmap the file
  4061.     MOVE B,[.FHSLF,,MBXSEC]    ; from mailbox section
  4062.     MOVX C,MBXSCN        ; this many sections
  4063.     SMAP%
  4064.      ERCAL FATAL
  4065.     MOVX A,.DEQID        ; get rid of any locks we got
  4066.     MOVX B,REQID
  4067.     DEQ%
  4068.      ERJMP .+1
  4069.     SKIPE A,MBXJFN        ; close file off
  4070.      CLOSF%
  4071.       ERJMP .+1
  4072.     SETZM MBXJFN        ; no mailbox selected any more
  4073.     SETO A,            ; delete the index page
  4074.     SKIPA B,.+1        ; MACRO is a noisome pile of reptile dung
  4075. LODIPG:! .FHSLF,,IDXPAG
  4076.     MOVX C,PM%CNT!1        ; 1 page
  4077.     PMAP%            ; pffft
  4078.      ERJMP .+1
  4079.     SKIPE A,IDXJFN        ; close index off
  4080.      CLOSF%
  4081.       ERJMP .+1
  4082.     SETZM IDXJFN        ; no index any more
  4083.     SETZM IDXADR
  4084.     SETZM FLGTAB        ; clear old keywords
  4085.     MOVE A,[FLGTAB,,FLGTAB+1]
  4086.     BLT A,FLGTAB+NKYFLG-1
  4087.     MOVE A,[FREE]        ; re-initialize free storage pointer
  4088.     MOVEM A,FSFREE
  4089.     RET
  4090.     SUBTTL Miscellaneous subroutines
  4091.  
  4092. ; Outputs a CRLF
  4093.  
  4094. CRLF:    SAVEAC <A,B,C>
  4095.     MOVX A,.PRIOU        ; use SOUTR% for non-TTY primary I/O
  4096.     HRROI B,[ASCIZ/
  4097. /]
  4098.     SETZ C,
  4099.     SOUTR%            ; this pushes the text on networks
  4100.      ERJMP .+1
  4101.     RET
  4102.  
  4103. ; Convert a 32-bit quantity in A from squoze to ASCII
  4104.  
  4105. SQZTYO:    IDIVI A,50        ; divide by 50
  4106.     PUSH P,B        ; save remainder, a character
  4107.     SKIPE A            ; if A is now zero, unwind the stack
  4108.      CALL SQZTYO        ; call self again, reduce A
  4109.     POP P,A            ; get character
  4110.     ADJBP A,[POINT 7,[ASCII/ 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ.$%/],6]
  4111.     LDB A,A            ; convert squoze code to ASCII
  4112.     PBOUT%
  4113.     RET
  4114.     SUBTTL Error handling
  4115.  
  4116. ; Common routine called to output last error code's message
  4117.  
  4118. ERROUT:    TMSG < - >
  4119.     MOVX A,.PRIOU
  4120.     HRLOI B,.FHSLF        ; dumb ERSTR%
  4121.     SETZ C,
  4122.     ERSTR%
  4123.      JRST ERRUND        ; undefined error number
  4124.      NOP            ; can't happen
  4125.     RET
  4126.  
  4127. ERRUND:    TMSG <Undefined error >
  4128.     MOVX A,.FHSLF        ; get error number
  4129.     GETER%
  4130.     MOVX A,.PRIOU        ; output it
  4131.     HRRZS B            ; only right half where error code is
  4132.     MOVX C,^D8        ; in octal
  4133.     NOUT%
  4134.      ERJMP R        ; ignore error here
  4135.     RET
  4136.  
  4137. ; Various error messages
  4138.  
  4139. DMPTAG:    MOVX A,.PRIOU        ; dump current command's tag
  4140.     HRROI B,CMDBUF
  4141.     MOVN C,TAGCNT
  4142.     SOUT%
  4143.     RET
  4144.  
  4145. BADCOM:    TAGMSG <BAD Command unrecognized: >
  4146. DMPCOM:    HRROI A,CMDBUF
  4147.     PSOUT%
  4148.     RET
  4149.  
  4150. BADARG: TAGMSG <BAD Argument given when none expected: >
  4151.     CALLRET DMPCOM
  4152.  
  4153. MISARG:    TAGMSG <BAD Missing required argument: >
  4154.     CALLRET DMPCOM
  4155.  
  4156. NOMBX:    TAGMSG <NO No mailbox selected>
  4157.     RET
  4158.  
  4159. NOTLOG:    TAGMSG <NO Not logged in yet>
  4160.     RET
  4161.  
  4162. SYNERR:    TAGMSG <BAD Syntax error in command: >
  4163.     CALLRET DMPCOM
  4164.  
  4165. ; Fatal errors arrive here
  4166.  
  4167. FATAL:    MOVEM 17,FATACS+17    ; save ACs in FATACS for debugging
  4168.     MOVEI 17,FATACS        ; save from 0 => FATACS
  4169.     BLT 17,FATACS+16    ; ...to 16 => FATACS+16
  4170.     MOVE 17,FATACS+17    ; restore AC17
  4171.     MOVX A,.PRIIN        ; flush TTY input
  4172.     CFIBF%
  4173.      ERJMP .+1
  4174.     CALL CRLF        ; new line first
  4175.     TMSG <* BYE Fatal system error>
  4176.     CALL ERROUT        ; output last JSYS error
  4177.     TMSG <, >
  4178.     MOVE A,(P)        ; get PC
  4179.     MOVE A,-2(A)        ; get instruction which lost
  4180.     CALL SYMOUT        ; output symbolic instruction if possible
  4181.     TMSG < at PC >
  4182.     POP P,A
  4183.     SUBI A,2        ; point PC at actual location of the JSYS
  4184.     CALL SYMOUT        ; output symbolic name of the PC
  4185.     JRST IMPERR
  4186.  
  4187. ;  Clever symbol table lookup routine.  For details, read "Introduction to
  4188. ; DECSYSTEM-20 Assembly Language Programming", by Ralph Gorin, published by
  4189. ; Digital Press, 1981.  Called with desired value in A.
  4190.  
  4191. SYMOUT:    ACVAR <SYM,VAL>
  4192.     MOVEM A,VAL        ; save value
  4193.     SETZB C,SYM        ; no current program name or best symbol
  4194.     MOVE D,PDV+.PVSYM    ; symbol table vector pointer
  4195.     MOVE A,(D)        ; get length of vector
  4196.     DO.
  4197.       CAIGE A,4        ; another block?
  4198.        EXIT.        ; no - can't find symbol table
  4199.       LDB B,[POINT 6,1(D),5] ; get type of this table
  4200.       CAIN B,1        ; Radix-50 defined symbols?
  4201.       IFSKP.
  4202.         SUBI A,3        ; no, try next block
  4203.         ADDI D,3
  4204.         LOOP.
  4205.       ENDIF.
  4206.       LDB C,[POINT 30,1(D),35] ; found it, get table length
  4207.       MOVE D,2(D)        ; and table address
  4208.       DO.
  4209.         LDB A,[POINT 4,(D),3] ; symbol type
  4210.         IFN. A        ; 0=prog name (uninteresting)
  4211.           CAILE A,2        ; 1=global, 2=local
  4212.         ANSKP.
  4213.           MOVE A,1(D)    ; value of the symbol
  4214.           CAME A,VAL    ; exact match?
  4215.           IFSKP.
  4216.         MOVE SYM,D    ; yes, select it as best symbol
  4217.         EXIT.
  4218.           ENDIF.
  4219.           CAML A,VAL    ; smaller than value sought?
  4220.         ANSKP.
  4221.           SKIPE B,SYM    ; get best one so far if there is one
  4222.            CAML A,1(B)    ; compare to previous best
  4223.         MOVE SYM,D    ; current symbol is best match so far
  4224.         ENDIF.
  4225.         ADDI D,2        ; point to next symbol
  4226.         SUBI C,2        ; and count another symbol
  4227.         JUMPG C,TOP.    ; loop unless control count is exhausted
  4228.       ENDDO.
  4229.  
  4230.       IFN. SYM        ; if a best symbol found
  4231.         MOVE A,VAL        ; desired value
  4232.         SUB A,1(SYM)    ; less symbol's value = offset
  4233.         CAIL A,200        ; is offset small enough?
  4234.       ANSKP.
  4235.         MOVE A,(SYM)    ; symbol name
  4236.         TXZ A,<MASKB 0,3>    ; clear flags
  4237.         CALL SQZTYO        ; print symbol name
  4238.         SUB VAL,1(SYM)    ; difference between this and symbol's value
  4239.         JUMPE VAL,R        ; if no offset then done
  4240.         MOVX A,"+"        ; add + to the output line
  4241.         PBOUT%
  4242.       ENDIF.
  4243.     ENDDO.
  4244.     MOVX A,.PRIOU        ; and copy numeric offset to output
  4245.     MOVE B,VAL        ; value to output
  4246.     MOVX C,^D8
  4247.     NOUT%
  4248.      ERJMP R
  4249.     RET
  4250.  
  4251.     ENDAV.
  4252.     SUBTTL Interrupt stuff
  4253.  
  4254. ; PSI blocks
  4255.  
  4256. PSITAB:    PSIBLN            ; length of block
  4257.     1,,LEVTAB        ; level table
  4258.     1,,CHNTAB        ; channel table
  4259. PSIBLN==.-PSITAB
  4260.  
  4261. LEVTAB:    LEV1PC            ; priority level table
  4262.     LEV2PC
  4263.     LEV3PC
  4264.  
  4265. CHNTAB:    PHASE 0            ; channel table
  4266. COFCHN:!1B5+<1,,COFINT>        ; carrier off channel
  4267. TIMCHN:!2B5+<1,,TIMINT>        ; timer channel
  4268.     REPEAT ^D36-.,<0>
  4269.     DEPHASE
  4270.  
  4271. ; Set up PSIs
  4272.  
  4273. SETPSI:    MOVX A,.FHSLF        ; set level/channel tables
  4274.     XMOVEI B,PSITAB
  4275.     XSIR%
  4276.      ERCAL FATAL
  4277.     EIR%            ; enable PSIs
  4278.      ERCAL FATAL
  4279.     MOVX B,<1B<TIMCHN>!1B<COFCHN>> ; on these channels
  4280.     AIC%
  4281.      ERCAL FATAL
  4282.     MOVE A,[.TICRF,,COFCHN]    ; arm for carrier off interrupts
  4283.     ATI%
  4284. ;    CALLRET SETTIM
  4285.  
  4286. ; Initialize the timer
  4287.  
  4288. SETTIM:    MOVE A,[.FHSLF,,.TIMEL]    ; tick the timer every 5 seconds
  4289.     MOVX B,^D5*^D1000
  4290.     MOVX C,TIMCHN
  4291.     TIMER%
  4292.      ERCAL FATAL
  4293.     RET
  4294.  
  4295. ; Timer interrupt
  4296.  
  4297. TIMINT:    DMOVEM A,IN2ACS        ; save ACs
  4298.     MOVEM C,IN2ACS+2
  4299.     AOSGE TIMOUT        ; has timer run out yet?
  4300.     IFSKP.
  4301.       MOVX A,.PRIIN        ; flush TTY input
  4302.       CFIBF%
  4303.        ERJMP .+1
  4304.       CALL CRLF        ; output CRLF
  4305.       TMSG <* BYE Autologout; idle for too long>
  4306.       XMOVEI A,IMPERR    ; dismiss to quit code
  4307.       TXO A,PC%USR
  4308.       MOVEM A,LEV2PC+1
  4309.     ELSE.
  4310.       CALL SETTIM        ; reinitialize the timer
  4311.     ENDIF.
  4312.     DMOVE A,IN2ACS        ; restore ACs
  4313.     MOVE C,IN2ACS+2
  4314.     DEBRK%
  4315.  
  4316. ; Carrier-off interrupt
  4317.  
  4318. COFINT:    CALL HANGUP        ; hang up the connection
  4319.     DEBRK%            ; back out if continued
  4320.     SUBTTL Other randomness
  4321.  
  4322. ; File defaults
  4323.  
  4324. POBOX:    ASCIZ/POBOX/        ; post office box device
  4325. BBOARD:    ASCIZ/BBOARD/        ; bulletin board directory
  4326. INBOX:    ASCIZ/INBOX/        ; operating-system independent INBOX
  4327. MAIL:    ASCIZ/MAIL/        ; mail file filename
  4328. TXT:    ASCIZ/TXT/        ; mail file extension
  4329.  
  4330. ; Bits, indexed by their bit position
  4331.  
  4332. ...BIT==-1            ; init mechanism
  4333. BITS:    REPEAT ^D36,<1B<...BIT==...BIT+1>>
  4334.  
  4335. ; Literals
  4336.  
  4337. ...LIT:    XLIST            ; save trees during LIT
  4338.     LIT            ; generate literals
  4339. ...VAR:!VAR            ; generate variables (there shouldn't be any)
  4340. IFN .-...VAR,<.FATAL Variables illegal in this program>
  4341.     LIST
  4342.  
  4343. ; Entry vector
  4344.  
  4345. EVEC:    JRST MAPSER        ; START address
  4346.     JRST MAPREE        ; REENTER address
  4347.     MAPVER            ; version
  4348. EVECL==.-EVEC
  4349.  
  4350.     .ENDPS
  4351.  
  4352. ; Program Data Vector - filled in by LINK
  4353.  
  4354.     .PSECT PDV,PDVORG    ; define PDV psect
  4355.     .ENDPS
  4356.  
  4357. ; Define start address and version in PDV
  4358.  
  4359. DEFINE DEFPDV (NAME,DATA) <
  4360.     .TEXT "/PVDATA:'NAME':#'DATA"
  4361. >;DEFINE DEFPDV
  4362.  
  4363.     DEFPDV START,\CODORG    ; define start address
  4364.     DEFPDV VERSION,\MAPVER    ; define version
  4365.  
  4366.     END EVECL,,EVEC        ; establish entry vector
  4367.