Trailing-Edge
-
PDP-10 Archives
-
BB-M836A-BM
-
tools/ms/ms.mac
There are 19 other files named ms.mac in the archive. Click here to see a list.
; UPD ID= 4, SNARK:<5.TOOLS-TAPE>MS.MAC.2, 22-Mar-82 11:43:11 by PURRETTA
; Update copyright
;<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,1980,1981,1982 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