Google
 

Trailing-Edge - PDP-10 Archives - BB-5255D-BM - 4-sources/ms.mac
There are 19 other files named ms.mac in the archive. Click here to see a list.
;<4.ARPA-UTILITIES>MS.MAC.260, 10-Jan-80 16:19:09, EDIT BY BLOUNT


; TAKE OUT HEADER THAT LARRY PUT IN ABOUT THE SOURCES
;<4.ARPA-UTILITIES>MS.MAC.258, 10-Oct-79 11:28:14, Edit by LCAMPBELL
; Fix for obscure net-age of local mail caused host done flags to break
;<4.ARPA-UTILITIES>MS.MAC.257, 10-Oct-79 08:15:31, Edit by LCAMPBELL
; Cause "no addresses specified" to leave you in send mode
;<4.ARPA-UTILITIES>MS.MAC.256,  9-Oct-79 15:37:55, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.255,  9-Oct-79 15:26:22, Edit by LCAMPBELL
; Minor fix to MS SYS, and better "Processing mail..." msg
;<4.ARPA-UTILITIES>MS.MAC.254,  8-Oct-79 13:20:55, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.253,  8-Oct-79 13:09:20, Edit by LCAMPBELL
; Fix ERASE harikiri when no entries to erase
;<4.ARPA-UTILITIES>MS.MAC.252,  5-Oct-79 16:12:44, Edit by LCAMPBELL
; Fix obscure net-age of local mail (only after having queued up mail)
;<4.ARPA-UTILITIES>MS.MAC.251,  5-Oct-79 14:18:39, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.250,  5-Oct-79 14:12:27, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.249,  5-Oct-79 13:02:02, Edit by LCAMPBELL
; Don't let status command clobber M
;<4.ARPA-UTILITIES>MS.MAC.248,  4-Oct-79 14:12:09, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.247,  4-Oct-79 12:10:12, Edit by LCAMPBELL
; Get "other user(s) sent OK" msg for local mail totally correct
;<4.ARPA-UTILITIES>MS.MAC.246,  4-Oct-79 10:51:15, Edit by LCAMPBELL
; Fix MOD bug, and reinstitute ctrl-K
;<4.ARPA-UTILITIES>MS.MAC.245, 29-Sep-79 12:52:13, Edit by LCAMPBELL
; Minor cleanup
;<4.ARPA-UTILITIES>MS.MAC.244, 28-Sep-79 15:14:50, Edit by LCAMPBELL
; Fix complaint of trying to DEQ when no lock exists
;<4.ARPA-UTILITIES>MS.MAC.243, 28-Sep-79 14:14:06, Edit by LCAMPBELL
; Make DEQ failure warning, not fatal
;<4.ARPA-UTILITIES>MS.MAC.242, 28-Sep-79 13:15:47, Edit by LCAMPBELL
; DEQ mail file before closing it
;<4.ARPA-UTILITIES>MS.MAC.241, 28-Sep-79 12:52:20, Edit by LCAMPBELL
; Add warning to comments about dead letter end-of-text computation
;<4.ARPA-UTILITIES>MS.MAC.240, 28-Sep-79 12:49:01, Edit by LCAMPBELL
; Handle boundary of dead letter text better
;<4.ARPA-UTILITIES>MS.MAC.239, 28-Sep-79 12:04:48, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.238, 28-Sep-79 11:52:35, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.237, 28-Sep-79 11:46:25, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.236, 28-Sep-79 11:41:25, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.235, 28-Sep-79 11:30:20, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.234, 28-Sep-79 11:27:35, Edit by LCAMPBELL
; Assembly error from better help message
;<4.ARPA-UTILITIES>MS.MAC.233, 28-Sep-79 11:26:17, Edit by LCAMPBELL
; Better prompt text for msg text (documents ctrl chars), remove ^K
;<4.ARPA-UTILITIES>MS.MAC.232, 28-Sep-79 11:01:41, Edit by LCAMPBELL
; Better help message when parsing host names
;<4.ARPA-UTILITIES>MS.MAC.231, 28-Sep-79 00:11:00, Edit by LCAMPBELL
; Display dead letter after parsing
;<4.ARPA-UTILITIES>MS.MAC.230, 27-Sep-79 17:47:43, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.229, 27-Sep-79 17:36:40, Edit by LCAMPBELL
; Speak better English in multiple-dead-letter dialog
;<4.ARPA-UTILITIES>MS.MAC.228, 27-Sep-79 17:24:05, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.227, 27-Sep-79 14:27:22, Edit by LCAMPBELL
; Prevent space after "subject:" from reproducing itself
;<4.ARPA-UTILITIES>MS.MAC.226, 27-Sep-79 13:58:56, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.225, 27-Sep-79 13:51:39, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.224, 27-Sep-79 13:38:45, Edit by LCAMPBELL
; Fix multiple dead-letter case
;<4.ARPA-UTILITIES>MS.MAC.223, 27-Sep-79 13:26:23, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.222, 27-Sep-79 13:11:45, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.221, 27-Sep-79 12:35:53, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.220, 27-Sep-79 12:21:29, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.219, 27-Sep-79 12:12:08, Edit by LCAMPBELL
; Remove LCLTXT - no longer used, and more REPAIR fixes
;<4.ARPA-UTILITIES>MS.MAC.218, 27-Sep-79 12:05:20, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.217, 27-Sep-79 11:56:08, Edit by LCAMPBELL
; Random fixes to REPAIR command
;<4.ARPA-UTILITIES>MS.MAC.216, 27-Sep-79 11:53:41, Edit by LCAMPBELL
; If total wipeout from MAILER, stay in SEND mode with msg intact
;<4.ARPA-UTILITIES>MS.MAC.215, 27-Sep-79 11:43:23, Edit by LCAMPBELL
; If cont'd after exit, just rejoin cmd loop instead of reparsing mail
;<4.ARPA-UTILITIES>MS.MAC.214, 27-Sep-79 11:38:11, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.213, 27-Sep-79 10:27:17, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.212, 27-Sep-79 10:23:07, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.211, 27-Sep-79 09:51:47, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.210, 27-Sep-79 09:42:21, Edit by LCAMPBELL
; Add REPAIR command (to fix dead letters)
;<4.ARPA-UTILITIES>MS.MAC.209, 26-Sep-79 16:21:48, Edit by LCAMPBELL
; Prettier overquota message
;<4.ARPA-UTILITIES>MS.MAC.208, 26-Sep-79 12:28:00, Edit by LCAMPBELL
; Correct order of commands in read mode (weren't alphabetical)
;<4.ARPA-UTILITIES>MS.MAC.207, 26-Sep-79 12:17:10, Edit by LCAMPBELL
; Cause TYPE cmd in send mode with no mail file to return to send mode
;<4.ARPA-UTILITIES>MS.MAC.206, 20-Sep-79 15:54:24, Edit by LCAMPBELL
; Add D as abbrev for display in MS Send>> mode
;<4.ARPA-UTILITIES>MS.MAC.205, 19-Sep-79 13:29:09, Edit by LCAMPBELL
; Beautify listing
;<4.ARPA-UTILITIES>MS.MAC.204, 19-Sep-79 13:14:36, Edit by LCAMPBELL
; Close and release locks on SYSTEM message file when using REE entry
;<4.ARPA-UTILITIES>MS.MAC.203, 19-Sep-79 12:14:43, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.202, 19-Sep-79 12:02:39, Edit by LCAMPBELL
; Better fetchage of EDITOR:
;<4.ARPA-UTILITIES>MS.MAC.201, 19-Sep-79 11:35:54, Edit by LCAMPBELL
; Improve reportage of MAILER wipeouts
;<4.ARPA-UTILITIES>MS.MAC.199, 19-Sep-79 11:21:52, Edit by LCAMPBELL
; Get editor from SYS:, rather than PS:<SUBSYS>
;<4.ARPA-UTILITIES>MS.MAC.198, 18-Sep-79 13:13:51, Edit by LCAMPBELL
; Fix for MS SY ENQ problem
;<4.ARPA-UTILITIES>MS.MAC.197, 18-Sep-79 12:23:01, Edit by LCAMPBELL
; Change all "can't"s to "cannot"
;<4.ARPA-UTILITIES>MS.MAC.196, 18-Sep-79 12:20:18, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.195, 18-Sep-79 12:10:46, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.194, 18-Sep-79 12:07:26, Edit by LCAMPBELL
; Cosmetic improvement to JSYS error messages
;<4.ARPA-UTILITIES>MS.MAC.193, 18-Sep-79 12:05:55, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.192, 18-Sep-79 11:59:57, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.191, 18-Sep-79 11:54:41, Edit by LCAMPBELL
; ENQ the message file so expunges are guaranteed to not screw anyone
;<4.ARPA-UTILITIES>MS.MAC.190, 17-Sep-79 17:35:18, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.189, 17-Sep-79 13:28:48, Edit by LCAMPBELL
; Add storage for ENQ/DEQ, rearrange other storage
;<4.ARPA-UTILITIES>MS.MAC.188, 14-Sep-79 15:04:51, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.187, 13-Sep-79 16:08:48, Edit by LCAMPBELL
; Off-by-one bug in "last n" message sequence (LASTM is counted from 0)
;<4.ARPA-UTILITIES>MS.MAC.186, 12-Sep-79 13:18:06, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.185, 12-Sep-79 12:35:40, Edit by LCAMPBELL
; Better computation of how much of subject to type in headers cmd
;<4.ARPA-UTILITIES>MS.MAC.184, 11-Sep-79 11:41:03, Edit by LCAMPBELL
; Better help message in COPY and MOVE commands
;<4.ARPA-UTILITIES>MS.MAC.183, 10-Sep-79 21:54:28, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.182, 10-Sep-79 21:53:07, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.181, 10-Sep-79 21:42:40, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.180, 10-Sep-79 21:38:31, Edit by LCAMPBELL
; Add "D" as invisible abbrev for delete in read mode (Daytime lost it)
;<4.ARPA-UTILITIES>MS.MAC.179, 10-Sep-79 21:30:37, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.178, 10-Sep-79 21:20:42, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.177, 10-Sep-79 21:18:18, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.176, 10-Sep-79 21:14:26, Edit by LCAMPBELL
; Add "last n messages" message sequence arg
;<4.ARPA-UTILITIES>MS.MAC.175, 10-Sep-79 16:47:00, Edit by LCAMPBELL
; Add noise words to more commands
;<4.ARPA-UTILITIES>MS.MAC.174,  6-Sep-79 15:11:42, Edit by LCAMPBELL
; Add daytime command to read and send modes
;<4.ARPA-UTILITIES>MS.MAC.173,  5-Sep-79 17:43:56, Edit by LCAMPBELL
; Require filespec at GETOUT
;<4.ARPA-UTILITIES>MS.MAC.172,  4-Sep-79 15:07:05, Edit by LCAMPBELL
; Cause MOVE and COPY to append to existing files, not make new gen's
;<4.ARPA-UTILITIES>MS.MAC.171,  3-Sep-79 12:25:17, Edit by LCAMPBELL
; Get setting of host flags right at HSTIN1
;<4.ARPA-UTILITIES>MS.MAC.170, 29-Aug-79 16:51:10, Edit by LCAMPBELL
; Improve handling of lossage when inserting file into message
;<4.ARPA-UTILITIES>MS.MAC.169, 29-Aug-79 11:41:09, Edit by HESS
; Add VT100 screen clearing
;<4.ARPA-UTILITIES>MS.MAC.168, 29-Aug-79 01:04:05, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.167, 29-Aug-79 00:41:45, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.166, 29-Aug-79 00:16:09, Edit by LCAMPBELL
; If RSCANned command line, don't expunge when done
;<4.ARPA-UTILITIES>MS.MAC.165, 28-Aug-79 23:52:33, Edit by LCAMPBELL
; If new messages appear during (RSCANned) MS READ, don't return to EXEC
;<4.ARPA-UTILITIES>MS.MAC.164, 28-Aug-79 23:42:02, Edit by LCAMPBELL
; Close JFN of MS.HEADER-OPTIONS when done
;<4.ARPA-UTILITIES>MS.MAC.163, 28-Aug-79 23:10:33, Edit by LCAMPBELL
; Remove initial line of dashes - it violates RFC733
;<4.ARPA-UTILITIES>MS.MAC.162, 28-Aug-79 10:59:59, Edit by LCAMPBELL
; Fix detonation when illegal command line given
;<4.ARPA-UTILITIES>MS.MAC.161, 24-Aug-79 11:30:29, Edit by LCAMPBELL
; SETSN back to MS after running DMAILR in an inferior
;<4.ARPA-UTILITIES>MS.MAC.160, 24-Aug-79 10:06:14, Edit by LCAMPBELL
; Fix EXPUNGE when new mail has just arrived
;<4.ARPA-UTILITIES>MS.MAC.159, 23-Aug-79 17:40:08, Edit by LCAMPBELL
; Better handling of cruddy commands on EXEC command line
;<4.ARPA-UTILITIES>MS.MAC.158, 23-Aug-79 13:12:51, Edit by LCAMPBELL
; Off-by-one bug in search code (at EQSTR1)
;<4.ARPA-UTILITIES>MS.MAC.157, 22-Aug-79 20:15:56, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.156, 22-Aug-79 20:02:48, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.155, 22-Aug-79 19:39:05, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.154, 22-Aug-79 19:35:30, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.153, 22-Aug-79 17:54:18, Edit by LCAMPBELL
; Polish up expunge interlock stuff
;<4.ARPA-UTILITIES>MS.MAC.152, 22-Aug-79 13:58:41, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.151, 22-Aug-79 12:23:55, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.150, 22-Aug-79 12:16:44, Edit by LCAMPBELL
; Don't attempt to parse anything beyond end of header area
;<4.ARPA-UTILITIES>MS.MAC.149, 21-Aug-79 18:38:24, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.148, 21-Aug-79 18:32:53, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.147, 21-Aug-79 18:16:15, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.146, 21-Aug-79 18:09:02, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.145, 21-Aug-79 17:59:47, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.144, 21-Aug-79 17:58:48, Edit by LCAMPBELL
; Disable control-C during expunge (for lusers' own good)
;<4.ARPA-UTILITIES>MS.MAC.143, 20-Aug-79 12:57:26, Edit by LCAMPBELL
; Fix ?Invalid simultaneous access
;<4.ARPA-UTILITIES>MS.MAC.142, 20-Aug-79 11:23:42, Edit by LCAMPBELL
; Insure proper msg sequencing at READ0 when msgs are deleted
;<4.ARPA-UTILITIES>MS.MAC.141, 20-Aug-79 10:55:16, Edit by LCAMPBELL
; Fix bug in (DELETE, EXP, READ) and in Reply command
;<4.ARPA-UTILITIES>MS.MAC.140, 16-Aug-79 15:47:56, Edit by LCAMPBELL
; Change all occurrences of PS:<SYSTEM> to SYSTEM:
;<4.ARPA-UTILITIES>MS.MAC.139, 16-Aug-79 15:39:17, Edit by LCAMPBELL
; Allow "S" to mean "send" in send mode
;<4.ARPA-UTILITIES>MS.MAC.138, 16-Aug-79 15:32:57, Edit by LCAMPBELL
; Don't type seconds in date/time fields
;<4.ARPA-UTILITIES>MS.MAC.137, 15-Aug-79 15:07:06, Edit by LCAMPBELL
;<HELLIWELL>MS.MAC.10, 14-Aug-79 18:21:23, EDIT BY HELLIWELL
; ADD "LOGOUT-ON-EXIT" COMMAND
;<4.ARPA-UTILITIES>MS.MAC.135, 18-Jul-79 09:33:44, Edit by LCAMPBELL
; Set host flags properly at HSTIN1 on ARPANET systems
;<4.ARPA-UTILITIES>MS.MAC.134, 17-Jul-79 10:59:31, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.133, 17-Jul-79 10:38:31, Edit by LCAMPBELL
; Be more defensive about garbaged mail files
;<4.ARPA-UTILITIES>MS.MAC.132, 12-Jul-79 16:10:53, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.131, 11-Jul-79 14:51:34, Edit by LCAMPBELL
; Don't type ^V for ctrl-V
;<4.ARPA-UTILITIES>MS.MAC.130, 11-Jul-79 10:13:41, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.129, 11-Jul-79 10:06:07, Edit by LCAMPBELL
; Discard nulls from files inserted into text buffer
;<4.ARPA-UTILITIES>MS.MAC.128,  9-Jul-79 18:41:04, Edit by LCAMPBELL
; Only type "Expunging..." if deleted messages exist
;<4.ARPA-UTILITIES>MS.MAC.127,  9-Jul-79 16:31:35, Edit by LCAMPBELL
; Fix ignorance of new mail caused by obscurity at CHECK0
;<4.ARPA-UTILITIES>MS.MAC.126,  6-Jul-79 10:41:43, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.125,  5-Jul-79 09:44:29, Edit by LCAMPBELL
; Type "Expunging deleted messages" when starting expunge, not when done
;<4.ARPA-UTILITIES>MS.MAC.124,  5-Jul-79 09:26:05, Edit by LCAMPBELL
; SETSN both our names to MS
;<4.ARPA-UTILITIES>MS.MAC.123,  2-Jul-79 13:54:52, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.122,  2-Jul-79 13:38:34, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.121,  2-Jul-79 11:52:47, Edit by LCAMPBELL
; In EDITOR command, only do it for EMACS, complain if other editor
;<4.ARPA-UTILITIES>MS.MAC.120, 28-Jun-79 13:38:19, Edit by LCAMPBELL
; Parse an output filespec in COPY command, not a general filespec
;<4.ARPA-UTILITIES>MS.MAC.119, 28-Jun-79 08:57:15, Edit by LCAMPBELL
; Get TXTSIZ right (was words, should have been bytes)
;<4.ARPA-UTILITIES>MS.MAC.118, 22-Jun-79 13:31:21, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.117, 22-Jun-79 13:30:10, Edit by LCAMPBELL
; In READ mode, check for new mail only when exiting mode
;<4.ARPA-UTILITIES>MS.MAC.116, 20-Jun-79 11:57:58, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.115, 20-Jun-79 11:57:24, Edit by LCAMPBELL
; Fix bug in REPLY when Reply-to addr is net addr and all else is local
;<4.ARPA-UTILITIES>MS.MAC.114, 20-Jun-79 11:13:28, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.113, 20-Jun-79 10:29:43, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.112, 20-Jun-79 10:22:39, Edit by LCAMPBELL
; Better parsing of " at "
;<4.ARPA-UTILITIES>MS.MAC.111, 20-Jun-79 09:46:44, Edit by LCAMPBELL
; Remove unreferenced tags and unreachable code
;<4.ARPA-UTILITIES>MS.MAC.110, 19-Jun-79 14:06:29, Edit by LCAMPBELL
; Fix bug in EMACS interface (C-M-Y)
;<4.ARPA-UTILITIES>MS.MAC.109, 13-Jun-79 11:40:50, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.108, 13-Jun-79 11:23:19, Edit by LCAMPBELL
; Retain name as user typed it, even if local, to preserve case
;<4.ARPA-UTILITIES>MS.MAC.107, 13-Jun-79 09:48:56, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.106, 13-Jun-79 09:29:42, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.104, 13-Jun-79 09:27:07, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.103, 12-Jun-79 18:48:22, Edit by LCAMPBELL
; Allow both uppercase and lowercase "at" as node separator
;<4.ARPA-UTILITIES>MS.MAC.102, 12-Jun-79 18:39:56, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.101, 12-Jun-79 17:42:24, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.100, 12-Jun-79 17:33:26, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.99, 12-Jun-79 17:21:41, Edit by LCAMPBELL
; Allow net addresses to have " at " as well as "@"
;<4.ARPA-UTILITIES>MS.MAC.98, 11-Jun-79 17:06:49, Edit by LCAMPBELL
; Fix proliferating "Re:"s caused by bit 35 being left on at REPSUB
;<4.ARPA-UTILITIES>MS.MAC.97, 11-Jun-79 16:26:38, Edit by LCAMPBELL
; Fix bug caused by Release 3 COMND giving wrong error code
;<4.ARPA-UTILITIES>MS.MAC.96, 11-Jun-79 12:33:30, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.95, 11-Jun-79 11:59:15, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.94, 11-Jun-79 11:54:57, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.93, 11-Jun-79 11:08:38, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.92, 11-Jun-79 10:58:58, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.91, 11-Jun-79 10:52:17, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.90, 11-Jun-79 10:48:25, Edit by LCAMPBELL
; If all addresses are local, don't net the mail
;<4.ARPA-UTILITIES>MS.MAC.89,  7-Jun-79 16:56:55, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.88,  7-Jun-79 16:50:36, Edit by LCAMPBELL
; Default all fields of filespec of EDITOR: (so DEF EDITOR: SYS:TV works)
;<4.ARPA-UTILITIES>MS.MAC.87,  7-Jun-79 15:51:23, Edit by LCAMPBELL
; Suppress leading space on dates of single digits
;<4.ARPA-UTILITIES>MS.MAC.86,  7-Jun-79 14:43:35, Edit by LCAMPBELL
; If no filespec given for COPY, MOVE, or PUT, give warning message
;<4.ARPA-UTILITIES>MS.MAC.85,  7-Jun-79 05:27:35, EDIT BY R.ACE
;CHANGE SPELLING OF CANT TO CAN'T
;<4.ARPA-UTILITIES>MS.MAC.84,  6-Jun-79 14:14:26, Edit by LCAMPBELL
; Fix funny header output when terminal width set to zero
;<4.ARPA-UTILITIES>MS.MAC.83,  4-Jun-79 18:46:54, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.82,  4-Jun-79 18:44:01, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.81,  4-Jun-79 18:40:57, Edit by LCAMPBELL
; Improve handling of non-EMACS editors
;<4.ARPA-UTILITIES>MS.MAC.80,  4-Jun-79 16:02:21, Edit by LCAMPBELL
; Fix bug in adding text from SEND mode after editing with editor
;<4.ARPA-UTILITIES>MS.MAC.79,  1-Jun-79 11:39:13, Edit by LCAMPBELL
; Insure correct error message at CPYERR
;<4.ARPA-UTILITIES>MS.MAC.78, 29-May-79 10:55:40, Edit by LCAMPBELL
; Change name of header options file to MS.HEADER-OPTIONS
;<4.ARPA-UTILITIES>MS.MAC.77, 26-May-79 17:34:08, Edit by LCAMPBELL
; Require header fields to start with CRLF
;<4.ARPA-UTILITIES>MS.MAC.76, 24-May-79 13:19:03, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.75, 24-May-79 13:03:07, Edit by LCAMPBELL
; Only try net addr if COMND error is nonexistent user or directory
;<4.ARPA-UTILITIES>MS.MAC.74, 24-May-79 12:53:15, Edit by LCAMPBELL
; Make input buffer for COMND bigger
;<4.ARPA-UTILITIES>MS.MAC.73, 24-May-79 12:47:32, Edit by LCAMPBELL
; If COMND parsing user name fails, type monitor's error message
;<4.ARPA-UTILITIES>MS.MAC.72, 24-May-79 12:01:10, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.71, 24-May-79 11:40:57, Edit by LCAMPBELL
; Fix bug introduce by ignoring nulls
;<4.ARPA-UTILITIES>MS.MAC.70, 23-May-79 15:01:19, Edit by LCAMPBELL
; Look on PS for mailer flags
;<4.ARPA-UTILITIES>MS.MAC.69, 22-May-79 13:22:39, Edit by LCAMPBELL
; When parsing headers, ignore nulls that MAILER stupidly inserts
;<4.ARPA-UTILITIES>MS.MAC.68, 22-May-79 13:07:47, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.67, 22-May-79 13:00:54, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.66, 22-May-79 12:01:59, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.65, 22-May-79 11:55:30, Edit by LCAMPBELL
; Define new error UUO, JRETER, to ERSTR then RET
;<4.ARPA-UTILITIES>MS.MAC.64, 22-May-79 11:43:13, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.63, 22-May-79 11:34:10, Edit by LCAMPBELL
; Cause SEND failure to always enter SEND>> mode with message intact
;<4.ARPA-UTILITIES>MS.MAC.62, 21-May-79 00:42:44, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.61, 21-May-79 00:37:23, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.60, 21-May-79 00:23:34, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.59, 21-May-79 00:13:33, Edit by LCAMPBELL
; Delete and expunge MSG.TMP when done
;<4.ARPA-UTILITIES>MS.MAC.58, 21-May-79 00:09:48, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.57, 21-May-79 00:06:10, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.56, 20-May-79 23:59:53, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.55, 20-May-79 23:57:10, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.54, 20-May-79 23:54:28, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.53, 20-May-79 23:34:51, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.52, 20-May-79 23:31:54, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.51, 20-May-79 23:29:19, Edit by LCAMPBELL
; Make MS understand about EDITOR: and call editors other than EMACS
;<4.ARPA-UTILITIES>MS.MAC.50, 20-May-79 22:41:44, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.49, 20-May-79 22:36:50, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.48, 20-May-79 22:29:48, Edit by LCAMPBELL
; Use "reply-to" field in reply command if it exists
;<4.ARPA-UTILITIES>MS.MAC.47, 20-May-79 21:17:45, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.46, 20-May-79 21:05:04, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.45, 20-May-79 20:26:30, Edit by LCAMPBELL
; Add support for header options
;<4.ARPA-UTILITIES>MS.MAC.44, 17-May-79 18:38:45, Edit by LCAMPBELL
; Cosmetic change to queued mail message
;<4.ARPA-UTILITIES>MS.MAC.43, 17-May-79 18:27:27, Edit by LCAMPBELL
; If disk full, type reasonable error message for MAIL.CPY problem
;<4.ARPA-UTILITIES>MS.MAC.42, 16-May-79 09:37:17, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.41, 16-May-79 09:31:15, Edit by LCAMPBELL
; Make length of subject field dependent on terminal line width
;<4.ARPA-UTILITIES>MS.MAC.40, 11-May-79 11:39:41, Edit by LCAMPBELL
; When displaying message, type date received
;<4.ARPA-UTILITIES>MS.MAC.39,  4-May-79 14:16:38, Edit by LCAMPBELL
; Make "In-reply-to" be part of the header (no leading CRLF)
;<4.ARPA-UTILITIES>MS.MAC.38,  3-May-79 11:09:36, Edit by LCAMPBELL
; Shorten interval between checks for new mail to 2 minutes
;<4.ARPA-UTILITIES>MS.MAC.37,  3-May-79 10:52:16, Edit by LCAMPBELL
; Cause SYSTEM-MESSAGES command to expunge deleted messages
;<4.ARPA-UTILITIES>MS.MAC.36, 27-Apr-79 12:57:54, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.35, 27-Apr-79 12:51:28, Edit by LCAMPBELL
; When ERASEing names, remove from NAMTAB also
;<4.ARPA-UTILITIES>MS.MAC.34, 23-Apr-79 13:53:01, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.33, 23-Apr-79 13:50:52, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.32, 23-Apr-79 13:48:02, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.31, 23-Apr-79 13:39:37, Edit by LCAMPBELL
; Cosmetic change in message typeout
;<4.ARPA-UTILITIES>MS.MAC.30, 23-Apr-79 10:55:02, Edit by LCAMPBELL
; Keep L looking good at READ0 (keeps msg sequencing working over REPLY)
;<4.ARPA-UTILITIES>MS.MAC.29, 19-Apr-79 15:03:25, Edit by LCAMPBELL
; Beautify forwarded messages
;<4.ARPA-UTILITIES>MS.MAC.28, 19-Apr-79 14:50:50, Edit by LCAMPBELL
; Fix subject lossage in FORWARD command
;<4.ARPA-UTILITIES>MS.MAC.27, 18-Apr-79 20:13:37, Edit by LCAMPBELL
; Add MARK and UNMARK commands to MS READ>> mode
;<4.ARPA-UTILITIES>MS.MAC.26, 11-Apr-79 09:40:54, Edit by LCAMPBELL
; Get CMD.REL from DSK instead of SYS
;<4.ARPA-UTILITIES>MS.MAC.25,  6-Apr-79 12:48:03, Edit by LCAMPBELL
; Say "%No current mail file", it's clearer
;<4.ARPA-UTILITIES>MS.MAC.24,  6-Apr-79 12:38:38, Edit by LCAMPBELL
; Cause ?No current file to be %No current file (add CWARN MACRO)
;<4.ARPA-UTILITIES>MS.MAC.23,  5-Apr-79 12:14:51, Edit by LCAMPBELL
; Restore EX as abbrev for EXIT, the removal was unpopular
; Also don't type %You have no MAIL.TXT, user can figure that out
;<4.ARPA-UTILITIES>MS.MAC.22,  5-Apr-79 11:47:51, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.21,  5-Apr-79 11:41:21, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.20,  5-Apr-79 11:28:11, Edit by LCAMPBELL
; Condition out EMACS code for shipped version
;<4.ARPA-UTILITIES>MS.MAC.19,  4-Apr-79 10:20:40, Edit by LCAMPBELL
; Beautify forwarded message brackets
;<4.ARPA-UTILITIES>MS.MAC.18,  4-Apr-79 09:57:51, Edit by LCAMPBELL
; Remove EX as abbreviation for EXIT
;<4.ARPA-UTILITIES>MS.MAC.17,  4-Apr-79 09:38:41, Edit by LCAMPBELL
; Double maximum message size (now 40 pages)
;<4.ARPA-UTILITIES>MS.MAC.16,  4-Apr-79 09:33:34, Edit by LCAMPBELL
; Remove yet more halfword arithmetic (PARS12)
;<4.ARPA-UTILITIES>MS.MAC.15,  3-Apr-79 17:16:31, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.14,  3-Apr-79 17:15:25, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.13,  3-Apr-79 16:23:31, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.12,  3-Apr-79 16:09:10, Edit by LCAMPBELL
; Allow MAIL.TXT to be over 102 pages long (change all byte addresses
; to fullword quantities)
;<4.ARPA-UTILITIES>MS.MAC.11,  3-Apr-79 15:15:37, Edit by LCAMPBELL
; In COPY command in READ mode, NOISE "into file" instead of PROMPTing
;<4.ARPA-UTILITIES>MS.MAC.10,  3-Apr-79 14:21:40, Edit by LCAMPBELL
; Look for "at", not "AT", in net addresses
;<4.ARPA-UTILITIES>MS.MAC.9, 30-Mar-79 16:24:16, Edit by LCAMPBELL
; Spelling errors
;<4.ARPA-UTILITIES>MS.MAC.8, 19-Mar-79 13:20:13, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.7, 19-Mar-79 12:47:14, Edit by LCAMPBELL
; Purge AC N, move O and X down so CX doesn't get clobbered
;<4.ARPA-UTILITIES>MS.MAC.6, 13-Mar-79 17:54:14, Edit by LCAMPBELL
; Set OF%FDT for MAIL.TXT so read date/time stays accurate
;<4.ARPA-UTILITIES>MS.MAC.5, 13-Mar-79 16:57:01, Edit by LCAMPBELL
; Fix bug in HEADERS FROM and HEADERS SUBJECT caused by CX clobberage
;<4.ARPA-UTILITIES>MS.MAC.4, 12-Mar-79 17:22:10, Edit by LCAMPBELL
;<4.ARPA-UTILITIES>MS.MAC.3, 12-Mar-79 17:16:23, Edit by LCAMPBELL
; Update version number and copyright
;<4.ARPA-UTILITIES>MS.MAC.2, 12-Mar-79 14:42:09, Edit by LCAMPBELL
;<LCAMPBELL.DECNET>MS.MAC.7, 10-Mar-79 16:18:56, Edit by LCAMPBELL
;<LCAMPBELL.DECNET>MS.MAC.6, 10-Mar-79 16:01:53, Edit by LCAMPBELL
;<LCAMPBELL.DECNET>MS.MAC.5, 10-Mar-79 15:36:59, Edit by LCAMPBELL
;<LCAMPBELL.DECNET>MS.MAC.4,  9-Mar-79 15:42:09, Edit by LCAMPBELL
;<LCAMPBELL.DECNET>MS.MAC.3,  9-Mar-79 15:09:20, Edit by LCAMPBELL
;<LCAMPBELL.DECNET>MS.MAC.2,  9-Mar-79 15:00:12, Edit by LCAMPBELL
; Change name to MS, align comments, space after opcode, etc.
;<LCAMPBELL.DECNET>MM.MAC.26,  8-Mar-79 16:04:20, Edit by LCAMPBELL
;<LCAMPBELL.DECNET>MM.MAC.2,  6-Mar-79 18:50:31, Edit by LCAMPBELL
; Cosmetic changes - adhere to TOPS20  coding conventions
;<HESS.1>MM.MAC.300, 11-Jan-79 15:17:43, Edit by HESS
;This software is furnished under a license and may only be used
;  or copied in accordance with the terms of such license.
;
;Copyright (C) 1979 by Digital Equipment Corporation, Maynard, Mass.

	TITLE MS

	SEARCH MONSYM,MACSYM,CMD

	.REQUIRE DSK:CMD,SYS:MACREL

	.DIRECTIVE FLBLST
	SALL

;Much of the credit for the origin of this program goes to Michael McMahon
;at MIT-AI (formerly at SRI). It has been converted from FAIL and ULTCMD to
;MACRO and COMND for more wider acceptance and use. I feel that this has
;greatly improved its useability. /Ted Hess [HESS@DEC]

	SUBTTL Definitions

VWHO==0				; Version # stuff
VMIN==0
VMAJ==4
VEDIT==^D258


; AC's

F=0				; Flags
A=1				; Temp and JSYS
B=2				; Ditto
C=3				; Ditto
D=4				; Ditto
E=5				; Temp & local to routine
T=6				; Ditto
U=7				; Ditto
V=10				; Ditto 
W=11				; Ditto
L=12
M=13				; Current message if any
O=14
X=15
CX=16				; Used by macros
P=17
OPDEF PRINT [1B8]
OPDEF UTYPE [2B8]
OPDEF UETYPE [3B8]
OPDEF UERR [4B8]
OPDEF GTBLT [JSYS 634]		; Not on TOPS-20

F%F1==1B0			; Temp
F%F2==1B1
F%F3==1B2
F%AT==1B3			; @ see in address
F%CC==1B4			; In cc command
F%CMA==1B5			; Type comma except before 1st field
F%LCL==1B6			; Local mail seen
F%ESND==1B7			; EMACS said "send"
F%RSCN==1B8			; Exec level command seen
F%LOGO==1B9			; LOGOUT-ON-EXIT command seen
F%CTLC==1B10			; Control-C seen during expunge

F%READ==1B35			; Inside the read command
F%SEND==1B34			; Inside the send commands
F%ARPA==1B33			; ARPA net present
F%MOD==1B32			; Reading system MAIL.TXT
F%AMOD==1B31			; Auto MOD
F%DECN==1B30			; DECnet present

;Flags is command dispatch word

C%GETF==1B0			; Need to have MAIL file for this 

;Flags in rh of host name table entry

NT%DCN==1B35			; DECnet host
NT%ARP==1B34			; ARPAnet host
NT%LCL==1B33			; this host
NT%DON==1B32			; mail queued for this host

EOL==37
 SUBTTL Simple macros

DEFINE TYPE (X) <
	UTYPE [ASCIZ \X\]
   >
DEFINE CTYPE (X) <
	UTYPE 10, [ASCIZ \X\]
   >
DEFINE CITYPE (X) <
	UTYPE 1, [ASCIZ \X\]
   >

DEFINE ETYPE (X) <
	UETYPE [ASCIZ \X\]
   >
DEFINE CETYPE (X) <
	UETYPE 10, [ASCIZ \X\]
   >
DEFINE CIETYP (X) <
	UETYPE 1, [ASCIZ \X\]
   >
;AC field decoded as follows:
;10 (1 = ? , 0 = %)
; 4 ERSTR for last error
; 3 Return to user
; 2 Return to EXEC
; 1 User settable return
; 0 Return to Toplevel

DEFINE DEFERR (X,Y) <
	DEFINE X (Z) <
		IFIDN <Z>,<>,<UERR Y, 0>
		IFDIF <Z>,<>,<UERR Y, [ASCIZ /Z/]>
	   >
   >
DEFERR CWARN,0
DEFERR WARN,3
DEFERR JWARN,7
DEFERR CERR,10
DEFERR JCERR,14
DEFERR ERROR,11
DEFERR CMERR,13
DEFERR JERROR,15
DEFERR JRETER,17
DEFERR FATAL,12
DEFERR JFATAL,16

DEFINE CMD (X,Y,Z) <
    IFIDN <Z>,<>,<
	IFIDN <Y>,<>,<[ASCIZ \X\],,.'X>
	IFDIF <Y>,<>,<[ASCIZ \X\],,Y>
    >
    IFDIF <Z>,<>,<
	IFIDN <Y>,<>,<[Z
			 ASCIZ \X\],,.'X>
	IFDIF <Y>,<>,<[Z
			 ASCIZ \X\],,Y>
    >
>

DEFINE CMD1 (X,Y,Z) < CMD (X,Y,<CM%FW!Z>) >

DEFINE CMDT (X,Y,Z<0>,FL<0>) <
	IFDIF <Y>,<>,< CMD (X,<[FL!Y]>,<CM%FW!Z>) >
	IFIDN <Y>,<>,< CMD (X,<[FL!.'X]>,<CM%FW!Z>) >
>

DEFINE MXMOV (AC,ZOT) <
	XLIST
    IRP ZOT,<
	MOVE AC,MSG'ZOT(M)
	MOVEM AC,MSG'ZOT(X)
>
	LIST
>
 SUBTTL MAILER definitions

SYSCOD==-2			; Special system code
NOACKB==0			; Default message type
NACK1==2			; Total wipeout from MAILER
NACK2==3			; Quota exceeded
MINMSG==1			; First error message

MSGTBL:	[ASCIZ / Quota exceeded./]
MAXMSG==.-MSGTBL+MINMSG		; Last message + 1
 SUBTTL Page allocation

PAGE0==40			; First free page
PAGEN==PAGE0			; Start allocating there
NMSGS==2000			; Number of messages we can handle

DEFINE DEFPAG (ADDR,LENGTH) <
	ADDR==PAGEN*1000
	IFIDN <LENGTH>,<>,<PAGEN==PAGEN+1>
	IFDIF <LENGTH>,<>,<PAGEN==PAGEN+LENGTH>
   >

DEFPAG HDRPAG			; Headers
DEFPAG TXTPAG,40		; Message text page
    TXTSIZ==40*1000*5		;  Message max size
DEFPAG TCPAG			; TO/CC lists
DEFPAG NAMTAB			; TBLUK format name table
DEFPAG NAMTXT,2			; Name strings for above lists
DEFPAG HSTNAM			; Host names
DEFPAG HOSTAB			; Pointers to above
DEFPAG FLGPAG			; For MAILER.FLAGS
DEFPAG EDBPAG			; Editor buffer block page
DEFPAG EDPAGE,20		; Editor pages for data
DEFPAG TMPPGS,2			; Temporary pages (see below)
DEFPAG OPTTXT			; Optional header lines read here

DEFPAG MSGALL,<NMSGS/1000>	; Starting byte of message
DEFPAG MSGALN,<NMSGS/1000>	; Size of whole message
DEFPAG MSGBOD,<NMSGS/1000>	; Starting byte of message body
DEFPAG MSGBON,<NMSGS/1000>	; Size of message body
DEFPAG MSGHDN,<NMSGS/1000>	; Size of header area
DEFPAG MSGDAT,<NMSGS/1000>	; Date of message
DEFPAG MSGFRM,<NMSGS/1000>	; Starting byte of from field
DEFPAG MSGFRN,<NMSGS/1000>	; Size of from field
DEFPAG MSGSUB,<NMSGS/1000>	; Starting byte of subject
DEFPAG MSGSUN,<NMSGS/1000>	; Size of subject
DEFPAG MSGBTS,<NMSGS/1000>	; Msg bits 0-5 local only
				;	   6-17 file copy
				;	   18-35 dynamic

M%SEEN==1			; Message has been seen
M%DELE==2			; Message is deleted
M%ATTN==4			; Message wants attention
M%RPLY==10			; Message has been replied to


MSGPAG==PAGEN			; Start of file mapping area
USRBLK==TMPPGS			; Place to build user list for MAILER
WRTPGS==TMPPGS			; Place to map file for bit updates
NAMTTB==TMPPGS			; Temp name table for name parse
 SUBTTL Impure storage

ZERMEM:				; Begin clear here
CMDRET:	BLOCK 1			; Usual return dispatch for error
SNDCAL:	BLOCK 1			; Caller of send subcommands
OKTINT:	BLOCK 1			; Is it ok for timer to interrupt now?
CHKTIM:	BLOCK 1			; Next time to check for new messages
V52FLG:	BLOCK 1			; We are on a vt52
LSTCHR:	BLOCK 1			; Place to stash last char typed
CPYJFN:	BLOCK 1			; JFN for MAIL.CPY
MSGJFN:	BLOCK 1			; JFN for current message file
MSGJF2:	BLOCK 1			; JFN to open for write
OUTJFN:	BLOCK 1			; Output file jfn
SAVMOD:	BLOCK 5			; Normal tty modes
EDMOD:	BLOCK 5			; Editor modes
LASTM:	BLOCK 1			; Number of messages in current file
FILPGS:	BLOCK 1			; Size of the file in pages
FILSIZ:	BLOCK 1			; Size of the file (bytes)
FILCRV:	BLOCK 1			; Creation date
FILWRT:	BLOCK 1			; Write date
LASTRD:	BLOCK 1			; Last read date of file
UNSEEN:	BLOCK 1			; Number of unseen messages
NDELET:	BLOCK 1			; Number of deleted messages
NFLAGD:	BLOCK 1			; Number of flagged messages
PRIORM:	BLOCK 1			; Saved current message number
LASTN:	BLOCK 1			; Saved last number for pluralizing
LSTMSG:	BLOCK 1			; Saved last message for typing out seq
COMPDT:	BLOCK 1			; Date/time for "since" and "before"
DOMSG:	BLOCK 1			; Dispatch to process next message
NXTMSG:	BLOCK 1			; Dispatch to fetch next message
LHOSTN:	BLOCK 1			; Local host number
PSIPC:	BLOCK 1			; Saved pc from psi routine (level 3)
ILIPC:	BLOCK 1			; Saved pc from psi routine (level 2)
CTLCPC:	BLOCK 1			; Saved pc from psi routine (level 1)
EXECFK:	BLOCK 1			; Saved fork handle for EXEC
EDFORK:	BLOCK 1			; Editor fork
EFRKPC:	BLOCK 1			; Editor fork's PC
EDPAG0:	BLOCK 1			; First page of editor fork mapped in
TOPTRS:	BLOCK 1			; CC,,TO list pointers
FRENAM:	BLOCK 1			; Pointer to free space for names
MOVDSP:	BLOCK 1			; Dispatch for typing or setting to, etc
REPDAT:	BLOCK 1			; Reply date
SAVEL:	BLOCK 1			; Saved L (msg sequence pointer)
EDITOR:	BLOCK 1			; -1 => EMACS, 1 => something else
LINEW:	BLOCK 1			; Terminal line width
DEDJFN:	BLOCK 1			; JFN of dead letter, if any

NQID==12345			; ENQ ID magic number for expunge interlock

ZEREND==.-1			; End of clear
UUOACS:	BLOCK 20		; Ac's during LUUO call
INTACS:	BLOCK 20		; During timer interrupt routines
FRKACS:	BLOCK 20		; Setup for editor fork's ac's

NPDL==177			; Size of PDL
PDL:	BLOCK NPDL		; Pushdown list

STRBSZ==100
SRCBUF::
FILNAM::
STRBUF:	BLOCK STRBSZ		; Temporary string space
PATSTR:	BLOCK STRBSZ		; String pattern for from/subj matching

MYDIR:	BLOCK 1			; Login directory

MYDIRS:	BLOCK 10		; ASCII of login directory

MSGSEQ:	BLOCK <NMSGS/3>+1	; Table of numbers of messages

CMDBLN==:<^D80*30>/5+1		;room for thirty line command
CMDBUF::BLOCK CMDBLN
CMDACS::BLOCK 20		;saved ac's from beginning of command line
ATMBLN==:CMDBLN
ATMBUF::BLOCK ATMBLN		;holds last parsed field
SBK::	BLOCK 20		;COMND JSYS state block
CJFNLN==:20
CJFNBK::BLOCK CJFNLN		;GTJFN block for COMND JSYS
REPARA::BLOCK 1			;reparse address for COMND
CMDFRM::BLOCK 1			;marks bottom of stack
CMDPLN==:200			;amount of stack we can save
CMDPDL::BLOCK CMDPLN		;room to save PDL


;Storage inited non-zero (keep contiguous to help shrink .EXE file)

;ENQ block for expunge interlock

ENQBLK:	1,,6			; Number of locks,,length of block
	NQID			; Magic number
	0			; Bits,,JFN
	-1,,[ASCIZ /Mail expunge interlock/]	; Name of lock
	0			; Unused fields
	0


MYHNAM:	ASCII / at /
	BLOCK 17		; Host and personal name


;IPCF template

PIDGET:	IP%CPD			; Get PID
	0
	0			; To INFO
	ENDMSG-.,,.+1		; For INFO
	1,,1			; Get PID for name
	0			; No copy
	ASCIZ /[SYSTEM]MAILER/

ENDMSG==.

TTXTIB:	7
	RD%JFN
	.PRIIN,,.PRIOU
TXTPTR:	0			; Put updated pointer here
TXTCNT:	0			; Put count here
	POINT 7, TXTPAG		; Where it starts
	0
	TXTMS2			; Break table for text

FSCPKL:	0			; a LSHC A,<n> for SHIFT-IN goes here
	LSH A,1
	MOVEM A,(C)		; Address of dest stored in RH here
	0			; a LSHC A,<n> for SHIFT-OUT goes here
	MOVE B,(C)		; Address of source stored in RH here
	AOBJN C,FSCPKL
	JRST @FENTRM(D)
 SUBTTL Pure storage

;Help message for host name parsing

HSTHLP:	ASCIZ /host name,/

; Texti break mask for user input

TXTMS2:	110100001400		; ^B, ^E, ^K, ^Z, ESC
	000000000000
	000000000000
	000000000000


; Break table for "scan for @" beginning of host name

HSTBRK:	000220000400		; ^J, ^M, ESC
	400040000000		; space and ,
	400000000000		; @
	000000000000

; Break table to eat leading spaces (breaks on anything except space)

SKPSPC:	777777,,777760
	377777,,777760		; break on space only
	777777,,777760

; Interrupt storage

LEVTAB:	CTLCPC
	ILIPC
	PSIPC

CHNTAB:	BLOCK ^D36

CTCCHN==0	; ^C ON CHAN 0
TMRCHN==5	; TIMER ON CHAN 5

RELOC CHNTAB+CTCCHN
	1,,CTLCIN
RELOC
RELOC CHNTAB+TMRCHN
	3,,TMRINT
RELOC
RELOC CHNTAB+.ICILI
	2,,ILITRP
RELOC

EDTGJB:	EXP GJ%OLD		; GTJFN block to default editor type to .EXE
	XWD .NULIO,.NULIO
	-1,,[ASCIZ /SYS:/]
	0
	-1,,[ASCIZ /EDIT/]
	-1,,[ASCIZ /EXE/]
	EXP 0
	EXP 0
	EXP 0
 SUBTTL Revision History

Comment 

Edits 0 thru 42 were preliminary versions. Version 2 implemented a new
scheme of message flagging and notation. All revisions from 1-Dec-78
are included below:

Edit			Notes
====			=====

43	Fix "Check" bug not finding new mail.

Version 3:

44	Add DECnet mail support and change SNDMSG to send all mail via network
	if any recipients have net addresses. This will be removed when a
	new mailer is written.

45	Have the "Type" command in MS Send>> mode save and restore some context

46	Allow "Exit" to continue even if expunge fails (write protection).
	Fix "MS Check" strangeness.

47	New format for forwarded messages.

50	Produce warning message when mail file approaches 102 pages (90).

51	Various minor network bug fixes.

52	Add 'Insert (file into message)' command to send level

53	Fix RLJFN of -1 at FNDFL4

54	Add Net-mail command to MS Read>> level

55	Have DECnet mail setup MAILER.FLAGS for spooling net messages
	and use separate file.

56	Move host name table to different temporary page.

57	Fix "Quota exceeded" problem in expunge code.

 SUBTTL Main program

EV:	JRST GO
	JRST GO1		; Do message of the day auto function
	BYTE (3) VWHO (9) VMAJ (6) VMIN (18) VEDIT

GO:	SETZ F,			; Clear flags
GO0:	RESET
	MOVE A,[SIXBIT /MS/]
	MOVE B,[SIXBIT /MS/]
	SETSN			; Cause monitor to keep statistics on use
	 JFCL
	MOVE A,[ZERMEM,,ZERMEM+1]
	SETZM ZERMEM
	BLT A,ZEREND		; Clear out data-base
	MOVE A,[JRST CMDRES]
	MOVEM A,CMDRET
	SETZM PIDGET+1		; No PID yet
	SETZM LHOSTN		; No local host name yet
	SETOM EDFORK		; No editor fork
	SETOM EXECFK		;  or EXEC fork
	MOVE P,[IOWD NPDL,PDL]
	MOVE A,[CALL UUOH]	; Setup uuo handler call
	MOVEM A,.JB41##
	CALL CMDINI		; Init command parser
	CALL INIT		; Init interrupts and tty modes
	CALL NAMINI		; Get our local name (if any)
	TXNE F,F%AMOD		; Auto mod feature?
	JRST MSGOD0		; Yes - enuf init for now
	CALL OPTINI		; Init header options
	SETZ A,
	RSCAN			; check for command
	 ERJMP GO2
	JUMPE A,GO2		; Any chars?
	HRROI A,[0]		; Dummy ^R pointer
	MOVEM A,SBK+.CMRTY
	MOVEI A,GO4+1		; For reparse on error
	MOVEM A,REPARA		;  fake out return addrs.
	MOVEI A,[FLDDB. .CMINI]	; Init COMND
	CALL RFIELD
	MOVEI A,[FLDDB. (.CMKEY,,<[2,,2
				     [ASCIZ /MS/],,0
				     [ASCIZ /NMS/],,0]>)]
	CALL RFLDE		; See if program name
	 JRST GO2		; Clean up and try normal case
	MOVEI A,[FLDDB. .CMCFM]	; Maybe just MS<CR>
	CALL RFLDE
	 JRST [	CALL RECEN0		; Update data in message file
		TXO F,F%RSCN		;  mark as exec command
		MOVEM P,CMDACS+P	;  insure stack doesn't disappear
		JRST CMDLLP]		;  and try command parse
	; ..
	; ..

GO2:	HRROI A,[0]		; Clear rescan
	RSCAN
	 ERJMP .+1
	CALL GETFIL		; Get and parse file,
	SKIPG MSGJFN		; Have we found something?
	JRST CMDRES		; No - message already printed
	CALL RECENT		; Show data on recent messages
	CALL SUMMRY		; And a summary of the files contents
	JRST CMDRES		; Enter main loop

; Auto message of the day hack

GO1:	MOVX F,F%AMOD		; Set flags
	JRST GO0		;  and join common code

;Handle initial command error

GO4:	MOVEI A,.PRIIN		; Clear input buffer of type ahead
	CFIBF
	PUSH P,[GO2]		; Dummy up return address
	CMERR <Error in command line> ; Go to GO2

;Init header options

OPTINI:	STKVAR<<FNAME,15>>	; Build filename string here
	SETZM OPTTXT		; Clear options area
	MOVE A,[OPTTXT,,OPTTXT+1]
	BLT A,OPTTXT+777
	HRROI A,FNAME
	HRROI B,[ASCIZ /PS:</]	; Prefix dir name
	SETZB C,D
	SOUT
	HRROI B,MYDIRS
	SOUT
	HRROI B,[ASCIZ />MS.HEADER-OPTIONS/]
	SOUT			; Finish off filename string
	MOVX A,GJ%SHT
	HRROI B,FNAME		; Point to filespec string
	GTJFN
	 ERJMP R		; None found, return
	MOVX B,OF%RD
	OPENF			; Open for read
	 ERJMP R
	HRLZ A,A		; Read first page
	MOVE B,[.FHSLF,,<OPTTXT/1000>]
	MOVX C,PM%RD!PM%CPY
	PMAP			;  ..
	MOVES OPTTXT		; Touch page, create own copy
	HLRZ A,A		; Get JFN back
	CLOSF			; Close the JFN
	 JFCL			; Tuff
	RET
CMDRES:	MOVE P,[IOWD NPDL,PDL]
CMDLUP: TXZE F,F%RSCN		; Exec command?
	 JRST .EXIT1		;  yes - bye
	PROMPT (MS>)
	CALL CHECK0		; Check for new messages
	 JRST CMDLLP		; None - go on
	CALL CHECKS		; Got some - print headers
	JRST CMDLUP		; Re-prompt
CMDLLP:	MOVEI A,[FLDDB. (.CMKEY,,CMDTAB)]
	SETOM OKTINT		; OK for timer interrupt here
	CALL RFIELD		; Read command
	SETZM OKTINT		; No more though
	HRRZ B,(B)		; Get dispatch word
	MOVE B,(B)
	PUSH P,B		; Save it
	SKIPG MSGJFN		; Have message file?
	TXNN B,C%GETF		; No - need to get message file?
	 SKIPA			;  Already have it or dont't need it
	CALL GETFIL		; Yes - get it
	POP P,B			; Restore dispatch word
	HRRZ A,B		; Command dispatch address 
	CALL (A)		; Do the command
	TXZN F,F%ESND		; Want to send something?
	JRST CMDLUP		; No - keep going
	SETZM LSTCHR		; Yes - invoke sender
	CALL ERSAL1		; Erase all but text
	CALL SEND0
	JRST CMDLUP		; And return to command loop
 SUBTTL Command tables

; Top level commands

CMDTAB:	NCMDS,,NCMDS 
	CMDT (Answer,.REPLY,,C%GETF)	; Synonym for Reply
	CMDT (Blank)
	CMDT (Check,,,C%GETF)
	CMDT (Copy,.PUT,,C%GETF)
	CMD1 (D,ENTDEL,CM%ABR!CM%INV)
	CMDT (Daytime)
ENTDEL:	CMDT (Delete,,,C%GETF)
	CMDT (Editor)
	CMD1 (Ex,ENTXIT,CM%ABR!CM%INV)
ENTXIT:	CMDT (Exit)
	CMDT (Expunge,,,C%GETF)
	CMDT (Flag,,,C%GETF)
	CMDT (Forward,,,C%GETF)
	CMDT (Get)
	CMD1 (H,ENTHDR,CM%ABR!CM%INV)
ENTHDR:	CMDT (Headers,,,C%GETF)
	CMDT (Help)
	CMDT (List,,,C%GETF)
	CMDT (Logout-on-exit,.LOGOU)
	CMDT (Mark,,,C%GETF)
	CMDT (Move,,,C%GETF)
	CMD1 (N,ENTNXT,CM%ABR!CM%INV)
	CMDT (Net-mail,.MAILR)
ENTNXT:	CMDT (Next,,,C%GETF)
	CMDT (Push)
	CMDT (Quit)
	CMD1 (R,ENTRED,CM%ABR!CM%INV)
ENTRED:	CMDT (Read,,,C%GETF)
	CMD1 (Rep,ENTRP1,CM%ABR!CM%INV)
	CMDT (Repair)
ENTRP1:	CMDT (Reply,,,C%GETF)
	CMD1 (S,ENTSND,CM%ABR!CM%INV)
ENTSND:	CMDT (Send)
	CMDT (Status,,,C%GETF)
	CMDT (System-messages,.MSGOD)
	CMDT (Type,,,C%GETF)
	CMDT (Undelete,,,C%GETF)
	CMDT (Unflag,,,C%GETF)
	CMDT (Unmark,,,C%GETF)
NCMDS==.-CMDTAB-1
; Read commands

RCMDTB:	NRCMDS,,NRCMDS
	CMD (Answer,.RRPL1)
	CMD (Copy,.PUT)
	CMD1 (D,ENTRDL,CM%ABR!CM%INV)
	CMD (Daytime)
ENTRDL:	CMD (Delete,.RDELM)
	CMD (Editor)
	CMD (Exit,.REXIT)
	CMD (Flag,.RFLAG)
	CMD (Forward)
	CMD (Help)
	CMD (List)
	CMD (Mark,.RMARK)
	CMD (Move)
	CMD (Net-mail,.MAILR)
	CMD (Next,.RNEXT)
	CMD (Push)
	CMD (Quit,.RQUIT)
	CMD (R,ENTREP,CM%ABR!CM%INV)
	CMD (Read,.TYPMS)
ENTREP:	CMD1 (Reply,.RREPL)
	CMD (Type,.TYPMS)
	CMD (Undelete,.RUDLM)
	CMD (Unflag,.RUFLG)
	CMD (Unmark,.RUNMK)
NRCMDS==.-RCMDTB-1
; Send (and reply) commands

SCMDTB:	NSCMDS,,NSCMDS
	CMD Cc
	CMD1 (D,ENTSDI,CM%ABR!CM%INV)
	CMD Daytime
ENTSDI:	CMD Display
	CMD Edit,.SEDIT
	CMD Erase
	CMD Help
	CMD Insert
	CMD Push
	CMD Quit,.SQUIT
	CMD Remove,.UNTO
	CMD1 (S,ENTSSN,CM%ABR!CM%INV)
ENTSSN:	CMD Send,.SSEND
	CMD Subject
	CMD Text
	CMD To
	CMD Type,.STYPE
NSCMDS==.-SCMDTB-1

ECMDTB:	NECMDS,,NECMDS
	CMD All,.ERSAL
	CMD Cc,.ERSCC
	CMD Reply-date,.ERSDT
	CMD Subject,.ERSSB
	CMD Text,.ERSTX
	CMD To,.ERSTO
NECMDS==.-ECMDTB-1
DCMDTB:	NDCMDS,,NDCMDS
	CMD All,.DSALL
	CMD Cc,.DSCC
	CMD Subject,.DSSUB
	CMD Text,.DSTXT
	CMD To,.DSTO
NDCMDS==.-DCMDTB-1

EDCMTB:	NEDCMS,,NEDCMS
;	CMD All,.EDALL
;	CMD Cc,.EDCC
;	CMD Subject,.EDSUB
	CMD Text,.EDTXT
;	CMD To,.EDTO
NEDCMS==.-EDCMTB-1

RPCMTB:	NRPCMS,,NRPCMS
	CMD All,.REPAL
	CMD Sender,.REPTO
NRPCMS==.-RPCMTB-1
;Help command

.HELP:	CONFRM
	STKVAR <HLPJFN>
	MOVX A,GJ%OLD!GJ%SHT
	HRROI B,[ASCIZ "HLP:MS.HLP"]
	GTJFN
	 JRST NOHELP
	MOVX B,7B5+OF%RD
	OPENF			; Open help file for read
	 JRST [	RLJFN
		 JFCL
		JRST NOHELP]
	MOVEM A,HLPJFN
HELP1:	MOVE A,HLPJFN
	BIN			; Get char
	JUMPE B,HELP2		; Null - check eof
	MOVE A,B		; Copy for pbout
	PBOUT			; dump to terminal
	JRST HELP1

HELP2:	GTSTS			; See if eof or null
	TXNN B,GS%EOF		; ??
	JRST HELP1		; Not eof - strip nulls
	CLOSF			;  else close file
	 JFCL
	CALL CRLF		; In case none in file
	RET

NOHELP:	JWARN (< HLP:MS.HLP not available - >)
	RET
 SUBTTL Command routines
; Headers of messages

.HEADE:	CALL DFSQNW		; Get sequence, default to new
HEADR1:	CALL @NXTMSG		; Get the next message in sequence
	 RET			; No more to do
	CALL TYPHDR		; Type its header
	JRST HEADR1

; Get another message file

.GET:	NOISE (messages from file)
	MOVX A,GJ%OLD		; Must exist
	MOVEM A,CJFNBK+.GJGEN
	HRROI A,[ASCIZ /MAIL/]
	MOVEM A,CJFNBK+.GJNAM
	HRROI A,[ASCIZ /TXT/]
	MOVEM A,CJFNBK+.GJEXT
	MOVEI A,[FLDDB. .CMFIL]
	CALL CFIELD
	TXZ F,F%AMOD!F%MOD
GET1:	STKVAR <NEWJFN,<OLDPGS,5>>
	MOVEM B,NEWJFN		; Save the jfn away
	MOVEI A,OLDPGS		; Save old FDB info
	HRLI A,FILPGS
	BLT A,4+OLDPGS
	MOVE A,B		; Pass to sizfil
	CALL SIZFIL		; Get the size of the file, etc.
	 JRST GETER1		; Error - release JFN
	MOVE A,NEWJFN		; Get JFN back
	MOVX B,OF%RD!OF%FDT	; Force read date/time update
	OPENF
	 JRST GETERR		; Woops, he goofed
	HRRZ C,OLDPGS		; Number of pages in old file
	CALL UNMAPF		; Flush current message file
	PUSH P,F		; Preserve F%MOD
	CALL CLOSEF		;  close old JFN
	POP P,F			;  ..
	MOVE A,NEWJFN		;  and setup new JFN
	MOVEM A,MSGJFN
	CALL GETFLL		; Go parse and do magic
	TXO F,F%F1		; Maybe want headers (for MOD)
	TXNN F,F%AMOD		; No headers of auto MOD
	TXNN F,F%MOD		; If MOD hack - print headers
	TXZ F,F%F1		; No headers, but get new
	CALL RECEN0		;  info on this file
	TXNN F,F%AMOD		; No summary if auto MOD
	CALL SUMMRY		; And a summary of the files contents
	TXZ F,F%RSCN		; Allow return to command level
	RET			;  if from exec

GETERR:	UERR 17,		; Type jsys error message
GETER1:	MOVE A,NEWJFN		; Flush new jfn (old file still intact)
	RLJFN
	 JFCL
	MOVEI A,FILPGS
	HRLI A,OLDPGS
	BLT A,FILPGS+4
	RET
; Type messages

.TYPE:	CALL DFSQTH
TYPE1:	CALL @NXTMSG
	 RET
	CALL CHKDEL		; Not the deleted ones
	 JRST TYPE1
	CALL TYPMSG
	JRST TYPE1


; Mark messages

.MARK:	SKIPA A,[MRKMSG]


; Delete messages

.DELET:	MOVEI A,DELMSG
DELET0:	MOVEM A,DOMSG		; Set up handler
	CALL DFSQTH		; Get sequence, default to current
				; Message sequencer
SEQUEN:	CALL @NXTMSG		; Next message spec'd
	 JRST PRTSQS		; No more, type end of them
	CALL @DOMSG		; Process the message
	CALL PRTSEQ		; Print out the numbers
	JRST SEQUEN


; Message of the day

.MSGOD:	CONFRM
MSGOD1:	SKIPLE MSGJFN		; Have a MAIL.TXT?
	CALL EXPUNG		; Yes, expunge deleted messages
	MOVX A,GJ%SHT!GJ%OLD	; Existing file
	HRROI B,[ASCIZ /SYSTEM:MAIL.TXT.1/]
	GTJFN			; Get JFN on system message file
	 ERROR (No system message file.)
	MOVE B,A		; Copy JFN to b for GET1
	TXO F,F%MOD		; Set flag for system mail
	JRST GET1		; Now get file


; Auto MOD stuff

MSGOD0:	CALL MSGOD1		; Commom get routine
	MOVEI A,NXTNEW		; Setup message sequencer
	MOVEM A,NXTMSG
	SETO M,			; Init message #
	CALL TYPE1		; Use type routine (New)
	PUSH P,[GO]		; In case continue
	CALL CLOSEF		; Close and release lock on message file
	CALLRET CKEXIT		; Now exit
.DAYTI:	CONFRM
	MOVEI A,.PRIOU
	SETOB B,C
	ODTIM
	RET

.QUIT:	NOISE (MS)
	CONFRM			; Confirm first
	CALLRET CKEXIT

.NEXT:	NOISE (message)
	CONFRM			; Confirm first
	SKIPG MSGJFN
	 CWARN (No current mail file)
	CAME M,LASTM		; At last message?
	 AOJA M,TYPMSG		; No, type the next one then
	CIETYP < Currently at end, message %M.
>
	RET

.FLAG:	SKIPA A,[FLGMSG]	; Flag messages
.UNFLA:	MOVEI A,UFLMSG		; Unflag messages
	JRST DELET0		; Use common code

.UNMAR:	SKIPA A,[UMKMSG]	; Unmark message (make unseen)
.UNDEL:	MOVEI A,UNDMSG		; Undelete message
	JRST DELET0		; Use common code

.BLANK:	NOISE (screen)
	CONFRM
BLANK0:	SKIPN A,V52FLG		; Unless on 52,
	 RET			; Just a fresh line
	JRST BINOUT
.LOGOU:	CONFRM
	TXOE F,F%LOGO		; Remember logout on exit
	CWARN <Logout-on-exit already enabled>
	TXZ F,F%RSCN		; Don't exit if exec command
	WARN <Will logout on exit>
	MOVEI A,.FHSLF
	RPCAP
	TXNN B,SC%CTC
	CWARN <Cannot enable ^C trapping>
	TXON C,SC%CTC
	EPCAP
	 ERJMP [JCERR <Failed to enable ^C trapping>]
	MOVEI A,.FHSLF
	MOVX B,1B<CTCCHN>
	AIC			; Enable channel 0
	MOVSI A,.TICCC
	ATI			; Assign ^C
	RET


;Prevent control-C while expunging deleted messages

CTCLOK:	MOVSI A,(EN%BLN)	; Ignore level numbers, non-shared ENQ
	HRR A,MSGJFN		; JFN of message file
	MOVEM A,ENQBLK+.ENQLV	; Stuff into ENQ block
	MOVEI A,.ENQMA		; Modify existing lock (make exclusive)
	MOVEI B,ENQBLK		;  ..
	ENQ			;  ..
	 ERJMP R		; Can't - must be other readers
	MOVX A,.FHSLF		; See if we can
	RPCAP
	TXNN B,SC%CTC		; Do we have the capability?
	JRST [	WARN <Cannot trap ^C - be sure to allow expunge to finish>
		RETSKP]			; Allow to proceed
	TXO C,SC%CTC		; Enable it
	EPCAP
	MOVE A,[1,,XPNCTC]	; ^C while expunge in progress trap address
	MOVEM A,CHNTAB+CTCCHN	; Vector there
	TXNE F,F%LOGO		; ^C trapping already on?
	RETSKP			; Yes, all done
	MOVX A,.FHSLF
	MOVX B,1B<CTCCHN>
	AIC			; Enable channel 0
	MOVSI A,.TICCC
	ATI			; Assign ^C
	RETSKP			; Done
;Here if ^C while expunge in progress

XPNCTC:	TXON F,F%CTLC		; Remember ^C typed
	WARN <Expunge in progress - please wait>
	DEBRK


;Here when expunge done

CTCOK:	MOVSI A,(EN%BLN+EN%SHR)	; Make ENQ shared again
	HRR A,MSGJFN		; JFN of message file
	MOVEM A,ENQBLK+.ENQLV
	MOVEI A,.ENQMA		; Modify access
	MOVEI B,ENQBLK
	ENQ			;  ..
	 ERJMP .+1		; We might not have obtained exclusive access
	TXZE F,F%CTLC		; ^C typed while locked?
	CALLRET CKEXIT		; Yes, logout or exit as appropriate
	TXNE F,F%LOGO		; Logout-on-exit in effect?
	JRST [	MOVE A,[1,,CTLCIN]	; Yes, replace ^C vector address
		MOVEM A,CHNTAB+CTCCHN	;  ..
		RET]			; and just return
	MOVX A,.FHSLF		; Logout-on-exit not in effect
	MOVX B,1B<CTCCHN>	; Disable ^C trapping
	DIC
	MOVX A,.TICCC		; Deassign terminal code
	DTI			;  ..
	RET			; and return
.EXIT:	NOISE (and update message file)
	CONFRM			; Confirm first
.EXIT0:	SKIPLE MSGJFN		; If file exists,
	 CALL EXPUNG		;  then expunge first
.EXIT1:	SKIPG MSGJFN		; Still have file?
	JRST CKEXIT		; No, just quit
	HRRZ C,FILPGS
	CALL UNMAPF		; Yes - unmap message file
	CALL CLOSEF		;  and flush JFN

CKEXIT:	TXNN F,F%LOGO
	JRST CKXIT1
	MOVNI A,1
	LGOUT
	 JRETER <Failed to logout job>
CKXIT1:	HALTF
	JRST CMDRES		; Just rejoin command loop if restarted
.EXPUN:	NOISE (deleted messages)
	CONFRM			; Confirm first
	SKIPG MSGJFN
	 CWARN (No current mail file)

EXPUNG:	STKVAR <NPCNT>
	TXNE F,F%MOD		; MOD hack?
	 RET			; Yes - exit now
	CALL GETJF2		; Get write jfn so no one interferes
	 JRST [	WARN <File write protected - cannot expunge>
		RET]
	CALL CHECKT		; In case newly arrived mail
	SETZB L,M		; Zero offset, start with first msg
	SETZ X,			; Init count of bytes saved

EXPN00:	MOVX A,M%DELE		; Deleted bit
	TDNN A,MSGBTS(M)	; Is it deleted?
	 JRST EXPN20		; No, must save it
	JUMPN L,EXPN10		; The first deleted msg we have seen?
	CALL CTCLOK		; Yes, prevent ^C from stopping this scramblage
	 JRST [	WARN <Cannot expunge deleted messages - another reader exists>
		CALL CLSJF2		; Release write JFN
		RET]			; Quit now
	CITYPE < Expunging deleted messages >	; Yes, type message
	MOVE V,X
	CALL CHR2BP
	MOVE O,A		; Init pointer to output area
	MOVEI A,MSGPAG_9	;  and make messages private
	HRRZ B,FILPGS
EXPN01:	MOVES (A)
	SOJLE B,EXPN10
	ADDI A,1000
	JRST EXPN01
EXPN10:	MOVE A,MSGALN(M)	; Get length of deleted msg
	SUB L,A			; Increment count of byte offset
	JRST EXPN30		; And go process next msg
EXPN20:	MOVE C,MSGALN(M)	; Length of message
	ADD X,C			; Keep track of total
	JUMPE L,EXPN30		; If no bytes deleted yet, no moving
	MOVE V,MSGALL(M)	; Get starting byte of message
	CALL CHR2BP		; Get byte pointer in a to old msg
	CALL FSCOPY		; Do a fast string copy
	ADDM L,MSGALL(M)	; Update positions
	ADDM L,MSGBOD(M)
	SKIPE MSGSUB(M)
	 ADDM L,MSGSUB(M)
	SKIPE MSGFRM(M)
	 ADDM L,MSGFRM(M)

EXPN30:	CAMGE M,LASTM		; At the last msg?
	 AOJA M,EXPN00		; No, do next then
	JUMPE L,EXPN33		; No msgs deleted, nothing more to do
	JUMPE X,EXPN34		; No msgs retained, delete the file
	MOVE B,X		; See how many pages touched
	IDIVI B,5000
	JUMPE C,.+2
	 AOJ B,
	MOVEM B,NPCNT		; Save new count for later
	HRRZ C,FILPGS		; Number we had mapped to start
	SUB C,B			; Less number touched
	JUMPE C,EXPN31		; All pages touched
	SETO A,
	ADD B,[.FHSLF,,MSGPAG]
	HRLI C,(PM%CNT)
	PMAP			; Unmap those not touched
	HRLZ B,MSGJF2		;  in both memory and the file
	HRR B,NPCNT		; Start here
	PMAP			; ...
	 ERJMP EXPNER		; Pages mapped elsewhere
EXPN31:	MOVE A,MSGJF2		; Write JFN
	MOVE B,[POINT 7,<MSGPAG_^D9>]
	MOVN C,X		; Byte count in new file
	SOUT			; Overwrite existing file
	MOVE B,[.FHSLF,,MSGPAG]
	HRLZ A,MSGJFN		; Use read JFN
	MOVX C,PM%CNT!PM%RD!PM%CPY
	HRR C,NPCNT		; Only map back pages touched
	PMAP
	MOVE B,NPCNT		; Get back count of pages touched
	HRRM B,FILPGS		; Set up new count of pages
	MOVE A,MSGJF2
	HRLI A,.FBSIZ
	SETO B,
	MOVE C,X		; Update byte count
	CHFDB
	 ERJMP [JWARN
		JRST .+1]
	LDB B,[POINT 6,FILPGS,11]	; Get byte size
	CAIN B,7		; If not 7,
	 JRST EXPN32
	HRLI A,.FBBYV		; Make it be
	MOVSI B,(FB%BSZ)
	MOVSI C,(7B11)
	CHFDB
	 ERJMP [JWARN
		JRST .+1]
EXPN32:	SETZB X,M		; Update message numbers
	MOVX A,M%DELE
EXPN41:	TDNN A,MSGBTS(M)	; Deleted?
	 JRST EXPN43		; No, save numbers then
EXPN42:	CAMGE M,LASTM		; Done?
	 AOJA M,EXPN41
	SOJ X,
	MOVEM X,LASTM		; Yes, update new count
	MOVE M,X		; And current message #
	MOVE A,MSGJF2		; Write JFN
	CALL SIZFIL		; Update knowledge of file size
	 JFCL			; This should work
	TMSG <- OK
>				; Type reassurance
	CALL CLSJF2		; And go close it up
	JRST RELJF2		; Release JFN and return
EXPN43:	CAMN X,M		; Still none deleted?
	 AOJA X,EXPN42
	MXMOV B,<ALL,ALN,BOD,BON,DAT,FRM,FRN,SUB,SUN,BTS>
	AOJA X,EXPN42

EXPN33:	CALL CLSJF2
RELJF2:	HRRZ A,MSGJF2
	RLJFN			; release JFN
	 JFCL			; Maybe error?
	SETOM MSGJF2		; No longer have one
	RET

EXPN34:	CITYPE < All messages deleted, deleting file.
>
	HRRZ C,FILPGS
	CALL UNMAPF		; Unmap pages
	CALL CLSJF2		; Close file
	MOVE A,MSGJFN		; Thoroughly
	CLOSF
	 JFCL
	MOVE A,MSGJF2
	DELF			; Now delete it
	 JFCL
	SETOM MSGJFN		; Mark that we have no JFNs
	SETOM MSGJF2
	RET


; Here if expunge lost

EXPNER:	UERR 13,[ASCIZ "Expunge failed -- message file busy."]
	HRRZ C,FILPGS
	CALL UNMAPF		; Unmap all pages
	CALL CLSJF2		; Close file
	CALL RELJF2		;  and release JFN
	CALL GETFIL		; Re-read and parse mail file
	RET			; Return
.READ:	CALL DFSQNW		; Get sequence, default to new
	TXO F,F%READ		; Say in read command
	MOVEI A,REDRET		; Return here
	HRRM A,CMDRET		; On error
READ0:	CALL @NXTMSG		; Get next message
	 JRST RQUIT0		; none, all done
	MOVEM L,SAVEL		; Save current msg sequence pointer
	CALL CHKDEL		; Dont if deleted msg
	 JRST REDRET
	CALL BLANK0		; Clear the screen perhaps
	CALL TYPMSG		; And type the message out

REDRET:	MOVE P,[IOWD NPDL,PDL]	; Reset stack
	MOVE L,SAVEL		; Restore msg sequence pointer
	CALL CMDINI		; Init this level
REDCLP:	PROMPT (MS read>>)
	MOVEI A,[FLDDB. (.CMKEY,,RCMDTB,,<next>)]
	CALL RFIELD		; Parse command
	HRRZ A,(B)
	CALL (A)
	TXZN F,F%ESND		; Want to send something
	JRST REDCLP		; Keep going
	SETZM LSTCHR		; Setup for send
	CALL ERSAL1		; Erase all but text
	CALL SEND0
	JRST REDCLP		; Continue

.RQUIT:	NOISE (read mode)
	CONFRM			; Confirm first
	CALL UPDBT0		; Update this message
RQUIT0:	TXZ F,F%READ
	MOVEI A,CMDRES
	HRRM A,CMDRET
	SETZM CHKTIM		; Force immediate check
	CALL CHECK0		; Any new messages?
	 JRST CMDRES		; No, return to top level
	CALL CHECKS		; Yes, print the message
	TXZ F,F%RSCN		; Don't quit, user probably wants to read 'em
	JRST CMDRES		; Return to top level

.RNEXT:	CONFRM
	CALL UPDBT0		; Update message
	JRST READ0		; Step to next
.RDELM:	CONFRM			; Confrm first
	JRST DELMSG		; Then delete

.RUDLM:	CONFRM			; Confirm first
	JRST UNDMSG		; Then undelete

.RFLAG:	CONFRM			; Confrm first
	JRST FLGMSG		; Then flag

.RUFLG:	CONFRM			; Confrm first
	JRST UFLMSG		; Then un-flag

.RMARK:	CONFRM
	JRST MRKMSG		; mark message

.RUNMK:	CONFRM
	JRST UMKMSG		; unmark message

.REXIT:	NOISE (and expunge deleted messages)
	CONFRM
	CALL UPDBT0		; Update this message
	TXZ F,F%READ		; No longer in read
	MOVEI A,CMDRES
	HRRM A,CMDRET		; Reset top level
	JRST .EXIT0		;  and exit
; Sending subcommands

.SEND:	NOISE (message)
	CONFRM			; CONFIRM first
	CALL SNDINI		; Reset fields
	CALL GETMSG		; Prompt for message
SEND0:	HRRZ A,CMDRET		; Save where we came from
	MOVEM A,SNDCAL
	MOVE A,LSTCHR		; Get last character
	CAIN A,32		; ESC - wants more stuff
	 JRST SSEND0		; ^Z - just send if off then
SEND1:	MOVEI A,SNDRET
	HRRM A,CMDRET
	TXZ F,F%ESND		; Clear this
	TXO F,F%SEND
SNDRET:	MOVE P,[IOWD NPDL,PDL]	; Reset stack
	TXZE F,F%ESND		; Want auto send?
	JRST SSEND0		; Yes - do it
	CALL CMDINI		; Init this level
SNDLUP:	PROMPT (MS send>>)
	MOVEI A,[FLDDB. (.CMKEY,,SCMDTB)]
	CALL RFIELD
	HRRZ A,(B)
	CALL (A)
	TXZN F,F%ESND		; Want to send it now?
	JRST SNDLUP		; Nope
	JRST SSEND0		; Yes - off it goes
.SSEND:	NOISE (message)
	CONFRM			; Make sure if just null command
SSEND0:	TXZ F,F%ESND		; Clear this here in case its set
	CALL SNDMSG		; Send it off and fall thru
	 JRST SEND1		; Failed, enter (or remain in) send mode
	SKIPLE A,DEDJFN		; Was this a fixed dead letter?
	CALL DEDFLS		; Yes, flush it
	JRST SQUIT0

.SQUIT:	NOISE (send mode)
	CONFRM			; Confirm first
	MOVX A,M%RPLY		; Check if reply being done for
	TDNN A,MSGBTS(M)	;  this message
	 JRST SQUIT0		; No - go on
	LDB B,[POINT 12,MSGBTS(M),17]	; Yes
	TXNN B,M%RPLY		; See if previous reply in file bits
	 ANDCAM A,MSGBTS(M)	; No - clear this reply then
SQUIT0:	TXZ F,F%SEND!F%ESND	; Not in send command any more
	SKIPLE A,DEDJFN		; Any dead letter JFN left?
	CLOSF			; Yes, close it
	 JFCL			; Don't care
	SETZM DEDJFN
	MOVE A,SNDCAL		; Get where we entered from
	HRRM A,CMDRET		; Set up to go back there
	JRST (A)		; And do
.STYPE:	SKIPG MSGJFN		; Have a message file?
	JRST [	WARN (No current mail file)
		RET]
	STKVAR <SAVM,<SAVNXM,2>>	; Context variables for "Type"
	MOVEM M,SAVM		; Save M (current message)
	MOVE A,NXTMSG		;  this routine addrs
	MOVE B,PRIORM		;  and this cell
	DMOVEM A,SAVNXM
	CALL .TYPE		; Call type routine
	DMOVE A,SAVNXM		; Restore context
	MOVEM A,NXTMSG
	MOVEM B,PRIORM
	MOVE M,SAVM
	RET			; And return

.SEDIT:	NOISE (field)
	MOVEI A,[FLDDB. (.CMKEY,,EDCMTB,,<text>)]
	JRST .ERAS2		; Get field to edit

.ERASE:	NOISE (field)
	MOVEI A,[FLDDB. (.CMKEY,,ECMDTB,,<text>)]
.ERAS2:	CALL CFIELD		; Parse keyword and confirm
	HRRZ A,(B)
	CALL (A)
	JRST @CMDRET

.DISPL:	NOISE (field)
	MOVEI A,[FLDDB. (.CMKEY,,DCMDTB,,<all>)]
	JRST .ERAS2

				;Insert file into message

.INSER:	NOISE (file into message)
	CALL FSPEC		; Get a file spec
	 RET			; Just CR - ignore
	CALL RDTXT		; Get contents of file
	 RET			; Error - just return
	RET
; Reply command

.REPLY:	CALL DFSQTH		; Get range arg
	MOVEI A,REPRET		; Reply return
	HRRM A,CMDRET
REPRET:	CALL @NXTMSG		; Next message in list
	 JRST [	MOVEI A,CMDRES	; Return to top level
		HRRM A,CMDRET
		JRST CMDRES]
	CALL CHKDEL		; Deleted?
	 JRST REPRET		; Yes - skip it
	MOVE P,[IOWD NPDL,PDL]	; Reset stack
	CALL CMDINI		; Init this level
	MOVE A,[POINT 7,STRBUF]	; Setup prompt string in strbuf
	MOVEI B,[ASCIZ / Reply message # /]
	CALL MOVSTR
	MOVEI B,1(M)		; Message #
	MOVEI C,^D10
	NOUT
	 JCERR
	MOVEI B,[ASCIZ / to: /]
	CALL MOVST0		; Complete prompt and add null
	HRROI A,STRBUF		; Point to prompt string
	CALL DPROMPT
	CALL .RRPL1		; Used common reply code
	JRST REPRET		; Loop over all in list
; Reply subroutines

.RREPL:	NOISE (to)
.RRPL1:	MOVEI A,[FLDDB. (.CMKEY,,RPCMTB,,<sender>)]
	JRST .ERAS2

.REPAL:	TXOA F,F%F3		; Say reply to everyone
.REPTO:	 TXZ F,F%F3		; Say just reply to sender
	CALL SNDINI		; Erase drafts
	CALL FNDSDT		; Find send date
	MOVEM B,REPDAT		; Set up as reply date
	CALL REPSUB		; Construct the subject
	MOVEI T,[ASCIZ /
Reply-to: /]
	CALL FNDHDR		; Is there a "reply-to" field?
	 SKIPA			; No, use "from" field
	JRST .REPL4		; Yes, parse this line as address
	MOVE V,MSGFRM(M)
	JUMPE V,.REPL2		; Dont know who it's from
	CALL CHR2BP
.REPL4:	MOVEI W,TCPAG-1
	SETZ E,			; No host name defaulting
	CALL PRADDR		; Get the guy
	HRRM W,TOPTRS		; Starting to pointer
.REPL0:	TXZN F,F%F3		; Wants reply to all addresses?
	 JRST .REPL1		; No, have enuf now
	MOVEI T,[ASCIZ /
To: /]				; Find start of addresses
	CALL FNDHDR
	 JRST .REPL1		; Not there, forget it
	CALL PRTOCC		; Get to and cc lists
	MOVEI U,MYDIRS		; Remove me from the list
	CALL DOUNTO
.REPL1:	CALL GETTXT		; Get text of reply
	MOVX A,M%RPLY		; Mark message as replied to
	IORM A,MSGBTS(M)	; Careful about updating bits
	JRST SEND0		; And go get more or send it off

.REPL2:	CITYPE (Cannot tell who message is from)
	CALL GETTO		; Ask him who it's to then...
	JRST .REPL0
; Repair undeliverable mail

.REPAI:	STKVAR <<FNAM,20>>	; Filename string
	TXNN F,F%DECN		; Only works for DECNET for now
	CERR (Must have DECNET)
	NOISE (undeliverable mail for)
	SETZM DEDJFN		; No dead letter JFN yet
	CALL SNDINI		; Init drafts
	SKIPN HOSTAB		; Have host name table?
	 CALL HSTINI		; No, build it now
	MOVEI A,[FLDDB1 (.CMKEY,,HOSTAB,<-1,,HSTHLP>)]
	CALL RFLDE		; Get host name
	 CERR (No such host name)
	CONFRM
	HLRO E,(B)		; Get and preserve pointer to host name
	HRROI A,FNAM		; Where to build filename string
	HRROI B,[ASCIZ /PS:</]	; Build ptr to connected directory
	SETZ C,			;  ..
	SOUT
	HRROI B,MYDIRS
	SOUT
	HRROI B,[ASCIZ />]--UNDELIVERABLE-DECNET-MAIL--[./]
	SOUT
	MOVE B,E		; Host name string
	SOUT
	HRROI B,[ASCIZ /./]	; SOUT so null goes in
	SOUT
	HRROI A,FNAM		; Point to entire filename string
	CALL SELECT		; Select a dead letter to handle
	 RET			; None exist
	MOVEM A,DEDJFN		; Remember JFN of dead letter
	HRROI B,TXTPAG		; Read into TXTPAG
	MOVEI C,TXTSIZ		; Don't overflow buffer area
	SETZ D,			; Stop on null
	SIN			; Read the dead letter
	CALL PRSDED		; Parse dead letter, init new draft
	 RET			; Can't
	CALL .DSALL		; Type dead letter
	MOVEI A,CMDRES		; Where to go when leaving send mode
	MOVEM A,SNDCAL		;  ..
	JRST SEND1		; Enter send mode with dead letter in buffer
;Select a dead letter (if only one, this is easy)
; Call with A pointing to filename string
; Returns with JFN of dead letter in A

SELECT:	STKVAR <<GENLST,^D10>,<FNAM,20>,FNPTR>
	MOVEM A,FNPTR		; Preserve ptr to filename string
	HRROI A,FNAM		; Build filename string with wild generation
	MOVE B,FNPTR		; Start with string passed to us
	SETZ C,			;  ..
	SOUT			;  ..
	HRROI B,[ASCIZ /*/]	; SOUT so null goes in
	SOUT
	MOVEI E,GENLST		; Point to JFN list
	HRLI E,(POINT 18,)	; Allow 18 bits for each
	HRROI B,FNAM		; String to look for
	MOVX A,<<GJ%SHT!GJ%IFG!GJ%OLD>-3>
	GTJFN			; Find 'em
	 ERJMP [WARN (No dead letters found for that host)
		RET]			; Failure return
	CALL STUFGN		; Stuff generation number into list
	MOVEI T,1		; Count of dead letters
	MOVE D,A		; Preserve indexable file handle
SELEC1:	MOVE A,D		; Get next one
	GNJFN			;  ..
	 ERJMP SELEC2		; All done
	CALL STUFGN		; Stuff generation number into list
	ADDI T,1		; Count dead letters
	CAIL T,^D20-1		; Insure stack not clobbered by too many gen's
	JRST [	WARN (Too many dead letters exist -- some will be ignored)
		JRST SELEC2]
	JRST SELEC1		; Go for next
;More of SELECT...

SELEC2:	HRRZ A,D		; Get RH of indexable file handle
	RLJFN			; Release it
	 JFCL			; Don't care
	SETZ A,			; Tie off end of list
	IDPB A,E		;  ..
	CAIN T,1		; More than one dead letter?
	JRST SELEC3		; No, then all is easy
	CITYPE (There are )
	MOVEI A,.PRIOU
	MOVE B,T		; Number of dead letters
	MOVX C,^D10
	NOUT
	 JFCL
	TYPE < dead letters, numbered >
	MOVEI E,GENLST		; Form fresh pointer to list again
	HRLI E,(POINT 18,)	;  ..
	ILDB B,E		; Get next generation number
SELEC4:	MOVEI A,.PRIOU		; Type gen number on terminal
	MOVEI C,^D10		; Decimal
	ILDB D,E		; Get next JFN
	JUMPE D,SELEC5		; Last one?
	NOUT			; No, type it
	 JFCL
	CAIE T,2		; No comma if only two letters
	TYPE <,>		; Type comma space
	TYPE < >
	MOVE B,D		; Next JFN
	JRST SELEC4		; Go for next
SELEC5:	TYPE (and )		; Fancy English grammar
	NOUT			; Type the generation number
	 JFCL
	TYPE (.)
	CITYPE (Which one would you like to repair? )
	MOVEI A,.PRIIN		; Get number from terminal
	MOVEI C,^D10		; Base 10
	NIN			; Fetch it
	 ERJMP [JWARN (Invalid generation number)
		RET]
	MOVE D,B		; Preserve generation number
	MOVEI E,GENLST		; Search JFNs for this generation
	HRLI E,(POINT 18,)
SELEC6:	ILDB A,E		; Next generation
	JUMPE A,[CERR (No such dead letter)]
	CAME A,D		; Match user's request?
	JRST SELEC6		; No, try next
	JRST SELEC7		; Go get JFN for and open this one
;Here when only one dead letter exists

SELEC3:	HLRZ A,GENLST		; First generation in list is one we want

;Here with desired generation number in A

SELEC7:	MOVE E,A		; Preserve generation number for a bit
	HRROI A,FNAM		; Where to build filespec string
	MOVE B,FNPTR		; Pointer to start of filespec
	SETZ C,			; Move it
	SOUT			;  ..
	MOVE B,E		; Generation number
	MOVEI C,^D10		; Type in decimal
	NOUT
	 JFCL
	MOVX A,GJ%SHT!GJ%OLD	; Now get a JFN on the dead letter
	HRROI B,FNAM		;  ..
	GTJFN
	 ERJMP [JCERR (Can't get JFN on dead letter)]
	MOVX B,<070000,,OF%RD>	; Open for ASCII read
	OPENF
	 ERJMP [JCERR (Can't open dead letter file)]
	RETSKP			; Return with JFN in A


;Here to stuff generation number of JFN in A into list pointed to by E

STUFGN:	SAVEAC <A,B,C>		; Preserve these ACs
	HRRZS A,A		; Make sure no extraneous bits left around
	MOVE B,[1,,.FBGEN]	; Generation number field
	MOVEI C,C		; Into C
	GTFDB			; Get it
	HLRZ A,C		; Generation number is in LH
	IDPB A,E		; Stuff it
	RET			; And return


;Flush dead letter after repair -- JFN in A

DEDFLS:	DELF			; Delete the file
	 JCERR (Can't delete dead letter)
	CLOSF			;  And close it
	 JFCL
	SETZM DEDJFN		; Remember no more dead letter
	RET
;Here to parse a dead letter and insert good info into send buffer
; Letter has already been read into TXTPAG

PRSDED:	STKVAR <DEDSIZ,DEDPTR>	; Size of dead letter, pointer to it
	MOVEI A,TCPAG-1		; Init to list pointer
	MOVEM A,TOPTRS		;  ..
	MOVE A,DEDJFN		; JFN of dead letter
	MOVE B,[1,,.FBSIZ]	; Get length of file (to limit searches)
	MOVEI C,C		; Into C
	GTFDB
	MOVEM C,DEDSIZ		; Preserve
	MOVE A,[POINT 7,TXTPAG]	; Byte pointer to letter
	CALL BP2CHR		; Form character pointer
	MOVEM V,DEDPTR		; Remember for later
	MOVE W,DEDSIZ		; Length of letter
	MOVEI T,[ASCIZ /
To:/]				; Look for addressee lists
	CALL SEARCH		;  ..
	 JRST [	WARN (Can't understand contents of dead letter)
		RET]
	CALL PRTOCC		; Fetch to and cc lists into new draft
	MOVE V,DEDPTR		; Point at start again
	MOVE W,DEDSIZ		;  ..
	MOVEI T,[ASCIZ /
Subject: /]			; Find subject
	CALL SEARCH		;  ..
	JRST [	WARN (Can't find Subject field in dead letter)
		JRST PRSDD1]
	MOVE B,[POINT 7,STRBUF]	; Copy to temp area
PRSDD2:	ILDB C,A		; Next byte
	CAIN C,15		; Stop at CR
	JRST PRSDD3		;  ..
	IDPB C,B
	JRST PRSDD2
PRSDD3:	SETZ A,			; Put null at end
	IDPB A,B		;  ..
	MOVEI B,STRBUF		; Move from here to header area
	MOVE A,[POINT 7,HDRPAG+700]
	CALL MOVST0		; Move the string
	; ..
	; ..

PRSDD1:	MOVE V,DEDPTR		; Search through entire msg
	MOVE W,DEDSIZ		;  ..
	MOVEI T,[ASCIZ /

/]				; For end of header area (two CRLFs)
	CALL SEARCH		;  ..
	 JRST [	WARN (Can't distinguish header from text)
		RET]
	MOVE B,A		; Where to snarf msg from
	MOVE A,[POINT 7,TXTPAG]	; Move text down to beginning of text area
	CALL MOVST2		; Move bytes until null seen
	MOVNI B,^D14		; Back up over <sp><sp><sp>--------<cr><lf>
	ADJBP B,A		;  ..
	MOVE A,B		; Get into better AC
	SETZ C,			; Tie off string with null
	IDPB C,B		;  ..
	MOVEM A,TXTPTR		; Init TEXTI to append to this stuff
	CALL BP2CHR		; Compute character position of end of text
	MOVE D,B		; Preserve
	MOVE A,[POINT 7,TXTPAG]	; Compute character position of text buffer
	CALL BP2CHR		;  ..
	SUB D,V			; Compute length of dead letter, in chars
	MOVEI A,TXTSIZ		; Length of empty TEXTI buffer
	SUB A,D			; Compute what's left
	MOVEM A,TXTCNT		; Save
	RETSKP			; Give good return
; Move messages into files

.PUT:	SKIPA A,[PUTMSG]
.MOVE:	 MOVEI A,MOVMSG
	MOVEM A,DOMSG
	TXNE F,F%READ		; In read command?
	 JRST .RPUT1		; Yes
	CALL DFSQTH		; Get message sequence
	CALL CMDINI		; Init this level
	PROMPT (  Into file: )
	CALL GETOUT		; Get output file
	 JRST [	WARN (No output file specified)
		RET]
.PUT1:	CALL SEQUEN		; go handle the sequence
.PUT2:	MOVE A,OUTJFN
	CLOSF
	 JERROR (Cannot close output file)
	RET

.RPUT1:	NOISE (into file)
	CALL GETOUT		; Get output file
	 JRST [	WARN (No output file specified)
		RET]
.RPUT2:	CALL @DOMSG		; Process it
	JRST .PUT2		; And go close it up

.LIST:	MOVEI A,LPTMSG
	MOVEM A,DOMSG
	TXNE F,F%READ
	 JRST .RLIS1
	CALL DFSQTH		; Get sequence
	CALL GETLPT		; Get LPT: file
	JRST .PUT1		; And do handle them

.RLIS1:	NOISE (on line-printer)
	CONFRM
	CALL GETLPT
	JRST .RPUT2
.FORWA:	TXNE F,F%READ
	JRST [	CONFRM		; Confirm if in read
		JRST .FORW0]
	CALL DFSQTH		; Get message sequence, default to this
.FORW0:	CALL SNDINI		; Reset message drafts
	CALL GETTO		; Get recipients
	CALL GETTXT		; Get initial comments
	MOVE A,TXTPTR		; Get pointer to text field
	CAMN A,[POINT 7,TXTPAG]	; Empty?
	 JRST .FORW1		; Yes, no need to check crlf
	LDB C,A			; Get last char
	MOVEI B,CRLF0
	CAIE C,12		; Unless have crlf
	 CALL MOVSTR		; Put one in
.FORW1:	MOVEM A,TXTPTR		; Save pointer so far
	TXNE F,F%READ		; If not in read
	 JRST .RFORW
.FORW2:	CALL @NXTMSG		; Get next guy in list
	 JRST SEND0		; Maybe send if off or ger more
	CALL CHKDEL		; Dont forward deleted msgs
	 JRST .FORW2
	CALL .FORWD		; Include original message
	JRST .FORW2		; Then look for more

.RFORW:	CALL .FORWD		; Forward current message
	JRST SEND0		;  and send it off

.FORWD:	MOVE A,TXTPTR		; Get pointer
	MOVEI B,[ASCIZ /- - - - - - - Begin message from: /]
	CALL MOVSTR
	SKIPN B,MSGFRM(M)	; Original sender
	 JRST [	MOVEI B,[ASCIZ /(Unknown)/]
		CALL MOVSTR
		JRST .FRWD1]
	EXCH A,B		; Pointer to b , string to a
	MOVE C,MSGFRN(M)	; Length of from field
	CALL FORMSS
	MOVE A,B		; Pointer back to a
.FRWD1:	MOVEI B,[ASCIZ /
/]				; add a CRLF
	CALL MOVSTR		;  ..
	MOVEM A,TXTPTR		; Update pointer
	CALL FORMSG		; Include text
	MOVE A,TXTPTR
	MOVEI B,[ASCIZ /- - - - - - - End forwarded message
/]
	CALL MOVST0
	ADD A,[7B5]		; Back over the null
	MOVEM A,TXTPTR
	RET			; And return
FORMSG:	SKIPN A,MSGFRM(M)	; Has an author?
	 JRST FORMS2		; No
	MOVE B,[POINT 7,HDRPAG+700]
	MOVEI C,"["
	IDPB C,B
	MOVE C,MSGFRN(M)	; Get length of from field
	CALL FORMSS
	MOVEI C,":"
	IDPB C,B
	SKIPN A,MSGSUB(M)	; Subject field present?
	 JRST FORMS1		; No
	MOVEI C," "
	IDPB C,B
	MOVE C,MSGSUN(M)	; Size of subject field
	CALL FORMSS
FORMS1:	MOVEI C,"]"
	IDPB C,B
	SETZ C,
	IDPB C,B
FORMS2:	MOVE A,MSGBOD(M)	; body of the message
	MOVE B,TXTPTR
	MOVE C,MSGBON(M)	; Length
	CALL FORMSS
	MOVEM B,TXTPTR
	RET

FORMSS:	JUMPE C,R		; None to do
	MOVE V,A
	CALL CHR2BP		; Get byte pointer to it
FRMSS1:	ILDB D,A		; Get char
	JUMPE D,FRMSS2		; Skip nulls
	IDPB D,B
FRMSS2:	SOJG C,FRMSS1
	RET
 SUBTTL Command subroutines

INIT:	MOVEI A,.CTTRM
	GTTYP
	SETZ C,
	CAIN B,.TTV52		; VT52?
	 HRROI C,[BYTE (7)33,"H",33,"J",0]
	CAIN B,.TT100
	 HRROI C,[BYTE (7)33,"[","H",33,"[","J",0]
	MOVEM C,V52FLG		; Remember string
	MOVEI D,SAVMOD
	CALL GETTYM		; Get current tty modes
	TDZ C,[3B9!3B19]	; Dont echo esc or ctrl-V
	SFCOC
	MOVEM C,2(D)
	MOVEI A,.FHSLF		; Setup interrupt stuff
	RPCAP
	TRZ B,-1		; Only enable LH caps
	IOR C,B
	EPCAP			; ...
	CALL INTINI
	GTAD			; setup check timer for
	ADDI A,<2B17/<^D24*^D60>>	;  five minutes from now
	MOVEM A,CHKTIM
	GJINF
	DMOVEM A,MYDIR		; Save directory
	MOVE B,A
	HRROI A,MYDIRS		; Temp name for speed
	DIRST
	 JFCL
	MOVX A,.PRIOU		; Get line width of terminal
	MOVX B,.MORLW
	MTOPR
	MOVEM C,LINEW
	RET
; Init timer interupt chl and set time

INTINI:	MOVX A,.FHSLF
	MOVE B,[LEVTAB,,CHNTAB]
	SIR
	EIR
	MOVX B,1B<TMRCHN>!1B<.ICILI> ; Timer and ill inst channels
	AIC
	CALLRET SETTIM		; Set up timer interrupt

FLGMSG:	MOVX A,M%ATTN		; Mark as attention needed
	JRST SETBIT

MRKMSG:	SKIPA A,[M%SEEN]	; Mark as seen
DELMSG:	MOVX A,M%DELE		; Mark as deleted
SETBIT:	IORM A,MSGBTS(M)
	JRST UPDBIT		; Go update the message bits,maybe

UFLMSG:	MOVX A,M%ATTN		; Mark as unflagged
	JRST CLRBIT

UMKMSG:	SKIPA A,[M%SEEN]	; Mark as unseen
UNDMSG:	MOVX A,M%DELE		; Mark as undeleted
CLRBIT:	ANDCAM A,MSGBTS(M)
	JRST UPDBIT		; Go update the message bits, maybe
GETOUT:	MOVX A,GJ%MSG		; Just message
	MOVEM A,CJFNBK+.GJGEN
	SETZM CJFNBK+.GJNAM	; No default name
	HRROI A,[ASCIZ /txt/]	;  Use .txt as default extn
	MOVEM A,CJFNBK+.GJEXT
	MOVEI A,[FLDDB. (.CMFIL,CM%SDH,,<
filespec
>)]
	CALL RFIELD		; Get filespec
	MOVEM B,OUTJFN		; Save JFN
	CONFRM			; Confirm command
	MOVE A,OUTJFN		; Get JFN back
	MOVE B,[7B5+OF%APP]	; Open for append
	OPENF
	 JCERR (Cannot open output file)
	MOVEM A,OUTJFN		; Save it
	RETSKP

GETLPT:	MOVX A,GJ%FOU!GJ%SHT
	HRROI B,[ASCIZ /LL:MS-OUTPUT.LST/]
	GTJFN			; Try for lower case LPT
	 JRST [	MOVX A,GJ%FOU!GJ%SHT
		HRROI B,[ASCIZ /LPT:MS-OUTPUT.LST/]
		GTJFN		; Try again (dont care)
		 JERROR (Cannot get LPT)
		JRST .+1]	; Have JFN
	MOVE B,[7B5+OF%WR]
	OPENF
	 JERROR (Cannot open LPT)
	MOVEM A,OUTJFN
	RET
MOVMSG:	CALL CHKDEL
	 RET
	CALL PUTMS1
	JRST DELMSG		; Move deletes message

LPTMSG::			; For time being
PUTMSG:	CALL CHKDEL		; Not deleted msgs
	 RET
PUTMS1:	MOVE V,MSGALL(M)	; Get start of the message
	CALL CHR2BP
	MOVE B,A
	MOVE C,MSGALN(M)	; Length
	MOVN C,C
	MOVE A,OUTJFN		; Where it goes
	SOUT			; that's it
	RET

REPSUB:	SKIPN A,MSGSUB(M)
	 RET			; No subject
	MOVE B,[POINT 7,STRBUF]
	MOVE C,MSGSUN(M)	; Size of subject field
	CALL FORMSS		; move it to temp space
	SETZ D,
	IDPB D,B		; And a null
	MOVE A,STRBUF		; Get start of it
	ANDCM A,[<BYTE (7) 40, 40, 0, 0, 177>+1] ; Uppercase and clear last byte
	CAMN A,[ASCIZ /RE: /]	; Already a response?
	 JRST REPSB1		; Yes, dont propogate Re: 's
	MOVE A,[ASCIZ /Re: /]
	MOVEM A,HDRPAG+700	; Start subject off right
	SKIPA A,[POINT 7,HDRPAG+700,27]	; Start going into last byte
REPSB1:	 MOVE A,[POINT 7,HDRPAG+700]	; Start at start of subject
	MOVEI B,STRBUF		; From here
	JRST MOVST0		; Move it and the null
				; Get tty modes
GETTYM:	MOVEI A,.FHJOB		; Get job's interrupt word
	RTIW
	DMOVEM B,3(D)
	MOVEI A,.PRIOU
	RFMOD
	MOVEM B,0(D)
	RFCOC
	DMOVEM B,1(D)
	RET


; Set tty modes

SETTYM:	MOVEI A,.FHJOB
	DMOVE B,3(D)
	STIW
	MOVEI A,.PRIOU
	MOVE B,0(D)
	SFMOD
	DMOVE B,1(D)
	SFCOC
	RET
.CHECK:	NOISE (for new messages)
	CONFRM
CHECKT:	SETZM CHKTIM		; Force check now.
	CALL CHECK0		; Check for new messages
	 RET			; None


; Print message when there are new guys

CHECKS:	MOVE A,MSGJFN		; Set JFN
	CALL SETREF		; Update read date-time
	PUSH P,M		; Save current message
	MOVE M,LASTM		; Start at current end or
	PUSH P,M		;  from beginning if new file
	AOJ M,			; From that one on,
	CALL PARSEF		; Parse these new ones
	POP P,A			; Get old number
	SUB A,LASTM		; Get number of new guys
	JUMPE A,[POP P,A		; Clean up stack
		RET]			; None - someone's mucking the file
	MOVM A,A
	MOVEI B,[ASCIZ /are/]
	CAIN A,1
	 MOVEI B,[ASCIZ /is/]
	CIETYP < There %2S %1D additional message%P
>
	CALL RECENT		; Give the headers of the recent ones
	POP P,M			; Restore current message
	CIETYP < Currently at message %M.
>
	RET
CHECK0:	GTAD
	CAMGE A,CHKTIM		; Time we had a look?
	 RET			; Nope, back to work then
	ADDI A,<2B17/<^D24*^D60>> ; Two minutes from now
	MOVEM A,CHKTIM		; Is next time to look
	SKIPG MSGJFN		; Have a file
	 JRST CHKNEW		; No - see if new file appeared
	PUSH P,FILSIZ		; Save current size
	MOVE A,MSGJFN
	CALL SIZFIL		; Get the current poop on it
	 JRST [	POP P,(P)	; Clean PDL
		JRST CLOSEF]	; Return error
	POP P,T			; Get back old size
	EXCH T,FILSIZ		; Restore old size, save new in t
	MOVE A,FILWRT
	CAMN T,FILSIZ		; File size changed?
	 RET			; No, nothing changed
	MOVEM T,FILSIZ		; Yes - store new size info
	RETSKP			;  and skip return


; Set read date-time for JFN in 1

SETREF:	PUSH P,A		; Save jfn
	GTAD
	MOVE C,A		; Save time
	GTAD			; Wait for time to elapse
	CAMN C,A
	JRST .-2
	MOVE C,A		; Set read date to now 
	POP P,A			; JFN to update
	HRLI A,.FBREF
	SETO B,			; Cause we are going to reparse
	CHFDB
	 ERJMP .+1		; Maybe no access, dont worry
	RET

;Check if MAIL.TXT has been undeleted

CHKNEW:	CALL GETFIL		; Has it?
	 RET			; Nope - return
	SETOM LASTM		; Flag for full parse
	SETZ M,			; Current message
	RETSKP
 SUBTTL Lower level subroutines

; Move a string from 2 to 1

MOVSTR:	HRLI B,(<POINT 7,0>)
MOVST1:	ILDB C,B
	JUMPE C,MOVST3
	IDPB C,A
	JRST MOVST1


; Move string and terminating null

MOVST0:	HRLI B,(<POINT 7,0>)
MOVST2:	ILDB C,B
	IDPB C,A
	JUMPN C,MOVST2
MOVST3:	RET


; Unmap pages from file
; Number of pages in c

UNMAPF:	SETO A,
	MOVE B,[.FHSLF,,MSGPAG]
	HRLI C,(PM%CNT)
	PMAP
	RET


; Close the file

CLOSEF:	SKIPG MSGJFN		; Any message JFN?
	JRST CLOSF1		; No, skip this
	MOVEI A,.DEQID		; Release all locks on message file
	MOVEI B,NQID		;  ..
	DEQ
	 JWARN (Cannot release lock on message file)
	MOVE A,MSGJFN
	CLOSF			; Close it
	 JFCL
CLOSF1:	SETOM MSGJFN
	SKIPLE A,MSGJF2
	 RLJFN
	 JFCL
	SETOM MSGJF2
	TXZ F,F%AMOD!F%MOD	; Clear MOD hack bits
	RET
 SUBTTL Interrupt routines

;Illegal instruction trap

ILITRP:	CIS
	JCERR <Illegal instruction trap>


;^C interrupt

CTLCIN:	CIS
	CWARN <Control-C intercepted, type "EXIT" to logout>


; Timer interrupt

TMRINT:	MOVEM 16,INTACS+16
	MOVEI 16,INTACS
	BLT 16,INTACS+15
	SKIPE OKTINT		; OK for timer at this time?
	 JRST TMRIN1		; Yes, check for new messages
TMRIN2:	CALL SETTIM		; Set next timer up
	MOVSI 16,INTACS
	BLT 16,16
	DEBRK			; No, return

SETTIM:	MOVE A,[.FHSLF,,.TIMEL]	; Elapsed time
	MOVX B,^D5*^D60*^D1000	; 5 mins
	MOVEI C,5		; Chan 5
	TIMER
	 JFCL
	RET

TMRIN1:	SETZM CHKTIM		; Force ...
	CALL CHECK0		; Check for new guys
	 JRST TMRIN2		; None, return for commands
	CIS			; Clear out interrupt
	MOVEI D,SAVMOD
	CALL SETTYM		; Restore tty modes
	CALL CHECKS		; Print message on new guys
	CALL INTINI		; Re-init timer
	JRST @CMDRET		; And return to command
 SUBTTL File parsing subroutines

GETFIL:	CALL FNDFIL		; Try to find it first
	 RET			; Not there, forget it
GETFLL:	MOVSI A,(EN%SHR+EN%BLN)	; ENQ for shared access, ignore level numbers
	HRR A,MSGJFN		; Lock the message file
	MOVEM A,ENQBLK+.ENQLV	;  ..
	MOVEI A,.ENQAA		; Acquire the lock now
	MOVEI B,ENQBLK		; Address of arg block
	ENQ			; This should always work
	 JCERR (Cannot lock message file)
	SKIPE FILSIZ		; Is the file empty?
	 JRST GETFL2		; No
	CIETYP ( There are no messages in %1J.)
	RLJFN			; Get rid of the jfn
	 JFCL
	SETOM MSGJFN
	RET

GETFL2:	SETZ M,			; Must parse all messages
	JRST PARSEF		; And return


; Try to find a MAIL.TXT

FNDFIL:	MOVE A,[POINT 7,FILNAM]	; Get string pointer
	MOVEI B,[ASCIZ /PS:</]
	CALL MOVSTR
	MOVEI B,MYDIRS		; Login directory string
	CALL MOVSTR
	MOVEI B,[ASCIZ />MAIL.TXT.1/]
	CALL MOVST0
	MOVSI A,(GJ%OLD!GJ%SHT)
	HRROI B,FILNAM
	GTJFN
	 JRST FNDFL4
	MOVEM A,MSGJFN		; Save the jfn away
	CALL SIZFIL		; Get the size of the file, etc.
	  JRST CLOSEF		; Return error
	MOVEI B,OF%RD!OF%FDT	; Force read date/time update
	MOVE A,MSGJFN
	OPENF
	 JRST FNDFL5
	RETSKP			; Skip return

FNDFL4:	SKIPLE A,MSGJFN		; Get rid of stray jfns
	RLJFN
	 JFCL
	SETOM MSGJFN
	RET			; Return

FNDFL5:	CAIN A,OPNX2		; Empty file?
	JRST FNDFL4		; Yes - tread as non-ex
	CITYPE <% Cannot open MAIL.TXT.1>
	JRST FNDFL4
; Get size of current file (JFN in a)

SIZFIL:	STKVAR <SAVJFN>
	MOVEM A,SAVJFN		; Save JFN
	MOVE B,[5,,.FBBYV]
	MOVEI C,FILPGS
	GTFDB			; Get the size stuff
	 ERJMP [UERR 17,	; Give jsys error
		RET]
	TXNN F,F%MOD		; MOD wanted
	JRST SIZFL1			; No - then done
	SETO A,			; Yes - get d/t last login then
	HRROI B,D
	MOVEI C,.JILLN		; For this job
	GETJI			; Instead of d/t last read
	 SETZ D,		; use 0 if can't obtain it
	MOVEM D,LASTRD		; Save it as last read
SIZFL1:	LDB U,[POINT 6,FILPGS,11] ; Get byte size
	MOVE V,FILSIZ		; Else get the size now
	CAIN U,7		; If 7 bit,
	 JRST SIZFL3		; Are almost done
	CAIN U,^D36		; 36 bit is easier
	 JRST SIZFL2
	MOVEI T,^D36
	IDIVI T,(U)		; Get number of bytes in a word
	IDIVI V,(T)		; Get number of words
SIZFL2:	IMULI V,5		; Into bytes
SIZFL3:	MOVEM V,FILSIZ		; Save the size
	IDIVI V,5000		; Since we have the file open, the
	JUMPE V+1,.+2		; Page count may be too little
	 AOJ V,			; So, we must check against the
	HRRZ T,FILPGS		; Size according to the byte count
	CAMN T,V		; If equal -
	RETSKP			;  then done
	MOVE A,SAVJFN		; Else - try to find first free page
	GTSTS			; Only do this if file open
	TXNN B,GS%OPN
	JRST [	HRRM V,FILPGS
		RETSKP]		; Not opened - use what we have
	FFFFP			; Look for first free page
	HRRM A,FILPGS		;  and use it.
	RETSKP
; Parse the file from message (m) on

PARSEF:	JUMPE M,[HRRZ 3,FILPGS	; number of pages in FILE
		    SETZ 1,	; starting at first page
		    JRST PARSF2]	; And go map it all in
	MOVE C,MSGALL-1(M)	; Get start of message
	MOVE B,MSGALN-1(M)
	ADDI B,1(C)		; Get size in bytes plus one
	IDIVI B,5000		; Get first page we will need
	MOVEI A,(B)		; That is first file page
	HRRZ C,FILPGS
	SUBI C,(B)		; Get real page count
PARSF2:	MOVEI B,MSGPAG(A)	; First page here to map into
	HRL A,MSGJFN		; File they come from
	HRLI B,.FHSLF
	HRLI C,(PM%CNT!PM%RD!PM%CPY)
	PMAP			; Map them in
	SETZ V,			; Assume
	JUMPE M,.+4		; Start at start
	MOVE V,MSGALL-1(M)	; Or at end of last message
	MOVE U,MSGALN-1(M)
	ADD V,U

PARS10:	CALL CHR2BP		; Get byte pointer to this
	MOVEM V,MSGALL(M)	; start of whole message
PARS11:	ILDB T,A		; Get character
	CAIE T,","
	 JRST [	CALL BP2CHR		; See where we are
		CAMG V,FILSIZ		; Have we run off the end of file?
		JRST PARS11		; No, keep looking
		CMERR (File has bad format - last message has no size field)
		RET]
	MOVEI C,^D10		; Decimal
	CALL .NIN
	MOVEM B,MSGBON(M)	; Save length of real message
	MOVEI C,10		; Octal
	CALL .NIN
	HRRZM B,MSGBTS(M)	; Save message bits
	HRLM B,MSGBTS(M)
PARS12:	ILDB T,A
	CAIE T,12		; Until end of line
	 JRST [	CALL BP2CHR		; Insure we don't run off end of file
		CAMG V,FILSIZ
		JRST PARS12		; OK, keep looking
		CMERR (File has bad format - Cannot find start of last message)
		RET]
	CALL BP2CHR		; Get character position
	MOVEM V,MSGBOD(M)	; Save start of real message
	MOVE B,MSGBON(M)	; Get size again
	ADD B,V			; Get end of whole thing
	PUSH P,B		; Save it for later
	MOVE T,MSGALL(M)	; Where it started
	SUB B,T			; Length of whole thing
	MOVEM B,MSGALN(M)	; Save it too
	MOVE W,MSGBON(M)	; Get size of whole message
	MOVEI T,[ASCIZ /

/]				; Search for end of header area (2 CRLFs)
	CALL SEARCH
	 JRST [	MOVE W,MSGBON(M)	; Not found, assume whole msg
		MOVEM W,MSGHDN(M)	;  is one big header
		JRST PARS13]		; ..
	CALL BP2CHR		; Convert to char pointer
	SUB V,MSGBOD(M)		; Compute length of header area
	MOVEM V,MSGHDN(M)	;  and save it away
PARS13:	CALL FNDSUB		; Find the subject
	MOVEM V,MSGSUB(M)
	MOVEM W,MSGSUN(M)	; Save position and size

	CALL FNDFRM		; Find the from/sender
	MOVEM V,MSGFRM(M)	; Where
	MOVEM W,MSGFRN(M)	; Size

	CALL FNDDAT		; Find the date
	MOVEM B,MSGDAT(M)	; Receive date

	POP P,V			; Recover ending address
	CAMGE V,FILSIZ		; Is this the last one
	 AOJA M,PARS10		; No,keep going

	MOVEM M,LASTM		; Save total number of messages
	RET

.NIN:	SETZ B,
.NIN1:	ILDB D,A
	CAIL D,"0"
	 CAILE D,"0"-1(C)
	 RET			; Done
	IMULI B,(C)
	ADDI B,-"0"(D)
	JRST .NIN1
; Find the subject of the message

FNDSUB:	MOVEI T,[ASCIZ /
Subject: /]
	CALL FNDHDR		; Try to find this header
	 JRST FNDSB3		; Not there
FNDSB1:	SETZ W,			; Count size of field in w
FNDSB2:	ILDB T,A		; Get char
	CAIE T,15		; Until the CR
	 AOJA W,FNDSB2
	RET
FNDSB3:	MOVEI T,[ASCIZ /
Re: /]				; Try this then
FNDSB4:	CALL FNDHDR
	 JRST FNDSB5		; Not there either
	JRST FNDSB1		; Found it then
FNDSB5:	SETZB V,W		; Say we didnt find it anywhere
	RET


; Find the author of a message

FNDFRM:	MOVEI T,[ASCIZ /
From: /]
	CALL FNDHDR
	 CAIA
	 JRST FNDSB1
	MOVEI T,[ASCIZ /
Sender: /]
	JRST FNDSB4


; Find the date field

FNDDAT:	MOVE V,MSGALL(M)	; First thing in header is recv date
	CALL CHR2BP
	SETZB B,C
	IDTIM
	 ERJMP [CMERR (File has bad format - message %M has no receive date)
		SETO B,			; supply a random one (now)
		RET]
	RET


FNDSDT:	MOVEI T,[ASCIZ /
Date: /]
	CALL FNDHDR
	 JRST FNDDT1		; Not there
	SETZB B,C
	IDTIM			; Try to parse it
FNDDT1:	 MOVE B,MSGDAT(M)	; Bad format, use recv date
	RET
; Try to find a header in the message body

FNDHDR:	MOVE V,MSGBOD(M)	; Start of msg body
	MOVE W,MSGHDN(M)	; Look in header area only
	CALL SEARCH		; try to find it
	 RET			; No good
	AOS (P)
	JRST BP2CHR		; And get char pointer

SEARCH:	HRLI T,(<POINT 7,0>)
	SETZ A,
SEARC1:	ILDB B,T		; Get a character
	MOVEM B,SRCBUF(A)	; Compile search table
	JUMPE B,SEARC2
	AOJA A,SEARC1

SEARC2:	CAMGE W,A		; Pattern larger than subject string?
	 RET			; Yes - return failure now
	CALL CHR2BP		; Get byte pointer
	SETZ U,			; Init counter
	TLNE A,(1B0)		; Word boundary?
	JRST SEARC4		; Yes - start fast match now
SEARC3:	TLNN A,(76B5)		; At end of word?
	AOJA A,SEARC4		; Yes - do fast match for rest
	CALL EQSTR		; See if the strings match
	 AOJA U,SEARC3		; No - try next character
	RETSKP			; Yes, skip return
SEARC4:	SUBI W,(U)		; Correct count for chars done
	JUMPLE W,R		; Return if no more string
	MOVEI B,(W)		; Number of bytes to do
	IDIVI B,5		; Get number of words
	JUMPE C,.+2
	 AOJ B,
	MOVEI T,(B)		; That is number of words to try to do
	PUSH P,L		; Get a reg
	MOVE L,SRCBUF		; First character
	IMUL L,[<BYTE (7) 1, 1, 1, 1, 1>_-1]
	LSH L,1
	MOVE O,L
	XOR O,[BYTE (7) 40, 40, 40, 40, 40]
	MOVE X,[BYTE (7) 1, 1, 1, 1, 1]

SEARC5:	MOVE B,L		; Pattern to match
	MOVE C,O		; Case indept one
	MOVE D,(A)		; Word to try
	MOVE E,(A)
	JCRY0 .+1		; Clear carry flags
	EQVB D,B
	EQVB E,C
	ADD D,X
	ADD E,X
	EQV D,B
	EQV E,C
	JCRY0 SEARC6		; Found a match
	TDNN D,X
	 TDNE E,X
	 JRST SEARC6
SEAR5B:	SOJLE T,[POP P,L		; Not found, restore L
		RET]			; and give failure return
	SUBI W,5		; Account for word we've scanned
	AOJA A,SEARC5		; Try some more
SEARC6:	MOVSI U,-5		; Try matching withing this word
	HRLI A,(<POINT 7,,>)	; Start on word boundary
SEARC7:	CALL EQSTR		; Try to match string
	 AOBJN U,SEARC7		; No match, keep trying
	JUMPGE U,SEAR5B		; Not found this word, try some more
	POP P,L			; Restore L
	RETSKP			; Found it, skip return

; Try to match pattern against one in srcbuf
; W has length of subject string, A points to it

EQSTR:	PUSH P,A		; Save pointer
	PUSH P,W		; Save length
	SETZ B,
EQSTR1:	JUMPL W,EQSTR2		; If subject text gone, quit
	SKIPN C,SRCBUF(B)	; Get next char
	 JRST [	POP P,W			; Restore W
		POP P,(P)		; Don't restore A
		RETSKP]			; Null, we found a match
	ILDB D,A		; Get next char
	JUMPE D,[SOJG W,.-1		; Ignore nulls which MAILER inserts
		JRST EQSTR2]		; Subject exhausted, quit
	CAIN D,(C)		; Matches?
	 AOJA B,[SOJA W,EQSTR1]	; Yes, keep trying
	TRC D,(C)		; Try case indept
	CAIN D,40
	 AOJA B,[SOJA W,EQSTR1]	; Yes, keep trying
EQSTR2:	POP P,W
	POP P,A			; No match - restore pointer
	IBP A			;  and advance one character
	RET


; Convert byte count in v to byte pointer in a

CHR2BP:	PUSH P,B
	MOVE A,V
	IDIVI A,5
	ADDI A,MSGPAG_9		; Offset it right
	HRL A,BPS(B)
	POP P,B
	RET


; Vice versa

BP2CHR:	LDB C,[POINT 6,A,5]	; Get position field
	MOVEI V,1-MSGPAG_9(A)	; Clear out bp field
	IMULI V,5
	IDIVI C,7
	SUBI V,(C)
	RET

BPS:	440700
	350700
	260700
	170700
	100700
; Parse the rest of this line as addresses, inserting default host
; Name pointed to by e, using free space from frenam and into list in w

PRADDR:	STKVAR <<SAVAB,2>,HSTBEG,NAMBEG>
	MOVE U,FRENAM
PRADD0:	TXZ F,F%AT		; No @ seen yet
	MOVEI T,(U)		; Save pointer for later
PRADD1:	ILDB B,A		; Get char
	CAIE B,","
	 CAIN B,15
	 JRST NXTAD1
	CAIN B," "
	 JRST PRADD1		; flush leading spaces
	HRLI U,(<POINT 7,0>)	; Make byte pointer
	MOVEM U,NAMBEG		; Save start of name string
PRADD2:	CAIN B,":"
	 JRST SKPADR
	CAIN B,"("		; ( - search for matching )
	 JRST PRADD4
	CAIE B,","
	 CAIN B,15		; End of line or this address
	 JRST PRADD5
	CAIN B,">"		; Terminating bracket?
	JRST PRNET3		; Yes - flush remainder of address
	CAIN B,"@"		; Allow @ in net address
	JRST PRNETB
	CAIN B," "		; Non-initial spaces
	 JRST PRNETA		; Terminate this part of it
PRADD3:	IDPB B,U		; Stick it in
	ILDB B,A		; Get next
	JRST PRADD2


; Skip to ")"

PRADD4:	IDPB B,U
	ILDB B,A
	CAIE B,")"
	 JRST PRADD4
	JRST PRADD3
PRADD5:	TXNN F,F%AT		; "at" seen?
	 JUMPN E,NETDEF		; Yes,insert host string then
PRADD6:	DMOVEM A,SAVAB		; Save a and b
	SETZ B,
	IDPB B,U		; End with null
	TXNE F,F%AT		; Net address?
	JRST CHKHNM		; Check for valid host name
PRADD8:	HRRO B,T		; Point to name string
	MOVX A,RC%EMO		; Exact match only
	RCUSR
	 ERJMP PRADD7		; Error
	TXNN A,RC%NOM		; Match?
	JRST ADDADR		; Yes - add to list
PRADD7:	HRRO A,T		; See if special
	HRROI B,[ASCIZ "SYSTEM"]
	STCMP
	JUMPN A,NOUSER		; Jump if no match (no such user)
	MOVE C,[SYSCOD]		; Match supply code
	JRST ADDADR		;  and proceed


;No such user name - issue warning

NOUSER:	CITYPE <% No such user: >
	MOVE A,NAMBEG		; Print name parsed
	PSOUT
	TYPE < - ignored
>
	JRST FLSADR		; continue scan
;Check for valid host name

CHKHNM:	TXNN F,F%ARPA!F%DECN	; Have a net here?
	JRST NOUSER		; No - just complain
	SKIPN HOSTAB		; Have host table?
	CALL HSTINI		; No - get one now
	MOVEI A,HOSTAB		; Point to table
	MOVE B,HSTBEG		; Host name to lookup
	TBLUK			; See if in table
	TXNE B,TL%EXM		; Exact match only!
	 JRST [	MOVE A,(A)		; Get flags for this host
		TXNE A,NT%LCL		; Local host?
		JRST [	SETZ B,			; Wipe it out with a null
			DPB B,HSTBEG		;  ..
			JRST PRADD8]		; Got see if valid local user
		SETO C,			; Foreign host, set network flag
		JRST ADDADR]		; Enter in list
	CITYPE <% No such host: >
	MOVE A,NAMBEG		; Print entire address
	PSOUT
	CALL CRLF
	TYPE <% Enter new host name or CR to ignore.
>
	CALL CMDINI		; Init this level
	PROMPT <Host: >
	MOVEI A,[FLDDB. (.CMCFM,,,,,[FLDDB1 (.CMKEY,,HOSTAB,<-1,,HSTHLP>)])]
	CALL RFIELD
	LDB A,[POINTR (<0(C)>,CM%FNC)]	; Get code
	CAIN A,.CMCFM		; Just CR?
	JRST FLSADR		; Yes - skip this entry
	HLRO B,(B)		; Append new host name
	MOVE A,HSTBEG		;  to address
	SETZ C,
	SOUT
	MOVE U,A		; Update new free pointer
	CONFRM			; Get CRLF
	SETO C,			; Flag as net address
	JRST ADDADR		;  and add to list
; Add address to list c(C) := user number or code
;	-1 := net address
;	-2 := SYSTEM
;	 0 := no known address
; c(T) := pointer to name string

ADDADR:	HRRZ B,C		; User number or code
	HRL B,T			; Pointer to string
	MOVEI A,NAMTAB		; Name string table
	TBADD			; Attempt to add
	 ERJMP FLSADR		; Reclaim space (dupl entry)
	AOS W			; Step to next entry
	HLRZM B,(W)		; Save pointer to string
	MOVEI U,1(U)
	JRST NXTADR		; Go scan next

FLSADR:	MOVEI U,(T)		; Reclaim unused string
NXTADR:	DMOVE A,SAVAB		; Restore break char and pointer
NXTAD1:	CAIN B,","		; more names?
	 JRST NXTAD2		; Yes - check for ,<crlf>
	HRRZ T,FRENAM		; No - end of line then
	MOVEM U,FRENAM		; Update free space
	CAIE T,(U)		; If no names gotten,
	 RET
	TXNN F,F%CC		; Must undo update to pointer
	 HRRZ W,TOPTRS
	TXNE F,F%CC
	 HLRZ W,TOPTRS
	RET


;Comma seen - check line continuation

NXTAD2:	MOVEM A,SAVAB		; Save pntr
	ILDB B,A		; Peek ahead to next char
	CAIE B,15		; Maybe <CR>
	JRST [	MOVE A,SAVAB	; No - restore pntr
		JRST PRADD0]
	ILDB B,A		; Skip <LF> also
	JRST PRADD0		; Get next address
;Check possible net address

PRNETA:	ILDB B,A
	CAIN B," "
	 JRST PRNETA
	CAIE B,"a"		; start of @?
	 JRST PRNET5		; No, flush rest then
	ILDB B,A
	CAIE B,"t"
	 JRST PRNET5
	ILDB B,A
	CAIE B," "		; must be trailing space
	 JRST PRNET5
	MOVEI B,"@"
PRNETB:	IDPB B,U		; Got the at, start it out
	TXO F,F%AT
	MOVEM U,HSTBEG		; Save start of host name
PRNET1:	ILDB B,A
	CAIN B," "
	 JRST PRNET1		; Flush any intermediate spaces
PRNET2:	IDPB B,U
	ILDB B,A
	CAIN B,">"		; Terminating bracket?
	JRST PRNET3		; Yes - skip to end
	CAIE B,","
	 CAIN B,15
	 JRST PRADD6		; Tie off string and validate
	CAIE B," "
	 JRST PRNET2
PRNET3:	ILDB B,A
	CAIN B,"("		; Handle comment
	 JRST SKPCOM
	CAIE B,","		; Flush the rest of this address
	 CAIN B,15
	 JRST PRADD6		; Tie off string and validate
	JRST PRNET3

PRNET4:	ILDB B,A
PRNET5:	CAIN B,"<"		; check for actual address
	JRST PRNET6
	CAIE B,","		; Flush the rest of this address
	 CAIN B,15
	JRST [	MOVEI U,(T)	; Restore string space
		JRST NXTAD1]
	JRST PRNET4

PRNET6:	TXZ F,F%AT		; Forget "@" seen
	MOVEI U,(T)		; Reset string pointer
	HRLI U,(<POINT 7,0>)
	ILDB B,A		; Get next character
	JRST PRADD2		; Try again
; Insert the default hostname

NETDEF:	MOVE D,E
NETDF1:	ILDB C,D
	JUMPE C,PRADD6
	IDPB C,U
	JRST NETDF1


; Flush this field

SKPADR:	MOVEI U,(T)
SKPAD1:	ILDB B,A
	CAIE B,","
	 CAIN B,15
	 JRST NXTAD1
	JRST SKPAD1


; Flush comments

SKPCOM:	ILDB B,A
	CAIE B,")"
	 JRST SKPCOM
	JRST PRNET3
; Get to and cc lists from message

PRTOCC:	SETZ E,			; assume default
	TXNN F,F%AT		; Was there an @ in the main name?
	 JRST PRTO10		; No, leave default at null
	MOVE E,[POINT 7,NAMTXT]	; First name
PRTO01:	ILDB B,E
	JUMPE B,[SETZ E,	; If node name removed (because local node),
		JRST PRTO10]	;  then don't default node name
	CAIE B,"@"		; Start it just after the @
	 JRST PRTO01
	ADD E,[7B5]		; Include the @ too
PRTO10:	HRRZ W,TOPTRS		; Where to store more of list
	TXZ F,F%CC		; Not in CC yet
PRTO11:	CALL PRADDR		; Parse this line
	IBP A			; Move over the LF too
	ILDB B,A		; Get next char
	CAIE B,"T"		; More to maybe
	 CAIN B,"t"
	 JRST PRTO20
	CAIE B,"C"		; Or maybe start of cc
	 CAIN B,"c"
	 JRST PRTO30
PRTO12:	TXNN F,F%CC		; If doing to still
	 HRRM W,TOPTRS		; Update to list
	TXNE F,F%CC
	 HRLM W,TOPTRS		; Else cc
	RET			; And done
PRTO20:	ILDB B,A
	CAIE B,"O"
	 CAIN B,"O"
	 CAIA
	 JRST PRTO12
	ILDB B,A
	CAIE B,":"
	 JRST PRTO12		; No good I guess
	JRST PRTO11		; Get rest of this line then
PRTO30:	ILDB B,A
	CAIE B,"C"
	 CAIN B,"c"
	 CAIA
	 JRST PRTO12
	ILDB B,A
	CAIE B,":"
	 JRST PRTO12
	TXOE F,F%CC		; Now doing cc
	 JRST PRTO11		; Already was
	HRRM W,TOPTRS		; Update list of to's
	HLRZ W,TOPTRS		; Get list of cc
	JUMPN W,.+2
	 MOVEI W,TCPAG+400-1	; Init if emptry so far
	JRST PRTO11		; And now go get more
 SUBTTL Message handling subroutines

; Type out header of a message
TYPHDR:	CALL CRIF		; Get a fresh line
	MOVE T,MSGBTS(M)	; Get messages bits
	TXNE T,M%SEEN
	 SKIPA A,[" "]
	 MOVEI A,"N"		; New
	PBOUT
	TXNN T,M%ATTN
	 SKIPA A,[" "]
	 MOVEI A,"F"		; FLAGGED
	PBOUT
	TXNN T,M%RPLY
	 SKIPA A,[" "]
	 MOVEI A,"A"		; Answered
	PBOUT
	TXNN T,M%DELE
	 SKIPA A,[" "]
	 MOVEI A,"D"		; Deleted
	PBOUT
	MOVEI A,.PRIOU
	MOVEI B,1(M)		; Message number
	MOVX C,NO%LFL+3B17+^D10
	NOUT
	 JFCL
	PRINT " "
	SKIPG B,MSGDAT(M)	; Date
	 JRST [	DMOVE T,[ASCIZ /      /]	; Fill with spaces if not there
		JRST TYPHD2]
	HRROI A,T		; Where to stick string
	MOVX C,OT%NTM
	ODTIM
	TLZ U,(<BYTE (7) 0,177>)	; Clear out year and anything else
TYPHD2:	UTYPE T
	MOVE A,MSGFRM(M)	; From field
	MOVEI B,^D20		; Limited to 20 chars
	MOVE C,MSGFRN(M)	; Size
	CALL TYPHDS
	JUMPE B,TYPHD3		; None more needed
	MOVEI A," "
	PBOUT
	SOJG B,.-1		; Fill with spaces
TYPHD3:	MOVE A,MSGSUB(M)	; Subject field
	SKIPG B,LINEW		; Get tty line width
	MOVEI B,^D72		; If unknown or weird, assume 72
	SUBI B,^D49		; Make rest of line fit
	CAIL B,^D100		; If length>100, need another column
	SUBI B,1		;  ..
	CAIL B,^D1000		; If length>1000, need another
	SUBI B,1		;  ..
	CAIL B,^D10000		;  etc. etc.
	SUBI B,1		; 5 columns ought to do it!
	MOVE C,MSGSUN(M)	; Size
	CALL TYPHDS
	MOVE A,MSGBON(M)	; Length of message
	ETYPE < (%1D chars)
>
	RET
TYPHDS:	PRINT " "
	JUMPE A,R		; Nothing there to type
	MOVE V,A		; Start of field
	JUMPE C,R		; Nothing if zero length
	CAMLE C,B		; Or truncate
	 MOVE C,B
	MOVN C,C
	ADD B,C			; Get number of chars needed to fill
	PUSH P,B
	CALL CHR2BP		; Get byte pointer
	MOVE B,A
	MOVEI A,.PRIOU
	SOUT
	POP P,B
	RET

; Type out a message

.TYPMS:	CONFRM			; Confirm first
TYPMSG:	MOVE C,MSGBON(M)	; Length of message
	MOVE B,MSGDAT(M)	; And date received
	CIETYP < Message %M (%3D chars), received %2T
>
	MOVN C,C
	MOVE V,MSGBOD(M)
	CALL CHR2BP
	MOVE B,A
	MOVEI A,.PRIOU
	SOUT			; Print the message out
	MOVX A,M%SEEN		; Mark message as seen
	IORM A,MSGBTS(M)
	JRST UPDBIT		; And maybe update

CHKDEL:	MOVX A,M%DELE
	TDNN A,MSGBTS(M)	; Deleted?
	 RETSKP			; No, skip return
	CIETYP < Message %M deleted.
>
	RET			; Single return
; Type out headers of recent messages

RECENT:	TXO F,F%F1		; Want headers
RECEN0:	SETZB M,NFLAGD		; Init counts
	SETZM NDELET
	SETZM UNSEEN		; ...
	SETOM PRIORM		; No new messages yet
RECEN1:	TXNE F,F%MOD		; Mod hack?
	 CALL RECMOD		; Yes - special test for new msgs
	MOVE A,MSGBTS(M)	; Get flags
	TXNE A,M%SEEN		; Seen this one?
	 JRST RECEN2		; Yes - skip it
	SKIPGE PRIORM
	MOVEM M,PRIORM		; Save first unseen
	TXNE F,F%F1		; Header?
	CALL TYPHDR		; Yes - tell him what it's about
RECEN2:	MOVE A,MSGBTS(M)	; Flags again for count updates
	TXNN A,M%SEEN		; Seen this one?
	AOS UNSEEN		; Count unseen messages
	TXNE A,M%DELE		; Deleted?
	AOS NDELET		; Count deleted ones
	TXNE A,M%ATTN		; Flagged?
	AOS NFLAGD		; Count 'em
	CAMGE M,LASTM		; Thru with all msgs?
	 AOJA M,RECEN1		; No
	SKIPGE M,PRIORM		; Set current message to first unseen
	SETZB M,PRIORM		;  Else use first message
	RET

; Special routine to update m%seen for system-messages

RECMOD:	MOVX W,M%SEEN		; Bit to twiddle
	SKIPLE A,MSGDAT(M)	; Get recv date of message
	CAMG A,LASTRD		; Check against last read date
	 JRST [	IORM W,MSGBTS(M)	; Mark as seen (ie not new)
		RET]
	ANDCAM W,MSGBTS(M)	; Not seen - assume new
	RET


; Type out summary of the current file (status command)

.STATU:	NOISE (of current message file)
	CONFRM
	SKIPG MSGJFN		; Have a file?
	 CWARN (No current mail file)
	TXZ F,F%F1		; No headers
	PUSH P,M		; Save current message number
	CALL RECEN0		; Update status
	POP P,M			; Restore
	CALL SUMMRY		; Print summary
	CIETYP < Currently at message %M.
>
	RET
; Print out summary of message file

SUMMRY:	MOVE A,LASTM		; Get number of messages
	AOS D,A
	MOVEI B,[ASCIZ /Last read: %3T/]
	TXNE F,F%MOD		; MOD hack?
	MOVEI B,[ASCIZ /Last login: %3T/]
	SKIPG C,LASTRD		; Last read date
	 MOVEI B,[ASCIZ /Never read/]
	SUB D,UNSEEN		; Number of old messages
	SKIPN UNSEEN		; Any new messages?
	 TDZA E,E
	 MOVEI E,[ASCIZ / (%4D old)/]
	HRRZ T,FILPGS		; Number of pages
	CETYPE < %2S, %1D message%P%5S, %6D page%P
>
	SKIPE D,NDELET		; Check for deleted
	 ETYPE < (You have %4D message%P deleted.)>
	SKIPN NFLAGD		; Messages flaged?
	 RET
	MOVX D,M%ATTN		; Bit to check
	CIETYP < Message%4L flagged.
> 
	RET
; Update the file copy of the message bits, unless in read command

UPDBIT:	TXNE F,F%READ
	 RET			; In which case noop


; Insist on update

UPDBT0:	LDB A,[POINT 12,MSGBTS(M),17]
	HRRZ B,MSGBTS(M)	; Get new copy of bits
	TXNN F,F%MOD		; MOD hack - exit now
	CAIN B,(A)		; Old matches new?
	 RET			; Yes, no need to do any more
	CALL GETJF2		; Get a second jfn if dont already
	 RET
	MOVE V,MSGALL(M)	; Start of the message header
	CALL CHR2BP		; Get byte pointer
UPDBT1:	ILDB B,A		; Get char
	CAIN B,15		; At end of line??
	JRST [	CMERR (File has bad format - Cannot find message flags)
		JRST CLSJF2]
	CAIE B,";"		; At start of bits?
	 JRST UPDBT1
	SUBI A,MSGPAG_9		; Get absolute pointer
	PUSH P,A		; Save that pointer
	HLRZ B,A
	CAIN B,010700
	 AOJ A,
	ANDI A,-1
	IDIVI A,1000		; Get page number we need
	HRL A,MSGJF2
	CAIL B,776		; If near end of page
	 SKIPA C,[PM%CNT+PM%WR+PM%RD+2]	; Map two pages
	 MOVSI C,(PM%WR!PM%RD)
	MOVE B,[.FHSLF,,WRTPGS_-9]
	PMAP
	POP P,A			; Get back byte pointer
	TRZ A,777000		; Just relative to page
	ADDI A,WRTPGS		; Offset right
	HRRZ B,MSGBTS(M)	; Bits to set out
	MOVE C,[NO%LFL+NO%ZRO+^D12B17+10]
	NOUT			; Write them out
	 JFCL
	MOVEI C,15		; Kill the null
	IDPB C,A		; With a CR
	DPB B,[POINT 12,MSGBTS(M),17]	; This is now the file version
	SETO A,
	MOVE B,[.FHSLF,,WRTPGS_-9]
	MOVE C,[PM%CNT+2]
	PMAP			; Unmap the pages
CLSJF2:	MOVE A,MSGJF2
	TLO A,(CO%NRJ)		; Keep this jfn around
	CLOSF
	 JFCL
	HRRZ A,MSGJF2		; In case error , get JFN again
	CALL SETREF		; Set read date-time
	CALL CTCOK		; Allow ctrl-C again if disabled
	RET			; Done

GETJF2:	SKIPLE MSGJF2		; Have one already?
	 JRST GETJ2A		; Yes, use it
	HRROI A,FILNAM
	MOVE B,MSGJFN		; One we do have
	SETZ C,
	JFNS
	MOVSI A,(GJ%OLD!GJ%SHT)
	HRROI B,FILNAM
	GTJFN
	 JERROR (Cannot get second JFN on file)
	MOVEM A,MSGJF2		; Save jfn
GETJ2A:	MOVE A,MSGJF2		; Get back jfn
	MOVX B,7B5+OF%RD!OF%WR!OF%PDT	; Open file for write as well (it is
	OPENF			; now write-locked against new msgs).
	 RET			; Write protected
	RETSKP			; Return success
 SUBTTL Message sequence subroutines

; Get sequence

DFSQNW:	MOVEI A,DEFNEW		; Default to new (unseen)
	JRST GETSEQ

DFSQTH:	MOVEI A,DEFCUR		; Default to current message
GETSEQ:	PUSH P,A		; Save command block addrs
	SKIPG MSGJFN		; Have a message file?
	 CWARN (No current mail file)
	NOISE (message sequence)
	SETOB X,LSTMSG
	MOVE L,[POINT 12,MSGSEQ]	; Init sequence table
	POP P,A			; Restore command block
	CALL RFIELD		; Get command field
	LDB A,[POINTR (<0(C)>,CM%FNC)]	; Get function found
	CAIN A,.CMKEY		; Keyword?
	JRST GETSQK		; Yes - done
	CAIN A,.CMNUM		; Number?
	JRST GETSQN		; Yes - proceed
	JRST GETSQT		; Must be token (% or .)


;Keyword seen , handle defaulting and return

GETSQK:	HRRZ A,(B)		; Get routine addrs
	JRST (A)


;Token - check for % or . and supply number

GETSQT:	LDB A,[POINT 7,ATMBUF,6]	; Get token character
	CAIN A,"%"
	SKIPA B,LASTM		; % = last message number
	MOVEI B,(M)		; . = current message number
	AOJA B,GETSQN		; Handle as number now
;Number parsed - handle n:m n,m or n alone

GETSQN:	JUMPE B,GTSQNE		; Range error
	SOJL B,GTSQNE
	CAMLE B,LASTM
	 JRST GTSQNE
	JUMPGE X,GTSQN2		; 2nd in series n:m
	IDPB B,L		; Save number in list
	MOVEI A,GTNBK1		; Now try for <cr> ! , ! :
GTSQNA:	CALL RFIELD
	LDB A,[POINTR (<0(C)>,CM%FNC)]	; Get fcn parsed
	CAIN A,.CMCFM		; EOL?
	JRST GTSQNR		; Yes - done
	CAIE A,.CMCMA		; Comma?
	LDB X,L			; Must be ":" ,setup for 2nd arg
	MOVEI A,GTNBK2		; Yes - try for <number> ! . ! %
	CALL RFIELD
	LDB A,[POINTR (<0(C)>,CM%FNC)]	; Get fcn parsed
	CAIN A,.CMCFM		; EOL?
	JRST GTSQNR		; Yes - done
	CAIN A,.CMNUM		; Number?
	JRST GETSQN		; Yes - handle
	JRST GETSQT		; Handle token


;2nd in range seen - fill list

GTSQN2:	CAIN X,(B)		; Done with range
	JRST GTSQNC		; Look for next field
	CAIG X,(B)		; If going forwards,
	 AOSA X			;   increment,
	SOS X			;  else decrement
	IDPB X,L		; Save in table
	JRST GTSQN2		; Loop till done
GTSQNC:	SETO X,			; Say looking for 1st number of pair
	MOVEI A,GTNBK3		; Try for <cr> ! ,
	JRST GTSQNA


;EOL seen , wrapup numbers

GTSQNR:	MOVEI B,3777		; Mark end of list
	IDPB B,L
	MOVE L,[POINT 12,MSGSEQ]	; Reset list
	MOVEI A,NXTSEQ		; Nest in the sequence
	MOVEM A,NXTMSG		; Setup as dispatch
	RET			; Return

GTSQNE:	ERROR (Number out of range)


;COMND argument blocks

    DEFINE FLDDB1 (TYP,FLGS,DATA,HLPM,DEFM,LST) <
	..XX==<FLD(TYP,CM%FNC)>+FLGS+<Z LST>
	IFNB <HLPM>,<..XX==CM%HPP!..XX>
	IFNB <DEFM>,<..XX==CM%DPP!..XX>
	    ..XX
	IFNB <DATA>,<DATA>
	IFB <DATA>,<0>
	IFNB <HLPM>,<HLPM>
	IFB <HLPM>,<IFNB <DEFM>,<0>>
	IFNB <DEFM>,<POINT 7,[ASCIZ \DEFM\]>
    >

DEFCUR:	FLDDB1 (.CMTOK,CM%SDH,<POINT 7,[ASCII "%"]>,<-1,,HLPTXT>,<current>,TKNDOT)

DEFNEW:	FLDDB1 (.CMTOK,CM%SDH,<POINT 7,[ASCII "%"]>,<-1,,HLPTXT>,<new>,TKNDOT)

DEFALL:	FLDDB1 (.CMTOK,CM%SDH,<POINT 7,[ASCII "%"]>,<-1,,HLPTXT>,<all>,TKNDOT)

DEFDEF:	FLDDB1 (.CMNUM,CM%SDH,^D10,,,[FLDDB1 (.CMKEY,,SQCMTB)])

TKNDOT: FLDDB1 (.CMTOK,CM%SDH,<POINT 7,[ASCII "."]>,,,DEFDEF)

TKNCLN:	FLDDB1 (.CMTOK,CM%SDH,<POINT 7,[ASCII ":"]>)

GTNBK1:	FLDDB1 (.CMCFM,CM%SDH,,<-1,,HLPTXT>,,[FLDDB1 (.CMCMA,CM%SDH,,,,TKNCLN)])

GTNBK2:	FLDDB1 (.CMTOK,CM%SDH,<POINT 7,[ASCII "%"]>,<-1,,HLPTXT>,,GTBK2A)
GTBK2A:	FLDDB1 (.CMTOK,CM%SDH,<POINT 7,[ASCII "."]>,,,GTBK2B)
GTBK2B:	FLDDB1 (.CMNUM,CM%SDH,^D10)

GTNBK3:	FLDDB1 (.CMCFM,CM%SDH,,<-1,,HLPTXT>,,[FLDDB1 (.CMCMA,CM%SDH)])

HLPTXT:	ASCIZ \Message sequence in the form:
   n		- Single message number
   n,m,...,k	- List of message numbers
   n:m		- Range of message numbers
     or any combination of ranges in a list.
   "." 		- Current message number
   "%"	 	- Last message in file
Terminate list with <CR>\

SQCMTB:	NSQCMS,,NSQCMS
	CMD1 (A,ENTALL,CM%INV!CM%ABR)
ENTALL:	CMD1 (All,STQALL)
	CMD1 (Answered,STQANS)
	CMD1 (Before,STQTMB)
	CMD1 (Current,STQCUR)
	CMD1 (Deleted,STQDEL)
	CMD1 (F,ENTFRM,CM%INV!CM%ABR)
	CMD1 (Flagged,STQFLG)
ENTFRM:	CMD1 (From,STQFRM)
	CMD1 (Inverse,STQREV)
	CMD1 (Last,STQLST)
	CMD1 (New,STQNEW)
	CMD1 (Old,STQOLD)
	CMD1 (Since,STQTMS)
	CMD1 (Subject,STQSBJ)
	CMD1 (Unanswered,STQUNA)
	CMD1 (Undeleted,STQUND)
	CMD1 (Unflagged,STQUNF)
NSQCMS==.-SQCMTB-1
STQALL:	SKIPA A,[NXTALL]
STQDEL:	 MOVEI A,NXTDEL
STQDL0:	MOVEM A,NXTMSG
	CONFRM			; Get confirmation
	MOVEM M,PRIORM		; Save current in case none in list
	SETO M,
	RET

STQFLG:	SKIPA A,[NXTFLG]
STQUND:	 MOVEI A,NXTUND
	 JRST STQDL0

STQNEW:	SKIPA A,[NXTNEW]
STQOLD:	 MOVEI A,NXTOLD
	JRST STQDL0

STQLST:	MOVEI A,[FLDDB. (.CMNUM,,^D10,,<1>)]
	CALL RFIELD
	CAIE B,1		; Singular?
	JRST STQLS0		; No, use plural
	NOISE (message)
	JRST STQLS1
STQLS0:	NOISE (messages)
STQLS1:	PUSH P,B		; Save number
	CONFRM
	POP P,D			; Restore
	JUMPLE D,GTSQNE		; Range check
	SUBI D,1		; LASTM is counted from zero
	CAMLE D,LASTM		;  ..
	JRST GTSQNE		;  ..
	ADDI D,1		; recorrect D
	MOVE C,LASTM		; Number of last message
STQLS2:	IDPB C,L		; Stuff message numbers
	SUBI C,1		; Next message from end
	SOJG D,STQLS2		; Do for all in list
	JRST GTSQNR		; Done with list

STQCUR:	MOVEI B,(M)		; Default to current
	IDPB B,L		; Save on list
	CONFRM			; Grntee EOL
	JRST GTSQNR		; Done with list

STQUNF:	SKIPA A,[NXTUNF]
STQREV:	MOVEI A,NXTREV		; Reverse order
	JRST STQDL0

STQANS:	SKIPA A,[NXTANS]	; Answered
STQUNA:	MOVEI A,NXTUNA		; Unanswered
	JRST STQDL0
STQFRM:	MOVEI X,NXTFRM		; Match from string
	MOVEI A,[FLDDB. (.CMCFM,CM%SDH,,<
String to match in "From" field.
>,,[FLDDB. (.CMTXT,CM%SDH)])]
	JRST STQSB0		; Common routine to get pattern

STQSBJ:	MOVEI X,NXTSBJ		; Match subject string
	MOVEI A,[FLDDB. (.CMCFM,CM%SDH,,<
String to match in "Subject" field.
>,,[FLDDB. (.CMTXT,CM%SDH)])]
STQSB0:	PUSH P,A		; Save arg
	NOISE (string)
	POP P,A
	CALL RFIELD		; Read subject line or crlf
	LDB A,[POINTR (<0(C)>,CM%FNC)]	; See what typed
	CAIN A,.CMCFM		; Just CR?
	ERROR <No string given.>	; Yes - error
	HRROI B,ATMBUF		; Copy string to pattern buffer
	HRROI A,PATSTR
	SETZ C,
	SOUT
	MOVE A,X		; Routine addrs
	JRST STQDL0


;Find substring in From field

NXTSBJ:	SKIPA C,[CALL SBJSTR]	; Routine to match Subject string
NXTFRM:	MOVE C,[CALL FRMSTR]	; Routine to match From string
	JRST NXTAL0		; Use common loop

FRMSTR:	SAVEAC <A,C>		; Save these regs
	MOVEI T,PATSTR		; String to match
	MOVE V,MSGFRM(A)	; From field for this message
	MOVE W,MSGFRN(A)
	CALL SEARCH		; Look for string
	 RETSKP			; Not found - try next
	RET			; Found - use this

SBJSTR:	SAVEAC <A,C>		; Save these regs
	MOVEI T,PATSTR		; String to match
	MOVE V,MSGSUB(A)	; Subject field for this message
	MOVE W,MSGSUN(A)
	CALL SEARCH		; Look for string
	 RETSKP			; Not found - try next
	RET			; Found - use this
; Get date-time arg for "before" and "since" keywords

STQTMB:	MOVEI X,NXTTMB		; Rountine addrs
	MOVEI A,DEFTMB		; Date/time parse
	JRST STQTIM

STQTMS: MOVEI X,NXTTMS		; Routine addrs
	MOVEI A,DEFTMS		; Date/time parse
STQTIM:	PUSH P,A		; Save arg
	NOISE (Date and Time)
	POP P,A			; Restore arg
	CALL RFIELD
	MOVEM B,COMPDT		; Save it for compare
	MOVE A,X		; Copy routine to a
	JRST STQDL0		; Common exit

DEFTMB:	FLDDB1 (.CMTAD,CM%SDH,<CM%IDA!CM%ITM>,<-1,,TMBTXT>,,DEFTIM)
DEFTMS:	FLDDB1 (.CMTAD,CM%SDH,<CM%IDA!CM%ITM>,<-1,,TMSTXT>,,DEFTIM)
DEFTIM:	FLDDB1 (.CMTAD,CM%SDH,CM%IDA,,,[FLDDB1 (.CMTAD,CM%SDH,CM%ITM)])

TMBTXT:	ASCIZ \Date and Time:
Only messages with date-times prior to the specified
date and time will be used.\

TMSTXT:	ASCIZ \Date and Time:
Only messages with date-times greater than or equal to the
specified date and time will be used.\


; Compare date/time

NXTTMB:	SKIPA C,[CAMLE B,MSGDAT(A)]
NXTTMS: MOVE C,[CAMG B,MSGDAT(A)]
	MOVE B,COMPDT		; Date/time to compare against
	JRST NXTAL0		; Use common rountine
; Print out sequence

PRTSEQ:	SKIPGE A,LSTMSG		; Any last message?
	 JRST PRTSQ3		; No, install this one then
	CAIN M,1(A)		; Yes, is this one the next one?
	 JRST PRTSQ2		; Yes, keep accumulating
	CALL PRTSQS		; Print what is there now otherwise
PRTSQ1:	HRLM M,LSTMSG		; And set ourselves up as start
PRTSQ2:	HRRM M,LSTMSG		; Set ourselves up as next link in chain
	RET
PRTSQ3:	TXZ F,F%CMA		; Reset comma flag
	JRST PRTSQ1

PRTSQS:	TXOE F,F%CMA		; Maybe a comma first
	 PRINT ","
	PRINT " "
	MOVEI A,.PRIOU
	MOVEI C,^D10
	HLRZ T,LSTMSG		; get start of sequence
	MOVEI B,1(T)
	NOUT
	 JFCL
	HRRZ B,LSTMSG		; Get end
	CAIN B,(T)		; Same?
	 RET			; Yes, that's it
	PRINT ":"
	AOS B			; +1
	NOUT			; Output number
	 JFCL
	RET			; Return
; Get next messages

NXTSEQ:	ILDB A,L		; Get next byte
	CAIN A,3777		; End?
	 RET			; Yes,single return
NXTSQ1:	MOVEI M,(A)		; No, this is next message
	RETSKP			; Skip return

NXTANS:	SKIPA B,[M%RPLY]	; Answered
NXTOLD:	MOVX B,M%SEEN		; Old := seen bit set
	JRST NXTDL0

NXTFLG:	SKIPA B,[M%ATTN]	; Flagged
NXTDEL:	 MOVX B,M%DELE		; Deleted
NXTDL0:	MOVE C,[TDNE B,MSGBTS(A)]	; Bit must be set
	JRST NXTAL0

NXTUNA:	SKIPA B,[M%RPLY]	; Unanswered
NXTUNF:	MOVX B,M%ATTN		; Unflagged
	JRST NXTUD0

NXTNEW:	SKIPA B,[M%SEEN]	; New := seen bit clear
NXTUND:	 MOVX B,M%DELE		; Undeleted
NXTUD0:	SKIPA C,[TDNN B,MSGBTS(A)]	; Bit must be clear
NXTALL:	MOVSI C,(<JFCL>)	; All := pass all thru
NXTAL0:	MOVEI A,1(M)		; Start here
NXTAL1:	CAMLE A,LASTM		; Done?
	 JRST NXTEND		; Check if any done
	XCT C			; Test it out
	 JRST NXTSQ1		; Matches
	AOJA A,NXTAL1		; No good, try next one

NXTEND:	JUMPGE M,R		; Ok if not -1
	HRRZ M,PRIORM		;  else restore prior current msg
	RET

NXTREV:	JUMPGE M,NXTRV1		; First time here?
	HRRZ A,LASTM		; Yes - start at end
	JRST NXTSQ1

NXTRV1:	MOVEI A,(M)		; Try next
	SOJGE A,NXTSQ1		; Keep going till all done
	RET
BINOUT:	PUSH P,A		; Type string in binary mode (for dm)
	MOVEI A,.PRIOU
	RFMOD
	PUSH P,B
	TRZ B,TT%DAM		; Binary mode
	SFMOD
	EXCH A,-1(P)
	PSOUT
	EXCH A,-1(P)
	POP P,B
	SFMOD
	POP P,A
	RET
 SUBTTL Sending subroutines

SNDINI:	SKIPN LHOSTN		; Have name info yet?
	 CALL NAMINI		; No
	JRST .ERSAL		; Go erase everything

NAMINI:	STKVAR <NODARG>
	MOVE A,[SIXBIT /LHOSTN/]
	SYSGT
	MOVEM A,LHOSTN
	TXZ F,F%ARPA!F%DECN	; Assume no nets
	CAMN A,[-1]		; ARPA net?
	 JRST NAMIN1		; No - check for DECnet
	TXO F,F%ARPA		; Yes - set flag
	MOVEI B,(A)
	MOVE A,[POINT 7,MYHNAM,27]
	CVHST
	 JFATAL (CVHST failed on local host)
	RET

NAMIN1:	MOVEI A,.NDGLN		; Get DECnet host name
	MOVE B,[POINT 7,MYHNAM,27]
	MOVEM B,NODARG		; Setup arg block for NODE jsys
	MOVEI B,NODARG		; Point to it
	NODE			; Get our name
	 ERJMP R		; Return - no network
	TXO F,F%DECN		; Set flag - we have DECnet
	RET			;  and return
HSTINI:	STKVAR <HTABL,HSTJFN>	; Place to save table pntr
	TXNN F,F%ARPA		; ARPA or DEC net?
	JRST HSTIND		; DECnet - do that
	MOVE A,[SIXBIT /HSTNAM/]
	SYSGT
	MOVEM B,HTABL		; Save for gtblt sim.
	HRRO A,B
	MOVEI B,HSTNAM		; Get table of host names
	GTBLT
	 ERJMP [MOVE C,HTABL		; Pass pointer to simulator
		CALL GTBSIM
		JRST .+1]
	MOVE A,[SIXBIT /HOSTN/]
	SYSGT
	MOVEM B,HTABL		; Save aobjn pntr
	HRRO A,B
	MOVEI B,EDPAGE		; Temporary space
	GTBLT
	 ERJMP [MOVE C,HTABL		; Pass on pntr
		CALL GTBSIM
		JRST .+1]
	MOVEI A,777		; Length of table (max)
	MOVEM A,HOSTAB
	HLLZ C,HTABL		; Restore aobjn pntr
HSTIN1:	MOVS B,EDPAGE(C)	; Get entry
	TRZ B,777400		; Clear all but host number and name index
	HRRZ A,B		; Isolate host number
	CAMN A,LHOSTN		; Is this one us?
	SKIPA A,[NT%LCL!NT%ARP]	; Yes, set ARPA and local flags
	MOVX A,NT%ARP		; No, just set ARPA flag
	HRR B,A			; Form table entry
	ADD B,[HSTNAM,,0]	; Make relative pointer
	MOVEI A,HOSTAB		; Host name table
	SKIPGE EDPAGE(C)	; Server?
	TBADD			; Yes, add to host table
	AOBJN C,HSTIN1		; Do for all hosts
	RET			; Done
HSTIND:	MOVX A,GJ%OLD!GJ%SHT	; Look for existing file
	HRROI B,[ASCIZ /SYSTEM:DECNET-HOSTS.TXT/]
	GTJFN
	 JFATAL <No DECnet host name table:>
	MOVX B,7B5+OF%RD
	OPENF			; open for read
	 JFATAL <Cannot open DECnet host name table:>
	MOVEM A,HSTJFN		; Save JFN
	MOVE D,[POINT 7,HSTNAM]	; Buffer for host name strings
	MOVEI B,777		; Length of table (max)
	MOVEM B,HOSTAB
HSTID1:	MOVEM D,HTABL		; Save beginning of string
	MOVE A,HSTJFN		; JFN
HSTID2:	BIN			; Get a char
	JUMPE B,HSTIDE		; Skip nulls or check EOF
	CAIE B,15		; CR?
	JRST [	IDPB B,D		; Save character
		JRST HSTID2]		; Get next
	BIN			; Skip LF
	MOVEI B,0		; Add terminating null
	IDPB B,D
	MOVE A,[POINT 7,MYHNAM,27] ; Local host name
	HRRO B,HTABL		; This host name
	STCMP			; See if the same
	SKIPN A			; A=0 if name matched
	SKIPA B,[NT%LCL!NT%DCN]	; Local, set flag
	MOVX B,NT%DCN		; Set DECnet flag
	HRL B,HTABL		; Point to string begin
	MOVEI A,HOSTAB		; Host name table
	TBADD			; Add to table
	AOS D			; Move to next word
	HRLI D,(POINT 7,,)
	JRST HSTID1		; Get next

HSTIDE:	GTSTS			; See if eof or null
	TXNN B,GS%EOF
	JRST HSTID2		; Null - skip it
	CLOSF			; EOF - close file
	 JFCL
	RET			; Return

GTBSIM:	HLLZ D,C		; Setup aobjn
	HRLI B,D		; Form @ pointer
GTBSM1:	HRRZ A,C		; Table number
	HRL A,D			; Index
	GETAB			; Get entry
	 JFATAL (GETAB failure in GTBLT sim.)
	MOVEM A,@B		; Save in table
	AOBJN D,GTBSM1		; Loop till all done
	RET
; Send the current message off

SNDMSG:	SKIPN A,TOPTRS		; Must have some addresses
	JRST [	WARN (No addresses specified)
		RET]
	TRNN A,-1		; Must have some To people too
	JRST [	WARN <No TO, only CC>
		RET]
	MOVE A,TXTPTR		; Get end of message
	MOVEI B,CRLF0
	LDB C,A
	CAIE C,12		; Unless ended with CRLF
	 CALL MOVSTR		; Put one in now
	MOVEI B,0		; Deposit null at end
	IDPB B,A
	CALL SNDLCL		; Send local mail if any
	 RET			; Failure, pass it on
	TXNE F,F%LCL		; Any net mail?
	 RETSKP			; No - done

; Net mail starts here

	MOVE A,[POINT 7,HDRPAG]	; Start of where to assemble message
	MOVEI B,[ASCIZ /Date: /]
	CALL MOVSTR
	SETO B,			; Now
	MOVSI C,(OT%4YR!OT%SPA!OT%NSC!OT%NCO!OT%TMZ!OT%SCL) ; "12 Dec 1977 1906-PST"
	ODTIM
	MOVEI B,[ASCIZ /
From: /]
	CALL MOVSTR
	MOVEI B,MYDIRS		; My name
	CALL MOVST0		; Put it and the null in

	MOVE O,A		; Get pointer set up right
	CALL MOVTO		; And to
	CALL MOVCC		; And CC
	TXO F,F%F1		; Want crlf
	CALL MOVOPT		; Move header options
	CALL MOVSUB		; Insert subject
	SKIPLE REPDAT		; Has a reply date?
	 CALL MOVRDT		; Yes, insert it too
	MOVEI B,CRLF2
	CALL MOVSB2		; And a couple blank lines
	SETZ A,
	IDPB A,O		; Mark end of this with a null too
	TXZ F,F%F3		; No queued mail made yet
	CITYPE <Processing mail...>
	HLRZ W,TOPTRS		; Get CC list
	JUMPE W,SNDMS1		; None
	MOVEI U,TCPAG+400	; Start of list
	CALL SNDNET		; Send it off
	 RET			; Failure, pass it on
SNDMS1:	HRRZ W,TOPTRS		; Get TO list
	MOVEI U,TCPAG
	CALL SNDNET		; Send to list
	 RET			; Failure, pass it on
	TXNN F,F%DECN		; DECNET mail?
	JRST SNDMS2		; No, done
	HLRZ A,HOSTAB		; Yes - clear done flags in host table
	MOVX B,NT%DON		;  ..
	ANDCAM B,HOSTAB(A)	;  ..
	SOJG A,.-1		;  ..
SNDMS2:	TXZE F,F%F3		; Any queued mail?
	 CALLRET MAIFLG		; Yes, set mailer flags and return
	CTYPE <No errors.>
	RETSKP
SNDNET:	ACVAR <QJFN>		; Queued mail JFN
	STKVAR <<SPTRS,2>>
SNDNT0:	MOVE A,[POINT 7,STRBUF]
	MOVEI B,[ASCIZ "PS:<"]
	CALL MOVSTR		; Set up logged in dir.
	MOVEI B,MYDIRS
	CALL MOVSTR
	MOVEI B,[ASCIZ />[--UNSENT-MAIL--]./]
	TXNE F,F%DECN		; DECnet ?
	MOVEI B,[ASCIZ />[--DECNET-MAIL--]./]
	CALL MOVSTR		; Put in start of filename
	TXZ F,F%AT		; Havent seen an @ yet
	HRRZ B,(U)		; Get this address
	HRLI B,(<POINT 7,0>)
	MOVEI D,"V"-100
	TXNN F,F%DECN		; DECnet mail?
	JRST SNDNT3		; No
SNDNT1:	ILDB C,B		; Get DECnet host name
	JUMPE C,[MOVE B,[POINT 7,MYHNAM,27]
		   JRST SNDNT2]		; Local mail
	CAIE C,"@"		; Net address
	JRST SNDNT1
SNDNT2:	DMOVEM A,SPTRS		; Save pointers
	SKIPN HOSTAB		; Have host table?
	 CALL HSTINI		; No - get one
	MOVEI A,HOSTAB
	TBLUK			; Name lookup
	HRRZ B,(A)		; Get flags
	TXOE B,NT%DON		; Done this host yet?
	JRST SNDNT6		; Yes, don't do it again
	HRRM B,(A)		; Remember we've done it
	DMOVE A,SPTRS
	JRST SNDNT4		; Send message

SNDNT3:	ILDB C,B		; Get char of name
	JUMPE C,[TXOE F,F%AT	; Local?
		    JRST SNDNT6		; No - done with name
		    MOVE B,[POINT 7,MYHNAM,27]
		    MOVEI C,"@"		; add local host name
		    JRST .+1]
	IDPB D,A		; Quote it
	IDPB C,A
	CAIE C,"@"		; At host yet?
	 JRST SNDNT3		; No
SNDNT4:	TXO F,F%AT		; Say @ seen
	CALL MOVST2		; Insert rest of string and null
	MOVSI A,(GJ%NEW!GJ%FOU!GJ%SHT)
	HRROI B,STRBUF
	GTJFN
	 ERJMP [JRETER (Cannot get queue file)
		RET]
	HRLI A,.FBBYV		; Specify 0 retention count
	TXO A,CF%NUD		; Hold update till close
	MOVX B,77B5
	SETZ C,
	CHFDB			; ...
	 JFCL			; Tough darts.
	TLZ A,-1		; JFN only
	MOVE B,[7B5+OF%WR]
	OPENF
	 ERJMP [JRETER (Cannot open queue file)
		RET]
	MOVE QJFN,A		; Remember the JFN
	HRROI B,HDRPAG		; Start of headers
	SETZ C,
	SOUT
	 ERJMP QERROR		; Error writing queue file
	TXNN F,F%AT		; This going out over the net?
	 JRST SNDNT5		; No
	PUSH P,B
	HRROI B,MYHNAM		; Yes, put in "at FOO (My Name)"
	SOUT
	 ERJMP QERROR
	POP P,B
SNDNT5:	SOUT			; And rest of header info
	 ERJMP QERROR
	HRROI B,TXTPAG		; The actual text of the message
	SOUT
	 ERJMP QERROR
	HRROI B,[ASCIZ /   --------
/]				; *** WARNING: Any change to this string
				;     must be accompanied by the appropriate
				;     correction of the computation of the
				;     end of the dead letter around PRSDD1
	SOUT			; Add the dashes
	 ERJMP QERROR
	TXO F,F%F3		; Say have queued mail
	CLOSF			; All there is to it
	 JERROR (Cannot close message file)
SNDNT6:	CAIE U,(W)		; At the end yet?
	 AOJA U,SNDNT0		; No, get next guy
	RETSKP


;Here on any error writing queue file

QERROR:	MOVE A,QJFN		; Get JFN of queued mail
	CLOSF			; Close it
	 JFCL			; Ignore problems
	JRETER (Error writing queued mail)
	RET
; Attempt to deliver local mail right away

SNDLCL:	STKVAR <SPTR>
	MOVE A,[POINT 7,STRBUF]	;Setup pointer for file name
	MOVEI B,[ASCIZ "PS:<"]
	CALL MOVSTR
	MOVEI B,MYDIRS		; Logged in directory
	CALL MOVSTR
	MOVEI B,[ASCIZ ">MAIL.CPY.0;T"]
	CALL MOVST0		; Terminate with null
	MOVX A,GJ%SHT!GJ%FOU	; Create file
	HRROI B,STRBUF
	GTJFN
	 ERJMP [JRETER (MAIL.CPY failure.)
		RET]
	MOVEM A,CPYJFN		; Save jfn for mailer
	MOVX B,44B5+OF%WR
	OPENF			; Open file
	 ERJMP CPYER1
	SETZM USRBLK		; Start with 0
	MOVEI W,1		; Init pointer
	TXZ F,F%LCL		;  flag
	CALL LMOVTO		; Setup To list
	 JRST SNDLC3		;  Saw net address
	CALL LMOVCC		; Setup Cc list
	 JRST SNDLC3		;  Saw net address
	TXO F,F%LCL		; Local mail only flag
	MOVE O,[POINT 7,USRBLK]	; Pointer to put text in
	ADDI O,(W)		; Plus current offset
	MOVEM O,SPTR		; Save it
	TXZ F,F%F1		; No crlf
	CALL MOVOPT		; Move header options
	CALL MOVSUB		; Insert subject
	SKIPLE REPDAT		; Have reply?
	 CALL MOVRDT		; Yes - insert it also
	MOVEI B,CRLF2
	CALL MOVSB2		; A few blank lines
	MOVE A,O		; Need to copy text into buffer
	HRROI B,TXTPAG		; To get proper alignment
	SETZ C,
	SOUT
	 ERJMP CPYERR
	MOVEI B,0		; Pad out last word with nulls
SNDLC1:	TLNN A,(7B2)		; At end of word
	JRST SNDLC2		; DONE
	IDPB B,A
	JRST SNDLC1

SNDLC2:	SETZM 1(A)		; Clear last word
	SUBI A,USRBLK		; Get count of words to write
	MOVNI C,1(A)
	MOVE B,[POINT 36,USRBLK]
	MOVE A,CPYJFN		; Dump it all to the file
	SOUT
	 ERJMP CPYERR
	TXO A,CO%NRJ		; Retain JFN
	CLOSF
	 JFCL
	CALLRET RDYN		; Yes - go send it off

SNDLC3:	MOVE A,CPYJFN		; No - release JFN and return
	TXO A,CZ%ABT		; Abort file
	CLOSF
	 JFCL
	SETZM CPYJFN
	RETSKP


;Here if any problems opening or writing MAIL.CPY

CPYERR:	MOVE A,CPYJFN
	CLOSF
	 JFCL
CPYER1:	MOVE A,CPYJFN
	RLJFN
	 JFCL
	SETZM CPYJFN
	JRETER (MAIL.CPY failure.)
	RET
;setup user name lists for local mail

LMOVTO:	HRRZ E,TOPTRS		; Setup to list
	MOVEI U,TCPAG

LMOV1:	JUMPE E,LMOVTR		; Empty list
LMOV2:	CALL GETUNM		; Get user number in b
	CAMN B,[-1]		; Net address?
	 RET			;  Yes - return now
	CAMN B,[SYSCOD]		; SYSTEM?
	JRST LMOV3
	HRLI B,(5B2)		; Form user number
LMOV3:	MOVEM B,USRBLK(W)	; Store it
	AOS W			; Step to next entry
	CAIE U,(E)		; Done?
	AOJA U,LMOV2		; Do next
LMOVTR:	SETZM USRBLK(W)		; Clear entry
	AOJA W,RSKP		;  and return


;Setup for cc list

LMOVCC:	HLRZ E,TOPTRS		; Cc list pointer
	MOVEI U,TCPAG+400
	JRST LMOV1


; Get user number from table , string pntr c(u)

GETUNM:	PUSH P,A		; Save a
	MOVEI A,NAMTAB		; Table header
	HRRZ B,(U)		; String pointer
	TBLUK			; Lookup entry
	HRRE B,(A)		; Get code or user number
	JRST CPOP1J
; Set the MAILER flags

MAIFLG:	CTYPE <Queued -- Use "Net-mail" command to send immediately.>
	MOVSI A,(GJ%OLD!GJ%SHT)
	HRROI B,[ASCIZ /SYSTEM:MAILER.FLAGS.1/]
	TXNE F,F%DECN		; DECnet? Use different file then
	HRROI B,[ASCIZ /SYSTEM:DECNET-MAILER.FLAGS.1/]
	GTJFN
	 ERJMP [JRETER (Cannot find mailer flags)
		RET]
	PUSH P,A
	MOVEI B,OF%THW!OF%WR!OF%RD
	OPENF
	 JRST [	JRETER (Cannot open mailer flags)
		POP P,A
		RLJFN
		 JFCL
		RET]
	HRLZ A,(P)		; Page 0
	MOVE B,[.FHSLF,,FLGPAG_-9]
	MOVSI C,(PM%RD!PM%WR)
	PMAP
	HRRZ C,MYDIR		; Logged in directory
	IDIVI C,^D36
	MOVSI A,400000
	MOVN D,D
	ROT A,(D)
	IORM A,FLGPAG(C)	; Set my bit
	SETO A,
	SETZ C,
	PMAP
	POP P,A
	CLOSF
	 JFCL
	RETSKP
;Now send IPCF message to MAILER
;Call:	CALL RDYN
;Returns +1: failure
;	 +2: success

RDYN:	SETZB U,PIDGET		; Retry flag
	SKIPE PIDGET+1		; Have PID?
	JRST RDYN1		; Yes - use it
MALER:	MOVSI A,(IP%CPD)	; Create PID
	MOVEM A,PIDGET		; Request this function
	SETZM PIDGET+1		; No sender's PID
RDYN1:	MOVEI B,PIDGET		; Get mailer's PID
	SETZM PIDGET+2		; No receiver's PID
	MOVEI A,4		; The count
	MSEND
	 JRST [	SKIPN U			; First try?
		JWARN <Waiting...>
		AOS U			; Count tries
		MOVEI A,^D500		; Sleep time
		DISMS
		JRST MALER]		; Go try it again
	MOVSI B,(IP%CPD)	; Create PID bit
	ANDCAM B,PIDGET		; Now have a PID
GETAGN:	SETZB T,U		; No flags,no sender
	MOVE V,PIDGET+1		; My temp id
	MOVE W,[10,,WRTPGS]	; Use buffer
	MOVEI B,T		; Where recive will be
	MRECV			; Get it please
	 JFCL			; How can this Happen PMH?
	MOVE U,T		; Save header
	ANDI T,7B32		; Isolate filed
	CAIE T,1B32		; Sent by monitor?
	CAIN T,2B32		; Sent by INFO?
	SKIPA
	JRST GETAGN		; No get it again
	TRNE U,7		; Was the packet undeliverable?
	JRST RDYN1		; Yes. So send it again
	ANDI U,77B29		; Isolate the error field
	JUMPE U,GETAS1		; Got it.
	CAIN U,<.IPCSN>B29	; Did INFO crash and restart?
	JRST GETAGN		; Yes. Wait for some other news then
	ERROR <Could not send to MAILER>

GETAS1:	MOVE V,WRTPGS+1		; Save mailer's PID
	MOVEM V,PIDGET+2	; For later
	SETZM WRTPGS		; To get file name
	MOVE B,CPYJFN
	HRRZS B			; JFN
	HRROI A,WRTPGS+1	; Where name is going
	MOVE C,[1B2!1B5!1B8!1B11!1B14+1]	; Get full name
	JFNS			; Get the name
	SETZ C,
	IDPB C,A		; Tie it off
	MOVEI W,(A)
	MOVE A,CPYJFN		; Release jfn now
	RLJFN
	 JFCL
	SETZM CPYJFN
	SUBI W,WRTPGS		; Size of string
	HRLZS W			; To the left half
	HRRI W,WRTPGS+1		; Where it is
	SETZ T,			; No bits
	MOVE U,PIDGET+1		; Where INFO put it
SENDIT:	MOVEI A,4
	MOVEI B,T		; For mailer
	MSEND			; Send it off
	 JRST [	MOVEI A,^D500		; Sleep for a while
		DISMS
		JRST SENDIT]		; Try again
	CTYPE <Processing mail...>
AGAIN:	MOVEI A,4
	MOVEI B,T		; Set up for mailer's reply
	SETZB T,U
	MOVE V,PIDGET+1		; My PID
	MOVE W,[1000,,WRTPGS+1000]	; Message space
	MRECV			; Get it
	 JFCL			; ?????
	TRNN T,7B32		; From INFO or the monitior?
	JRST OK			; No. Must be from mailer
	MOVE B,T		; The header
	ANDI B,7B32		; See who it is
	CAIE B,2B32		; From INFO?
	CAIN B,3B32		;  or private INFO?
	JRST AGAIN		; Yes. Get another message
	ERROR <MAILER is not running. Messages not sent.>

OK:	CAME U,PIDGET+2		; From mailer?
	JRST AGAIN		; No. Ignore it
	TRNE T,77B29		; ANY errors?
	JRST ERRORS		; Yes. Go analyze them
	CTYPE <No errors.>
	RETSKP

ERRORS:	ANDI T,77B29
	CAIE T,<NACK1>B29	; Total wipeout?
	JRST SOME		; No. Print errors
	CMERR <Processing errors occured. No mail sent.>
	RET			; Give failure return

SOME:	CTYPE <>		; New line
	HLRZS W			; Get count
	IMUL W,[-1,,0]
	HRRI W,WRTPGS+1000	; Buffer
SOME1:	MOVE B,1(W)		; Bad guy
	CAMN B,[SYSCOD]		; Is this system?
	JRST [	HRROI A,[ASCIZ /SYSTEM/]
		PSOUT
		JRST SOME2]
	MOVEI A,.PRIOU
	DIRST			; Print his id
	 JFCL
SOME2:	TYPE < not sent >
	HLRZ B,0(W)		; Get macro code
	CAIN B,NOACKB		; Default error condition?
	JRST [	HRRZ B,0(W)		; Yes. Get monitor code
		JUMPE B,NSTRNG		; If zero, no more information
		HRLI B,.FHSLF
		TYPE <because:>
		CALL CRLF
		MOVEI A,.PRIOU		; Output reason
		SETZ C,
		ERSTR			; Produce monitor error
		 JFCL
		 JFCL
		JRST NSTRNG]		;  and done
	CAIL B,MINMSG		; Have a string for this?
	CAIL B,MAXMSG		; Still?
	JRST NSTRNG		; No. go on
	TYPE <because:>
	HRRO A,MSGTBL-MINMSG(B)	; Yes. get the string
	PSOUT			;  and print it
NSTRNG:	CALL CRLF
	AOBJN W,.+1		; Advance twice
	AOBJN W,SOME1		; Do all baddies
	HRRZ A,TOPTRS		; Get to list pointer
	SUBI A,TCPAG-1		; Computer number of names in list
	HLRZ B,TOPTRS		; Same for cc list
	SKIPE B			; Might be nobody in list
	SUBI B,TCPAG+400-1	;  ..
	ADD A,B			; Compute total recipients
	HRRZ B,W		; Get wasted AOBJN pointer
	SUBI B,WRTPGS+1000	; Compute how far it went
	LSH B,-1		; Two words per baddie
	CAMN A,B		; As many baddies as recipients?
	RET			; Yes, quit now -- total lossage
	SUB A,B			; How many sent OK?
	CAIN A,1		; Only one?
	JRST [	CITYPE <Other user sent OK.>
		RET]			; Singular case -- return
	CITYPE <Other users sent OK.>
	RET			; Return to caller
 
; Run mailer to send off what we queued

.MAILR:	NOISE (queued messages)
	CONFRM
	TXNN F,F%ARPA!F%DECN	; Net?
	CERR (No net mailer)
	HRROI B,[ASCIZ /SYS:NMAILR.EXE/]
	TXNE F,F%DECN		; DECnet?
	HRROI B,[ASCIZ /SYS:DMAILR.EXE/]
	TXO F,F%F3		; Make sure it doesnt run enabled
	CALL RUNFL0
	KFORK			; Dont need it any more
	MOVE A,[SIXBIT /MS/]	; Restore our name
	MOVE B,[SIXBIT /MS/]
	SETSN			;  ..
	 JFCL
	RET

RUNFIL:	TXZ F,F%F3		; Default run enabled
RUNFL0:	MOVSI A,(GJ%OLD!GJ%SHT)
	GTJFN
	 JERROR (Couldnt find file to run)
	PUSH P,A		; Save the jfn
	TXZE F,F%F3		; Wants to run enabled?
	 TDZA A,A		; No
	 MOVSI A,(CR%CAP)	; Yes, give it our caps
	CFORK
	 JERROR (Couldnt create fork)
	EXCH A,(P)		; Get back jfn
	HRL A,(P)
	GET
	POP P,A			; Get back fork handle
RUNFL2:	SETZ B,
	SFRKV			; At regular startup point
	WFORK
	RET

.PUSH:	NOISE (command level)
	CONFRM
	SKIPLE A,EXECFK
	 JRST RUNFL2		; Already have one, just run it
	HRROI B,[ASCIZ /SYSTEM:EXEC.EXE/]
	CALL RUNFIL		; Else make a fork and run it
	MOVEM A,EXECFK		; And keep the fork handle
	RET
; Erase fields

ERSAL1:	SETZM HDRPAG+700	; Reset subject
	SETZM TOPTRS		; Reset to and cc pointers
	SETZM REPDAT		; No reply date
	MOVE A,[POINT 7,NAMTXT]
	MOVEM A,FRENAM		; Reset free string pointers
	MOVEI A,777		; Reset name table
	MOVEM A,NAMTAB
	RET

.ERSAL:	CALL ERSAL1
.ERSTX:	MOVE A,[POINT 7,TXTPAG]
	MOVEM A,TXTPTR		; Reset pointer to text space
	SETZM TXTPAG		; And make sure it starts with null
	MOVEI A,TXTSIZ-1	; Init buffer size
	MOVEM A,TXTCNT
	RET

.ERSDT:	SETZM REPDAT		; no reply date
	RET

.ERSSB:	SETZM HDRPAG+700
	RET

.ERSCC:	HLRZ T,TOPTRS		; get end of cc list
	JUMPE T,R		; if list empty, quit now
	MOVEI V,TCPAG+400	; and start
.ERSC2:	CALL NAMDEL		; delete this name
	CAME T,V		; done yet?
	SOJA T,.ERSC2		; no, keep going
	HRRZS A,TOPTRS		; yes, erase cc pointer
.ERSC3:	JUMPN A,R		; if names left in to list, done
	MOVE A,[POINT 7,NAMTXT]	; no names left in either list
	MOVEM A,FRENAM		; Reset free pointer
	MOVEI A,777		; Reset name table
	MOVEM A,NAMTAB
	RET

.ERSTO:	HRRZ T,TOPTRS		; end of to list
	JUMPE T,R		; if list empty, quit now
	MOVEI V,TCPAG		; and start
.ERST2:	CALL NAMDEL		; delete this name
	CAME T,V		; done?
	SOJA T,.ERST2		; no, keep going
	HLLZS A,TOPTRS		; yes, reset to pointer
	JRST .ERSC3		; clean up and return

.DSALL:	MOVE A,[PBOUT]		; Set up to type it out to tty
	TXO F,F%LCL		; Treat local names w/o net addrs
	CALL MOVTO0
	CALL MOVCC1
	TXO F,F%F1		; want crlf before
	CALL MOVSB1
	SKIPG REPDAT		; Have reply date?
	JRST MOVTX1
	MOVEI O,.PRIOU		; Primary output for odtim
	CALL MOVRDT
	JRST MOVTX1		; Then message text

.DSSUB:	TXO F,F%F1		; Want crlf before
	SKIPA B,[MOVSB0]
.DSTXT:	 MOVEI B,MOVTX0
	JRST .DSCC1

.DSTO:	SKIPA B,[MOVTO0]
.DSCC:	 MOVEI B,MOVCC0
	TXO F,F%LCL		; Treat local names w/o net addrs
.DSCC1:	MOVE A,[PBOUT]
	JRST (B)
MOVSUB:	MOVE A,[IDPB A,O]
MOVSB0:	MOVEM A,MOVDSP		; Set up to move into memory
MOVSB1:	LDB A,[POINT 7,HDRPAG+700,6]
	JUMPE A,R		; no subject
	MOVEI B,[ASCII /
/]
	TXZE F,F%F1		; Want crlf
	CALL MOVSB2		; Yes
	MOVEI B,[ASCIZ /Subject: /]
	CALL MOVSB2		; Print header part
	MOVEI B,HDRPAG+700	; Start of actual string
	CALL MOVSB2
	MOVEI B,CRLF0
MOVSB2:	HRLI B,(<POINT 7,0>)
MOVSB3:	ILDB A,B		; Get char
	JUMPE A,R		; Done
	XCT MOVDSP		; Handle it
	JRST MOVSB3

MOVTX0:	MOVEM A,MOVDSP		; Set up to move into memory
MOVTX1:	MOVEI B,CRLF2
	CALL MOVSB2
	MOVEI B,TXTPAG
	CALL MOVSB2
	MOVEI B,CRLF0
	CAIE A,12		; Unless ended with CRLF
	 CALL MOVSB2		; Put one in
	RET			; Return

MOVCC:	MOVE A,[IDPB A,O]
MOVCC0:	MOVEM A,MOVDSP		; Set up to move into memory
MOVCC1:	MOVEI T,[ASCIZ /
cc: /]
	HLRZ C,TOPTRS		; Head of list
	MOVEI E,TCPAG+400
	JRST MOVTO2
MOVTO:	MOVE A,[IDPB A,O]
MOVTO0:	MOVEM A,MOVDSP
	MOVEI T,[ASCIZ /
To: /]
	HRRZ C,TOPTRS
	MOVEI E,TCPAG
MOVTO2:	JUMPE C,R		; None here, forget it
	SKIPA B,T		; header supplied
MOVTO3:	MOVEI B,[ASCIZ /
    /]				; List continuation
	CALL MOVSB2		; Print header
	MOVEI X,4		; Init horizontal position
MOVTO4:	HRRZ B,(E)		; Get name
	HRLI B,(<POINT 7, 0>)
	TXZ F,F%AT		; Init flag
MOVTO5:	ILDB A,B
	JUMPE A,MOVTO6
	CAIN A,"@"
	 JRST MOVTO7
	XCT MOVDSP
	AOJA X,MOVTO5
MOVTO6:	TXNN F,F%AT		; node address seen?
	JRST MOVTO8
MOVT6A:	CAIN E,(C)		; At the end yet?
	 RET			; Yes
	MOVEI A,","
	XCT MOVDSP
	CAIL X,^D65		; near end?
	 AOJA E,MOVTO3		; Yes, get new line for more then
	MOVEI A," "
	XCT MOVDSP
	ADDI X,2
	AOJA E,MOVTO4

MOVTO8:	TXNE F,F%LCL		; Net mail?
	JRST MOVT6A		; No - done with name
	MOVE B,[POINT 7,MYHNAM,27]; Yes - add local host name
MOVTO7:	PUSH P,B
	MOVEI B,[ASCIZ / at /]
	CALL MOVSB2
	ADDI X,4		; Count 4 chars for this
	POP P,B
	TXO F,F%AT
	JRST MOVTO5
MOVRDT:	MOVEI B,[ASCIZ /In-reply-to: Your message of /]
	CALL MOVSB2
	MOVE A,O
	MOVE B,REPDAT
	MOVSI C,(OT%NSC!OT%NCO!OT%TMZ!OT%SCL)
	ODTIM
	MOVE O,A
	MOVEI B,CRLF0
	CALLRET MOVSB2		; Leave null at end


;Move header options

MOVOPT:	SKIPN OPTTXT		; Any header options?
	RET			; No, just quit
	MOVE A,[IDPB A,O]
	MOVEM A,MOVDSP
	MOVEI B,[ASCIZ /
/]				; CRLF
	TXZE F,F%F1		; If needed
	CALL MOVSB2
	MOVEI B,OPTTXT
	SETZM OPTTXT+777	; Prevent cruft from causing runaway move
	CALLRET MOVSB2		; Move 'em out
; Get some more text

.TEXT:	CONFRM			; Confirm command
	CALL GETTXT		; Resume text
	MOVE A,LSTCHR		; See if want to send
	CAIN A,32		;  by ^Z term.
	JRST SSEND0
	RET			; Nope

GETTXT:	HRRZ A,TXTCNT		; See if first time here.
	CAIE A,TXTSIZ-1
	CITYPE <Continuing...>
	CITYPE (<Message (ESC to enter MS Send level, ctrl-Z to send, ctrl-K to redisplay,
	 ctrl-B to insert file, ctrl-E to enter editor):>)
	CALL CRLF		; Blank line
	CALL CRLF
.TEXT1:	MOVEI A,TTXTIB
	TEXTI
	 JERROR (TEXTI failed)
	LDB B,TXTPTR
	MOVEM B,LSTCHR		; Save terminator
	SETZ A,
	DPB A,TXTPTR		; Replace terminator with null
	MOVSI A,(7B5)
	ADDM A,TXTPTR
	AOS TXTCNT
	CAIN B,"E"-100		; ^E - enter editor on text
	 JRST .EDTXT
	CAIN B,"K"-100		; Wants retype of whole thing?
	 JRST RETYPE
	CAIE B,"B"-100		; Wants to insert a file?
	 RET			; No, must have terminated right
CBAGN:	PROMPT (<(Insert file: >)
	CALL FSPEC		; Get file spec
	 JRST .TEXT1		; Just CR - ignore this request
	CALL RDTXT		; Read in text
	 JRST CBAGN		; Error - try again
	TYPE <...EOF)>
	JRST .TEXT1		; Continue getting text
;Get a filespec, confirm and return JFN in A

FSPEC:	MOVEI A,[FLDDB. (.CMCFM,CM%SDH,,<Input filespec>,,[FLDDB. (.CMIFI,CM%SDH)])]
	CALL RFIELD		; Get filespec or CR
	LDB A,[POINTR (<0(C)>,CM%FNC)]	; See which
	CAIN A,.CMCFM		; Just CR?
	 RET			; Yes - return
	PUSH P,B		; Save JFN
	CONFRM			; Confirm
	POP P,A			; Restore JFN to a
	RETSKP			; Skip return


;Insert file into text buffer - JFN in a

RDTXT:	MOVX B,7B5+OF%RD	; Open file for read
	OPENF
	 JRST [	RLJFN		; Flush JFN
		 JFCL
		UERR 17,	; Report error
		RET]		;  and return
	MOVE C,TXTCNT		; - Count left in buffer
	MOVE B,TXTPTR		; Where to put text
RDTXT2:	SETZ D,			; Stop on nulls
	SIN			; Read file
	 ERJMP [MOVE D,B		; Save pointer
		GTSTS			; See if real EOF
		EXCH B,D		; Restore pntr to b
		TXNE D,GS%EOF
		JRST RDTXT1		; Eof - ok to proceed
		CLOSF			; Close and release JFN
		 JFCL
		CMERR <Read error>	; Report lossage
		RET]			; Give bad return
	SKIPG C			; Exhausted count yet?
	JRST RDTXTV		; Yes, report overflow
	SETO D,			; Back up over the null
	ADJBP D,B		;  ..
	MOVE B,D		;  ..
	JRST RDTXT2		; Go eat more

RDTXT1:	CLOSF			; close file
	 JFCL
	SKIPG C			; Have all of file?
	JRST RDTXTV		; No, report overflow
	MOVEM B,TXTPTR		; Update pointer and
	MOVEM C,TXTCNT		; Character count
	RETSKP			; Give good return

RDTXTV:	CMERR <File too large to insert>
	RET			; Give failure return
;Retype buffer so far...

RETYPE:	CALL CRIF		; Yes
	CALL CRLF
	SKIPLE REPDAT		; Have reply?
	JRST [	MOVE A,[PBOUT]
		MOVEM A,MOVDSP	; Setup up this here
		MOVEI O,.PRIOU	; For odtim
		CALL MOVRDT
		CALL CRLF		; xtra crlf
		JRST .+1]
	HRROI A,TXTPAG		; Start of stuff
	PSOUT
	JRST .TEXT1		; And go get some more
; Get a new subject

.SUBJE:	CONFRM			; Confirm command
GETSUB:	PROMPT (Subject: )
	MOVEI A,[FLDDB. (.CMCFM,CM%SDH,,<
Type a single line terminated with a <CR> which summarizes
the message you are sending.
>,,[FLDDB. (.CMTXT,CM%SDH)])]
	CALL RFIELD		; Read subject line or crlf
	LDB A,[POINTR (<0(C)>,CM%FNC)]	; See what typed
	CAIN A,.CMCFM		; Just CR?
	 JRST .ERSSB		;  No subject
	HRROI A,HDRPAG+700	; Move subject to header page
	HRROI B,ATMBUF
	MOVEI C,0
	SOUT
	CONFRM			; Grntee CR
	RET
.CC:	CONFRM			; Confirm command
GETCC:	PROMPT (cc: )
	TXO F,F%CC		; Say in cc command
	HLRZ W,TOPTRS		; Pointer to cc links
	JUMPN W,.TO2
	 MOVEI W,TCPAG+400-1	; Init for start
	JRST .TO2		; And enter to command

.TO:	CONFRM			; Confirm command
GETTO:	PROMPT (To: )
	TXZ F,F%CC
	HRRZ W,TOPTRS
	JUMPN W,.TO2
	 MOVEI W,TCPAG-1
.TO2:	MOVE U,FRENAM		; Get free space pointer
	TXZ F,F%CMA!F%F3	; Dont allow funny local names
	MOVEI A,777
	MOVEM A,NAMTTB		; Init temp name table
.TO3:	CALL GETUSR		; Get the user entry in (b)
	 RET			; Null field, return
	MOVEI A,NAMTTB		; Add to table
	TBADD
	 ERJMP [CALL MGETER		; Check for fullness
		CAIE A,TADDX2		; ??
		ERROR <Name table full>
		JRST .TO4]		; Must be duplicate - ignore
	MOVEM U,FRENAM		; Update free pointer
.TO4:	TXNE F,F%CMA		; More wanted
	 JRST .TO3		; Yes - get some
	HLLZ E,NAMTTB		; Get n,,0
	MOVNS E			; Make -n,,0
	HRRI E,1		; Setup AOBJN pntr
.TO5:	MOVE B,NAMTTB(E)	; Get entry
	MOVEI A,NAMTAB		; Point to name table
	TBADD			; Attempt to add
	 ERJMP .TO7		; Maybe there already
	AOS W			; Advance pointer to next slot
	HLRZM B,(W)		; Save pointer to this entry
.TO6:	AOBJN E,.TO5		; Loop over all entries
	TXNN F,F%CC		; In the cc field?
	 JRST [	CAIE W,TCPAG-1		; Check null to list
		HRRM W,TOPTRS
		RET]
	CAIE W,TCPAG+400-1	; Check null cc list
	HRLM W,TOPTRS
	RET

.TO7:	CALL MGETER		; Get last error code in (a)
	CAIE A,TADDX2		; Duplicate entry?
	ERROR <Name table full>
	HLRZS B			; point to string
	CIETYP <%% Duplicate name purged - %2S
>
	JRST .TO6

; Get prompted message

GETMSG:	CALL GETTO
	CALL GETCC
	CALL GETSUB
	JRST GETTXT
; Remove user

.UNTO:	NOISE (user)
	TXO F,F%F3		; Allow funny addresses
.UNTO1:	MOVEI U,STRBUF		; Place to put name string
	CALL GETUSR
	 RET			; Null address, just return
	MOVEI U,STRBUF		; Start of buffer
	CALL DOUNTO		; Remove the name
	TXNE F,F%CMA		; More to come?
	 JRST .UNTO1		; Yep
	RET

DOUNTO:	HRRZ V,TOPTRS		; Get to pointers
	MOVEI T,TCPAG
	TXZ F,F%CC		; Say not in cc
	CALL DOUNC1
	HLRZ V,TOPTRS		; Get cc pointers
	MOVEI T,TCPAG+400
	TXO F,F%CC		; Say in cc
DOUNC1:	JUMPE V,R		; None of this class
DOUNT0:	HRRZ A,(T)		; Get this one
	HRLI A,(<POINT 7,0>)
	MOVEI B,(U)		; Try to match this
	HRLI B,(<POINT 7,0>)
DOUNT1:	ILDB C,B		; Get char from target
	JUMPE C,DOUNT3		; Null means it matches
	CAIN C,"@"		; Starting host name?
	 TXNE F,F%AT		; Trying to match @ too?
	 CAIA			; No or yes
	 JRST DOUNT3		; Yes and no, matches
	ILDB D,A
	CAIN D,(C)
	 JRST DOUNT1		; Chars match?
	TRC D,(C)
	CAIN D,40		; Case only?
	 JRST DOUNT1		; Yes, keep looking
	CAIN T,(V)		; Done with this list?
	 RET			; Yes, return
	AOJA T,DOUNT0

DOUNT3:	CALL NAMDEL		; delete this name
	CAIN T,(V)		; At the end of the list?
	 JRST DOUNT4		; Yes, no need to move anything
	MOVEI A,(T)
	HRLI A,1(T)		; Move up one word
	BLT A,-1(V)
DOUNT4:	CAIE V,TCPAG+400	; At start of cc
	 CAIN V,TCPAG		; Was that the final entry?
	 TDZA V,V		; Yes, erase cc field then
	 SOJ V,			; Else one less entry in list
	TXNE F,F%CC		; In cc field?
	 HRLM V,TOPTRS		; Yes update cc pointer
	TXNN F,F%CC
	 HRRM V,TOPTRS		; Else update to pointers
	CAIE T,1(V)		; Was that the last in the list?
	 JUMPN V,DOUNT0	; Or the end of the list?
	RET			; Yes, return


NAMDEL:	MOVEI A,NAMTAB		; Remove entry form name table
	HRRO B,(T)		; Actual string
	TBLUK			; Find in table
	MOVE B,A
	MOVEI A,NAMTAB
	HLRZ D,NAMTAB		; Don't try if table empty
	SKIPE D			;  ..
	TBDEL			; Delete from table (can't fail?)
	RET
; Get User@site string, U/ addr where to stick string

GETUSR:	TRVAR <SAVUSR,HPNT,STPNT>
	MOVX A,CM%XIF		; Clear @ allowed flag in case of error
	ANDCAM A,SBK+.CMFLG
	MOVEI A,[FLDDB. .CMCFM,,,,,[FLDDB. .CMUSR,CM%SDH,,<

Type user names separated by commas. The list is terminated
by a <CR>. The entire list may be read from a file by typing:

	@FILESPEC

Typing a "?" gives this message.
>,,[FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /./]>,,,[FLDDB. .CMKEY,CM%SDH,[
		1,,1
		CMD SYSTEM,0]]]]]
	TXZE F,F%CMA
	MOVE A,(A)		; Comma previous, disallow CR
	CALL RFLDE		; Get name
	 JRST GTCNET		; Check for net address
	LDB A,[POINTR (<0(C)>,CM%FNC)]
	CAIN A,.CMCFM		; Just CR?
	 RET			; Yes - return
	CAIN A,.CMTOK		; "." self?
	JRST [	MOVE B,MYDIR		; Yes, supply my directory number
		MOVEM B,SAVUSR		;  ..
		HRRO A,U		;  and supply a string that works
		DIRST
		 JSHLT
		JRST GETUS1]		; finish up
	CAIN A,.CMKEY		; Special user
	MOVE B,[SYSCOD]		; Yes - supply value
	MOVE A,SBK+.CMPTR	; Get next character
	ILDB A,A		;  and check for @
	MOVEM B,SAVUSR		; Save user #
	CAIN A,"@"		; net address (wrong user)
	JRST GTNETU		; Get net addr
	CAIN A," "		; Possible beginning of " at nodename"?
	JRST GTNETA		; Yes, go handle
	HRROI B,ATMBUF		; Regular user, stuff name into string space
	HRRO A,U		;  ..
	SETZ C,
	SOUT
	; ..
	; ..

GETUS0:	CAME B,[SYSCOD]		; Special hack?
	JRST GETUS1		; No
	HRROI B,[ASCIZ "SYSTEM"]
	HRRO A,U		; Supply canned name
	SETZ C,
	SOUT

GETUS1:	HRLM U,SAVUSR		; Remember where string is.
	IBP A			; Step over null
	MOVEI U,1(A)		; Point to new free loc.
	MOVEI A,[FLDDB. (.CMCFM,,,,,[FLDDB. .CMCMA])]
	CALL RFIELD		; Get CR or comma
	LDB A,[POINTR (<0(C)>,CM%FNC)]
	MOVE B,SAVUSR		; Return entry
	CAIE A,.CMCFM		; EOL?
	TXO F,F%CMA		; No - set comma seen
	RETSKP			; Return
NOHOST:	MOVX A,CM%XIF		; Clear @ allowed flag on error
	ANDCAM A,SBK+.CMFLG
	CMERR (No such host name.)
	JRST CMDER1

NONET:	CMERR (Net addresses not allowed on this system.)
	JRST CMDER1

GTCNET:	CAIN B,NPXNOM		; Release 3 gives this error code
	SKIPA			;  if bad username given
	CAIN B,NPXNMD		; Nonexistent user or directory?
	TXNN F,F%ARPA!F%DECN	; Have a net?
	JRST [	JRETER (Cannot parse destination)
		JRST CMDER1]
	MOVE A,SBK+.CMPTR	; Get next char
	ILDB A,A		;  ..
	CAIE A," "		; Leading space?
	JRST GTCNT3		; No, don't try to skip them then
	MOVEI A,[FLDDB. (.CMUQS,,SKPSPC)]
	CALL RFIELD		; Crock to skip leading spaces
GTCNT3:	MOVE A,SBK+.CMPTR	; Save pointer to string beg
	MOVEM A,STPNT
	MOVEI A,[FLDDB. (.CMUQS,,HSTBRK)]
	CALL RFIELD		; Get string to @, CR, or comma
	MOVE A,SBK+.CMPTR	; Look at break char
	ILDB A,A
	CAIN A,"@"		; Net addrs delim?
	JRST GTCNT2		; Yes, handle it
	CAIE A," "		; Possible start of " at node"?
	JRST [	CMERR (Invalid user name)
		JRST CMDER1]
	CALL GTNTAT		; Parse " at "
	 JRST [	CMERR (Invalid user name)
		JRST CMDER1]

GTCNT2:	HRRZ A,U		; Pointer to string space
	HRLI A,(POINT 7,,)

GTCNT1:	ILDB C,STPNT		; Copy string to string space
	CAIN C,"@"		; terminate on @
	JRST GTNTU1		; Now get host name
	CAIN C," "		; End of user name,
	JRST [	MOVEM A,HPNT		; Save string pointer
		JRST GTNTU2]		;  and go parse node name
	IDPB C,A		; Store in name string
	JRST GTCNT1
;parse host string , user@ already seen

GTNETU:	TXNN F,F%ARPA!F%DECN	; Have a net?
	JRST NONET
	HRROI B,ATMBUF		; Get user name from buffer
	HRRO A,U		; Into string space
	SETZ C,
	SOUT
GTNTU1:	MOVEM A,HPNT		; Save pntr
	MOVX A,CM%XIF		; Allow @ in string
	IORM A,SBK+.CMFLG
	MOVEI A,[FLDDB. (.CMTOK,,<-1,,[ASCIZ "@"]>)]
	CALL RFIELD		; Parse @
GTNTU2:	MOVEI A,"@"		; Stash @ in string
	IDPB A,HPNT
	SKIPN HOSTAB		; Have host table?
	 CALL HSTINI		; No - get one now
	MOVEI A,[FLDDB1 (.CMKEY,,HOSTAB,<-1,,HSTHLP>)]
	CALL RFLDE		; Get host name
	 JRST NOHOST
	MOVE A,(B)		; Get flags for this host
	TXNE A,NT%LCL		; Local host?
	JRST [	SETZ A,			; Yes, zap the at-sign
		DPB A,HPNT
		MOVNI A,1		; Back up over at-sign
		ADJBP A,HPNT		; ..
		MOVEM A,HPNT		; ..
		MOVX A,RC%EMO		; Insure that this user exists
		HRRO B,U		; Point to username in string space
		SETZ C,
		RCUSR
		TXNE A,RC%NOM		; Any match found?
		JRST [	CMERR (Invalid user name)
			JRST CMDER1]
		MOVEM C,SAVUSR		; stash user number and finish up
		MOVE A,HPNT		; Return with A pointing at address
		JRST GETUS0]		;  ..
	MOVX A,CM%XIF		; Disallow @
	ANDCAM A,SBK+.CMFLG
	HLRO B,(B)		; Host name string
	MOVE A,HPNT		; Append to user name
	SETZ C,
	SOUT
	SETOM SAVUSR		; Flag net address
	JRST GETUS1		; Join common code
;Parse host string, user <space> already seen

GTNETA:	TXNN F,F%ARPA!F%DECN	; Have a net?
	JRST NONET		; No, complain
	HRROI B,ATMBUF		; Get username from atom buffer
	HRRO A,U		; Into string space
	SETZ C,
	SOUT
	MOVEM A,HPNT		; Save pointer
	CALL GTNTAT		; Parse " at "
	 JRST [	MOVE A,HPNT		; No node separator, assume local name
		JRST GETUS0]
	JRST GTNTU2		; Eat the space and chug along


;Parse " at ".  Returns +1 if not found, +2 if found

GTNTAT:	MOVEI A,[FLDDB. .CMKEY,CM%SDH,[	1,,1
		CMD AT,0],<

"at" followed by space and a node name to specify a user on
 a remote node, or comma or carriage return to terminate this name.
>]
	CALL RFLDE		; Parse the separator
	 RET			; Not found, fail
	MOVE A,SBK+.CMPTR	; Get next character
	ILDB A,A		;  ..
	CAIE A," "		; better be space
	JRST [	CMERR (Cannot parse destination)
		JRST CMDER1]
	RETSKP			; Return
 SUBTTL Editor interfacing subroutines

; Here to start up a new editor

GETED:	HRROI A,[0]		; Clear Rescan buffer
	RSCAN			;  EMACS occasionally blows it
	 JFCL
	MOVSI A,(CR%CAP!CR%ACS)
	MOVEI B,FRKACS		; Set these initial ac's
	CFORK
	 JERROR (Cannot create editor fork)
	MOVEM A,EDFORK		; Save it
	MOVSI A,(GJ%OLD!GJ%SHT)
	HRROI B,[ASCIZ /SYS:EMACS.EXE/]
	GTJFN
	 JERROR (Cannot get editor)
	HRL A,EDFORK
	GET			; Get in the editor
	MOVE A,EDFORK
	SKIPN FRKACS+1		; If not passing a jfn,
	 TDZA B,B		; Start at normal entry
	 MOVEI B,2		; Else at CCL entry
	SFRKV
	JRST WAITE1

; Here to restart fork

RESTED:	MOVEI D,EDMOD		; Restore editor tty modes
	CALL SETTYM
RESTE0:	MOVE A,EDFORK
	MOVE B,EFRKPC		; Forks old PC
	SFORK
	RFORK			; Thaw it
WAITE1:	WFORK			; And wait for it to terminate
	; ..
	; ..

; Here when fork terminates

	FFORK			; Freeze it
	RFSTS			; Get its status
	TXZ A,RF%FRZ		; We know it's frozen already
	HLRZ A,A
	TXZ F,F%ESND		; Clear flag
	CAIE A,.RFHLT		; Voluntary termination?
	 JRST KILLED		; No, kill it off, it's bombed
	MOVEM B,EFRKPC		; Save the PC for restarting it
	MOVE A,EDFORK		; Need fork again
	RWM			; See why it stopped
	TLNE B,(1B1)		; Level 1 in progress?
	 JRST CTLCED		; Yes, means the guy ^C'd out
	MOVE A,EDFORK
	MOVEI B,FRKACS		; Get its AC's
	RFACS
	MOVE A,FRKACS+2	; Pointer to buffer block
	IDIVI A,1000		; Get page number of block
	MOVEI T,(B)		; Save position in page
	HRL A,EDFORK
	MOVE B,[.FHSLF,,EDBPAG_-9]	; Into our area
	MOVX C,PM%RD!PM%WR	; Read write
	PMAP
	MOVE A,EDBPAG(T)	; Char address of beginning of buffer
	IDIVI A,5000		; Get page number
	HRL A,EDFORK
	MOVE B,[.FHSLF,,EDPAGE_-9]
	MOVE C,[PM%CNT+PM%RD+PM%WR+10]
	PMAP			; Map those pages too, read/write
	LSH A,9		; Get word address
	HRREI A,-EDPAGE(A)
	MOVEM A,EDPAG0		; Save address of first page mapped
	; ..
	; ..

	MOVE A,EDBPAG+4(T)	; End of the buffer
	CAMN A,EDBPAG+0(T)	; Same as beginning?
	 RET			; Yes, forget empty buffer
	SUBI A,2		; Back up two chars
	CAMGE A,EDBPAG+0(T)	; But not past beginning
	 RET
	CALL EDCHRP		; Get byte pointer to it
	ILDB B,A		; Get character
	CAIE B,37		; ^_ part of a request?
	 RET			; Nope
	ILDB B,A		; Get next char
	CAIE B,"I"		; Request for insert of message?
	 CAIN B,"S"		; Or for sending of buffer?
	 CAIA			; Yes
	 RET			; No, forget it
	MOVNI A,2		; Back up buffer over those chars
	ADDB A,EDBPAG+4(T)	; Back up virtual pointer
	CAMG A,EDBPAG+5(T)	; And if real end at same place
	 JRST EDTRM2
	MOVEM A,EDBPAG+5(T)	; Move it back too
	MOVEI A,2		; And increase gap size
	ADDM A,EDBPAG+6(T)
EDTRM2:	CAIE B,"I"		; Was it an insert request?
	 JRST EDSEND		; No, go send the buffer off
	MOVE V,MSGBOD(M)	; Start of current message
	CALL CHR2BP		; Get byte pointer in 1
	MOVE B,MSGBON(M)	; Length of it
	JRST EDINS		; Go insert that string and resume

EDSEND:	MOVEI C,32		; Say terminated with ^Z
	MOVEM C,LSTCHR
	TXO F,F%ESND		; Say to send buffer
	RET			; And return to caller
; Convert char address to byte pointer, taking gap into account

EDCHRP:	CAML A,EDBPAG+3(T)
	 ADD A,EDBPAG+6(T)
EDCHR1:	IDIVI A,5
	SUB A,EDPAG0		; Make absolute
	HRL A,BPS(B)
	RET


; Request editor to insert c(b) chars at PT

EDINSC:	MOVEM B,EDBPAG+8(T)	; Set up as SUPARG
	MOVE A,EDFORK
	HRRZ B,EDBPAG+7(T)	; Where to start it
	SFORK			; Start it
	RFORK			; Thaw it
	WFORK			; Wait for it
	FFORK			; Refreeze it
	RET


; Insert a string into its buffer

EDINS:	TRVAR<OLDCNT,NEWCNT,EDTPNT> ; *** must match TRVAR at TVORED and EDREPL
	MOVEM B,OLDCNT		; Save old count
	MOVEM A,EDTPNT		; Save text pntr
	MOVE D,B		; Copy count to d
	SETZ B,			; Adjust char count (strip nulls)
EDINS1:	ILDB C,A		; Get char
	SKIPE C			; Skip if null
	AOS B			;  else count it
	SOJG D,EDINS1		; Loop over string
	MOVEM B,NEWCNT		; Save count less nulls
EDINS2:	CALL EDINSC		; Request it to insert
	MOVE A,EDBPAG+2(T)	; Address of current position
	SUB A,NEWCNT		; Back over the chars to be inserted
	CALL EDCHR1		; Get byte pointer
	MOVE C,OLDCNT		; Get back count
	MOVE B,EDTPNT		; Get back byte pointer
EDINS3:	ILDB D,B
	JUMPE D,EDINS4		; Skip nulls
	IDPB D,A
EDINS4:	SOJG C,EDINS3		; For all requested
	JRST RESTE0		; And resume editor
; Replace the editor's buffer with a given string

EDREPL:	TRVAR <OLDCNT,NEWCNT,EDTPNT> ; *** Must match TRVAR at EDINS and TVORED
	MOVEM A,EDTPNT		; Save pntr
	MOVEM B,OLDCNT		;  and count
	MOVEM B,NEWCNT
	SKIPG EDFORK		; If dont have a fork yet,
	 JRST [	CALL EDTMP		; Write to temp file
		MOVEM A,FRKACS+1	; Pass JFN of file to EMACS
		JRST GETED]		; Get and start EMACS
	MOVEI D,EDMOD		; Restore editor tty modes
	CALL SETTYM
	MOVE A,FRKACS+2		; Pointer to buffer block
	IDIVI A,1000		; Get page number of block
	MOVEI T,(B)		; Get position in page
	MOVE B,EDBPAG+5(T)	; Save addr of end of buffer
	MOVSI A,EDBPAG+0(T)	; Start with beginning addr
	HRRI A,EDBPAG+1(T)	; Into virtual beg
	BLT A,EDBPAG+5(T)	; Up to end pointer
	SUB B,EDBPAG+5(T)	; See how many chars we "deleted"
	ADDM B,EDBPAG+6(T)	; Increase the gap that many
	SETZM EDBPAG+9(T)	; Not modified yet
	MOVE B,OLDCNT		; Restore count
	JRST EDINS2		; And go insert the new string


; Do it thru a temp file

EDTMP:	MOVSI A,(GJ%SHT!GJ%FOU)
	HRROI B,[ASCIZ /MSG.TMP;T/]
	GTJFN
	 JERROR (Cannot get TMP file)
	MOVE B,[7B5+OF%WR]
	OPENF
	 JERROR (Cannot open TMP file)
	MOVN C,OLDCNT		; Get -char cnt
	MOVE B,EDTPNT		;  and pointer
	SOUT			; Write it out
	TLO A,(CO%NRJ)		; Keep the jfn
	CLOSF
	 JFCL
	RET
				; Editor command
.EDITO:	CONFRM			; Confirm first
	SKIPN EDITOR		; Know what editor we're using yet?
	CALL EDITQ		; No, find out
	SKIPL EDITOR		; EMACS?
	CWARN (The EDITOR command is useful only if you are using EMACS as your editor.)
	SKIPLE EDFORK		; Do we have one already?
	 JRST .EDTO3		; Yes, just resume it then
	CALL CRIF		; Let him know we are at work
	SETZM FRKACS+1		; No, make one, without a file
	CALL GETED
.EDTO1:	TXNE F,F%ESND		; Want to send buffer?
	CALL .EDTX1		; Yes - get it then
.EDTO2:	MOVEI D,EDMOD		; Save editor modes
	CALL GETTYM
	MOVEI D,SAVMOD		; And restore ours
	JRST SETTYM

.EDTO3:	CALL RESTED		; Restart editor
	JRST .EDTO1

				; Editor terminated badly
KILLED:	MOVE A,EDFORK
	KFORK			; Kill it off
	SETOM EDFORK		; And forget about it
	MOVEI D,SAVMOD		; Restore program's modes
	CALL SETTYM
	ERROR ( Editor fork terminated involuntarily.)


; ^C typed from editor, make it percolate up

CTLCED:	CALL CKEXIT
	JRST RESTE0		; And resume it afterwards
; Edit fields

.EDTXT:	CALL CRIF		; ACK
	SKIPN EDITOR		; Know which editor to use yet?
	CALL EDITQ		; No, figure it out
	SKIPL EDITOR		; EMACS?
	JRST TVORED		; No, TV or EDIT or something...
	LDB A,[POINT 6,TXTPTR,5]
	IDIVI A,7		; Get chars within word
	HRRZ B,TXTPTR
	MOVEI B,1-TXTPAG(B)	; Get number of words
	IMULI B,5		; Into chars
	SUBI B,(A)		; Get total number of chars
	MOVE A,[POINT 7,TXTPAG]	; Where it starts
	CALL EDREPL		; Run editor over this field
	CALL .EDTX1		; Snarf text
	JRST .EDTO2		; Switch tty modes and return


; Get text from EMACS and update pntr and cnt

.EDTX1:	CALL GEDTXT		; Get the editted text
	MOVEI D,TXTSIZ-1	; Compute remaining char cnt
	SUB D,C		; Must leave c intact
	MOVEM D,TXTCNT		; Store count
	MOVE B,[POINT 7,TXTPAG]	; Replace string here
	CALL FRMSS1		; Move string
	MOVEM B,TXTPTR		; Update pointer
	SETZ D,
	IDPB D,B		; And end with a null too
	RET


; Get the editted field

GEDTXT:	PUSH P,EDBPAG+4(T)
	POP P,EDBPAG+2(T)	; ZJ
	SETZ B,
	CALL EDINSC		; Move gap to end
	MOVE C,EDBPAG+4(T)
	SUB C,EDBPAG+1(T)	; Number of chars in it
	MOVE A,EDBPAG+1(T)	; Start of virtual buffer
	JRST EDCHRP		; Get byte pointer and return
;Determine what editor we are using
; Set EDITOR to -1 for EMACS, +1 for anything else

EDITQ:	STKVAR<<LNAME,20>>	; Logical name string goes here
	SETOM EDITOR		; Assume EMACS
	SETZB A,D		; Job-wide
EDITQ1:	HRROI B,[ASCIZ /EDITOR/]
	HRROI C,LNAME
	LNMST
	 ERJMP [SKIPE D			; Tried system-wide yet?
		RET			; Yes, quit
		SETOM D			; Remember we've tried this
		MOVEI A,1		; Try system-wide
		JRST EDITQ1]
	HRRI A,LNAME		; Start of string
	HRLI A,(POINT 7)	; Form byte pointer
	CALL BP2CHR		; Form char pointer
	MOVEI W,20*5		; Maximum length
	MOVEI T,[ASCIZ /EMACS/]
	CALL SEARCH		; Is EMACS in the name anywhere?
	 JRST [	MOVEI A,1		; No, assume it's something else
		MOVEM A,EDITOR
		RET]
	RET			; Yes, original assumption was OK


;Here if using editor other than EMACS

TVORED:	ACVAR<TJFN>
	TRVAR<OLDCNT,NEWCNT,EDTPNT> ; *** Must match TRVAR at EDREPL and EDINS
	STKVAR<<STRING,30>>	; MSG.TMP filespec
	MOVE A,[POINT 7,TXTPAG]
	MOVEM A,EDTPNT
	LDB A,[POINT 6,TXTPTR,5]
	IDIVI A,7		; This junk figures out the char count
	HRRZ B,TXTPTR		; Get last word
	MOVEI B,1-TXTPAG(B)	; Number of words
	IMULI B,5		; Chars
	SUBI B,(A)
	MOVEM B,OLDCNT
	CALL EDTMP		; Write text into tmp file
	HRRZ TJFN,A		; Remember its JFN
	; ..
	; ..

	HRROI A,STRING
	HRROI B,[ASCIZ /EDIT /]	; Build command for editor
	SETZB C,D
	SOUT
	MOVE B,TJFN
	MOVX C,<1B8+1B11+1B14>!JS%PAF ; Name, type, and generation
	JFNS
	MOVEI B," "		; Plunk a space in there
	BOUT
	MOVE B,TJFN
	MOVX C,<1B8+1B11+1B14>!JS%PAF
	JFNS			; Output to this spec too
	HRROI B,[ASCIZ /
/]
	SETZB C,D
	SOUT			; Tie off the command
	HRROI A,STRING
	RSCAN			; Command string for editor
	 JFCL
	SETZB A,D		; Try job-wide definition first
	HRROI B,[ASCIZ /EDITOR/]	; Logical name to expand
	HRROI C,STRING		; Where to put expansion
	LNMST			; Get it
	 ERJMP [MOVEI A,1		; Try system-wide
		LNMST			; Is there one?
		 ERJMP [SETZM STRING		; No, use a null string
			JRST .+1]		; Rejoin main flow
		JRST .+1]		; Rejoin main flow
	MOVEI A,EDTGJB		; Editor GTJFN block
	HRROI B,STRING		; Pointer to editor filename string
	GTJFN			; Find the editor
	 JERROR (Cannot get editor)
	PUSH P,A		; Save JFN of editor
	MOVX A,CR%CAP
	CFORK
	 JERROR (Cannot create editor fork)
	MOVEM A,EDFORK
	POP P,A			; Restore editor JFN
	HRL A,EDFORK
	GET
	MOVE A,EDFORK
	SETZ B,
	SFRKV			; Start the editor
	WFORK
	KFORK			; Kill it off
	SETZM EDFORK
	MOVE A,TJFN		; Re-open TMP file
	MOVX B,<070000,,0>!OF%RD
	MOVE C,[POINT 7,TXTPAG]
	MOVEI D,TXTSIZ-1	; Init buffer count
	OPENF			; Read, 7-bit bytes
	 ERJMP [CAIN A,OPNX2		; Did editor empty the file?
		JRST TVORE1		; Yes, empty text buffer
		JRETER (Cannot open tmp file)
		JRST TVORE3]		; Evaporate the file and quit

TVORE2:	BIN
	 ERJMP TVORE1
	IDPB B,C
	SOJG D,TVORE2

TVORE1:	SETZ B,
	IDPB B,C		; Make ASCIZ
	MOVEM D,TXTCNT
	MOVNI B,1		; Back up over null
	ADJBP B,C		;  ..
	MOVEM B,TXTPTR		; Update text pointer

TVORE3:	MOVE A,TJFN		; Get JFN again
	TXO A,CO%NRJ		; Keep JFN
	CLOSF			; Close file
	 JFCL
	HRLI A,(DF%EXP)		; Delete and expunge
	DELF
	 JFCL
	RET
 SUBTTL Uuo handler

UUOH:	MOVEM 16,UUOACS+16	; Save all AC's
	MOVEI 16,UUOACS
	BLT 16,UUOACS+15
	LDB A,[POINT 9,40,8]	; Get opcode field
	CALL @UUOS(A)		; Do the right routine
	MOVSI 16,UUOACS	; Restore ac's
	BLT 16,16
	RET

UUOS:	0
	%PRINT
	%TYPE
	%ETYPE
	%ERROR

%PRINT:	HRRZ A,40		; Get byte
	CAIN A,EOL		; Print eol means do crlf
	 JRST CRLF
	PBOUT
	RET

%TYPE:	CALL TYCRIF		; Check if we should do a crlf
	HRRO A,40		; Get string
	PSOUT
	RET
TYCRIF:	MOVE A,40		; Get instruction
	TLNE A,(<10,0>)		; Wants cr all the time?
	 JRST CRLF		; Yes
	TLNE A,(<1,0>)		; Wants fresh line?
	 JRST CRIF		; Yes
	RET

CRIF:	PUSH P,A
	PUSH P,B
	MOVEI A,.PRIOU
	RFPOS
	HRROI A,CRLF0
	TRNE B,-1		; If not at start of line,
	 PSOUT			; Type crlf
	POP P,B
CPOP1J:	POP P,A
	RET

CRLF:	PUSH P,A
	HRROI A,CRLF0
	PSOUT
	POP P,A
	RET

CRLF0:	BYTE (7) 15,12,0
CRLF2:	BYTE (7) 15,12,15,12,0
%ERROR:	CALL CRIF		; Get a fresh line
	MOVE B,40		; Get instruction
	TLNE B,(<10,0>)		; Wants %?
	 SKIPA A,["?"]		; No
	 MOVEI A,"%"
	PBOUT
	TRNN B,-1		; Any message to print?
	 JRST %ERR2		; No
	CALL %ETYE0		; Yes,print it out
	MOVEI A," "
	PBOUT
	MOVE B,40		; And recover instruction
%ERR2:	TLNN B,(<4,0>)		; Wants JSYS error message?
	 JRST %ERR3
	HRROI A,[ASCIZ /because: /]
	PSOUT
	MOVEI A,.PRIOU
	HRLOI B,.FHSLF		; This fork
	SETZ C,
	ERSTR
	 JFCL
	 JFCL
%ERR3:	LDB A,[POINT 2,40,12]	; Get low order bits of ac field
	JRST %ERRS(A)

%ERRS:	JRST CMDRES		; 0 - return to top level commands
	XCT CMDRET		; 1 - user settable return
	CALL CKEXIT		; 2 - return to exec
	RET			; 3 - return to user
%ETYPE:	CALL TYCRIF		; Type a cr maybe
%ETYE0:	HRRZ U,40
%ETYS0:	HRLI U,(<POINT 7,0>)	; Get byte pointer to string
%ETYP1:	ILDB A,U		; Get char
	JUMPE A,R		; Done
	CAIE A,"%"		; Escape code?
	 JRST %ETYP0		; No, just print it out
	SETZ V,			; Reset ac
%ETYP2:	ILDB A,U
	CAIL A,"0"		; Is it part of addr spec?
	 CAILE A,"7"
	 JRST %ETYP3		; No
	IMULI V,10		; Yes, increment address
	ADDI V,-"0"(A)
	JRST %ETYP2
%ETYP3:	CAIGE A,"A"
	 JRST %ETYP0
	CALL @%ETYTB-"A"(A)	; Do dep't thing
	JRST %ETYP1

%ETYP0:	PBOUT
	JRST %ETYP1

%ETYTB:	%ETYPA			; A - Print time
	%ETYPB			; B - Print date
	%ETYP0			; C
	%ETYPD			; D - print decimal
	%ETYP0			; E
	%ETYPF			; F - floating
	%ETYP0			; G
	%ETYPH			; H - rh as octal
	%ETYP0			; I
	%ETYPJ			; J - filename
	%ETYP0			; K
	%ETYPL			; L - list
	%ETYPM			; M - current msg number
	%ETYPN			; N - host name
	%ETYPO			; O - octal
	%ETYPP			; P - plural (decimal)
	REPEAT 2,<%ETYP0>	; Q, R
	%ETYPS			; S - string
	%ETYPT			; T - date and time
	%ETYPU			; U - user name
	REPEAT 5,<%ETYP0>	; V, W, X, Y, Z
%ETYPA:	MOVSI C,(OT%NDA)	; No day, just time
	JRST %ETYB0

%ETYPT:	TDZA C,C		; Both date and time
%ETYPB:	 MOVSI C,(OT%NTM)	; No time, just day
%ETYB0:	JUMPE V,.+2		; If ac field spec'd
	 SKIPA B,UUOACS(V)	; Use it
	 SETO B,		; Else use now
	MOVEI A,.PRIOU
	TXO C,OT%SCL!OT%NSC	; Suppress leading space and seconds
	ODTIM
	RET

%ETYPD:	SKIPA C,[^D10]		; Decimal
%ETYPO:	 MOVEI C,10		; Octal
	MOVE B,UUOACS(V)	; Get data
%ETYO0:	MOVEI A,.PRIOU
	MOVEM B,LASTN		; Save for %P
	NOUT
	 JFCL
	RET

%ETYPM:	MOVEI C,^D10		; Decimal
	HRRZ B,UUOACS+M	; Current message
	AOJA B,%ETYO0		; Zero is msg 1

%ETYPF:	MOVEI A,.PRIOU
	MOVE B,UUOACS(V)
	SETZ C,
	FLOUT
	 JFCL
	RET
%ETYPP:	MOVE B,LASTN		; Get last number printed
	CAIN B,1		; C(b) := number printed
	 RET			; If 1 , then no plural
	MOVEI A,"s"		;  else - put out "s"
	PBOUT
	RET			; and return

%ETYPL:	SETOB M,LSTMSG		; Init loop and sequence printer
%ETYL1:	MOVE B,UUOACS(V)	; Get bit to test
	MOVEI A,1(M)		; Starting message #
%ETYL2:	CAMLE A,LASTM		; Done?
	 JRST PRTSQS		; Yes - wrapup message sequence
	TDNN B,MSGBTS(A)	; Want this one?
	 AOJA A,%ETYL2		; No - try more
	MOVEI M,(A)		; Yes - use it
	CALL PRTSEQ		; Print sequence
	JRST %ETYL1		;  Then try next message till done
%ETYPH:	MOVEI C,10
	HRRZ B,UUOACS(V)
	JRST %ETYO0

%ETYPJ:	MOVEI A,.PRIOU
	MOVE B,UUOACS(V)
	SETZ C,
	JFNS
	RET

%ETYPN:	MOVEI A,.PRIOU
	MOVE B,UUOACS(V)
	MOVEI C,10		; Just in case
	CVHST
	 NOUT
	 JFCL
	RET

%ETYPS:	PUSH P,U
	SKIPE U,UUOACS(V)
	 CALL %ETYS0		; Recursive call
	POP P,U
	RET

%ETYPU:	MOVEI A,.PRIOU
	MOVE B,UUOACS(V)
	DIRST
	 JFCL
	RET

MGETER:	PUSH P,B		; Save B
	MOVEI A,.FHSLF
	GETER
	HRRZ A,B		; Return just error
	POP P,B		; Restore ac
	RET
 SUBTTL FSCOPY - Fast String Copy

;	Courtesy of KLH
;	A - Source BP
;	O - Dest BP
;	C - char count
;	Updates destination pointer in O, smashes AC's A-C freely

KLWINC==^D18	; # chars at which hairy word move starts wining over bp loop

$STENT==1	; offset from beg of loop for entry to STORE phase
$GENT==4	; offset from beg of loop for entry to GET phase

FSCOPY:	CAIL C,KLWINC		; Less than break-even point?
	 JRST FSCPY2		; No, use hairy word copy.
	ILDB B,a		; simple byte-by-byte copying.
	IDPB B,O
	SOJG C,.-2
	POPJ P,

	; Wheee, using hairy word copying!
FSCPY2:	DMOVEM M,UUOACS+M	; This is a pain, but faster than using PDL,
	MOVE M,[D,,UUOACS+D]	; and we need to do something
	BLT M,UUOACS+M-1	; since ACs will be massacred.

	LDB E,[360300,,A]	; get low 3 bits of P field for source
	SKIPGE E,FSCHTB(E)	; Get resulting # chars, skip if addr ok
	 MOVEI A,1(A)		; P= 01, must bump address.
	MOVEI L,1(A)		; anyway, get addr+1 into 12.
	LDB D,[360300,,O]	; Repeat procedure for dest
	SKIPGE D,FSCHT2(D)	; using slightly different table
	 AOSA V,O		; and addr goes into 10
	  MOVEI V,(O)		; and isn't normally bumped.
	MOVEI O,(C)		; update the destination pointer in o
	ADJBP O,UUOACS+O	; from initial value
	; Now get index for shift values, and count for words
	SUBI C,(E)		; Get # chars minus those in 1st src wd.
	ADDI E,-6(D)		; Get E index - d*5+s, zero based.
	IDIVI C,5		; find # words to loop through, rem in d.
	MOVE B,-1(L)		; and get 1st word of source.
	JRST @FPATH(E)		; MUST now pick a path...

	; BLT possible!  Jump to FSBLT0 if no shifting needed for setup.
FSBLT0:	MOVEM B,(V)		; store source word directly
	JRST FSBLT4
FSBLT:	LSH B,@SHASL(E)		; Shift source up against left
	MOVE A,(V)		; get 1st wd of dest.
	LSH A,@SHADR(E)		; right-adjust it
	LSHC A,@SHFIX(E)	; and get everything into A.
	LSH A,1			; need one more bit's worth.
	MOVEM A,(V)		; Store 1st wd of dest...

	; Now settle down to serious BLT'ing.
FSBLT4:	MOVEI T,(C)		; transfer word count
	ADDI T,(V)		; find addr of last dest word
	MOVEI V,1(V)		; Now get 1st dest addr,
	HRLI V,(L)		; and put 1st source addr in LH.
	BLT V,(T)		; Zoom!!
	JUMPE D,FSCPY9		; if no remainder, super win - done!
	ADDI L,(C)		; Hmm, must get last source word.
	MOVE B,(L)		; like so.
	MOVE A,FBMSK(D)		; and a word mask for chars
	AND B,A			; clear unused bits from source,
	ANDCAM A,1(T)		; and zap target bits in dest.
	IORM B,1(T)		; and stick last chars in.
	JRST FSCPY9		; OK, all done...


	; Can't do BLT.  Well, get A and B set up for magical shift loop.
SHSKP2:	LSH B,@SHASL(E)		; Here, only need to adjust source,
	JRST SHSKP5		; since dest will be totally clobbered.
FSSHFT:	LSH B,@SHASL(E)		; Here, both src and dest must be integrated.
SHSKP1:	MOVE A,(V)		; Here, only need adjust dest; src wd is full.
	LSH A,@SHADR(E)
SHSKP5:	LSHC A,@SHFIX(E)	; Stuff as many chars as possible into A.

	CAIE D,0		; If any remainder,
	 MOVEI C,1(C)		; add 1 more word.
	MOVNI C,(C)		; Make AOBJN pointer.
	MOVSI C,(C)

	; Now make another index for termination wrapup purposes.
	ADD D,FFINDX(E)		; Make new index using # chs left in last wd.

	; Now set things up for loop, and enter it.

	HRLI V,(<MOVEM A,(C)>)
	MOVEM V,FSCPKL+2	; Address for MOVEM
	HRRM L,FSCPKL+4		; Address for MOVE
	MOVE L,FSHINT(E)	; Get LSH for shift-in
	MOVEM L,FSCPKL
	MOVE L,FSHOUT(E)	; and shift-out
	MOVEM L,FSCPKL+3
	JUMPGE D,FSCPKL+$STENT	; Depending on flag in D, enter loop at store
	SOS V,FSCPKL+2
	JRST FSCPKL+$GENT	; or at get.

;---------------------------------------------------------------------------
	; Come here when loop finished.  The last word of the source string
	; will be in B.  It may have 1 to 5 chars left for moving, but will
	; never have 0.

	; Long wrapup.
FSCPTL:
	LSHC A,@FSCPKL		; Perform a shift-in
	LSH A,1
	MOVEM A,@10		; Store full word.
	MOVEI C,1(C)		; increment address index
				; and drop through to Medium wrapup.

	; Medium wrapup.
FSCPTM:	LSHC A,@FLOUT(D)	; Shift rest of source word into A
	MOVE B,@10		; Get dest word it will be stored into
	LSH B,@FLADJ(D)		; left-adjust chars to preserve.
				; and drop thru to Short wrapup.

	; Short wrapup.
FSCPTS:	LSHC A,@FFLOUT(D)	; Do final, last, shift-out.
	ANDCMI A,1
	MOVEM A,@10		; and store last dest word.

	; Done!!  Just restore regs and return.
FSCPY9:	MOVE M,[UUOACS+D,,D]
	BLT M,M
	POPJ P,


	; Indexed by low 3 bits of P field, returns # chars
	; existing to right of loc BP points to.  Hence value
	; ranges from 5 to 1; if P = 01, SETZ indicates that
	; bp address needs incrementing.
FSCHTB:	1	; P=10
	SETZ 5	; P=01, increment addr
	0
	0	; randomness
	5	; P=44, full word
	4	; P=35, 4 chars to go
	3	; P=26
	2	; P=17

	; This table is just like FSCHTB except values are pre-multiplied
	; by 5 for easy addition into E.
FSCHT2:	1*5	; P=10
	SETZ 5*5 ; P=01, increment addr
	0
	0	;random
	5*5
	4*5
	3*5
	2*5

	; This table is indexed by D when it has # chars remaining from
	; dividing # chars (in C) by 5.  Provides mask for these chars.
FBMSK:	0	; Nothing here.
	BYTE (7) 177
	BYTE (7) 177, 177
	BYTE (7) 177, 177, 177
	BYTE (7) 177, 177, 177, 177

	; FPATH table vectors off to BLT and other minor stuff as
	; soon as all the basic computations are made.
	; Indexed by E.
FPATH:	FSBLT
	FSSHFT
	FSSHFT
	FSSHFT
	SHSKP1
	FSSHFT
	FSBLT
	FSSHFT
	FSSHFT
	SHSKP1
	FSSHFT
	FSSHFT
	FSBLT
	FSSHFT
	SHSKP1
	FSSHFT
	FSSHFT
	FSSHFT
	FSBLT
	SHSKP1
	SHSKP2
	SHSKP2
	SHSKP2
	SHSKP2
	FSBLT0

DEFINE ENT (A,B,C,D,E) <
	A*7
	B*7
	C*7
	D*7
	E*7
   >
	; SHASL table, contains # bits to shift first source wd left so
	; as to left-adjust it in B.  Indexed by E.
SHASL:
	ENT 4,3,2,1,0
	ENT 4,3,2,1,0
	ENT 4,3,2,1,0
	ENT 4,3,2,1,0
	ENT 4,3,2,1,0

	; SHADR table, contains # bits to shift first dest wd right so
	; as to right-adjust it in A.  Indexed by E.
DEFINE ENT1 (A,B,C,D,E) <
	0,,A*7-1
	0,,B*7-1
	0,,C*7-1
	0,,D*7-1
	0,,E*7-1
   >
SHADR:
	ENT1 -1,-1,-1,-1,-1
	ENT1 -2,-2,-2,-2,-2
	ENT1 -3,-3,-3,-3,-3
	ENT1 -4,-4,-4,-4,-4
	ENT1 -5,-5,-5,-5,-5

	; SHFIX table, contains # bits to left-shift A and B combined so
	; as to move as many characters out of B as possible.  Indexed
	; by E.  MIN(d,e) (d and e after fschtb)
SHFIX:
	ENT 1,1,1,1,1
	ENT 1,2,2,2,2
	ENT 1,2,3,3,3
	ENT 1,2,3,4,4
	ENT 1,2,3,4,5

	; FSHINT table, containing appropriate LSHC instructions for shifting
	; in the first chars of a fresh source word.  Indexed by E.
DEFINE ENTL (ARG1,ARG2,ARG3,ARG4,ARG5) <
	LSHC A,ARG1*7
	LSHC A,ARG2*7
	LSHC A,ARG3*7
	LSHC A,ARG4*7
	LSHC A,ARG5*7
   >
FSHINT:
	ENTL 5,4,3,2,1
	ENTL 1,5,4,3,2
	ENTL 2,1,5,4,3
	ENTL 3,2,1,5,4
	ENTL 4,3,2,1,5


	; FSHOUT table, containing appropriate LSHC instructions for shifting
	; out the last chars of an old source word, to make room for a
	; new one.  Indexed by E.
FSHOUT:
	ENTL 0,1,2,3,4
	ENTL 4,0,1,2,3
	ENTL 3,4,0,1,2
	ENTL 2,3,4,0,1
	ENTL 1,2,3,4,0


	; FFINDX table, contains part of D index for fast add-in.
	; Indexed by E.  Similar to FSHOUT.  Sign bit also indicates
	; whether entry point is $STENT (pos) or $GENT (neg).
DEFINE ENTS (A,B,C,D,E) <
	ENT5 A
	ENT5 B
	ENT5 C
	ENT5 D
	ENT5 E
   >
DEFINE ENT5 (X,Y) <
	X!<Y*5>
>
S==0B0
G==1B0

FFINDX:
	ENTS (<S,0>,<S,1>,<S,2>,<S,3>,<S,4>)
	ENTS (<G,4>,<S,0>,<S,1>,<S,2>,<S,3>)
	ENTS (<G,3>,<G,4>,<S,0>,<S,1>,<S,2>)
	ENTS (<G,2>,<G,3>,<G,4>,<S,0>,<S,1>)
	ENTS (<G,1>,<G,2>,<G,3>,<G,4>,<S,0>)

DEFINE ENTX (A,B,C,D,E) <	; Last item (5) is actually first (0)
	7*E
	7*A
	7*B
	7*C
	7*D
   >

	; FENTRM table, dispatching to appropriate wrapup routine when fast AC
	; loop is finished.  Indexed by D.
FENTRM:
DEFINE ENTXJ (A,B,C,D,E) <
	FSCPT'E
	FSCPT'A
	FSCPT'B
	FSCPT'C
	FSCPT'D
>
	ENTXJ M,M,M,M,S
	ENTXJ M,M,M,S,L
	ENTXJ M,M,S,L,L
	ENTXJ M,S,L,L,L
	ENTXJ S,L,L,L,L


	; FLOUT table, for use by Medium wrapup routine; pushes out remaining
	; source chars in B, making room for incoming dest word.
	; Indexed by D.
FLOUT:	ENTX 1,2,3,4,0
	ENTX 1,2,3,0,1
	ENTX 1,2,0,1,2
	ENTX 1,0,1,2,3
	ENTX 0,1,2,3,4

	; FLADJ table, also for Medium wrapup routine; adjusts dest word in
	; B to left-adjust chars to be preserved.
FLADJ:	ENTX 1,2,3,4,5
	ENTX 2,3,4,5,1
	ENTX 3,4,5,1,2
	ENTX 4,5,1,2,3
	ENTX 5,1,2,3,4

	; FFLOUT table, for Short wrapup routine.  Final Last shift-out of
	; chars in B, so that the last dest word can be stored from A.
	; Indexed by D.  Adds 1 extra bit since MOVEM A, done right after it,
	; and nothing to preserve in B.
FFLOUT:
DEFINE ENTX1 (A,B,C,D,E) <
	E*7+1
	A*7+1
	B*7+1
	C*7+1
	D*7+1
   >
	ENTX1 4,3,2,1,5
	ENTX1 3,2,1,4,4
	ENTX1 2,1,3,4,3
	ENTX1 1,2,4,3,2
	ENTX1 1,4,3,2,1
; Local modes:
; Mode: MACRO
; Comment col:40
; Comment begin:; 
; End:

	END <3,,EV>
>
@%)@$kO