Trailing-Edge
-
PDP-10 Archives
-
T10_T20_MS_V10_SRCS_830128
-
ms.mac
There are 19 other files named ms.mac in the archive. Click here to see a list.
;This software is furnished under a license and may only be used
; or copied in accordance with the terms of such license.
;
;Copyright (C) 1979,1980,1981, 1982 by Digital Equipment Corporation
; Maynard, Massachusetts, USA
TITLE MS - Message System for TOPS10 and TOPS20
SEARCH GLXMAC
PROLOG (MS)
.DIRECTIVE FLBLST
SALL
EXTERNAL MOVSTR,MOVST0,MOVST1,MOVST2 ; Autopatch-theft crock
;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]
;Since MM came to DEC in the summer of 1978, we've changed the name
; to MS and added:
;
; COMND support (TAH)
; DECNET mail support
; Init files
; XMAILR support
; Simultaneous DECNET and ARPANET support for non-XMAILR systems
; Paper mail support (Interoffice mail)
; Made MS part of GALAXY, so it can run under TOPS10
; User-defined header-items and aliases
; /Larry Campbell [LCampbell@DEC-MARLBORO]
SUBTTL Revision history
Comment @
Edit Reason
---- ------
1412 Fix personal-name extractor, and remove (by popular
demand) the CLRBFI at startup.
1413 Fix bug on XMAILR systems when address-lists used.
1414 Add TAKE command to send and read levels, and fix
bad output designator on TOPS20 systems.
1415 Enlarge automatic storage at SNDNET and XMAILR so long
directory names don't cause wild clobberage.
1416 Fix bug which caused text-string header-items to never
appear in messages sent.
1417 Fix error routines in GETUSR to do reparsing correctly
(by calling SVSTA0 to restore original state of world).
1420 Dynamically allocate space for message file (this means
too-large file on TOPS10 will produce Galaxy stopcode
instead of ?illegal address in UUO, at least until
Galaxy is fixed to give error returns from memory manager).
1421 Fix bugs in TOPS20 code caused by edit 1420.
1422 General cleanup, fix several piddling bugs.
1423 More bugs in TOPS20 version caused by edit 1420.
1424 Yet more of the same.
1425 Expunge and parse bugs (TOPS20 only) caused by 1420.
1426 Fix infinite loop in XMAILR code caused by sending to
local recipient. This edit will force ALL mail to
go via XMAILR on XMAILR-equipped systems.
1427 Fix DATE75 bug on TOPS10 systems.
1430 Add "set [no] brief-address-list-display".
1431 More bulletproofing against munged message files.
1432 Fix bugs in DECNET hostname synonyms.
1433 Fix typo in 1432.
1434 Make GTNTU4 understand flags words in HOSTAB strings.
1435 More hostname synonym fixes.
1436 Fix expunge bug caused by edit 1420 (caused IMW stopcodes
on XMAILR systems).
1437 Always exit on exit command, even if new mail arrives.
1440 In headers cmd, if msg is from me, delimit column with
dot (.) instead of space, and type "to" field instead of "from".
1441 Massive speedup to HELP command (F%IBUF instead of F%IBYT).
1442 Default PPN for save-outgoing to logged-in PPN.
1443 Smarter check for messages from me, so messages from users
with names of which my name is a substring don't match.
1444 Fix bugs in ARPANET (NMAILR) code and remove spurious
CONFRM from "erase header-item" command.
1445 Fix bug in updating msg bits when file is exact multiple
of 128 words long (TOPS10 only).
1446 Fix accidental CONFRMs caused by 1444.
1447 Enlarge HOSTAB to two pages so all of MRC's synonyms fit.
1450 Make ^C continuable without clobberage.
1451 Make FSCOPY use private AC save block instead of purloining
the UUO AC save block, which caused bizarre clobberage whenever
an interrupt routine running during FSCOPY executed a UUO.
1452 Use MM-style flagging of our own messages in headers command
("To: <name>" instead of ".<name>").
1453 Improvement to 1452 (bit bumming).
1454 Fix Judy's bug (IST stopcodes after command line editing).
1455 Better error msg when bad username typed on TOPS20.
1456 If XMAILR support but no ARPANET, try DECNET node name
for local node name. If no DECNET node name, die,
because we MUST know our local name.
1457 Fix confirm bug with non-EMACS editors invoked from send level.
1460 Respect TTY GAG when typing annoying stuff on terminals.
1461 Make REPLY command prompt for required header-items.
1462 If EOF on cmd file in msg text, display text and stay
in text mode (don't go to send level). Also cause
RETYPE (ctrl-K) to display only text of message.
1463 Fix subtle subroutine-call-nesting bugs which broke putting
TAKE commands inside init files.
1464 Insure that "sending to" message starts at left margin.
1465 Fix bugs in date/time parsing on TOPS10 (exercised only
when message file munged).
1466 Better help message for time header-items.
1467 Remove "set show-to-in-headers-command". It was one of
the grosser-looking commands, and is no longer needed due to
edits 1440 and 1452.
1470 Multiple fixes to TAKE command and init file code so that
nested command files work in all cases.
1471 Better error message when msg no. out of range, and more of 1470.
1472 Fix stuckness in send level caused by 1470.
1473 Fix CONFRM bug in EMACS interface.
1474 Fix multiple bugs in REMOVE command.
1475 Fix read-level EXIT command.
1476 Fix REPAIR command bugs.
1477 Fix bug in REPLY when Reply-to contains unknown hostname.
1500 Fix the way ENQing is done on TOPS10 to prevent damaged files.
1501 Make EXPUNGE code obey append interlock as well (TOPS10 only).
1502 Type filespecs in file-related error messages.
1503 Fix ILM stopcode in SAVE-OUTGOING command (TOPS10 only).
1504 Only read SYSTEM:MS.INIT if private init file doesn't exist.
1505 Show save-outgoing filespec in output from "show defaults" command.
1506 Make message-ID conform to RFC733.
1507 Add VT05 clear-screen support.
1510 Sigh... don't light IT.OCT on TOPS20 due to GLXKBD awfulnesses.
1511 If doing auto MOD stuff, make BLANK cmd in init file a noop.
1512 Fix "?Unimplemented error macro invoked".
1513 Remove table of contents (ATSIGN does it better).
1514 Allow "save-outgoing <crlf>" to stop saving outgoing messages.
1515 Wrap long lines in only-headers-shown display in output from
"show defaults" command.
1516 Performance hack... only call NAMINI if about to send a message,
and don't init any software interrupts if just typing system messages.
1517 Fix obscure bug induced by 1516 but caused by not calling
CMDINI in enough places.
1520 Fix bogus date/time display in "next" command at top-level caused
by not having parsed the message (M%VALI not lit).
1521 Fix very obscure echoing bug caused by 1516 (TOPS10 only) by
moving call to USRINI out of NAMINI and into startup sequence.
1522 Fix doubled "Message n is deleted" messages in "list" command.
1523 Localize literals for TOPS20 to reduce paging.
1524 Move init routines closer to startup for better pgm locality.
1525 Deactivate timer interrupts during expunge.
1526 Fix nonreturn to exec after .MS EXPUNGE (TOPS10 only).
1527 Cosmetic adjustments to "show defaults" output.
1530 Noise words for "show" cmd.
1531 Fix %Duplicate name purged bug of going into TI wait.
1532 Do physical-only open of SYSTEM:MAIL.TXT; add bulletproofing
to editor interface code.
1533 Fix horrible awful bug which causes vast lossage when sending
large messages to local users (TOPS20 only).
1534 Fix several bugs related to not recognizing receipt of new mail.
1535 Minor bug in 1533.
1536 Handle removal of duplicate address lists properly.
1537 For read command, check for new mail before building message sequence.
1540 Minor repair to editor interface error recovery (release JFN).
1541 Fix typo in 1536.
1542 Many fixes to "repair" command.
1543 More of 1540.
1544 More of 1532 (bug fixes to editor code).
1545 More of 1533 (typo).
1546 Insure that "?MS command error" msgs start at left margin.
1547 Fix "?Can't translate host name" when replying to message from
unknown host, or with unknown host in reply-to field.
1550 Better error message when STD:USERS.TXT is crufty.
1551 Fix stupid return to EXEC after MS SYSTEM command.
1552 Update copyright notice for 1981.
1553 Fix REMOVE command for net addresses.
1554 Construct "In-reply-to" and "Reference" fields at REPLY time, not
SEND time, so "retrieve last-message" after expunge doesn't use bogus
pointers.
1555 Include MS's version number in Message-ID field.
1556 Sigh... make Message-ID conform to RFC733 (and ugly in the bargain).
1557 Add "retrieve" commands to read level.
1560 Fix bug in "set personal-name" when null arg given.
1561 Fix bug in hdrs command when checking for self in "from" string.
1562 Fix cruddy Reference fields.
1563 Add support for DECNET host table containing routing info.
1564 Allow linear white space in DECNET host table.
1565 Fix "no network" error in "net-mail" cmd given to virgin MS.
1566 Off-by-one message number reported by XDATIE.
1567 Add GTHST hostname stuff for extended leader ARPANET.
1570 Have GET cmd default to PS:<logged-in-dir>.
1571 Fix once-again-broken-because-never-used paper mail feature.
1572 Implement "set suppressed-headers".
1573 Fix many bugs by not relying on .CMUQS, which Eric won't fix
1574 Always call NAMINI on startup to avoid obscure complaints
about absence of network support.
1575 Allow addresses on same line as "to" and "cc" commands.
1576 Fix faulty fence in handling suppressed headers that caused
illegal instructions if illegally-formatted header.
1577 Add support for improved IPCF mailer; local mail now stays
local and also has MS-built headers.
1600 Fix bogus "No such user" message when defaulting hostname
in "reply (to) all" because bare local addresses found
in mail from remote host.
1601 Fix corruption of message files if error (like overquota)
occurs in the middle of appending a message.
1602 Fix incredibly stupid bug in line-stuffing code in TYPHDR.
1603 Add whizzy VT100 scrolling.
1604 Add msg sequencer "sorted (by) date-time" (DRL).
1605 Fix bug in whizzy screen stuff.
1606 Add "set [no] video-mode".
1607 Fix no confirm on read-mode "type" command and add "set
minimum-text-window-size" command.
1610 Cause "exit" in read mode to undo screen funniness also.
1611 Use STPAR to set page size, SFMOD doesn't make it.
1612 Turn on IB.NPF.
1613 Clear screen (thus resetting scroll region) when entering
editor or PUSHing.
1614 Try using K%BUFF to speedup TTY I/O.
1615 Flush TTY output buffers in a few more places.
1616 More of the same...
1617 When exiting read level, instead of clearing screen (annoying),
move cursor to bottom line (different but not as obnoxious).
1620 Add positive acknowledgement of having saved an outgoing message.
1621 Spurious CRLF on TOPS10 systems...
1622 Add hooks for Kawell mail (VAX-RSX-RSTS).
1623 More TTY buffer flushing.
1624 And more.... (sigh).
1625 On TOPS10 must zero line counter after setting page size (on
TOPS20 you get that for free).
1626 Add msg selector "same" and also allow constructs of the form
"headers 1,3:6,flagged".
1627 Fix screen weirdness when using TYPE from send level from read level.
1630 Show minimum-text-window-size in "show defaults" output.
1631 Fix fencepost bug in GTHST code that caused bogus hostnames to
be created by concatenation of real names.
1632 Make GET from SFDs work.
1633 Reset page counter in yet one more place (TOPS10 only).
1634 Fix minor bug in 1626.
1635 Clear F%RSCN on "set", "define", and "create-init" commands.
1636 Rescan for commands if continued also (makes MFEXEC more useful).
1637 Change the switch name to KAWELL.
1640 GLXLIB now calls its data psect DATA...
1641 Fix filespec defaulting bugs.
1642 More detailed error messages for file opening failures.
1643 Rearrange PSECT stuff, the new GLXLIB has changed many things.
1644 Finally! Fixed that annoying bad error message (ASCIZ string
not terminated) when bad username typed.
1645 Another K%FLSH (TOPS10 only) for delivery confirmations.
1646 Show GLXLIB version in "show version" command also.
1647 Set up filespec defaults properly for TOPS10 command scanner.
1650 More explicit error message when can't open message file.
1651 Fix hostname defaulting in REPLY command, so absence
of host spec in "Reply-to" field doesn't matter.
1652 Fix reparsing when command error in parsing usernames.
1653 Better error message when can't open output files, and fix
minor bug in error recovery code that lost chunks.
1654 Always form complete net addresses, with hostnames,
to conform to RFC733 (per recent MSGGROUP discussion).
1655 Fix illegal memory references in "retrieve saved-draft" and
"repair" commands caused by edit 1651.
1656 Fix more reply bugs caused by 1651.
1657 Add GLXLIB version no. to message-ID and get the damn thing
into strict conformance with RFC733.
1660 UFPGS message file whenever we've modified it in case system crashes.
1661 Fix spurious "Expunge in progress" messages when ctrl-C typed,
fix nonupdating of message flag bits, also several minor or
cosmetic fixes.
1662 Fix nonupdateage of message bits caused by 1660, better error
message when OPENF in GETJF2 fails, handle lowercase structure
names in USERS.TXT.
1663 Correct reparse behavior at NOUSR (in GETUSR).
1664 Warn user when UPDBIT can't get exclusive access to file.
1665 Fix off-by-one bug in KWDREL which caused storage to never
get released, and fix reparse bug at NOUSR which caused
?GETUSR - No reparse address.
1666 Fix garbage 'Reference' fields when replying to messages
after an expunge (TOPS20 only).
1667 Convert BP2CHR and CHR2BP from routines to macros (for speed).
1670 More performance hacks -- turn on preloading when PMAPing message
file, more judicious use of ACs with fewer PUSH/POP sequences
in NOISE macro and EQSTR routine.
1671 Try calling F%CHKP before closing file when appending to message
files to see if that stops random clobberage of last block
minus one (a problem seen only on TOPS10).
1672 Fix some bugs introduced by 1670 (I expected these...)
1673 Remove PUSH/POP sequences from NOISE and CONFRM macros.
Callers must now be aware that these clobber A and B.
1674 Fix spurious 'unterminated named address list' in reply command
if sender's name appears also as the last name in an addr list.
1675 Oops, forgot to actually add PM%PLD in 1670.
1676 TOPS20-only bug in 1670.
1677 PMAP DECNET-HOSTS.TXT instead of using BIN.
1700 In expunge code, only make private those pages that we are really
going to BLT stuff around in. This will save the monitor from
a considerable number of BLTs when expunging messages from
near the end of a large message file.
1701 Fix nonreturn to send level after failure to send mail because
of some file operation failure (TOPS10 only), and give better
error messages in this case also.
1702 Fix BPN stopcode in 'define header *' if some header-items
are keywords.
1703 Fix line-wrapping bug in 'show address-list' command.
1704 More informative error message in TAKE command failure.
1705 Turn on PM%PLD for HOSTS2.BIN and fix 'no recipients on
this host specified' bug in DECNET mail when sending to both
local and foreign users (Wook's bug).
1706 GLXLIB finally has physical-only opens!!! Turn it on for
STD:USERS.TXT!
1707 Make 'headers 120:last' work (a la Tarl).
1710 Recover gracefully from loops in indirect files (TAKE MS.INI).
1711 Fix reparse code in 'define address-list' and 'define alias'.
1712 Fix confirm bug in 1707.
1713 Move CMDER1 so error reparses ALWAYS report the failing command
if it's in a command file.
1714 Change STKVAR at ADRLST to TRVAR so 1711 works.
1715 Fix three bugs related to having nulls inside header area so that
mail generated by old, stupid mailers can be read.
1716 Better error handling for STD:USERS.TXT.
1717 Fix horrible awful bug in TOPS10 expunge/update code that
caused message files to be emptied of all data.
1720 Understand uppercase ' AT ' host delimiter in received mail,
even though it violates RFC733 (so I can reply to Covert's mail).
1721 Fix stupid error in 1717 which caused "?Can't abort update
opening of message file" fatal errors.
1722 Cosmetic improvement to "invalid username" error messages.
1723 Fix non-updating of message bits for messages in last block of
file when new mail is arriving (TOPS10 bug only).
1724 Add switch /NOMAIL20 to DECNET-HOSTS.TXT which says that host
cannot receive mail using current DECNET-20 protocol.
1725 Fix clear-screen sequence for VT05s (sigh, DEC operating systems
are dumb and don't add the fill characters).
1726 Add EXIT command to send level (per HAS).
1727 Double space available for ANF10 node names, we just ran out
of room on Twinky.
1730 Fix non-echo after failing GET command when typed as monitor
command.
1731 Fix bug in XMAILR systems where DISPLAY command would prevent
netmail from ever getting queued.
1732 Allow abbreviations in switches in DECNET-HOSTS.TXT, and when
announcing new messages, only type headers of the new ones,
not unread ones.
1733 Change switch name to /NO20MAIL.
1734 Do physical-only opens for mailer flags, use entire editor window
space when fondling EMACS buffers.
1735 Allow numeric characters in switches and add hooks for switches
with arguments (DECNET-HOSTS.TXT).
1736 Remove CHKTIM, it is a source of bugs. This should fix the
TOPS10 bug of nulls in the middle of message files.
1737 Fix clobberage in HSTINI.
1740 Make "set brief-address-list-display" work for suppressed-headers
as well as only-headers-shown case.
1741 Fix annoying VT100 bug exercised only when doing fancy scrolling
and "set brief-address-list-display" is in effect.
1742 Fix some halfword arithmetic at EXPN36 which caused very large
message files to suddenly become very short (TOPS10 only).
1743 Add message selector 'larger (than) n (characters)'.
1744 Also 'smaller (than) n' for completeness.
1745 Make msg number be 4 columns in headers cmd so >999 msgs works.
1746 A little more flexibility on the format of the help file.
1747 Add 'echo' command, which just types out its string argument
(useful for hacking with hairy command files).
1750 If user specifies an empty message sequence, tell him in all
circumstances.
1751 Better COMND error messages, and another "msg 4096" bug fix.
1752 Random small cosmetic adjustments.
1753 Fix check for oversized message files.
1754 Fix bug in duplicate name purging which caused badly-formed address
lists to be generated, and a bug in PRADDR which caused replies
to such messages to cause wild explosions.
1755 More bulletproofing against badly-formed address lists.
1756 Better error messages for badly-formed address lists.
1757 Add 'status' command to send and read levels, and improve grammar.
1760 Make default be non-fancy scrolling for VT100s; change name of command
to turn it on to 'set text-scroll-region'; make the old command
(set minimum-text-window-size) invisible.
1761 Fix 'set video-mode' so it can be toggled.
1762 Add EMS-like 'file' command.
1763 Show state of 'set headers-on-printer-output' in 'show defaults'.
1764 Sigh... fix terminal paging bug caused by idiotic implementation
of TTY I/O in TOPS10. Also requires monitor patch (to make .TOPCT
a settable TRMOP. -- set the 40000,,0 bit in TOPTB1+24).
1765 Handle SIZEF failure on HOSTS2.BIN; also make EXIT command never
imply EXPUNGE if F%MOD lit.
1766 When closing message file, release its buffer space also.
1767 Remove spurious call to RECEN0 in RESCAN command logic.
1770 Fix bug in UPDBIT (TOPS10 only) that caused nulls to get inserted
into last block minus one of message file.
1771 Fix edit 1766, never release the storage twice.
1772 Fix badly-formatted outgoing-message files (TOPS10 and TOPS20) and
recipient mail files (TOPS10 only) when resending a message which
has failed.
1773 1772 wasn't quite all of it, finish the fix.
1774 Have CHECKS call RDELAY, so new message notification in read mode
doesn't immediately get wiped by screen clearage.
1775 Better noise words for read-level EXIT command.
1776 Add ECHO command to read and send levels.
1777 (TOPS10 only) If mail to someone fails, continue down list and
attempt all addressees before returning to send level.
2000 Fix off-by-two byte count when resending a message (after a send
failure, for example, or after RETRIEVE LAST-MESSAGE).
2001 Always insure that local host is present in internal host table,
so it needn't be in the external ones (NODTBL.EXE, DECNET-HOSTS.TXT)
2002 Fix bad error messages at CMDER1 caused by bug in TSOUT.
2003 Fix line continuation bugs caused by bogus implementation (parsing
by hand) of network addresses.
2004 Fix handling of quoted strings at MOVADR.
2005 Remove special-cased TOPS10-only code which was required because
GLXLIB COMND simulator had a bug. I've fixed the GLXLIB bug.
This REQUIRES that MS be loaded with GLXLIB version 1(1057)
or later. If you don't have this GLXLIB (symptom is that username
parsing is wildly broken under TOPS10), the patch is:
In GLXSCN, in the literal at CMRAT2+7, the JUMPG T1,CMRATT should
be changed to JUMPG T1,CMRATR.
2006 Don't check for new mail before every MS prompt if command input
is coming from a file, not a TTY. This not only prevents unwanted
openings of MAIL.TXT, but also speeds up init files massively.
2007 Fix bug (TOPS10 only) that if MAIL.TXT does not exist, but is
created by arrival of new mail, MS doesn't see it.
2010 Allow parsing of multi-word usernames (Joe Blow at NODE3).
2011 Allow replies to multi-word usernames, and to addresses with
extended host specs (Fred Ferd at HOST at NETWORK).
2012 Per RFC733 and recent MSGGROUP discussion, make "In-reply-to"
contain message-ID of original message. "In-reply-to"'s old
function is now filled by a new header name, "Regarding".
2013 Allow quoted strings for address list names and header item names.
2014 Remove nonzero data from initial low seg to speed up TOPS10 MS.
2015 Fix bug caused by recognition appending a space to the end of
TOPS20 usernames.
2016 Fix another space-append bug (prevents "USER " is an invalid name
error message, when USER is valid).
2017 Fix "%Can't determine existence of new mail" after failing GET cmd.
2020 Fix spurious CRLF near end of first line of message text when
in SET TEXT-SCROLL-REGION mode.
2021 Fix "%Can't open file, no free channels" when no message file exists.
2022 Fix '?Invalid user name "Wells "' when "Wells" is a valid user;
also use CWARN when complaining about DEFINE ADDRESS-LIST command
with no addresses so ctrl-H works.
2023 Fix ?Illegal UUO when USERS.TXT does not end with CRLF.
2024 Reinitialize KWDTBL at runtime on startup to prevent ill mem refs
in ABREL when adding new entries.
2025 Report FILOP. error strings in all their glory.
2026 SIZFIL should call FILOPR, and not roll its own (improves error
reporting).
2027 Fix two bugs: 1) REPLY ALL didn't work right if named address-lists
occurred in the To or CC field, and 2) ill mem refs in DOUNTO
when removing a named address-list which is the last element in
an address list.
2030 Improve FILOP. error reporting.
2031 Improve error reporting and recovery in USRINI.
2032 Because of security bugs and LOGIN's not doing anything with
it, temporarily de-implement system mail for TOPS10.
2033 Allow SET BRIEF-ADDRESS-LIST-DISPLAY to work always, not just when
SET SUPPRESSED-HEADERS or SET ONLY-HEADERS-SHOWN is in effect.
2034 Fix infinite "?Too many terminators in named address list" bug in
REPLY command.
2035 Make RDELAY clever so that we delay based on time-of-day, which
guarantees no useless delays.
2036 Have all error macros call RDELAY.
2037 More RDELAY improvements, better error reporting in SIZFIL.
2040 Clear ctrl-O before prompting and before error messages.
2041 Flush TTY buffers after init files.
2042 Remove code which references NODTBL for TOPS10; version 5 will
have only local mail support for TOPS10.
2043 Use .CMTXT instead of .CMFLD for parsing usernames in USERS.TXT;
this allows usernames with dots, spaces, underscores, etc.
2044 Fix TMT stopcode when USERS.TXT gets large.
2045 Enlarge USRTAB to 600 entries. Version 6 will dynamically allocate.
2046 Fix bug in ERASE ALL that missed header-items.
2047 Rename HEADERS to SUMMARIZE, LIST to PRINT, SET HEADERS-ON-PRINTER-
OUTPUT to SET SUMMARY-ON-PRINTER-OUTPUT, and SET HEADERS-PERSONAL-
NAME-ONLY to SET SUMMARY-PERSONAL-NAME-ONLY.
2050 Fix yet another bug in SET BRIEF-ADDRESS-LIST-DISPLAY.
2051 Rename top-level EDITOR command to EMACS.
2052 Make STATUS and DAYTIME invisible (replaced by SHOW xxx).
2053 Change read-level EDITOR command to EMACS, update copyright notice.
2054 Fix security bug by explicitly setting protection of MAIL.CPY
and queued netmail to 770000.
2055 Change version number to 10, per marketeers.
2056 Change ERASE REPLY-DATE to ERASE REPLY-INFORMATION.
2057 Fix security bug in TOPS10 file opens (ALCFOB).
2060 Improve version number printer to print real GLXLIB version.
2061 Same for message-ID.
2062 Correct misspelling in FILE command noise.
2063 Double space allocation for message header (HDRPAG) to 2 pages.
2064 Fix strangeness in address list if TO or CC field ends in CRLF-comma.
2065 Fix bad GLXLIB version no. shown in Message-ID.
2066 Use our own private stack during interrupt routines instead of
stunted GLXLIB stack that overflows.
2067 Add another page to HOSTAB, MRC's host table is getting bigger.
Also add terminal types VT101 and VT102 (TOPS10 only).
2070 Rewrite USRINI to not use GLXSCN. This fixes structure-not-online
lossage, makes error handling better (only the bad line is skipped),
and makes MS run faster.
2071 Fix bug in reporting nonexistent help file.
2072 Various small fixes, QARs 20-02008, 20-02002, 20-02001.
2073 Suppress line numbers in command files (required for TOPS-10 only).
2074 (QAR 10-01007) On TOPS10, disallow delivery mail to message files
over 1000 blocks long (because TOPS10 doesn't enforce quotas for us).
2075 (QAR 20-02011) If ^C'ed out of editor and CONTINUEd, return
to editor rather than attempting rescan.
2076 (QAR 20-02007) Change "save-draft" to "save draft".
2077 Add "save outgoing-messages" at send level.
2100 Change "save-outgoing-messages" to "save outgoing-messages" for
consistency.
2101 Remove system-messages stuff from TOPS10 version.
2102 Make SET DEFAULT DIRECTORY work for input files as well as output.
2103 (QAR 20-02006) Fix defaulting for RETRIEVE DRAFT.
2104 (QAR 20-02004) Put MSG.TMP in DEFAULT DIRECTORY.
2105 (QAR 20-02019) Fix SET DEFAULT PROTECTION.
2106 Triple size of HSTNAM space (room for more ARPANET hostnames).
2107 Fix ill mem ref in RETRIEVE DRAFT when file is exact multiple
of one page long.
2110 Fix bug at .RNEXT caused by workaround for ancient COMND bug.
2111 Prompt for cc in FORWARD command.
2112 If SET TEXT-SCROLL-REGION value too small, ignore the command.
2113 Make SA and SAV valid abbreviations for SAVE (despite invisible
SAVE-OUTGOING-MESSAGES), and remove obsolete, invisible commands
from CREATE-INIT-FILE command set.
2114 Only specify protections for output files if user has explicitly
given SET DEFAULT PROTECTION command; otherwise let O.S. default it.
2115 In REPAIR command, if user types host synonym, look up the real name.
2116 Give warning if CREATE-INIT command is superseding existing init file.
2117 Ignore spaces in usernames in USERS.TXT.
2120 Fix "illegal IFN" crash when COPY or MOVE given after SAVE OUTGOING
with null filespec.
2121 Put copyright notice in EXE file.
2122 Fix illegal memory reads when byte count claims there are more pages
than really exist.
2123 Enlarge USRTAB to 1400.
2124 Move MOVSTx routines to external module because of autopatch hassle.
@
SUBTTL Version and AC definitions
VWHO==0 ; Version # stuff
VMIN==0
VMAJ==10
VEDIT==2124
TOPS10<
TWOSEG ; The better to share you with, my dear
RELOC 400000
>;End TOPS10
; AC's
O=0 ; CAUTION -- Clobbered by all GLXLIB stuff!!
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 - frequently is a character pointer
W=11 ; Ditto
L=12 ; Byte pointer to list of message numbers
M=13 ; Current message if any
F=14 ; Flags
X=15
CX=16 ; Used by macros
P=17
IFN <TF>,<PRINTX ?WARNING -- GLXLIB AC conventions have changed - TF>
IFN <A-S1>,<PRINTX ?WARNING -- GLXLIB AC conventions have changed - S1>
IFN <B-S2>,<PRINTX ?WARNING -- GLXLIB AC conventions have changed - S2>
;Macro to localize literals for TOPS20 to reduce paging... invoke
; after heavy use of literals in any routine.
DEFINE LLIT,<
TOPS10<>
TOPS20< LIT >
>
;*** Temporary until Phil fixes GLXMAC.UNV
TOPS10<.CMTAD==.CMTXT+1>
;*** Temporary until in all monitors
TOPS10<IFNDEF .GTLPN,<.GTLPN==-10>> ; Original logged-in PPN
OPDEF UTYPE [2B8]
OPDEF UETYPE [3B8]
OPDEF UERR [4B8]
OPDEF GTBLT [JSYS 634] ; Not on TOPS-20
OPDEF CALL [PUSHJ P,]
OPDEF CALLRET [JRST]
OPDEF RET [POPJ P,]
DEFINE RETSKP <JRST RSKP>
F%F1==1B0 ; Temporary local flags
F%F2==1B1 ; ..
F%F3==1B2 ; ..
F%AT==1B3 ; @ seen 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%RPIN==1B11 ; Include me in replies
F%CONC==1B12 ; Concise mode
F%RPAL==1B13 ; Reply to all (0 = sender only)
F%VBTY==1B14 ; Verbose-type (all hdrs) flag
F%NSUM==1B15 ; Don't type initial summary line
F%CEOF==1B16 ; Lit by caller of RFLDE to force error return
; instead of invisible unwinding
F%NIPC==1B17 ; New IPCF mailer exists
F%READ==1B35 ; Inside the read command
; ==1B34 ; Obsoleted by edit 1606
F%ARPA==1B33 ; ARPA net present
F%MOD== 1B32 ; Reading system MAIL.TXT
F%AMOD==1B31 ; Auto MOD
F%DECN==1B30 ; DECnet present
F%QDEC==1B29 ; DECNET mail has been queued
F%QARP==1B28 ; ARPANET mail has been queued
F%QXML==1B27 ; XMAILR mail has been queued
F%XMLR==1B26 ; System has XMAILR/HOSTS2 support
F%XMTO==1B25 ; Flag for MOVTO/MOVCC to do XMAILR-style lists
F%HLPT==1B24 ; Preface LPT listings with headers of msgs
F%PRSN==1B23 ; Show personal name only in headers
F%DNNM==1B22 ; Use DECNET node name instead of ARPANET
F%BREF==1B21 ; Brief address-lists (don't display elements)
F%SUFX==1B20 ; Suffix will be needed at end of this expansion
F%XPIP==1B19 ; Expunge in progress
F%JSYS==1B18 ; Next call to TXTOUT should do SOUT, not TSOUT
F%ANFX==F%JSYS ; ANF10 net present (precludes JSYSes)
;Random parameters
TOPS20<
BY2PAG==5000 ; Bytes to a page
WD2PAG==1000 ; Words to a page
>;End TOPS20
TOPS10<
BY2PAG==1200 ; Bytes to a "page" (TOPS10 disk block)
WD2PAG==200 ; Words to a "page" (TOPS10 disk block)
>;End TOPS10
ADRWTH==^D57 ; Maximum line width for address lists
NMSGS==2000 ; Number of messages we can handle
;Flags in 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
NT%SYN==1B31 ; This name is a synonym for some other name
NT%NXL==1B30 ; Don't translate this name in message text
NT%KWL==1B29 ; Kawell mail host (VMS, RSX, RSTS)
NT%IDX==3777B28 ; (index to other name is in bits 18-28)
EOL==37
;Flags in LH of to/cc list entries (TCPAG)
AD%PFX==1B0 ; This entry is a prefix name for a list
AD%SFX==1B1 ; This is a suffix (semicolon) placeholder
AD%DON==1B2 ; This one has been queued (XMAILR only)
SB.LEN==^D25 ; Size of a string block (these are used
; for usernames, keywords, header-item names,
; alias names, and so forth)
;Header-item definitions
;User-defined header items are maintained in a TBLUK-style table.
; The string (pointed to by LH of table entry) is the name of the
; header-item. The right half points to an H-block.
;H-block - contains type, flags, and possible data for header-item
HD.SIZ==0 ; Size of this H-block
HD.FLG==1 ; Flags and type code
HD%OPT==1B18 ; Optional (must use send lvl cmd to include)
HD%PDF==1B19 ; Predefined (wired in)
HD%RQD==1B20 ; Required but not defined (must prompt for it)
HD%PRS==1B21 ; This header-item is present in current msg
HD%TYP==77B35 ; Type code (types defined at GETHDA by HDTYPS macro)
HD.DAT==2 ; Data associated with header-item
;Alias definitions. These are maintined in a TBLUK-style table,
; with the data portion pointing at one or more A-blocks linked together.
;A-block format
AB.COD==0 ; User no. or code, -1 = net addr, -2 = SYSTEM
AB.FLG==1 ; Flag bits
AB%INV==1B0 ; Invisible -- don't show alias in mail
AB.LNK==2 ; Link to next A-block
AB.TXT==3 ; Text of address in this A-block
AB.LEN==SB.LEN+AB.TXT+1 ; Length of A-block
;U-block (TOPS10 only) -- contains structure and PPN for MAIL.TXT
UB.PPN==0 ; PPN
UB.STR==1 ; Structure
UB.LEN==2
;T-block - page of message text. These are linked together and the
; list grows as message text is added.
TB.FOR==0 ; Forward link
TB.BAK==1 ; Backward link
TB.CNT==2 ; Count of bytes in this block
TB.TXT==3 ; First word of text
TXTSIZ==<1000-TB.TXT>*5 ; Number of bytes in a T-block
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 (*** de-implemented ***)
; 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 CMERR,13
DEFERR JRETER,17
DEFERR FATAL,12
DEFERR JFATAL,16
SUBTTL COMND helper macros -- stolen from MACSYM because GLXMAC doesn't have 'em
;Macro to add break character to four word break mask (W0., W1., W2., W3.)
DEFINE BRKCH. (%%V,V2)
<
%%FOO==%%V
BRK0 (%%FOO,V2,0)
>
;Macro to remove character
DEFINE UNBRK. (%%V,V2)
<
%%FOO==%%V
BRK0 (%%FOO,V2,1)
>
DEFINE BRK0 (%%11,V2,FLAVOR)
< ..V22==%%11
..V1==%%11
IFNB <V2>,<..V22==V2>
REPEAT ..V22-<%%11>+1,< ;;BRACKETS AROUND %%11 IN CASE ITS AN EXPRESSION
%%W==..V1/^D32 ;;DECIDE WHICH WORD CHARACTER GOES IN
%%X==..V1-%%W*^D32 ;;CALCULATE BIT POSITION WITHIN WORD
IFE FLAVOR,BRKC1 \"<%%W+"0"> ;;MODIFY CORRECT MASK WORD
IFN FLAVOR,BRKC2 \"<%%W+"0">
..V1==..V1+1
>
>
DEFINE BRKC1 (ARG1)
< W'ARG1'.==W'ARG1'.!<1B<%%X>>
>
DEFINE BRKC2 (ARG1)
< W'ARG1'.==W'ARG1'.&<-1-1B<%%X>>
>
;Macro to initialize 4-word 12-bit character break mask
DEFINE BRINI.(A0<0>,A1<0>,A2<0>,A3<0>)
<
W0.==A0
W1.==A1 ;Initialize break mask
W2.==A2
W3.==A3
>
;macro to define a break set
DEFINE BRMSK. (INI0,INI1,INI2,INI3,ALLOW,DISALW)
< BRINI. INI0,INI1,INI2,INI3 ;;SET UP INITIAL MASK
IRPC ALLOW,< UNBRK. "ALLOW"> ;;DON'T BREAK ON CHARS TO BE ALLOWED IN FIELD
IRPC DISALW,< BRKCH. "DISALW"> ;;BREAK ON CHARACTERS NOT ALLOWED
EXP W0.,W1.,W2.,W3. ;;STORE RESULTANT MASK IN MEMORY
>
;Define break masks
BRINI. ;Initialize break mask for standard field
BRKCH. (0,37) ;All control characters
BRKCH. (40,54) ;Space through comma
BRKCH. (56,57) ;Dot and slash
BRKCH. (72,77) ;Colon through question mark
BRKCH. (100) ;Atsign
BRKCH. (133,140) ;Open bracket through accent grave
BRKCH. (173,177) ;Close bracket through tilde
FLDB0.==W0. ;Standard field break mask
FLDB1.==W1.
FLDB2.==W2.
FLDB3.==W3.
;Macro to generate function data block -- caller supplies POINTER to help text
DEFINE FLDDB1 (TYP,FLGS,DATA,HLPM,DEFM,LST) <
XLIST
..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\]>
LIST
>
; Macro to generate function data block -- caller supplies help text
DEFINE FLDDB. (TYP,FLGS,DATA,HLPM,DEFM,LST) <
XLIST
..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>,<POINT 7,[ASCIZ \HLPM\]>
IFB <HLPM>,<IFNB <DEFM>,<0>>
IFNB <DEFM>,<POINT 7,[ASCIZ \DEFM\]>
LIST
>
;Macro to generate function descriptor block with break mask supplied
DEFINE FLDBK. (TYP,FLGS,DATA,HLPM,DEFM,BRKADR,LST)<
..XX==<FLD(TYP,CM%FNC)>+FLGS+<Z LST>
IFNB <HLPM>,<..XX=CM%HPP!..XX>
IFNB <DEFM>,<..XX=CM%DPP!..XX>
IFNB <BRKADR>,<..XX=CM%BRK!..XX>
..XX
IFNB <DATA>,<DATA>
IFB <DATA>,<0>
IFNB <HLPM>,<POINT 7,[ASCIZ HLPM]>
IFB <HLPM>,<IFNB <DEFM'BRKADR>,<0>>
IFB <DEFM>,<IFNB <BRKADR>,<0>>
IFNB <DEFM>,<POINT 7,[ASCIZ \DEFM\]>
IFNB <BRKADR>,<BRKADR>
>
;Macro to prompt for command
DEFINE PROMPT (MESSAGE) <
XLIST
HRROI A,[ASCIZ MESSAGE]
CALL DPROMPT
LIST
>
;Macro to print guidewords
DEFINE NOISE (SHT) <
XLIST
MOVEI A,[FLDDB. (.CMNOI,,<POINT 7,[ASCIZ /SHT/]>)]
CALL RFIELD
LIST
>
;Macro to require confirmation
DEFINE CONFRM <
XLIST
MOVEI A,[FLDDB. (.CMCFM)]
CALL RFIELD
LIST
>
;Macros to make table entry for TBLUK or COMND .CMKEY style table
DEFINE T (WORD,ADDRES) <
IFB <ADDRES>,< [ASCIZ /WORD/],,.'WORD>
IFNB <ADDRES>,< [ASCIZ /WORD/],,ADDRES>
>
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>) >
>
;Macro to move entries in message tables down over deleted entries.
; Whenever a message table is added, its name must be added to the
; argument list in the invocation of this macro in the expunge code.
DEFINE MXMOV (AC,ZOT) <
XLIST
IRP ZOT,<
MOVE AC,MSG'ZOT(M)
MOVEM AC,MSG'ZOT(X)
>
LIST
>
SUBTTL HOSTS2 Definitions
;HOSTS2 is the Stanford/MIT Host table. It is compiled from text files into
; the format described here. It allows for multiple networks, multiple
; names for a host, and multiple paths to a host. XMAILR is a mailer
; which uses HOSTS2. MS assumes that a system either has XMAILR and
; HOSTS2, or neither.
;The format of the compiled HOSTS2 file is:
HSTSID==0 ; wd 0 SIXBIT /HOSTS2/
NAMPTR==10 ; wd 10 Address in file of NAME table.
SITPTR==11 ; wd 11 Address in file of SITE table.
NETPTR==12 ; wd 12 Address in file of NETWORK table.
;NETWORK table
; wd 0 Number of entries in table.
; wd 1 Number of words per entry. (2)
NETNUM==0 ; wd 0 network number
NTLNAM==1 ; wd 1 LH - address in file of name of network
NTRTAB==1 ; wd 1 RH - address in file of network's address table
;ADDRESS table(s)
; wd 0 Number of entries in table.
; wd 1 Number of words per entry. (2)
ADDADR==0 ; wd 0 Network address of this entry including network number
ADLSIT==1 ; wd 1 LH - address in file of SITE table entry
ADRCDR==1 ; wd 1 RH - address in file of next ADDRESS entry for this site
; 0 = end of list
;SITE table
; wd 0 Number of entries in table.
; wd 1 Number of words per entry. (3)
STLNAM==0 ; wd 0 LH - address in file of official host name
STRADR==0 ; wd 0 RH - address in file of first ADDRESS table entry for
; this site. Successive entries are threaded
; together through ADRCDR.
;NAMES table:
; wd 0 Number of entries
; wd 1 Number of words per entry. (1)
NMLSIT==0 ; lh address in file of SITE table entry for this host.
NMRNAM==0 ; rh address in file of host name
; All names are ASCIZ strings, all letters upper case.
; The strings are stored before, after and between the tables.
; All strings are word-aligned, and fully zero-filled in the last word.
;Network addresses are defined as follows, for purposes of this table:
; 4.9 0
; 4.8-4.1 network number
; Chaos net (number 7):
; 3.9-2.8 0
; 2.7-1.1 address (2.7-1.9 subnet, 1.8-1.1 host)
; Arpanet (number 12): (note, old-format Arpanet addresses
; 3.9-3.8 0 never appear in the host table.)
; 3.7-2.1 IMP
; 1.9 0
; 1.8-1.1 Host
; Dialnet (number 26):
; 3.9-3.1 0
; 2.9-1.1 address in file of ASCIZ string of phone number
SUBTTL Impure storage
TOPS10< RELOC >
ZERMEM: ; Begin clear here
INIP: BLOCK 1 ; Saved P during init file
INIRET: BLOCK 1 ; Where to go when init file exhausted
INIPDL: BLOCK 40 ; Saved stack during init file
OKTINT: BLOCK 1 ; Is it ok for timer to interrupt now?
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
TOPS10<
MSGSTR: BLOCK 1 ; Structure for message file
LKB: BLOCK .RBTIM+1 ; Extended LOOKUP/ENTER block
PBLOCK: BLOCK 10 ; Path block
FILOPB: BLOCK .FOPPN+1 ; FILOP. block
SAVPSZ: BLOCK 1 ; Saved TTY page size
>;End TOPS10
OUTIFN: BLOCK 1 ; Output file IFN
OUTFOB: BLOCK 2 ; Output file FOB size and length
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 2 ; Dispatch to process next message
NXTMSG: BLOCK 1 ; Dispatch to fetch next message
LHOSTN: BLOCK 1 ; Local host number
HLPTXT: BLOCK 1 ; Pointer to text from help file
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)
TOPTRS: BLOCK 1 ; CC,,TO list pointers
FRENAM: BLOCK 1 ; Pointer to free space for names
TOPTR0: BLOCK 1 ; Initial TOPTRS (for default-cc-list)
FRENM0: BLOCK 1 ; Initial FRENAM (ditto)
NAMTB0: BLOCK 1000 ; Initial NAMTAB (ditto)
SV.TOP: BLOCK 1 ; Saved TOPTRS (for reparsing address lists)
SV.FNM: BLOCK 1 ; Saved FRENAM (ditto)
SV.NTB: BLOCK 1000 ; Saved NAMTAB (ditto)
MOVDSP: BLOCK 1 ; Dispatch for typing or setting to, etc
REPLIN: BLOCK ^D50 ; Reply lines (In-reply-to and Reference)
SAVEL: BLOCK 1 ; Saved L (msg sequence pointer)
TTYUDX: BLOCK 1 ; Terminal UDX
LINEW: BLOCK 1 ; Terminal line width
TAKPTN==3*20 ; Length of take IFN stack (FOB size, addr, IFN)
TAKPDL: BLOCK TAKPTN ; Stack for take file IFNs and FOBs
TAKPTR: BLOCK 1 ; Stack pointer
SVMFOB: BLOCK 2 ; Saved messages FOB size and address
SVMIFN: BLOCK 1 ; Saved messages IFN
INIIFN: BLOCK 1 ; IFN of init file being created
LSITE: BLOCK 1 ; Ptr to site entry in HOSTS2 for local host
INIFOB: BLOCK 2 ; FOB size and addr of init file being created
SUBJEC: BLOCK ^D30 ; Subject field
AUTEXP: BLOCK 1 ; Magic number which controls auto-expunges
SVABLK: BLOCK 1 ; Saved A-block for GETUSR
UPDPTR: BLOCK 1 ; Updated byte pointer returned by TORs
UPDX: BLOCK 1 ; Updated X (horizontal position) for TORs
LSCERR: BLOCK 2 ; Last S%CMND error code and addr of CR block
OBPTR: BLOCK 1 ; Output byte pointer (partly replaces AC O)
TXTTOT: BLOCK 1 ; Total bytes in entire chain of text blocks
TXTFPG: BLOCK 1 ; Word address of first text page
MSGID0: BLOCK 1 ; Date/time to compose msg id with
MSGID1: BLOCK 1 ; Job number for same
MSGID2: BLOCK 1 ; PPN or usernumber for same
MSGID3: BLOCK 1 ; Runtime in msec. for same
LDEPTH: BLOCK 1 ; Address list depth
NETSY0: BLOCK 1 ; Number of network host synonyms
NETSYN: BLOCK 100 ; Pointers to real hostnames
MSGADR: BLOCK 1 ; Address of beginning of message file
MSGPAG: BLOCK 1 ; Page of beginning of message file
MSGPGS: BLOCK 1 ; Pages allocated for message file
CNCLHD: BLOCK 1 ; Pointer to TBLUK table of suppressed headers
SCRREG: BLOCK 1 ; Ptr to routine to set scroll region
SCRBTM: BLOCK 1 ; Ptr to routine to undo scroll region and
; go to bottom line of screen
SCRRGR: BLOCK 1 ; Ptr to routine to do the reverse
BLKTIM: BLOCK 1 ; Universal date/time before which clear-screen
; not allowed (error message would vanish)
LFCNT: BLOCK 1 ; Line feed counter
MINWSZ: BLOCK 1 ; Minimum text window size
SCRLFL: BLOCK 1 ; Screen parameters need resetting flag
ABLHED: BLOCK 1 ; OWN storage for ADRLST reparse code
TOPS20<
EDITOR: BLOCK 1 ; -1 = EMACS, 1 = something else
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
TMPTX0: BLOCK 1 ; Storage for editor code
TMPTX1: BLOCK 1 ; *** WARNING: these 2 locs must be adjacent!!
XMFJFN: BLOCK 1 ; XMAILR.FLAGS JFN
DEDJFN: BLOCK 1 ; JFN of dead letter, if any
>;End TOPS20
TOPS10<
GTS.AC: BLOCK 20 ; Even failing GETSEGs clobber ACs!!!
ANFNUM: BLOCK 1 ; Local node number
MYPPN: BLOCK 1
MSIOWD: BLOCK 2 ; IOWD command list
MSGFD: BLOCK FDXSIZ ; FD for message file
USRTBN==^D1400 ; Maximum no. of usernames for TOPS10
USRTAB: BLOCK USRTBN+1 ; TBLUK-style table of names and ptrs to PPNs
ANFNMN==^D200*<<7+4>/5> ; Space for 200. host names of 6 chars each
ANFNAM: BLOCK ANFNMN ; The strings
>;End TOPS10
HLPTB0==^D60 ; Max no. of topics for help command
HLPTAB: BLOCK HLPTB0+1 ; Topic table
REPADD: BLOCK 1 ; Pointer to A-block list for reply-address
PERSNN==^D50 ; maximum length of personal name string
PERSON: BLOCK <PERSNN+4>/5
HDRMAX==^D72 ; Maximum length of a header name
OHSNMX==^D20 ; Max no. headers to exclusively show
OHSN: BLOCK 1 ; Number of only-shown headers
OHSST0: BLOCK <<HDRMAX+8>/5>*OHSNMX ; String space (plus CRLF, colon, null)
OHSSTF: BLOCK 1 ; Free pointer to above
OHSPTR: BLOCK OHSNMX ; length of hdr name,,word addr of name string
;User-defined header-items table
HDITBN==^D100
HDITAB: BLOCK HDITBN+1
;Keyword (alias and address-list) table
KWDTBN==^D100 ; Room for 100 names
KWDTBL: BLOCK KWDTBN
;.JBINT block for trapping ctrl-C on TOPS10
TOPS10<
INTF: BLOCK 1 ; -1 means interrupts not in progress
INTBLK: BLOCK 3
>;End TOPS10
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
FSCACS: BLOCK 20 ; AC's during FSCOPY
NPDL==177 ; Size of PDL
PDL: BLOCK NPDL ; Pushdown list
INTP: BLOCK 1 ; Saved P during interrupt
INTPDL: BLOCK NPDL ; Interrupt 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
CRFDEV: BLOCK 2 ; Created-files device
CRFDIR: BLOCK 10 ; Created-files directory
CRFPRT: BLOCK 2 ; Created-files protection
MSGSEQ: BLOCK <NMSGS/3>+1 ; Table of numbers of messages
SAVSEQ: BLOCK <NMSGS/3>+1 ; Saved table during type cmd under send level
CMDBLN==:<^D80*60>/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
REPAR0: BLOCK 1 ; saved reparse address when inside GETUSR
CMDFRM::BLOCK 1 ;marks bottom of stack
CMDPLN==:200 ;amount of stack we can save
CMDPDL::BLOCK CMDPLN ;room to save PDL
SUBTTL Impure storage inited nonzero
;Storage inited non-zero. Initial values are kept in the hi seg.
; At startup time they are BLT'ed to the low seg. This insures
; that the low seg need never be read from disk (for TOPS10), a big
; performance win.
TOPS10<
NZLOC==. ; Low seg address of nonzero stuff
RELOC ; Hi seg please
NZBEG==. ; Hi seg address of initial values
PHASE NZLOC ; Pretend we're already in low seg
NZCNT==. ; Used to count words allocated
>;End TOPS10
CPYRIT::ASCIZ /COPYRIGHT (C) DIGITAL EQUIPMENT CORPORATION 1982, 1983/
;ENQ block for expunge interlock
; CAUTION -- offsets assumed to be the same on TOPS10 and TOPS20
NQID==12345 ; ENQ ID magic number for expunge interlock
APPQID==23456 ; ENQ ID magic number for append interlock
ENQBLK: 1,,6 ; Number of locks,,length of block
NQID ; Magic number
0 ; Bits,,JFN
POINT 7,[ASCIZ /Mail expunge interlock/] ; Name of lock
0 ; Unused fields
0
TOPS10<
;ENQ block for append interlock -- TOPS10 only
; Needed since TOPS10 screws up if two simultaneous appenders
APPBLK: 1,,6 ; Number of locks,,length of block
APPQID ; Magic number
0 ; Bits, channel number
POINT 7,[ASCIZ /Mail append interlock/]
0
0 ; Unused fields
>;End TOPS10
MYHNAM: ASCII / at /
BLOCK 17 ; ARPANET host name
MYHDEC: ASCII / at /
BLOCK 17 ; DECNET host name
;Trailer added to end of queued mail and saved mail
TRAILR: ASCIZ / --------
/
NTRAIL==^D13 ; Length of trailer (MUST MATCH!!!)
;Keywords acceptable as usernames - SYSTEM is only wired-in one.
KWDTB0: KWDT0N,,KWDTBN
TOPS20<
CMD1 S,SYSCOD,CM%NOR!CM%INV ; Force complete spelling of SYSTEM
CMD1 SY,SYSCOD,CM%NOR!CM%INV
CMD1 SYS,SYSCOD,CM%NOR!CM%INV
CMD1 SYST,SYSCOD,CM%NOR!CM%INV
CMD1 SYSTE,SYSCOD,CM%NOR!CM%INV
CMD SYSTEM,SYSCOD
>;End TOPS20
KWDT0N==.-KWDTB0-1
TOPS20<
;IPCF template
PIDGET: IP%CPD ; Get PID
0
0 ; To INFO
ENDMSG-.,,.+1 ; For INFO
1,,1 ; Get PID for name
0 ; No copy
PIDNAM: ASCIZ /[SYSTEM]MAILEX/
ENDMSG==.
; MAILER definitions
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
>;End TOPS20
;Funny values returned by GETUSR for non-addresses or special addresses
NETCOD==<0,,-1> ; Network address code
SYSCOD==<0,,-2> ; Special system code
PFXCOD==<0,,-3> ; Prefix code (name of address list)
SFXCOD==<0,,-4> ; Suffix code (terminator of address list)
;TEXTI argument block
TTXTIB: 7 ; .RDCWB - count
RD%JFN ; .RDFLG - flags
.PRIIN,,.PRIOU ; .RDIOJ - JFNs
TXTPTR: 0 ; .RDDBP - destination byte pointer
TXTCNT: 0 ; .RDDBC - destination byte count
0 ; .RDBFP - buffer pointer
0 ; .RDRTY - prompt string pointer
TXTMS2 ; .RDBRK - 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)
; Texti break mask for user input
TXTMS2:
TOPS20<
110100001400 ; ^B, ^E, ^K, ^Z, ESC
>
TOPS10<
100100001400 ; same except no ^E
>
000000000000
000000000000
000000000000
; Interrupt storage
TOPS20<
LEVTAB: CTLCPC
ILIPC
PSIPC
CTCCHN==0 ; ^C ON CHAN 0
TMRCHN==5 ; TIMER ON CHAN 5
CHNTAB: 1,,CTLCIN ; 0 - ctrl-C
EXP 0 ; 1
EXP 0 ; 2
EXP 0 ; 3
EXP 0 ; 4
3,,TMRINT ; 5 - timer interrupt
XLIST ; Nothing else
REPEAT ^D30,<EXP 0> ; ..
LIST
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
>;End TOPS20
;Return to low seg and allocate storage for stuff inited nonzero
TOPS10<
NZCNT==.-NZCNT ; Count words allocated
DEPHASE
RELOC ; Low seg please
NZSTG: BLOCK NZCNT ; Make room for the stuff
>;End TOPS10
SUBTTL High segment -- sharable data
TOPS10< RELOC >
;GLXLIB initialization block
IB: EXP 0 ; Default everything except interrupt vectors
TOPS10< EXP IT.OCT!IB.NPF > ; Open controlling terminal, no pfh
TOPS20< EXP 0 >
TOPS20< LEVTAB,,CHNTAB >
TOPS10< EXP 0 >
EXP 0
EXP 0
SIXBIT /MS/ ; Program name
;Help message for host name parsing
HSTHLP: ASCIZ /host name,/
SUBTTL Page allocation
DEFINE DEFPAG (ADDR,LENGTH) <
TOPS20< .PSECT DATAP >
TOPS10< RELOC >
ADDR: IFIDN <LENGTH>,<>,<BLOCK 1000>
IFDIF <LENGTH>,<>,<BLOCK 1000*LENGTH>
TOPS20<
TOPPAG==.
.ENDPS DATAP
>
TOPS10< RELOC >
>
DEFPAG HDRPAG,2 ; Header of msg currently being composed
DEFPAG TCPAG ; TO/CC lists
DEFPAG NAMTAB ; TBLUK format name table
DEFPAG NAMTXT,2 ; Name strings for above lists
DEFPAG HOSTAB,3 ; TBLUK-style host name table
TOPS20<
DEFPAG HSTNAM,3 ; ARPANET host names
DEFPAG FLGPAG ; For MAILER.FLAGS
DEFPAG EDBPAG ; Editor buffer block page
DEFPAG EDPAGE,20 ; Editor pages for data
DEFPAG HSTPAG,15 ; HOSTS2 mapped here
>;End TOPS20
DEFPAG TMPPGS,2 ; Temporary pages
WRTPGS==TMPPGS ; Place to map file for bit updates
USRBLK==TMPPGS ; Place to build user list for MAILER
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 MSGTO, <NMSGS/1000> ; Starting byte of to field
DEFPAG MSGTON,<NMSGS/1000> ; Size of first line of to field
DEFPAG MSGTOK,<NMSGS/1000> ; Size of entire to field
DEFPAG MSGSUB,<NMSGS/1000> ; Starting byte of subject
DEFPAG MSGSUN,<NMSGS/1000> ; Size of subject
DEFPAG MSGMID,<NMSGS/1000> ; Starting byte of message-ID
DEFPAG MSGMIN,<NMSGS/1000> ; Size of message-ID
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
M%VALI==1B0 ; Local bit -- msg info is valid
M%TEMP==1B1 ; Temporary marker bit
;Random macros
DEFINE BP2CHR,< ;; Byte pointer to character pointer
LDB C,[POINT 6,A,5]
MOVEI V,1(A)
IMULI V,5
IDIVI C,7
SUBI V,(C)
>
DEFINE CHR2BP,< ;; Character pointer to byte pointer
MOVE A,V
ADJBP A,[POINT 7,0]
>
SUBTTL COMND support routines
;Here on COMND JSYS error. Let user try again.
MESLN==30
CMDERR::STKVAR <<ERMES,MESLN>>
CALL CLRFIB ; Clear typeahead
CALL CRIF ; Insure that we're at left margin
TOPS20<
$TEXT (KBFTOR,<?MS command error: ^A>)
$CALL K%FLSH
MOVX A,.PRIOU ; Type on terminal
MOVE B,[.FHSLF,,-1] ; Ourself, most recent error
SETZ C,
ERSTR ; Get error string
JFCL
JFCL ; Unexpected errors
MOVE A,[POINT 7,ATMBUF] ; Tell user exactly what COMND didn't like
$TEXT (KBFTOR,<: "^Q/A/">)
>;End TOPS20
TOPS10<
MOVX A,.PRIOU ; Turn echo back on
HRRM A,SBK+.CMIOJ ; ..
MOVE A,[POINT 7,ATMBUF] ; Tell user exactly what lost
$TEXT (KBFTOR,<?MS command error: ^E/[-1]/: "^Q/A/">) ; Type msg
>;End TOPS10
CMDER1: MOVE B,TAKPTR ; Point to top of IFN stack
HRRZ B,(B) ; Current IFN for command input
CAIN B,.PRIIN ; If not TTY, type losing command
JRST CMDER2 ; TTY - user has seen the losing command
MOVE A,[POINT 7,STRBUF] ; Where to put the bad command
MOVE B,[POINT 7,CMDBUF] ; Where to get it from
MOVEI C,<STRBSZ*5>-1 ; Maximum byte count
MOVEI D,15 ; Stop on EOL
CALL TSOUT ; Copy the command
CALL CRIF ; Insure left margin
MOVE A,[POINT 7,STRBUF] ; Point to copy of command
$TEXT (KBFTOR,< in command: ^Q/A/>)
MOVE A,TAKPTR ; Point to command file stack
MOVE A,-1(A) ; Get FOB address for this file
MOVE A,FOB.FD(A) ; Fetch FD address for printing filespec
$TEXT (KBFTOR,< in command file: ^F/(A)/>)
MOVEI A,^D10 ; Ten seconds, please
CALL RDELAY ; Insure user has time to read the message
CMDER2: SOS REPARA ; Modify reparse address so reprompt happens
JRST REPARS
;Place to transfer if user edits previously parsed fields
REPARS: MOVE P,CMDACS+P ; First restore P so we know how much stack to restore
HRLI A,CMDPDL ; Restore stack from saved stack
HRR A,CMDFRM ; Copy to bottom of stack
BLT A,(P) ; Restore the stack
MOVSI 16,CMDACS ; Make BLT pointer
BLT 16,16 ; Restore rest of AC's
JRSTF @REPARA ; Transfer back to just after .CMINI call
;Routine to prompt for new command or new prompt line of command.
; Call this routine with pointer to prompt in A, or 0 if no prompt.
DPROMP::CAIN A,0 ; Any prompt?
HRROI A,[0] ; No, point to a null string
MOVEM A,SBK+.CMRTY ; Save pointer to prompt
MOVE B,TAKPTR ; Is input coming from the terminal?
HRRZ B,(B) ; ..
CAIE B,.PRIIN ; ..
JRST DPROM0 ; No, skip this slow stuff then
$CALL K%FLSH ; Yes, empty terminal output buffers
PUSH P,A ; Save .CMRTY pointer
CALL CLRCTO ; Clear ctrl-O
POP P,A ; And restore .CMRTY pointer
DPROM0: POP P,REPARA ; Remember reparse address
DMOVEM 0,CMDACS+0 ; Save AC's
MOVE 1,[2,,CMDACS+2]
BLT 1,CMDACS+17
HRL A,CMDFRM ; Save from bottom of stack
HRRI A,CMDPDL ; Move data to COMND PDL area
HRRZ B,P ; See where top of stack is now
SUB B,CMDFRM ; Calculate number of words
MOVE C,[IOWD CMDPLN,CMDPDL] ; Get pointer to saved stack
ADJSP C,(B) ; Generate error if too much stack to save
BLT A,CMDPDL(B) ; Save the stack
PUSH P,REPARA ; Make stack like it was
MOVEI A,[FLDDB. .CMINI] ; Type prompt
CALL RFIELD
$CALL M%CLNC ; Clean up core image
RET ; Return to caller
;Read a field routine. Give it address of function block in A.
; JRSTs to CMDERR if error. A, B, and C will have
; result of COMND JSYS in them.
RFIELD::CALL RFLDE ; Read field, skip if success
JRST CMDERR ; Handle failure
RET ; Success
;Routine to read a field and skip IFF successful.
; Return +1: Failure, B contains error code
; +2: Success, B contains data returned by COMND
; For both, A contains address of CR.xxx block built by GLXLIB
; If EOF is encountered on the input stream, F%CEOF is lit.
RFLDE:: MOVE B,A ; Put function block pointer in B
MOVEI A,SBK ; Pointer to state block in A
$CALL S%CMND ; Call GLXLIB routine
DMOVEM A,LSCERR ; Save potential error code and CR blk addr
JUMPF [ HLRZ A,SBK+.CMIOJ ; Get JFN of COMND input
CALL DGTSTS ; See if EOF occurred
TXNN B,GS%EOF ; ..
JRST [ MOVE A,LSCERR ; No, fetch addr of CR block
TXZ F,F%CEOF ; indicate not caused by EOF
RET] ; and give failure return
MOVE T,TAKPTR ; Yes, get IFN stack ptr
POP T,A ; Get IFN of cmd input
CAIN A,.PRIIN ; Better be a file
JCERR (COMND failure) ; Isn't - strange
$CALL F%REL ; OK, release the IFN
POP T,B ; Get FOB info
POP T,A ; ..
CALL RELFOB ; Release FOB storage
MOVE A,(T) ; Point to next IFN
CALL SETIOJ ; Read commands from it
MOVEM T,TAKPTR ; Save updated pointer
TXNE F,F%CEOF ; Caller wish to handle EOF?
RET ; Yes, return then
MOVE A,(T) ; Are we unwinding to TTY:?
CAIE A,.PRIIN ; ..
JRST REPARS ; No, just reparse then
SKIPN A,INIRET ; Init file in progress?
JRST CMDER1 ; No, force prompt and parse again
MOVE P,INIP ; Yes, return to INITF then
JRST (A)] ; ..
MOVEI A,(B) ; Return addr of S%CMND return block in A
MOVE B,CR.FLG(A) ; Get flags returned
TXNE B,CM%NOP ; Did command parse correctly?
JRST [ MOVE B,CR.RES(B) ; No, get result returned
TXZ F,F%CEOF ; Indicate not caused by EOF
RET] ; and give failure return
TOPS10< ; *** TEMPORARY CROCK UNTIL S%CMND FIXED ***
MOVE B,CR.COD(A) ; Get function parsed
CAIE B,.CMKEY ; Keyword?
JRST RFLDE1 ; No, fetch result and return now
HLRZ B,@CR.RES(A) ; Yes, point at potential flags
MOVE B,(B) ; Get possible flags
TLNE B,774000 ; Is this text or flags?
JRST RFLDE1 ; Text, just return result then
TXNN B,CM%FW ; Really flags?
JRST RFLDE1 ; No, weird, just return
TXNN B,CM%ABR ; OK, is this abbreviation?
JRST RFLDE1 ; No, just return the expected result then
HRRZ B,@CR.RES(A) ; Yes, point to real entry then
JRST RSKP ; and give OK return
>;End TOPS10 ;*** END OF CROCK ***
RFLDE1: MOVE B,CR.RES(A) ; Get result from S%CMND block
RSKP: AOS 0(P)
R: RET
;Read a field and require carriage return after it for confirmation
CFIELD::CALL RFIELD ; Read the field
PUSH P,A ; CONFRM wipes these
PUSH P,B
CONFRM ; Get confirmation
POP P,B
POP P,A
RET ; Return to caller
;COMND JSYS initialization routine. Call only once at start of program.
; Always call this routine at a less-than-or-equally nested location
; within the program in comparison with any subsequent call to the COMND
; JSYS execution routines.
CMDINI::MOVEI A,REPARS ; Reparse address
MOVEM A,SBK+.CMFLG
MOVE T,TAKPTR ; Point to current input IFN
MOVE A,(T) ; Get the IFN from the stack
CALL SETIOJ ; Set up COMND and TEXTI blocks
HRROI A,CMDBUF ; Pointer to command buffer
MOVEM A,SBK+.CMBFP
MOVEM A,SBK+.CMPTR ; Pointer to next field
MOVEI A,CMDBLN*5 ; Room for typin
MOVEM A,SBK+.CMCNT
SETZM SBK+.CMINC ; No unparsed characters yet
HRROI A,ATMBUF ; Pointer to atom buffer
MOVEM A,SBK+.CMABP
MOVEI A,ATMBLN*5
MOVEM A,SBK+.CMABC ; Room in atom buffer
MOVEI A,CJFNBK ; Pointer to JFN block
MOVEM A,SBK+.CMGJB
MOVEM P,CMDFRM ; Remember beginning of stack
RET
LLIT
SUBTTL Operating-system-specific code
; Clear typeahead for terminal
CLRFIB:
TOPS20<
MOVEI A,.PRIIN ; Clear input buffer of type ahead
CFIBF
>;End TOPS20
TOPS10<
CLRBFI
>;End TOPS10
RET
;Set page size for scrolling, page size in A
SETPSZ:
TOPS20<
MOVE B,SAVMOD ; Original TTY modes
DPB A,[POINT 7,B,10] ; New page size
MOVX A,.PRIOU
STPAR
RET
>;End TOPS20
TOPS10<
PUSH P,A ; Sigh... since TOPS10 TTY I/O is
$CALL K%FLSH ; asynchronous with respect to the user,
$CALL K%TPOS ; we must flush buffers and wait for
POP P,A ; output to finish before changing anything.
MOVX B,.TOSET+.TOPSZ ; Set TTY PAGE size
MOVE C,TTYUDX
MOVE D,A ; Size
MOVE A,[3,,B]
TRMOP. A,
JFCL
MOVX B,.TOSET+.TOPCT ; On TOPS10 must also reset line counter
MOVE C,TTYUDX ; ..
SETZ D, ; to zero (top of page)
MOVE A,[3,,B]
TRMOP. A,
JFCL
RET
>;End TOPS10
;Restore TTY page size
RSTPSZ:
TOPS20<
MOVX A,.PRIOU
MOVE B,SAVMOD ; Original RFMOD word
STPAR
RET
>;End TOPS20
TOPS10<
MOVE A,SAVPSZ ; Get saved page size
CALLRET SETPSZ ; Restore it, set line counter, and return
>;End TOPS10
;Simulate GTSTS to see if EOF occurred on JFN of command input
TOPS10< GS%EOF==IO.EOF >
DGTSTS:
TOPS20<
GTSTS ; This is easy on TOPS20
RET
>;End TOPS20
TOPS10<
SETZ B, ; Clear bits
MOVE A,LSCERR ; Get last S%CMND error
CAIN A,EREOF$ ; EOF happened?
TXO B,GS%EOF ; Yes, light the bit
RET
;Turn S%CMND echoing back on in case monitor command
ECHOON: MOVX A,.PRIOU
HRRM A,SBK+.CMIOJ
RET
>;End TOPS10
;Clear ctrl-O
CLRCTO:
TOPS20<
MOVX A,.PRIOU ; Get current TTY modes
RFMOD
TXZ B,TT%OSP ; Clear ctrl-O bit
SFMOD
RET
>;End TOPS20
TOPS10<
MOVE A,[3,,B]
MOVX B,.TOSET+.TOOSU ; Clear ctrl-O function
MOVE C,TTYUDX
SETZ D,
TRMOP. A,
JFCL
RET
>;End TOPS10
SUBTTL Dummy routines for the dummy operating system
TOPS10<
XMAILR: WARN (XMAILR called)
RET
SNDNET: WARN (SNDNET called)
RET
MAIFLG: WARN (MAIFLG called)
RET
SETREF: ;WARN (SETREF called)
RET
>;End TOPS10
SUBTTL Main program
TOPS20<
EV: JRST GO
JRST GO1 ; Do message of the day auto function
VERSN.: BYTE (3) VWHO (9) VMAJ (6) VMIN (18) VEDIT
>;End TOPS20
TOPS10<
LOC 137
VERSN.: BYTE (3) VWHO (9) VMAJ (6) VMIN (18) VEDIT
RELOC
>;End TOPS10
GO: SETZ F, ; Clear flags
GO0: MOVE P,[IOWD NPDL,PDL]
RESET
TOPS20<
MOVEI A,<<TOPPAG+777>/1000>*1000
MOVEM A,.JBFF## ; Protect our pages from GLXMEM
MOVE A,[SIXBIT /MS/]
MOVE B,[SIXBIT /MS/]
SETSN ; Cause monitor to keep statistics on use
JFCL
SETOM EDFORK ; No editor fork yet
SETOM EXECFK ; or EXEC fork
SETZM PIDGET+1 ; No PID yet
>;End TOPS20
MOVEI A,IB.SZ ; Size of init block
MOVEI B,IB ; Addr of same
$CALL I%INIT
JUMPF [FATAL (Can't initialize GLXLIB)]
MOVE A,[ZERMEM,,ZERMEM+1]
SETZM ZERMEM
BLT A,ZEREND ; Clear out data-base
SETZM CRFPRT ; Zap default protection
TOPS10<
MOVE A,[NZBEG,,NZSTG] ; Init nonzero low seg storage
BLT A,NZSTG+NZCNT-1 ; ..
>;End TOPS10
SETZM HOSTAB ; Empty host name table
MOVE A,[CALL UUOH] ; Setup uuo handler call
MOVEM A,.JB41##
MOVEI A,HDITBN ; Empty HDITAB
MOVEM A,HDITAB ; ..
MOVE A,[KWDTB0,,KWDTBL] ; Init KWDTBL
BLT A,KWDTBL+KWDT0N ; ..
MOVEI A,[RET] ; Dummy routine
MOVEM A,SCRREG ; for non-video terminals
MOVEM A,SCRRGR ; ..
MOVEM A,SCRBTM ; ..
SETZM MINWSZ ; Default to no fancy scrolling stuff
MOVE T,[IOWD TAKPTN,TAKPDL]
MOVEM T,TAKPTR ; Init take IFN stack pointer
MOVEI A,.PRIIN ; Start getting cmds from primary input
PUSH T,A ; Shove it on the stack
MOVEM T,TAKPTR ; ..
CALL INIT ; Init interrupts and O.S.-specific stuff
CALL TTINI ; Init terminal parameters
TOPS10< CALL USRINI > ; Init username table from SYS:USERS.TXT
CALL CMDINI ; Init command parser
CALL ZAPTCC ; Zap to and cc list defaults
MOVEI A,2 ; Default for auto-expunge is exit-command-only
MOVEM A,AUTEXP ; Setup magic number
TXNE F,F%AMOD ; Auto MOD hack?
CITYPE <[Checking for new system messages...]
>
CALL NAMINI ; Get info about possible networks
CALL INITF ; Parse init file
TXNE F,F%AMOD ; Auto mod feature?
JRST MSGOD0 ; Yes - enuf init for now
; JRST GO3 ; No, check for rescanned command
; Check to see if command on line which invoked us
GO3:
TOPS20<
SETZ A,
RSCAN ; check for command
ERJMP GO2 ; None
JUMPE A,GO2 ; If char count zero, no cmd
>;End TOPS20
TOPS10<
RESCAN 1 ; See if anything there
SKIPA ; Could be...
JRST GO2 ; Nothing, skip all this
MOVX A,.NULIO ; Turn off GLXLIB echoing so users
HRRM A,SBK+.CMIOJ ; don't see command twice
>;End TOPS10
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,,<[1,,1
[ASCIZ /MS/],,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 [ TXO F,F%RSCN ; mark as exec command
PUSH P,[CMDRES] ; Dummy return in case EOF on cmd input
MOVEM P,CMDACS+P ; insure stack doesn't disappear
JRST CMDLLP] ; and try command parse
; ..
; ..
GO2:
TOPS20<
HRROI A,[0] ; Clear rescan
RSCAN
ERJMP .+1
>;End TOPS20
TOPS10<
MOVX A,.PRIOU ; Turn echoing back on
HRRM A,SBK+.CMIOJ ; ..
>;End TOPS10
SKIPG MSGJFN ; Already have message file?
CALL GETFIL ; No, get and parse one
SKIPG MSGJFN ; Have we found something?
JRST CMDRES ; No - message already printed
CALL RECENT ; Show data on recent messages
TXNN F,F%NSUM ; "Set no type-initial-summary"?
CALL SUMMRY ; No, type 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: CALL CLRFIB ; Clear typeahead
JRST CKEXIT ; Just quit
SUBTTL INIT - init operating-system-dependent stuff
TOPS20<
INIT: MOVEI A,.FHSLF ; Setup interrupt stuff
RPCAP
TRZ B,-1 ; Only enable LH caps
IOR C,B
EPCAP ; ...
TXNE F,F%AMOD ; Unless doing auto MOD hack,
JRST INIT0 ; in which case skip it for speed,
CALL INTINI ; init interrupt system
INIT0: 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
INTINI: MOVX A,.FHSLF
EIR
MOVX B,1B<TMRCHN>!1B<.ICILI> ; Timer and ill inst channels
AIC
CALLRET SETTIM ; Set up timer interrupt
>;End TOPS20
TOPS10<
INIT: MOVE A,[-1,,.GTLPN] ; Get original logged-in PPN
GETTAB A, ; ..
SKIPA A,[-1,,.GTPPN] ; Hmmm... must be non-TSG monitor
JRST INIT0 ; OK, this one worked
GETTAB A, ; Use normal PPN then
FATAL (Can't discover my PPN)
INIT0: MOVEM A,MYPPN ; Save it
MOVX A,%LDSTP ; Get standard file protection
GETTAB A, ; ..
MOVSI A,057000 ; Hmmm...
LSH A,-^D27 ; Why this UUO returns it here is beyond me...
MOVEM A,CRFPRT ; Save as default
MOVE A,[3,,XPNCTC] ; Point to ctrl-C routine
MOVX B,ER.ICC ; Bit to specify ctrl-C
DMOVEM A,INTBLK ; Set it up
SETZM INTBLK+2 ; Clear new PC
SETOM INTF ; Flag that interrupts are OK
MOVEI A,INTBLK ; Turn on the interrupt
MOVEM A,.JBINT ; ..
; CALLRET EATCHN ; Eat channel zero and return
EATCHN: $CALL F%FCHN ; Eat channel zero so MSGJFN nonzero
JUMPF R ; means that a message file exists
JUMPN A,R ; Nonzero channel returened? All done then...
OPEN [ EXP .IODMP ; Eat a disk DDB
SIXBIT /DSK/
EXP 0]
JFCL ; Who cares?
RET
>;End TOPS10
;TTINI - Init terminal parameters, called at startup and by
; SET VIDEO-MODE command
TOPS20<
TTINI: MOVEI A,.CTTRM
GTTYP
SETZ C,
CAIN B,.TTV52 ; VT52?
HRROI C,[BYTE (7)33,"H",33,"J",0]
CAIN B,.TT100
JRST [ HRROI C,[BYTE (7)33,"[","H",33,"[","J",0]
MOVEI A,SREGV1 ; Init ptrs to terminal-dependent rtns
MOVEM A,SCRREG
MOVEI A,SRGRV1
MOVEM A,SCRRGR
MOVEI A,SBTMV1
MOVEM A,SCRBTM
JRST .+1]
CAIN B,.TTV05 ; VT05
HRROI C,[BYTE (7)35,177,177,177,177,37,177,177,177,177,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)
RET
>;End TOPS20
;TTINI - TOPS10 version
TOPS10<
TTINI: MOVNI C,1 ; Get UDX of controlling TTY
TRMNO. C, ; ..
FATAL (Can't get UDX for controlling TTY)
MOVEM C,TTYUDX ; Save for later
MOVE A,[2,,B] ; Get page size
MOVX B,.TOPSZ ; ..
TRMOP. A,
FATAL <Can't get terminal's page size>
MOVEM A,SAVPSZ ; Save for later
MOVE A,[2,,B] ; Arg block for TRMOP. in B and C
MOVX B,.TOWID ; Get line width of terminal
TRMOP. A, ; ..
FATAL (Can't get terminal's line width)
MOVEM A,LINEW ; Save it
MOVE A,[2,,B] ; Arg block again
MOVX B,.TOTRM ; Get TTY type
TRMOP. A, ; Get type
JFCL
SETZ B, ; Assume not fancy terminal
CAME A,[SIXBIT /VT61/]
CAMN A,[SIXBIT /VT52/]
MOVE B,[POINT 7,[BYTE (7)33,"H",33,"J",0]]
CAME A,[SIXBIT /VT101/] ; These are equivalent to VT100
CAMN A,[SIXBIT /VT102/] ; for our purposes
SKIPA
CAMN A,[SIXBIT /VT100/] ; Get appropriate clear-screen sequence
JRST [ MOVE B,[POINT 7,[BYTE (7)33,"[","H",33,"[","J",0]]
MOVEI C,SREGV1 ; Init ptrs to terminal-dependent rtns
MOVEM C,SCRREG
MOVEI C,SRGRV1
MOVEM C,SCRRGR
MOVEI C,SBTMV1
MOVEM C,SCRBTM
JRST .+1]
CAMN A,[SIXBIT /VT05/]
MOVE B,[POINT 7,[BYTE (7)35,177,177,177,177,37,177,177,177,177,0]]
MOVEM B,V52FLG ; Save for BLANK command
RET
>;End TOPS10
SUBTTL Interrupt routines
;Illegal instruction trap
TOPS20<
ILITRP: CIS
JCERR <Illegal instruction trap>
>;End TOPS20
;^C interrupt
CTLCIN:
TOPS20<
$BGINT (1)
WARN <Control-C intercepted, type "EXIT" to logout>
$DEBRK
>
TOPS10<
CALLRET .EXIT ; Just quit
>
; Timer interrupt
TOPS20<
TMRINT: $BGINT (3) ; Level 2
MOVEM P,INTP ; Save pointer to excessively tiny stack
MOVE P,[IOWD NPDL,INTPDL] ; Get pointer to more reasonable stack
SKIPE OKTINT ; OK for timer at this time?
CALL TMRIN1 ; Yes, check for new messages
TMRIN2: CALL SETTIM ; Set next timer up
MOVE P,INTP ; Restore stunted GLXLIB stack
$DEBRK ; Dismiss the interrupt
TMRIN1: CALL CHECK0 ; Check for new guys
RET ; None, return now
CALLRET CHECKS ; Print message on new guys and return
SETTIM: MOVE A,[.FHSLF,,.TIMEL] ; Elapsed time
MOVX B,^D5*^D60*^D1000 ; 5 mins
MOVEI C,5 ; Chan 5
TIMER
JFCL
RET
>;End TOPS20
LLIT
CMDRES: MOVE P,[IOWD NPDL,PDL]
PUSH P,[CMDRES] ; Dummy return in case EOF on .PRIOU
CALL CMDINI ; Init command parser
CMDLUP: MOVE T,TAKPTR ; See if inside command file
HRRZ A,(T) ; Get current COMND input IFN
CAIE A,.PRIIN ; Command file or TTY?
JRST CMDLP0 ; file...
TXZE F,F%RSCN ; Exec command?
JRST [ MOVE A,AUTEXP ; Yes, auto-expunge always?
CAIE A,1 ; ..
JRST .EXIT1 ; No, just close file and quit
SKIPLE MSGJFN ; If we have a message file,
CALL EXPUNG ; Expunge it
JRST .EXIT1] ; Now close file and quit
CMDLP0: SKIPE INIIFN ; Creating init file?
JRST [ PROMPT (MS Create-init>>)
JRST CMDLLP] ; Yes, different prompt
PROMPT (MS>)
HRRZ A,(T) ; Get current COMND input IFN
CAIE A,.PRIIN ; File or TTY?
JRST CMDLLP ; File, DON'T call slow routines like CHECK0!
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)]
SKIPE INIIFN ; Creating defaults file (init file)?
MOVEI A,[FLDDB. (.CMKEY,,CINTAB)] ; Yes, choose cmd subset
SETOM OKTINT ; OK for timer interrupt here
TXZ F,F%VBTY ; Default is not verbose-type
CALL RFIELD ; Read command
SETZM OKTINT ; No more though
HRRZ B,(B) ; Get entry
MOVE B,(B) ; addr of routine
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
HRRZ A,0(P) ; Command dispatch address
CALL (A) ; Do the command
POP P,A ; Restore dispatch word
HRRZS A ; Only check significant part
CAIE A,.TAKE ; Take command?
CAIN A,.CREAT ; or create-init command?
JRST CMDLUP ; Yes, don't put it into init file!
CAIN A,.HELP ; Also don't put help into init file
JRST CMDLUP ; ..
MOVE C,[POINT 7,CMDBUF] ; Point to cmd in case it needs writing
SKIPE A,INIIFN ; Creating init file?
JRST [ ILDB B,C ; Yes, get next byte
JUMPE B,CMDLUP ; Done, fetch next cmd
$CALL F%OBYT ; Write to init file
JRST .-1] ; Repeat for all bytes in cmd
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
LLIT
SUBTTL Command tables
;Caution -- the CMD1 macro generates a reference to a label formed by
; preceding the command name with a dot. This does not work, however, for
; command names containing hyphens. For these commands, the CMDT macro,
; which requires an explicit label, must be used.
; 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)
CMDT (Create-init-file,.CREAT)
CMD1 (D,ENTDEL,CM%ABR!CM%INV)
CMDT (Daytime,,CM%INV)
CMDT (Define)
ENTDEL: CMDT (Delete,,,C%GETF)
CMDT (Echo)
TOPS20< CMDT (EMACS,.EDITOR) >
CMD1 (Ex,ENTXIT,CM%ABR!CM%INV)
ENTXIT: CMDT (Exit)
CMDT (Expunge,,,C%GETF)
CMDT (File)
CMDT (Flag,,,C%GETF)
CMDT (Forward,,,C%GETF)
CMDT (Get)
CMD1 (H,ENTHDR,CM%ABR!CM%INV)
ENTHDR: CMDT (Headers,,CM%INV,C%GETF)
CMDT (Help)
CMDT (List,,CM%INV,C%GETF)
CMDT (Mark,,,C%GETF)
CMDT (Move,,,C%GETF)
CMD1 (N,ENTNXT,CM%ABR!CM%INV)
TOPS20< CMDT (Net-mail,.MAILR) >
ENTNXT: CMDT (Next,,,C%GETF)
CMDT (Print,.LIST)
TOPS20< CMDT (Push) >
CMDT (Quit)
CMD1 (R,ENTRED,CM%ABR!CM%INV)
ENTRED: CMDT (Read,,,C%GETF)
CMD1 (Rep,ENTRP1,CM%ABR!CM%INV)
TOPS20< CMDT (Repair) >
ENTRP1: CMDT (Reply,,,C%GETF)
CMDT (Retrieve)
CMD1 (S,ENTSND,CM%ABR!CM%INV)
CMD1 (Sa,ENTSAV,CM%ABR!CM%INV)
CMD1 (Sav,ENTSAV,CM%ABR!CM%INV)
ENTSAV: CMDT (Save,.SAVTL)
CMDT (Save-outgoing-messages,.SAVMS,CM%INV)
ENTSND: CMDT (Send)
CMDT (Set)
CMDT (Show)
CMDT (Status,,CM%INV,C%GETF)
CMDT (Summarize,.HEADE,,C%GETF)
TOPS20< CMDT (System-messages,.MSGOD) >
CMD1 (T,ENTTYP,CM%ABR!CM%INV)
CMDT (Take)
ENTTYP: CMDT (Type,,,C%GETF)
CMDT (Undelete,,,C%GETF)
CMDT (Unflag,,,C%GETF)
CMDT (Unmark,,,C%GETF)
CMDT (Verbose-type,,,C%GETF)
NCMDS==.-CMDTAB-1
;Commands available in create-init mode
CINTAB: NINCMD,,NINCMD
CMDT (Blank)
CMDT (Check,,,C%GETF)
CMD1 (D,ENIDEL,CM%ABR!CM%INV)
CMDT (Define)
ENIDEL: CMDT (Delete,,,C%GETF)
CMDT (Echo)
TOPS20< CMDT (Editor) >
CMDT (Expunge,,,C%GETF)
CMDT (Finish)
CMDT (Flag,,,C%GETF)
CMDT (Get)
CMDT (Mark,,,C%GETF)
CMD1 (N,ENINXT,CM%ABR!CM%INV)
TOPS20< CMDT (Net-mail,.MAILR) >
ENINXT: CMDT (Next,,,C%GETF)
CMDT (Print,.LIST)
TOPS20< CMDT (Push) >
CMDT (Quit,.QUINI)
CMD1 (R,ENIRED,CM%ABR!CM%INV)
ENIRED: CMDT (Read,,,C%GETF)
CMD1 (Rep,ENIRP1,CM%ABR!CM%INV)
ENIRP1: CMDT (Reply,,,C%GETF)
CMDT (Save,.SAVTL)
CMDT (Set)
CMDT (Show)
CMDT (Summarize,.HEADE,,C%GETF)
TOPS20< CMDT (System-messages,.MSGOD) >
CMD1 (T,ENITYP,CM%ABR!CM%INV)
CMDT (Take)
ENITYP: CMDT (Type,,,C%GETF)
CMDT (Undelete,,,C%GETF)
CMDT (Unflag,,,C%GETF)
CMDT (Unmark,,,C%GETF)
CMDT (Verbose-type,,,C%GETF)
NINCMD==.-CINTAB-1
; Read commands
RCMDTB: NRCMDS,,NRCMDS
CMD (Answer,.RRPL1)
CMD (Backup,.RBACK) ; Synonym for "previous"
CMD (Blank)
CMD (Copy,.PUT)
CMD1 (D,ENTRDL,CM%ABR!CM%INV)
CMD (Daytime,,CM%INV)
CMD (Define)
ENTRDL: CMD (Delete,.RDELM)
CMD (Echo)
TOPS20< CMD (EMACS,.EDITO) >
CMD (Exit,.REXIT)
CMD (File)
CMD (Flag,.RFLAG)
CMD (Forward)
CMD1 (H,ENTRHD,CM%ABR!CM%INV)
ENTRHD: CMD (Header,.RHEAD,CM%INV)
CMD (Help)
CMD (List,,CM%INV)
CMD (Mark,.RMARK)
CMD (Move)
TOPS20< CMD (Net-mail,.MAILR) >
CMD (Next,.RNEXT)
CMD (Previous,.RPREV)
CMD (Print,.LIST)
TOPS20< CMD (Push) >
CMD (Quit,.RQUIT)
CMD1 (R,ENTREP,CM%ABR!CM%INV)
CMD (Read,.RTYPE)
CMD1 (Rep,ENTREP,CM%ABR!CM%INV) ; I like to type "rep" for reply
TOPS20< CMD (Repair) >
ENTREP: CMD1 (Reply,.RREPL)
CMD (Retrieve)
CMD (Set)
CMD (Show)
CMD (Status,,CM%INV)
CMD (Summarize,.RHEAD)
CMD (Take)
CMD (Type,.RTYPE)
CMD (Undelete,.RUDLM)
CMD (Unflag,.RUFLG)
CMD (Unmark,.RUNMK)
CMD (Verbose-type,.RVBTY)
NRCMDS==.-RCMDTB-1
; Send (and reply) commands
SCMDTB: NSCMDS,,NSCMDS
CMD Blank
CMD Cc
CMD1 (D,ENTSDI,CM%ABR!CM%INV)
CMD Daytime,,CM%INV
CMD Define
ENTSDI: CMD Display
CMD Echo
TOPS20< CMD Edit,.SEDIT >
CMD Erase
CMD Exit
CMD Help
CMD Include
CMD Insert
TOPS20< CMD Push >
CMD Quit,.SQUIT
CMD Remove,.UNTO
CMD1 (S,ENTSSN,CM%ABR!CM%INV)
CMD Save
ENTSSN: CMD Send,.SSEND
CMD Set
CMD Show
CMD Status,,CM%INV
CMD Subject
CMD Take
CMD Text
CMD To
CMD Type,.STYPE
CMD (Verbose-type,.VSTYP)
NSCMDS==.-SCMDTB-1
ECMDTB: NECMDS,,NECMDS
CMD All,.ERSAL
CMD Cc,.ERSCC
CMD Header-item,.ERSHD
CMD Reply-information,.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
TOPS20< CMD Text,.EDTXT >
; CMD To,.EDTO
NEDCMS==.-EDCMTB-1
RPCMTB: NRPCMS,,NRPCMS ; REPLY commands
CMD All,.REPAL
CMD Sender-only,.REPTO
NRPCMS==.-RPCMTB-1
;Show commands
SHCMTB: NSHCMT,,NSHCMT
CMD (Address-lists,.SHADL)
CMD (Aliases,.SHSYN)
CMD (Daytime)
CMD (Defaults,.SHDEF)
CMD (Header-items,.SHHDI)
CMD (Status,.STATU)
CMD (Version)
NSHCMT==.-SHCMTB-1
;SET commands
STCMTB: NSTCMD,,NSTCMD
CMD Auto-expunge,.STAUT
CMD Brief-address-list-display,.STBFD
CMD Concise-mode,.STCNC
CMD Default,.STDFT
CMD Headers-on-printer-output,.STHLP,CM%INV
CMD Headers-personal-name-only,.STHPR,CM%INV
CMD Include-me-in-replies,.STINC
TOPS20< CMD Logout-on-exit,.LOGOU >
CMD1 (Minimum-text-window-size,.STWSZ,CM%INV) ; Invisible because obsolete
CMD No,.STNO
CMD Only-headers-shown,.STOHS
CMD Personal-name,.STPNM
CMD Reply-address,.STRAD
CMD Reply-to,.STRAD ; Synonym
CMD Summary-on-printer-output,.STHLP
CMD Summary-personal-name-only,.STHPR
CMD Suppressed-headers,.STSPH
CMD Text-scroll-region,.STWSZ
CMD Type-initial-summary,.STSUM
CMD Video-mode,.STVID
NSTCMD==.-STCMTB-1
STCMT0: NSTCM0,,NSTCM0 ; SET commands which can be negated
CMD Brief-address-list-display,.STBFD
CMD Concise-mode,.STCNC
CMD Headers-on-printer-output,.STHLP,CM%INV
CMD Headers-personal-name-only,.STHPR,CM%INV
CMD Include-me-in-replies,.STINC
CMD Personal-name,.STPNM
CMD Reply-address,.STRAD
CMD Reply-to,.STRAD ; Synonym
CMD Summary-on-printer-output,.STHLP
CMD Summary-personal-name-only,.STHPR
CMD Suppressed-headers,.STSPH
CMD Text-scroll-region,.STWSZ
CMD Type-initial-summary,.STSUM
CMD Video-mode,.STVID
NSTCM0==.-STCMT0-1
;Set default
DFCMTB: NDFCM0,,NDFCM0
CMD Cc-list,.STDCC
CMD Directory,.STCDI
TOPS20< CMD Protection,.STCPR >
CMD Reply-to-all,.STRPA
CMD Reply-to-sender-only,.STRPS
NDFCM0==.-DFCMTB-1
;Keyword table for set default directory
TOPS20<
CRFDTB: CRFDT0,,CRFDT0
CMD Connected-directory,.STCND
CMD Logged-in-directory,.STLGD
CRFDT0==.-CRFDTB-1
>;End TOPS20
;Keyword table for set auto-expunge (on)
AUTCMT: AUTCM0,,AUTCM0
CMD Any-exit,1 ; Magic numbers
CMD Exit-command-only,2 ; Default
CMD Never,3
AUTCM0==.-AUTCMT-1
;Keyword table for define commands
DFNCTB: DFNCT0,,DFNCT0
CMD Address-list,.DEFSS
CMD Alias,.DEFAS
CMD Header-item,.DFHDI
DFNCT0==.-DFNCTB-1
;Keyword table for define header-item
HTYP0T: HTYP00,,HTYP00
CMD Optional,HD%OPT
CMD Predefined,HD%PDF
CMD Required,HD%RQD
HTYP00==.-HTYP0T-1
;Save command, top level
SVTLTB: SVTLT0,,SVTLT0
CMD (Outgoing-messages,.SAVMS)
SVTLT0==.-SVTLTB-1
;Save command, send level
SVCMTB: SVCMT0,,SVCMT0
CMD (Draft,.SAVDF)
CMD (Outgoing-messages,.SAVMS)
SVCMT0==.-SVCMTB-1
;Retrieve commands
RETRCM: RETRC0,,RETRC0
CMD (Draft,.RESDF)
CMD (Last-message,.RECOV)
RETRC0==.-RETRCM-1
;Switches for SYSTEM:DECNET-HOSTS.TXT
SWTTAB: SWTTB0,,SWTTB0
CMD (NOMAIL20,NT%KWL)
SWTTB0==.-SWTTAB-1
SUBTTL Help command for structured help file
;First word on each page of help file is topic name
.HELP: NOISE (with topic)
HLRZ A,HLPTAB ; Do we have a help table yet?
SKIPN A ; ..
CALL HLPINI ; No, get one then
MOVEI A,[FLDDB. (.CMCFM,,,,,[FLDDB. (.CMKEY,,HLPTAB)])]
CALL RFIELD ; Go to it
MOVE A,CR.COD(A) ; Get function parsed
CAIN A,.CMCFM ; Just CR typed?
JRST [ $TEXT (KBFTOR,<
Type "help topic" to get help with a particular topic. Type
"help ?" to get a list of all the topics for which help is available.
If this is the first time you have used MS, type "help introduction".
>)
RET]
HRRZ C,(B) ; Get character address of topic
CONFRM
MOVE A,HLPTXT ; Point to first byte
ADJBP C,A ; Point to topic
.HELP0: ILDB A,C ; Get next byte
SKIPE A ; Last byte?
CAIN A,14 ; or form feed?
CALLRET CRLF ; Yes, crlf and quit
$CALL KBFTOR ; No, type this char
JRST .HELP0 ; and go for next
;Parse help file -- adds each topic name to TBLUK-style table
; Each page of the help file starts with the topic name
HLPINI: ACVAR <HPTR,LOC> ; Ptr to help text, loc of topic name
STKVAR <HLPST0> ; Beginning addr of copy of topic name
MOVEI A,HLPTB0 ; Max size of help topic table
MOVEM A,HLPTAB ; Init table
CALL GETHLP ; Read help file
MOVE HPTR,HLPTXT ; Point to it
SETZB D,LOC ; First topic is at byte zero
JRST HLPIN3 ; Go find first topic name
;Here with HPTR pointing to first byte of a topic name
HLPIN4: MOVEI A,SB.LEN ; Allocate space for next topic name
$CALL M%GMEM ; ..
JUMPF [ WARN (Can't build help tables -- insufficient memory)
RET]
MOVEM B,HLPST0 ; Remember this address
HRLI B,(POINT 7,) ; Byte ptr to it
MOVEI C,<SB.LEN*5>-1 ; Maximum bytes in a string
HLPIN0: ILDB A,HPTR ; Get next byte of topic name
JUMPE A,R ; Null -- end of help text
ADDI D,1 ; Count chars
CAIE A,15 ; Anything funny terminates it
CAIN A,12
JRST HLPIN1 ; Count chars
CAIE A,11 ; Tab
CAIN A,40 ; Space
JRST HLPIN1
IDPB A,B ; Nonfunny - store char
SOJLE C,[MOVE A,HLPST0 ; Name too long -- point to fragment
HRLI A,(POINT 7,) ; for error message
WARN (Topic name too long -- %1S)
JRST HLPIN1] ; Just truncate the name
JRST HLPIN0 ; Go get next char
HLPIN1: SETZ A, ; Insure ASCIZ
IDPB A,B ; ..
HRLZ B,HLPST0 ; Get string addr of topic name in LH
HRR B,LOC ; Put char addr of this topic in RH
MOVEI A,HLPTAB ; Addr of TBLUK table
$CALL S%TBAD ; Add to table
JUMPF [ WARN (Problem building help topic table, table probably full)
CALL CRLF
JRST .+1]
HLPIN2: ILDB A,HPTR ; Next char of help text
JUMPE A,R ; Null -- end of help file
ADDI D,1 ; Count chars
CAIE A,14 ; Look for form feed
JRST HLPIN2 ; Not yet
HLPIN3: ILDB A,HPTR ; Skip to first non-white-space char
JUMPE A,R ; Null means end of help text
CAIE A,15 ; ..
CAIN A,12 ; ..
AOJA D,HLPIN3 ; Count chars
CAIE A,40 ; Space
CAIN A,11 ; Tab
AOJA D,HLPIN3 ; Count chars
MOVNI A,1 ; Back up so ILDB at HLPIN0 works
ADJBP A,HPTR ; ..
MOVEM A,HPTR ; ..
MOVEM D,LOC ; Save char addr of next topic
JRST HLPIN4 ; Go add it to table
SUBTTL GETHLP - read help file
GETHLP: STKVAR <<HLPFOB,2>,HLPIFN>
MOVEI A,FDXSIZ ; Allocate an FD
$CALL M%GMEM ; ..
JUMPF GTHLPE ; No room
HRLZM A,.FDLEN(B) ; Stuff length
TOPS20<
HRLI A,[ASCIZ /HLP:MS.HLP/]
HRRI A,.FDSTG(B) ; Point to filespec area
BLT A,FDXSIZ-1(B)
>
TOPS10<
MOVE A,[SIXBIT /HLP/] ; Init filespec
MOVEM A,.FDSTR(B)
MOVE A,[SIXBIT /MS/]
MOVEM A,.FDNAM(B)
MOVE A,[SIXBIT /HLP/]
MOVEM A,.FDEXT(B)
>;End TOPS10
MOVE A,B ; Set up for ALCFOB
CALL ALCFOB ; Allocate and link FOB
JRST GTHLPE ; No room
MOVX C,FB.LSN ; Don't try to strip LSN's here
ANDCAM C,FOB.CW(B) ; ..
DMOVEM A,HLPFOB ; Save FOB addr and size
$CALL F%IOPN ; Open help file for input
JUMPF [ MOVE A,1+HLPFOB ; Point to FOB
MOVE A,FOB.FD(A) ; Point to FD for error message
$TEXT (KBFTOR,<%Can't read help file ^F/(A)/ because: ^E/[-1]/>)
JRST GTHLP9]
MOVEM A,HLPIFN ; Save IFN
MOVX B,FI.SIZ ; Get length of file in bytes
$CALL F%INFO
ADDI A,<1000*5>-1 ; Round up
IDIVI A,<1000*5> ; Compute pages needed
$CALL M%AQNP ; Snarf them
JUMPF [ WARN (Can't read help file -- insufficient memory)
RET]
LSH A,^D9 ; Compute address of block of pages
HRLI A,(POINT 7,) ; Form byte pointer
MOVEM A,HLPTXT ; Save
MOVE D,A ; Better AC
; JRST GETHP0
GETHP0: MOVE A,HLPIFN
$CALL F%IBUF ; Get next chunk
JUMPF [ CAIE A,EREOF$ ; EOF?
JRST [CMERR (Can't read help file)]
SETZ A, ; Insure ASCIZ
IDPB A,D ; ..
MOVE A,HLPIFN ; Get IFN back
$CALL F%REL ; Close file
JRST GTHLP9]
TOPS10< ; *** Dumb GLXLIB bug patch
TLNN B,770000 ; Bogus byte pointer returned?
TLO B,010000 ; Yes, fix it up then
>;End TOPS10
MOVE C,A ; Byte count
MOVE A,B ; Pointer to buffer just read
MOVE O,D ; Destination
CALL FSCOPY ; Move those bytes
MOVE D,O ; Retain updated destination pointer
JRST GETHP0 ; Do for all hunks
;Here if no room for chunks
GTHLPE: WARN (Can't read help file -- insufficient memory)
;Here to release chunks
GTHLP9: DMOVE A,HLPFOB
CALLRET RELFOB
LLIT
; Headers of messages
.HEADE: TXNE F,F%READ ; In read cmd ("show header")?
CALLRET .RHEAD ; Yes, just type a single header
CALL DFSQNW ; Get sequence, default to new
LDB A,[POINT 12,MSGSEQ,11]
CAIN A,3777 ; Any messages at all?
JRST [ WARN <No messages match this specification>
RET]
HEADR1: CALL NXTSEQ ; Get the next message in sequence
RET ; No more to do
CALL TYPHDR ; Type its header
JRST HEADR1
; Type messages
.VERBO: TXO F,F%VBTY ; Set "verbose type" flag
.TYPE: CALL DFSQTH
LDB A,[POINT 12,MSGSEQ,11]
CAIN A,3777 ; Any messages at all?
JRST [ WARN <No messages match this specification>
RET]
TYPE1: CALL NXTSEQ
JRST [ TXZ F,F%VBTY
RET]
CALL CHKDEL ; Not the deleted ones
JRST TYPE1
CALL TYPMSG
JRST TYPE1
SUBTTL Routines to diddle various message flags
.FLAG: MOVEI A,FLGMSG ; Flag messages
MOVEI B,[ASCIZ / Flagged: /]
CALLRET SEQUEN
.UNFLA: MOVEI A,UFLMSG ; Unflag messages
MOVEI B,[ASCIZ / Unflagged: /]
CALLRET SEQUEN
.UNMAR: MOVEI A,UMKMSG ; Unmark message (make unseen)
MOVEI B,[ASCIZ / Unmarked: /]
CALLRET SEQUEN
.UNDEL: MOVEI A,UNDMSG ; Undelete message
MOVEI B,[ASCIZ / Undeleted: /]
CALLRET SEQUEN
.MARK: MOVEI A,MRKMSG ; Mark message (as seen)
MOVEI B,[ASCIZ / Marked: /]
CALLRET SEQUEN
.DELET: MOVEI A,DELMSG ; Delete message
MOVEI B,[ASCIZ / Deleted: /]
; CALLRET SEQUEN
;Here to perform some action on a sequence of messages
;Call:
; A/ address of routine to munch message
; B/ address of ASCIZ reassurance string
SEQUEN: DMOVEM A,DOMSG ; Set up handler
CALL DFSQTH ; Get sequence, default to current
SEQUE0: CALL CRIF ; In case random error messages have happened
MOVE A,DOMSG+1 ; Type reassurance string
HRLI A,(POINT 7,)
$CALL KBFTOR ; Flush buffers, this might be slow
SEQUE1: CALL NXTSEQ ; Next message spec'd
CALLRET PRTSQS ; No more, type end of them
CALL @DOMSG ; Process the message
CALL PRTSEQ ; Print out the numbers
JRST SEQUE1
LLIT
SUBTTL GET command - Get another message file
.GET: NOISE (messages from file)
TXZ F,F%F2 ; Allow printing of file status
TXZ F,F%RSCN ; Don't return to EXEC after reading file
TOPS20<
MOVX A,GJ%OLD ; Must exist
MOVEM A,CJFNBK+.GJGEN
HRROI A,[ASCIZ /PS:/] ; Default to PS:<logged-in-directory>
MOVEM A,CJFNBK+.GJDEV
HRROI A,MYDIRS
MOVEM A,CJFNBK+.GJDIR
HRROI A,[ASCIZ /MAIL/]
MOVEM A,CJFNBK+.GJNAM
HRROI A,[ASCIZ /TXT/]
MOVEM A,CJFNBK+.GJEXT
>;End TOPS20
TOPS10<
SETZM CJFNBK ; First zero the block
MOVE A,[CJFNBK,,CJFNBK+1]
BLT A,CJFNBK+CJFNLN-1
MOVE A,[SIXBIT /MAIL/]
MOVEM A,CJFNBK+.FDNAM
MOVSI A,(SIXBIT /TXT/)
MOVEM A,CJFNBK+.FDEXT
MOVE A,MYPPN
MOVEM A,CJFNBK+.FDPPN
>;End TOPS10
MOVEI A,[FLDDB. .CMFIL]
CALL CFIELD
TXZ F,F%AMOD!F%MOD
; JRST GET1 ; Next page
;Here from previous page, with B pointing to JFN or FD for TOPS10
; to open a message file
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
TOPS20<
MOVE A,NEWJFN ; Get JFN back
MOVX B,OF%RD!OF%FDT ; Force read date/time update
OPENF
JRST GETERR ; Woops, he goofed
>;End TOPS20
TOPS10<
MOVE A,NEWJFN ; On TOPS10, this really points to FD
MOVE B,MYPPN ; Default to logged-in PPN
SKIPN .FDPPN(A) ; ..
MOVEM B,.FDPPN(A) ; ..
CALL INILKB ; Init LOOKUP/ENETER block
CALL FILOPR ; Open for read
JRST [ CALL FILERR ; Type appropriate error message
CALL CLRCTO ; Clear ctrl-O
$TEXT (KBFTOR,<%Can't open message file ^F/@NEWJFN/>)
MOVEI A,^D10 ; Insure user gets ten seconds
CALL RDELAY ; to read this message
JRST GETER1] ; Clean up and quit
EXCH A,NEWJFN ; Remember IFN, get FD address back
HLRZ B,.FDLEN(A) ; Get length of FD
HRLZ A,A ; Form BLT ptr to copy to safe place
HRRI A,MSGFD ; Here's where it'll go
ADDI B,MSGFD-1 ; Last address to move
BLT A,(B) ; Move it
>;End TOPS10
; ..
; ..
;.GET continued...
CALL SIZFIL ; Get the size of the file, etc.
JRST [ WARN <Can't determine size of message file>
JRST GETER1]
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
SKIPG MSGJFN ; Did we win a file?
JRST GETER1 ; No, release stray JFN and quit
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
TXZE F,F%F2 ; Skip headers (expunge just done)?
JRST GET2 ; Yes, don't type stuff
TXNN F,F%AMOD ; No summary if auto MOD
CALL SUMMRY ; And a summary of the files contents
GET2:
TOPS10< CALL ECHOON > ; In case monitor command
RET
GETERR: JRETER (Can't open message file)
GETER1:
TOPS20<
MOVE A,NEWJFN ; Flush new jfn (old file still intact)
RLJFN
JFCL
>;End TOPS20
TOPS10<
MOVEI A,MSGFD ; Re-init LOOKUP/ENTER block
CALL INILKB ; ..
>;End TOPS10
MOVEI A,FILPGS ; Restore file size poop
HRLI A,OLDPGS
BLT A,FILPGS+4
JRST GET2 ; Clean up and quit
SUBTTL MSGOD - Message of the day
.MSGOD: CONFRM
TXZ F,F%RSCN ; Don't uselessly return to EXEC if EXEC cmd
MSGOD1:
TOPS20<
MOVX A,GJ%SHT!GJ%OLD!GJ%PHY ; Existing file, physical-only
HRROI B,[ASCIZ /SYSTEM:MAIL.TXT.1/]
GTJFN ; Get JFN on system message file
ERJMP [WARN (No system message file)
RET]
MOVE B,A ; Copy JFN to b for GET1
TXO F,F%MOD ; Set flag for system mail
JRST GET1 ; Now get file
>;End TOPS20
TOPS10<
STKVAR <SYSFD>
MOVEI A,FDXSIZ ; Get a chunk for an FD
$CALL M%GMEM ; ..
JUMPF [CWARN (Can't read system message file -- insufficient memory)]
MOVEM B,SYSFD
HRLZM A,.FDLEN(B) ; Stuff its length
MOVSI A,'STD' ; Where file lives
MOVEM A,.FDSTR(B)
MOVE A,[SIXBIT /MAIL/]
MOVEM A,.FDNAM(B)
MOVE A,[SIXBIT /TXT/]
MOVEM A,.FDEXT(B)
TXO F,F%MOD ; Set funny flag
CALL GET1 ; Read, parse file
MOVEI A,FDXSIZ ; Release the FD now
MOVE B,SYSFD ; ..
$CALL M%RMEM ; ..
RET
>;End TOPS10
; Auto MOD stuff
MSGOD0: CALL MSGOD1 ; Commom get routine
MOVEI A,NXTNEW ; Setup message sequencer
MOVEM A,NXTMSG
SETO M, ; Init message #
MOVE L,[POINT 12,MSGSEQ]
CALL STQDL2 ; Create msg sequence
CALL TYPE1 ; Use type routine (New)
PUSH P,[GO] ; In case continue
MOVE A,MSGJFN ; Get JFN of system message file
HRRZ C,FILPGS ; and page count
CALL UNMAPF ; Unmap it
CALL CLOSEF ; Close and release lock on message file
CALLRET CKEXIT ; Now exit
LLIT
SUBTTL Random small command routines
.DAYTI: CONFRM
$TEXT (KBFTOR,<^H/[-1]/>) ; Type current date/time
RET
.ECHO: MOVEI A,[FLDDB. (.CMTXT)]
CALL RFIELD ; Parse arbitrary text
CONFRM
MOVE A,[POINT 7,ATMBUF]
CALL KBFTOR ; Type the string and return
CALLRET CRLF
.QUIT: NOISE (MS)
CONFRM ; Confirm first
CALLRET CKEXIT
;Quit from MS Create-init>> mode without writing init file
.QUINI: NOISE (without updating init file)
CONFRM
MOVE A,INIIFN ; Close the init file
$CALL F%RREL ; Release without writing
DMOVE A,INIFOB ; Release chunks associated with file
CALL RELFOB ; ..
SETZM INIIFN
RET
;Finish creating init file (close init file nicely)
.FINIS: NOISE (and update init file)
CONFRM
MOVE A,INIIFN
$CALL F%REL ; Close file
DMOVE A,INIFOB ; Release chunks associated with file
CALL RELFOB
SETZM INIIFN
RET
.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
.BLANK: NOISE (screen)
CONFRM
SKIPE INIP ; If doing init file,
TXNN F,F%AMOD ; while doing auto MOD,
SKIPA ; ..
RET ; Don't blank the screen
BLANK0: SKIPN V52FLG ; Doing screen clearing?
JRST BLANK2 ; No, skip this
$CALL K%FLSH ; Yes, insure TTY buffers flushed
SKIPN BLKTIM ; Are we possibly delayed here?
JRST BLANK1 ; No, just do it then
$CALL I%NOW ; Get current date/time
SUB A,BLKTIM ; Get interval to next OK time for clearing
JUMPGE A,BLANK1 ; Interval already passed, just do it
MOVN A,A ; Get positive delay time (fractions of a day)
IDIVI A,<<1,,0>/<^D24*^D60*^D60>> ; Compute seconds (from UDT format)
JUMPE A,BLANK1 ; Not enough time left to care about
$CALL I%SLP ; OK, sleep that amount before clearing
BLANK1: MOVE A,V52FLG ; Get clear-screen sequence pointer
CALL BINOUT ; Type it
CALL @SCRRGR ; Undo any scroll-region junk
SETZM SCRLFL ; Flag that we're no longer scroll regioning
BLANK2: $CALL K%FLSH ; Dump TTY output
RET
BINOUT:
TOPS20<
PUSH P,A ; Type string in binary mode
$CALL K%FLSH ; Flush output buffers
MOVEI A,.PRIOU
RFMOD
PUSH P,B
TRZ B,TT%DAM ; Binary mode
SFMOD
EXCH A,-1(P)
$CALL KBFTOR
$CALL K%FLSH ; Insure typed while in binary mode
EXCH A,-1(P)
POP P,B
SFMOD
POP P,A
>;End TOPS20
TOPS10<
$CALL KBFTOR
>;End TOPS10
RET
SUBTTL Logout-on-exit and control-C routines
TOPS20<
.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
>;End TOPS20
;Prevent control-C while expunging deleted messages
CTCLOK: CALL XCLENQ ; Make ENQ exclusive
RET ; Can't, must be other readers
TXO F,F%XPIP ; Flag expunge in progress
TOPS20<
MOVX A,.FHSLF
MOVX B,1B<TMRCHN> ; Deactivate timer interrupts
DIC
RPCAP ; See if we can trap ctrl-C
TXNN B,SC%CTC ; Do we have the capability?
RETSKP ; No, just pretend all is OK
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
>;End TOPS20
RETSKP ; Done
;Here if ^C while expunge in progress
XPNCTC:
TOPS20<
$BGINT (1)
TXON F,F%CTLC ; Remember ^C typed
WARN <Expunge in progress - please wait>
$DEBRK
>;End TOPS20
TOPS10<
PUSH P,INTBLK+2 ; Save return address
AOSE INTF ; Interrupt already in progress?
RET ; Yes, dismiss without reenabling
SETOM INTF ; Flag that interrupts are OK now
SETZM INTBLK+2 ; ..
TXNN F,F%XPIP ; Expunge in progress?
JRST [ $TEXT (KBFTOR,<^^C>)
MONRT. ; Just quit
RET]
TXON F,F%CTLC ; ctrl-C already typed?
WARN <Expunge in progress - please wait>
RET
>;End TOPS10
;Here when expunge done
CTCOK: TXZ F,F%XPIP ; Clear expunge in progress flag
CALL SHRAGN ; Make ENQ shared again
TXZE F,F%CTLC ; ^C typed while locked?
CALLRET CKEXIT ; Yes, logout or exit as appropriate
TOPS20<
MOVX A,.FHSLF ; Reactivate timer interrupts
MOVX B,1B<TMRCHN>
AIC
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 ; ..
>;End TOPS20
RET ; and return
.EXIT: NOISE (and update message file)
CONFRM ; Confirm first
.EXIT0: CALL CHECK0 ; Any newly arrived mail?
SKIPA ; No, continue
JRST [CALL CLRFIB ; Clear typeahead - this is unexpected
CALL CHECKS ; Type message
JRST .+1] ; Go on
MOVE A,AUTEXP ; Get auto-expunge magic number
TXNN F,F%MOD ; SYSTEM messages?
CAIN A,3 ; or never do auto-expunge?
JRST .EXIT1 ; Yes to either, don't try then
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: CALL CKXRTN ; Do exit stuff, return here if continued
MOVE P,[IOWD NPDL,PDL] ; If continued, reset stack
JRST GO3 ; and try a rescan
CKXRTN: TXNE F,F%MOD ; Never do implied EXPUNGE for system mail
JRST CKXIT0 ; ..
MOVE A,AUTEXP ; Get auto-expunge magic number
CAIN A,1 ; Do for any exit?
JRST [ SKIPLE MSGJFN ; Yes, have a message file?
CALL EXPUNG ; Yes, do it then
JRST .+1]
CKXIT0: SKIPE SCRLFL ; If scroll region in effect,
JRST [ CALL @SCRRGR ; Undo scroll region stuff
CALL @SCRBTM ; Get to bottom of screen
SETZM SCRLFL ; Reset flag
JRST .+1]
$CALL K%FLSH ; Make sure user sees everything we've typed
TOPS20<
TXNN F,F%LOGO
JRST CKXIT1
MOVNI A,1
LGOUT
JRETER <Failed to logout job>
CKXIT1: HALTF
>;End TOPS20
TOPS10<
MONRT.
MOVX A,.PRIOU ; In case continued
HRRM A,SBK+.CMIOJ ; turn echoing back on
>;End TOPS10
RET ; Return if continued
;Create-init-file
.CREAT: NOISE (for setting permanent defaults)
CONFRM
TXZ F,F%RSCN ; Don't uselessly return to EXEC
MOVE T,TAKPTR ; Insure not from command file
MOVE A,(T) ; Get input IFN
CAIE A,.PRIIN ; Better be TTY
CERR (Create-init-file command not allowed inside command file)
CALL ININAM ; Do common init filespec build
RET ; Failure, msg already typed
DMOVEM A,INIFOB ; Save FOB size and address
$CALL F%IOPN ; See if already exists
JUMPF .CREA0 ; No, this is OK then
WARN <Superseding existing init file>
$CALL F%REL ; Release input IFN
.CREA0: DMOVE A,INIFOB ; Get FOB pointers again
$CALL F%OOPN ; Open for output
MOVEM A,INIIFN ; remember the IFN
TXNE F,F%CONC ; concise mode?
RET ; yes, return now
CITYPE (<
Give commands whose effects you wish to have remembered as permanent
defaults (for example, SET PERSONAL-NAME, SET CONCISE-MODE, etc.).
Commands which cause actions (READ, SUMMARIZE NEW, etc.) will be executed
every time MS starts up. Give the QUIT command to leave this mode
without changing anything, or the FINISH command to make your
changes permanent.>)
CALL CRLF
RET
SUBTTL Define commands - define alias and define address-list
;Define alias
.DEFAS: MOVX B,AB%INV ; This flavor is invisible to recipient
MOVEI A,[FLDDB. (.CMTOK,,<POINT 7,[ASCIZ /*/]>,,,[FLDDB. (.CMQST,,,,,[FLDDB. (.CMFLD,,,<name of alias>)])])]
JRST .DEFS1
;Define address-list
.DEFSS: SETZ B, ; This kind will be visible to recipient
MOVEI A,[FLDDB. (.CMTOK,,<POINT 7,[ASCIZ /*/]>,,,[FLDDB. (.CMQST,,,,,[FLDDB. (.CMFLD,,,<name of address list>)])])]
; JRST .DEFS1
;Common code to define address lists or aliases
.DEFS1: STKVAR <SYN0,ADRL,TBENT0,FLGS,FCNB> ; Synonym ptr, addr list ptr, table entry addr, fcn blk addr
MOVEM A,FCNB ; Save function block address
MOVEM B,FLGS ; Save flags
NOISE (name)
MOVE A,FCNB ; Restore function block address
CALL RFIELD ; Parse the synonym
MOVE A,CR.COD(A) ; Get fcn parsed
CAIN A,.CMTOK ; * (all)?
JRST .DEFA8 ; Yes, go delete all aliases/address-lists
MOVEI A,SB.LEN ; Allocate space for string
$CALL M%GMEM ; ..
JUMPF .DEFAE ; No room
MOVEM B,SYN0 ; Save address of synonym string
MOVE A,B ; Set up for MOVST0
HRLI A,(POINT 7,) ; ..
MOVE B,[POINT 7,ATMBUF] ; Copy synonym name into newly allocated chunk
CALL MOVST0 ; and terminate with null
NOISE (to be)
SETZM ADRL ; No address list
CALL ADRLST ; Parse addresses and form list
JRST .DEFAE ; Error
MOVEM A,ADRL ; Save ptr to head of addr list
MOVE B,FLGS ; Get flags for this synonym
MOVEM B,AB.FLG(A) ; Stuff into A-block
MOVEI A,KWDTBL ; See if this one already exists
MOVE B,SYN0 ; Point to synonym string
HRLI B,(POINT 7,) ; ..
$CALL S%TBLK ; ..
TXNN B,TL%EXM ; Exact match?
JRST .DEFA1 ; No, just add to table then
MOVEM A,TBENT0 ; Yes, save address of entry
HRRZ B,(A) ; Get code or pointer to A-block
CAIN B,SYSCOD ; Code?
JRST [ WARN (Can't redefine or delete definition of SYSTEM)
MOVEI A,SB.LEN ; Release string block no longer needed
MOVE B,SYN0 ; ..
$CALL M%RMEM ; ..
RET]
CALL ABREL ; Delete or supersede - release all A-blocks
MOVEI A,SB.LEN ; Won't need new synonym block either
MOVE B,SYN0 ; So release that as well
$CALL M%RMEM ; ..
SKIPE ADRL ; Any address list returned?
JRST .DEFA2 ; Yes, superseding
MOVE B,TBENT0 ; No, deleting - release synonym name also
HLRZ B,(B) ; ..
MOVEI A,SB.LEN ; ..
$CALL M%RMEM ; ..
MOVEI A,KWDTBL ; Remove entry from table
MOVE B,TBENT0 ; ..
$CALL S%TBDL ; ..
RET ; All done!
;Here to supersede an existing alias
.DEFA2: MOVE A,ADRL ; Point to address list
MOVE B,TBENT0 ; Address of table entry
HRRM A,(B) ; Point existing table entry at new expansion
RET ; All done
;Here to add an entirely new alias
.DEFA1: SKIPN B,ADRL ; Insure that we got an address
JRST [ CWARN (No address specified)
RET]
MOVEI A,KWDTBL ; Where to add table entry
HRL B,SYN0 ; Address of synonym string
$CALL S%TBAD ; Add to table
JUMPF [ CERR (Can't add synonym to table)]
RET
;Here if no room
.DEFAE: WARN (Can't get memory)
RET
;Here to delete all address-lists/aliases (define alias *)
.DEFA8: CONFRM
HLLZ E,KWDTBL ; Count of entries in table
JUMPE E,R ; Quit if none
MOVN E,E ; Form AOBJN ptr to table
HRRI E,KWDTBL+1 ; ..
.DEFA9: HRRZ B,(E) ; Get next entry
CAIN B,SYSCOD ; SYSTEM?
JRST .DEFA7 ; Yes, skip it
MOVE A,AB.FLG(B) ; Get flags for this entry
XOR A,FLGS ; See if the kind we want
TXNE A,AB%INV ; Does this bit match?
JRST .DEFA7 ; No, skip this entry then
CALL ABREL ; Delete A-block
MOVEI A,KWDTBL ; Remove from TBLUK table
MOVEI B,(E) ; Point to entry to remove
$CALL S%TBDL ; Delete it
SUBI E,1 ; Account for shortening of table
.DEFA7: AOBJN E,.DEFA9 ; Loop through table
RET
SUBTTL Define commands - ADRLST - parse an address list
;Parse an address list and form linked list of A-blocks
;
;Return +1: Failure, no room or bad syntax
; +2: Success, A points to head of list
ADRLST: TRVAR <AB0,AB1> ; Head, current
MOVEI A,AB.LEN ; Size of an A-block
$CALL M%GMEM ; Allocate a chunk
JUMPF R ; Failure
MOVEM B,AB0 ; Save head pointer
CALL ADRLSV ; Save state and set up for reparse
ADRLS0: MOVEM B,AB1 ; Make this current
MOVEI U,AB.TXT(B) ; Point to string space
CALL GETUSR ; Parse an address
JRST ADRLSX ; CRLF -- all done
MOVE C,AB1 ; Point to current A-block
HRRZM B,AB.COD(C) ; Store user number or code
TXZE F,F%CMA ; More addresses to come?
JRST [ MOVEI A,AB.LEN ; Yes, get another chunk
$CALL M%GMEM ; ..
JUMPF ADRLSE ; Sigh... fail
MOVE A,AB1 ; Point to current block
MOVEM B,AB.LNK(A) ; Chain
JRST ADRLS0] ; Go fetch next address
ADRLSX: MOVE A,AB0 ; Point to head
SKIPN AB.COD(A) ; Any addresses typed at all?
JRST [ MOVE B,A ; For ABREL
CALL ABREL ; No, release all chunks
SETZ A, ; Signal null address spec
RETSKP]
RETSKP ; Yes, all done
ADRLSE: MOVE B,AB0 ; Failure, release chunks
CALLRET ABREL ; and give bad return
;Routine to prepare for reparse -- calls remainder of ADRLST as coroutine
ADRLSV: MOVEM B,ABLHED ; Save head of list in OWN storage
MOVEI A,ADRLS2 ; Where to go in case reparse needed
HRRM A,SBK+.CMFLG ; Inform S%CMND
EXCH A,REPARA ; Inform CMDERR, get what it wanted before this
MOVEM A,REPAR0 ; Save what was originally there
MOVEI A,ADRLS1 ; Where to go to restore world
EXCH A,(P) ; Set up so coroutine exit restores world
JRST (A) ; Call remainder of ADRLST as coroutine
;This routine called by reparse code at CMDERR or from S%CMND via .CMFLG word
; First instruction is in case of SOSing reparse address because reprompt needed
SOS REPAR0 ; Decrement saved reparse addr to force reprompt
ADRLS2: MOVEI A,REPARS ; Original reparse address
HRRM A,SBK+.CMFLG ; Restore
MOVE A,REPAR0 ; Original reparse routine
MOVEM A,REPARA ; Restore
SKIPE B,ABLHED ; Deallocate A-block chain
CALL ABREL ; ..
JRST REPARS ; Now go do fancy reparse stuff
;Routine called when coroutine finally exits (ADRLST finishes or bombs)
ADRLS1: TDZA B,B ; Watch out for skip/nonskip returns
MOVEI B,1 ; B gets offset (A returns ADRLST's result)
ADDM B,(P) ; Correct return address
MOVEI B,REPARS ; Restore default reparse stuff
HRRM B,SBK+.CMFLG ; ..
MOVE B,REPAR0 ; ..
MOVEM B,REPARA ; ..
RET ; and return
;Here to release chain of A-blocks, B points to first block
ABREL: MOVE D,AB.LNK(B) ; Get link
MOVEI A,AB.LEN ; Length of an A-block
$CALL M%RMEM ; Release chunk
JUMPE D,R ; If no link, done
MOVE B,D ; Link, do next
JRST ABREL ; ..
SUBTTL Define commands - MVALST - move an address list
;Move an address list, handling line wrap and XMAILR-style quoting
;Call: A/ ptr to head of address list
; X/ Horizontal position
MVALST: STKVAR <ABLK> ; Ptr to current A-block
MOVEM A,ABLK
MVALS0: MOVE A,ABLK
MOVEI B,AB.TXT(A) ; Point to text of address
HRLI B,(POINT 7,)
HRRZ C,AB.COD(A) ; Get user number or code
CAIN C,PFXCOD ; Is this an address list prefix?
JRST [ CALL MOVTU0 ; Yes, type it
MOVEI A,":" ; Punctuate
XCT MOVDSP ; ..
MOVE A,ABLK ; Restore current A-block ptr
MOVE A,AB.LNK(A) ; Get ptr to next
MOVEM A,ABLK ; Make current
AOJA X,MVALS2] ; Go check for line wrap
CALL MOVADR ; Normal address, just type it
MVALS1: MOVE A,ABLK ; Restore A-block pointer
SKIPN B,AB.LNK(A) ; Any more entries?
RET ; No, return
MOVEM B,ABLK ; Yes, make this one current
MOVE C,AB.COD(B) ; Get usernum or code of this entry
CAIN C,SFXCOD ; Suffix?
JRST [ MOVEI A,";" ; Yes, type it
XCT MOVDSP ; ..
AOJA X,MVALS1] ; Check for more suffixes or addresses
MOVEI A,"," ; Type comma, there's more coming
XCT MOVDSP ; ..
MVALS2: TXNN F,F%XMTO ; XMAILR-style (one addr per line)
CAIL X,ADRWTH ; Or too close to right margin?
JRST [ MOVEI B,[ASCIZ /
/]
CALL MOVSB2 ; Move CRLF and indentation
MOVEI X,4 ; Init horizontal position
JRST MVALS0] ; Type next address
MOVEI A," " ; Same line, type space
XCT MOVDSP ; ..
ADDI X,2 ; Update column position
JRST MVALS0
SUBTTL Define commands - Define header-item
.DFHDI: NOISE (name)
STKVAR <HDI0,HDI1,FLAGS,TENT>
TXZ F,F%F1 ; Assume not supersede or delete
MOVEI A,[FLDDB. (.CMTOK,,<POINT 7,[ASCIZ /*/]>,,,[FLDDB. (.CMQST,,,,,[FLDDB. (.CMFLD,,,<name of header item>)])])]
CALL RFIELD ; Get the name
MOVE A,CR.COD(A) ; Get function parsed
CAIN A,.CMTOK ; Token? (asterisk)
JRST .DFHD6 ; Yes, confirm and delete all header-items
MOVE B,[POINT 7,ATMBUF]
MOVEI A,HDITAB ; See if name already exists
$CALL S%TBLK ; ..
TXNE B,TL%EXM ; Exact match?
JRST [ TXO F,F%F1 ; Yes, flag supersede/delete
MOVEM A,TENT ; Save addr of existing table entry
JRST .DFHD0] ; Don't make new name block
MOVEI A,SB.LEN ; New - allocate chunk for this name
$CALL M%GMEM ; ..
JUMPF .DFHD9 ; Sigh... this should never happen
MOVEM B,HDI0 ; Save address of name block
MOVE A,B ; Set up for MOVST0
HRLI A,(POINT 7,) ; Where to store name
MOVE B,[POINT 7,ATMBUF] ; Where to fetch from
CALL MOVST0 ; Move it
; JRST .DFHD0
;define header-item (cont'd.)
.DFHD0: NOISE (type)
MOVEI A,[FLDDB. (.CMKEY,,HTYP0T,,,[FLDDB. (.CMCFM)])]
CALL RFIELD ; Get name or CR
MOVE A,CR.COD(A) ; Get function parsed
CAIN A,.CMCFM ; Confirm?
JRST .DFHD8 ; Yes, delete this entry then
HRRZ B,(B) ; Get flags for this keyword
MOVEM B,FLAGS ; Save
MOVEI A,[FLDDB. (.CMKEY,,HTYP1T)]
CALL RFIELD ; Parse type
HRRZ B,(B) ; Get flags for this keyword
IORB B,FLAGS ; Set more bits
ANDI B,HD%TYP ; ***Should use LOAD
HLRZ A,GETHDA(B) ; Get size of chunk for this type H-block
$CALL M%GMEM ; Get the chunk
JUMPF .DFHD9 ; No room
MOVEM B,HDI1 ; Remember this address
MOVEM A,HD.SIZ(B) ; Put size into chunk
MOVE A,HDI1 ; Addr of H-block
MOVE B,FLAGS ; Get flags and type
MOVEM B,HD.FLG(A) ; Store in H-block
ANDI B,HD%TYP ; Get just type
CAIN B,HD%KWD ; Keyword?
JRST [ NOISE (list)
MOVE B,FLAGS ; Insure not predefined
TXNE B,HD%PDF ; ..
CWARN (Keyword header-item cannot be predefined)
MOVEI A,^D100 ; Allocate table space
$CALL M%GMEM
MOVE A,HDI1 ; Point to H-block
MOVEM B,HD.DAT+1(A) ; Point H-block to table
MOVEI A,^D99 ; Number of entries
MOVEM A,(B) ; Init table header word
MOVE A,B ; For KWDLST
CALL KWDLST ; Parse list
RET ; Error
JRST .DFHD3] ; Can't be predefined
MOVE B,FLAGS
TXNN B,HD%PDF ; Predefined header-item?
JRST .DFHD2 ; No, don't parse one now then
CALL GETHDI ; Parse the header-item
RET ; Error, msg already typed
JRST .DFHD3 ; GETHDI got the confirmation
.DFHD2: CONFRM
.DFHD3: TXZE F,F%F1 ; Superseding existing entry?
JRST [ MOVE D,TENT ; Yes, get its addr
HRRZ A,(D) ; Get old H-block addr
CALL HBREL ; Release
MOVE A,HDI1 ; Addr of new block
HRRM A,(D) ; Replace
RET] ; All done
MOVEI A,HDITAB ; Header-item table
HRLZ B,HDI0 ; String address (name of header-item)
HRR B,HDI1 ; Address of header-item block
$CALL S%TBAD ; Add to table
JUMPF [ WARN (Couldn't add header-item to table)
RET]
RET
;Here to delete all header-items (define header-item *)
.DFHD6: CONFRM
HLRZ E,HDITAB ; Get number of header-items
JUMPE E,R ; If none, done
.DFHD7: MOVEI A,HDITAB+1 ; Entry to be removed is always first
CALL HDIDEL ; since HDIDEL moves 'em all down one
SOJG E,.DFHD7 ; Loop through all entries
RET ; and return
;Here to delete header-item definition
.DFHD8: TXNN F,F%F1 ; Insure that we found a match
JRST [ HRRO A,HDI0 ; Point to name
WARN (Header-item %1S does not exist)
MOVEI A,SB.LEN ; Size of chunk
MOVE B,HDI0 ; Release chunk
$CALL M%RMEM
RET]
HRRZ A,TENT ; Address of entry to delete
CALLRET HDIDEL ; Delete it and return
.DFHD9: CMERR (No room)
RET
SUBTTL Define commands - HDIDEL - delete a header-item
;Delete an entry from HDITAB and associated storage
;A/ address of entry to delete
HDIDEL: STKVAR <T0>
MOVEM A,T0 ; Save address of table entry
HLRZ B,(A) ; Get ptr to name block
MOVEI A,SB.LEN ; Length of block
$CALL M%RMEM ; Release chunk
MOVE A,T0 ; Recover address of table entry
HRRZ A,(A) ; Addr of H-block
CALL HBREL ; Release H-block
MOVEI A,HDITAB ; Header-item table
MOVE B,T0 ; Addr of entry to remove
$CALL S%TBDL ; Do it
RET
SUBTTL Define commands - HBREL - release H-block storage
;Release H-block storage - must release associated blocks too
;Call: A/ Addr of H-block
HBREL: STKVAR <HBADD>
MOVEM A,HBADD ; Remember address for a bit
MOVE A,HD.FLG(A) ; Get flags
ANDI A,HD%TYP ; *** Get type (should use LOAD)
; LOAD A,HDTYP(A)
CAIN A,HD%ADR ; Address spec?
JRST [ MOVE A,HBADD ; Yes, point to H-block
SKIPE B,HD.DAT(A) ; Point to address list
CALL ABREL ; Release it if present
JRST HBREL0]
CAIN A,HD%KWD ; Keyword?
JRST [ MOVE A,HBADD ; Yes, point to H-block
SKIPE A,HD.DAT+1(A) ; If keyword table present,
CALL KWDREL ; Release it
JRST HBREL0]
HBREL0: MOVE B,HBADD ; Point to H-block again
MOVE A,HD.SIZ(B) ; Size
$CALL M%RMEM ; Release chunks
RET
SUBTTL Define commands - KWDLST - parse keyword list
;Parse keyword list and enter into TBLUK-style table
;Call: A/ address of table
;Return +1: failure, no args
; +2: OK, table built in H-block
KWDLST: STKVAR <STRB,HDBLK> ; String block address, table address
MOVEM A,HDBLK ; Save H-block ptr
KWDLS0: MOVEI A,[FLDDB. (.CMFLD,CM%SDH,,<
Enter keywords, separated by commas
>)]
CALL RFIELD ; Get next word
LDB A,[POINT 7,ATMBUF,6]
JUMPE A,R ; Insure something typed
CAIE A,15 ; ..
CAIN A,12
RET
MOVEI A,SB.LEN ; Allocate a string block
$CALL M%GMEM ; ..
JUMPF R
MOVEM B,STRB ; Remember address
MOVE A,B ; For MOVST0
HRLI A,(POINT 7,) ; ..
MOVEI B,ATMBUF ; Move this name to block
CALL MOVST0 ; ..
HRLZ B,STRB ; Table entry
MOVE A,HDBLK ; Table address
$CALL S%TBAD ; Add to it
JUMPF R
MOVEI A,[FLDDB. .CMCFM,,,,,[FLDDB. .CMCMA]]
CALL RFIELD
MOVE A,CR.COD(A) ; Get function parsed
CAIN A,.CMCMA ; Comma typed?
JRST KWDLS0 ; Yes, go for next keyword
RETSKP
SUBTTL HDTYPS - Header-item definitions
;Parse header-item and store
;Call: A/ Address of H-block
;Returns +1: failure, error msg already printed
; +2: success, H-block updated
GETHDI: TRVAR <HBLKP>
MOVEM A,HBLKP ; Save H-block pointer and result pointer
MOVE B,HD.FLG(A) ; Should use LOAD for this
ANDI B,HD%TYP ; Isolate type field
; LOAD B,HDTYP(A) ; Get type of H-block
HRRZ B,GETHDA(B) ; Get routine address
CALLRET (B) ; Dispatch to appropriate routine
;Define types of header-items, names, and size of H-blocks
DEFINE HDTYPS,<
X ADR,address,HD.DAT+1
X DAT,date,HD.DAT+1
X DTI,<date-and-time>,HD.DAT+1
X KWD,keyword,<HD.DAT+2>
X TXT,<text-string>,HD.DAT+SB.LEN
X TIM,time,HD.DAT+1
>
SUBTTL Routines to parse header-items
;Build command table
DEFINE X(COD,STRNG,SIZ),<
CMD (<STRNG>,HD%'COD)
>
HTYP1T: HTYP10,,HTYP10
HDTYPS
HTYP10==.-HTYP1T-1
;Define type codes and build dispatch table
%%%ZZZ==0
DEFINE X(COD,STRNG,SIZ),<
HD%'COD==%%%ZZZ ;; Define type code
XWD SIZ,GTH'COD ;; Address of routine to parse header-item
%%%ZZZ==%%%ZZZ+1 ;; and size of H-block
>
GETHDA: HDTYPS
;Define name strings
DEFINE X(COD,STRNG,SIZ),<
EXP POINT 7,[ASCIZ /STRNG/]
>
HDTNAM: HDTYPS
;Parse address header-item
GTHADR: MOVE B,HBLKP ; Point to H-block
SKIPE B,HD.DAT(B) ; Any address list already there?
CALL ABREL ; Yes, release it first
CALL ADRLST ; Parse an address list
RET ; Error
MOVE C,HBLKP ; Point to H-block
MOVEM A,HD.DAT(C) ; Store pointer to address list
JUMPE A,GTHEX0 ; Null list typed -- mark not present
GTHEX1: MOVX A,HD%PRS ; Non-null list -- mark item present
IORM A,HD.FLG(C) ; ..
RETSKP ; Give good return
GTHEX0: MOVX A,HD%PRS ; Mark header-item not present
ANDCAM A,HD.FLG(C) ;
RETSKP
;Parse date
GTHDAT: MOVEI A,[FLDDB. .CMCFM,,,,,[FLDDB. (.CMTAD,,CM%IDA)]]
GTHDT0: CALL RFIELD
MOVE A,CR.COD(A) ; Get function parsed
MOVE C,HBLKP ; Point to H-block
CAIN A,.CMCFM ; Just CR typed?
JRST GTHEX0 ; Yes, mark item not present
PUSH P,B ; Save date/time over CONFRM
CONFRM
POP P,HD.DAT(C) ; Store datum
JRST GTHEX1 ; Mark present
;Parse date/time
GTHDTI: MOVEI A,[FLDDB. .CMCFM,,,,,[FLDDB. (.CMTAD,,CM%IDA!CM%ITM)]]
JRST GTHDT0 ; Join common code
;Parse time
GTHTIM: MOVEI A,[FLDDB. .CMCFM,,,,,[FLDDB. (.CMTAD,CM%SDH,CM%ITM,<
Time in hours, or hh:mm for hours and minutes
>)]]
JRST GTHDT0 ; Join common code
;Parse text header-item
GTHTXT: MOVEI A,[FLDDB. .CMCFM,,,,,[FLDDB. (.CMTXT)]]
CALL RFIELD ; Get field
MOVE A,CR.COD(A) ; Get function parsed
MOVE C,HBLKP ; Point to H-block
CAIN A,.CMCFM ; Just CR?
JRST GTHEX0 ; Yes, mark as not present
CONFRM
MOVE B,[POINT 7,ATMBUF] ; Check to insure special chars are quoted
SETZ D, ; Assume no quotes required
CALL SPCCHK ; ..
MOVEI D,42 ; Quotes required, supply 'em
MOVEI A,HD.DAT(C) ; Point to text space
HRLI A,(POINT 7,) ; Form byte pointer
SKIPE D ; If quoting,
IDPB D,A ; move the quote
CALL MOVST1 ; Move 'em on out!
SKIPE D ; If quoting,
IDPB D,A ; move close quote
SETZ B, ; ASCIZ pleaze
IDPB B,A ; ..
MOVE C,HBLKP ; Restore H-block pointer
JRST GTHEX1 ; Mark present and return
;Parse keyword
GTHKWD: STKVAR <<FLDB0,10>> ; Two writeable FLDDB. blocks
HRLI A,[FLDDB. (.CMCFM)]
HRRI A,FLDB0 ; Copy templates to writeable storage
BLT A,3+FLDB0 ; ..
HRLI A,[FLDDB. (.CMKEY)]
HRRI A,4+FLDB0 ; Stupid MACRO can't put both macros inside
BLT A,7+FLDB0 ; one literal so we need two BLTs
MOVEI A,4+FLDB0 ; Pointer to second block (.CMKEY)
HRRM A,FLDB0 ; Chain to first block (.CMCFM)
MOVE B,HBLKP ; Point to H-block
MOVE B,HD.DAT+1(B) ; Point to keyword table
MOVEM B,.CMDAT+4+FLDB0 ; Store in 2nd function block
MOVEI A,FLDB0 ; Point to COMND arg block
CALL RFIELD ; Parse keyword or CR
MOVE A,CR.COD(A) ; Find out which
MOVE C,HBLKP ; Point to H-block
CAIN A,.CMCFM ; CR?
JRST GTHEX0 ; Yes, mark not present and return
PUSH P,B ; Save datum returned from S%CMND
CONFRM
POP P,HD.DAT(C) ; Store in H-block
JRST GTHEX1 ; Mark present and return
LLIT
SUBTTL Define and Set command dispatchers
F%NO==F%F1 ; local flag indicating "no" typed
.DEFIN: SKIPN INIP ; If not from init file,
TXZ F,F%RSCN ; don't uselessly return to exec
MOVEI A,[FLDDB. (.CMKEY,,DFNCTB)]
CALL RFIELD
HRRZ A,(B) ; Get routine address
CALL (A)
RET
.SET: NOISE (parameter)
TXZ F,F%NO ; Note "no" not typed yet
SKIPN INIP ; If not in init file,
TXZ F,F%RSCN ; then don't uselessly return to EXEC
MOVEI A,[FLDDB. (.CMKEY,,STCMTB)]
.SET0: CALL RFIELD
HRRZ A,(B)
CALL (A)
TXZ F,F%NO
RET
;No
.STNO: TXO F,F%NO ; Remember "no" typed
MOVEI A,[FLDDB. (.CMKEY,,STCMT0)]
JRST .SET0 ; table without "no" in it
;Retrieve commands
.RETRI: MOVEI A,[FLDDB. (.CMKEY,,RETRCM)]
CALL RFIELD
HRRZ A,(B)
CALL (A)
RET
;Save commands (top level)
.SAVTL: MOVEI A,[FLDDB. (.CMKEY,,SVTLTB,,<outgoing-messages>)]
CALL RFIELD ; Parse keyword
HRRZ A,(B) ; Get routine address
CALLRET (A) ; Go to it
SUBTTL Set commands
;Set include-me-in-replies
.STINC: CONFRM
TXNE F,F%NO ; "no" typed?
TXZA F,F%RPIN ; yes, clear include-me flag
TXO F,F%RPIN ; set it
RET
;Set brief-address-list-display
.STBFD: CONFRM
TXNE F,F%NO
TXZA F,F%BREF
TXO F,F%BREF
RET
;Set Personal-name <text>
.STPNM: NOISE (used in outgoing mail)
TXZE F,F%NO ; "No" typed?
JRST [ CONFRM
JRST .STPN3]
MOVEI A,[FLDDB. (.CMTXT,CM%SDH,,<
Your full name, as you'd like it to appear in mail you send
>)]
CALL RFIELD
LDB A,[POINT 7,ATMBUF,6]
JUMPE A,.STPN3 ; If null arg given, zap whole word
HRRI B,ATMBUF ; Get the string from ATMBUF
HRLI B,(POINT 7,)
HRRI A,PERSON ; into personal name space
HRLI A,(POINT 7,)
CALL MOVST0
MOVE B,[POINT 7,PERSON]
.STPN0: CALL SPCCHK ; Check for special characters
JRST [ WARN <Special characters in personal name must be in quoted string>
JRST .STPN3]
RET ; OK, normal return
.STPN3: SETZM PERSON ; Just ignore it
RET
SUBTTL Set commands - SPCCHK - check for special characters
;Check for special characters in string (per RFC733)
;
; specials = "(" / ")" / "<" / ">" / "@" ; To use in a word,
; / "," / ";" / ":" / "\" / <"> ; word must be a
; ; quoted-string.
;
;Call: B/ Byte pointer to ASCIZ string to be checked
;
;Return +1: Specials found, or quoted string not closed
; +2: No specials found
SPCCHK: $SAVE <A,B> ; Be safe
SPCCH0: ILDB A,B ; Check for no-no characters
JUMPE A,[RETSKP] ; Return on end of string
CAIE A,"("
CAIN A,")"
JRST SPCCH2 ; Parentheses not allowed (per RFC733)
CAIE A,"<" ; Check for all no-no chars
CAIN A,">"
JRST SPCCH2
CAIE A,"@"
CAIN A,","
JRST SPCCH2
CAIE A,";"
CAIN A,":"
JRST SPCCH2
CAIN A,"\"
JRST SPCCH2
CAIE A,42 ; Start of quoted string?
JRST SPCCH0 ; No, keep checking
SPCCH1: ILDB A,B ; Yes, eat chars in quoted string
JUMPE A,[WARN <Unterminated quoted string>
RET] ; Give bad return
CAIE A,42 ; Close of quoted string?
JRST SPCCH1 ; No, keep eating chars
JRST SPCCH0 ; Yes, return to ordinary mode
SPCCH2: RET ; Failure
SUBTTL Set commands - continued
;Set default reply-to-all
.STRPA: CONFRM
TXO F,F%RPAL
RET
;Set default reply-to-sender-only
.STRPS: CONFRM
TXZ F,F%RPAL
RET
;Set [no] concise-mode
.STCNC: CONFRM
TXNE F,F%NO ; "no" typed?
TXZA F,F%CONC ; yes, clear flag
TXO F,F%CONC ; no, set concise flag
RET
;Set default
.STDFT: MOVEI A,[FLDDB. (.CMKEY,,DFCMTB)]
CALL RFIELD
HRRZ A,(B) ; Get routine address
CALL (A)
RET
;Set [no] headers-on-printer-output
.STHLP: CONFRM
TXNE F,F%NO ; "no" typed?
TXZA F,F%HLPT ; Yes, clear the flag
TXO F,F%HLPT ; No, set it
RET
SUBTTL Set commands - .STCDI - set default directory
.STCDI: TRVAR <<DIR0,10>> ; Full directory name space
NOISE (to)
TOPS10<
WARN (Not yet implemented for TOPS10 systems)
RET
>;End TOPS10
TOPS20<
MOVEI A,[FLDDB. (.CMKEY,,CRFDTB,,,[FLDDB. (.CMDIR)])]
CALL RFIELD ; Get keyword or directory name
MOVE A,CR.COD(A) ; Get function parsed
CAIE A,.CMDIR ; Directory name typed?
JRST [ HRRZ A,0(B) ; Get routine addr for keyword
CALLRET 0(A)] ; Do it and return
.STCD1: HRROI A,DIR0 ; Where to put directory name
DIRST ; Remember it
JCERR (Bad directory name)
MOVEI B,DIR0 ; Point to directory spec
HRLI B,(POINT 7,) ; ..
MOVE A,[POINT 7,CRFDEV] ; First do device name
.STCD2: ILDB C,B ; Get next byte of device name
IDPB C,A
CAIE C,":" ; Do until colon
JRST .STCD2 ; Do for all chars in device field
IBP B ; Skip opening wedge
MOVE A,[POINT 7,CRFDIR] ; Where to put directory name
.STCD4: ILDB C,B ; Get next byte of directory name
CAIN C,76 ; (This is a closing wedge) until closing wedge
JRST [ SETZ C, ; Done, insure ASCIZ
IDPB C,A ; ..
RET] ; and quit
IDPB C,A ; Stuff it
JRST .STCD4 ; Go for more
;Connected-directory and logged-in-directory keywords
.STCND: SKIPA C,[.JIDNO] ; Connected
.STLGD: MOVEI C,.JILNO ; Logged-in
CONFRM
SETO A, ; This job
HRROI B,D ; -length,,where to put it
GETJI
JFCL
MOVE B,D ; Get dirnum in right AC for DIRST
CALLRET .STCD1 ; Go join common code
>;End TOPS20
SUBTTL Set commands - continued
;set default protection (for created files)
.STCPR: NOISE (for created files)
MOVEI A,[FLDDB. (.CMNUM,,^D8,,<775200>)]
CALL RFIELD
TOPS20<
HRROI A,CRFPRT ; Where to put protection string
MOVX C,^D8 ; Radix
NOUT
JFCL
>;End TOPS20
TOPS10<
MOVEM B,CRFPRT ; On TOPS10, save octal number
>;End TOPS10
RET ; Common return
;Set [no] headers-personal-name-only
.STHPR: CONFRM
TXNE F,F%NO ; "no" typed?
TXZA F,F%PRSN ; Yes, clear bit
TXO F,F%PRSN ; No, set bit
RET
;Set auto-expunge (on) <condition>
.STAUT: NOISE (on)
MOVEI A,[FLDDB. (.CMKEY,,AUTCMT)]
CALL RFIELD ; Read keyword
HRRZ D,(B) ; Get value of this keyword
CONFRM
MOVEM D,AUTEXP ; Save for later
RET
SUBTTL Set commands - .STDCC - set [no] default-cc-list
.STDCC: TXNE F,F%NO ; "no" typed?
JRST [ CONFRM ; yes, confirm it
JRST .+1]
CALL ZAPTCC ; Zap to and cc lists
CALL .ERSL0 ; ..
TXZE F,F%NO ; "no" typed?
RET ; Yes, quit now
NOISE (to)
MOVEI W,TCPAG+400-1 ; Prepare to parse cc list
TXO F,F%CC ; ..
CALL .TO2 ; Go get 'em, boy!
TXZ F,F%CC ; All done
MOVE A,TOPTRS ; Remember pointers for later
MOVEM A,TOPTR0
MOVE A,[NAMTAB,,NAMTB0] ; Save entire NAMTAB
HLRZ B,NAMTAB ; ..
BLT A,NAMTB0(B) ; ..
MOVE A,FRENAM
MOVEM A,FRENM0
RET
;Zap to and cc list defaults
ZAPTCC: SETZM TOPTR0 ; clear cc list
MOVEI A,777
MOVEM A,NAMTB0 ; Reset name space
MOVE A,[POINT 7,NAMTXT]
MOVEM A,FRENM0
RET
SUBTTL Set commands - continued
;Set [no] type-initial-summary
.STSUM: CONFRM
TXNE F,F%NO ; "no" typed?
TXOA F,F%NSUM ; Yes, set "no-summary" bit
TXZ F,F%NSUM ; No, clear bit so summary gets typed
RET
;Set reply-address (supplies "Reply-to: addr" in sent mail)
.STRAD: STKVAR <PTR> ; Pointer to current A-block
TXZE F,F%NO ; set no reply-address?
JRST [ CONFRM ; Yes, confirm
SKIPE B,REPADD ; Release A-blocks
CALL ABREL ; ..
SETZM REPADD ; Zap list
RET] ; and quit
NOISE (to)
SKIPE B,REPADD ; Any existing addresses?
CALL ABREL ; Yes, release their A-blocks
SETZM REPADD ; Empty list
CALL ADRLST ; Parse some addresses
CMERR (Can't allocate memory for address blocks)
MOVEM A,REPADD ; Save pointer to list
RET
;Set [no] video-mode
.STVID: CONFRM
CALL TTINI ; Re-init TTY parameters
TXNN F,F%NO ; Default is video mode
RET
SETZM V52FLG ; Hmmm... OK, insure no fancy video stuff
MOVEI A,[RET]
MOVEM A,SCRREG
MOVEM A,SCRRGR
MOVEM A,SCRBTM
RET
;Set text-scroll-region
.STWSZ: TXNE F,F%NO ; 'set no text-scroll-region'?
JRST [ CONFRM ; Yes, zap it
SETZM MINWSZ
RET]
NOISE (to)
MOVEI A,[FLDDB. (.CMNUM,,^D10,,<8>)]
CALL RFIELD
PUSH P,B
NOISE (lines)
CONFRM
POP P,B
CAIG B,2 ; Check for unreasonable values
JRST [ WARN <Value too small, ignored>
RET]
MOVEM B,MINWSZ ; Save
RET
SUBTTL Set commands - .STOHS - set [no] only-headers-shown
.STOHS: SETZM OHSN ; Initially there are no header items
MOVEI A,OHSST0 ; Reset string free space ptr
MOVEM A,OHSSTF ; ..
NOISE (to)
.STOH1: MOVEI A,[FLDDB. .CMFLD,CM%SDH,,<
The names of the only header items you wish displayed when showing
messages, separated by commas. If you don't specify any particular
header items to display, they will all be displayed. Header items
are things like Subject, Date, To, cc, Reply-to, and so forth.
>]
CALL RFIELD
LDB A,[POINT 7,ATMBUF,6]
JUMPE A,R ; Insure something typed
CAIE A,15 ; If nothing typed, quit now
CAIN A,12
RET
AOS B,OHSN ; Increment number of header-names given
CAILE B,OHSNMX ; Too many given?
CERR (Too many header items given)
MOVE A,OHSSTF ; Where this one will go (free space ptr)
MOVEM A,OHSPTR-1(B) ; Save pointer to it
HRLI A,(POINT 7,) ; Init ASCII byte pointer
MOVEI B,CRLF0 ; Insure header-names begin with CRLF
CALL MOVSTR ; ..
MOVE B,[POINT 7,ATMBUF] ; Where to fetch header name from
MOVEI D,1 ; Init length (allow for colon)
.STOH2: ILDB C,B ; Next byte
JUMPE C,.STOH3 ; All done
IDPB C,A ; Move to free block
AOJA D,.STOH2 ; Count chars
.STOH3: MOVE B,OHSN ; Point to this entry again
HRLM D,OHSPTR-1(B) ; Save length of this header name
MOVEI B,":" ; Tie off with colon (for later call to FNDHDR)
IDPB B,A ; ..
SETZ B, ; Insure ASCIZ
IDPB B,A
HRRZI B,1(A) ; First free is next word after this one
MOVEM B,OHSSTF
MOVEI A,[FLDDB. .CMCFM,,,,,[FLDDB. .CMCMA]]
CALL RFIELD
MOVE A,CR.COD(A) ; Get function parsed
CAIN A,.CMCMA ; Comma typed?
JRST .STOH1 ; Yes, go get another header name
RET ; Confirm - finished
SUBTTL Set commands - .STSPH - set suppressed-headers
.STSPH: STKVAR <TBL0>
TXNE F,F%NO ; "NO" typed?
JRST [ CONFRM
SKIPN A,CNCLHD ; See if previous defs
RET ; No, quit
SETZM CNCLHD
CALLRET KWDREL] ; Yes, release and quit
NOISE (to be)
MOVEI A,^D100 ; Space for keyword table
$CALL M%GMEM ; Allocate it
MOVEM B,TBL0 ; Remember presence
MOVEI A,^D99 ; Maximum number of entries
MOVEM A,(B) ; Init TBLUK-style table
MOVE A,B ; Set up for KWDLST
CALL KWDLST ; Parse keywords and stuff into table
JRST [ MOVE A,TBL0 ; Error, just release storage
CALLRET KWDREL] ; and quit
SKIPE A,CNCLHD ; If something already defined,
CALL KWDREL ; release it
SKIPE OHSN ; Warn if conflicting commands given
WARN <There is an overriding "set only-headers-shown" command in effect>
MOVE A,TBL0
MOVEM A,CNCLHD ; Stuff table address and return
RET
;Release storage for keyword table and associated string blocks
KWDREL: PUSH P,E ; Need this register
PUSH P,A ; Save address of table
HLLZ E,(A) ; Get number of entries used
JUMPE E,KWDRL1 ; If table empty, this is easy
MOVN E,E ; Form ABOJN pointer to them
HRRI E,1(A) ; ..
KWDRL0: HLRZ B,(E) ; Get address of string block
MOVEI A,SB.LEN ; Length
$CALL M%RMEM ; Release it
AOBJN E,KWDRL0 ; Do for all
KWDRL1: POP P,B ; Address of table
HRRZ A,(B) ; Length
ADDI A,1 ; Account for header word
$CALL M%RMEM ; Release it
POP P,E ; Restore work reg
RET
LLIT
SUBTTL TAKE command (used for init file)
.TAKE: NOISE (commands from)
MOVE T,TAKPTR ; Init IFN stack pointer
TOPS10< CALL ECHOON > ; In case monitor command
TOPS20<
HRROI A,[ASCIZ /cmd/] ; default extension
MOVEM A,CJFNBK+.GJEXT ; ..
>;End TOPS20
TOPS10<
SETZM CJFNBK ; Zero previous defaults
MOVE A,[CJFNBK,,CJFNBK+1]
BLT A,CJFNBK+CJFNLN-1
MOVSI A,(SIXBIT /CMD/) ; Default only the extension
MOVEM A,CJFNBK+.FDEXT
>;End TOPS10
CALL FSPEC ; get filespec
JRST [ WARN (No file specified)
RET]
HLRE C,T ; First check room on the stack
MOVN C,C ; Get size of area left
CAIGE C,3 ; Need three words
JRST [ MOVE C,FOB.FD(B) ; No room, point to FD for error msg
CALL CRIF ; Get to left margin
$TEXT (KBFTOR,<?Command files nested too deeply, detected in opening ^F/(C)/>)
CALLRET RELFOB] ; Release FOB and give failure return
PUSH T,A ; Save FOB info
PUSH T,B ; ..
$CALL F%IOPN ; Open the file
JUMPF [ POP T,B ; Recover FOB info
POP T,A ; ..
HRRZ C,FOB.FD(B) ; For error message
$TEXT (KBFTOR,<?Can't open command file ^F/(C)/ because: ^E/[-1]/>)
CALLRET RELFOB] ; Release chunks
.TAKE0: PUSH T,A ; Push IFN onto take stack
MOVEM T,TAKPTR ; Preserve stack pointer
CALLRET SETIOJ ; Set up COMND I/O pointers and return
;Routine to set up COMND state block to take input from a file
; Call with IFN (or .PRIIN) in A
SETIOJ: MOVX B,.PRIOU ; Assume output to TTY
CAIN A,.PRIIN ; Primary input?
JRST SETIO1 ; Yes, this is easy
MOVX B,.NULIO ; Output to NUL: if input from file
TOPS20<
PUSH P,B ; Preserve output designator for a bit
MOVX B,FI.CHN ; On TOPS20, must put JFN into .CMIOJ
$CALL F%INFO ; instead of IFN
MOVX B,7 ; Also must set byte size to 7
SFBSZ
JFCL ; Garbagey skip returns!!!
POP P,B ; Restore output designator
>
SETIO1: HRLZ A,A ; position in LH
HRR A,B ; Output designator
MOVEM A,SBK+.CMIOJ ; inform COMND of this
MOVEM A,TTXTIB+.RDIOJ ; Also TEXTI
RET
;ININAM - Build FD for private MS.INIT (MS.INI on TOPS10)
;SYSNAM - Build FD for system MS.INIT
;Returns +1: Insufficient memory
; +2: OK, A/ size of FOB, B/ address of FOB
SYSNAM: TXZA F,F%F1 ; Remember SYSNAM entry
ININAM: TXO F,F%F1 ; Remember ININAM entry
MOVEI A,FDXSIZ ; Allocate max FD size
$CALL M%GMEM ; ..
JUMPF [ WARN (Can't process init file -- no memory)
RET]
MOVE D,B ; Place chunk addr in safe reg
MOVEI A,FDXSIZ ; Put length into FD
HRLZM A,.FDLEN(D) ; ..
TOPS20<
MOVEI A,.FDSTG(B) ; Where to build string
HRLI A,(POINT 7,)
TXZN F,F%F1 ; Private or system?
JRST [ MOVEI B,[ASCIZ /SYSTEM:/]
CALL MOVSTR ; System
JRST ININM0]
MOVEI B,[ASCIZ /PS:</]
CALL MOVSTR
MOVEI B,MYDIRS ; My login directory
CALL MOVSTR
MOVEI B,">"
IDPB B,A
ININM0: MOVEI B,[ASCIZ /MS.INIT/]
CALL MOVST0
>
TOPS10<
DMOVE A,[SIXBIT /DSK/ ; Device
SIXBIT /MS/] ; Name
TXZN F,F%F1 ; Private or system?
MOVE A,[SIXBIT /STD/] ; System
DMOVEM A,.FDSTR(D)
MOVE A,[SIXBIT /INI/] ; Extension
MOVEM A,.FDEXT(D)
MOVE A,MYPPN ; Get logged-in PPN
MOVEM A,.FDPPN(D) ; Stuff it
>
MOVEI A,FDXSIZ ; Size of FD
HRLZM A,.FDLEN(D)
MOVE A,D ; Allocate and link FOB
CALL ALCFOB ; ..
JRST [ WARN (Can't process init file -- insufficient memory)
RET]
RETSKP ; Win -- skip return
SUBTTL INITF - Parse init files (SYSTEM: and private)
INITF: CALL ININAM ; Build filespec for private init file
RET ; Error msg already printed
CALL INITX ; Process init file if it exists
SKIPA ; Not found, use system init file then
RET ; Found it, use only the private one
CALL SYSNAM ; Build FD for system init file
RET ; Error msg already printed
CALL INITX ; Go process the file
JFCL ; Don't care if not there
RET
;INITX - Attempt to open, and process an init file.
;Call:
; A/ FOB size
; B/ FOB address
;
;Return +1: failure (file not found)
; +2: success
INITX: MOVE T,TAKPTR ; Init IFN stack pointer
HLRE C,T ; First check room on the stack
MOVN C,C ; Get size of area left
CAIGE C,3 ; Need three words
JRST [ MOVE C,FOB.FD(B) ; No room, point to FD for error msg
CALL CRIF ; Get to left margin
$TEXT (KBFTOR,<?Command files nested too deeply, detected in opening ^F/(C)/>)
CALLRET RELFOB] ; Release FOB and give failure return
PUSH T,A ; Push FOB pointer and size onto IFN stack
PUSH T,B ; ..
$CALL F%IOPN ; Open for read
JUMPF [ POP T,B ; Recover FOB info
POP T,A ; ..
CALL RELFOB ; Release chunks
RET] ; Return
CALL .TAKE0 ; Set up COMND to take from file
MOVEM P,INIP ; Save state of the world
MOVEI A,PDL ; Compute how many words on PDL currently used
HRRZ B,P ; so we know how much to save
SUBI B,(A) ; ..
MOVE A,[PDL,,INIPDL] ; Save entire stack context
BLT A,INIPDL(B)
MOVEI A,INITX0 ; Where to go on EOF of init file
MOVEM A,INIRET ; ..
JRST CMDLUP ; Go parse init file
INITX0: MOVE P,INIP ; Restore state of world
MOVE A,[INIPDL,,PDL]
BLT A,(P)
SETZM INIP ; Flag init file no longer in progress
SETZM INIRET ; ..
$CALL K%FLSH ; Flush TTY buffers
RETSKP ; Return
SUBTTL Save-outgoing-messages (in file)
.SAVMS: NOISE (in file)
TOPS20<
HRROI A,[ASCIZ /txt/] ; Default extension
MOVEM A,CJFNBK+.GJEXT ; ..
>;End TOPS20
TOPS10<
SETZM CJFNBK ; Zero previous fields
MOVE A,[CJFNBK,,CJFNBK+1]
BLT A,CJFNBK+CJFNLN-1
MOVSI A,(SIXBIT /TXT/)
MOVEM A,CJFNBK+.FDEXT ; Default extension
MOVE A,MYPPN ; Put outgoing mail into my PPN
MOVEM A,CJFNBK+.FDPPN ; ..
>;End TOPS10
CALL GETPRS ; Parse filespec, don't open
JRST [ DMOVE A,SVMFOB ; No filespec given, just release this
SKIPE A ; if one to release
CALL RELFOB ; ..
SETZM SVMFOB ; ..
SETZM SVMFOB+1 ; ..
RET]
DMOVE A,SVMFOB ; Release previous FOB
SKIPE A ; if any
CALL RELFOB ; ..
DMOVE A,OUTFOB ; Save this away in a safe place
DMOVEM A,SVMFOB ; ..
TOPS10<
MOVE A,FOB.FD(B) ; Point to FD
MOVE B,MYPPN ; Get my PPN in case needed
SKIPN .FDPPN(A) ; PPN supplied by user?
MOVEM B,.FDPPN(A) ; No, default to logged-in PPN then
>;End TOPS10
RET
LLIT
SUBTTL Show commands - .SHDEF - show defaults
.SHOW: NOISE (information about)
MOVEI A,[FLDDB. (.CMKEY,,SHCMTB)]
CALL RFIELD
HRRZ A,(B) ; Get routine address
CALL (A) ; Go do it up
RET
;Show defaults
.SHDEF: CONFRM
TXNE F,F%CONC ; Concise mode?
$TEXT (KBFTOR,< set concise-mode>)
SKIPE C,TOPTR0 ; Default cc list?
CALL [ $TEXT (KBFTOR,< set default cc-list (to) ^A>)
HLRZ C,C ; Yes, point to it
MOVEI E,TCPAG+400 ; ..
MOVE A,[$CALL KBFTOR] ; What to do with each char
MOVEM A,MOVDSP ; ..
MOVEI T,[ASCIZ / /] ; "header" to type first
CALL MOVTO2 ; Go type the list
CALLRET CRLF]
TOPS20<
$TEXT (KBFTOR,< set default directory (to) ^A>)
SKIPN CRFDIR ; Any directory set?
JRST [ $TEXT (KBFTOR,<connected-directory>)
JRST .SHDE0] ; No, punt then
HRROI A,CRFDEV ; Show device and directory
$CALL KBFTOR
MOVEI A,"<" ; Punctuate
$CALL KBFTOR
HRROI A,CRFDIR ; Directory name
$CALL KBFTOR
MOVEI A,">"
$CALL KBFTOR
CALL CRLF
>;End TOPS20
; ..
; ..
.SHDE0: SKIPN CRFPRT
JRST .SHD00
TOPS20<
$TEXT (KBFTOR,< set default protection (for created files) ^A>)
TOPS20<
HRROI A,CRFPRT
$CALL KBFTOR
>;End TOPS20
TOPS10<
$TEXT (KBFTOR,<^O3R0/CRFPRT/^A>)
>;End TOPS10
CALL CRLF
>;End TOPS20
.SHD00: TXNE F,F%BREF
$TEXT (KBFTOR,< set brief-address-list-display>)
$TEXT (KBFTOR,< set default ^A>) ; Type state of reply switch
TXNN F,F%RPAL
$TEXT (KBFTOR,<reply-to-sender-only>)
TXNE F,F%RPAL ; Reply-to-all default?
$TEXT (KBFTOR,<reply-to-all>)
TXNE F,F%HLPT
$TEXT (KBFTOR,< set headers-on-printer-output>)
TXNE F,F%RPIN ; Flag on?
$TEXT (KBFTOR,< set include-me-in-replies>)
SKIPN A,MINWSZ ; Get text scroll region size
JRST [ $TEXT (KBFTOR,< set no text-scroll-region>)
JRST .SHDE2]
$TEXT (KBFTOR,< set text-scroll-region (to) ^D/A/ (lines)>)
.SHDE2: SKIPE A,OHSN ; Any only-headers-shown?
JRST [ CALL SHOOHS ; Yes, show them
JRST .SHDE1]
SKIPE D,CNCLHD ; Suppressed headers?
JRST [ $TEXT (KBFTOR,< set suppressed-headers ^A>)
MOVE A,D
CALL .SHHK0
CALL CRLF
JRST .SHDE1]
.SHDE1: SKIPE PERSON ; Personal name?
JRST [ $TEXT (KBFTOR,< set personal-name ^A>)
HRROI A,PERSON ; Yes, show it
$CALL KBFTOR
CALL CRLF
JRST .+1]
SKIPE REPADD ; Any reply-address?
JRST [ $TEXT (KBFTOR,< set reply-address ^A>)
MOVEI X,^D19 ; Init horizontal position
MOVE A,[$CALL KBFTOR]
MOVEM A,MOVDSP
MOVE A,REPADD ; Point to address list
CALL MVALST ; Type it
CALL CRLF
JRST .+1]
TXNE F,F%NSUM
$TEXT (KBFTOR,< set no type-initial-summary>)
$TEXT (KBFTOR,< set auto-expunge (on) ^A>)
MOVE A,AUTEXP
HRRO A,[[ASCIZ /exit-command-only/]
[ASCIZ /any-exit/]
[ASCIZ /exit-command-only/]
[ASCIZ /never/]](A)
$CALL KBFTOR
CALL CRLF
SKIPN SVMFOB ; Any outgoing-messages file?
RET ; No, all done
MOVE A,SVMFOB+1 ; Yes, point to FOB
MOVE A,FOB.FD(A) ; Point to FD
$TEXT (KBFTOR,< save outgoing-messages (in file) ^F/(A)/>)
RET
;Display only-headers-shown
; A/ contents of OHSN (number of headers shown)
SHOOHS: MOVN E,A ; Form AOBJN ptr
HRLZ E,E ; ..
$TEXT (KBFTOR,< set only-headers-shown (to) ^A>)
TXZ F,F%F1 ; Remember nothing typed yet
MOVEI X,^D29 ; Init horizontal position
SHOOH0: HRRZ C,OHSPTR(E) ; Get ptr to next name
TXON F,F%F1 ; Anything typed yet?
JRST SHOOH1 ; No, skip this then
HRROI A,[ASCIZ /, /] ; Yes, get comma space in case needed
ADDI X,2 ; Account for horizontal movement
MOVE B,LINEW ; Get terminal line width
SUBI B,^D16 ; Leave reasonable margin
CAIL X,(B) ; Time to wrap line yet?
JRST [ HRROI A,[ASCIZ /, -
/] ; Yes, get the string to do it
MOVEI X,4 ; Reset horizontal position
JRST .+1]
$CALL KBFTOR ; Type the comma
SHOOH1: HRLI C,(POINT 7,,13) ; Skip leading CRLF
SHOOH2: ILDB A,C ; Next char of header name
CAIN A,":" ; Stop on colon
JRST SHOOH3 ; ..
$CALL KBFTOR
ADDI X,1 ; Update horizontal position
JRST SHOOH2
SHOOH3: AOBJN E,SHOOH0 ; Do for all
CALLRET CRLF ; CRLF and return
SUBTTL Show commands - show aliases and show address-lists
.SHADL: TDZA U,U ; Match no bits for address-lists
.SHSYN: MOVX U,AB%INV ; Bits to match for aliases
CONFRM
HLLZ E,KWDTBL ; Get count of entries in keyword table
JUMPE E,R ; If none, just quit
MOVN E,E ; Form AOBJN ptr
HRRI E,KWDTBL+1 ; Point to first entry
MOVE A,[$CALL KBFTOR] ; What to do with chars of address string
MOVEM A,MOVDSP ; ..
.SHSY0: HRRZ A,(E) ; Get pointer to block for next entry
CAIN A,SYSCOD ; SYSTEM?
JRST .SHSY9 ; Yes, skip it
MOVE B,AB.FLG(A) ; Get flags for this entry
XOR B,U ; Match ones we're interested in?
JUMPN B,.SHSY9 ; No, skip this one
HLRZ B,(E) ; Yes, Get the synonym name pointer
HRLI B,(POINT 7,) ; Make byte ptrs
SETZM UPDX ; Horizontal postion where TOR can get to it
$TEXT (.SHSY8,< ^Q/B/ = ^A>)
MOVE X,UPDX ; Get horizontal position
TXO F,F%LCL ; Don't type our own host name
CALL MVALST ; Move address list
TXZ F,F%LCL
MOVEI B,CRLF0 ; CRLF
CALL MOVSB2 ; ..
.SHSY9: AOBJN E,.SHSY0
RET
;Call this to type chars of synonym, updates column position
.SHSY8: AOS UPDX ; Count columns
$CALL KBFTOR
RET
SUBTTL Show commands - show header-items (defined by user)
.SHHDI: NOISE (defined by user)
CONFRM
HLLZ E,HDITAB ; Get number of header-items defined
JUMPE E,R ; Just quit if none
MOVN E,E ; Form AOBJN pointer
HRRI E,HDITAB+1 ; ..
MOVE A,[$CALL KBFTOR]
MOVEM A,MOVDSP ; Instruction to handle each character
.SHHD0: HLRZ A,(E) ; Point to name of item
HRRZ B,(E) ; Point to H-block
MOVE C,HD.FLG(B) ; Get flags and type
TXNE C,HD%OPT ; Fetch appropriate words
MOVE D,[POINT 7,[ASCIZ /optional/]]
TXNE C,HD%PDF
MOVE D,[POINT 7,[ASCIZ /predefined/]]
TXNE C,HD%RQD
MOVE D,[POINT 7,[ASCIZ /required/]]
ANDI C,HD%TYP ; Isolate type field
MOVE C,HDTNAM(C) ; Get word for this type
$TEXT (KBFTOR,< define header-item ^Q/A/ (to be) ^Q/D/ ^Q/C/ ^A>)
MOVE A,HD.FLG(B) ; Get type field
MOVEI C,HD%TYP ; Isolate type code
AND C,A ; .. *** should use LOAD
; LOAD C,HDTYP,A ; Get type code
CAIN C,HD%KWD ; Keyword?
JRST [ CALL .SHHDK ; Yes, display possible keywords
JRST .SHHD1] ; Continue
TXNN A,HD%PDF ; Predefined?
JRST .SHHD1 ; No, all done with this one then
ANDI A,HD%TYP ; ***Should use LOAD
; LOAD A,HDTYP(B) ; Get type of this header-item
TXO F,F%LCL ; Don't type local host name
EXCH A,B ; Set up ACs correctly for MOVHDO
CALL @MOVHDO(B) ; Display if predefined
.SHHD1: CALL CRLF
TXZ F,F%LCL
AOBJN E,.SHHD0
RET
;Display keywords, B points to H-block
.SHHDK: MOVE A,HD.DAT+1(B) ; Get address of table
.SHHK0: HLLZ D,(A) ; Get number of elements
JUMPE D,R ; Just quit if table empty
TXZ F,F%F1 ; Init comma flag
MOVN D,D ; Form AOBJN ptr
HRRI D,1(A) ; ..
.SHHK1: HLRZ A,(D) ; Point to string name
HRLI A,(POINT 7,) ; ..
TXOE F,F%F1 ; Comma typed yet?
$TEXT (KBFTOR,<, ^A>) ; No, type comma space
$TEXT (KBFTOR,<^Q/A/^A>)
AOBJN D,.SHHK1 ; Do for all keywords
RET
SUBTTL Expunge command
DEFINE SYSWRN,< ; for neatness in code on this page
TOPS10< WARN (Use the command GET STD:MAIL.TXT to expunge messages)>
TOPS20< WARN (Use the command GET SYSTEM:MAIL.TXT to expunge messages)>
>
.EXPUN: NOISE (deleted messages)
CONFRM ; Confirm first
SKIPG MSGJFN
CWARN (No current mail file)
EXPUNG: STKVAR <NPCNT>
EXPN03: 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?
TXNE F,F%MOD ; MOD hack?
JRST [ SYSWRN ; Issue warning msg (see macro above)
RET] ; and quit now
CALL CTCLOK ; Yes, prevent ^C from stopping this scramblage
JRST [ WARN <Cannot expunge deleted messages - another reader exists>
RET] ; Quit now
TOPS10<
MOVE A,MSGJFN ; Prevent incoming mail while this goes on
CALL APPNQ0 ; ..
JRST [ WARN (Cannot expunge deleted messages - mail is arriving)
RET]
CALL CHECK0 ; See if any new mail
JRST EXPN02 ; None exists, no problem
CALL CTCOK ; Oops, some arrived -- release expunge lock
CALL APPDEQ ; Release append interlock
CALL CLOSEF ; Better go reparse it all
MOVEI B,MSGFD ; Read file again
TXO F,F%AMOD ; (Crock - sigh) don't type summary
CALL GET1 ; To prevent loss of new messages
TXZ F,F%AMOD
JRST EXPN03 ; OK, try it again
>;End TOPS10
; ..
;EXPUNGE continued...
EXPN02: CALL GETJF2 ; Get write JFN so no one interferes
JRST [ WARN <Can't open file for write, so cannot expunge>
CALL CTCOK ; Unlock file
TOPS10< CALL APPDEQ >
RET]
TOPS20<
PUSH P,X ; May be clobbered by PARSEF
CALL CHECKT ; In case new mail
POP P,X
>;End TOPS20
CITYPE < Expunging deleted messages > ; Type message
$CALL K%FLSH ; This can take a while
MOVE V,X
MOVE B,MSGADR ; Get base address of message file
IMULI B,5 ; Form character address
ADD V,B ; Add to count of good output chars
CHR2BP
MOVE O,A ; Init pointer to output area
TOPS20<
ANDI A,777000 ; Get page address of output area
MOVE C,A ; Copy for munching
SUB C,MSGADR ; Compute words not touched (to nearest pg)
LSH C,-^D9 ; Form pages not touched
HRRZ B,FILPGS ; Total pages in file
SUBI B,(C) ; Compute count of pages to be touched
EXPN01: MOVES (A)
SOJLE B,EXPN10
ADDI A,1000
JRST EXPN01
>;End TOPS20
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
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)
SKIPE MSGTO(M)
ADDM L,MSGTO(M)
SKIPE MSGMID(M)
ADDM L,MSGMID(M)
EXPN30: CAMGE M,LASTM ; At the last msg?
AOJA M,EXPN00 ; No, do next then
JUMPE L,R ; 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,BY2PAG
JUMPE C,.+2
AOJ B,
MOVEM B,NPCNT ; Save new count for later
TOPS20<
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,MSGPAG
HRLI B,.FHSLF
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
>;End TOPS20
EXPN31: SETZB B,D ; Make a null in case needed
MOVE V,X ; Form byte ptr to last byte unfilled
MOVE C,MSGADR ; First word in message file
IMULI C,5 ; First byte
ADD V,C ; Plus bytes OK gives last unfilled
CHR2BP ; ..
EXPN35: TLNN A,760000 ; Have we zapped to a word boundary?
JRST EXPN36 ; Yes, we're OK then
IDPB B,A ; No, zero rest of this word
AOJA D,EXPN35 ; Count nulls added and pad to word boundary
TOPS10<
EXPN36: MOVE B,X ; Get bytes to write
ADDI B,4 ; Force roundup
IDIVI B,5 ; Compute words
MOVNS B ; Negate for IOWD
HRLZS B ; Position for same
HRR B,MSGADR ; Address of buffer
SUBI B,1 ; minus one
MOVEM B,MSIOWD ; Store IOWD
SETZM MSIOWD+1 ; Tie off list
MOVE B,[OUT MSIOWD] ; Instruction to write file
MOVE A,MSGJF2 ; Get channel for write
LSH A,^D23 ; Into right position
IOR B,A ; Form complete instruction
XCT B
SKIPA ; OK
FATAL (Can't update message file during expunge)
CALL CLSJF2 ; Close write channel
CALL APPDEQ ; Release append interlock
CALL CLOSEF ; Close first opening as well
$TEXT (KBFTOR,<- OK>) ; Reassure user
TXO F,F%F2 ; Don't type status of file
MOVEI B,MSGFD ; Point to FD we used to open this file
CALLRET GET1 ; Get and parse file again, and return
>;End TOPS10
; ..
; ..
TOPS20<
EXPN36: MOVE A,MSGJF2 ; Write JFN
MOVE B,MSGADR ; Form byte pointer to message file
HRLI B,(POINT 7,) ; ..
MOVN C,X ; Byte count in new file
SUB C,D ; Also write nulls to end of word.
; This is necessary because GLXLIB append
; code successfully imitates TOPS10 and
; only appends to a word boundary, thus
; missing non-null bytes at the end of
; a word which aren't included in the file's
; byte count. We'll get the byte count right
; later, by using CHFDB, but we must put the
; nulls in anyway because GLXLIB will mess it
; up for us later.
SOUT ; Overwrite existing file
MOVE B,MSGPAG ; Where to map pages back
HRLI B,.FHSLF ; This fork
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 (Can't set byte count for message file)
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 (Can't set byte size for message file)
JRST EXPN32]
; JRST EXPN32
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
WARN <Internal error - SIZFIL failed at EXPN42>
$TEXT (KBFTOR,<- 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,HDN,DAT,FRM,FRN,SUB,SUN,BTS,TO,TON,TOK,MID,MIN>
AOJA X,EXPN42
>;End TOPS20
;Here when all messages deleted
EXPN34: CITYPE < All messages deleted, deleting file.
>
CALL DEQFIL ; DEQ the lock on message file
TOPS20<
HRRZ C,FILPGS
CALL UNMAPF ; Unmap pages
CALL CLSJF2 ; Close file
MOVE A,MSGJFN ; Thoroughly
CLOSF
JWARN (Cannot close message file)
MOVE A,MSGJF2
DELF ; Now delete it
JWARN (Cannot delete message file)
>;End TOPS20
TOPS10<
CALL CLSJF2 ; Close second opening, if any
CALL APPDEQ ; Release append interlock
MOVE A,MSGJFN ; Get channel of first opening
LSH A,^D23 ; Get into AC field
TLO A,(CLOSE) ; Close it first
XCT A ; ..
HRL A,MSGJFN ; Get channel again for FILOP.
HRRI A,.FODLT ; Delete function
MOVEM A,FILOPB+.FOFNC ; Stuff into FILOP. block
MOVE A,[.FOPPN+1,,FILOPB]
FILOP. A,
WARN (Cannot delete message file)
>;End TOPS10
SETOM MSGJFN ; Mark that we have no JFNs
SETOM MSGJF2
RET
TOPS20<
; Here if expunge lost
EXPNER: CMERR <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
>;End TOPS20
SUBTTL Expunge command - ENQ/DEQ Routines
;Get shared ENQ on message file (so potential expungers know not to)
SHRENQ:
TOPS20<
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)
RETSKP
>;End TOPS20
TOPS10<
MOVE A,MSGJFN ; Get IFN of message file
MOVX B,NQID ; Use standard ID
MOVEM B,ENQBLK+.ENQRI ; ..
JRST SHRNQ1
SHRNQ0: MOVX B,NQID+1 ; Use alternate ID
MOVEM B,ENQBLK+.ENQRI ; ..
SHRNQ1: IOR A,[EQ.FSR+EQ.FBL] ; ENQ for shared access, ignore level numbers
MOVEM A,ENQBLK+.ENQFL+.ENQRI+1 ; Save in ENQ. block
MOVE A,[.ENQAA,,ENQBLK] ; Acquire the lock now, fail if can't
ENQ. A, ; ..
JRST [ CAIN A,ENQQE% ; Insufficient ENQ/DEQ quota?
WARN (You have no ENQ-DEQ quota -- see your system administrator)
RET]
RETSKP
>;End TOPS10
;Make existing shared lock exclusive, to prevent scramblage
;Returns +1: Another reader exists, can't scramble the bits
; +2: Success, we're only reader and now have file locked
XCLENQ:
TOPS20<
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
>;End TOPS20
TOPS10<
CALL DEQFIL ; *** CROCK -- TOPS10 can't upgrade locks
MOVE A,MSGJFN ; Get IFN of message file
IOR A,[EQ.FBL] ; Ignore level numbers, exclusive access
MOVEM A,ENQBLK+.ENQFL+.ENQRI+1 ; ..
MOVX A,NQID ; Use standard ENQ ID
MOVEM A,ENQBLK+.ENQRI ; ..
MOVE A,[.ENQAA,,ENQBLK] ; Get exclusive access
ENQ. A, ; ..
JRST [ CALL SHRENQ ; Probably another reader
JFCL ; Restore shared lock
RET] ; and return failure
>;End TOPS10
RETSKP ; Success
;Make existing, possibly exclusive, lock shared again
SHRAGN:
TOPS20<
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
>;End TOPS20
TOPS10<
MOVE A,MSGJFN ; Get IFN of message file
IOR A,[EQ.FBL+EQ.FSR] ; Make shared, ignore level numbers
MOVEM A,ENQBLK+.ENQFL+.ENQRI+1 ; ..
MOVX A,NQID ; Use standard ENQ ID
MOVEM A,ENQBLK+.ENQRI ; ..
MOVE A,[.ENQMA,,ENQBLK]
ENQ. A,
JFCL ; Might already be shared
>;End TOPS10
RET
;Release the lock on a message file entirely
DEQFIL:
TOPS20<
MOVEI A,.DEQID ; Unlock file first
MOVEI B,NQID ; ..
DEQ
JWARN (Cannot release lock on message file)
RET
>;End TOPS20
TOPS10<
SKIPA A,[.DEQID,,NQID] ; Release this specific lock
DEQFL0: MOVE A,[.DEQID,,NQID+1] ; Alternate ID (for other users' mail files)
DEQ. A, ; ..
WARN (Cannot release lock on message file - error code %1O)
RET
>;End TOPS10
LLIT
SUBTTL Read mode commands
.READ: CALL CHECKT ; Check for recently arrived mail
CALL DFSQNW ; Get sequence, default to new
LDB A,[POINT 12,MSGSEQ,11]
CAIN A,3777 ; Any selected?
JRST [ WARN <No messages match this specification>
RET]
TXO F,F%READ ; Say in read command
READ0: CALL NXTSEQ ; 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 L,SAVEL ; Restore msg sequence pointer
CALL CMDINI ; Init this level
REDCLP: PROMPT (MS read>>)
MOVEI A,[FLDDB. (.CMKEY,,RCMDTB,,<next>)]
TXZ F,F%VBTY ; Default is not verbose-type
CALL RFIELD ; Parse a command
HRRZ A,(B) ; Dispatch
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
;Read level commands
.RQUIT: NOISE (read mode)
CONFRM ; Confirm first
CALL UPDBT0 ; Update this message
POP P,A ; Dump return address in read level loop
RQUIT0: TXZ F,F%READ
CALL @SCRRGR ; Undo fancy scroll-region stuff
CALL @SCRBTM ; Get to bottom of screen if need be
SETZM SCRLFL ; Say no longer in this stuff
CALL CHECK0 ; Any new messages?
RET ; No, quit now
CALL CHECKS ; Yes, print the message
TXZ F,F%RSCN ; Don't quit, user probably wants to read 'em
TOPS10< CALL ECHOON > ; In case monitor command
RET ; Return to caller (top level)
.RNEXT: NOISE (message in sequence)
.RNEX0: CONFRM
CALL UPDBT0 ; Update message bits
POP P,A ; Flush unused return address
JRST READ0 ; Step to next message
.RBACK: NOISE (to previous message in sequence)
JRST .RPRV0
.RPREV: NOISE (message in sequence)
.RPRV0: CONFRM
CALL UPDBT0 ; Update message bits
MOVNI A,2 ; Back byte pointer up one msg
ADJBP A,L ; ..
CAMN A,[POINT 12,MSGSEQ-1,23] ; Insure we don't back up too far
JRST [ WARN (There are no messages prior to this one in this sequence)
RET]
MOVE L,A
POP P,A ; Flush unused return address
JRST READ0 ; Step to next message
.RDELM: CONFRM ; Confrm first
JRST DELMSG ; Then delete
.RUDLM: CONFRM ; Confirm first
JRST UNDMSG ; Then undelete
.RFLAG: CONFRM ; Confrm first
FLGMSG: MOVX A,M%ATTN ; Mark as attention needed
JRST SETBIT
.RUFLG: CONFRM ; Confrm first
UFLMSG: MOVX A,M%ATTN ; Mark as unflagged
JRST CLRBIT
.RMARK: CONFRM
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
.RUNMK: CONFRM
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
.REXIT: NOISE (and update message file)
CONFRM
CALL BLANK0 ; Clear screen and undo scroll-region stuff
CALL UPDBT0 ; Update this message
TXZ F,F%READ ; No longer in read
CALLRET .EXIT0 ; Exit, remain at read lvl if cont'd.
LLIT
SUBTTL Send mode commands
.SEND: NOISE (message)
CALL SNDINI ; Reset fields
MOVEI A,[FLDDB. .CMCFM] ; Either CR or addresses must follow
CALL RFLDE ; See which it is
JRST [ CALL GETMS0 ; Addresses - parse message
JRST SEND0] ; and go handle
CALL GETMSG ; Prompt for message
SEND0: MOVE A,LSTCHR ; Get last character
CAIN A,32 ; ESC - wants more stuff
CALL SSEND0 ; ^Z - just send if off then
SEND1: TXZ F,F%ESND ; Clear this
SNDRET: TXZE F,F%ESND ; Want auto send?
JRST [ CALL SSEND0 ; Yes - do it
JRST SEND1] ; Failed, stay at send level
CALL CMDINI ; Init this level
SNDLUP: PROMPT (MS send>>)
TXZ F,F%VBTY ; Default is not verbose-type
MOVEI A,[FLDDB. (.CMKEY,,SCMDTB)]
CALL RFIELD ; Parse a command
HRRZ A,(B) ; Dispatch
CALL (A) ; ..
TXZN F,F%ESND ; Want to send it now?
JRST SNDLUP ; Nope
CALL SSEND0 ; Yes - off it goes
JRST SEND1 ; Failure, stay at send level (success
; returns to next level, not here)
.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
RET ; Failed, enter (or remain in) send level
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: POP P,A ; Dump useless return address
TXZ F,F%ESND ; Not in send command any more
RET ; Return to caller of send level
.VSTYP: TXO F,F%VBTY ; Set "verbose type" flag
.STYPE: SKIPG MSGJFN ; Have a message file?
JRST [ WARN (No current mail file)
TXZ F,F%VBTY
RET]
STKVAR <<SAVLM,2>,SAVPRI> ; Context variables for "Type"
DMOVEM L,SAVLM ; Save M (current message) and L (ptr to seq)
MOVE A,PRIORM ; and this cell
MOVEM A,SAVPRI
MOVE A,[MSGSEQ,,SAVSEQ]
BLT A,SAVSEQ+<NMSGS/3> ; Save current message sequence
PUSH P,F ; Remove read flag to prevent screen
TXZ F,F%READ ; weirdness
CALL .TYPE ; Call type routine
POP P,F ; Restore flags
MOVE A,SAVPRI ; Restore context
MOVEM A,PRIORM
MOVE A,[SAVSEQ,,MSGSEQ] ; Restore sequence
BLT A,MSGSEQ+<NMSGS/3>
DMOVE L,SAVLM
TXZ F,F%VBTY
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>)]
CALL RFIELD
SKIPA
.ERAS2: CALL CFIELD ; Parse keyword and confirm
HRRZ A,(B)
CALLRET (A)
.DISPL: NOISE (field)
MOVEI A,[FLDDB. (.CMKEY,,DCMDTB,,<all>)]
JRST .ERAS2
SUBTTL Send level commands - include (header-item)
.INCLU: NOISE (header-item)
MOVEI A,[FLDDB. (.CMKEY,,HDITAB)]
CALL CFIELD ; Parse keyword and confirm
MOVE E,B ; Put in right AC for later
HRRZ A,(E) ; Address of H-block for item
MOVE B,HD.FLG(A) ; Get flags
TXNN B,HD%PDF ; Predefined?
CALLRET INCLUD ; No, go on ahead then
WARN <Header-item is predefined, use "define" command to change>
RET
;Include user-defined header-item. Prompts user for it and stores data.
;Call: E/ Address of entry in HDITAB for item
;Returns +1: always
INCLUD: MOVE A,[POINT 7,STRBUF] ; Where to form name and colon
HLRZ B,(E) ; Get address of header-item's name
HRLI B,(POINT 7,) ; Form byte pointer
CALL MOVSTR ; Move name
MOVEI B,":" ; Colon space (for prompt)
IDPB B,A ; ..
MOVEI B," " ; ..
IDPB B,A ; ..
SETZ B, ; Insure ASCIZ
IDPB B,A ; ..
MOVE A,[POINT 7,STRBUF] ; Point to prompt string
CALL DPROMP ; Prompt
HRRZ A,(E) ; Address of H-block
CALL GETHDI ; Parse it
JFCL ; Error msg already printed
RET ; Return
;Insert file into message
.INSER: NOISE (file into message)
TOPS20<
HRROI A,[ASCIZ /txt/] ; Default extension
MOVEM A,CJFNBK+.GJEXT ; ..
>;End TOPS20
TOPS10<
SETZM CJFNBK ; Zap previous defaults
MOVE A,[CJFNBK,,CJFNBK+1]
BLT A,CJFNBK+CJFNLN-1
MOVSI A,(SIXBIT /TXT/) ; Default extension
MOVEM A,CJFNBK+.FDEXT
>;End TOPS10
CALL FSPEC ; Get a file spec
RET ; Just CR - ignore
CALL RDTXT ; Get contents of file
RET ; Error - just return
RET
SUBTTL Send level commands - save
.SAVE: MOVEI A,[FLDDB. (.CMKEY,,SVCMTB,,<draft>)]
CALL RFIELD ; Parse keyword
HRRZ A,(B) ; Get routine address
CALLRET (A) ; Go to it
.SAVDF: NOISE (in file)
TOPS20<
HRROI A,[ASCIZ /draft/] ; Default extension
MOVEM A,CJFNBK+.GJEXT ; ..
>;End TOPS20
TOPS10<
SETZM CJFNBK ; Zap previous defaults
MOVE A,[CJFNBK,,CJFNBK+1]
BLT A,CJFNBK+CJFNLN-1
MOVSI A,(SIXBIT /DRF/) ; Default extension
MOVEM A,CJFNBK+.FDEXT
>;End TOPS10
CALL GETNEW ; Get file, open for write (not append)
JRST [ WARN (No file specified)
RET]
MOVE A,[POINT 7,HDRPAG] ; First must build header text
MOVEM A,OBPTR
CALL MOVTO ; Just need to, cc, and subject
CALL MOVCC
TXO F,F%F1 ; Want CRLF first
CALL MOVSUB
MOVEI B,CRLF0 ; Separate hdrs from text
CALL MOVSB2 ; ..
SETZ A, ; Tie this off with null
IDPB A,OBPTR ; ..
MOVE A,OUTIFN ; IFN of draft file
TXO F,F%F3 ; Don't put the trailing dashes in
CALL SAVDRF ; Write headers and text
JFCL ; Don't care (msg already typed)
DMOVE A,OUTFOB ; Release chunks
CALL RELFOB ; ..
SETZM OUTIFN
RET
SUBTTL Reply command
.REPLY: CALL DFSQTH ; Get range arg
REPRET: CALL NXTSEQ ; Next message in list
RET ; Done
CALL CHKDEL ; Deleted?
JRST REPRET ; Yes - skip it
CALL CMDINI ; Init this level
MOVE A,[POINT 7,STRBUF] ; Setup prompt string in strbuf
MOVEM A,UPDPTR ; Put byte ptr where TOR can get to it
MOVEI B,1(M) ; Message #
$TEXT (REPRE0,< Reply message number ^D/B/ to: ^A>)
SETZ A, ; Insure ASCIZ
IDPB A,UPDPTR ; ..
HRROI A,STRBUF ; Point to prompt string
CALL DPROMPT
CALL .RRPL1 ; Used common reply code
JRST REPRET ; Loop over all in list
;Here by $TEXT macro above to stuff bytes
REPRE0: IDPB A,UPDPTR
RET
.RREPL: NOISE (to)
.RRPL1: TXNE F,F%RPAL ; Want default of all?
JRST [ MOVEI A,[FLDDB. (.CMKEY,,RPCMTB,,<all>)]
JRST .ERAS2]
MOVEI A,[FLDDB. (.CMKEY,,RPCMTB,,<sender-only>)]
JRST .ERAS2
.REPAL: TXOA F,F%F3 ; Say reply to everyone
.REPTO: TXZ F,F%F3 ; Say just reply to sender
TXZ F,F%CC!F%AT ; Clear some bits
CALL SNDINI ; Erase drafts
CALL CONREP ; Construct reply lines (In-reply-to,Regarding)
CALL REPSUB ; Construct the subject
MOVE V,MSGFRM(M) ; Find "from" field (for hostname defaulting,
JUMPE V,.REPL3 ; even if reply-to field present)
CHR2BP
MOVEI W,TCPAG-1 ; Where to build address list
SETZ E, ; No host name defaulting
CALL PRADDR ; Get the guy
HRRM W,TOPTRS ; Starting to pointer
SETZ E, ; assume default
TXNN F,F%AT ; Was there an @ in the main name?
JRST .REPL3 ; No, leave default at null
MOVE E,FRENM0 ; Yes, point to first name
.REPL6: ILDB B,E
JUMPE B,[SETZ E, ; If node name removed (because local node),
JRST .REPL3] ; then don't default node name
CAIE B,"@" ; Start it just after the @
JRST .REPL6
.REPL3: MOVEI T,[ASCIZ /
Reply-to: /]
PUSH P,E ; Clobbered by FNDHDR
CALL FNDHDR ; Reply-to field present?
JRST [ POP P,E ; No, use from field then
JRST .REPL0] ; ..
POP P,E
HRRZ W,TOPTRS ; Yes, add to list (reply to all)
TXNE F,F%F3 ; or only use this one?
JRST .REPL5 ; Reply-to-all -- skip deletions
MOVE B,[NAMTB0,,NAMTAB] ; Empty address lists (except for
HLRZ C,NAMTB0 ; ..
BLT B,NAMTAB(C) ; default cc-list)
MOVEI W,TCPAG-1 ; Reset addr list (but keep "from"
; JRST .REPL5 ; string in name space for host defaulting)
;Reply (cont'd.)
.REPL5: PUSH P,F ; Save state of hostname flag
CALL PRADDR ; so hostname defaulting (at PRTOCC) works
POP P,F ; Restore flags
HRRM W,TOPTRS ; Save this address
.REPL0: HRRZ A,TOPTRS ; See if any names found ("from" or "reply-to")
JUMPE A,.REPL2 ; No, go ask user then
.REPL4: TXZN F,F%F3 ; Wants reply to all addresses?
JRST .REPL1 ; No, have enuf now
MOVEI T,[ASCIZ /
To: /] ; Find start of addresses
PUSH P,E ; Save default host pointer
CALL FNDHDR
JRST [ POP P,E ; Not there, forget it
JRST .REPL1]
POP P,E ; Restore default host pointer
CALL PRTOCC ; Get to and cc lists
TXNE F,F%RPIN ; Including me in replies?
JRST .REPL1 ; Yes, don't remove myself
MOVEI U,MYDIRS ; Remove me from the list
SETZ A, ; Not removing list, just single name
CALL DOUNTO
.REPL1: CALL GETUHD ; Prompt for required header-items
CALL GETTXT ; Get text of reply
MOVX A,M%RPLY ; Mark message as replied to
IORM A,MSGBTS(M) ; Careful about updating bits
CALLRET SEND0 ; And go get more or send it off
.REPL2: WARN (Cannot tell who message is from)
CALL GETTO ; Ask him who it's to then...
HRRZ A,TOPTRS ; Anything supplied?
JUMPE A,.REPL4 ; No, don't loop...
JRST .REPL0
SUBTTL CONREP - Construct reply lines (In-reply-to and Reference)
CONREP: STKVAR <REPDAT,REPPTR>
CALL FNDSDT ; Find date msg being replied to was sent
MOVEM B,REPDAT ; Save for a bit
MOVE A,[POINT 7,REPLIN] ; Point to where this junk will go
MOVEI B,[ASCIZ /Regarding: /]
CALL MOVSTR
SKIPN V,MSGFRM(M) ; Sender known?
JRST [ MOVEI B,[ASCIZ /Your message of /]
JRST CONRP1] ; No, just mumble then...
MOVEI B,[ASCIZ /Message from /]
CALL MOVSTR ; Yes, say something intelligent
MOVEM A,REPPTR ; Preserve pointer for a bit
CHR2BP ; Get ptr to name
MOVE C,A
MOVE B,MSGFRN(M) ; and length
CONRP0: ILDB A,C ; Next byte of name
IDPB A,REPPTR ; Stuff it
SOJG B,CONRP0 ; Until done
MOVE A,REPPTR ; Set up for MOVSTx again
MOVEI B,[ASCIZ / of /] ; Make grammatical
MOVE C,MSGFRN(M) ; Get length of "from"
CAIL C,^D24 ; Will continuing on this line exceed 72 chars?
MOVEI B,[ASCIZ /
of /] ; Yes, make a continuation line then
CONRP1: CALL MOVSTR
MOVE B,REPDAT
TOPS20<
MOVSI C,(OT%NSC!OT%NCO!OT%TMZ!OT%SCL)
ODTIM ; Must use ODTIM because GLXLIB doesn't
>;End TOPS20 ; do time zones
TOPS10<
MOVEM A,UPDPTR ; Stash PTR or IFN for TOR
$TEXT (UPDTOR,<^H/B/^A>)
MOVE A,UPDPTR ; Get updated byte pointer
>;End TOPS10
SKIPN V,MSGMID(M) ; Message-ID exist for this message?
JRST CONRP3 ; No, all done then
MOVEI B,[ASCIZ /
In-reply-to: /] ; Yes, include in reply then
CALL MOVSTR
MOVEM A,REPPTR ; Save pointer for a bit
CHR2BP ; Form BP to message-ID
MOVE C,A ; Copy
MOVE B,MSGMIN(M) ; Length of message-ID
CONRP2: ILDB A,C ; Get next byte of message-ID
IDPB A,REPPTR ; Stuff it
SOJG B,CONRP2
MOVE A,REPPTR
CONRP3: MOVEI B,CRLF0 ; Tie everything off
CALLRET MOVST0
SUBTTL REPSUB - Construct subject for reply from subject of msg being answered
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,SUBJEC ; Start subject off right
SKIPA A,[POINT 7,SUBJEC,27] ; Start going into last byte
REPSB1: MOVE A,[POINT 7,SUBJEC] ; Start at start of subject
MOVEI B,STRBUF ; From here
JRST MOVST0 ; Move it and the null
LLIT
SUBTTL Repair undeliverable mail
TOPS20<
.REPAI: TRVAR <<FNAM,20>,RBUFA,RBUFP,RBUFC> ; Filename string, buffer info
TXNN F,F%DECN ; Only works for DECNET for now
CERR (Must have DECNET)
NOISE (undeliverable mail for host)
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)
HLRZ B,(B) ; Point to host table entry
MOVE A,(B) ; Get first word of string block
TLNN A,(177B6) ; Is this a flag word or text?
TXNN A,CM%FW ; ..
SKIPA ; Not flags, must be text
ADDI B,1 ; Flags, skip it
HRLI B,(POINT 7,) ; Form byte pointer
CALL TRANSH ; Translate to real host name
PUSH P,B ; Save pointer to translated name
CONFRM
MOVEI A,FNAM ; Where to build filename string
HRLI A,(POINT 7,)
MOVEI B,[ASCIZ /PS:</] ; Build ptr to connected directory
CALL MOVSTR
MOVEI B,MYDIRS
CALL MOVSTR
MOVEI B,[ASCIZ />]--UNDELIVERABLE-DECNET-MAIL--[./]
CALL MOVSTR
POP P,B ; Restore hostname ptr
CALL MOVSTR
MOVEI B,[ASCIZ /./] ; Punctuate
CALL MOVST0 ; Move dot and a null
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
MOVE B,[1,,.FBSIZ] ; Get size of file, in bytes
MOVEI C,A ; Return in A
GTFDB ; ..
JUMPE A,[WARN <Dead letter is empty>
MOVE A,DEDJFN
RLJFN
JFCL
RET]
MOVEM A,RBUFC ; Save byte count
ADDI A,<1000*5>-1 ; Force roundup
IDIVI A,<1000*5> ; Compute pages required
MOVEM A,RBUFP ; Save page count
$CALL M%AQNP ; Allocate space for dead letter
JUMPF [CWARN (Can't parse dead letter - insufficient memory)]
LSH A,^D9 ; Form word address of buffer
MOVEM A,RBUFA ; Save
HRLI A,(POINT 7,) ; Form byte pointer
MOVE B,A ; Set up for SIN ("The wages of SIN is death")
MOVE A,DEDJFN ; Read from this file
MOVE C,RBUFC ; These many bytes
SETZ D, ; Stop on null
SIN ; Read the dead letter
MOVE A,RBUFA ; Pass pointer to text to PRSDRF
HRLI A,(POINT 7,) ; ..
MOVE B,RBUFC ; and count
CALL PRSDRF ; Parse draft
CALLRET .REPAX ; Oops... release buffer and return now
CALL .REPAX ; Release buffer pages
CALL .DSALL ; Type dead letter
SETZM LSTCHR ; Signal no ctrl-Z or anything
CALL SEND0 ; Give user opportunity to correct and resend
CALLRET DEDFLS ; OK, he had his chance, delete it now
;(Still in TOPS20)
;(Still in TOPS20)
;Release buffer pages allocated by .REPAI
.REPAX: SKIPN B,RBUFA ; Any space allocated?
RET ; No, just quit
LSH B,-^D9 ; Yes, form page number
MOVE A,RBUFP ; Get page count
$CALL M%RLNP ; Release them
RET
;(Still in TOPS20)
;Still in TOPS20
;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
MOVEI A,FNAM ; Build filename string with wild generation
HRLI A,(POINT 7,)
MOVE B,FNPTR ; Start with string passed to us
CALL MOVSTR ; ..
MOVEI B,[ASCIZ /*/] ; Add star and null
CALL MOVST0 ; ..
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
;Still in TOPS20
;Still in TOPS20
;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
$TEXT (KBFTOR,<There are ^D/T/ dead letters, numbered ^A>)
MOVEI E,GENLST ; Form fresh pointer to list again
HRLI E,(POINT 18,) ; ..
ILDB B,E ; Get next generation number
SELEC4: ILDB D,E ; Get next JFN
JUMPE D,SELEC5 ; Last one?
$TEXT (KBFTOR,<^D/B/^A>); No, type it
CAIE T,2 ; No comma if only two letters
$TEXT (KBFTOR,<,^A>) ; Type comma space
$TEXT (KBFTOR,< ^A>)
MOVE B,D ; Next JFN
JRST SELEC4 ; Go for next
SELEC5: $TEXT (KBFTOR,<and ^D/B/.>) ; Fancy English grammar
PROMPT (Which one would you like to repair? )
MOVEI A,[FLDDB. (.CMNUM,,^D10)]
CALL CFIELD ; Get the number and confirm
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
;(Still in TOPS20)
;Still in TOPS20
;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
MOVEI A,FNAM ; Where to build filespec string
HRLI A,(POINT 7,)
MOVE B,FNPTR ; Pointer to start of filespec
CALL MOVSTR
MOVE B,E ; Generation number
MOVEI C,^D10
NOUT ; Add to filespec
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: $SAVE <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
DEDFLS: MOVE A,DEDJFN
DELF ; Delete the file
JCERR (Can't delete dead letter)
CLOSF ; And close it
JFCL
SETZM DEDJFN ; Remember no more dead letter
RET
>;End TOPS20
SUBTTL Retrieve commands - retrieve last-message
;Recover-last-message -- puts user back into send level after having
; sent something and belatedly realizing that, say, an address was
; missing
.RECOV: NOISE (and enter send level)
CONFRM
SKIPN A,TOPTRS ; See if address lists empty
JRST .RECV1
CAME A,TOPTR0 ; ..
JRST .RESD2 ; No, go ahead with it then
.RECV1: SKIPN A,TXTPTR ; No addresses, is there any text?
JRST .RECV2 ; Nope, this is silly then
MOVE B,TXTFPG ; Point to first page of text
ADD B,[POINT 7,TB.TXT] ; Form virgin ptr for comparison
CAME A,B ; Is TXTPTR virgin?
JRST .RESD2 ; No, OK
.RECV2: WARN (There is no previous message draft)
RET
SUBTTL Retrieve commands - retrieve saved-draft
;Retrieve saved-draft -- parses saved draft and enters send mode
.RESDF: TRVAR <<DFOB,2>,DIFN,DBUF,DPGS,DSIZ>
; FOB, IFN, bfr addr, pages, size (bytes)
NOISE (from file)
SETZM DSIZ ; Init size in bytes of draft
SETZM DBUF ; No buffer pages yet
CALL SNDINI ; Init draft
TOPS20<
HRROI A,[ASCIZ /draft/] ; Default extension
MOVEM A,CJFNBK+.GJEXT ; ..
>;End TOPS20
TOPS10<
SETZM CJFNBK
MOVE A,[CJFNBK,,CJFNBK+1]
BLT A,CJFNBK+CJFNLN-1 ; Zap previous fields
MOVSI A,(SIXBIT /DRF/) ; Default extension
MOVEM A,CJFNBK+.FDEXT
>;End TOPS10
CALL FSPEC ; Get a IFN
JRST [ WARN (No file specified)
RET]
DMOVEM A,DFOB ; Save FOB info
$CALL F%IOPN ; Open for read
JUMPF [ WARN (Can't read draft)
DMOVE A,DFOB
CALLRET RELFOB]
MOVEM A,DIFN ; Save IFN
MOVX B,FI.SIZ ; Get size of file in bytes
$CALL F%INFO ; ..
IDIVI A,5*1000 ; ..
ADDI A,1 ; Round up
MOVEM A,DPGS ; Remember how many we take
$CALL M%AQNP ; Get the pages
JUMPF [ WARN (Can't read draft file -- insufficient memory)
JRST .RESD1] ; Release file blocks and return
LSH A,^D9 ; Compute address of buffer
MOVEM A,DBUF
HRLI A,(POINT 7,) ; Point to it
MOVE C,A ; Safer AC
; JRST .RESD0
.RESD0: MOVE A,DIFN
$CALL F%IBYT ; Get a byte
JUMPF [ CAIE A,EREOF$ ; EOF?
WARN (Error reading draft)
JRST .RESD1] ; Release file blocks
JUMPE B,.RESD0 ; Ignore nulls
AOS DSIZ ; Count bytes in draft
IDPB B,C ; Stuff into text pag
JRST .RESD0 ; Keep going
.RESD1: SETZ A, ; Insure ASCIZ
IDPB A,C ; ..
MOVE A,DIFN
$CALL F%REL ; Close file
DMOVE A,DFOB ; Release file info blocks
CALL RELFOB
MOVE A,DBUF ; Address of buffer
HRLI A,(POINT 7,) ; Point to draft
SKIPE B,DSIZ ; Size of draft, in bytes
CALL PRSDRF ; Parse the draft
CALLRET .RESDX ; Error - release pages and return now
CALL .RESDX ; Release buffer pages
.RESD2: CALL .DSALL ; Type current draft
SETZM LSTCHR ; No special action
JRST SEND0 ; Enter send mode
;Release buffer pages, if any, used by .RESDF
.RESDX: SKIPN B,DBUF ; Any buffer allocated?
RET ; No
LSH B,-^D9 ; Yes, form page number
MOVE A,DPGS ; Number of pages
$CALL M%RLNP ; Release 'em
RET
SUBTTL Retrieve commands - retrieve saved-draft - PRSDRF - parse draft
;Here to parse a draft and insert good info into send buffer
;Call:
; A/ Byte pointer to draft
; B/ Byte count
; CALL PRSDRF
;Return +1: failure, probably bad syntax in draft
; +2: OK, send buffers all set up
PRSDRF: STKVAR <DRFSIZ,DRFPTR> ; Size of draft, pointer to it
MOVEM A,DRFPTR ; Save pointer
MOVEM B,DRFSIZ ; and size
MOVEI A,TCPAG-1 ; Init to list pointer
MOVEM A,TOPTRS ; ..
MOVE A,DRFPTR ; Get pointer to draft again
BP2CHR ; Form character pointer
MOVEM V,DRFPTR ; Remember for later
MOVE W,DRFSIZ ; Length of draft
MOVEI T,[ASCIZ /
To: /] ; Look for addressee lists
CALL SEARCH ; ..
JRST [ WARN (Can't find To field in draft)
RET]
SETZ E, ; No hostname defaulting
CALL PRTOCC ; Fetch to and cc lists into new draft
MOVE B,TOPTRS ; Did PRTOCC find anybody?
CAIN B,TCPAG-1 ; ..
SETZM TOPTRS ; No, don't confuse MOVTO then
MOVE V,DRFPTR ; Point at start again
MOVE W,DRFSIZ ; ..
MOVEI T,[ASCIZ /
Subject: /] ; Find subject
CALL SEARCH ; ..
JRST PRSDR1 ; Not there
MOVE B,[POINT 7,SUBJEC] ; Copy to subject area
PRSDR2: ILDB C,A ; Next byte
CAIN C,15 ; Stop at CR
JRST PRSDR3 ; ..
IDPB C,B
JRST PRSDR2
PRSDR3: SETZ A, ; Put null at end
IDPB A,B ; ..
; ..
; ..
PRSDR1: MOVE V,DRFPTR ; Search through entire msg
MOVE W,DRFSIZ ; ..
MOVEI T,[ASCIZ /
/] ; For end of header area (two CRLFs)
CALL SEARCH ; ..
JRST RSKP ; No text, I guess
CALL TXTPUT ; Ok, move everything up to null to text area
RETSKP ; Give good return
SUBTTL COPY, FILE, and MOVE commands - Move messages into files
;COPY just sopies the message
;MOVE copies and then deletes
;FILE copies and then asks the user if deletion is desired (a la EMS)
.FILE: DMOVE A,[PUTMSG
[ASCIZ / Filed: /]]
CALL .MOVE0 ; Call common code
CALL CMDINI ; Init this level
TXNN F,F%READ ; Read mode?
JRST .FILE0 ; Yes, be a little cleverer about the prompt
PROMPT < Delete this message from current message file? >
JRST .FILE1
.FILE0: PROMPT < Delete from current message file the message(s) just filed? >
.FILE1: CALL YESNO ; Get a yes or no
RET ; No, just return
TXNE F,F%READ ; Read mode?
CALLRET DELMSG ; Yes, this is easy
DMOVE A,[DELMSG ; No, set up for SEQUEN
[ASCIZ / Deleted: /]]
DMOVEM A,DOMSG ; Save dispatch
SETOM LSTMSG ; Re-init message sequencer states
MOVE L,[POINT 12,MSGSEQ] ; ..
CALLRET SEQUE0 ; Delete 'em and return
YESNO: MOVEI A,[FLDDB. (.CMKEY,,<[2,,2
[ASCIZ /no/],,0
[ASCIZ /yes/],,1]>,,<no>)]
CALL CFIELD ; Get the answer
HRRZ A,(B) ; Get the code
JUMPE A,R ; 'no' -- nonskip
RETSKP
.PUT: DMOVE A,[PUTMSG
[ASCIZ / Copied: /]]
SKIPA
.MOVE: DMOVE A,[MOVMSG
[ASCIZ / Moved: /]]
.MOVE0: DMOVEM 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: )
TOPS20<
HRROI A,[ASCIZ /txt/] ; Default extension
MOVEM A,CJFNBK+.GJEXT ; ..
HRROI A,[ASCIZ /DSK/] ; Default device
MOVEM A,CJFNBK+.GJDEV ; ..
SETZM CJFNBK+.GJDIR ; No default for directory
>;End TOPS20
TOPS10<
SETZM CJFNBK ; Zap previous defaults
MOVE A,[CJFNBK,,CJFNBK+1]
BLT A,CJFNBK+CJFNLN-1
MOVSI A,(SIXBIT /TXT/)
MOVEM A,CJFNBK+.FDEXT
>;End TOPS10
CALL GETOUT ; Get output file
JRST [ WARN (No output file specified)
RET]
.PUT1: CALL SEQUE0 ; go handle the sequence
.PUT2: MOVE A,OUTIFN
$CALL F%REL ; Close file
SETZM OUTIFN
DMOVE A,OUTFOB ; Release chunks
CALL RELFOB ; ..
RET
.RPUT1: NOISE (into file)
TOPS20<
HRROI A,[ASCIZ /txt/] ; Default extension
MOVEM A,CJFNBK+.GJEXT ; ..
>;End TOPS20
TOPS10<
SETZM CJFNBK ; Zap previous fields
MOVE A,[CJFNBK,,CJFNBK+1]
BLT A,CJFNBK+CJFNLN-1
MOVSI A,(SIXBIT /TXT/)
MOVEM A,CJFNBK+.FDEXT ; Default extension
>;End TOPS10
CALL GETOUT ; Get output file
JRST [ CMERR (No output file specified)
RET]
.RPUT2: CALL @DOMSG ; Process it
JRST .PUT2 ; And go close it up
.LIST: MOVEI A,LPTMSG
MOVEI B,[ASCIZ / Listed: /]
DMOVEM A,DOMSG
TXNE F,F%READ
JRST .RLIS1
CALL DFSQTH ; Get sequence
CALL GETLPT ; Open LPT for output
RET ; Failure, return
TXNN F,F%HLPT ; Headers wanted on LPT output?
JRST .PUT1 ; No, skip this then
PUSH P,L ; Yes, save initial msg pointer
.LIST0: CALL NXTSEQ ; Get next msg in sequence
JRST [ POP P,L ; Done, restore original sequence
MOVE A,OUTIFN ; Put headers on separate page
MOVEI B,14 ; ..
$CALL F%OBYT ; ..
CALLRET .PUT1] ; Go print the messages and return
CALL TYPHDR ; Type header for this message
JRST .LIST0 ; Go through 'em all
.RLIS1: NOISE (on line-printer)
CONFRM
CALL GETLPT
RET ; Failure, just quit
JRST .RPUT2
SUBTTL Forward
.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 GETCC ; ..
CALL GETTXT ; Get initial comments
MOVE A,TXTPTR ; Get pointer to text field
MOVE B,TXTFPG ; Address of first text page
ADD B,[POINT 7,TB.TXT] ; Form virgin text pointer
CAMN A,B ; Is buffer empty?
JRST .FORW1 ; Yes, no need to check crlf
LDB C,A ; Get last char
MOVEI A,CRLF0
CAIN C,12 ; Unless have crlf
JRST .FORW1
CALL TXTPUT ; Put one in
.FORW1: TXNE F,F%READ ; If not in read
JRST .RFORW
.FORW2: CALL NXTSEQ ; 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
;Here to move forwarded message into text buffer
.FORWD: MOVEI A,[ASCIZ /- - - - - - - Begin message from: /]
CALL TXTPUT
SKIPN V,MSGFRM(M) ; Original sender
JRST [ MOVEI A,[ASCIZ /(Unknown)/]
CALL TXTPUT
JRST .FRWD1]
CHR2BP ; Form byte pointer to sender
MOVE B,MSGFRN(M) ; Length of from field
CALL TXTCPT ; Move counted string to text
.FRWD1: MOVEI A,[ASCIZ /
/] ; add a CRLF
CALL TXTPUT ; ..
CALL FORMSG ; Include text
MOVEI A,[ASCIZ /- - - - - - - End forwarded message
/]
CALL TXTPUT ; Move this out
RET ; And return
FORMSG: SKIPN A,MSGFRM(M) ; Has an author?
JRST FORMS2 ; No
MOVE B,[POINT 7,SUBJEC]
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 C,MSGBON(M) ; Length
JUMPE C,R ; No body? return
MOVE V,A
CHR2BP ; Form byte pointer to it
MOVE D,A ; Better AC
FORMS3: ILDB A,D ; Move all nonnull chars
JUMPE A,FORMS4 ; ..
CALL TXTCHR ; to text area
FORMS4: SOJG C,FORMS3 ; ..
RET
FORMSS: JUMPE C,R ; None to do
MOVE V,A
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
LLIT
SUBTTL Routines to open output files and write messages to them
;GETOUT - Parse filespec and open for append
;GETNEW - Same, but open for write
;GETPRS - Parse filespec only, don't open
GETPRS: TXO F,F%F2 ; Note parse-only
GETNEW: TXZA F,F%F1 ; Note flavor
GETOUT: TXO F,F%F1 ; ..
TOPS20<
MOVX A,GJ%MSG ; Just message
MOVEM A,CJFNBK+.GJGEN
SETZM CJFNBK+.GJNAM ; No default name
HRROI A,CRFPRT ; Default protection
SKIPE CRFPRT ; if specified
MOVEM A,CJFNBK+.GJPRO ; ..
>;End TOPS20
MOVEI A,[FLDDB. (.CMCFM,,,,,[FLDDB. (.CMFIL,CM%SDH,,<filespec>)])]
CALL FSPEC0 ; Parse filespec and set up FOB
JRST [TXZ F,F%F2 ; Don't leave bits lying around
RET]
DMOVEM A,OUTFOB ; Remember this FOB
TXZE F,F%F2 ; Only want to parse filespec?
RETSKP ; Yes, just quit now
MOVE C,[$CALL F%OOPN] ; Decide which open flavor to use
TXNE F,F%F1 ; Want append instead of clobber?
MOVE C,[$CALL F%AOPN] ; Yes, do append call
XCT C ; Open the file
JUMPF [ MOVE A,OUTFOB+1 ; Get FOB address
MOVE A,FOB.FD(A) ; Point to FD for error message
$TEXT (KBFTOR,<?Can't open ^F/(A)/ for write because: ^E/[-1]/>)
SETZM OUTIFN
DMOVE A,OUTFOB ; Deallocate chunks
CALLRET RELFOB] ; and return
MOVEM A,OUTIFN ; Save IFN
RETSKP
;Open LPT for output
;Return +1: failure, message already printed
; +2: success, IFN of printer in OUTIFN
GETLPT: STKVAR <LPTFD>
MOVEI A,FDXSIZ ; Allocate space for largest FD
$CALL M%GMEM ; ..
JUMPF GETLPE ; No room
HRLZM A,.FDLEN(B) ; Stuff length into FD
MOVEM B,LPTFD ; Save address
MOVE A,B
TOPS20<
HRLI A,(POINT 7,) ; Form byte pointer
ADDI A,.FDSTG ; Where filespec goes
MOVEI B,[ASCIZ /LL:MS-Output.LST/]
CALL MOVST0
MOVE A,LPTFD ; Restore FD address
>;End TOPS20
TOPS10<
DMOVE B,[SIXBIT /LL/
SIXBIT /MS-OUT/]
DMOVEM B,.FDSTR(A)
MOVE B,[SIXBIT /LST/]
MOVEM B,.FDEXT(A)
>;End TOPS10
CALL ALCFOB ; Allocate and link FOB
JRST GETLPE ; No room
DMOVEM A,OUTFOB ; Save address
$CALL F%OOPN ; Open for write
JUMPF GETLPX ; Hmmm... go try LPT instead of LL
MOVEM A,OUTIFN ; Save IFN
RETSKP
GETLPX: MOVE A,LPTFD ; Try LPT, LL didn't work
TOPS20<
HRLI A,(POINT 7,)
ADDI A,.FDSTG
MOVEI B,[ASCIZ /LPT:MS-Output.LST/]
CALL MOVST0
>;End TOPS20
TOPS10<
MOVE B,[SIXBIT /LPT/]
MOVEM B,.FDSTR(A)
>;End TOPS10
DMOVE A,OUTFOB ; Retry the open
$CALL F%OOPN ; ..
JUMPF [ DMOVE A,OUTFOB ; Don't lose chunks
CALL RELFOB
JRST GETLPE]
MOVEM A,OUTIFN ; Save IFN
RETSKP
GETLPE: $TEXT (KBFTOR,<?Can't open LPT for output because: ^E/[-1]/>)
RET ; Failure return
MOVMSG: CALL CHKDEL
RET
CALL PUTMS1
JRST DELMSG ; Move deletes message
LPTMSG: CALL PUTMSG ; Put it out there
MOVX A,M%DELE ; Skip for deleted messages
TDNE A,MSGBTS(M) ; ..
RET
MOVE A,OUTIFN
MOVEI B,14 ; Form feed
$CALL F%OBYT
RET
;PUTMSG - write message to a file, IFN in OUTIFN
; Constructs new header line from scratch, in case file damage
; has garbaged the one in the message file. At worst, this will
; make a bad assumption about the message date (today, if real
; date can't be found)
PUTMSG: CALL CHKDEL ; Not deleted msgs
RET
PUTMS1: HRRZ B,MSGBTS(M) ; Get message bits
$TEXT (PUTMSW,<^H/MSGDAT(M)/,^D/MSGBON(M)/;^O12R0/B/>)
MOVE V,MSGBOD(M) ; Get start of the message body
CHR2BP
MOVE D,A ; Safer AC for byte ptr
SKIPN C,MSGBON(M) ; Length
RET ; Zero length (file damage) -- don't write
PUTMS2: MOVE A,OUTIFN
ILDB B,D
$CALL F%OBYT ; Write to the file
SOJG C,PUTMS2 ; Count down bytes
RET
PUTMSW: MOVE B,A ; Put byte in right AC for F%OBYT
MOVE A,OUTIFN ; Where to write this one
$CALL F%OBYT
RET
; Get tty modes
TOPS20<
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
>;End TOPS20
SUBTTL CHECK command - Check for new mail
.CHECK: NOISE (for new messages)
CONFRM
; CALLRET CHECKT ; Check and type stuff if new msgs
CHECKT: CALL CHECK0 ; Check for new messages
RET ; None
; CALLRET CHECKS ; There are some, announce them
; Print message when there are new guys
CHECKS: MOVE A,MSGJFN ; Set JFN
TOPS20< 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
TOPS20<
AOJ M, ; From that one on,
CALL PARSEF ; Parse these new ones
>;End TOPS20
TOPS10<
CALL CLOSEF ; TOPS10 can't read the new stuff, so
MOVEI B,MSGFD ; we must close and read the whole shebang
TXO F,F%AMOD ; Crock to avoid printing status info
CALL GET1 ; This will also parse file
TXZ F,F%AMOD
>;End TOPS10
POP P,A ; Get old number
MOVEI M,1(A) ; For headers (TYPHDR)
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:
>
MOVEI E,(A) ; Get number of new messages
CHECK1: PUSH P,E ; TYPHDR is hairy and clobbers most ACs
CALL TYPHDR ; Announce each new message
ADDI M,1 ; ..
POP P,E
SOJG E,CHECK1 ; ..
POP P,M ; Restore current message
CIETYP < Currently at message %M.
>
MOVEI A,^D5 ; Five seconds
CALLRET RDELAY ; Delay if read mode and exit
;Check to insure a message isn't deleted
CHKDEL: MOVX A,M%DELE
TDNN A,MSGBTS(M) ; Deleted?
RETSKP ; No, skip return
CIETYP < Message %M is deleted.
>
RET ; Single return
;Check to see if new mail has appeared
;Return +1: no new mail
; +2: new mail exists, caller should parse it
CHECK0: SKIPG MSGJFN ; Have a file?
CALLRET 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 [ WARN (Can't determine existence of new mail)
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
TOPS20<
SETREF: PUSH P,A ; Save jfn
$CALL I%NOW
MOVE C,A ; Save time
$CALL I%NOW ; 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
>;End TOPS20
;Check if MAIL.TXT has appeared
CHKNEW: CALL GETFIL ; Has it?
RET ; Nope - return
SETOM LASTM ; Flag for full parse
SETZ M, ; Current message
RETSKP
LLIT
SUBTTL Lower level subroutines
;These routines moved to external module (MSX) to prevent autopatch theft
; of MS (sigh, autopatch really bites it)
REPEAT 0,<
; 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
>;End REPEAT 0
;Universal Text Output Routine which uses UPDPTR
; Called from $TEXT macros all over the place
UPDTOR: IDPB A,UPDPTR
$RET
;Handy routine necessary 'ciz GLXTXT doesn't necessarily zero
; B (S2) before calling TOR
KBFTOR: JUMPE A,[$RET] ; This is dumb until definition of $RET changes
PUSH P,B
SETZ B,
$CALL K%BUFF
POP P,B
$RET
; Close the file
CLOSEF: SKIPG MSGJFN ; Any message JFN?
JRST CLOSF1 ; No, skip this
CALL DEQFIL ; Release ENQ lock
MOVE A,MSGJFN
TOPS20<
CLOSF ; Close it
JWARN (Cannot close message file)
>;End TOPS20
TOPS10<
CALL CLSFIL
>;End TOPS10
CLOSF1: SETOM MSGJFN
TOPS20<
SKIPLE A,MSGJF2
RLJFN
JFCL
>;End TOPS20
TOPS10<
SKIPLE MSGJF2
CALL CLSJF2
>;End TOPS10
SETOM MSGJF2
TXZ F,F%AMOD!F%MOD ; Clear MOD hack bits
SKIPN A,MSGPGS ; Any buffer space allocated?
RET ; No, quit now
MOVE B,MSGPAG ; Yes, get its address
$CALL M%RLNP ; Release it
SETZM MSGPGS ; Remember it's gone
RET
;Unmap pages from file
; Number of pages in C
UNMAPF:
TOPS20<
SETO A,
MOVE B,MSGPAG
HRLI B,.FHSLF
HRLI C,(PM%CNT)
PMAP
>;End TOPS20
RET
SUBTTL File parsing subroutines
GETFIL: CALL FNDFIL ; Try to find it first
RET ; Not there, forget it
GETFLL: SKIPN FILSIZ ; Is the file empty?
JRST [ MOVE A,MSGJFN ; Yes, get JFN into A for message
TOPS20<
CIETYP ( There are no messages in %1J.)
RLJFN ; Get rid of the jfn
JFCL
>;End TOPS20
TOPS10<
$TEXT (KBFTOR,<% There are no messages in ^F/MSGFD/>)
LSH A,^D23 ; Release message file channel
IOR A,[RELEASE]
XCT A
>;End TOPS10
SETOM MSGJFN
RET]
CALL SHRENQ ; Get shared ENQ on file
WARN (Can't lock message file)
SETZ M, ; Must parse all messages
CALLRET PARSEF ; And return
; Try to find a MAIL.TXT
FNDFIL:
TOPS20<
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 ; Before opening, to get last read correct
JRST CLOSEF ; Error message already printed
MOVE A,MSGJFN ; Get JFN back again
MOVEI B,OF%RD!OF%FDT ; Force read date/time update
OPENF
JRST FNDFL5
>;End TOPS20
TOPS10<
MOVEI A,MSGFD ; Message file FD
MOVE C,MYDIR ; Point to my U-block
MOVEI B,FDXSIZ ; Size of FD
HRLZM B,.FDLEN(A) ; Store size
MOVE B,UB.STR(C) ; Get structure for MAIL.TXT
MOVEM B,.FDSTR(A) ; ..
MOVE B,[SIXBIT /MAIL/]
MOVEM B,.FDNAM(A)
MOVE B,[SIXBIT /TXT/]
MOVEM B,.FDEXT(A)
MOVE B,UB.PPN(C)
MOVEM B,.FDPPN(A)
CALL INILKB ; Init FILOP.'s LOOKUP/ENTER block
CALL FILOPR ; Open for read
JRST [ JUMPE A,R ; If not found, just quit
CALL FILERR ; Else type FILOP. error message
WARN <%Can't open message file>
RET]
MOVEM A,MSGJFN ; Save channel no. of message file
CALL SIZFIL ; Get the size of the file, etc.
JRST CLOSEF ; Error - close file
>;End TOPS10
RETSKP ; Skip return
TOPS20<
FNDFL4: SKIPG A,MSGJFN ; Get rid of stray jfns
JRST FNDFLX ; None, I guess...
RLJFN
JFCL
FNDFLX: 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
>;End TOPS20
TOPS10<
;INILKB - Init LOOKUP/ENTER block pointed to by FILOP. block
;Call: A/ address of FD for file
;Return +1: always
INILKB: HLRZ B,.FDLEN(A) ; Get length of this FD
CAIG B,.FDPPN+1 ; Is there room for an SFD spec?
JRST INILK1 ; No, don't fetch crud then
MOVE C,.FDPPN(A) ; Get PPN or path pointer
TLNN C,-1 ; Which flavor?
JRST INILK2 ; PPN, use it
SETZM PBLOCK ; Path, zero path block
MOVE C,[PBLOCK,,PBLOCK+1]
BLT C,PBLOCK+7 ; ..
HRLI C,.FDPPN(A) ; BLT the path block from the FD
HRRI C,PBLOCK+2 ; to out path block
ADDI B,PBLOCK+1-.FDPPN ; ..
BLT C,(B) ; ..
MOVEI C,PBLOCK ; Point lookup block at
MOVEM C,LKB+.RBPPN ; our path block
JRST INILK3
INILK1: MOVE C,.FDPPN(A) ; Move PPN
INILK2: MOVEM C,LKB+.RBPPN ; ..
INILK3: MOVE B,.FDNAM(A) ; Name
MOVEM B,LKB+.RBNAM ; ..
MOVE B,.FDEXT(A) ; Extension
MOVEM B,LKB+.RBEXT ; ..
MOVE B,.FDSTR(A) ; Structure name
MOVEM B,MSGSTR ; Doesn't go in LOOKUP block
MOVEI B,.RBTIM+1 ; Length of block
MOVEM B,LKB+.RBCNT ; ..
RET
;FILOPW - Open file for write (superseding)
;FILOPU - Open file for update, single-access
;FILOPR - Open file for read in multiple-access mode
;Call: with LKB inited
;Return +1: No channels left or file can't be opened
; +2: OK, with channel in A
FILOPW: MOVX A,.FOWRT ; Open for write only
JRST FILOP0
FILOPU: SKIPA A,[.FOSAU] ; Multiple access update
FILOPR: MOVX A,.FORED ; Read
FILOP0: HRRZM A,FILOPB+.FOFNC ; Stuff into FILOP. block
SETZM LKB+.RBSIZ ; Zero unused stuff in LOOKUP/ENTER block
MOVE B,[LKB+.RBSIZ,,LKB+.RBSIZ+1]
BLT B,LKB+.RBTIM
STKVAR <CHAN>
$CALL F%FCHN ; Get a free channel
JUMPF [ WARN <Can't open file, no free channels>
RET]
MOVEM A,CHAN ; Remember for later
HRLM A,FILOPB+.FOFNC ; Stuff into FILOP. block
MOVX A,.IODMP ; Dump mode
MOVEM A,FILOPB+.FOIOS ; ..
MOVE A,MSGSTR ; Structure name
MOVEM A,FILOPB+.FODEV ; ..
SETZM FILOPB+.FOBRH ; No buffers
SETZM FILOPB+.FONBF ; ..
MOVEI A,LKB ; Point to LOOKUP block
MOVEM A,FILOPB+.FOLEB
SETZM FILOPB+.FOPAT ; No paths supported yet
MOVE A,MYPPN ; Do access checking
MOVEM A,FILOPB+.FOPPN ; ..
MOVSI A,(1B0) ; Light bit saying "use privileges"
IORM A,FILOPB+.FOFNC ; ..
MOVE A,[.FOPPN+1,,FILOPB]
FILOP. A, ; Open the file
JRST [ EXCH A,CHAN ; Save error code, fetch channel
CALL CLSFIL ; Release this channel
MOVE A,CHAN ; Return error code to caller
RET] ; Failure return
MOVE A,CHAN ; Return channel to caller
RETSKP
;FILERR - Type error message corresponding to FILOP. failure
;Call with error code in A
FILERR: CALL CRIF ; Left margin please
CAIL A,ERFNF% ; Range check
CAILE A,ERJCH% ; ..
JRST FILER0
MOVE A,ERRTAB(A) ; Get ptr to appropriate error message
$TEXT (KBFTOR,<%File operation failed: ^Q/A/>)
RET
FILER0: $TEXT (KBFTOR,<%File operation failed: unknown FILOP. error ^O/A/>)
RET
;LOOKUP/ENTER error message table
DEFINE ERRT(STRING),<
POINT 7,[ASCIZ |STRING|]
>
ERRTAB: ERRT <ERFNF% (0) - File not found>
ERRT <ERIPP% (1) - Nonexistent UFD>
ERRT <ERPRT% (2) - Protection failure>
ERRT <ERFBM% (3) - File being modified>
ERRT <ERAEF% (4) - File already exists>
ERRT <ERISU% (5) - Illegal sequence of monitor calls>
ERRT <ERTRN% (6) - Device or data error>
ERRT <ERNSF% (7) - Not a save file>
ERRT <ERNEC% (10) - Not enough core>
ERRT <ERDNA% (11) - Device not available>
ERRT <ERNSD% (12) - No such device>
ERRT <ERILU% (13) - Illegal monitor call>
ERRT <ERNRM% (14) - No room or quota exceeded>
ERRT <ERWLK% (15) - File structure is write-locked>
ERRT <ERNET% (16) - Insufficient monitor table space>
ERRT <ERPOA% (17) - Partial allocation only>
ERRT <ERBNF% (20) - Block not free on allocated position>
ERRT <ERCSD% (21) - Cannot supersede a directory>
ERRT <ERDNE% (22) - Cannot delete nonempty directory>
ERRT <ERSNF% (23) - SFD not found>
ERRT <ERSLE% (24) - Search list empty>
ERRT <ERLVL% (25) - SFDs nested too deeply>
ERRT <ERNCE% (26) - Can't create file on any structure in search list>
ERRT <ERSNS% (27) - GETSEG of nonexistent segment>
ERRT <ERFCU% (30) - Cannot update file>
ERRT <ERLOH% (31) - Page overlap error>
ERRT <ERNLI% (32) - Not logged in>
ERRT <ERENQ% (33) - File has ENQ locks outstanding>
ERRT <ERBED% (34) - Bad EXE file directory>
ERRT <ERBEE% (35) - File's extension is not EXE>
ERRT <ERDTB% (36) - EXE file directory too big>
ERRT <ERENC% (37) - Network capacity exceeded>
ERRT <ERTNA% (40) - Task not available>
ERRT <ERUNN% (41) - Unknown network node specified>
ERRT <ERSIU% (42) - SFD is in use (rename)>
ERRT <ERNDR% (43) - File has an NDR block>
ERRT <ERJCH% (44) - Job count too high (A.T. read count overflow)>
>;End TOPS10
SUBTTL File parsing subroutines - SIZFIL - Get size of current file
SIZFIL: STKVAR <SAVJFN,CHN0>
MOVEM A,SAVJFN ; Save JFN
TOPS10<
CALL FILOPR ; Open current file for read
JRST [ CALL FILERR
WARN <Can't determine size of message file>
RET]
MOVEM A,CHN0 ; Save channel number
MOVX A,.FOCLS ; Now close this channel
HRL A,CHN0 ; ..
MOVEM A,FILOPB+.FOFNC ; ..
MOVE A,[.FOPPN+1,FILOPB]
FILOP. A,
JRST [ CALL FILERR
WARN <Can't close second opening of message file>
RET]
MOVE A,CHN0 ; Get channel again
LSH A,^D23 ; Position
TLO A,(RELEASE) ; Release the channel
XCT A ; ..
MOVE A,LKB+.RBSIZ ; Get word count for file
IMULI A,5 ; Form byte count
MOVEM A,FILSIZ ; Save number of bytes
ADDI A,BY2PAG-1 ; Round up
IDIVI A,BY2PAG ; ..
MOVEM A,FILPGS ; and pages (blocks)
MOVE A,LKB+.RBTIM ; Get creation date/time
MOVEM A,FILCRV ; Store
MOVEM A,FILWRT ; Shit... TOPS10 doesn't offer write date?
RETSKP
>;End TOPS10
;(TOPS20 portion on next page)
;SIZFIL - (Fall through from previous page)
TOPS20<
MOVE B,[5,,.FBBYV]
MOVEI C,FILPGS
GTFDB ; Get the size stuff
ERJMP [JRETER (GTFDB failed on message file)
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,BY2PAG ; 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 [ CAMLE V,T ; Use smaller page count, to prevent
MOVE V,T ; illegal memory reads
HRRM V,FILPGS ; ..
RETSKP]
FFFFP ; Look for first free page
HRRM A,FILPGS ; and use it.
HRRZS A ; Get just page count
IMULI A,BY2PAG ; Compute byte count
CAMGE A,FILSIZ ; If FDB byte count too big,
MOVEM A,FILSIZ ; prevent ill mem reads in PARSEF
RETSKP
>;End TOPS20
LLIT
SUBTTL File parsing subroutines - PARSEF - Parse the file from message (M) on
TOPS20<
PARSEF: JUMPE M,[HRRZ C,FILPGS ; number of pages in file
SETZ D, ; starting at first page
JRST PARSF2] ; And go map it all in
MOVE C,MSGALL-1(M) ; Get start of message
MOVE A,MSGADR ; Get base address of message file
IMULI A,5 ; Form byte address
SUB C,A ; Compute byte offset in file of last msg
MOVE B,MSGALN-1(M) ; Get its length also
ADDI B,1(C) ; Get size of file in bytes plus one
IDIVI B,BY2PAG ; Get first page we will need
MOVEI D,(B) ; That is first file page
HRRZ C,FILPGS
SUBI C,(B) ; Get real page count
PARSF2: SKIPE B,MSGPAG ; Buffer already allocated?
JRST [ HRRZ A,FILPGS ; Yes, get total file page count
CAMG A,MSGPGS ; Will the new stuff fit?
JRST PARSF3 ; Yes, go read it
MOVE A,MSGPGS ; No, must get new buffer
$CALL M%RLNP ; Release pages
SETZ M, ; Parse entire file again
SETZM MSGPAG ; ..
JRST PARSEF] ; ..
HRRZ A,FILPGS ; Pages in file
ADDI A,20 ; plus slop for new messages
MOVEM A,MSGPGS ; Remember how many we allocated
$CALL M%AQNP ; Allocate space to map file
JUMPF [ WARN (Message file too big - can't allocate enough memory)
RET]
MOVEM A,MSGPAG ; Save page number
MOVE B,A ; ..
LSH A,^D9 ; and address
MOVEM A,MSGADR ; ..
SETZB D,M ; We're reading from beginning of file
PARSF3: ADD B,D ; Compute first page to read into
HRL A,MSGJFN ; File they come from
HRR A,D ; Page of file to start with
HRLI B,.FHSLF
HRLI C,(PM%CNT!PM%RD!PM%CPY!PM%PLD) ; Start the I/O now, please
PMAP ; Map them in
JRST PARSF5 ; Go parse the newly-read stuff
>;End TOPS20
TOPS10<
PARSEF: SKIPN B,MSGPAG ; Any buffer to release first?
JRST PARSF1 ; No
MOVE A,MSGPGS ; Yes, get size
$CALL M%RLNP ; Release pages
PARSF1: MOVE A,FILSIZ ; Get byte count of file
ADDI A,<5*1000>-1 ; Force roundup
IDIVI A,<5*1000> ; Compute pages needed for file
MOVEM A,MSGPGS ; Remember
$CALL M%AQNP ; Acquire the pages
JUMPF [ WARN (Can't read message file - insufficient memory)
RET]
MOVEM A,MSGPAG ; Save addr of buffer
LSH A,^D9 ; Word address
MOVEM A,MSGADR ; Save
MOVE B,FILSIZ ; Byte count again
ADDI B,4 ; Force roundup
IDIVI B,5 ; Compute words in file
MOVE C,MSGJFN ; Channel to read
LSH C,^D23 ; Position into AC field
CALL READF ; Read gobs of stuff
FATAL (Cannot read message file)
JRST PARSF5 ; Go parse what we read
;Read stuff from file
;Call:
; A/ address of input buffer
; B/ word count
; C/ channel number in AC field
READF: STKVAR <WCNT,BADR> ; Current count and address
MOVEM A,BADR
MOVEM B,WCNT
READF0: CAILE B,377777 ; Max count in one operation
MOVEI B,377777
MOVE A,BADR ; Buffer address
ADDM B,BADR ; Update in case 2nd read needed
MOVN B,B ; Negate wd cnt for IOWD
HRLM B,MSIOWD
ADDM B,WCNT ; Adjust for words read
MOVEI A,-1(A) ; Buffer-1
HRRM A,MSIOWD
MOVE A,[IN MSIOWD] ; Instruction to read
IOR A,C ; Get channel
XCT A ; Read the stuff
SKIPA ; OK
RET ; Failure return
SKIPE B,WCNT ; Anything left to read?
JRST READF0 ; Yes, go get it
RETSKP ; No -- all done
>;End TOPS10
;Here after reading a new chunk of message file - parse new stuff
PARSF5: SETZ V, ; Assume
MOVE A,MSGADR ; Address of message buffer
IMULI A,5 ; Byte address of buffer
ADD V,A ; Compute number of first byte in file
JUMPE M,PARS10 ; Start at start
MOVE V,MSGALL-1(M) ; Or at end of last message
MOVE U,MSGALN-1(M)
ADD V,U
PARS10: CHR2BP ; Get byte pointer to this
MOVEM V,MSGALL(M) ; start of whole message
PARS11: ILDB T,A ; Get character
JUMPE T,[CALL CHKEOF ; Running off end of file?
JRST [ AOS MSGALN-1(M) ; Credit null to length of previous msg
JRST PARS10] ; Keep eating nulls
SUBI M,1 ; Yes - this isn't a real msg,
JRST PARSEX] ; just trailing nulls - don't count it
CAIE T,","
JRST [ CALL CHKEOF ; Running off end of file?
JRST PARS11 ; No, keep looking
CMERR (File has bad format - last message has no size field)
SETZM MSGBON(M) ; Zap length
JRST PARSEX]
MOVEI C,^D10 ; Decimal
CALL .NIN
CAIE D,";" ; Genuine count, and not some random number?
JRST PARS11 ; No, random number -- keep trying
MOVEM B,MSGBON(M) ; Save length of real message
MOVEI C,10 ; Octal
CALL .NIN
CAIE D,15 ; Better be terminated with CR
JRST PARS11 ; Isn't -- must be imitation header line
HRRZM B,MSGBTS(M) ; Save message bits
HRLM B,MSGBTS(M)
; ..
; ..
PARS12: ILDB T,A
CAIE T,12 ; Until end of line
JRST [ CALL CHKEOF ; Running off end of file?
JRST PARS12 ; No, keep looking
CMERR (File has bad format - Cannot find start of last message)
JRST PARSEX]
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 A,MSGBTS(M) ; Get message bits
TRNN A,M%ATTN ; Flagged?
TRNN A,M%SEEN ; or not seen?
CALL PRSMS0 ; Yes to either, parse msg and flag valid
POP P,V ; Recover ending address
CALL CHKEF0 ; See if EOF yet
AOJA M,PARS10 ; No, keep going
PARSEX: CAIL M,2000 ; Have tables overflowed?
FATAL (Too many messages in file)
CAIL M,2000-^D200 ; Getting near max no. msgs (1024)?
WARN <Message file almost overflowing: MOVE or DELETE messages, please>
MOVEM M,LASTM ; Save total number of messages
RET
SUBTTL File parsing subroutines - PRSMSG, PRSMS0 - parse single message
;PRSMSG - Parse a single message, preserving all temp ACs
;PRSMS0 - Parse message for code willing to have ACs stomped on
PRSMSG: $SAVE <A,B,C,D,E> ; For sensitive callers
PRSMS0: MOVE V,MSGBOD(M) ; Get beginning of message body
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 PRSMS1] ; ..
BP2CHR ; Convert to char pointer
SUB V,MSGBOD(M) ; Compute length of header area
MOVEM V,MSGHDN(M) ; and save it away
PRSMS1: MOVX A,M%VALI ; Flag that this msg has valid info
IORM A,MSGBTS(M) ; ..
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 FNDTO ; Find "to" list
MOVEM V,MSGTO(M) ; Where
MOVEM W,MSGTON(M) ; Size of first line
MOVEM X,MSGTOK(M) ; Size of entire field
CALL FNDMID ; Find message-ID
MOVEM V,MSGMID(M)
MOVEM W,MSGMIN(M)
CALL FNDDAT ; Find the date
MOVEM B,MSGDAT(M) ; Receive date
AOJN B,R ; Not found (ie., -1)?
CALL FNDSDT ; Yes, try for send date then
MOVEM B,MSGDAT(M) ; ..
RET ; All done!
;.NIN - Parse a number pointed to by A, radix in C
.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
;Check to see if byte pointer in A has gone past EOF
;Return +1: No, byte pointer is OK
; +2: Yes, you've run off the end
CHKEOF: BP2CHR ; Convert to character pointer
CHKEF0: MOVE B,MSGADR ; Word address of 1st word in file
IMULI B,5 ; Byte address of 1st byte
MOVE C,V ; Don't clobber V
SUB C,B ; Compute byte offset into file
CAMGE C,FILSIZ ; Off the end yet?
RET ; No, nonskip
RETSKP ; Yes, skip
; 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 message-ID
FNDMID: MOVEI T,[ASCIZ /
Message-ID: /]
JRST FNDSB4 ; Use common code
; Find "To" field. Returns position in V, length of first line in
; W (for headers command), length of entire field in X
FNDTO: MOVEI T,[ASCIZ /
To: /]
FNDTO0: CALL FNDHDR ; Find it
JRST [ SETZB V,W ; say didn't find it
SETZ X,
RET]
SETZ W, ; Count size of first line in W
FNDTO1: ILDB T,A ; Look for EOL
CAIE T,15 ; ..
AOJA W,FNDTO1 ; ..
MOVE D,W ; OK, W has length of first line...
FNDTO2: MOVE X,D ; Save candidate for end of field
ADDI D,1 ; Count CR in case next line is continuation
FNDTO4: ILDB T,A ; See if next line is continuation
SKIPE T ; Ignore nulls
CAIN T,12 ; Ignore LF
AOJA D,FNDTO4 ; ..
CAIE T,40 ; Is first char of line Linear White Space?
CAIN T,11 ; ie., space or tab?
AOJA D,FNDTO3 ; Yes, keep counting
RET ; Not continuation, return size of whole field
FNDTO3: ILDB T,A ; Get next char of this line
CAIN T,15 ; Until CR
JRST FNDTO2 ; CR found, see if continuation
AOJA D,FNDTO3 ; Still in this line... count away
;Find cc field, similar to FNDTO
FNDCC: MOVEI T,[ASCIZ /
cc: /]
JRST FNDTO0 ; Join common code
; Find the date field
FNDDAT: MOVE V,MSGALL(M) ; First thing in header is recv date
CHR2BP
TOPS20<
SETZB B,C
IDTIM
ERJMP [CMERR (File has bad format - message %M has no receive date)
SETO B, ; supply a random one (now)
RET]
>;End TOPS20
TOPS10<
CALL XDATI ; *** Call date/time crock
JUMPF [ CMERR (File has bad format - message %M has no receive date)
SETO B,
RET]
>;End TOPS20
RET
FNDSDT: MOVEI T,[ASCIZ /
Date: /]
CALL FNDHDR
JRST FNDDT1 ; Not there
TOPS20<
SETZB B,C
IDTIM ; Try to parse it, will skip on success
>;End TOPS20
TOPS10<
CALL XDATI ; *** Call date/time crock
JUMPF FNDDT1 ; Failure, use receive date
SKIPA ; Success, keep date just parsed
>;End TOPS10
FNDDT1: MOVE B,MSGDAT(M) ; Bad format, use recv date
RET
;*** Crock to get around S%DATI bugs
XDATI: STKVAR <<DATTIM,10>> ; Where to make copy of date/time
MOVEI C,DATTIM
HRLI C,(POINT 7,) ; Point to this space
MOVEI B,^D39 ; Maximum chars in string allowed
XDATI0: ILDB D,A ; Skip leading spaces
CAIN D,40 ; ..
JRST XDATI0 ; ..
XDATI1: IDPB D,C ; OK, first nonspace
SOJLE B,XDATIE ; Watch for overflow
ILDB D,A ; Get next
CAIE D,"," ; Watch out for cruddy strings
CAIN D,15 ; ..
JRST XDATIE ; ..
CAIE D,";" ; ..
CAIN D,12 ; ..
JRST XDATIE ; ..
CAIE D,40 ; Watch for spaces
JRST XDATI1 ; Not space, keep going
MOVEI D,":" ; Stupid GLXLIB now demands colon before time!
IDPB D,C ; Just pass one space
SOJLE B,XDATIE ; ..
XDATI2: ILDB D,A ; Space, eat all but one
CAIN D,40 ; Another?
JRST XDATI2 ; Yes, skip it
XDATI3: IDPB D,C ; Nonspace, pass along
SOJLE B,XDATIE
ILDB D,A ; Next char
CAIE D,15
CAIN D,"," ; Terminator?
JRST XDATI4 ; Yes, almost done
CAIE D,12
CAIN D,73 ; Semicolon
JRST XDATI4
JRST XDATI3 ; No, keep passing characters
XDATI4: SETZ D, ; Insure ASCIZ
IDPB D,C
SOJLE B,XDATIE
MOVEI A,DATTIM ; Point to remodelled string
HRLI A,(POINT 7,) ; ..
MOVX B,CM%IDA!CM%ITM
$CALL S%DATI
RET
;Here if DATTIM overflows
XDATIE: MOVEI A,1(M)
WARN (Badly formatted date-time field in message %1D)
SETO B, ; Return current date/time
RET
LLIT
SUBTTL File parsing subroutines - SEARCH - fast string search
; 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
SUBI V,2 ; Include CRLF before 1st item in search
ADDI W,2 ; because headers must begin with CRLF
CALL SEARCH ; try to find it
RET ; No good
AOS (P)
BP2CHR ; Form char pointer
RET ; and return
SEARCH: HRLI T,(<POINT 7,0>)
SETZB A,U
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
CHR2BP ; Get byte pointer
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
MOVE E,W ; Make trashable copy of length
SETZ B, ; Init index to search table
EQSTR1: JUMPL E,EQSTR2 ; If subject text gone, quit
SKIPN C,SRCBUF(B) ; Get next char
JRST [ POP P,(P) ; Toss A, caller wants the update
RETSKP] ; Null, we found a match
ILDB D,A ; Get next char
JUMPE D,[SOJG E,.-1 ; Ignore nulls which MAILER inserts
JRST EQSTR2] ; Subject exhausted, quit
CAIN D,(C) ; Matches?
AOJA B,[SOJA E,EQSTR1] ; Yes, keep trying
TRC D,(C) ; Try case indept
CAIN D,40
AOJA B,[SOJA E,EQSTR1] ; Yes, keep trying
EQSTR2: POP P,A ; No match - restore pointer
IBP A ; and advance one character
RET
SUBTTL PRADDR - Parse address lists in received mail
;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: TRVAR <SAVB,HSTBEG,NAMBEG,<TEMP,10>,SRC>
MOVE U,FRENAM
MOVEM A,SRC ; Stash source string ptr
PRADD0: TXZ F,F%AT ; No @ seen yet
MOVEI T,(U) ; Save pointer for later
PRADD1: ILDB B,SRC ; 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,42 ; Start of quoted string?
JRST PRADD9 ; Yes, eat to matching quote
CAIN B,":"
JRST PRADDL ; This is start of list of addresses
CAIN B,"(" ; ( - search for matching )
JRST PRADD4
CAIE B,","
CAIN B,15 ; End of line or this address
JRST PRADD5
CAIN B,";" ; End of named address-list?
JRST PRADD5 ; Yes, that ends this name as well
CAIN B,"<" ; Opening bracket?
JRST PRNET6 ; Yes - flush what we've got
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,SRC ; Get next
JRST PRADD2
;We've parsed the name of a list of addresses - increment list depth
; and store name
PRADDL: MOVEI A,(T) ; Point to string
AOS LDEPTH ; Increment depth
TXO A,AD%PFX ; Flag this as prefix to list
AOS W ; Step to next table entry location
MOVEM A,(W) ; Store this entry
SETZ A, ; Insure ASCIZ
IDPB A,U ; ..
MOVEI U,1(U) ; Step to next free string space location
MOVEI B,"," ; Pretend comma so coming address gets scanned
JRST NXTAD1 ; Continue parsing
; Skip to ")"
PRADD4: IDPB B,U
ILDB B,SRC
CAIE B,")"
JRST PRADD4
JRST PRADD3
; Skip to close quote (same as PRADD4)
PRADD9: IDPB B,U
ILDB B,SRC
CAIE B,42
JRST PRADD9
JRST PRADD3
;Here when address terminator is seen (comma, semicolon, or EOL)
; Default hostname if none given and defaulting requested
; B/ terminating character
; E/ byte pointer to default hostname
PRADD5: TXNN F,F%AT ; "at" seen?
CALL NETDEF ; No, default the hostname then
PRADD6: MOVEM B,SAVB ; Save terminating character
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
TOPS20<
MOVX A,RC%EMO ; Exact match only
RCUSR
ERJMP PRADD7 ; Not a user, go see if SYSTEM
TXNN A,RC%NOM ; Match?
JRST ADDAD0 ; Yes - add to list
>;End TOPS20
TOPS10<
HRLI B,(POINT 7,) ; Form byte pointer to name
MOVEI A,USRTAB ; See if known local user
$CALL S%TBLK ; ..
TXNE B,TL%EXM ; Exact match?
JRST [ HRRZ C,(A) ; Yes, get ptr to PPN
JRST ADDAD0] ; Go add to table
>;End TOPS10
PRADD7: HRRO A,T ; See if special
HRROI B,[ASCIZ "SYSTEM"]
$CALL S%SCMP ; See if strings match
JUMPN A,NOUSER ; Jump if no match (no such user)
MOVEI C,SYSCOD ; Match, supply code
JRST ADDAD0 ; and proceed
;Routine to insert the default hostname, pointed to by E
NETDEF: SKIPN D,E ; Is there a default hostname?
RET ; No, return
MOVEI C,"@" ; Yes, do the atsign
IDPB C,U ; ..
MOVEM U,HSTBEG ; Save pointer to hostname for later
TXO F,F%AT ; Flag that we have a net address
NETDF1: ILDB C,D ; Move hostname now
JUMPE C,[RET] ; If null, return
IDPB C,U
JRST NETDF1
;No such user name - issue warning
NOUSER: CITYPE <% No such user: >
MOVE A,NAMBEG ; Print name parsed
$CALL KBFTOR
$TEXT (KBFTOR,< - ignored^M>)
JRST FLSADR ; continue scan
;Check for valid host name
CHKHNM: TXNN F,F%ARPA!F%DECN!F%ANFX ; 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
$CALL S%TBLK ; See if in table
TXNN B,TL%EXM ; Exact match only!
JRST CHKHN2 ; Oops - ask user for help
TXNE F,F%XMLR ; XMAILR/HOSTS2 type host table?
JRST [ CAMN A,LSITE ; Yes, is this the local host?
JRST CHKLCL ; Yes, treat differently
SETO C, ; Nope - set net flag
JRST ADDAD0] ; Go add address to list
MOVE A,(A) ; Non-XMAILR -- get host flags
TXNN A,NT%LCL ; Local host?
JRST [ SETO C, ; No, set net flag
JRST ADDAD0] ; And add address to list
CHKLCL: SETZ B, ; Local host - zap host name with leading null
DPB B,HSTBEG ; ..
JRST PRADD8 ; Go validate local username and add to list
CHKHN2: $TEXT (KBFTOR,<% No such host: ^Q/NAMBEG/>)
WARN < Enter new host name or CR to ignore.
>
PROMPT <Host: >
MOVEI A,[FLDDB. (.CMCFM,,,,,[FLDDB1 (.CMKEY,,HOSTAB,<-1,,HSTHLP>)])]
CALL RFIELD
MOVE A,CR.COD(A) ; Get code
CAIN A,.CMCFM ; Just CR?
JRST FLSADR ; Yes - skip this entry
HLR B,(B) ; Append new host name
MOVE A,(B) ; Get potential flags word
TLNN A,(177B6) ; First byte empty?
TXNN A,CM%FW ; And flags bit lit?
SKIPA ; No, must be text
ADDI B,1 ; Yes, skip to text word then
HRLI B,(POINT 7,) ; Form byte pointer
MOVE A,HSTBEG ; Where old (bad) hostname begins
CALL MOVST0 ; Overwrite with good name
MOVE U,A ; Update new free pointer
CONFRM ; Get CRLF
SETO C, ; Flag as net address
JRST ADDAD0 ; 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
ADDAD0: HRRZ B,C ; User number or code
HRL B,T ; Pointer to string
MOVEI A,NAMTAB ; Name string table
$CALL S%TBAD ; Attempt to add
JUMPF FLSADR ; Reclaim space (dupl entry)
AOS W ; Step to next entry
HRRZM T,(W) ; Save pointer to string
MOVEI U,1(U)
ADDAD1: MOVE B,SAVB ; Restore terminator character
ADDAD2: CAIE B,";" ; End of named list?
JRST NXTADR ; No, check for comma
SOSGE LDEPTH ; Watch nesting level
JRST [ WARN (Too many terminators in named address list)
SETZM LDEPTH
JRST .+1]
AOS W ; Make room for next entry
MOVX C,AD%SFX ; Stuff the suffix into the list
MOVEM C,(W) ; ..
ILDB B,SRC ; Get char after semicolon
MOVEM B,SAVB ; For NXTADR
JRST ADDAD2 ; Check for nested lists
;Flush current address because of some bogosity and keep parsing
FLSADR: MOVEI U,(T) ; Reclaim unused string
JRST ADDAD1 ; Go check to see if this was last in a list
;Go on to next address in the list
NXTADR: MOVE B,SAVB ; Restore break character
NXTAD1: CAIN B,"," ; more names?
JRST NXTAD2 ; Yes - check for ,<crlf>
NXTAD4: HRRZ T,FRENAM ; No - end of line then
MOVEM U,FRENAM ; Update free space
CAIE T,(U) ; If no names gotten,
JRST NXTAD3
TXNN F,F%CC ; Must undo update to pointer
HRRZ W,TOPTRS
TXNE F,F%CC
HLRZ W,TOPTRS
NXTAD3: MOVE A,SRC ; Return updated source pointer to caller
SKIPN LDEPTH ; Insure all named lists terminated
RET ; OK, return to caller
WARN <Message has bad format: unterminated named address list>
MOVX C,AD%SFX ; Generate all terminators required
NXTAD5: AOS W ; Next loc in list please
MOVEM C,(W) ; Hallucinate a terminator
SOSE LDEPTH ; In case nested lists, do all levels
JRST NXTAD5 ; ..
RET
;Comma seen - check line continuation
NXTAD2: MOVE A,SRC ; Get temp source pointer for lookahead
ILDB B,A ; Peek ahead to next char
CAIE B,15 ; Maybe <CR>?
JRST PRADD0 ; No, just parse next address then
ILDB B,A ; Yes, skip <LF> also
MOVEM A,SRC ; Update source pointer
ILDB B,A ; See if next line starts with LWSP
CAIE B,40 ; Does it start with space or tab?
CAIN B,11 ; ..
JRST PRADD0 ; OK, this is continuation - get next address
JRST NXTAD4 ; Nope -- this line has spurious comma then
;Check possible net address
PRNETA: ILDB B,SRC
CAIN B," "
JRST PRNETA
CAIN B,"@" ; Allow space-atsign-space host delimiter
JRST PRNETB ; ..
CALL ATP ; Is this the word "at"?
JRST [ MOVEI B," " ; No, assume multi-word username.
IDPB B,U ; Insert the space...
LDB B,SRC ; Re-prime the pump with next nonspace
JRST PRADD2] ; character and keep scanning.
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,SRC
CAIN B," "
JRST PRNET1 ; Flush any intermediate spaces
PRNET2: IDPB B,U
ILDB B,SRC
CAIN B,">" ; Terminating bracket?
JRST PRNET3 ; Yes - skip to end
CAIN B,";" ; End of address list?
JRST PRADD6 ; Yes, add this addr and check for next
CAIE B,"," ; End of single address?
CAIN B,15 ; ..
JRST PRADD6 ; Yes, tie off string and validate
CAIE B," " ; Eat trailing spaces
JRST PRNET2
CALL ATP ; Is this the word "at"?
JRST PRNET3 ; No, assume trailing whitespace
PRNET0: SETZ B, ; Yes, tie off the string so far (ASCIZ)
IDPB B,U ; ..
EXCH U,HSTBEG ; Save this host ptr, restore preceding
PRNT0A: MOVEI A,TEMP ; Copy the preceding hostname to TEMP
HRLI A,(POINT 7,) ; ..
MOVEI B,[ASCIZ / at /] ; only 1st replace "@" with " at "
CALL MOVSTR ; ..
MOVE B,U ; Point to beginning of preceding hostname
CALL MOVST2 ; Move preceding hostname to TEMP, with null
MOVNI A,1 ; Form byte pointer to preceding hostname - 1
ADJBP A,U ; so we will stomp on the @
MOVEI B,TEMP ; Move " at <preceding-host-name>" on top
HRLI B,(POINT 7,) ; of "@<preceding-host-name>"
CALL MOVST1 ; ..
MOVE U,A ; Point to end of preceding hostname
MOVEI B,"@" ; Fetch real hostname marker
JRST PRNETB ; Go do the hostname bit again
PRNET3: ILDB B,SRC
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
;Here if open wedge seen -- discard stuff parsed so far and continue parsing
PRNET6: TXZ F,F%AT ; Forget "@" seen
MOVEI U,(T) ; Reset string pointer
HRLI U,(<POINT 7,0>)
ILDB B,SRC ; Get next character
JRST PRADD2 ; Try again
;Try to parse the word "at", followed by a space. Call with B already
; containing the suspect for the letter "a", or leading whitespace
; before the suspect, and SRC pointing to it.
;
;Return +1: failure, SRC not changed
; +2: success, SRC moved over the word and the trailing space
ATP: CAIE B," " ; Do we have leading whitespace to skip?
JRST ATP0 ; No
ILDB B,SRC ; Yes, gobble it upt
JRST ATP ; ..
ATP0: CAIE B,"a"
CAIN B,"A" ; Allow either case
SKIPA A,SRC ; Is an "a", fetch the source pointer
RET ; Oops, failure
ILDB B,A ; Get candidate for "t"
CAIE B,"t"
CAIN B,"T"
SKIPA
RET
ILDB B,A ; Now check for space
CAIE B," "
RET
MOVEM A,SRC ; Winnage, update SRC
RETSKP ; and give skip return
;Flush this field
SKPADR: MOVEI U,(T)
SKPAD1: ILDB B,SRC
CAIE B,","
CAIN B,15
JRST NXTAD1
JRST SKPAD1
;Flush comments
SKPCOM: ILDB B,SRC
CAIE B,")"
JRST SKPCOM
JRST PRNET3
; Get to and cc lists from message
PRTOCC: 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
TXZE 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,PRTO11 ; Already a list started
HLRZ W,TOPTR0 ; Reinit if empty so far
JUMPN W,PRTO11 ; Any default cc list started?
MOVEI W,TCPAG+400-1 ; No, start it now
JRST PRTO11 ; And go get more
LLIT
SUBTTL Type header line for a message (HEADERS command)
.RHEAD: NOISE (of this message)
CONFRM
TYPHDR: CALL CRIF ; CRLF if needed
SKIPG A,OUTIFN ; File or terminal?
MOVX A,.PRIOU ; No, must be to TTY then
SETZB C,D
MOVE T,MSGBTS(M) ; Get message's bits
TXNE T,M%SEEN
SKIPA B,[" "]
MOVEI B,"N" ; New
CALL TBOUT
TXNN T,M%ATTN
SKIPA B,[" "]
MOVEI B,"F" ; FLAGGED
CALL TBOUT
TXNN T,M%RPLY
SKIPA B,[" "]
MOVEI B,"A" ; Answered
CALL TBOUT
TXNN T,M%DELE
SKIPA B,[" "]
MOVEI B,"D" ; Deleted
CALL TBOUT
MOVEI B,1(M) ; Message number
$TEXT (TYPHD9,<^D4R /B/ ^A>)
TXNN T,M%VALI ; Message parsed yet?
CALL PRSMS0 ; No, go parse it
SKIPG B,MSGDAT(M) ; Date
JRST [ $TEXT (TYPHD9,< ^A>) ; Fill with spaces if not there
JRST TYPHD2]
$TEXT (TYPHD9,<^H6R /B/^A>)
; ..
; ..
TYPHD2: SKIPG A,OUTIFN ; File or TTY
MOVX A,.PRIOU ; ..
MOVEI B," " ; Delimit this column
CALL TBOUT ; ..
MOVEI B,^D20 ; Limited to 20 chars
MOVE A,MSGFRM(M) ; "From" field
MOVE C,MSGFRN(M) ; Size
CALL TYPFME ; Is this message from me?
SKIPA ; No...
JRST [MOVE A,MSGTO(M) ; Yes, use "to" field instead
MOVE C,MSGTON(M) ; ..
SUBI A,4 ; Show "To: "
ADDI C,4 ; ..
JRST TYPHD1]
TXNE F,F%PRSN ; Personal name only?
CALL TYPPRN ; Yes, extract it and point A to it
TYPHD1: CALL TYPHDS ; Type the field
JUMPE B,TYPHD3 ; None more needed
MOVE C,B ; Make room
MOVEI B," "
SKIPG A,OUTIFN ; LPT, file, or terminal?
MOVX A,.PRIOU ; Terminal
CALL TBOUT
SOJG C,.-1 ; Fill with spaces
TYPHD3: SKIPG A,OUTIFN ; File or TTY...
MOVX A,.PRIOU ; ..
MOVEI B,"|" ; Delimit this column with vertical bar
CALL TBOUT ; ..
MOVE A,MSGSUB(M) ; Subject field
SKIPG B,LINEW ; Get tty line width
MOVEI B,^D72 ; If unknown or weird, assume 72
SUBI B,^D50 ; Make rest of line fit
MOVE C,MSGBON(M) ; Get character count of msg
CAIL C,^D100 ; If length>100, need another column
SUBI B,1 ; ..
CAIL C,^D1000 ; If length>1000, need another
SUBI B,1 ; ..
CAIL C,^D10000 ; etc. etc.
SUBI B,1 ; 5 columns ought to do it!
MOVE C,MSGSUN(M) ; Size of subject field
CALL TYPHDS
SKIPG A,OUTIFN
MOVX A,.PRIOU
SETZB C,D
HRROI B,[ASCIZ / (/]
CALL TSOUT
MOVE B,MSGBON(M) ; Length of message
MOVEI C,^D10 ; Base 10
CALL TNOUT
JFCL
HRROI B,[ASCIZ / chars)
/]
CALL TSOUT ; Finish off line
RET
;Here from $TEXT macros above
TYPHD9: MOVE B,A ; Character
SKIPG A,OUTIFN ; File
MOVEI A,.PRIOU ; or terminal
CALL TBOUT
$RET
TYPHD8: IDPB A,UPDPTR ; Just stuff it
RET
;TYPFME - Check to see if current message is from me
;Return +1: no
; +2: yes
TYPFME: $SAVE <A,B,C> ; Don't clobber temps
STKVAR <<TMPST,20>> ; Temporary string space
MOVE V,MSGFRM(M) ; Point to beginning of "from" field
MOVE W,MSGFRN(M) ; Length of "from" field
CHR2BP ; Form byte pointer
MOVEI B,TMPST ; Pointer to temp space
HRLI B,(POINT 7,) ; ..
TXZ F,F%F1 ; Init real-name flag
TYPFM0: SOJL W,TYPFM3 ; Eat leading LWSP first
ILDB C,A ; ..
CAIE C," " ; ..
CAIN C,11 ; ..
JRST TYPFM0 ; LWSP, ignore it
JRST TYPFM2 ; OK, have non-LWSP char to examine now
TYPFM1: SOJL W,TYPFM3 ; Insure that we don't run off end of field
ILDB C,A ; Next char of "from" field
TYPFM2: CAIN C,42 ; Beginning of quoted string?
JRST [ SOJL W,TYPFM3 ; Yes, ignore - can't be real name
ILDB C,A ; ..
CAIE C,42 ; End of quoted string?
JRST . ; No, eat chars
JRST TYPFM0] ; Yes, start interpreting chars again
CAIE C,12 ; Stop at LF
CAIN C,15 ; or CR
JRST TYPFM3 ; ..
CAIE C,"(" ; or start of comment
SKIPN C ; or null
JRST TYPFM3 ; ..
TXNE F,F%F1 ; Inside real name yet?
CAIE C,">" ; If so, check for closure
SKIPA ; Not inside real name
JRST TYPFM3 ; Real name closed, quit now
CAIN C,"<" ; Start of (trailing) real name?
JRST [ MOVEI B,TMPST ; Yes, discard personal name
HRLI B,(POINT 7,) ; Start checking real name
TXO F,F%F1 ; Flag this
JRST TYPFM0]
IDPB C,B ; Character seems OK, stuff it
JRST TYPFM1
TYPFM3: SETZ C, ; End of string, insure ASCIZ
IDPB C,B ; ..
MOVEI B,TMPST ; Now scan what we've got to isolate 1st word
HRLI B,(POINT 7,)
TYPFM4: ILDB A,B ; For each character,
CAIN A," " ; if a space,
JRST [ SETZ A, ; Space ends 1st word, so
DPB A,B ; tie it off ASCIZ-wise
JRST TYPFM5] ; Now we can do the compare
JUMPN A,TYPFM4 ; Until null found, loop
TYPFM5: HRROI A,MYDIRS ; Compare extracted name
HRROI B,TMPST ; with my name
$CALL S%SCMP ; ..
JUMPE A,RSKP ; A=0 implies match, so skip return
RET ; No match, nonskip return
SUBTTL TSOUT - simulate a SOUT
TSOUT: STKVAR <SIFN,PTR> ; IFN, source ptr
TLC B,-1 ; Check for TOPS20-style string ptr
TLCN B,-1 ; ..
HRLI B,(POINT 7,)
TLC A,-1
TLCN A,-1
HRLI A,(POINT 7,)
MOVEM A,SIFN
MOVEM B,PTR ; Save source ptr
TXZ F,F%F1 ; Assume zero byte count
SKIPE C ; Is it?
TXO F,F%F1 ; No, remember significance of C
TSOUT0: MOVE A,SIFN ; IFN
ILDB B,PTR ; Next byte
TXNN F,F%F1 ; Is byte count significant?
JRST [ JUMPE B,TSOUTX ; No, null? done...
JRST TSOUT1] ; More to come... type it
SKIPLE C ; Positive count?
JRST [ CAIN B,(D) ; Yes, is this the ending byte?
JRST TSOUTX ; Yes, then quit
SOJA C,TSOUT1] ; No, update count
SKIPE C ; Unless C is zero already,
ADDI C,1 ; count towards zero
TSOUT1: CAIN B,12 ; Count line feeds for those interested
AOS LFCNT ; ..
CAIN A,.PRIOU ; Terminal?
JRST [ MOVE A,B ; Yes, handle differently
$CALL KBFTOR
JRST TSOUT2]
TLNE A,-1 ; Byte ptr or IFN?
JRST [ IDPB B,A ; Byte ptr, stuff it
MOVEM A,SIFN ; Store updated ptr
JRST TSOUT2] ; Get next byte
$CALL F%OBYT ; Write the byte
TSOUT2: TXNN F,F%F1 ; Is byte count significant?
JRST TSOUT0 ; No, keep going then
JUMPN C,TSOUT0 ; Yes, if count is nonzero, keep going
TSOUTX: TLNN A,-1 ; If destination not byte pointer
SKIPA A,SIFN ; restore IFN
JRST [ PUSH P,A ; else save ptr to last byte
SETZ B, ; append a null
IDPB B,A ; ..
POP P,A ; Leave ptr pointing to last byte
JRST .+1] ; Rejoin main flow
MOVE B,PTR ; Return updated byte pointer
TXZE F,F%F1 ; Was byte-to-stop-on null?
RET ; No, just quit
SETZ C, ; Yes, get a null in case
TLNE A,-1 ; Are we writing to a string?
IDPB C,SIFN ; Yes, write a null
RET
SUBTTL TNOUT - simulate a NOUT -- CAUTION ! Bases 10 and 8 only!
TNOUT: STKVAR <SAVD> ; IFN
MOVEM D,SAVD ; Preserve D
MOVE D,A ; For TNOUT0
CAIE C,^D8 ; Octal?
JRST TNOUT1 ; No, must be decimal
$TEXT (TNOUT0,<^O/B/^A>)
TNOUTX: MOVE D,SAVD
RET
TNOUT1: CAIE C,^D10 ; Better be decimal
FATAL (Invalid radix at TNOUT)
$TEXT (TNOUT0,<^D/B/^A>)
JRST TNOUTX
TNOUT0: MOVE B,A ; Set up for TBOUT
MOVE A,D ; IFN
CALL TBOUT ; Move that byte!
$RET
;Simulate BOUT -- if .PRIOU, call KBFTOR, else F%OBYT
;Call: A/ IFN or .PRIOU
; B/ character
TBOUT: PUSH P,A ; Preserve A
PUSH P,B
CAIN A,.PRIOU
JRST [ MOVE A,B ; Copy char
$CALL KBFTOR ; Type it
JRST TBOUTX]
$CALL F%OBYT
TBOUTX: POP P,B
POP P,A
RET
SUBTTL Utility routines for HEADERS command
;Extract personal name from field and point to it (just copy field
; if no personal name present)
; Call:
; A/ Character pointer to string
; B/ Width of field (not used, but preserved)
; C/ Length of string
TYPPRN: STKVAR <<ARGS,3>,SVFLGS>
DMOVEM A,ARGS ; Save args
MOVEM F,SVFLGS ; and flags
MOVEM C,2+ARGS ; ..
MOVEI T,[ASCIZ /
From-the-terminal-of: /]
CALL FNDHDR ; No, see if local mail crock
JRST TYPPR2 ; No, do usual
CALL FNDSB1 ; Compute length of this field
MOVEM V,ARGS ; Fudge ptr to point to this field
MOVEM W,2+ARGS ; Length of this field
TYPPR2: MOVE V,ARGS ; Form byte ptr to string
CHR2BP ; ..
MOVE C,[POINT 7,STRBUF] ; Where to put extracted name
SKIPN D,2+ARGS ; Length of field
JRST TYPPRX ; None there, point to empty field and quit
TXZ F,F%F1!F%F2 ; Not in quoted field or personal name yet
TYPPR0: ILDB B,A ; Next char of field
TXNE F,F%F2 ; Inside quoted string?
JRST [ CAIN B,42 ; Yes, is this the close quote?
TXZ F,F%F2 ; Yes, clear quote flag
JRST TYPPR1] ; Move char literally
CAIN B,42 ; Start of quoted string?
JRST [ TXO F,F%F2 ; Yes, flag quotedness
JRST TYPPR1] ; Go move the quote
TXNE F,F%F1 ; Inside name?
JRST [ CAIN B,")" ; End of comment (personal name)?
JRST TYPPRX ; Got it -- done
JRST TYPPR1] ; Still in quotes -- copy this char
CAIN B,"<" ; Start of actual address?
JRST TYPPRX ; Yes, all done then
CAIN B,"(" ; Start of comment field (personal name)?
JRST [ MOVE C,[POINT 7,STRBUF] ; Yes, discard stuff copied so far
SETZM STRBUF ; In case nothing inside parens
TXO F,F%F1 ; Remember inside quotes
JRST TYPPR0] ; Go copy this stuff
TYPPR1: IDPB B,C ; None of the above, move this char
SOJG D,TYPPR0 ; Do for all chars
TYPPRX: SETZ B, ; Insure ASCIZ
IDPB B,C ; ..
MOVE A,C ; Byte ptr to end of string
BP2CHR ; Form char ptr to end of string
MOVE B,V ; Preserve for a bit
MOVE A,[POINT 7,STRBUF] ; Ptr to beginning of string
BP2CHR ; Form char ptr
MOVE A,V ; Return it in A
SUB B,V ; Compute length of string
MOVEI C,-1(B) ; Return in C -- account for null
MOVE B,1+ARGS ; Return original B (width of column)
MOVE F,SVFLGS ; Restore flags and return
RET
;Type field
;
; A/ Character address of string
; B/ Width of field
; C/ Size of string
;
;Returns:
; B/ number of chars left unfilled
TYPHDS: 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
CHR2BP ; Get byte pointer
MOVE B,A
SKIPG A,OUTIFN ; LPT, file, or terminal
MOVX A,.PRIOU
CALL TSOUT
POP P,B
RET
LLIT
SUBTTL TYPMSG - type out a message
.RVBTY: TXO F,F%VBTY
.RTYPE: CONFRM
CALL BLANK0
JRST TYPMSG
.VBTYP: TXO F,F%VBTY ; Set verbose flag
.TYPMS: CONFRM ; Confirm first
TYPMSG: STKVAR <<HDR0,20>,HDR1> ; Current header-name, temp ptr to its end
MOVX A,M%VALI ; Have we parsed this message yet?
TDNN A,MSGBTS(M) ; ..
CALL PRSMS0 ; No, do so then
MOVE C,MSGBON(M) ; Get length of message
MOVEI B,1(M) ; Make external msg number to type
$TEXT (KBFTOR,< Message ^D/B/ (^D/C/ chars), received ^H/MSGDAT(M)/^M>)
JUMPE C,TYPMS5 ; If empty, just mark as seen and quit
MOVEI A,1 ; Init line counter
MOVEM A,LFCNT ; ..
CAMN C,MSGHDN(M) ; Are headers distinguished from msg body?
JRST TYPMS3 ; No, can't handle headers intelligently then
TXNE F,F%VBTY ; Verbosely type it?
JRST TYPMS2 ; Yes, no fancy header handling then
SKIPE E,OHSN ; Any "set only-headers-shown" cmd in effect?
JRST TYPM0A ; Yes, it takes precedence over supressed hdrs
MOVE V,MSGBOD(M) ; Yes, get start of message body
MOVE W,MSGHDN(M) ; Length of message headers
TYPM0B: CHR2BP ; Form byte pointer to current line
MOVEI B,HDR0 ; Where to store this headername
HRLI B,(POINT 7,) ; ..
SETZ E, ; Init length of this name
MOVEI X,^D79 ; Fence in case non-RFC733 header
TYPM0C: ILDB C,A ; Copy header name to temp space
SOJL X,[MOVEI A,1(M)
WARN <Incorrectly formatted header for message %1D
>
JRST TYPMS3]
ADDI E,1 ; Count length of name
CAIN C,":" ; Go for name of this one
JRST TYPM0D
JUMPE C,TYPM0C ; Ignore nulls inserted by cretinous mailers
IDPB C,B ; Store real chars
JRST TYPM0C
;Here with header name stored in HDR0, see if suppressed or not
TYPM0D: MOVEM B,HDR1 ; Remember where string ends
SETZ C, ; Tie string off
IDPB C,B ; ..
PUSH P,W ; Save current length of rest of hdr area
SETZ W,
CALL FNDTO1 ; Compute length of arg for this hdr item
POP P,W ; Restore header area byte count
ADDI X,2 ; Account for terminating CRLF
SKIPN A,CNCLHD ; Point to concealed-headers table
JRST TYPM0F ; None are concealed, type this one then
HRROI B,HDR0 ; Point to name we're checking on
$CALL S%TBLK ; Do the lookup
TXNE B,TL%EXM ; Found?
JRST TYPM0E ; Yes, don't type it
TYPM0F: MOVEI A,":" ; No, suffix its name with a colon
IDPB A,HDR1 ; for ADDRSP's benefit
SETZ A, ; Insure ASCIZ
IDPB A,HDR1 ; ..
HRRI A,HDR0 ; Form ptr to name of this header item
HRLI A,(POINT 7,) ; ..
TXNE F,F%BREF ; Want fancy (brief) address list display?
CALL ADDRSP ; Yes, see if this is an address field
SKIPA ; Not an address field, type it normally
JRST [MOVX A,.PRIOU ; Address field - first type its name
HRROI B,HDR0 ; Which we know is here
SETZ C, ; ..
CALL TSOUT ; ..
PUSH P,V ; Must preserve this, actually
ADDI V,(E) ; Reflect that we've typed name
CALL TYPMSA ; Now type its contents fancily
POP P,V ; Restore char pointer
JRST TYPM0E] ; ..
CHR2BP ; Not concealed - form BP to it
MOVE B,A ; Set up for TSOUT
MOVX A,.PRIOU ; Type on terminal
MOVE C,X ; Length of contents
ADDI C,(E) ; plus length of name
MOVN C,C ; Negate count, so embedded nulls have
SETZ D, ; no significance to TSOUT
CALL TSOUT ; Type this one
TYPM0E: SUBI W,(E) ; Account for length of name
ADDI V,(E) ; ..
SUBI W,(X) ; and for length of contents
ADDI V,(X) ; ..
CAIG W,2 ; Are we down to the extra CRLF?
JRST TYPM1B ; Yes, type msg text then
JRST TYPM0B ; Handle next one
;Here if doing "set only-headers-to-show"
TYPM0A: MOVN E,E ; Yes, build AOBJN ptr to table of names
HRLZ E,E ; ..
TYPMS0: HRRZ T,OHSPTR(E) ; Get addr of first header name to show
PUSH P,E ; FNDHDR clobbers E
CALL FNDTO0 ; Find this one if you can
JUMPE V,[POP P,E ; Flush stack
JRST TYPMS1] ; Not there, go on to next one
POP P,E
HLRZ A,OHSPTR(E) ; Get length of header name
SUB V,A ; Back up so name is typed as well as contents
ADD X,A ; Account for length in byte count
HRR B,OHSPTR(E) ; Form ptr to header name for addressness test
HRLI B,(POINT 7,) ; ..
MOVEI A,2 ; Skip the leading CRLF, though
ADJBP A,B ; ..
TXNE F,F%BREF ; Want brief address lists?
CALL ADDRSP ; Yes, is this an address field?
SKIPA ; No to either, just type literally
JRST [MOVX A,.PRIOU ; Yes, first type its name
HRR B,OHSPTR(E) ; ..
HRLI B,(POINT 7,) ; Point to name
IBP B ; But skip the CRLF
IBP B ; ..
SETZ C, ; ..
CALL TSOUT ; ..
HLRZ A,OHSPTR(E) ; Adjust pointer and count to reflect
ADDI V,(A) ; that we've typed the header name
SUBI X,(A) ; ..
CALL TYPMSA ; Type contents fancily
CALL CRLF
JRST TYPMS1] ; and go on
CHR2BP ; Form byte pointer to header contents
MOVE B,A ; Set up for SOUT
MOVX A,.PRIOU ; Type on terminal
MOVE C,X ; Byte count
SETZ D,
CALL TSOUT
CALL CRLF
TYPMS1: AOBJN E,TYPMS0 ; No, must be next header item... go check it
TYPM1B: CALL CRLF ; Make a blank line
TYPM1A: TXNE F,F%READ ; If read mode,
CALL @SCRREG ; do fancy scrolling if on VT100
MOVN C,MSGBON(M) ; Length of msg body
ADD C,MSGHDN(M) ; Minus length of hdrs (already handled)
MOVE V,MSGBOD(M) ; Beginning of msg body
ADD V,MSGHDN(M) ; Skip header area
JRST TYPMS4 ; Go type it out
TYPMS2: MOVN C,MSGHDN(M) ; Get negative length of header area
MOVE V,MSGBOD(M) ; and start of entire message
CHR2BP ; Form byte pointer
MOVE B,A ; Set up for TSOUT
MOVX A,.PRIOU ; Type on terminal
SETZ D,
CALL TSOUT ; ..
JRST TYPM1A ; Go type message body now
TYPMS3: MOVN C,MSGBON(M) ; Type entire message body
MOVE V,MSGBOD(M) ; ..
TYPMS4: CHR2BP ; Form byte pointer to stuff to type
MOVE B,A ; Set up for TSOUT
MOVX A,.PRIOU ; Type on terminal
SETZ D,
CALL TSOUT ; ..
TYPMS5: MOVX A,M%SEEN ; Mark message as seen
IORM A,MSGBTS(M)
JRST UPDBIT ; And maybe update
;SREGV1 - Set scrolling region for VT100 so headers stay on screen
; while message text whizzily scrolls along
SREGV1: SKIPN B,MINWSZ ; Any scrolling stuff wanted at all?
RET ; No, just quit
MOVEI A,^D24 ; Lines in a page
SUB A,LFCNT ; minus lines currently occupied
SUB A,B ; minus lines for scrolling text
JUMPLE A,R ; If no room, don't set scroll region
SETOM SCRLFL ; OK, set scroll flag so we remember to undo it
HRROI A,[BYTE (7) 33,"[",0]
CALL BINOUT ; Commence scroll-region command
MOVE A,LFCNT ; Get line count
ADDI A,1 ; plus one because cursor is 1-origin
PUSH P,A ; Save region begin
CALL SCRNOU ; NOUT it
POP P,B ; Restore region begin
MOVEI A,^D24 ; Screen size
SUBI A,-1(B) ; Compute region size
CALL SETPSZ ; Set page size
HRROI A,[BYTE (7) ";","2","4","r",0]
CALL BINOUT ; Finish it off
HRROI A,[BYTE (7) 33,"[",0]
CALL BINOUT ; Begin "cursor position" command
MOVE A,LFCNT ; Put cursor back where it was
ADDI A,1 ; ..
CALL SCRNOU ; ..
HRROI A,[BYTE (7) ";","1","H",0]
CALL BINOUT ; Always column one
MOVEI A,15 ; Type a CR to fake the dumb operating systems
$CALL KBFTOR ; into believing we're at left margin
RET ; (we are, but they don't believe it)
;Utility routine to expand decimal number -- standard PDP-10 recursion stuff
SCRNOU: IDIVI A,^D10
HRLM B,(P)
SKIPE A
CALL SCRNOU
HLRZ A,(P)
ADDI A,"0"
$CALL KBFTOR
RET
;SRGRV1 - Restore scroll region to full screen for VT100
SRGRV1: SKIPN SCRLFL ; Is this necessary?
RET ; No, skip it
HRROI A,[BYTE (7) 33,"[","1",";","2","4","r",0]
CALL BINOUT ; Resume scrolling entire screen
CALL RSTPSZ ; Restore page size
MOVEI A,15 ; Type a CR to fake the dumb operating systems
$CALL KBFTOR ; out into believing we're at the left margin
RET ; (after all, we really ARE at the margin...)
;SBTMV1 - Get to bottom line of screen
SBTMV1: SKIPN SCRLFL ; Is this necessary?
RET ; No, skip it
HRROI A,[BYTE (7) 33,"[","2","4",";","1","H",0]
CALL BINOUT
MOVEI A,15 ; Fake O.S. into believing we're at
CALL KBFTOR ; left margin
RET
;See if current header item in msg being typed is an address item
;Call:
; A/ pointer to name string for header item
; CALL ADDRSP
;Return +1: Not an address item
; +2: Is an address item
ADDRSP: STKVAR <HDPTR>
MOVEM A,HDPTR
HRROI B,[ASCIZ /To:/]
$CALL S%SCMP ; Only to and cc are address items
JUMPE A,RSKP ; A=0 means strings matched
MOVE A,HDPTR
HRROI B,[ASCIZ /cc:/]
$CALL S%SCMP
JUMPE A,RSKP ; Match, return success
RET ; No match - return failure
;TYPMSA - Type address header item fancily (compress address lists)
; Name of item already typed, this routine only handles contents
;Call:
; V/ character pointer to entire field
; X/ length of field
TYPMSA: $SAVE <X> ; Caller wants this preserved
TXZ F,F%F1 ; Not in quoted string
SETZM LDEPTH ; Init depth of list nesting
CHR2BP ; Point to string
MOVE D,A ; Safer AC
TYPMA1: JUMPE X,TYPMAX ; When char count exhausted, return
SUBI X,1 ; Countdown chars fetched
ILDB A,D ; Get next character
TXNE F,F%F1 ; Inside quoted string?
JRST [ CAIN A,42 ; Yes, close quote?
TXZ F,F%F1 ; Yes, clear flag
JRST TYPMA2] ; continue
CAIN A,42 ; Open quote?
JRST [ TXO F,F%F1 ; Yes, flag quotedness
JRST TYPMA2] ; and continue
CAIN A,";" ; Close of address list?
JRST [ SOSG LDEPTH ; Yes, decrement nesting depth
JRST TYPMA3 ; Outer list closed - type the ;
JRST TYPMA1] ; Flush this char otherwise
CAIN A,":" ; Opening of address list?
JRST [ AOS B,LDEPTH ; Yes, increment nesting depth
CAIN B,1 ; Outermost list?
$CALL KBFTOR ; Yes, type the colon
JRST TYPMA2]
TYPMA2: SKIPE LDEPTH ; Inside an address list?
JRST TYPMA1 ; Yes, just flush chars
TYPMA3: CAIN A,12 ; Count line feeds for screen adjustments
AOS LFCNT ; ..
$CALL KBFTOR ; No, type chars
JRST TYPMA1
;Here when done -- insure address lists closed, if not (because of badly-
; formatted message header), close lists, type CRLF (since suppression
; of address list contents suppressed the CRLF), and return.
TYPMAX: SKIPN D,LDEPTH ; Address lists closed properly?
RET ; Yes, all done then
TYPMX0: MOVEI A,";" ; No, type a closure symbol
$CALL KBFTOR ; ..
SOJG D,TYPMX0 ; for each unterminated list
CALL CRLF ; Close the line
SETZM LDEPTH ; Clean up the mess
RET ; and return
SUBTTL RECENT - type out headers of recent messages
RECENT: TXO F,F%F2 ; Want headers
RECEN0: SETZB M,NFLAGD ; Init counts
SETZM NDELET
SETZM UNSEEN ; ...
SETOM PRIORM ; No new messages yet
CALL CRIF ; Get fresh line if needed
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%F2 ; 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
TXZ F,F%F2 ; Don't leave stray bits lying around
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 B,MSGJFN ; Have a file?
CWARN (No current mail file)
$TEXT (KBFTOR,< Current message file is ^A>)
TOPS20<
PUSH P,B
$CALL K%FLSH
POP P,B
MOVEI A,.PRIOU ; Type filespec on terminal
MOVX C,<1B2+1B5+1B8+1B11+1B14>+JS%PAF
JFNS
TXZ F,F%F1 ; No headers
>;End TOPS20
TOPS10<
$TEXT (KBFTOR,<^F/MSGFD/^A>)
>;End TOPS10
PUSH P,M ; Save current message number
CALL RECEN0 ; Update status
POP P,M ; Restore
CALL SUMMRY ; Print summary
MOVEI A,1(M) ; M is zero-origin
$TEXT (KBFTOR,< Currently at message ^D/A/.>)
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
TOPS20<
CIETYPE < %2S. %1D message%P%5S, %6D page%P.
>
>;End TOPS20
TOPS10<
CIETYPE < %1D message%P%5S, %6D block%P.
>
>;End TOPS10
SKIPE D,NDELET ; Check for deleted
ETYPE < (You have %4D message%P deleted.)>
SKIPN A,NFLAGD ; Messages flaged?
RET
MOVX D,M%ATTN ; Bit to check
CAIE A,1 ; Singular or plural?
JRST [ CIETYP < Messages%4L flagged.
>
RET]
CIETYP < Message%4L flagged.
>
RET
; Version command
.VERSI: CONFRM
$TEXT (KBFTOR,< MS version ^V/VERSN./ + GLXLIB version ^V/.SPLIB##/^M>)
SKIPN HOSTAB ; If don't know about any nets yet,
CALL HSTINI ; Find out so can tell user what we know
TXNE F,F%XMLR ; XMAILR support?
$TEXT (KBFTOR,< XMAILR support^M>)
TXNE F,F%DECN
$TEXT (KBFTOR,< DECNET support^M>)
TXNE F,F%ARPA
$TEXT (KBFTOR,< ARPANET support^M>)
TXNE F,F%ANFX
$TEXT (KBFTOR,< ANF10 support^M>)
RET
LLIT
SUBTTL UPDBIT - 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: STKVAR <IOWDT,BLKNO,BTPTR,MBITS,BLINC>
LDB A,[POINT 12,MSGBTS(M),17]
HRRZ B,MSGBTS(M) ; Get new copy of bits
MOVEM B,MBITS ; Save in case CHECKS and PARSEF clobber
TXNN F,F%MOD ; MOD hack - exit now
CAIN B,(A) ; Old matches new?
RET ; Yes, no need to do any more
CALL CTCLOK ; ENQ for exclusive access
JRST [ WARN <Can't update message bits -- another reader exists>
RET]
CALL GETJF3 ; Get a second jfn if dont already
JRST [ CALL CTCOK ; Maybe reenable ctrl-C
CALLRET RELJF2] ; and maybe release a JFN
MOVE V,MSGALL(M) ; Start of the message header
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)
CALLRET CLSJF2]
CAIE B,";" ; At start of bits?
JRST UPDBT1
SUB A,MSGADR ; Get relative pointer
MOVEM A,BTPTR ; Save that pointer
HLRZ B,A
CAIN B,010700
AOJ A,
ANDI A,-1
; ..
; ..
TOPS20<
IDIVI A,1000 ; Get page number we need
HRL A,MSGJF2
CAIL B,775 ; If near end of page
SKIPA C,[PM%CNT+PM%WR+PM%RD+2] ; Map two pages
MOVSI C,(PM%WR!PM%RD)
MOVE B,[.FHSLF,,WRTPGS_-9]
PMAP
>;End TOPS20
TOPS10<
IDIVI A,200 ; Get block number minus one
MOVEI A,1(A) ; Correct block number
MOVEM A,BLKNO ; Save for later
MOVE C,MSGJFN ; Get channel for message file
LSH C,^D23 ; Move to AC field
IOR C,[USETI] ; Get instruction
HRR C,BLKNO ; Get correct block number
XCT C ; Point to it
MOVE A,[-200,,WRTPGS-1]
CAIL B,175 ; Need to read two blocks?
MOVE A,[-400,,WRTPGS-1] ; Yes, get different IOWD
MOVEM A,IOWDT ; Save for later
MOVEM A,MSIOWD ; and save in place for IN UUO
SETZM MSIOWD+1 ; Tie off list
MOVE A,MSGJFN ; Get channel back
LSH A,^D23 ; Put in right place
IOR A,[IN MSIOWD] ; Form instruction to read stuff
XCT A ; Snarf
SKIPA ; Good stuff
FATAL (Can't read message file to update bits)
>;End TOPS10
; ..
; ..
MOVE A,BTPTR ; Get back byte pointer
TOPS20< TRZ A,777000 > ; Just relative to page
TOPS10< TRZ A,777600 > ; Just relative to block
ADDI A,WRTPGS ; Offset right
MOVEM A,UPDPTR ; Save pointer for TOR
MOVE B,MBITS ; Bits to write to file
$TEXT (UPDBT9,<^O12R0/B/^A>) ; 12 digits, zero-filled, right-justified
DPB B,[POINT 12,MSGBTS(M),17] ; This is now the file version
TOPS20<
SETO A,
MOVE B,[.FHSLF,,WRTPGS_-9]
MOVE C,[PM%CNT+2]
PMAP ; Unmap the pages
CALLRET CLSJF2 ; Close second JFN and return
>;End TOPS20
TOPS10<
HRRM B,MSGBTS(M) ; In case GETJF3/CHECKS/GET1 wiped these out
MOVE A,BTPTR ; Must also update in-core version
ADD A,MSGADR ; ..
MOVEM A,UPDPTR ; of file bits because TOPS10 can't map
$TEXT (UPDBT9,<^O12R0/B/^A>) ; 12 digits, zero-filled, right-justified
SETZM BLINC ; Init block increment to zero
MOVE A,IOWDT ; Get IOWD used to read block(s)
MOVE B,BLKNO ; Get first block number read
CAMN A,[-400,,WRTPGS-1] ; Did we read two blocks?
JRST [ MOVEI C,200 ; Yes, set block increment
MOVEM C,BLINC ; up by 1 block (200 words)
ADDI B,1 ; Bump number of last block read
JRST .+1] ; Continue
MOVE C,FILSIZ ; Get number of bytes in file
ADDI C,BY2PAG-1 ; Cause roundup
IDIVI C,BY2PAG ; Compute "pages" (blocks) in file
CAIN C,(B) ; Did we diddle last block of file?
JRST [ MOVE C,FILSIZ ; Yes, get file size back
ADDI C,4 ; Force roundup
IDIVI C,5 ; Compute word length of file
ANDI C,177 ; Drop block no. part of length
SKIPN C ; Is last block completely filled?
MOVEI C,200 ; Yes, write whole block
ADD C,BLINC ; Account for possibility of 2 blocks
MOVN C,C ; Form new word count
HRL A,C ; Fix up IOWD
JRST .+1]
MOVEM A,MSIOWD ; Save IOWD
SETZM MSIOWD+1
MOVE A,MSGJF2 ; Get channel number to write on
LSH A,^D23 ; Put in AC field
TLO A,(USETO) ; Form USETO instruction
HRR A,BLKNO ; Where to point
XCT A ; Get there
TLC A,(OUT^!USETO) ; Change to OUT instruction
HRRI A,MSIOWD ; Point to IOWD
XCT A ; Write updated blocks
CALLRET CLSJF2 ; Success, unlock file and return
FATAL (Can't update message bits)
>;End TOPS10
;Here from $TEXT macro above to write messge bit digits
UPDBT9: JUMPE A,[$RET] ; Don't write nulls
CAIE A,15 ; Don't do CR or LF either
CAIN A,12 ; ..
$RET ; ..
IDPB A,UPDPTR ; Store where UPDPTR tells us to
$RET
CLSJF2: MOVE A,MSGJF2
TOPS20<
SIZEF ; Get page count for file
ERJMP [JRETER <SIZEF failure for message file>
MOVE A,MSGJF2 ; at least try to close it
JRST CLSJ2A]
HRLZS A ; JFN ,, start at page zero
MOVEI B,(C) ; Count of pages to update
UFPGS
ERJMP [JRETER <UFPGS failure for message file>
MOVE A,MSGJF2
JRST CLSJ2A]
MOVE A,MSGJF2 ; Get JFN back
CLSJ2A: TXO A,CO%NRJ ; Keep this JFN around
CLOSF
JFCL
HRRZ A,MSGJF2 ; In case error , get JFN again
CALL SETREF ; Set read date-time
>;End TOPS20
TOPS10<
LSH A,^D23 ; Put into AC field
IOR A,[CLOSE] ; Instruction to do
XCT A
TLC A,(CLOSE^!RELEASE)
XCT A
SETOM MSGJF2
>;End TOPS10
CALL CTCOK ; Allow ctrl-C again if disabled
RET ; Done
RELJF2: ; Not really needed for TOPS10
TOPS20<
HRRZ A,MSGJF2
RLJFN ; release JFN
JFCL ; Maybe error?
SETOM MSGJF2 ; No longer have one
>;End TOPS20
RET
;Routine called when error message or other unexpected event happens.
; It guarantees that the screen won't be cleared for at least five seconds
; to give the user time to react to what's happened.
; A/ number of seconds to give user
RDELAY: STKVAR <DELAY>
MOVEM A,DELAY
$CALL K%FLSH ; Flush the TTY pipe
$CALL I%NOW ; Get the current time
MOVE B,DELAY ; Get seconds to delay
IMULI B,<<1,,0>/<^D24*^D60*^D60>> ; Convert it to UDT format
ADD A,B ; Add to current TOD
MOVEM A,BLKTIM ; This is when next clear-screen is allowed
RET
;GETJF2 - Open message file for write (expunge)
;GETJF3 - Open for update (UPDBIT)
;
;(These are the same on TOPS20, but differ on TOPS10)
TOPS10<
GETJF2: CALL FILOPW ; Open message file for write
JRST [ CALL FILERR ; Type FILOP. error string
WARN <Can't open message file for write>
RET]
MOVEM A,MSGJF2 ; Remember channel
CALL CHECK0 ; Any new messages pending?
JRST RSKP ; No, all set then
MOVE A,MSGJF2 ; Yes, recover channel number
RESDV. A, ; Abort this opening
FATAL <Can't abort second (write) opening of message file>
SETOM MSGJF2 ; Leave tracks
CALL CHECKS ; Read and parse new mail
JRST GETJF2 ; Now try again
GETJF3: CALL FILOPU ; Open message file for update
JRST [ CALL FILERR ; Type FILOP. error string
WARN <Can't open message file for update>
RET]
MOVEM A,MSGJF2 ; Remember channel
CALL CHECK0 ; Any new messages pending?
JRST RSKP ; No, all set then
MOVE A,MSGJF2 ; Yes, recover channel number
RESDV. A, ; Abort this opening
FATAL <Can't abort update opening of message file>
SETOM MSGJF2 ; Flag no second opening
CALL CHECKS ; Read and parse new mail
JRST GETJF3 ; Now try again
;Utility routine to close and release a channel in A
CLSFIL: LSH A,^D23
IOR A,[CLOSE]
XCT A
TLC A,(CLOSE^!RELEASE)
XCT A
RET
>;End TOPS10
TOPS20<
GETJF2:
GETJF3: 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
ERJMP [JRETER (Cannot get second JFN on file)
RET]
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).
ERJMP [JRETER <Can't update message file>
RET]
RETSKP ; Return success
>;End TOPS20
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
MOVE A,CR.COD(A) ; Get code
CAIN A,.CMKEY ; Keyword?
JRST GETSQK ; Yes - done
CAIN A,.CMNUM ; Number?
JRST GETSQN ; Yes - proceed
JRST GETSQT ; Must be token (% or .)
;Keyword seen , handle defaulting and return
GETSQK: HRRZ A,(B) ; Get routine addrs
JRST (A)
;Token - check for % or . and supply number
GETSQT: LDB A,[POINT 7,ATMBUF,6] ; Get token character
CAIN A,"%"
SKIPA B,LASTM ; % = last message number
MOVEI B,(M) ; . = current message number
AOJA B,GETSQN ; Handle as number now
;Number parsed - handle n:m n,m or n alone
GETSQN: JUMPE B,GTSQNE ; Range error
SOJL B,GTSQNE
CAMLE B,LASTM
JRST GTSQNE
JUMPGE X,GTSQN2 ; 2nd in series n:m
IDPB B,L ; Save number in list
MOVEI A,GTNBK1 ; Now try for <cr> ! , ! :
GTSQNA: CALL RFIELD
MOVE A,CR.COD(A) ; Get function code parsed
CAIN A,.CMCFM ; EOL?
JRST GTSQNR ; Yes - done
CAIE A,.CMCMA ; Comma?
LDB X,L ; Must be ":" ,setup for 2nd arg
MOVEI A,GTNBK2 ; Yes - try for <number> ! . ! %
CALL RFIELD
MOVE A,CR.COD(A) ; Get function code
CAIN A,.CMCFM ; EOL?
JRST GTSQNR ; Yes - done
CAIN A,.CMNUM ; Number?
JRST GETSQN ; Yes - handle
CAIN A,.CMKEY ; Keyword?
JRST GETSQK ; Yep, go handle it
JRST GETSQT ; Handle token
;2nd in range seen - fill list
GTSQN2: CAIN X,(B) ; Done with range
JRST GTSQNC ; Look for next field
CAIG X,(B) ; If going forwards,
AOSA X ; increment,
SOS X ; else decrement
IDPB X,L ; Save in table
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
MOVEI A,NXTSEQ ; Next in the sequence
MOVEM A,NXTMSG ; Setup as dispatch
MOVE A,[POINT 12,MSGSEQ]
EXCH A,L ; Reset L, get old contents
CAMN A,[POINT 12,MSGSEQ,11] ; Any messages in list at all?
RET ; No -- leave M alone then
PUSH P,L ; Save these for a bit
PUSH P,M
GTSQN3: ILDB M,L ; Check to see all msgs are parsed
CAIN M,3777 ; End of list?
JRST GTSQN4 ; Yes, all done
MOVX A,M%VALI ; Valid info for this message?
TDNN A,MSGBTS(M) ; ..
CALL PRSMS0 ; No, get some then
JRST GTSQN3 ; Check all msgs in sequence
GTSQN4: POP P,M
POP P,L ; Finish up
RET ; Return
GTSQNE: CMERR (Invalid message number)
JRST CMDER1
DEFCUR: FLDDB1 (.CMTOK,CM%SDH,<POINT 7,[ASCII "%"]>,<-1,,SEQHLP>,<current>,TKNDOT)
DEFNEW: FLDDB1 (.CMTOK,CM%SDH,<POINT 7,[ASCII "%"]>,<-1,,SEQHLP>,<new>,TKNDOT)
DEFALL: FLDDB1 (.CMTOK,CM%SDH,<POINT 7,[ASCII "%"]>,<-1,,SEQHLP>,<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,,SEQHLP>,,[FLDDB1 (.CMCMA,CM%SDH,,,,TKNCLN)])
GTNBK2: FLDDB1 (.CMTOK,CM%SDH,<POINT 7,[ASCII "%"]>,<-1,,SEQHLP>,,GTBK2A)
GTBK2A: FLDDB1 (.CMTOK,CM%SDH,<POINT 7,[ASCII "."]>,,,DEFDEF)
GTNBK3: FLDDB1 (.CMCFM,CM%SDH,,<-1,,SEQHLP>,,[FLDDB1 (.CMCMA,CM%SDH)])
SEQHLP: 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 (First,STQFRS)
CMD1 (Flagged,STQFLG)
ENTFRM: CMD1 (From,STQFRM)
CMD1 (Inverse,STQREV)
CMD1 (Keyword,STQKWD)
CMD1 (L,ENTLST,CM%INV!CM%ABR)
CMD1 (Larger,STQLRG)
ENTLST: CMD1 (Last,STQLST)
CMD1 (New,STQNEW)
CMD1 (Old,STQOLD)
CMD1 (Same,STQSAM)
CMD1 (Since,STQTMS)
CMD1 (Smaller,STQSML)
CMD1 (Sorted,STQSOR)
CMD1 (Subject,STQSBJ)
CMD1 (To,STQTO)
CMD1 (Unanswered,STQUNA)
CMD1 (Undeleted,STQUND)
CMD1 (Unflagged,STQUNF)
NSQCMS==.-SQCMTB-1
STQSRC: STQSRN,,STQSRN
CMD1 (Date-time,SQSRDT)
STQSRN==.-STQSRC-1
STQSAM: NOISE (as last sequence)
CONFRM
SKIPN MSGSEQ ; Insure that we had a previous sequence
JRST STQSAE ; None there, complain
MOVE L,[POINT 12,MSGSEQ]
MOVEI B,NMSGS ; Make sure this sequence has a terminator
STQSA0: ILDB A,L ; Get msg number
CAIN A,3777 ; Check for terrminator
JRST [ MOVE L,[POINT 12,MSGSEQ] ; Got one, this sequence is kosher
RET]
SOJG B,STQSA0 ; Loop thru all possible slots
STQSAE: CMERR <No previous sequence exists>
JRST CMDER1
;Larger (than) n (characters)
STQLRG: CALL STQLR0 ; Parse character count
STQLR1: CAMGE B,MSGBON(M) ; Is this one big enough?
IDPB M,L ; Yes, add to sequence
CAME M,LASTM ; Loop through all messages
AOJA M,STQLR1 ; ..
JRST GTSQNR ; Finished
;Smaller (than) n (characters)
STQSML: CALL STQLR0 ; Parse character count
STQSM1: CAMLE B,MSGBON(M) ; Match?
IDPB M,L ; Yes, stuff into sequence
CAME M,LASTM ; Loop over all msgs
AOJA M,STQSM1 ; ..
JRST GTSQNR ; Done
STQLR0: NOISE (than)
MOVEI A,[FLDDB. (.CMNUM,CM%SDH,^D10,<character count>)]
CALL RFIELD
SETZ M, ; Init message pointer
PUSH P,B ; Save size limit
NOISE (characters)
CONFRM
POP P,B ; Restore size limit
RET
STQSOR: NOISE (by)
MOVEI A,[FLDDB. (.CMKEY,,STQSRC,,<Date-time>)]
CALL RFIELD
HRRZ A,(B) ; Dispatch to sort routine
CALLRET (A)
;Sort by date/time
SQSRDT: STKVAR <LOW,LOWM> ; Low date/time, and its M
CONFRM
SETZ M,
SQSRD0: MOVX A,M%TEMP ; Temporary marker bit
ANDCAM A,MSGBTS(M) ; Clear markers
MOVX A,M%VALI ; Parsed this one yet?
TDNN A,MSGBTS(M) ; ..
CALL PRSMS0 ; No, insure it has a date/time
CAME M,LASTM ; for all messagges
AOJA M,SQSRD0
SETOM LOWM ; Flag nothing found yet
MOVE A,[377777,,777777] ; Get largest integer
MOVEM A,LOW ; Init floor counter
SETZ M,
SQSRD1: MOVX A,M%TEMP ; Skip this message
TDNE A,MSGBTS(M) ; if already done
JRST SQSRD2 ; ..
MOVE A,MSGDAT(M) ; Get this msgs date
CAMGE A,LOW ; Is this lowest yet?
JRST [ MOVEM M,LOWM ; Yes, remember it
MOVEM A,LOW ; and its date/time
JRST .+1]
SQSRD2: CAME M,LASTM ; Check all msgs
AOJA M,SQSRD1 ; ..
SKIPGE M,LOWM ; Did we find one?
JRST GTSQNR ; No, all done then - tie off sequence
IDPB M,L ; Yes, stuff into sequence
MOVX A,M%TEMP ; Mark this one as gotten
IORM A,MSGBTS(M) ; ..
SETZ M, ; Begin scan again
SETOM LOWM ; Flag nothing found this scan yet
MOVE A,[377777,,777777] ; Init ceiling again
MOVEM A,LOW ; ..
JRST SQSRD1 ; ..
STQALL: SKIPA A,[NXTALL]
STQDEL: MOVEI A,NXTDEL
STQDL0: MOVEM A,NXTMSG
CONFRM ; Get confirmation
MOVEM M,PRIORM ; Save current in case none in list
STQDL2: SETO M,
STQDL1: CALL @NXTMSG ; Get next in sequence
JRST GTSQNR ; No more, finish up
IDPB M,L ; Save this one in list
JRST STQDL1 ; Go for more
STQFLG: SKIPA A,[NXTFLG]
STQUND: MOVEI A,NXTUND
JRST STQDL0
STQNEW: SKIPA A,[NXTNEW]
STQOLD: MOVEI A,NXTOLD
JRST STQDL0
STQLST: CALL STQLSS ; Get number of messages to put into list
JRST GTSQNE ; Range error
MOVE C,LASTM ; Number of last message
JUMPL X,STQLS2 ; If no previous no. with colon, this is easy
MOVE B,C ; There was one, set up to count from there
JRST GTSQN2 ; Go count from number to end
STQLS2: IDPB C,L ; Stuff message numbers
SUBI C,1 ; Next message from end
SOJG A,STQLS2 ; Do for all in list
CONFRM
JRST GTSQNR ; Done with list
STQFRS: CALL STQLSS ; Similarly, first n messages
JRST GTSQNE ; ..
SETZ C, ; ..
STQFR2: IDPB C,L ; ..
ADDI C,1 ; ..
SOJG A,STQFR2 ; ..
CONFRM
JRST GTSQNR ; ..
STQLSS: MOVEI A,[FLDDB. (.CMNUM,,^D10,,<1>)]
CALL RFIELD
PUSH P,B ; NOISEs clobber this
CAIE B,1 ; Singular?
JRST STQLS0 ; No, use plural
NOISE (message)
JRST STQLS1
STQLS0: NOISE (messages)
STQLS1: POP P,A ; Restore number typed
JUMPLE A,R ; Range check
SUBI A,1 ; LASTM is counted from zero
CAMLE A,LASTM ; ..
RET ; ..
ADDI A,1 ; recorrect A
RETSKP ; Good return
STQCUR: MOVEI B,(M) ; Default to current
IDPB B,L ; Save on list
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
STQTO: MOVEI X,NXTTO ; Match "to" string
MOVEI A,[FLDDB. (.CMCFM,CM%SDH,,<
String to match in "To" field
>,,[FLDDB. (.CMTXT,CM%SDH)])]
JRST STQSB0
STQKWD: MOVEI X,NXTKWD ; Match keyword in header or text
MOVEI A,[FLDDB. (.CMCFM,CM%SDH,,<
Keyword to match in text or header of message
>,,[FLDDB. (.CMTXT,CM%SDH)])]
JRST STQSB0
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
MOVE A,CR.COD(A) ; Get code
CAIN A,.CMCFM ; Just CR?
JRST [ CMERR <No string given.> ; Yes - error
JRST CMDER1]
MOVEI B,ATMBUF ; Copy string to pattern buffer
MOVEI A,PATSTR
HRLI A,(POINT 7,)
CALL MOVST0
MOVE A,X ; Routine addrs
JRST STQDL0
;Find substring in From, To, or Subject field
NXTKWD: SKIPA C,[CALL KWDSTR] ; Routine to match keyword in message
NXTTO: MOVE C,[CALL TOSTR] ; Routine to match To string
JRST NXTAL0 ; Join common loop
NXTSBJ: SKIPA C,[CALL SBJSTR] ; Routine to match Subject string
NXTFRM: MOVE C,[CALL FRMSTR] ; Routine to match From string
JRST NXTAL0 ; Use common loop
FRMSTR: $SAVE <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: $SAVE <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
TOSTR: $SAVE <A,C> ; Save these regs
MOVEI T,PATSTR ; String to match
MOVE V,MSGTO(A) ; To field for this message
MOVE W,MSGTOK(A) ; Use entire To field
CALL SEARCH
RETSKP ; Not found, try next
RET ; Found
KWDSTR: $SAVE <A,C> ; Save these regs
MOVEI T,PATSTR ; String to match
MOVE V,MSGBOD(A) ; Point to entire message
MOVE W,MSGBON(A) ; ..
CALL SEARCH ; Check for this string
RETSKP ; Not found
RET ; Found
; 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
CAIE M,-1(A) ; Yes, is this next or previous?
CAIN M,1(A) ; ..
JRST PRTSQ2 ; Yes, keep accumulating
CALL PRTSQS ; Print what is there now otherwise
PRTSQ1: HRLM M,LSTMSG ; And set ourselves up as start
PRTSQ2: HRRM M,LSTMSG ; Set ourselves up as next link in chain
RET
PRTSQ3: TXZ F,F%CMA ; Reset comma flag
JRST PRTSQ1
PRTSQS: SKIPGE LSTMSG ; Any messages selected at all?
JRST [ WARN <No messages match this specification>
RET]
TXOE F,F%CMA ; Maybe a comma first
$TEXT (KBFTOR,<,^A>)
HLRZ A,LSTMSG ; Start of sequence
ADDI A,1 ; Make real message number
$TEXT (KBFTOR,< ^D/A/^A>)
HRRZ B,LSTMSG ; End of sequence
CAIN A,1(B) ; Same (ie., sequence of one)?
JRST PRTSQ0 ; Yes, quit
ADDI B,1 ; Actual is 1 more than LSTMSG
$TEXT (KBFTOR,<:^D/B/^A>)
PRTSQ0: $CALL K%FLSH ; This can be slow, so say something
RET ; Return
; Get next messages
NXTSEQ: 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
;Routines to select messages based on message flag bits.
; These routines need not parse the messages (unless a match is found,
; in which case GTSQNR will parse them.)
NXTANS: SKIPA B,[M%RPLY] ; Answered
NXTOLD: MOVX B,M%SEEN ; Old := seen bit set
JRST NXTDL0
NXTFLG: SKIPA B,[M%ATTN] ; Flagged
NXTDEL: MOVX B,M%DELE ; Deleted
NXTDL0: MOVE C,[TDNE B,MSGBTS(A)] ; Bit must be set
JRST NXTAL4
NXTUNA: SKIPA B,[M%RPLY] ; Unanswered
NXTUNF: MOVX B,M%ATTN ; Unflagged
JRST NXTUD0
NXTNEW: SKIPA B,[M%SEEN] ; New := seen bit clear
NXTUND: MOVX B,M%DELE ; Undeleted
NXTUD0: MOVE C,[TDNN B,MSGBTS(A)] ; Bit must be clear
NXTAL4: MOVEI A,1(M) ; Start here
NXTAL5: CAMLE A,LASTM ; Done?
JRST NXTEND ; Yes, see if any found
XCT C ; Test this message
JRST NXTSQ1 ; Matches -- add to list
AOJA A,NXTAL5 ; No match, check next
;If selecting messages based on contents, must insure that the
; message is parsed before calling selection routine
NXTALL: MOVSI C,(<JFCL>) ; All := pass all thru
NXTAL0: MOVEI A,1(M) ; Start here
NXTAL1: CAMLE A,LASTM ; Done?
JRST NXTEND ; Check if any done
MOVX D,M%VALI ; Valid info for this msg?
TDNN D,MSGBTS(A) ; If not, must parse it before testing it
JRST [ EXCH A,M ; Msg to parse is c(A)
CALL PRSMSG ; Go parse it
EXCH A,M ; Restore ACs
JRST .+1] ; Go test it now
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
LLIT
SUBTTL Routines to parse host tables, determine what nets are present, etc.
SNDINI: JRST .ERSL0 ; Go erase everything
;Figure out if we're on a network, and what our local host name is
; If we're both a DECNET and an ARPANET host, the ARPANET host name is used
; Also, note whether XMAILR exists
NAMINI: STKVAR <NODARG>
TXZ F,F%XMLR!F%ARPA!F%DECN!F%ANFX ; Assume no XMAILR or nets
TOPS20<
MOVX A,GJ%SHT!GJ%OLD!GJ%PHY ; See if system has XMAILR
HRROI B,[ASCIZ /SYSTEM:XMAILR.FLAGS/]
GTJFN
ERJMP NAMIN0 ; None, I guess...
MOVEM A,XMFJFN ; Yes, save flags file JFN
TXO F,F%XMLR ; Remember we're on a fancy host
NAMIN0: MOVX A,.GTHSZ ; Try new style JSYS
GTHST ; for local host number
ERJMP NAMIN1 ; If fails, try old
MOVEM D,LHOSTN ; OK, save local host number
MOVE C,D ; Find our name
MOVE B,[POINT 7,MYHNAM,27]
MOVX A,.GTHNS
GTHST
ERJMP [JRETER <Can't find local host name with GTHST>
JRST NAMIN1] ; Eh? maybe try old stuff
TXO F,F%ARPA ; Remember net exists
JRST NAMIN2 ; OK, now go see if any DECNET
NAMIN1: MOVE A,[SIXBIT /LHOSTN/]
SYSGT
MOVEM A,LHOSTN
CAMN A,[-1] ; ARPA net?
JRST NAMIN2 ; No - check for DECnet
MOVEI B,(A)
MOVE A,[POINT 7,MYHNAM,27]
CVHST
ERJMP [JRETER <Can't get local host name with CVHST>
JRST NAMIN2]
TXO F,F%ARPA ; Yes - set flag
NAMIN2: MOVEI A,.NDGLN ; Get DECnet host name
MOVE B,[POINT 7,MYHDEC,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
TXNE F,F%ARPA ; ARPANET also?
RET ; Yes, don't do this
MOVE B,[POINT 7,MYHNAM,27]
MOVEM B,NODARG ; No, make our DECNET name universal
MOVEI B,NODARG ; ..
MOVEI A,.NDGLN ; ..
NODE ; ..
RET ; and return
>;End TOPS20
; .. ; TOPS10 code continues on next page
; ..
TOPS10<
MOVEI A,.GTLOC ; Get location of job 0 (CROCK!!!)
GETTAB A, ; ..
RET ; Failure, assume no net
JUMPE A,R ; ..
MOVEM A,ANFNUM ; Save local node number
MOVEM A,LHOSTN ; *** For now, just to prevent multiple calls
MOVE C,A ; Copy to good place
MOVE A,[.NDRNN,,B] ; Function to return node name
MOVEI B,2 ; Length of arg block
NODE. A, ; Get our node name
RET ; Ratz... assume no net
MOVE B,A ; Get SIXBIT into better AC
MOVE C,[POINT 7,MYHNAM,27] ; Where to put ASCII name
NAMIN2: SETZ A,
LSHC A,6 ; Get SIXBIT character in C
ADDI A,40 ; Make ASCII
IDPB A,C ; Stuff into name
JUMPN B,NAMIN2 ; Do all chars
NAMIN3: IDPB B,C ; Insure ASCIZ
TXO F,F%ANFX ; Remember presence of ANF10 net
RET ; Return
;Still in TOPS10
;Still in TOPS10
;USRINI - Parse user/PPN file and enter into USRTAB
USRINI: TRVAR <USRIFN,<USRFOB,2>,USRN>
MOVEI A,FDXSIZ ; Allocate FD for filespec
$CALL M%GMEM ; Get a chunk
JUMPF [FATAL (Can't init user table)]
MOVEI A,FDXSIZ ; Size of FD
HRLZM A,.FDLEN(B) ; Store
MOVE A,[SIXBIT /SYS/] ; Init good stuff in filespec
MOVEM A,.FDSTR(B) ; ..
MOVE A,[SIXBIT /USERS/]
MOVEM A,.FDNAM(B)
MOVE A,[SIXBIT /TXT/]
MOVEM A,.FDEXT(B)
MOVE A,B ; Setup for call to ALCFOB
CALL ALCFOB ; Allocate and link FOB
FATAL (Can't init user table - no memory)
DMOVEM A,USRFOB ; Save FOB info
MOVX C,FB.PHY ; Physical-only open, please, no forgeries here
IORM C,FOB.CW(B) ; Notify GLXFIL via FOB
MOVX A,FOB.MZ ; Pretend short FOB so we use privileges
$CALL F%IOPN ; Open file for input
JUMPF [FATAL (Can't find SYS:USERS.TXT)]
MOVEM A,USRIFN ; Save IFN
MOVX B,FI.SIZ ; Get length of USERS.TXT, in bytes
$CALL F%INFO ; ..
MOVEM A,USRN ; Save for a bit
MOVEI A,USRTBN ; Init USRTAB
MOVEM A,USRTAB ; ..
USRIN1: MOVEI A,UB.LEN ; Allocate a U-block
$CALL M%GMEM ; ..
JUMPF USRINQ ; Oops, no room
MOVE U,B ; Save its address
CALL USRDEV ; Get device name
JRST USRINE ; Failed or EOF, check it out
MOVEM A,UB.STR(U) ; Save
CALL USRPPN ; Get PPN
JRST USRINE ; Failed or EOF, check it out
MOVEM A,UB.PPN(U) ; Save
CALL USRNAM ; Get name string
JRST USRINE ; Error or EOF, check it out
HRLZ B,A ; LH for TBADD
HRR B,U ; Pointer to U-block in RH
MOVEI A,USRTAB ; Table head
$CALL S%TBAD ; Add the entry
JUMPF [ HLRZ A,B ; Get name string
PUSH P,A
CALL CRIF
POP P,A
$TEXT (KBFTOR,<Can't add user ^Q/A/ to user table because: ^E/[-1]/>)
JRST USRINE]
SKIPLE USRN ; Characters still left in USERS.TXT?
JRST USRIN1 ; Yes, keep munching
JRST USRINX ; No, go clean up
;Here if error or possible EOF parsing an entry. Try to skip to end of line
; and start parsing the next entry. If we hit EOF, we go to the finishup code.
USRINE: CALL USRBYT ; Get next byte
JRST USRINX ; EOF, finish up
CAIE A,12 ; Line feed?
JRST USRINE ; No, keep looking
SKIPG USRN ; Yes, any bytes left?
JRST USRINX ; No, finish up
JRST USRIN1 ; Yes, try to parse next line
;Normal finish to USERS.TXT parse
USRINX: MOVE A,USRIFN ; Close USERS.TXT
$CALL F%REL ; ..
DMOVE A,USRFOB ; Release FOB info
CALL RELFOB ; ..
MOVE A,[POINT 7,MYDIRS] ; Point to place to store my name
MOVE B,MYPPN ; My PPN
CALL PPN2ST ; Convert to string
FATAL (You are not registered in SYS:USERS.TXT)
MOVEI A,USRTAB
MOVE B,[POINT 7,MYDIRS] ; Point to my name
$CALL S%TBLK ; Find table entry
HRRZ A,(A) ; Get pointer to U-block
MOVEM A,MYDIR ; Save for later use by GETUSR
MOVE A,[POINT 7,MYDIRS] ; My name
MOVE B,MYPPN ; See if [1,2]
CAMN B,[1,,2] ; which is possible source of confusion
WARN (Your messages will be considered to be from %1S%C)
RET ; Return
;Here if no memory
USRINQ: WARN (Can't parse SYS:USERS.TXT -- insufficient memory)
JRST USRINX
;Get one byte from USERS.TXT, flushing nulls and comments
;Return +1: EOF
; +2: OK, byte in A
USRBYT: SOSGE USRN ; Count down bytes
RET ; EOF
MOVE A,USRIFN ; IFN for USERS.TXT
$CALL F%IBYT ; Get a byte
JUMPE B,USRBYT ; Ignore nulls
CAIE B,";" ; Flush comments too
CAIN B,"!" ; ..
JRST [ SOSGE USRN ; Count down bytes
RET ; No more, return
MOVE A,USRIFN ; Next byte
$CALL F%IBYT ; ..
CAIN B,12 ; Eat chars to EOL
JRST USRBYT ; Comment done, return next valid char
JRST .] ; Still eating comment
MOVE A,B ; Return in A
RETSKP
;Get device name from USERS.TXT
;Return +1: syntax error or EOF
; +2: OK, device name (SIXBIT) in A
USRDEV: STKVAR <<DEV,2>>
MOVEI C,6 ; Maximum chars in device name
MOVEI D,DEV ; Where to build name string
HRLI D,(POINT 7,) ; Form byte pointer
USRDV0: CALL USRBYT ; Get a byte
RET ; EOF
CAIN A,":" ; Look for terminating colon
JRST USRDV2 ; OK, got it
CAIL A,"A" ; Check to insure alphanumeric
CAILE A,"Z" ; ..
SKIPA ; ..
JRST USRDV1 ; ..
CAIL A,"a" ; ..
CAILE A,"z" ; ..
SKIPA ; ..
JRST USRDV1 ; ..
CAIL A,"0" ; ..
CAILE A,"9" ; ..
JRST [ WARN <Invalid character in device name in STD:USERS.TXT>
RET]
USRDV1: IDPB A,D ; Stuff in string
SOJG C,USRDV0 ; Count chars
WARN <Too many characters in device name in STD:USERS.TXT>
RET
USRDV2: SETZ A, ; Insure ASCIZ
IDPB A,D ; ..
MOVEI A,DEV ; Point to name we collected
HRLI A,(POINT 7,) ; ..
CALL ASCSIX ; Form SIXBIT
MOVE A,B ; Return in A for caller
RETSKP ; WIN!
;Parse PPN in USERS.TXT.
;Return +1: EOF or syntax error
; +2: OK, PPN in A
USRPPN: CALL USRBYT ; Get the open bracket
RET ; EOF, bad
CAIE A,"[" ; Check it
JRST USRPPE ; Bad, complain
CALL USROCT ; Get octal number
RET ; Bad
HRLZ D,A ; This is LH of PPN
CAIE B,"," ; Terminator should be comma
JRST USRPPE ; Complain
CALL USROCT ; Get RH
RET ; Bad
CAIE B,"]" ; Close bracket should terminate
JRST USRPPE ; Nope, complain
HRR D,A ; Form whole PPN
CALL USRBYT ; Get comma
JRST USRPPE ; Failure
CAIE A,"," ; Check it
JRST USRPPE ; Not comma, complain
MOVE A,D ; Return PPN in A
RETSKP ; Return to caller
USRPPE: WARN <Invalid format for PPN in STD:USERS.TXT>
RET
;Parse octal number in PPN. Only valid terminators are comma and close bracket
USROCT: SETZ C, ; Where to accumulate number
USROC0: CALL USRBYT ; Get next character
RET ; EOF in middle not allowed
CAIL A,"0" ; See if numeric and octal
CAILE A,"7" ; ..
JRST USROC1 ; No, go check terminator
LSH C,3 ; Yes, shift C over one digit
SUBI A,"0" ; Form value of digit
ADD C,A ; Add to sum
JRST USROC0 ; Keep going
USROC1: CAIE A,"," ; Terminator has to be comma
CAIN A,"]" ; or close bracket
SKIPA A,C ; OK, return sum in A
RET ; Neither, give failure return
RETSKP
;Parse user name. Valid characters are all alphanumerics, dot, and hyphen.
;
;Return +1: failure or EOF
; +2: OK, A points to string block (SB.xxx block)
USRNAM: MOVEI A,SB.LEN ; Allocate string block
$CALL M%GMEM ; ..
MOVE D,B ; Save its address
MOVE C,B ; Make a copy
HRLI C,(POINT 7,) ; Form byte pointer
MOVEI E,<SB.LEN*5> - 1 ; Max chars in username
USRNM0: CALL USRBYT ; Get next byte
JRST USRNMX ; EOF is OK here I guess
CAIE A,40 ; Ignore spaces
CAIN A,15 ; Ignore CR
JRST USRNM0 ; ..
CAIN A,12 ; LF ends the entry
JRST USRNMX ; ..
CAIL A,"A" ; Range check the character
CAILE A,"Z" ; ..
SKIPA ; ..
JRST USRNM1 ; ..
CAIL A,"a" ; ..
CAILE A,"z" ; ..
SKIPA ; ..
JRST USRNM1 ; ..
CAIL A,"0" ; ..
CAILE A,"9" ; ..
SKIPA ; ..
JRST USRNM1 ; ..
CAIE A,"." ; ..
CAIN A,"-" ; ..
JRST USRNM1 ; ..
WARN <Invalid character in user name in STD:USERS.TXT>
RET
USRNM1: IDPB A,C ; Save the character
SOJG E,USRNM0 ; Go for more if room
WARN <Username %4S too long in STD:USERS.TXT, truncated>
USRNMX: SETZ A, ; Insure ASCIZ
IDPB A,C ; ..
MOVE A,D ; Return address of S-block to caller
RETSKP
;Convert PPN in B to string - A points to string space
;
;Return +1: unknown or weirdness
; +2: OK, updated string pointer in A
PPN2ST: HLLZ E,USRTAB ; Get number of known PPNs
JUMPE E,R ; Oops... none known
MOVN E,E ; Form AOBJN pointer
HRRI E,1 ; Skip table header
PPN2S0: HRRZ C,USRTAB(E) ; Point to next PPN entry
MOVE C,(C) ; Get PPN
CAMN B,C ; Is this it?
JRST PPN2S1 ; Success!
AOBJN E,PPN2S0 ; No, keep looking
RET ; Not found, give bad return
PPN2S1: PUSH P,B ; Preserve over MOVST0
HLRZ B,USRTAB(E) ; Point to name
CALL MOVST0 ; Move 'em on out
POP P,B ; Restore PPN
RETSKP
;Convert string pointed to by A to PPN, return PPN in B
ST2PPN: PUSH P,A
MOVE B,A ; For TBLUK
MOVEI A,USRTAB ; ..
$CALL S%TBLK ; Find it?
TXNN B,TL%EXM ; Exact match?
JRST [ POP P,A ; No, return A unchanged
RET]
HRRZ B,(A) ; Point to PPN
MOVE B,(B) ; Fetch it
POP P,A ; Return caller's string pointer
RETSKP
;Convert ASCIZ string pointed to by A into SIXBIT in B
ASCSIX: SETZ B,
MOVE D,[POINT 6,B]
ASCSX1: ILDB C,A ; Next byte
JUMPE C,R ; Stop on null
CAIGE C,40 ; Insure no random ctrl chars
JRST ASCSX1 ; just ignore 'em if present
CAIL C,140 ; Uppercasify
TRZ C,40 ; ..
SUBI C,40 ; SIXBIT-ify
IDPB C,D ; Stuff
TRNN B,77 ; Stop at six chars
JRST ASCSX1 ; ..
RET
>;End TOPS10
SUBTTL Sending subroutines - HSTINI - init hostname tables
;Construct host name table in TBLUK format (HOSTAB)
; First, if XMAILR exists, try HOSTS2 (if that's not there, F%XMLR
; is turned off)
; Otherwise use regular HSTNAM (for ARPANET) or DECNET-HOSTS.TXT
HSTINI: $SAVE <C,D,E,T,U,V,W,X> ; This can be called from almost anywhere...
TRVAR <HTABL,HSTJFN,FBITS,HFPGS,HFPGN,HFPTR,HFCNT,<SSTR,10>>
MOVEI A,2777 ; Maximum size of host name table
MOVEM A,HOSTAB ; Initially empty
TOPS10<
TXNE F,F%ANFX ; Net exist?
CALL HSTINA ; Yes, read NODTBL
>;End TOPS10
TOPS20<
TXNE F,F%XMLR ; XMAILR/HOSTS2 support?
CALL HSTINX ; Yes - map and parse HOSTS2
SKIPA ; Problems? use old-style stuff then
JRST HSTXIT ; OK, clean up and return
TXNE F,F%ARPA ; ARPANET?
CALL HSTARP ; Yes, fetch hostnames
TXNE F,F%DECN ; DECNET?
CALL HSTIND ; Yes, fetch hostnames
>;End TOPS20
HSTXIT: TXNN F,F%ANFX!F%ARPA!F%DECN!F%XMLR ; Any nets?
RET ; No, return now
MOVEI A,HOSTAB ; Look up local hostname to be sure it's there
MOVE B,[POINT 7,MYHNAM,27]
$CALL S%TBLK ; ..
TXNE B,TL%EXM ; Are we present?
RET ; Yes! All done.
MOVEI A,SB.LEN ; No, must allocate a string block,
$CALL M%GMEM ; stuff our name into it, and add to the table
MOVEM B,HTABL ; Remember address of string block
MOVEI A,(B) ; Dest ptr for MOVST2
HRLI A,(POINT 7,) ; ..
MOVE B,[POINT 7,MYHNAM,27]
CALL MOVST2 ; Move local hostname to the block
MOVEI A,HOSTAB ; Now add block to host table
HRLZ B,HTABL ; ..
TXO B,NT%LCL ; Light local node flag
$CALL S%TBAD ; ..
RET ; Return
TOPS20<
;Parse ARPANET host tables -- first tries GTHST (Release 4 flavor)
; and then tries GETABs if that fails (Release 3 or earlier)
HSTARP: MOVX A,.GTHSZ ; Get number of hostnames
GTHST ; ..
ERJMP HSTIN2 ; Must be pre-release 4 monitor
MOVE E,B ; Set up AOBJN ptr
HRROI U,HSTNAM ; Initial string pointer
HSTIN0: MOVX A,.GTHIX ; Get name given index
MOVE B,U ; Current string pointer
HRRZ C,E ; Index
GTHST ; Get the name
ERJMP [JRETER <GTHST failure while building host table>
RET]
TXNN D,HS%SRV ; Is this a server host?
JRST HSTIN1 ; No, just skip it then
EXCH B,U ; Get original pointer, save updated
HRLZS B ; Get address of string to LH
TXO B,NT%ARP ; ARPANET host flag to RH
CAMN C,LHOSTN ; Is this us?
TXO B,NT%LCL ; Yes, light local host flag
MOVEI A,HOSTAB ; Add entry to table
TBADD
ERJMP [JRETER <TBADD failure while building host table>
RET]
TLNN U,760000 ; Is this word filled?
ADDI U,1 ; Yes, must leave a word of zeroes for ASCIZ
ADDI U,1 ; Skip to next complete word
HRLI U,(POINT 7,) ; in string space
HSTIN1: AOBJN E,HSTIN0
RET ; Done, return
HSTIN2: MOVE A,[SIXBIT /HSTNAM/]
SYSGT
MOVEM B,HTABL ; Save for GTBLT simulator
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]
HLLZ C,HTABL ; Restore aobjn pntr
HSTIN3: 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
ERJMP [JRETER <TBADD failure building host table>
RET]
AOBJN C,HSTIN3 ; Do for all hosts
RET ; Done, return
;Still in TOPS20
;Still in TOPS20
;See if DECNET host name table exists, and add hosts to table if so.
HSTIND: MOVX A,GJ%OLD!GJ%SHT ; Look for existing file
HRROI B,[ASCIZ /SYSTEM:DECNET-HOSTS.TXT/]
GTJFN
ERJMP [TXZ F,F%DECN ; No host table - no net then
RET]
MOVX B,OF%RD
OPENF ; open for read
JFATAL <Cannot open DECnet host name table>
MOVEM A,HSTJFN ; Save JFN
SIZEF ; Get file size
JFCL ; Unlikely
MOVEM C,HFPGS ; Save page count
MOVE A,C ; Acquire space to map file
$CALL M%AQNP ; ..
MOVEM A,HFPGN ; Save page no. of 1st page
LSH A,^D9 ; Form word address
HRLI A,(POINT 7,) ; Form byte pointer
MOVEM A,HFPTR ; save
HRLZ A,HSTJFN ; Map from file page zero
HRLI B,.FHSLF ; to fork page
HRR B,HFPGN ; here
MOVE C,HFPGS ; Page count
TXO C,PM%RD!PM%PLD!PM%CNT
PMAP
MOVE A,HSTJFN ; Get JFN back
MOVE B,[1,,.FBSIZ] ; Get byte count for file
MOVEI C,C ; Into C
GTFDB
MOVEM C,HFCNT ; Save
HSTID1: MOVEI A,SB.LEN ; Allocate chunk for host name and flags
$CALL M%GMEM ; ..
JUMPF [ FATAL (No room for DECNET host table)]
MOVE D,B ; Better AC
MOVX B,CM%FW ; Make room for flags
IORM B,(D) ; ..
ADDI D,1 ; ..
HRLI D,(POINT 7,) ; Form byte pointer
MOVEM D,HTABL ; Save beginning of string
HSTD1A: SETZM FBITS ; No flag bits known yet
MOVE A,HSTJFN ; JFN
HSTID2: CALL BYTIN ;Get a byte
JRST HSTIDE ; Error or EOF - quit
CAIN B,"/" ; Check for switches
CALL HSTIDK ; Go handle
CAIN B,"," ; Comma? (routing info follows)
JRST [ CALL BYTIN ; Yes, eat to EOL, comment, or switch
JRST HSTIDE ; ..
CAIN B,"/" ; Switch? go handle it
CALL HSTIDK ; ..
CAIE B,";" ; ..
CAIN B,"!" ; ..
JRST HSTID3 ; ..
CAIN B,12 ; EOL, wrap up
JRST HSTID5 ; ..
JRST .] ; None of the above, keep eating route
CAIE B,";" ; Start of comment?
CAIN B,"!" ; ..
SKIPA ; Yes
JRST HSTID4 ; No
HSTID3: CALL BYTIN ; Eat chars until EOL
JRST HSTIDE
CAIN B,12 ; EOL?
JRST HSTID5 ; Yes, start interpreting chars again
JRST HSTID3 ; No, eat more comment
;Here with a valid character which is an element of a hostname
HSTID4: CAIN B,12 ; EOL?
JRST HSTID5 ; Yes, quit this line
CAIN B,"=" ; Start of synonym?
JRST HSTIDS ; Yes, go handle synonym
IDPB B,D ; Save character
JRST HSTID2 ; Get next
HSTID5: CAMN D,HTABL ; Any characters found at all?
JRST HSTID2 ; No, don't put null name in table
MOVEI B,0 ; Add terminating null
IDPB B,D
MOVE A,[POINT 7,MYHDEC,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
IOR B,FBITS ; Add in any switch-induced bits
TXNE B,NT%KWL ; Can this host receive 20-style mail?
JRST [ MOVE D,HTABL ; No, don't add to host table then
JRST HSTD1A] ; Just reuse string block
HSTID7: SOS C,HTABL ; Back up to point to flags word
HRL B,C ; Point to string for table entry
MOVEI A,HOSTAB ; Host name table
$CALL S%TBAD ; Add to table
JRST HSTID1 ; Get next
;Parse switch
;Call: A/ JFN of input file
;Return +1: always, B/ terminating character, A preserved, C trashed
HSTIDK: STKVAR <TERM,IJFN,<HSTR,10>> ; Terminating character, JFN, string
MOVEM A,IJFN ; Save JFN
MOVEI C,HSTR ; Point to place to stuff switch
HRLI C,(POINT 7,)
HSTDK0: CALL BYTIN ; Get a byte
JRST HSTDK1 ; Let someone else bite it on this one
CAIG B,172
CAIGE B,101 ; If not alphabetic,
JRST [ CAIG B,71 ; And also not numeric
CAIGE B,60 ; ..
JRST HSTDK1 ; It terminates this field
JRST .+2] ; Don't TRZ numbers
TRZ B,40 ; Uppercase
IDPB B,C ; Stuff into switch
JRST HSTDK0 ; Loop thru all chars
HSTDK1: MOVEM B,TERM ; Save terminator
SETZ B, ; Insure ASCIZ
IDPB B,C
MOVEI B,HSTR ; Point to switch name
MOVEI A,SWTTAB ; Switch table
$CALL S%TBLK ; Get the sucker
JUMPF [ WARN <Internal error at HSTDK1>
RET]
TXNN B,TL%EXM!TL%ABR ; Found this switch?
RET ; Just ignore unknown switches
HRRZ A,(A) ; Get bits associated with switch
IORM A,FBITS ; Save for posterity
MOVE A,IJFN ; Restore A
MOVE B,TERM ; Return terminator
RET ; Return
;Still in TOPS20
;Still in TOPS20
;Here to handle synonym -- insure that what it is a synonym for is in the
; table, add it to table, and point its entry to real thing
HSTIDS: MOVEI B,0 ; Tie off this string
IDPB B,D ; ..
MOVEI C,SSTR ; Where to store real name for synonym
HRLI C,(POINT 7,) ; Form byte pointer
MOVE E,C ; Remember original address
MOVE A,HSTJFN ; Get JFN back
HSTIS0: CALL BYTIN ; Next byte of real name
JRST HSTIDE
CAIN B,12 ; EOL?
JRST HSTIS1 ; Yes...
IDPB B,C ; No, stuff this char
JRST HSTIS0 ; Keep going
HSTIS1: MOVEI B,0 ; Terminate string
IDPB B,C ; ..
MOVEI A,HOSTAB ; Point to host name table
MOVE B,E ; Look up this entry
TBLUK ; Better exist
TXNN B,TL%EXM ; Does it?
JRST [ HRRO A,E ; Point to strings
MOVE B,HTABL ; For error message
WARN (SYSTEM:DECNET-HOSTS.TXT has bad format)
WARN <%1S, a synonym for %2S, is not a known host name>
CALLRET HSTIDE] ; Just quit now
AOS C,NETSY0 ; Count synonyms
CAILE C,100 ; Too many?
JRST [ WARN (Too many host synonyms in SYSTEM:DECNET-HOSTS.TXT)
CALLRET HSTIDE] ; Quit now
HLRZ D,(A) ; Get pointer to real name
MOVEM D,NETSYN-1(C) ; Save in synonym table
LSH C,^D7 ; Move index to l.h. of r.h. (bits 18-28)
HRRZ B,(A) ; Get flag bits for real name
TXZ B,NT%IDX!NT%NXL ; Don't propagate no-translate bit or index
IOR C,B ; Propagate flag bits
TXO C,NT%SYN ; Light synonym bit
HRROI A,[ASCIZ /Interoffice-mail/]
HRRO B,HTABL ; Point to current synonym
STCMP ; Does synonym CONTAIN "Interoffice-mail"?
TXNE A,SC%SUB ; If so, it should never be translated
JRST [ IORX C,NT%NXL ; Yes, light no-translate bit
TXZ C,NT%LCL ; Don't propagate "local" bit
MOVX B,CM%INV ; Make this invisible
MOVE A,HTABL ; String to be added to table
SUBI A,1 ; Point to flags for string
IORM B,(A) ; Make this guy invisible
JRST .+1]
MOVE B,C ; Put into right AC
JRST HSTID7 ; Add to host table
HSTIDE: SETO A, ; Unmap file pages
HRLI B,.FHSLF ; from fork
HRR B,HFPGN ; Starting page
MOVE C,HFPGS ; page count
TXO C,PM%CNT
PMAP
MOVE A,HFPGS ; Release storage too
MOVE B,HFPGN
$CALL M%RLNP
MOVE A,HSTJFN
CLOSF ; EOF - close file
JFCL
RET ; Return
;Utility routine to read bytes, ignoring null, LWSP, and CR
;Return +1: EOF or error, msg already typed if error
; +2: OK, byte in B, A preserved
BYTIN: SOSGE HFCNT ; Any bytes left?
RET ; No, nonskip return
ILDB B,HFPTR ; Yes, fetch next
JUMPE B,BYTIN ; Ignore nulls
CAIE B," " ; spaces
CAIN B,15 ; and CR
JRST BYTIN
CAIN B,11 ; Ignore tabs
JRST BYTIN
RETSKP
;Here to attempt build host name table from HOSTS2. If any lossage,
; clears F%XMLR so XMAILR isn't invoked (the assumption is made that
; systems should have both XMAILR and HOSTS2, or neither)
HSTINX: MOVX A,GJ%SHT!GJ%OLD
HRROI B,[ASCIZ /SYSTEM:HOSTS2.BIN/]
GTJFN
ERJMP [JRETER <Can't find SYSTEM:HOSTS2.BIN, using monitor tables instead>
JRST HSTNXX] ; Clean up and return
MOVE D,A ; Save JFN in case of OPENF failure
MOVX B,OF%RD ; Open for read
OPENF
ERJMP [JRETER <Can't open SYSTEM:HOSTS2.BIN, using monitor tables instead>
MOVE A,D ; Dump JFN
RLJFN
JFCL
JRST HSTNXX]
SIZEF ; Get size of file
ERJMP [JRETER <Can't determine size of SYSTEM:HOSTS2.BIN, using monitor tables instead>
MOVE A,D ; No dangling JFNs, please
RLJFN
JFCL
JRST HSTNXX]
HRLZ A,A ; JFN,,page zero
MOVE B,[.FHSLF,,HSTPAG/1000] ; Where to map file
TXO C,PM%PLD!PM%RD!PM%CNT ; Read access, preload please
PMAP
MOVE A,HSTPAG ; Check to insure this is really a HOSTS2
CAME A,[SIXBIT /HOSTS2/]
JRST [ WARN <SYSTEM:HOSTS2.BIN has bad format, using monitor tables instead>
JRST HSTNXX] ; Lossage, don't use XMAILR then
MOVE A,HSTPAG+NAMPTR ; Get ptr to names table
ADDI A,HSTPAG ; Add base addr of file
MOVN D,(A) ; Get size of table
MOVSS D ; Form AOBJN ptr
HRRI D,2(A) ; Point to first entry in table
HSTIX0: MOVEI A,HOSTAB ; Host name table for COMND
MOVS B,(D) ; Get name table entry
ADD B,[HSTPAG,,HSTPAG] ; Add base addr of file
$CALL S%TBAD
JUMPF [WARN (Error building host name table)
RETSKP] ; Probably just full table
AOBJN D,HSTIX0 ; Do for all names
MOVEI A,HOSTAB ; Look up our name in HOSTS2
MOVE B,[POINT 7,MYHNAM,27]
TBLUK
TXNN B,TL%EXM ; Better have exact match
FATAL (Can't find local host name in SYSTEM:HOSTS2.BIN)
HRRZ A,(A) ; Get pointer to site entry for this host
MOVEM A,LSITE ; Remember for later
RETSKP ; Done
;Still in TOPS20
;Still in TOPS20
;If any lossage in HOSTS2, don't use XMAILR
HSTNXX: SKIPLE A,XMFJFN ; Release XMAILR.FLAGS JFN if it exists
RLJFN
JFCL
SETZM XMFJFN
TXZ F,F%XMLR ; Don't attempt to use XMAILR
RET ; Failure return
;Simulate GTBLT JSYS for vanilla TOPS20
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
>;End TOPS20
;HSTINA - Here from HSTINI for TOPS10 -- read SYS:NODTBL.EXE
; to get list of all possible hosts
TOPS10<
HSTINA: RET ; *** Removed for MS version 5, version 6 will
; *** have the network support
REPEAT 0,<
TRVAR <<GTSGB,6>,<PATHB,9>,NHOSTS>; GETSEG arg block, path, host count
HRROI A,.GTRDV ; Get complete filespec for hiseg
GETTAB A, ; Device
FATAL (Can't GETTAB hiseg's device)
MOVEM A,GTSGB ; Save in GETSEG block
HRROI A,.GTRFN ; Filename
GETTAB A,
FATAL (Can't GETTAB hiseg name)
MOVEM A,1+GTSGB
HRROI A,.GTRDI ; Directory
GETTAB A,
FATAL (Can't GETTAB hiseg's PPN)
MOVEM A,4+GTSGB
HRROI B,.GTRS0 ; See if path exists
GETTAB B, ; ..
SETZ B,
JUMPE B,HSTNA3 ; No, this is easy
MOVEM A,2+PATHB ; Yes, stuff PPN into 1st wd of path
MOVEM B,3+PATHB ; First SFD
MOVEI A,PATHB ; Point GETSEG at path block
MOVEM A,4+GTSGB ; ..
SETZM PATHB ; Zero two useless words
SETZM 1+PATHB
HRROI A,.GTRS1 ; Do for all SFDs
GETTAB A,
SETZ A,
MOVEM A,4+PATHB
JUMPE A,HSTNA3
HRROI A,.GTRS2
GETTAB A,
SETZ A,
MOVEM A,5+PATHB
JUMPE A,HSTNA3
HRROI A,.GTRS3
GETTAB A,
SETZ A,
MOVEM A,6+PATHB
JUMPE A,HSTNA3
HRROI A,.GTRS4
GETTAB A,
SETZ A,
MOVEM A,7+PATHB
SETZM 8+PATHB ; Insure SFD list terminated
; JRST HSTNA3
;(Still in TOPS10)
;(Still in TOPS10)
HSTNA3: SETZM 2+GTSGB
SETZM 3+GTSGB ; Zero unused words
SETZM 5+GTSGB ; ..
MOVE A,[HSTN0,,HSTNAL] ; BLT code into low segment
BLT A,HSTNAL+HSTN0N ; so we can switch hi segs
MOVE A,[B,,GTS.AC+B] ; Save ACs clobbered by braindamaged UUO
BLT A,GTS.AC+P ; ..
JRST HSTNAL ; Go to low seg code
XLIST ; LIT to dump literals
LIT
LIST
RELOC ; This code will end up in low seg
HSTNAL==. ; Where code will land
RELOC ; Back to hi seg
HSTN0==. ; Hi seg address of pure copy of the code
PHASE HSTNAL ; Pretend already in low seg
HSTN0N==. ; Used to count words needed for this code
MOVEI A,[SIXBIT /SYS/ ; GETSEG SYS:NODTBL.EXE
SIXBIT /NODTBL/
SIXBIT /EXE/
EXP 0
XWD 1,4 ; PPN
EXP 0]
GETSEG A,
JRST [ MOVE A,[GTS.AC+B,,B] ; Restore ACs
BLT A,P ; ..
CALL RTRHSG ; Retrieve original hi seg
WARN (Can't find SYS:NODTBL.EXE)
RET]
MOVE A,[GTS.AC+B,,B] ; Restore stupidly clobbered ACs
BLT A,P ; ..
MOVE T,400010 ; Get length of an entry
MOVEI E,400011 ; First entry
MOVE U,[POINT 7,ANFNAM] ; Where to put host names
SETZM NHOSTS ; Reset host name count
; ..
;(Still in TOPS10)
;(Still in TOPS10)
; ..
HSTNA0: CAML E,.JBHRL ; Gone off end of hi seg yet?
JRST HSTNAX ; Yes, all done
SKIPN B,(E) ; Get next (SIXBIT) node name
JRST HSTNAX ; Zero -- all done
HRRZ D,U ; Save start of this entry in case discarded
HSTNA1: SETZ A,
LSHC A,6 ; Get next SIXBIT char
ADDI A,40 ; Convert to ASCII
CAIE A,"?" ; Ignore node names containing weird chars
CAIN A,"%" ; ..
SKIPA ; ..
CAIN A,"_" ; ..
JRST [ MOVE U,D ; Reuse this entry's space
JRST HSTNA2] ; Ignore this one, get next
IDPB A,U ; Store
JUMPN B,HSTNA1 ; Until done
SETZ A, ; Insure ASCIZ
IDPB A,U ; ..
AOS NHOSTS ; Count host names
HRRZI U,1(U) ; Next free word of string space
HSTNA2: ADDI E,(T) ; Advance to next entry
CAIL U,ANFNAM+ANFNMN ; Too many strings?
JRST [ OUTSTR [ASCIZ /
?Too many host names in SYS:NODTBL.EXE
/]
EXIT 1,
JRST .-1]
HRLI U,(POINT 7,) ; Form kosher byte pointer
JRST HSTNA0 ; Get next host name
;Here when all host names have been read -- retrieve GLXLIB and return
HSTNAX: CALL RTRHSG ; Retrieve GLXLIB hi seg
JRST HSTNX1 ; Reenter hi seg
; Retrieve high segment
RTRHSG: MOVE A,[B,,GTS.AC+B] ; Save ACs clobbered by idiot monitor
BLT A,GTS.AC+P ; ..
MOVEI A,GTSGB ; Point to block for old hiseg
GETSEG A, ; Snarf it back
JRST [ OUTSTR [ASCIZ /
?Can't retrieve high segment
/]
EXIT 1,
JRST .-1]
MOVE A,[GTS.AC+B,,B] ; Restore ACs
BLT A,P
CALL EATCHN ; Eat channel zero which was released
; by STUPID BRAINDAMAGED O.S.
RET
XLIST ; LIT so literals go in low seg
LIT
LIST
;Now compute how many words of code were generated and allocate low seg
; space for it all.
HSTN0N==.-HSTN0N
DEPHASE ; Back to ordinary addresses
RELOC
BLOCK HSTN0N ; Here is where the low seg code is BLT'ed to
RELOC
;(Still in TOPS10)
;(Still in TOPS10)
HSTNX1: MOVEI U,ANFNAM ; Point to first name
MOVE D,NHOSTS ; Get number of names
HSTNX0: MOVE A,[POINT 7,MYHNAM,27]
HRR B,U ; See if this is the local host
HRLI B,(POINT 7,)
$CALL S%SCMP
SETZ B, ; Assume not
SKIPN A ; A=0 if strings matched
TXO B,NT%LCL ; Match, this is local host
MOVEI A,HOSTAB ; Add to host table
HRL B,U ; Pointer to this name
$CALL S%TBAD ; Add it
MOVE B,U ; Point to this one again
HRLI B,(POINT 7,) ; Form byte pointer
ILDB A,B ; Scan for nulls
JUMPN A,.-1 ; ..
HRRZI U,1(B) ; Point to next full word
SOJG D,HSTNX0 ; Do for all names
RET ; and return
>;*** End REPEAT 0
>;End TOPS10
LLIT
SUBTTL SNDMSG - 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]
SKIPG B,TXTPTR ; Get ptr to terminator
JRST [ HRLI B,(POINT 7,,34) ; If funny (nonexistent byte),
SUBI B,1 ; correct
JRST .+1]
MOVEI A,CRLF0
LDB C,B
CAIE C,12 ; Unless ended with CRLF
CALL TXTPUT ; tack one on
TXZ F,F%QDEC!F%QARP ; Note no queued mail yet
CITYPE <Processing mail...>
$CALL K%FLSH
$CALL I%NOW ; Get current date/time
MOVEM A,MSGID0 ; Save for construction of message-ID
SETO A, ; This job
MOVX B,JI.JNO ; Job number for message-ID
$CALL I%JINF ; ..
MOVEM B,MSGID1 ; ..
MOVX B,JI.USR ; PPN or usernumber
$CALL I%JINF ; ..
HRRZM B,MSGID2 ; Only less significant half
MOVX B,JI.RTM ; Also runtime in msec
$CALL I%JINF ; ..
HRRZM B,MSGID3 ; Only need low-order part, really
; .. ; continued on next page
; .. ; continued from previous page
SKIPE A,SVMFOB ; Saving outgoing mail?
JRST [ MOVE B,SVMFOB+1 ; Yes, do it up
CALL CRIF ; Left margin, please
MOVE C,FOB.FD(B) ; now to FD for message
$TEXT (KBFTOR,<Message filed in ^F/(C)/ ^A>)
PUSH P,B
$CALL K%FLSH
POP P,B
CALL SAVMSG ; ..
JRST [ DMOVE A,SVMFOB ; Failure, release chunks
CALL RELFOB ; ..
SETZM SVMFOB ; Stop saving messages
WARN (No more messages will be saved)
JRST .+1]
$TEXT (KBFTOR,<- OK>)
JRST .+1]
$CALL K%FLSH ; This might take a while, so speak to the user
CALL SNDLCL ; Send local mail if any
RET ; Failure, pass it on
TXNN F,F%NIPC ; Smart local mailer?
TXNN F,F%LCL ; No, any net mail?
SKIPA
RETSKP ; Dumb mailer and all mail local, return now
TXNE F,F%XMLR ; XMAILR support?
JRST [ CALL XMAILR ; Yes, queue XMAILR mail
RET ; Pass failure on up
JRST SNDMS2] ; Light mailer flags and finish
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%QDEC ; Any DECNET mail queued?
JRST SNDMS2 ; No
HLRZ A,HOSTAB ; Yes - clear done flags in host table
MOVX B,NT%DON ; ..
ANDCAM B,HOSTAB(A) ; ..
SOJG A,.-1 ; ..
SNDMS2: TXNE F,F%QDEC!F%QARP!F%QXML ; Any queued mail at all?
CALLRET MAIFLG ; Yes, set mailer flags and return
RETSKP
SUBTTL Sending subroutines - BLDHDR - build message header
;Build text of headers at HDRPAG - returns with OO pointing to last byte
; Called only for netmail (because in local mail MAILER builds header)
; F%DNNM = queueing DECNET mail, so use DECNET name of this host
BLDHDR: MOVE A,[POINT 7,HDRPAG]
MOVEI B,[ASCIZ /Date: /]
CALL MOVSTR
TOPS20<
SETO B, ; Current time
MOVX C,<OT%4YR!OT%SPA!OT%NSC!OT%NCO!OT%TMZ!OT%SCL>
ODTIM ; "12 Dec 1977 1906-PST"
>;End TOPS20
TOPS10<
MOVEM A,UPDPTR ; Because of GLXLIB AC conventions
$TEXT (UPDTOR,<^H[-1]^A>) ; Current time
MOVE A,UPDPTR ; Put byte pointer back where MOVSTx expect it
>;End TOPS10
MOVEI B,[ASCIZ /
From: /]
CALL MOVSTR
SKIPN PERSON ; Any personal name string?
JRST BLDHD0 ; No, skip this
MOVEI B,PERSON ; Yes, put it first
CALL MOVSTR ; ..
MOVEI B,[ASCIZ / </] ; And delimit real address with wedges
CALL MOVSTR ; ..
BLDHD0: MOVEI B,MYDIRS ; My address
CALL MOVSTR ; Put it in
MOVEI B,MYHNAM ; Add "at FOO"
TXNE F,F%DNNM ; Writing DECNET or ARPANET mail?
MOVEI B,MYHDEC ; DECNET -- use DECNET name for this host
TXNE F,F%XMTO ; XMAILR-style hostnames?
JRST [ MOVEI B,[ASCIZ / at /]
CALL MOVSTR ; Yes, must delimit hostname
MOVEI B,177 ; with rubouts
IDPB B,A ; ..
MOVE B,[POINT 7,MYHNAM,27]
CALL MOVST1
MOVEI B,[BYTE (7) 177 (29) 0]
JRST .+1]
CALL MOVSTR ; ..
MOVEI B,[ASCIZ />/] ; Wedge might be needed
SKIPE PERSON ; Doing personal name?
CALL MOVSTR ; Yes, add the wedge
MOVEM A,OBPTR ; Get pointer set up right
CALL MOVTO ; Do to
CALL MOVCC ; and CC
TXO F,F%F1 ; Want crlf
CALL MOVOPT ; Move header options
CALL MOVSUB ; Insert subject
CALL MOVMID ; Move message-ID
MOVEI B,REPLIN ; Any reply lines?
SKIPE REPLIN ; ..
CALL MOVSB2 ; Yes, move 'em on out
MOVEI B,CRLF0
CALL MOVSB2 ; And a blank line
SETZ A,
IDPB A,OBPTR ; Mark end of this with a null
RET
SUBTTL Sending subroutines - SAVMSG - Save outgoing message in file
;Call with FOB size and address in A and B
; Skip return iff successful
; F%F1 = do not set "seen" bit in message flags
SAVMSG: STKVAR <HDRLEN> ; Header length
TXZ F,F%F2 ; In case left lying around by errors
SETZM SVMIFN ; Remember no IFN yet
MOVE C,B ; Preserve FOB address in case of error
$CALL F%AOPN ; ..
JUMPF [ MOVE A,FOB.FD(C) ; Error, point to FD for file
CALL CRIF
$TEXT (KBFTOR,<?Can't open file ^F/(A)/ for write because: ^E/[-1]/>)
RET]
JRST SAVMS1
SAVMS0: STKVAR <HDRLEN> ; Header length
SAVMS1: MOVEM A,SVMIFN ; Save the IFN
TXZ F,F%XMTO ; Insure no rubouts in headers
PUSH P,F ; Save state of F%F1
CALL BLDHDR ; Build header text
POP P,F ; Restore flags
MOVE A,OBPTR ; Compute no. of bytes in headers
BP2CHR ; First get byte no. of last byte
MOVEM V,OBPTR ; Save it
MOVE A,[POINT 7,HDRPAG] ; And byte no. of first byte
BP2CHR ; ..
MOVE B,OBPTR
SUB B,V ; Compute length of header
SUBI B,1 ; Don't count the null
ADD B,TXTTOT ; plus total length of text
ADDI B,NTRAIL ; and length of trailer (dashes)
TXNN F,F%F1 ; Want the "seen" bit on?
$TEXT (SAVMSW,<^H/[-1]/,^D/B/;000000000001>) ; Write header line
TXZE F,F%F1 ; Don't light "seen" bit
$TEXT (SAVMSW,<^H/[-1]/,^D/B/;000000000000>) ; Write header line
MOVE A,SVMIFN ; For calls to TSOUT on next page
TXZ F,F%F3 ; Put the trailing dashes in
CALLRET SAVDRF ; Write body of message and return
SUBTTL Sending subroutines - SAVDRF - write current draft
;Write current draft to file, IFN in A
; Skip return iff success
; F%F2 = must DEQ file before closing
; F%F3 = don't add trailing dashes
SAVDRF: STKVAR <SVIFN>
MOVEM A,SVIFN ; Save IFN for later
SETZB C,D
HRROI B,HDRPAG ; Start of headers
CALL TSOUT ; Do a SOUT
JUMPF SVDERR ; Error writing queue file
CALL TXTOUT ; Write text to IFN in A
JUMPF SVDERR
MOVE A,SVIFN
HRROI B,TRAILR ; Add trailing dashes
SETZB C,D ; ..
TXZN F,F%F3 ; unless saving draft
CALL TSOUT ; ..
JUMPF SVDERR
$CALL F%CHKP ; Update file, dammit!
MOVE A,SVIFN ; F%CHKP cleverly clobbers this
$CALL F%REL ; Close file
RETSKP ; OK
SVDERR: JRETER (Error writing message)
MOVE A,SVIFN ; Get IFN of losing file
$CALL F%RREL ; abort this opening
RET ; Failure return
SVERR: JRETER (Error writing message)
SKIPE A,SVMIFN ; If a file is open,
$CALL F%RREL ; abort this opening
RET
;SAVMSW - Routine called by $TEXT macro above to write byte to output file
SAVMSW: MOVE B,A ; Adjust AC usage
MOVE A,SVMIFN ; File to write to
$CALL F%OBYT
RET
SUBTTL Sending subroutines - TXTOUT - Write text of message to file or string
;Call:
; A/ IFN or string pointer
;
; or, if F%JSYS is on,
;
; A/ JFN or string pointer
TXTOUT: STKVAR <SVCNT,SVPTR,SIFN0,SINST>
MOVEM A,SIFN0 ; Save IFN
MOVE A,TXTFPG ; Address of first text page
ADD A,[POINT 7,TB.TXT] ; Point to text
MOVEM A,SVPTR ; Current text pointer
MOVE A,TXTTOT ; Get total text count
MOVEM A,SVCNT ; Save current text count
OUTTX0: MOVE C,SVCNT ; Get current count
CAILE C,TXTSIZ ; Is what's left entirely in current page?
MOVEI C,TXTSIZ ; No, just do this page
MOVE B,SVCNT ; Get current count
SUB B,C ; Minus this chunk
MOVEM B,SVCNT ; Update count
MOVE A,SIFN0 ; File to write to
MOVE B,SVPTR ; Point to this chunk
SETZ D, ; No fancy SOUT terminations
TOPS20<
TXNE F,F%JSYS ; Use JSYSes instead of GLXLIB?
JRST [ SOUT ; Yes
ERJMP .RETF ; Propagate errors
JRST OUTTX1] ; OK, continue
>;End TOPS20
CALL TSOUT ; Move it on out
JUMPF R ; Propagate errors
OUTTX1: MOVEM A,SIFN0 ; Save in case updated pointer
SKIPN SVCNT ; Any text left?
RET ; No, return OK
MOVE A,SVPTR ; Get text pointer
ANDI A,777000 ; Compute first address in page
MOVE A,TB.FOR(A) ; Move to next page
ADD A,[POINT 7,TB.TXT] ; Point to text part of it
MOVEM A,SVPTR ; Save as current pointer
JRST OUTTX0 ; Do all chunks
SUBTTL Netmail routines - SNDNET - queue DECNET and/or ARPANET mail
TOPS20<
;Queue mail for non-XMAILR DECNET systems (DMAILR)
;Write queued mail for one address list (to or cc)
; List pointed to by U, end of list pointed to by W
SNDNET: TRVAR <QJFN,HPTR0,PSPEC,TEMP0,<HOSSTR,20>,<HNTMP,10>>
; JFN, hostname ptr, partial filespec ptr,
; temp, hostname string
; *** Must match TRVAR at XMAILR
MOVEI A,HOSSTR ; Where to build filespec for queued mail
HRLI A,(POINT 7,)
MOVEI B,[ASCIZ "PS:<"] ; Start building name of queued mail file
CALL MOVSTR ; Set up logged in dir.
MOVEI B,MYDIRS
CALL MOVSTR
MOVEM A,PSPEC ; Save ptr to partially built filespec
SNDNT0: MOVE B,(U) ; Get this address
TXNE B,AD%PFX!AD%SFX ; Address, or funny entry?
JRST SNDNT6 ; Funny - ignore
HRLI B,(POINT 7,)
TXNN F,F%NIPC ; Smart local mailer?
JRST SNDNT1 ; No, must do all addresses via net
CALL GETUNM ; Yes, get code for this entry
CAME B,[-1] ; Net address?
JRST SNDNT6 ; No, don't send via net then
MOVE B,(U) ; Yes, reform string pointer
HRLI B,(POINT 7,)
SNDNT1: ILDB C,B ; Get host name
JUMPE C,[MOVE B,[POINT 7,MYHNAM,27]
JRST SNDNT2] ; Local user
CAIN C,42 ; Quoted string?
JRST [ ILDB C,B ; Yes, scan to close quote
JUMPE C,[CMERR (Unterminated quoted string)]
CAIN C,42 ; Close quote?
JRST .+1 ; Yes, go on then
JRST .] ; No, keep looking
CAIE C,"@" ; Hostname?
JRST SNDNT1 ; Not yet
; JRST SNDNT2 ; Yes
;(Still in TOPS20)
;(Still in TOPS20)
SNDNT2: MOVEM B,HPTR0 ; Save pointer to host name
SKIPN HOSTAB ; Have host table?
CALL HSTINI ; No - get one
MOVEI A,HOSTAB
MOVE B,HPTR0 ; Get pointer to host name back
TBLUK ; Name lookup
HRRZ B,(A) ; Get flags
TXNE B,NT%ARP ; ARPANET host?
JRST SNDNT3 ; Yes
TXO F,F%QDEC ; Note existence of queued DECNET mail
MOVE A,PSPEC ; Restore ptr to partial filespec
MOVEI B,[ASCIZ />[--DECNET-MAIL--]./]
CALL MOVSTR ; Finish filename
MOVEM A,TEMP0 ; Save ptr to it again
MOVE B,HPTR0 ; Point to host part of this address
TXZ F,F%F1 ; Translate always
CALL TRANSH ; Translate to real name if necessary
MOVEI A,HNTMP ; Safer place for translation to sit
HRLI A,(POINT 7,) ; ..
CALL MOVST0 ; Get it out of harm's way
MOVEI B,HNTMP ; Point to safe copy
HRLI B,(POINT 7,) ; ..
MOVEM B,HPTR0 ; Save ptr to real name
MOVEI A,HOSTAB ; Look up "real" entry for host
TBLUK ; ..
HRRZ B,(A) ; Get flags
TXNE B,NT%KWL ; HAKMAIL host?
JRST [ HRRZ A,(U) ; Yes, write entire address into
HRLI A,(POINT 7,) ; ..
MOVEM A,HPTR0 ; extension of queued mail
JRST SNDN2A] ; And do one file per recipient
TXOE B,NT%DON ; Done this host yet?
JRST SNDNT6 ; Yes, don't do it again
HRRM B,(A) ; Remember we've done it
SNDN2A: TXO F,F%DNNM ; Use DECNET name for this host
CALL BLDHDR ; Build header text
TXZ F,F%DNNM
MOVE A,TEMP0 ; Restore ptr to partial filespec
MOVE B,HPTR0 ; Point to host name
JRST SNDNT4 ; Send message
;Still in TOPS20
;Still in TOPS20
;More of SNDNET
SNDNT3: MOVE A,PSPEC ; Restore ptr to partial filespec
;*** Crock necessitated by stupid asinine behavior of MACRO
;< This is to balance the close bracket in the following ASCIZ string
MOVEI B,[ASCIZ />[--UNSENT-MAIL--]./]
CALL MOVSTR ; Finish filename
HRRZ B,(U) ; Point to complete address
HRLI B,(POINT 7,)
SNDNT5: ILDB C,B ; Get char of name
JUMPE C,[MOVE B,[POINT 7,MYHNAM,27]
MOVEI C,"@" ; add local host name
JRST .+1]
MOVEI D,"V"-100
IDPB D,A ; Quote it
IDPB C,A
CAIE C,"@" ; At host yet?
JRST SNDNT5 ; No
MOVEM A,TEMP0 ; Save partial filespec ptr
MOVEM B,HPTR0 ; and host name ptr
CALL BLDHDR ; Build headers
MOVE A,TEMP0
MOVE B,HPTR0
TXO F,F%QARP ; Note existence of queued ARPANET mail
SNDNT4: MOVEI D,"V"-100 ; In case anything needs quoting
SNDN4A: ILDB C,B ; Insert rest of string
JUMPE C,SNDN4B ; Stop on null
CAIN C,"@" ; This needs quoting
IDPB D,A ; ..
IDPB C,A ; Move the char
JRST SNDN4A ; Repeat
SNDN4B: MOVEI B,[ASCIZ /;P770000/]
CALL MOVST0 ; Copy string and null
; ..
;Still in TOPS20
;Still in TOPS20
; ..
MOVSI A,(GJ%NEW!GJ%FOU!GJ%SHT)
HRROI B,HOSSTR
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]
MOVEM A,QJFN ; Remember the JFN
HRROI B,HDRPAG ; Start of headers
SETZ C,
SOUT
ERJMP QERROR ; Error writing queue file
TXO F,F%JSYS ; Use SOUT, not TSOUT
CALL TXTOUT ; Move text of message
TXZ F,F%JSYS ; Don't leave stray bits around
JUMPF QERROR ; Check for errors
HRROI B,TRAILR ; Add the dashes
SOUT ; ..
ERJMP QERROR
CLOSF ; All there is to it
ERJMP QERROR
SNDNT6: CAIE U,(W) ; At the end yet?
AOJA U,SNDNT0 ; No, get next guy
RETSKP
;Here on any error writing queue file
QERROR: JRETER (Error writing queued mail)
MOVE A,QJFN ; Get JFN of queued mail
CLOSF ; Close it
JFCL ; Ignore problems
RET
;Still in TOPS20
SUBTTL Netmail routines - XMAILR - queue mail for XMAILR
;Still in TOPS20
;Here if using HOSTS2/XMAILR
; Local flags usage:
; F%F3 = currently doing to list (as opposed to cc)
XMAILR: TRVAR <QJFN,HPTR0,PSPEC,TEMP0,<HOSSTR,20>,<HNTMP,10>>
; JFN, hostname ptr, partial filespec ptr,
; temp, hostname string
; *** Must match TRVAR at SNDNET
MOVE A,[POINT 7,STRBUF]
MOVEI B,[ASCIZ "PS:<"] ; Start building name of queued mail file
CALL MOVSTR ; Set up logged in dir.
MOVEI B,MYDIRS
CALL MOVSTR
MOVEI B,[ASCIZ />[--NETWORK-MAIL--]..;P770000/]
CALL MOVST0 ; Move string and the null
MOVX A,GJ%SHT!GJ%NEW!GJ%FOU
HRROI B,STRBUF ; Point to name of queued mail file
GTJFN
ERJMP [JRETER (Can't write queued mail)
RET]
MOVEM A,QJFN ; Save JFN for a bit
HRLI A,.FBBYV ; Specify 0 retention count
TXO A,CF%NUD ; Hold update till close
MOVX B,77B5
SETZ C,
CHFDB ; ...
JFCL ; Tough darts.
MOVE A,QJFN ; Get JFN back
MOVX B,<070000,,0>!OF%WR
OPENF
ERJMP QERROR ; Oops...
; ..
;Still in TOPS20
;Still in TOPS20
; ..
;Queue file is now open -- write the "envelope" (address lists) into it
XMAILQ: HRRZ W,TOPTRS ; Get ptr to end of to list
MOVEI U,TCPAG ; Point to beginning of to list
TXO F,F%F3 ; Flag that current list is to list
XMAIL0: MOVX A,AD%DON!AD%PFX!AD%SFX
TDNE A,(U) ; Done already, or funny entry?
JRST [ ADDI U,1 ; Yes... check next
CAMG U,W ; Off the end of this list yet?
JRST XMAIL0 ; No, check this one out
TXZN F,F%F3 ; To or cc?
JRST XMAIL8 ; cc - all done then
HLRZ W,TOPTRS ; to - is the cc list nonempty?
JUMPE W,XMAIL8 ; If empty, all done
MOVEI U,TCPAG+400 ; Point to cc list
JRST XMAIL0] ; Go scan it for undone addresses
MOVE A,QJFN ; Write a form feed
MOVEI B,14 ; ..
BOUT
MOVE D,(U) ; Point to address string
HRLI D,(POINT 7,)
TXZ F,F%F1 ; Assume not local host
XMAIL1: ILDB A,D ; Get next char of address
JUMPE A,[MOVE V,LSITE ; Local site - get ptr to site entry
JRST XMAIL2] ; Go write site name into queued mail
CAIE A,"@" ; Look for host name
JRST XMAIL1 ; Not found, keep going
MOVE B,D ; Point to host name
MOVEI A,HOSTAB ; Host table
TBLUK ; Find it
TXNN B,TL%EXM ; Exact match only, please
FATAL (Confusion in host name table)
HRRZ V,(A) ; Get ptr to site table entry
XMAIL2: HLRZ B,(V) ; Get ptr to name string in file
HRROI B,HSTPAG(B) ; Add base addr of file, form string ptr
MOVE A,QJFN
SETZB C,D ; Write official host name to file
SOUT
HRROI B,CRLF0 ; And a CRLF
SOUT
; ..
;Still in TOPS20
;Still in TOPS20
; ..
;Here to write a single mailbox name and mark address as done
XMAIL3: HRRZ D,(U) ; Point to mailbox name
HRLI D,(POINT 7,) ; ..
MOVE A,QJFN
XMAIL4: ILDB B,D ; Get next char of mailbox name
CAIE B,"@" ; Stop at atsign
SKIPN B ; or null
JRST [ HRROI B,CRLF0 ; Complete the line
SETZB C,D ; ..
SOUT ; ..
MOVX A,AD%DON ; Mark this address as done
IORM A,(U) ; ..
JRST XMAIL5] ; Check for more addresses for this hst
BOUT
JRST XMAIL4
XMAIL5: ADDI U,1 ; Go on to next name in list
CAMLE U,W ; Have we gone off end of this list?
JRST [ TXZN F,F%F3 ; Yes, are we in to list?
JRST XMAILQ ; No, then see if any addresses left
MOVEI U,TCPAG+400-1 ; Were doing to list -- now do cc
HLRZ W,TOPTRS ; Unless it is empty
JUMPN W,XMAIL5 ; Not empty, start scanning
JRST XMAILQ] ; Empty - see if any addresses left
MOVX A,AD%DON!AD%PFX!AD%SFX ; Already done, or funny entry?
TDNE A,(U) ; ..
JRST XMAIL5 ; Yes, don't bother checking it then
HRRZ B,(U) ; Point to actual address
HRLI B,(POINT 7,) ; ..
XMAIL6: ILDB A,B ; Get next char of address
JUMPE A,[MOVE A,LSITE ; Local address - point to local site
JRST XMAIL7] ; Go see if should write this guy now
CAIE A,"@" ; Host name yet?
JRST XMAIL6 ; No, get next char
MOVEI A,HOSTAB ; Look this hostname up in host table
TBLUK
TXNN B,TL%EXM ; Exact match only, please
FATAL (Confusion in host name table)
HRRZ A,(A) ; Get ptr to site table entry for this host
XMAIL7: CAMN A,V ; Same host as one we're currently doing?
JRST XMAIL3 ; Yes, write the mailbox name
JRST XMAIL5 ; No, go on to next address
;Still in TOPS20
;Still in TOPS20
; Here when all addresses have been handled - write text of message
XMAIL8: MOVE A,QJFN ; Final form feed
MOVEI B,14
BOUT
HRROI B,CRLF0
SETZB C,D
SOUT
ERJMP QERROR
TXO F,F%XMTO ; Delimit hostnames with rubouts
CALL BLDHDR ; Build headers
TXZ F,F%XMTO
MOVE A,QJFN ; Get JFN back again
HRROI B,HDRPAG ; Write the headers
SOUT
ERJMP QERROR
TXO F,F%JSYS ; Use SOUT, not TSOUT
CALL TXTOUT ; Move the text
TXZ F,F%JSYS ; Don't leave this flag lying around
JUMPF QERROR ; Check for errors
HRROI B,TRAILR ; Dashes
SOUT
ERJMP QERROR
TXO F,F%QXML ; Remember we have queued mail
CLOSF
ERJMP QERROR
RETSKP
>;End TOPS20
SUBTTL Local mail routines
;Here to attempt to send mail locally. Lights F%LCL if successful,
; otherwise network must be invoked (on TOPS20. On TOPS10, if mail
; can be delivered locally, it will be.)
; Returns +1: Failure, message already printed
; +2: Success, all mail delivered (on TOPS10, all LOCAL mail done)
SNDLCL: TRVAR <ERRF> ; Error flag
TOPS20<
TXNE F,F%XMLR ; XMAILR-equipped system?
JRST RSKP ; Yes, use XMAILR for all mail
CALL GETPID ; Get PID for local mailer
RET ; Failure?
MOVEM A,PIDGET+2 ; OK, save PID in IPCF block
CALL OPNCPY ; Open MAIL.CPY file
RET ; Failure
MOVEM A,CPYJFN ; Save JFN
CALL WRTCPY ; Write MAIL.CPY for MAILER
RET ; Oops
TXNE F,F%LCL ; Any local mail?
CALLRET RDYN ; Yes, go send IPCF to mailer
RETSKP ; No, don't bother local mailer
>;End TOPS20
TOPS10<
TXO F,F%LCL ; Assume all mail local
CALL CRIF ; Fresh line
SETZM ERRF ; No errors yet
MOVEI U,TCPAG ; Point to "to" list
HRRZ E,TOPTRS ; ..
JUMPE E,[WARN (No to list)
RET]
CALL SNDLC0 ; Write "to" list recipients
SETOM ERRF ; Remember that an error occurred
MOVEI U,TCPAG+400 ; Point to "cc" list
HLRZ E,TOPTRS ; ..
JUMPE E,SNDLCX ; Null cc list, clean up and return
; CALLRET SNDLC0 ; OK, send cc list and return
;Send to one list of addressees
;Call: U/ pointer to first entry in list
; E/ pointer to last entry in list
;Return +1: failure, some addressee couldn't be delivered to
; +2: success, all mail delivered OK
SNDLC0: MOVE A,(U) ; Get this address list entry
TXNE A,AD%PFX!AD%SFX ; Address, or funny entry?
JRST SNDLC1 ; Funny entry -- ignore
CALL GETUNM ; Get ptr to PPN block or code
CAMN B,[-1] ; Net address?
JRST [ WARN (Net mail not yet implemented)
TXZ F,F%LCL ; Flag that netmail exists
JRST SNDLC1] ; Just skip it
HRRZ A,(U) ; Point to address string
HRLI A,(POINT 7,)
$TEXT (KBFTOR,<Sending to ^Q/A/^A>)
PUSH P,B ; In case K%FLSH is nasty
$CALL K%FLSH ; Be chatty
POP P,B ; Restore pointer to U-block (or code)
CAMN B,[-1,,SYSCOD] ; SYSTEM?
JRST [ WARN <System mail not yet implemented for TOPS10>
JRST SNDLC1] ; *** for now, don't do this
; JRST [ DMOVE A,[1,,4 ; Yes, different PPN and structure
; SIXBIT /STD/]
; JRST SNDLC2]
DMOVE A,(B) ; No, get PPN and structure
SNDLC2: PUSH P,E ; Watch out for valuable ACs
PUSH P,U
CALL WRTPPN ; Write mail for that PPN
JRST [ POP P,U
POP P,E
SETOM ERRF ; Flag error
JRST SNDLC1] ; Continue
POP P,U
POP P,E
$TEXT (KBFTOR,< - OK>) ; Reassure the guy
SNDLC1: $CALL K%FLSH ; Keep the TTY service busy
CAIE U,(E) ; Done with list?
AOJA U,SNDLC0 ; No, try next address
SNDLCX: SKIPE ERRF ; If errors occurred,
RET ; give failure return
RETSKP ; No errors, OK return
;Still in TOPS10
SUBTTL Local mail routines - WRTPPN - deliver mail for TOPS10 systems
;Still in TOPS10
;Here with PPN in A and structure name in B to write to his MAIL.TXT
;Return +1: failure, message already printed
; +2: success
WRTPPN: STKVAR <<PPN,2>,ENQIFN,WRTIFN,SLPCNT,WFD,<WFOB,2>> ; Uh, duh...
DMOVEM A,PPN ; Save PPN and structure
SETZM SLPCNT ; Haven't slept yet
MOVEI A,FDXSIZ ; Size of an FD, max
$CALL M%GMEM ; Allocate some space
JUMPF WRTPPE ; No space? Complain
MOVEM B,WFD ; Init FD
HRLZM A,.FDLEN(B)
MOVE A,1+PPN ; Get structure name
MOVEM A,.FDSTR(B)
MOVE A,[SIXBIT /MAIL/]
MOVEM A,.FDNAM(B)
MOVE A,[SIXBIT /TXT/]
MOVEM A,.FDEXT(B)
MOVE A,PPN
MOVEM A,.FDPPN(B)
MOVE A,B ; Pass ptr to FD to ALCFOB
CALL ALCFOB ; ..
JRST WRTPPE ; No room
DMOVEM A,WFOB ; Save size and addr of FOB
SETZM WRTIFN ; Note no write IFN yet
SETZM ENQIFN ; Note no ENQ IFN either
MOVX A,FOB.MZ ; Fake smaller FOB to bypass protection checks
$CALL F%IOPN ; Open on one channel for ENQ purposes
JUMPF [ CAIN A,ERFNF$ ; File not found?
JRST WRTPP1 ; Yes, OK
JRST WRTPPE] ; No, trouble
MOVEM A,ENQIFN ; Save ENQ IFN
WRTPP0: CALL APPENQ ; Get an exclusive lock
JRST WRTPPS ; Hmm... may need to wait
WRTPP1: DMOVE A,WFOB ; Get FOB back
MOVX A,FOB.MZ ; Fake smaller FOB to bypass protection checks
$CALL F%AOPN ; Now that we know it's safe, open for append
JUMPF WRTPPE ; This should've worked
MOVEM A,WRTIFN ; Save this IFN away
MOVX B,FI.SIZ ; Get size of this message file
$CALL F%INFO ; in bytes
CAML A,[200*5*^D1000] ; Is file bigger than 1000 blocks?
JRST [ WARN <Destination message file is too big>
SKIPE ENQIFN ; If we got an ENQ lock,
CALL APPDEQ ; release it
SKIPE A,ENQIFN ; If we have a channel for that
CALL F%REL ; Release it
MOVE A,WRTIFN ; Release write IFN also
CALL F%REL ; ..
JRST WRTPF0] ; Clean up and return
TXO F,F%F1 ; Tell SAVMS0 to light "seen" bit
MOVE A,WRTIFN ; IFN to write on
CALL SAVMS0 ; Go write the mail and release write IFN
JFCL ; Error -- message already printed
SKIPE ENQIFN ; If we got a lock on the file,
CALL APPDEQ ; release it
SKIPE A,ENQIFN ; Release the ENQ channel
$CALL F%REL ; ..
DMOVE A,WFOB ; Release chunks
CALL RELFOB ; ..
MOVE A,PPN ; Type stuff on recipient's screen
CALL ANNOY ; ..
RETSKP ; Return OK
;(Still in TOPS10)
;(Still in TOPS10)
;Here if can't open or lock mail file ... sleep and try again
WRTPPS: MOVEI A,1 ; Sleep for one second
$CALL I%SLP ; ..
AOS C,SLPCNT ; Count these
CAIN C,5 ; Waited five seconds on this PPN yet?
$TEXT (KBFTOR,< - temporarily busy - ^A>)
CAIL C,^D30 ; Give up after thirty seconds
JRST WRTPPF ; Total failure
MOVE A,ENQIFN ; Set up for APPENQ
JRST WRTPP0 ; Try again
;Total failure to write mail
WRTPPF: CMERR (Couldn't write mail - message file busy)
WRTPF0: DMOVE A,WFOB ; Release chunks
SKIPE A ; if any to release
CALL RELFOB ; ..
RET ; and give bad return
;Some other, impossible, error
WRTPPE: CALL CRIF ; Insure we're at left margin
$TEXT (KBFTOR,<?Can't send message because: ^E/[-1]/>)
JRST WRTPF0
;Get exclusive ENQ lock for appending to file
APPENQ: MOVX B,FI.CHN ; First get channel number
$CALL F%INFO ; ..
APPNQ0: TXO A,EQ.FBL ; Suppress level numbers
MOVEM A,APPBLK+.ENQFL+.ENQRI+1
MOVE A,[.ENQAA,,APPBLK]
ENQ. A,
RET ; Probably another writer
RETSKP ; Win!!
;Release the append lock
APPDEQ: MOVE A,[.DEQID,,APPQID]
DEQ. A,
WARN (Can't release message file append interlock)
RET
SUBTTL Local mail routines - ANNOY - notify users for TOPS10 systems
;(Still in TOPS10)
;Routine to type annoying message on terminals
; Call with PPN in A
ANNOY: CAME A,MYPPN ; Don't bother self
CAMN A,[1,,2] ; or zillions of operator jobs
RET
STKVAR <CKPPN,CKJOB,CNPTY>
MOVEM A,CKPPN
MOVX A,%CNSJN ; Get JOBMAX
GETTAB A, ; ..
RET ; ??
HRRZM A,CKJOB ; Safer place
MOVX A,%CNPTY ; Get PTY information
GETTAB A, ; ..
RET ; Can't fail
HLRZM A,CNPTY ; Save number of first PTY
MOVE A,[POINT 7,STRBUF] ; Where to build message
MOVE B,CKPPN ; Is this system mail?
CAMN B,[1,,4]
JRST [ MOVEI B,[ASCIZ /
[New system mail available]
/]
CALL MOVST0 ; Yes, different message
JRST ANNOY0]
MOVEI B,[ASCIZ /
[You have a message from /]
CALL MOVSTR
MOVEI B,MYDIRS ; My name
CALL MOVSTR ; ..
MOVEI B,[ASCIZ /]
/]
CALL MOVST0 ; Finish it off
; JRST ANNOY0
;(Still in TOPS10)
;(Still in TOPS10)
ANNOY0: HRL A,CKJOB ; Current job to check
HRRI A,.GTLPN ; Get "real" PPN
GETTAB A, ; ..
SKIPA ; Not there, probably vanilla monitor
JRST ANNOY1 ; Win, use clever PPN
HRL A,CKJOB ; Fetch job no. again
HRRI A,.GTPPN ; Get the PPN
GETTAB A, ; ..
JRST ANNOY2 ; Probably unused job slot
ANNOY1: MOVE B,CKPPN ; PPN we're sending to
CAME A,B ; The one we want?
CAMN B,[1,,4] ; or system mail?
SKIPA ; Yes to either
JRST ANNOY2 ; No, skip it
MOVE C,CKJOB ; Where to put UDX
TRMNO. C, ; Get it
JRST ANNOY2 ; Probably detached or something...
CAMN C,TTYUDX ; Is this me?
JRST ANNOY2 ; Yes, don't bother
MOVE A,C ; Copy UDX here for a bit
TRZ A,200000 ; Convert to TTY number
CAML A,CNPTY ; Is this a PTY?
JRST ANNOY2 ; Yes, don't bother it then
MOVE A,[2,,B] ; TRMOP. arg pointer
MOVX B,.TOSLV ; See if TTY slaved
TRMOP. A,
JRST ANNOY2 ; If fails, don't annoy
TRNE A,1 ; Slave?
JRST ANNOY2 ; Yes, don't bother it then
MOVE A,[2,,B]
MOVX B,.TOSND ; Get state of TTY GAG bit
TRMOP. A, ; ..
JRST ANNOY2 ; If fails, don't annoy
TRNN A,1 ; Is GAG bit in effect?
JRST ANNOY2 ; Yes, don't annoy (sense of bit is backwards)
MOVE A,[3,,B] ; Build TRMOP. arg block
MOVX B,.TOOUS ; Output string
MOVE D,[POINT 7,STRBUF] ; Pointer to string
TRMOP. A, ; Botheration!
JFCL ; Eh?
ANNOY2: SOSLE CKJOB ; Count down through all jobs
JRST ANNOY0 ; ..
RET
>;End TOPS10
SUBTTL Local mail routines - TOPS20 IPCF mailerr routines
TOPS20<
;Open MAIL.CPY - Returns JFN in A, clobbers STRBUF
; Skip return iff successful
OPNCPY: 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;P770000"]
CALL MOVST0 ; Terminate with null
MOVX A,GJ%SHT!GJ%FOU ; Create file
HRROI B,STRBUF
GTJFN
ERJMP [JRETER (MAIL.CPY failure.)
RET]
MOVX B,44B5+OF%WR
MOVE D,A ; In case OPENF clobbers JFN
OPENF ; Open file
ERJMP [JRETER (Can't open MAIL.CPY)
MOVE A,D ; Release it
RLJFN
JFCL
RET] ; Failure return
RETSKP
;Here if any problems opening or writing MAIL.CPY
CPYERR: MOVE A,CPYJFN
CLOSF
JFCL
CPYER1: JRETER (MAIL.CPY failure.)
MOVE A,CPYJFN
RLJFN
JFCL
SETZM CPYJFN
RET
;Still in TOPS20
;Still in TOPS20
;Routine to write MAIL.CPY
; Format is:
;
; EXP <flags> (no flags currently defined, so MBZ)
; EXP usernumber in To list
; EXP usernumber in To list
; ...
; EXP 0
; EXP usernumber in CC list
; ...
; EXP 0
; ASCIZ /text of message/ ; padded to word boundary
WRTCPY: STKVAR <SPTR> ; String pointer
SETZM USRBLK ; Start with 0
MOVEI W,1 ; Init pointer
TXZ F,F%LCL ; Assume no local addresses
CALL LMOVTO ; Setup To list
JRST WRTCP4 ; Saw net address
CALL LMOVCC ; Setup Cc list
JRST WRTCP4 ; Saw net address
TXNN F,F%LCL ; Any local addresses found?
JRST WRTCP4 ; No, don't bother local mailer then
MOVE A,CPYJFN ; Write usernumber list to MAIL.CPY
MOVE B,[POINT 36,USRBLK]
MOVN C,W ; Word count, including trailing null word
SOUT
ERJMP CPYERR
MOVX B,7 ; Now switch to ASCII I/O
SFBSZ ; This is SUPPOSED to fix up the file pointer
ERJMP CPYERR
TXNE F,F%NIPC ; Smart new IPCF mailer?
JRST [ CALL BLDHDR ; Yes, build fancy headers then
JRST WRTCP1] ; ..
MOVE A,[POINT 7,HDRPAG] ; Where to build headers
MOVEM A,OBPTR ; Output byte pointer
TXZ F,F%F1 ; No crlf
CALL MOVOPT ; Move header options
SKIPN PERSON ; Have personal name?
JRST WRTCP0 ; No, skip this
MOVEI B,[ASCIZ /From-the-terminal-of: /]
CALL MOVSB2 ; Have to say something...
MOVEI B,PERSON ; User's name
CALL MOVSB2 ; Move it out
MOVEI B,CRLF0 ; End the line
CALL MOVSB2
WRTCP0: CALL MOVSUB ; Insert subject
CALL MOVMID ; and message-ID
MOVEI B,REPLIN ; In case reply lines present
SKIPE REPLIN ; Any reply lines?
CALL MOVSB2 ; Yes, do 'em up
MOVEI B,CRLF0
CALL MOVSB2 ; A few blank lines
SETZ A, ; Insure ASCIZ
IDPB A,OBPTR ; ..
WRTCP1: MOVE A,CPYJFN ; Write headers to MAIL.CPY
MOVE B,[POINT 7,HDRPAG]
SETZB C,D
SOUT
ERJMP CPYERR
TXO F,F%JSYS ; Use jaysigh
CALL TXTOUT ; Write message text
TXZ F,F%JSYS
JUMPF CPYERR
MOVE A,CPYJFN
WRTCP2: RFPTR ; Pad with nulls to word boundary
ERJMP CPYERR
IDIVI B,5
JUMPE C,WRTCP3
SETZ B,
BOUT
ERJMP CPYERR
JRST WRTCP2
WRTCP3: TXO A,CO%NRJ ; Retain JFN
CLOSF
JFCL
RETSKP
;Here either if new mailer and there were no local addresses,
; (F%LCL never lit by LMOVTO or LMOVCC) or old mailer and
; some net addresses found (LMOVTO or LMOVCC failure returned)
WRTCP4: MOVE A,CPYJFN ; No - release JFN and return
TXO A,CZ%ABT ; Abort file
CLOSF
JFCL
SETZM CPYJFN
TXZ F,F%LCL
RETSKP
;Still in TOPS20
;Still in TOPS20
;setup user name lists for local mail
LMOVTO: HRRZ E,TOPTRS ; Setup to list
MOVEI U,TCPAG
LMOV1: JUMPE E,LMOVTR ; Empty list
LMOV2: MOVE A,(U) ; Get this entry
TXNE A,AD%PFX!AD%SFX ; Address, or funny entry?
JRST LMOV4 ; Funny - ignore
CALL GETUNM ; Get user number in b
CAMN B,[-1] ; Net address?
JRST [ TXNN F,F%NIPC ; Smart mailer?
RET ; No, quit now
JRST LMOV4] ; Yes, continue
CAME B,[-1,,SYSCOD] ; SYSTEM?
HRLI B,(5B2) ; No, form user number
MOVEM B,USRBLK(W) ; Store it
AOS W ; Step to next entry
TXO F,F%LCL ; Flag that ther is some local mail
LMOV4: 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
>;End TOPS20
; Get user number from table , string pntr c(u)
GETUNM: MOVEI A,NAMTAB ; Table header
HRRZ B,(U) ; String pointer
$CALL S%TBLK ; Lookup entry
HRRE B,(A) ; Get code or user number
RET
SUBTTL MAIFLG - set flags for network mailers
TOPS20<
; Set the MAILER flags
MAIFLG: TXNE F,F%XMLR ; XMAILR being used?
JRST [ MOVE A,XMFJFN ; Yes, have JFN already then
CALL MAIFL0 ; MAIFL0 will check F%XMLR also
RET
JRST MAIFL2]
HRROI A,[ASCIZ /SYSTEM:MAILER.FLAGS.1/]
TXNN F,F%QARP ; Any ARPANET mail going out?
JRST MAIFL1 ; No, skip this
CALL MAIFL0 ; Yes, light mailer flag
RET ; Pass failure on up
MAIFL1: HRROI A,[ASCIZ /SYSTEM:DECNET-MAILER.FLAGS.1/]
TXNN F,F%QDEC ; Any DECNET mail?
JRST MAIFL2 ; No, type reassurance and quit
CALL MAIFL0 ; Yes, notify mailer
RET ; Pass failure return on up
MAIFL2: CITYPE <Netmail queued for transmission.>
RETSKP ; OK
;Still in TOPS20
;Still in TOPS20
;Light bit in flags file for mailer
MAIFL0: ACVAR <FJFN> ; Flags file JFN
TXNE F,F%XMLR ; XMAILR support?
JRST MAIFL3 ; Yes, already have JFN in A then
MOVE B,A ; Pointer to name of file
MOVSI A,(GJ%OLD!GJ%SHT!GJ%PHY)
GTJFN
ERJMP [JRETER (Cannot find mailer flags)
RET]
MAIFL3: MOVE FJFN,A
MOVEI B,OF%THW!OF%WR!OF%RD
OPENF
JRST [ JRETER (Cannot open mailer flags)
MOVE A,FJFN ; Get JFN back
RLJFN
JFCL
RET]
HRLZ A,A ; 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
MOVE A,FJFN ; Get JFN back
TXNE F,F%XMLR ; If XMAILR support,
TXO A,CO%NRJ ; Keep the JFN
CLOSF
JFCL
RETSKP
;Still in TOPS20
SUBTTL RDYN - Send IPCF to MAILER (TOPS20 local mail)
;Still in TOPS20
;GETPID - Get PID for local mailer
;No arguments
;Return +1: failure, no mailer available
; +2: success, A/ PID, F%NIPC lit if new mailer (MAILEX)
GETPID: TXZ F,F%F1!F%NIPC ; Local flag, assume old mailer
MOVE A,[[ASCIZ /[SYSTEM]MAILEX/],,PIDNAM]
BLT A,PIDNAM+2 ; Try new mailer first
SETZB U,PIDGET ; Retry flag
SKIPE PIDGET+1 ; Have PID?
JRST GETPD1 ; Yes - use it
GETPD0: MOVSI A,(IP%CPD) ; Create PID
MOVEM A,PIDGET ; Request this function
SETZM PIDGET+1 ; No sender's PID
GETPD1: 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 GETPD0] ; Go try it again
MOVSI B,(IP%CPD) ; Create PID bit
ANDCAM B,PIDGET ; Now have a PID
GETPD2: 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 GETPD2 ; No get it again
TRNE U,7 ; Was the packet undeliverable?
JRST GETPD1 ; Yes. So send it again
ANDI U,77B29 ; Isolate the error field
JUMPE U,GETPD3
CAIN U,<.IPCSN>B29 ; Did INFO crash and restart?
JRST GETPD2 ; Yes. Wait for some other news then
TXOE F,F%F1 ; Failure, have we tried old mailer yet?
JRST [ CMERR <Could not send to local mailer>
RET]
MOVE A,[[ASCIZ /[SYSTEM]MAILER/],,PIDNAM]
BLT A,PIDNAM+2 ; OK, try for old-style mailer then
JRST GETPD1
GETPD3: MOVE A,WRTPGS+1 ; Get mailer's PID
TXNN F,F%F1 ; Did we have to go for old mailer?
TXO F,F%NIPC ; No, flag new mailer
RETSKP ; and return to caller
;RDYN - send IPCF message to MAILER
;Call: CALL RDYN
;Returns +1: failure
; +2: success
RDYN: 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
DMOVE U,PIDGET+1 ; My PID, MAILER's PID
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
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
CMERR <MAILER is not running. Messages not sent.>
RET
;Here when reply from MAILER received, check it out
OK: CAME U,PIDGET+2 ; From mailer?
JRST AGAIN ; No. Ignore it
TRNE T,77B29 ; ANY errors?
JRST ERRORZ ; Yes. Go analyze them
CITYPE <Local mail delivered OK.>
RETSKP
ERRORZ: 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
HRRZ A,B ; Get just right half
CAIN A,SYSCOD ; Is this system?
JRST [ HRROI A,[ASCIZ /SYSTEM/]
$CALL KBFTOR
JRST SOME2]
MOVEI A,.PRIOU
DIRST ; Print his id
JFCL
SOME2: $TEXT (KBFTOR,< not sent ^A>)
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
$TEXT (KBFTOR,<because: ^A>)
CALL CRLF
PUSH P,B
$CALL K%FLSH
POP P,B
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
$TEXT (KBFTOR,<because: ^A>)
HRRO A,MSGTBL-MINMSG(B) ; Yes. get the string
$CALL KBFTOR ; 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
;Still in TOPS20
SUBTTL Run network mailer to deliver mail
;Still in TOPS20
; Run mailer to send off what we queued
.MAILR: NOISE (queued messages)
CONFRM
TXNN F,F%ARPA!F%DECN ; Net?
CERR (No network)
TXNE F,F%XMLR ; XMAILR support?
JRST [ HRROI B,[ASCIZ /SYS:XMAILR.EXE/]
CALLRET .MAIL1] ; Yes, excludes all else
TXNE F,F%ARPA ; Any non-XMAILR ARPANET mail going out?
JRST [ HRROI B,[ASCIZ /SYS:NMAILR.EXE/]
CALL .MAIL1 ; Yes, send it
JRST .+1]
TXNN F,F%DECN ; DECNET exists?
RET ; No, quit now
TXNE F,F%ARPA ; Did we run the ARPANET mailer?
CALL CRLF ; Yes, it doesn't clean up after itself
HRROI B,[ASCIZ /SYS:DMAILR.EXE/]
.MAIL1: TXO F,F%F3 ; Make sure it doesnt run enabled
CALL RUNFL0
RET
KFORK ; Dont need it any more
MOVE A,[SIXBIT /MS/] ; Restore our name
MOVE B,[SIXBIT /MS/]
SETSN ; ..
JFCL
RET
SUBTTL Run some file -- used by PUSH and NET-MAIL commands
RUNFIL: TXZ F,F%F3 ; Default run enabled
RUNFL0: MOVSI A,(GJ%OLD!GJ%SHT)
GTJFN
ERJMP [JRETER <Couldn't find file to run>
RET]
PUSH P,A ; Save the jfn
MOVSI A,(CR%CAP) ; Yes, give it our caps
CFORK
ERJMP [JRETER <Couldn't create fork>
RET]
RPCAP
SETZ C,
TXZE F,F%F3 ; Run enabled?
EPCAP ; No, disable
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
RETSKP
.PUSH: NOISE (command level)
CONFRM
CALL BLANK0 ; Fresh start here
SKIPLE A,EXECFK ; Already have a fork?
JRST [ CALL RUNFL2 ; Yes, just restart it
SETZM EXECFK ; Hmmm...
RET]
HRROI B,[ASCIZ /SYSTEM:EXEC.EXE/]
CALL RUNFIL ; Else make a fork and run it
RET ; Failure...
MOVEM A,EXECFK ; And keep the fork handle
RET
>;End TOPS20
LLIT
SUBTTL Message draft editing and display routines
ERSAL1: SETZM SUBJEC ; Reset subject
MOVE A,TOPTR0 ; Reset to and cc pointers
MOVEM A,TOPTRS ; ..
SETZM REPLIN ; No reply lines
SETZM SVABLK ; No saved A-block
MOVE A,FRENM0
MOVEM A,FRENAM ; Reset free string pointers
MOVE A,[NAMTB0,,NAMTAB] ; Reset name table
HLRZ B,NAMTB0 ; ..
BLT A,NAMTAB(B) ; ..
HLLZ E,HDITAB ; Point to user-defined header-items
JUMPE E,ERSAL2 ; None exist
MOVN E,E ; Form AOBJN pointer
HRRI E,HDITAB+1 ; ..
MOVX B,HD%PRS ; "Present" flag
MOVX C,HD%PDF ; "Predefined" flag
ERSAL3: HRRZ A,(E) ; Get addr of H-block for this one
TDNN C,HD.FLG(A) ; Predefined?
ANDCAM B,HD.FLG(A) ; No, clear "present" flag
TDNE C,HD.FLG(A) ; Predefined?
IORM B,HD.FLG(A) ; Yes, set "present" flag
AOBJN E,ERSAL3 ; Do for all
ERSAL2: RET
.ERSAL: CONFRM
.ERSL0: CALL ERSAL1
JRST .ERST0
.ERSTX: CONFRM
.ERST0: SKIPN A,TXTFPG ; Any text pages allocated at all?
JRST .ERST2 ; No, this is easy then...
.ERST1: MOVE C,TB.FOR(A) ; Get forward link, if any
$CALL M%RPAG ; Release this page
SKIPE A,C ; Was there any forward link?
JRST .ERST1 ; Yes, keep going
.ERST2: $CALL M%GPAG ; Allocate first page for text
MOVEM A,TXTFPG ; Rememberr its address
ADD A,[POINT 7,TB.TXT] ; Point to text area
MOVEM A,TXTPTR ; Reset pointer to text space
MOVEM A,TTXTIB+.RDBFP ; This is also backup limit
MOVEI A,TXTSIZ ; Init buffer size
MOVEM A,TXTCNT
SETZM TXTTOT ; No bytes in text yet
RET
.ERSDT: CONFRM
SETZM REPLIN
RET
.ERSSB: CONFRM
.ERSB0: SETZM SUBJEC
RET
.ERSCC: CONFRM
HLRZ T,TOPTRS ; get end of cc list
JUMPE T,R ; if list empty, quit now
MOVEI V,TCPAG+400 ; and start
.ERSC2: MOVX A,AD%SFX ; Don't delete nonexistent strings
TDNN A,(T) ; ..
CALL NAMDEL ; delete this name string
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,FRENM0
MOVEM A,FRENAM ; Reset free pointer
MOVE A,[NAMTB0,,NAMTAB] ; Reset name table
HLRZ B,NAMTB0
BLT A,NAMTAB(B)
RET
; Erase to field
.ERSTO: CONFRM
HRRZ T,TOPTRS ; end of to list
JUMPE T,R ; if list empty, quit now
MOVEI V,TCPAG ; and start
.ERST9: MOVE A,(T) ; Get this entry
TXNN A,AD%SFX ; Funny entry?
CALL NAMDEL ; No, delete this name
CAME T,V ; done?
SOJA T,.ERST9 ; no, keep going
HLLZS A,TOPTRS ; yes, reset to pointer
JRST .ERSC3 ; clean up and return
.DSALL: MOVE A,[$CALL KBFTOR] ; 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 MOVOP1 ; Type header options
CALL MOVSB1 ; Type subject
TXZ F,F%LCL
SKIPN REPLIN ; Have reply lines?
JRST .DSTXT ; No, skip this
MOVEI B,REPLIN ; Yes, type them
CALL MOVSB2
.DSTXT: CALL CRLF
MOVX A,.PRIOU ; Where to put text
CALL TXTOUT ; Type it and return
CALLRET CRIF ; CRLF if needed
.DSSUB: TXO F,F%F1 ; Want crlf before
MOVEI B,MOVSB0
JRST .DSCC1
.DSTO: SKIPA B,[MOVTO0]
.DSCC: MOVEI B,MOVCC0
TXO F,F%LCL ; Treat local names w/o net addrs
.DSCC1: MOVE A,[$CALL KBFTOR]
JRST (B)
;Erase header-item
.ERSHD: NOISE (name)
MOVEI A,[FLDDB. (.CMKEY,,HDITAB)]
CALL CFIELD
HRRZ A,(B) ; Point to H-block
MOVX B,HD%PRS ; Bit to clear
ANDCAM B,HD.FLG(A) ; Clear "present" bit
RET
MOVSUB: MOVE A,[IDPB A,OBPTR]
MOVSB0: MOVEM A,MOVDSP ; Set up to move into memory
MOVSB1: LDB A,[POINT 7,SUBJEC,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,SUBJEC ; 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
MOVCC: MOVE A,[IDPB A,OBPTR]
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
;Construct and insert message-ID
MOVMID: MOVE A,[IDPB A,OBPTR]
MOVEM A,MOVDSP
$TEXT (MVODSP,<Message-ID: ^A>)
MOVEI A,"<" ; Stupid MACRO can't handle wedgies in args
XCT MVODSP
MOVE T,[POINT 7,MYHNAM,27]
$TEXT (MVODSP,<"MS^V/VERSN./+GLXLIB^V/.SPLIB##/" ^D/MSGID0/.^D/MSGID1/.^D/MSGID2/.^D/MSGID3/ at ^Q/T/^A>)
MOVEI B,[BYTE (7) ">", 15, 12, 0]
CALLRET MOVSB2
MOVTO: MOVE A,[IDPB A,OBPTR]
MOVTO0: MOVEM A,MOVDSP
MOVEI T,[ASCIZ /
To: /]
HRRZ C,TOPTRS
MOVEI E,TCPAG
MOVTO2: JUMPE C,R ; None here, forget it
TXZ F,F%AT ; Init flag
PUSH P,X ; Save this
SKIPA B,T ; header supplied
MOVTO3: MOVEI B,[ASCIZ /
/] ; List continuation
SETZ X, ; Init horizontal position
CALL MOVTOU ; Print header
MOVTO4: MOVE B,(E) ; Get entry
TXNE B,AD%PFX ; Prefix of list?
JRST [ HRLI B,(POINT 7,) ; Yes, point to string
CALL MOVTOU ; Move it
MOVEI A,":" ; Prefix separator
XCT MOVDSP ; Move it also
AOS LDEPTH ; Count levels of list nesting
JRST MOVTO6] ; OK, finish this and go to next
TXNE B,AD%SFX ; Is this a suffix entry?
JRST MOVTO7 ; Yes, decrement depth counter, etc.
HRLI B,(<POINT 7, 0>) ; No, must be address element, form byte ptr
CALL MOVADR ; Move address fancily
CAIN E,(C) ; At the end yet?
JRST [ POP P,X ; Yes, restore possible TRVAR ptr
RET] ; Return
MOVE B,1(E) ; See if next entry is a suffix entry
TXNE B,AD%SFX ; ..
JRST MOVTO7 ; End of list, this can be tricky
MOVTO5: MOVEI A,"," ; More addresses to come - move comma
XCT MOVDSP
TXNN F,F%XMTO ; XMAILR wants one address per line
MOVTO6: CAIL X,ADRWTH ; near end?
AOJA E,MOVTO3 ; Yes, get new line for more then
MOVEI A," "
XCT MOVDSP
ADDI X,2
AOJA E,MOVTO4
;Here to close a named address list
MOVTO7: MOVEI A,";" ; First close it with semicolon
XCT MOVDSP ; ..
SOSGE A,LDEPTH ; Keep track of nesting level
JRST [ WARN (Bad named address list nesting found at MOVTO7)
SETZM LDEPTH
JRST .+1]
ADDI E,1 ; Move past suffix entry
CAIE E,1(C) ; Done with list? (I know this looks funny
CAIN E,(C) ; but there is a reason for it)
JRST [ POP P,X ; Yes, quit
RET]
ADDI X,1 ; Account for semicolon
MOVE B,1(E) ; See if another suffix (list closure)
TXNE B,AD%SFX ; ..
JRST MOVTO7 ; Yes, another semicolon then
JRST MOVTO5 ; No, type comma and do next address
;MOVADR - Move address fancily, handling XMAILR-style address
; lists and host translation
;Call:
; B/ Byte pointer to address string
; X/ Horizontal position (updated)
; MOVDSP/ Instruction to execute with character in A
MOVADR: ILDB A,B ; Get next char of address
JUMPE A,MOVAD6 ; Done - maybe supply hostname, and return
CAIN A,42 ; Quoted string?
JRST MOVADQ ; Yes, go handle
CAIN A,"@" ; Start of hostname?
JRST MOVAD7 ; Yes, say " at " instead of "@"
XCT MOVDSP ; No, just move character
AOJA X,MOVADR ; Count columns
MOVADQ: XCT MOVDSP ; Move opening quote
AOS X ; Count columns
MOVAQ0: ILDB A,B ; Move contents literally
XCT MOVDSP ; ..
LDB A,B ; In case clobbered by MOVDSP
CAIE A,42 ; Close quote?
AOJA X,MOVAQ0 ; No, count columns and continue
JRST MOVADR ; Yes, finish remainder of text
MOVAD6: TXZN F,F%AT ; Host name seen?
JRST MOVAD8 ; No, go see if we should supply one
MOVEI A,177 ; Yes, XMAILR wants hostnames quoted by rubouts
TXNE F,F%XMTO ; Writing XMAILR queue entry?
XCT MOVDSP ; Yes, close the quote
MOVADX: RET ; All done
MOVAD8: TXNN F,F%ARPA!F%DECN!F%ANFX ; Networks?
JRST MOVADX ; No - done with name
MOVE B,[POINT 7,MYHNAM,27] ; Yes -- add local host name
TXNE F,F%DNNM ; Use DECNET names?
MOVE B,[POINT 7,MYHDEC,27] ; Yes -- use it instead
MOVAD7: PUSH P,B
MOVEI B,[ASCIZ / at /]
CALL MOVTOU
POP P,B
MOVEI A,177 ; XMAILR wants hostnames quoted by rubouts
TXNE F,F%XMTO ; XMAILR support?
XCT MOVDSP ; Yes, open quotes
TXO F,F%F1 ; Don't always translate
CALL TRANSH ; Translate host name, maybe
TXZ F,F%F1
TXO F,F%AT ; Remember that we've done this
MOVAD1: ILDB A,B ; Translated -- move translated name
JUMPE A,MOVAD6
XCT MOVDSP
AOJA X,MOVAD1 ; Do for all chars in string
;Utility routine to move string out via MOVDSP -- updates horizontal
; position in X. Call with string address in B.
MOVTOU: HRLI B,(POINT 7,)
MOVTU0: ILDB A,B
JUMPE A,R
XCT MOVDSP
AOJA X,MOVTU0
;Translate host name if necessary
;Call: B/ Pointer to host name
; F%F1 = Don't translate hostnames with NT%NXL bit (no translate)
; CALL TRANSH
;Returns +1: B points to translated name -- preserves all other ACs
;Preserves all ACs, stomps on STRBUF
TRANSH: TXNE F,F%DECN!F%ARPA ; Have a net?
TXNE F,F%XMLR ; XMAILR support?
RET ; No nets, or XMAILR -- don't translate
PUSH P,C ; Preserve these
PUSH P,B
SKIPN HOSTAB ; Have a host table?
CALL HSTINI ; No, get one
MOVE B,(P) ; Restore hostname ptr
TRANS1: MOVEI A,HOSTAB ; Look up host name
$CALL S%TBLK
TXNN B,TL%EXM ; Anything?
JRST [ MOVE A,(P) ; Point to name being translated
FATAL (Can't translate host name %1S)]
HRRZ B,(A) ; Get bits
TXNN B,NT%SYN ; Synonym?
JRST TRANSX ; No, just quit
TXNE F,F%F1 ; Suppress translations maybe?
TXNN B,NT%NXL ; Suppress this one?
SKIPA
JRST TRANSX ; Yes, just quit
LDB A,[POINT 11,B,28] ; Get index to real name
JUMPE A,[FATAL (Host name table messed up)]
MOVE B,NETSYN-1(A) ; Get pointer to name block
MOVE A,(B) ; Get possible flags word
TLNN A,(177B6) ; Is this a flags word?
TXNN A,CM%FW ; ..
SKIPA
ADDI B,1 ; Yes, skip the flags and point to string
HRLI B,(POINT 7,) ; Form kosher byte pointer
JRST TRANS1 ; Unwind next name
TRANSX: HLRZ B,(A) ; No, get pointer to translation
MOVE A,(B) ; Get possible flags word
TLNN A,(177B6) ; Flags present?
TXNN A,CM%FW ; ..
SKIPA
ADDI B,1 ; Yes, skip to text part
HRLI B,(POINT 7,)
MOVE A,[POINT 7,STRBUF]
CALL MOVST0 ; Move to temp area
MOVE B,[POINT 7,STRBUF] ; Point to translation
MOVEM B,(P) ; Return this instead of original B
POP P,B
POP P,C
RET
;Move header options - "Reply-to" and user-defined header-items
MOVOPT: MOVE A,[IDPB A,OBPTR]
MOVEM A,MOVDSP
MOVOP1: SKIPN REPADD ; Any "Reply-to" addresses?
JRST MOVHDI ; No, do user-defined header-items
MOVEI B,CRLF0 ; CRLF
TXZE F,F%F1 ; If needed
CALL MOVSB2
MOVEI B,[ASCIZ /Reply-to: /]
CALL MOVSB2
MOVEI X,^D10 ; Init horizontal position
MOVE A,REPADD ; First A-block
CALL MVALST ; Move this address list
MOVOP3: MOVEI B,CRLF0 ; Move the CRLF
CALL MOVSB2 ; ..
; JRST MOVHDI
;Move user-defined header-items out
MOVHDI: MOVEI B,CRLF0 ; CRLF needed first?
TXZE F,F%F1 ; We're told this by caller lighting F%F1
CALL MOVSB2 ; Yes, move it out
HLLZ E,HDITAB ; Any user-defined header-items?
JUMPE E,R ; No, return now
MOVN E,E ; Yes, form AOBJN pointer
HRRI E,HDITAB+1 ; ..
MOVHD0: SETZ X, ; Init horizontal position
HRRZ A,(E) ; Get ptr to H-block for this one
MOVE B,HD.FLG(A) ; Get flags
TXNN B,HD%PRS ; Present?
JRST MOVHD1 ; No, skip it then
HLRZ B,(E) ; Yes, get name
HRLI B,(POINT 7,) ; Form ptr
SETZ C, ; Assume no quoting needed
CALL SPCCHK ; Qutoing required?
MOVEI C,42 ; Yes, get the quote char
SKIPE A,C ; If quoting required,
XCT MOVDSP ; move the quote char
CALL MOVTOU ; Move it out
SKIPE A,C ; If quoting,
XCT MOVDSP ; move closing quote
MOVEI B,[ASCIZ /: /] ; Colon space
CALL MOVTOU
HRRZ A,(E) ; Point to H-block again
MOVE B,HD.FLG(A) ; Get type code
ANDI B,HD%TYP ; *** should use load
; LOAD B,HDTYP(A)
CALL @MOVHDO(B) ; Call appropriate routine to move data
MOVEI B,CRLF0 ; CRLF
CALL MOVSB2 ; ..
MOVHD1: AOBJN E,MOVHD0 ; Go on to next one
RET
;Table of routines indexed by type to move data of header-item out
DEFINE X(COD,STRNG,SIZ),<
EXP MVO'COD
>
MOVHDO: HDTYPS ; Generate the dispatch table
;Move address
MVOADR: MOVE A,HD.DAT(A) ; Address of address list
CALLRET MVALST ; Move fancily
;Move text string
MVOTXT: MOVEI B,HD.DAT(A) ; Address of text for this field
CALLRET MOVSB2 ; Move 'em on out
;Move date
MVODAT: MOVE A,HD.DAT(A) ; Get universal date/time
$TEXT (MVODSP,<^H9/A/^A>) ; Type only first 9 columns
RET
;Move date/time
MVODTI: MOVE A,HD.DAT(A) ; Get universal format date/time
$TEXT (MVODSP,<^H/A/^A>) ; Use GLXLIB routine
RET
;Move time
MVOTIM: MOVE A,HD.DAT(A) ; Get universal date/time
$TEXT (MVODSP,<^C5/A/^A>) ; Only do minutes and seconds
RET
;Called by $TEXT macro above with char in A
MVODSP: XCT MOVDSP
$RET
;Move keyword
MVOKWD: MOVE B,HD.DAT(A) ; Get keyword index
HLRZ B,(B) ; Get string address
CALLRET MOVSB2 ; Move it
LLIT
; 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: MOVE T,TAKPTR ; Get current input stream IFn
MOVE A,(T) ; ..
TXNE F,F%CONC ; Concise mode?
JRST [ CITYPE <Message:> ; Yes, be so then
JRST GETTX0]
TOPS20<
CITYPE (<Message (ESC to enter Send Level, ctrl-Z to send, ctrl-K to redisplay,
ctrl-B to insert file, ctrl-E to enter editor):>)
>;End TOPS20
TOPS10<
CITYPE (<Message (ESC to enter Send Level, ctrl-Z to send, ctrl-K to redisplay,
ctrl-B to insert file):>)
>;End TOPS10
; JRST GETTX0 ; continued next page
;Here after prompting the user to collect the message text.
GETTX0: CALL CRLF ; Blank line
CALL CRLF
.TEXT1: $CALL K%FLSH ; Make sure this goes to the terminal now
MOVE A,TXTPTR ; Get curren text pointer
ANDI A,777000 ; Strip all but address of page
MOVE B,TXTFPG ; Get address of first text page
CAME A,B ; Putting text in first page?
SKIPA A,[RD%JFN!RD%RND] ; No, return instead of bell if too many rubouts
MOVX A,RD%JFN ; Yes, just ding if too much editing
MOVEM A,TTXTIB+.RDFLG ; Save flag bits in TEXTI arg block
PUSH P,TXTCNT ; Save original text count
MOVEI A,TTXTIB
$CALL K%TXTI ; Call TEXTI
JUMPF [ MOVE T,TAKPTR ; EOF - get IFN stack ptr
POP T,A ; Get IFN of cmd input
CAIN A,.PRIIN ; Better be a file
JCERR (TEXTI failure) ; Isn't - strange
$CALL F%REL ; OK, release the IFN
POP T,B ; Get FOB info
POP T,A ; ..
CALL RELFOB ; Release FOB storage
MOVE A,(T) ; Point to next IFN
CALL SETIOJ ; Read commands from it
MOVEM T,TAKPTR ; Save updated pointer
MOVX A,RD%BTM ; Light break char bit
IORM A,TTXTIB+.RDFLG ; ..
MOVEI A,"K"-100 ; Force redisplay of text
CALL TXTCHR ; ..
SOS TXTTOT ; ADDM at .+3 will account for this
JRST .+1] ; Rejoin normal flow
POP P,A ; Get original text count for this page
SUB A,TXTCNT ; See if it changed
ADDM A,TXTTOT ; Update total text count (for all pages)
MOVE A,TTXTIB+.RDFLG ; Get flag bits
TXNE A,RD%BTM ; Did break char cause return?
JRST .TEXT2 ; Yes, this is easy
TXNE A,RD%BFE ; Deleting to previous buffer?
JRST .TEXT3 ; Yes, must deallocate page, back up, etc.
; ..
; ..
;None of the above - must be count exhausted - chain on a new page
SKIPE TXTCNT ; Bug filter
FATAL (Unknown return from K%%TXTI at GETTXT)
CALL TXTAQP ; Get and chain next page
JRST .TEXT1 ; Go eat more text
;Backup limit reached - must back up to previous page
.TEXT3: MOVE A,TXTPTR ; Get current text pointer
ANDI A,777000 ; Form addr of beginning of page
SKIPN C,TB.BAK(A) ; Get backward link (previous page)
FATAL (GETTXT - backup limit reached and no previous page)
$CALL M%RPAG ; Release this page
MOVE A,[POINT 7,777,27] ; Delete the last byte on the page
ADD A,C ; Point to this page
MOVEM A,TXTPTR ; Save
MOVE A,[POINT 7,TB.TXT] ; New backup limit
ADD A,C ; ..
MOVEM A,TTXTIB+.RDBFP ; Stuff into arg block
MOVEI A,1 ; One byte left on this page
MOVEM A,TXTCNT
MOVE A,TXTTOT ; Get total byte count
SUBI A,1 ; Account for byte just crudely deleted
MOVEM A,TXTTOT ; ..
JRST .TEXT1 ; Go talk to user some more
;Here on break character
.TEXT2: 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 ; Don't include break char in byte counts
SOS TXTTOT ; ..
CAIN B,"E"-100 ; ^E - enter editor on text
TOPS20< ; Until TOPS10 has forks...
JRST .EDTXT
>;End TOPS20
TOPS10<
WARN (Until TOPS10 has forks -- running an editor is impossible)
>;End TOPS10
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: >)
TOPS20<
HRROI A,[ASCIZ /txt/] ; Default extension
MOVEM A,CJFNBK+.GJEXT ; ..
>;End TOPS20
TOPS10<
SETZM CJFNBK ; Zap previous defaults
MOVE A,[CJFNBK,,CJFNBK+1]
BLT A,CJFNBK+CJFNLN-1
MOVSI A,(SIXBIT /TXT/)
MOVEM A,CJFNBK+.FDEXT ; Default extension
>;End TOPS10
CALL FSPEC ; Get file spec
JRST [ WARN <No file specified...)>
JRST .TEXT1] ; Just CR - ignore this request
CALL RDTXT ; Read in text
JRST CBAGN ; Error - try again
$TEXT (KBFTOR,<...EOF)>)
JRST .TEXT1 ; Continue getting text
;Get a filespec, confirm, fill in FD, allocate FOB and link to FD
;FSPEC - Input file only, no args required
;FSPEC0 - Caller supplies FLDDB. address in A
;Returns +1: CR typed with no filespec or no memory available
; +2: Filespec parsed OK
; A/ FOB size
; B/ FOB address (set up for call to F%xOPN)
;
;JRSTs to CMDERR if bad filespec typed
FSPEC:
TOPS20<
MOVX A,GJ%OLD ; Input file, must exist
MOVEM A,CJFNBK+.GJGEN ; ..
>;End TOPS20
MOVEI A,[FLDDB. (.CMCFM,CM%SDH,,<Input filespec>,,[FLDDB. (.CMFIL,CM%SDH)])]
FSPEC0:
TOPS20<
SKIPN CRFDEV ; Defaulting to connected directory?
JRST [ SETZM CJFNBK+.GJDEV ; Yes, zero GTJFN fields
SETZM CJFNBK+.GJDIR ; ..
JRST FSPEC1] ; ..
HRROI B,CRFDEV ; No, point to appropriate fields
MOVEM B,CJFNBK+.GJDEV
HRROI B,CRFDIR ; Directory name
MOVEM B,CJFNBK+.GJDIR
>;End TOPS20
FSPEC1: CALL RFIELD ; Get filespec or CR
MOVE A,CR.COD(A) ; See which
CAIN A,.CMCFM ; Just CR?
RET ; Yes - return
PUSH P,B ; Save JFN or FD address
CONFRM ; Confirm
TOPS10< ; On TOPS10, GLXLIB has already built FD
MOVEI A,FDXSIZ ; Must move to private copy, though...
$CALL M%GMEM ; Get a chunk
JUMPF [ WARN (Can't acquire space for FD)
POP P,A ; Flush stack
RET]
POP P,A ; Restore address of GLXLIB's FD
HRLZ A,A ; Built BLT pointer
HRR A,B ; Move to new FD
MOVE C,B ; Copy address of new FD
ADDI C,FDXSIZ-1 ; Last word in new FD
BLT A,(C) ; Make the copy
MOVE A,B ; Address of new FD
JRST FSPECX ; Allocate FOB, link, and return
>
TOPS20<
MOVEI A,FDXSIZ ; On TOPS20, we must build FD
$CALL M%GMEM ; Allocate chunk for FD
JUMPF [ WARN (Can't acquire space for FD)
POP P,A
RLJFN
JFCL
RET] ; Failure return
HRROI A,.FDSTG(B) ; Where in chunk to put string
EXCH B,(P) ; Save chunk addr, get JFN
MOVX C,<1B2+1B5+1B8+1B11+1B14+1B17+JS%PAF> ; Full filespec
JFNS ; Do it up
MOVE A,B ; Release this now useless JFN
RLJFN
JFCL
POP P,A ; Restore address of FD
MOVEI B,FDXSIZ ; Size of FD
HRLZM B,.FDLEN(A) ; Store in FD
>;End TOPS20
FSPECX: CALL ALCFOB ; Allocate FOB, link to FD
JRST [ WARN (Can't allocate file open block)
RET]
RETSKP ; Return with FOB size in B and addr in A
;Allocate FOB, link to FD, and set up for ASCII file open
;Call: A/ addr of FD
;Returns +1: can't allocate space for FOB
; +2: success, FOB size in A and address in B (setup for call to F%xOPN)
ALCFOB: STKVAR <FD>
MOVEM A,FD ; Save FD addr
MOVEI A,FOB.SZ ; Allocate FOB
$CALL M%GMEM ; Get a chunk
JUMPF R
MOVE A,FD ; Get FD address back
MOVEM A,FOB.FD(B) ; Stuff into FOB
MOVEI A,7 ; 7-bit bytes
TXO A,FB.LSN ; Ignore line sequence numbers
MOVEM A,FOB.CW(B) ; ..
TOPS10<
MOVE A,MYPPN ; My PPN for access checking
MOVEM A,FOB.US(B) ; ..
SETZM FOB.CD(B) ; Zero connected directory word
>;End TOPS10
TOPS20<
SETZM FOB.US(B) ; This doesn't apply for TOPS20
SETZM FOB.CD(B) ; No funny connected directory stuff please
>;End TOPS20
MOVEI A,FOB.SZ ; Return size in A, addr in B
RETSKP
;Clean up after ALCFOB -- deallocates FOB and FD
;Call: A/ FOB size
; B/ FOB address
;Returns +1: always
RELFOB: STKVAR <<FOB,2>>
DMOVEM A,FOB ; Save for a moment
MOVE B,FOB.FD(B) ; Address of FD
HLRZ A,.FDLEN(B) ; Size of FD
$CALL M%RMEM ; Release it
DMOVE A,FOB ; Release FOB
$CALL M%RMEM
RET
;Insert file into text buffer - FOB size, addr in A, B
RDTXT: STKVAR <<TFOB,2>,TIFN>
DMOVEM A,TFOB ; Remember for close
$CALL F%IOPN ; Open the file
JUMPF [ MOVE A,1+TFOB ; Get FOB addr
HRRZ A,FOB.FD(A) ; Get FD for error msg
$TEXT (KBFTOR,<?Can't open file ^F/(A)/ for read because: ^E/[-1]/>)
JRST RDTXTE] ; Clean up
MOVEM A,TIFN ; Remember this
RDTXT0: MOVE A,TIFN
$CALL F%IBYT ; Get a byte
JUMPF [ CAIE A,EREOF$ ; EOF?
JRST [ MOVE A,1+TFOB ; No, set up for err msg
HRRZ A,FOB.FD(A)
$TEXT (KBFTOR,<%Can't read file ^F/(A)/ because: ^E/[-1]/>)
MOVE A,TIFN
$CALL F%RREL
JRST RDTXTE] ; Give bad return
MOVE A,TIFN
$CALL F%REL ; Close file
JRST RDTXTX] ; Clean up
JUMPE B,RDTXT0 ; Ignore nulls
MOVE A,B
CALL TXTCHR ; Stuff into text
JRST RDTXT0
RDTXTX: SETZ A, ; Insure ASCIZ in text buffer
MOVE B,TXTPTR ; Leave TXTPTR pointing at null
IDPB A,B ; ..
DMOVE A,TFOB ; Deallocate FD and FOB
CALL RELFOB ; ..
RETSKP ; and give good return
RDTXTE: DMOVE A,TFOB ; Here for errors
CALL RELFOB
RET ; Give bad return
SUBTTL Text buffer manipulation routines
;Append ASCIZ string to text buffer, don't include null
;Call:
; A/ Pointer to string
; CALL TXTPUT
;Return +1: always, A/ pointer to last byte in text buffer
TXTPUT: TLC A,-1 ; See if magic LH (-1)
TLCN A,-1 ; ..
HRLI A,(POINT 7,)
TLNN A,-1 ; Even lazier -- zero LH
HRLI A,(POINT 7,)
MOVE D,A ; Copy pointer
TXTPT1: ILDB A,D ; Fetch character
JUMPE A,TXTPTX ; Stop on null
CALL TXTCHR ; Move to text buffer
JRST TXTPT1
;Same as above, but move the null
TXTPT0: TLC A,-1
TLCN A,-1
HRLI A,(POINT 7,)
TLNN A,-1
HRLI A,(POINT 7,)
MOVE D,A
TXTPT2: ILDB A,D
CALL TXTCHR
LDB A,TXTPTR ; Get char moved
JUMPN A,TXTPT2 ; Quit on null
TXTPTX: MOVE A,TXTPTR ; Always return pointing to last char moved
RET
;Insert one character into text buffer -- allocates pages if needed
;Call:
; A/ char to add
; CALL TXTCHR
TXTCHR: SOSGE TXTCNT ; Any room on current page?
JRST [ CALL TXTAQP ; No, acquire new page
JRST TXTCHR] ; Stuff it
IDPB A,TXTPTR ; Yes, just stuff it
AOS TXTTOT ; Count total bytes of text
RET
;Here if page full -- get and link next page
TXTAQP: $SAVE <A,B>
$CALL M%GPAG ; Get a page for text
JUMPF [ CERR (Can't expand text buffer -- insufficient memory)]
HRRZ B,TXTPTR ; Get current text pointer
ANDI B,777000 ; Get just the page address
MOVEM A,TB.FOR(B) ; Link new page
MOVEM B,TB.BAK(A) ; Maintain backward link too
ADD A,[POINT 7,TB.TXT] ; Point to text part of new page
MOVEM A,TXTPTR ; ..
MOVEM A,TTXTIB+.RDBFP ; This is also backup limit for editing
MOVEI A,TXTSIZ ; Bytes in one T-block
MOVEM A,TXTCNT
RET
;Move counted string to text buffer
;Call:
; A/ pointer to text
; B/ number of bytes to move
; CALL TXTCPT
;Return +1: always
TXTCPT: JUMPE B,R ; Just quit if zero count
STKVAR <TXPTR,TXCNT>
MOVEM A,TXPTR ; Current ptr to stuff left to move
MOVEM B,TXCNT ; Byte count of stuff left to move
TXTCP0: MOVE C,TXCNT ; Get count remaining
CAMLE C,TXTCNT ; Room on current page?
MOVE C,TXTCNT ; No, move just this much
MOVE A,TXTCNT ; Get bytes left in current page
SUB A,C ; Minus what we're moving now
MOVEM A,TXTCNT ; Save bytes left in page
MOVE A,TXCNT ; Get total bytes left to move
SUB A,C ; Compute bytes left after this chunk
MOVEM A,TXCNT ; Save
ADDM C,TXTTOT ; Maintain total number of bytes in text
MOVE A,C ; Number of bytes in this chunk
ADJBP A,TXPTR ; Compute first byte not moved
EXCH A,TXPTR ; Save new source ptr, get old
MOVE O,TXTPTR ; Destination byte pointer
CALL FSCOPY ; Do wizardly string copy
MOVEM O,TXTPTR ; Save updated destination pointer
SKIPN TXCNT ; Any bytes still left to move?
RET ; No, just quit
CALL TXTAQP ; Acquire and point to new text page
JRST TXTCP0 ; Go move this chunk
SUBTTL Message draft display and editing routines
;Retype buffer so far...
RETYPE: CALL CRIF ; Yes
CALL CRLF
MOVX A,.PRIOU ; Output text on TTY
CALL TXTOUT ; ..
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 subject of the message you are sending.
>,,[FLDDB. (.CMTXT,CM%SDH)])]
CALL RFIELD ; Read subject line or crlf
MOVE A,CR.COD(A) ; See which
CAIN A,.CMCFM ; Just CR?
JRST .ERSB0 ; No subject
CONFRM ; Grntee CR
MOVE A,[POINT 7,SUBJEC] ; Move to subject area
MOVEI B,ATMBUF
CALL MOVST0
RET
LLIT
.CC: MOVEI A,[FLDDB. .CMCFM] ; Try confirmation
CALL RFLDE ; ..
JRST GETCC0 ; None, maybe addresses to parse then
GETCC: PROMPT (cc: )
GETCC0: TXO F,F%CC ; Say in cc command
CALL SVSTAT ; Save state of address lists in case reparse
HLRZ W,TOPTRS ; Pointer to cc links
JUMPN W,.TO2
MOVEI W,TCPAG+400-1 ; Init for start
JRST .TO2 ; Go join common code
;Save state of address lists in case reparse occurs
SVSTAT: MOVE A,FRENAM ; String space pointer
MOVEM A,SV.FNM
MOVE A,TOPTRS ; Address list pointers
MOVEM A,SV.TOP
MOVE A,[NAMTAB,,SV.NTB] ; Name table
HLRZ B,NAMTAB ; ..
BLT A,SV.NTB(B) ; ..
MOVEI A,SVSTA0 ; Where to go to restore all this stuff
HRRM A,SBK+.CMFLG ; Fake out COMND routines
EXCH A,REPARA ; Fake out CMDERR also
MOVEM A,REPAR0 ; but remember what it wanted to do
MOVEI A,SVSTA1 ; Dummy return to reset default reparse addr
EXCH A,(P) ; Push on stack
JRST (A) ; Return to caller
;Here if no reparse needed -- reset default reparse address
SVSTA1: MOVEI A,REPARS
HRRM A,SBK+.CMFLG
MOVE A,REPAR0 ; Restore original reparse address
MOVEM A,REPARA
RET
;Here from COMND JSYS to restore things because reparse needed
SOS REPAR0 ; *** Note that this will only be called
; because CMDER1 SOS's REPARA, which
; points to SVSTA0. This remembers that.
SVSTA0: MOVE A,SV.FNM
MOVEM A,FRENAM
MOVE A,SV.TOP
MOVEM A,TOPTRS
MOVE A,[SV.NTB,,NAMTAB]
HLRZ B,SV.NTB
BLT A,NAMTAB(B)
MOVEI A,REPARS ; Restore normal reparse address
HRRM A,SBK+.CMFLG ; ..
MOVE A,REPAR0 ; Restore original REPARA
MOVEM A,REPARA ; ..
JRST REPARS ; Go do default reparse things
.TO: MOVEI A,[FLDDB. .CMCFM] ; Try confirmation
CALL RFLDE ; ..
JRST GETTO0 ; None, maybe addresses to parse
GETTO: PROMPT (To: )
GETTO0: TXZ F,F%CC
CALL SVSTAT ; Save state in case reparse
HRRZ W,TOPTRS
JUMPN W,.TO2
MOVEI W,TCPAG-1
.TO2: MOVE U,FRENAM ; Get free space pointer
TXZ F,F%CMA ; No commas seen yet
.TO3: CALL GETUSR ; Get the user entry in (b)
JRST .TO6 ; Empty field (CRLF), finish up and return
HRRZ A,B ; See if funny code returned
CAIN A,SFXCOD ; Suffix entry?
JRST [ AOS W ; Yes, stuff into table
MOVX A,AD%SFX ; ..
JRST .TO4]
MOVEI A,NAMTAB ; Regular name, add to table
MOVE C,B ; Preserve over call to S%TBAD
$CALL S%TBAD
JUMPF .TO7 ; Check for duplicate
MOVEM U,FRENAM ; Update free pointer
AOS W ; Add to address
HLRZ A,C ; Get ptr to string
HRRZ B,C ; Get user number or code
CAIN B,PFXCOD ; Prefix of named address-list?
TXO A,AD%PFX ; Yes, light appropriate flag
.TO4: MOVEM A,(W) ; Stuff entry into list
.TO5: TXNE F,F%CMA ; More wanted
JRST .TO3 ; Yes - get some
.TO6: 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
;Here if failure return from TBADD, either internal error, or
; duplicate name of some sort. Analyze and inform the user.
.TO7: CAIE A,EREIT$ ; Duplicate entry?
JRST [ CMERR <Name table full>
RET]
HLRZ B,C ; point to string
HRRZ A,C ; Are we purging an entire address list?
CAIE A,PFXCOD ; ..
JRST [ CIETYP <%% Duplicate name purged - %2S
>
JRST .TO5] ; No, we're done then
CIETYP <%% Duplicate address list purged - %2S
>
MOVEI E,1 ; Yes, init depth counter
.TO8: CALL GETUSR ; Eat addresses until list closure
JRST [ WARN <Internal error at .TO8, 1>
JRST .TO6] ; This can't happen
HRRZ A,B ; Get code for this guy
CAIN A,PFXCOD ; Prefix?
ADDI E,1 ; Yes, count levels of nesting
CAIN A,SFXCOD ; Suffix?
SOJL E,[WARN <Internal error at .TO8, 2>
JRST .TO6]
JUMPE E,.TO5 ; Back to original level -- all done purging
TXNN F,F%CMA ; There'd better always be more to parse
JRST [ WARN <Internal error at .TO8, 3>
JRST .TO6]
JRST .TO8 ; List to be purged still has elements left
;Prompt for and get user-defined header-items which are required
GETUHD: HLLZ E,HDITAB ; Count of all header-items
JUMPE E,R ; None, just quit
MOVN E,E ; Form AOBJN pointer
HRRI E,HDITAB+1 ; ..
GETUH0: HRRZ A,(E) ; Get ptr to H-block for this item
MOVE B,HD.FLG(A) ; Get flags
TXNE B,HD%RQD ; Required?
CALL INCLUD ; Yes, prompt for and store this header-item
AOBJN E,GETUH0 ; OK, keep on truckin'
RET
; Get prompted message
GETMS0: CALL GETTO0 ; Get To list without prompting
TOPS10< CALL ECHOON > ; In case monitor command
JRST GETMS1
GETMSG:
TOPS10< CALL ECHOON > ; In case monitor command
CALL GETTO ; To (with prompt)
CALL GETCC ; cc
GETMS1: CALL GETSUB ; Subject
CALL GETUHD ; User-defined header-items
JRST GETTXT ; Go get text and finish
; Remove user
.UNTO: NOISE (user)
.UNTO1: MOVEI U,STRBUF ; Place to put name string
CALL GETUSR
RET ; Null address, just return
HRRZ C,B ; Get code
SETZ A, ; Assume not address-list
CAIN C,PFXCOD ; Is this an address-list prefix?
SETO A, ; Yes, flag that we're removing a list
MOVEI U,STRBUF ; Start of buffer
CALL DOUNTO ; Remove the name
TXNE F,F%CMA ; More to come?
JRST .UNTO1 ; Yep
RET
;Remove a user (or list of users) from to or cc lists
;Call: A/ -1 to remove address-list, 0 to remove single user
; U/ address of name to remove (username or address-list name)
;Return +1: always
DOUNTO: TRVAR <PFXCNT> ; Count of prefixes seen
MOVEM A,PFXCNT ; also flag to remove list
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>)
; JRST DOUNT1
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
DOUNT2: CAIL T,(V) ; Done with this list?
RET ; Yes, return
AOJA T,DOUNT0 ; No, check next entry
DOUNT3: ILDB C,A ; Make sure we've matched entire target
JUMPN C,DOUNT2 ; There's more to target, this isn't a match
MOVX A,AD%PFX ; Is this entry an address-list prefix?
TDNE A,(T) ; ..
JRST [ SKIPN PFXCNT ; Yes, were we looking for one?
JRST DOUNT2 ; We weren't -- no match then
JRST DOUNT4] ; We were -- this is it then
SKIPE PFXCNT ; This isn't a prefix -- did we want one?
JRST DOUNT2 ; Yes, this is wrong -- no match
CALL RMVADR ; Ordinary address -- remove it
JRST DOUNT6 ; Finish up and return
DOUNT4: SETZM PFXCNT ; Init depth counter
DOUNT5: MOVE A,(T) ; Get this entry
TXNE A,AD%PFX ; Prefix? (Always true 1st pass)
AOS PFXCNT ; Yes, count depth
TXNE A,AD%SFX ; Suffix?
SOS PFXCNT ; Yes, one lest level now
CALL RMVADR ; Remove this entry
SKIPN PFXCNT ; This list totally removed yet?
JRST DOUNT6 ; Yes, finish up
JUMPN V,DOUNT5 ; Loop thru all entries in list
WARN (Unterminated named address-list)
DOUNT6: 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
CAIGE T,1(V) ; Was that the last in the list?
JUMPN V,DOUNT0 ; Or the end of the list?
RET ; Yes, return
;Remove one address from to or cc list.
;Call: T/ address of entry to remove
; V/ address of last entry in list
;Return +1: always, T preserved, V updated (or zero if list empty)
RMVADR: MOVX A,AD%SFX ; Suffixes have no string to remove
TDNN A,(T) ; ..
CALL NAMDEL ; delete this name
CAIN T,(V) ; At the end of the list?
JRST RMVAD1 ; Yes, no need to move anything
MOVEI A,(T)
HRLI A,1(T) ; Move up one word
BLT A,-1(V)
RMVAD1: CAIE V,TCPAG+400 ; Have we emptied the list?
CAIN V,TCPAG ; ie., Was that the first entry?
TDZA V,V ; Yes, erase field then
SOJ V, ; Else update end pointer
;See if we've emptied a named list by removing the individual names in it.
; If so, must remove prefix and suffix entries.
JUMPE V,R ; If list empty, don't try this stuff
CAIN T,1(V) ; Was entry deleted the end entry?
RET ; Yes, can't be any suffixes then
MOVE A,(T) ; Get potential suffix
TXNN A,AD%SFX ; Is deleted entry followed by suffix?
RET ; No, done
MOVE A,-1(T) ; Get possible prefix
TXNN A,AD%PFX ; Is it?
RET ; No, return
MOVEI A,-1(T) ; Yes, must delete prefix and suffix
HRLI A,1(T) ; So must remove two entries
BLT A,-2(V) ; ..
SUBI V,2 ; ..
CAIE V,TCPAG+400 ; Check for emptied list
CAIN V,TCPAG-1 ; ..
SETZ V, ; If empty, zero end pointer
RET
NAMDEL: MOVEI A,NAMTAB ; Remove entry from name table
HRR B,(T) ; Actual string
HRLI B,(POINT 7,) ; ..
$CALL S%TBLK ; Find in table
TXNN B,TL%EXM ; Found the entry?
JRST [ HRR A,(T) ; No, point to string
WARN (Can't find %1S in name table)
RET]
MOVE B,A
MOVEI A,NAMTAB
HLRZ D,NAMTAB ; Don't try if table empty
SKIPE D ; ..
$CALL S%TBDL ; Delete from table (can't fail?)
RET
SUBTTL Routines to parse address specifications
;Get User@site string, U/ addr where to stick string
;
;Return +1: blank line or error typed
; +2: success, B/ addr of string,,code
; where code =
; usernumber (TOPS20) or pointer to U-block (TOPS10) for local user
; NETCOD (-1) for network address
; SYSCOD (-2) for mail to SYSTEM
; PFXCOD (-3) for prefix name of an address list (name:)
; SFXCOD (-4) for suffix of address list (;)
;
;If an alias is typed which expands to more than one address,
; subsequent calls to GETUSR will return each address in the expansion.
; Further parsing of input will not occur until all addresses in the
; expansion have been returned. If the alias is a address-list, the
; first and last entries returned will be the prefix and suffix.
;
;Note that .TO and .CC, which allocate storage and change MS's state
; based on what GETUSR does, must call SVSTAT before calling GETUSR.
; SVSTAT dummies things up so that any reparse (either because of
; user editing or a command error) will undo anything .TO and .CC
; did. SVSTAT puts a dummy return on the stack so that its effect
; is undone automagically. Any other callers of GETUSR should
; probably do a similar thing.
GETUSR: TRVAR <SAVUSR,HPNT,STPNT,QCHAR,PDST>
TXZ F,F%AT ; Assume not net address yet
SKIPE C,SVABLK ; Any saved A-blocks waiting to be used?
JRST GETUSA ; Yes, go use up this one
MOVX A,CM%XIF ; Clear @ allowed flag in case of error
ANDCAM A,SBK+.CMFLG
MOVE A,SBK+.CMPTR ; Point to beginning of cmd
MOVEM A,STPNT ; in case quoted string typed
TOPS20<
MOVEI A,[FLDDB. .CMCFM,,,,,[FLDDB. .CMKEY,,KWDTBL,,,[FLDDB. .CMUSR,,,,,[FLDDB. .CMTOK,,<POINT 7,[ASCIZ /./]>,,,[FLDDB. .CMQST]]]]]
>;End TOPS20
TOPS10<
MOVEI A,[FLDDB. .CMCFM,,,,,[FLDDB. .CMKEY,,KWDTBL,,,[FLDDB. .CMKEY,,USRTAB,,,[FLDDB. .CMTOK,,<POINT 7,[ASCIZ /./]>,,,[FLDDB. .CMQST]]]]]
>;End TOPS10
; ..
; ..
HRRZ B,U ; Init address string dest ptr
HRLI B,(POINT 7,) ; ..
MOVEM B,PDST ; ..
TXZE F,F%CMA
MOVE A,(A) ; Comma previous, disallow CR
CALL RFLDE ; Get name
JRST GTCNET ; Hmm... check for possible net address
MOVE A,CR.COD(A) ; See what parsed
CAIN A,.CMCFM ; Just CR?
RET ; Yes - return
CAIN A,.CMTOK ; "." self?
JRST GETUME ; Yes, handle...
CAIN A,.CMQST ; Quoted string?
JRST GTNETU ; Go parse host spec, if present
CAIN A,.CMKEY ; Keyword?
JRST GETUSK ; Yes - synonym, SYSTEM, or TOPS10 username
GETUS3: MOVE A,SBK+.CMPTR ; Get next character
ILDB A,A ; and check for @
MOVEM B,SAVUSR ; Save user #
CAIE A," " ; Possible beginning of " at nodename"?
CAIN A,"@" ; or "@nodename" (wrong user)?
JRST GTNETU ; Yes, go try to parse a host spec
HRROI B,ATMBUF ; Regular user, stuff name into string space
HRRO A,U ; ..
SETZ C,
CALL TSOUT
GETUS0: CAIE B,SYSCOD ; Special hack?
JRST GETUS1 ; No
HRROI B,[ASCIZ "SYSTEM"]
HRRO A,U ; Supply canned name
SETZ C,
CALL TSOUT
GETUS1: HRLM U,SAVUSR ; Remember where string is.
IBP A ; Step over null
MOVEI U,1(A) ; Point to new free loc.
GETUS2: MOVEI A,[FLDDB. (.CMCFM,,,,,[FLDDB. .CMCMA])]
CALL RFIELD ; Get CR or comma
MOVE A,CR.COD(A) ; See what we just parsed
MOVE B,SAVUSR ; Return entry
CAIE A,.CMCFM ; EOL?
TXO F,F%CMA ; No - set comma seen
RETSKP ; Return
;Here if keyword parsed -- this is an address-list, alias, SYSTEM,
; or TOPS10 username. B has index into keyword table.
GETUSK: HRRZS B ; Get just index
TOPS10<
CAIL B,USRTAB ; Is this a user or a synonym?
CAILE B,USRTAB+USRTBN ; If index is in USRTAB, it's a user
SKIPA ; Not in USRTAB, must be synonym
JRST [ HRRZ D,(B) ; User -- get ptr to PPN
MOVE B,(D) ; Get PPN
MOVE A,[POINT 7,ATMBUF] ; Move real name of user
CALL PPN2ST ; to ATMBUF for later
CERR (PPN2ST failed at GETUSR)
MOVE B,D ; For later
JRST GETUS3] ; Rejoin main flow
>;End TOPS10
HRRZ A,(B) ; Get A-block ptr or code
CAIN A,SYSCOD ; SYSTEM?
JRST [ MOVEM A,SAVUSR ; Yes, remember
HLRO B,(B) ; Point to good string
HRRO A,U ; Where to write it
SETZ C, ; ..
CALL TSOUT ; Move name
JRST GETUS1] ; Continue
MOVE C,AB.FLG(A) ; Get flags for this A-block
TXNE C,AB%INV ; Invisible?
JRST [ MOVE C,A ; Yes, no prefix then
JRST GETUSA] ; Go handle alias
MOVEM A,SVABLK ; A-block, save its address
TXO F,F%CMA ; Make caller call us again
MOVX A,PFXCOD ; Indicate returning prefix
MOVEM A,SAVUSR ; ..
TXO F,F%SUFX ; Flag GETUSA that suffix needed
HLRZ B,(B) ; Point to name of alias
HRLI B,(POINT 7,) ; ..
SETZ C, ; Assume no quoting needed
CALL SPCCHK ; See if quoting needed
MOVEI C,42 ; Yep, get the quote char
MOVEM C,QCHAR ; Save it
HRRZ A,U ; Move alias name to string space
HRLI A,(POINT 7,) ; ..
SKIPE C ; Quoting required?
IDPB C,A ; Yes, move the quote
SETZB C,D ; Now move the address list name
CALL TSOUT ; ..
SKIPE B,QCHAR ; And, if quoting needed,
IDPB B,A ; close the quote
JRST GETSA1 ; Return funny code to caller
;Here to return addr and code from A-block, C points to A-block
; c(C)=-1 means that we need to return a suffix placeholder
GETUSA: TXZ F,F%CMA ; Assume no more coming
CAMN C,[-1] ; Suffix pending?
JRST [ MOVX B,SFXCOD ; Get suffix code
MOVEM B,SAVUSR ; Return to user
SETZM SVABLK ; All done handling this alias now
JRST GETUS2] ; Check for CR or comma and return
MOVE B,AB.COD(C) ; Get user number or network code
MOVEM B,SAVUSR ; Save away
SKIPE A,AB.LNK(C) ; Get link (if any)
TXOA F,F%CMA ; There is one, flag caller
JRST [ TXZN F,F%SUFX ; No more left -- need suffix?
JRST .+1 ; No, rejoin main flow
SETO A, ; Yes, flag suffix needed
TXO F,F%CMA ; and make caller call us again
JRST .+1]
MOVEM A,SVABLK ; Remember for subsequent calls
HRRZ A,U ; Where to put real string
HRLI A,(POINT 7,) ; ..
MOVEI B,AB.TXT(C) ; Point to string for synonym
HRLI B,(POINT 7,) ; ..
CALL MOVST0 ; Move 'em on out!
TXNN F,F%CMA ; Any more addresses in this list?
JRST GETUS1 ; No, check for CR or comma
GETSA1: HRRZ B,SAVUSR ; Is this address a net address?
CAIN B,NETCOD ; ..
TXO F,F%AT ; Yes, flag that for caller
HRLM U,SAVUSR ; Remember where string starts
IBP A ; Step over null
MOVEI U,1(A) ; Point to first free word
MOVE B,SAVUSR ; Return string ptr and code
RETSKP ; Good return
;Here when dot typed -- supply my own name and number
GETUME: MOVE B,MYDIR ; Supply my directory number
MOVEM B,SAVUSR ; (PPN pointer on TOPS10)
TOPS20<
HRRO A,U ; and supply a string that works
DIRST
ERJMP [JFATAL (DIRST failure)]
>;End TOPS20
TOPS10<
HRRZ A,U ; Supply my own name
HRLI A,(POINT 7,)
MOVE B,MYPPN ; ..
CALL PPN2ST ; ..
FATAL (Can't discover my own name)
>;End TOPS10
JRST GETUS1 ; finish up
;Error routines for GETUSR
NOHOST: MOVX A,CM%XIF ; Clear @ allowed flag on error
ANDCAM A,SBK+.CMFLG
MOVEI A,ATMBUF ; Type the bad host name
CMERR (No such host name as "%1S")
JRST NOUSR2 ; Common error exit
NOUSR0: MOVE A,[POINT 7,ATMBUF] ; Where to stuff bad name for error msg
NOUSR1: ILDB B,STPNT ; Get next char of bad name
CAIE B,"," ; Check for all possible terminators
CAIN B,";"
SETZ B, ; Turn terminators into null
CAIE B,15
CAIN B,12
SETZ B,
IDPB B,A ; Stuff char into atom bufferr
JUMPE B,NOUSR ; When done, type message
JRST NOUSR1 ; Loop for all chars in bad name
NOUSR: MOVX A,CM%XIF ; Clear @ allowed flag on error
ANDCAM A,SBK+.CMFLG
MOVEI A,ATMBUF ; Point to bad part of string
CMERR ("%1S" is an invalid user name)
NOUSR2: JRST CMDER1 ; Go force reprompt and reparse
NONET: CMERR (Network addresses not allowed on this system.)
JRST NOUSR2
;Here if name is neither keyword, username, token (.)
; It is probably the name of a foreign user. Parse as plain field.
GTCNET: MOVEI A,[FLDBK. (.CMFLD,,,,,[BRMSK. (FLDB0.,FLDB1.,FLDB2.,FLDB3.,<.#$%^&*_=+`~|'{}/>)])]
CALL RFIELD ; Get username string
; JRST GTNETU ; Now parse host specifier or more words
;Here when we have parsed a quoted string, or a token followed by a space
; or an at-sign. This is either a net address, or a username containing
; spaces. Check it out.
GTNETU: MOVE B,[POINT 7,ATMBUF] ; Point to username token
SETZ C, ; Default is no quoting
CALL SPCCHK ; Does it contain special chars?
MOVEI C,42 ; Yes, must quote it then
MOVEM C,QCHAR ; ..
MOVE A,PDST ; Where to plop this string
SKIPE B,QCHAR ; If quoting needed,
IDPB B,A ; Start us off
HRROI B,ATMBUF ; Get user name from buffer
SETZ C,
CALL TSOUT
SKIPE B,QCHAR ; If quoting,
IDPB B,A ; close the quotes
GTNTU1: MOVEM A,HPNT ; Save pntr
MOVEM A,PDST ; Also enable concatenation to what we just got
MOVE A,SBK+.CMPTR ; Get char that terminated user token
ILDB A,A ; ..
CAIN A,"@" ; Which flavor of host delimiter?
JRST [ MOVX A,CM%XIF ; Atsign: set flag to
IORM A,SBK+.CMFLG ; allow @ in string
MOVEI A,[FLDDB. (.CMTOK,,<-1,,[ASCIZ "@"]>)]
CALL RFIELD ; Parse @
JRST GTNTU2] ; and continue
CAIE A,"," ; Comma
CAIN A,15 ; or EOL?
JRST GTNT3A ; Yes, treat as local username then
CAIN A,12 ; COMND sometimes is off by one
JRST GTNT3A ; If EOL, treat as local username
CAIE A," " ; Space (beginning of " at ")?
JRST NOUSR0 ; No, go complain
CALL GTNTAT ; Yes, try to parse " at "
JRST [ MOVEI A," " ; Not " at ", must be multi-word
IDPB A,PDST ; name. Move the space and go try
JRST GTCNET] ; to parse more words.
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
HRRZ A,(B) ; Get flags for this host
TXNE F,F%XMLR ; HOSTS2 style host table?
JRST [ CAMN A,LSITE ; Yes, is this the local host?
JRST GTNTU3 ; Yup... wipe out host name then
JRST GTNTU4] ; No, do nothing special
TXNN A,NT%LCL ; Local host?
JRST GTNTU4 ; No, do nothing special
; JRST GTNTU3
;Here if user explicitly entered local host name -- remove it.
; It will be added later if really needed, but this allows us to insure
; that local mail stays that way
GTNTU3: SETZ A, ; Zap the at-sign
DPB A,HPNT
MOVNI A,1 ; Back up over at-sign
ADJBP A,HPNT ; ..
MOVEM A,HPNT ; ..
GTNT3A: LDB A,HPNT ; Get terminator
CAIE A,11 ; Space or tab (trailing whitespace)?
CAIN A,40 ; ..
JRST [ MOVNI A,1 ; Yes, back up over it
ADJBP A,HPNT ; ..
MOVEM A,HPNT ; so we can stomp on it with a null
JRST GTNT3A] ; ..
SETZ A, ; Insure ASCIZ (stomping on trailing
IDPB A,HPNT ; whitespace perhaps too)
HRRO B,U ; Point to username in string space
TOPS20<
MOVX A,RC%EMO ; Insure that this user exists
SETZ C,
RCUSR
ERCAL [TXO A,RC%NOM ; Light no-match bit on failure
RET]
TXNE A,RC%NOM ; Any match found?
>;End TOPS20
TOPS10<
MOVEI A,USRTAB ; Look up in userr table
$CALL S%TBLK ; ..
HRRZ A,(A) ; Point to U-block
TXNE B,TL%EXM ; Exact match?
SKIPA C,A ; Yes, put PPN pointer into C
>;End TOPS10
JRST [ MOVE A,[POINT 7,ATMBUF] ; Put name into ATMBUF so error msg
MOVE B,U ; works (otherwise it has host name)
CALL MOVST0 ; ..
JRST NOUSR] ; Go complain about user not existing
MOVEM C,SAVUSR ; stash user number and finish up
MOVE A,HPNT ; Return with A pointing at address
JRST GETUS0 ; ..
GTNTU4: MOVX A,CM%XIF ; Disallow @
ANDCAM A,SBK+.CMFLG
HLRZ B,(B) ; Point to string block for hostname
MOVE A,(B) ; Get first word of string block
TLNN A,(177B6) ; Is this a flags word?
TXNN A,CM%FW ; ..
SKIPA
ADDI B,1 ; Yes, skip to text then
HRLI B,(POINT 7,) ; Form string pointer
MOVE A,HPNT ; Append to user name
SETZ C,
CALL TSOUT
MOVX B,NETCOD ; Flag net address
HRRM B,SAVUSR ; ..
TXO F,F%AT ; ..
JRST GETUS1 ; Join common code
;Parse " at ". Returns +1 if not found, +2 if found
GTNTAT: MOVEI A,[FLDDB. .CMKEY,CM%SDH,[ 2,,2
CMD1 a,0,CM%NOR ; Don't allow abbrev. for "at"
CMD at,0],<
The word "at" followed by a node name to specify a user on
a remote node, or comma or <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 NOUSR2]
RETSKP ; Return
LLIT
SUBTTL Editor interfacing subroutines
TOPS20< ; For several pages
;Here to start up a new editor
;Return +1: failure of some sort
; +2: success
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
ERJMP [JRETER (Cannot create editor fork)
RET]
MOVEM A,EDFORK ; Save it
MOVSI A,(GJ%OLD!GJ%SHT)
HRROI B,[ASCIZ /SYS:EMACS.EXE/]
GTJFN
ERJMP [JRETER (Cannot get editor)
RET]
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
;(Still inside TOPS20)
;(Still inside TOPS20)
;Here to restart editor fork
;Return +1: failure of some sort
; +2: OK
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
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,BY2PAG ; Get page number
HRL A,EDFORK
MOVE B,[.FHSLF,,EDPAGE_-9]
MOVE C,[PM%CNT+PM%RD+PM%WR+20]
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
; .. (Still inside TOPS20)
; .. (Still inside TOPS20)
MOVE A,EDBPAG+4(T) ; End of the buffer
CAMN A,EDBPAG+0(T) ; Same as beginning?
RETSKP ; Yes, forget empty buffer
SUBI A,2 ; Back up two chars
CAMGE A,EDBPAG+0(T) ; But not past beginning
RETSKP
CALL EDCHRP ; Get byte pointer to it
ILDB B,A ; Get character
CAIE B,37 ; ^_ part of a request?
RETSKP ; 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
RETSKP ; 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
CHR2BP ; Get byte pointer in 1
MOVE B,MSGBON(M) ; Length of it
CALLRET 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
RETSKP ; And return to caller
;(Still inside TOPS20)
;(Still inside TOPS20)
; 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,[ 440700
350700
260700
170700
100700](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
;Return +1: failure
; +2: OK
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
CALLRET RESTE0 ; Resume editor and return
;(Still inside TOPS20)
;(Still inside TOPS20)
; 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
RET ; Error, quit now
MOVEM A,FRKACS+1 ; Pass JFN of file to EMACS
CALLRET GETED] ; Invoke EMACS and then return
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
CALLRET EDINS2 ; And go insert the new string
;Create temp file and write text out to it
;Return +1: failure
; +2: OK
EDTMP: STKVAR <<MFSTR,20>> ; Filespec string
HRROI A,MFSTR ; Dest ptr to string
SETZB C,D
SKIPN CRFDEV ; Any default directory?
JRST EDTMP0 ; No, skip this
HRROI B,CRFDEV ; Yes, default device
SOUT ; ..
MOVEI B,"<" ; Punctuate
IDPB B,A ; ..
HRROI B,CRFDIR ; Directory
SOUT
MOVEI B,">" ; Punctuate
IDPB B,A ; ..
EDTMP0: HRROI B,[ASCIZ /MSG.TMP;T/]
SOUT ; Complete filespec
MOVSI A,(GJ%SHT!GJ%FOU)
HRROI B,MFSTR ; Filespec we build
GTJFN
ERJMP [MOVEI A,MFSTR ; For error message
JRETER <Can't open (GTJFN) TMP file %1S>
RET]
MOVE B,[7B5+OF%WR]
MOVE E,A ; Preserve JFN for possible releasage
OPENF
ERJMP [MOVE A,E ; JFN
JRETER <Can't open (OPENF) TMP file %1J>
MOVE A,E ; Release dangling JFN
RLJFN
JFCL
RET]
MOVN C,OLDCNT ; Get -char cnt
MOVE B,EDTPNT ; and pointer
SOUT ; Write it out
ERJMP [JRETER <Can't write to TMP file>
MOVE A,E ; Release useless JFN
CLOSF
JFCL
RET]
TLO A,(CO%NRJ) ; Keep the jfn
CLOSF
ERJMP [JRETER <Can't close TMP file>
RET]
HRRZS A ; Return only JFN
RETSKP
;(Still inside TOPS20)
;(Still inside TOPS20)
; Editor command
.EDITO: CONFRM ; Confirm first
SKIPN EDITOR ; Know what editor we're using yet?
CALL EDITQ ; No, find out
SKIPL EDITOR ; EMACS?
JRST [ CALL CMDINI ; No, init this level
PROMPT <EMACS is not your default editor; do you wish to make it so? >
CALL YESNO
JRST [ WARN <EMACS not invoked>
RET]
SETOM EDITOR ; User said yes, declare EMACS default
SKIPLE A,EDFORK ; Have an old dusty editor lying about?
KFORK ; Yes, kill it
SETZM EDFORK ; ..
JRST .+1]
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
RET ; error, just quit now
.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
CALLRET SETTYM
.EDTO3: CALL RESTED ; Restart editor
RET ; Error, just quit
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
CMERR (Editor fork terminated involuntarily.)
RET
; ^C typed from editor, make it percolate up
CTLCED: CALL CKXRTN ; Exit and return if continued
CALLRET RESTE0 ; And resume it afterwards
;(Still inside TOPS20)
;(Still inside TOPS20)
; Edit fields
.EDTXT: CALL BLANK0 ; Fresh start
SKIPN EDITOR ; Know which editor to use yet?
CALL EDITQ ; No, figure it out
SKIPL EDITOR ; EMACS?
CALLRET TVORED ; No, TV or EDIT or something...
CALL TMPTXT ; Move text to contiguous buffer
CALL EDREPL ; Run editor over this field
JRST .EDTX2 ; Failure, don't snarf junk then
CALL .EDTX1 ; Snarf text
.EDTX2: CALL RELTMP ; Release temp text buffer
JRST .EDTO2 ; Switch tty modes and return
; Get text from EMACS and update pntr and cnt
.EDTX1: CALL .ERST0 ; Erase text
CALL GEDTXT ; Get the editted text
MOVE B,C ; Copy count to TXTCPT's good place
CALL TXTCPT ; Move counted string to text buffer
RET ; Return
; 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
;(Still inside TOPS20)
;(Still inside TOPS20)
;Allocate temporary buffer for text and move it there. This is
; so editors and editor interface routines don't have to deal
; with noncontiguous text.
;
;Returns: A/ pointer to contiguous copy of text
; B/ byte count
TMPTXT: SKIPN A,TXTTOT ; Get total text char count
JRST [ SETZ B, ; No count, no text
RET]
ADDI A,<1000*5-1> ; Force roundup
IDIVI A,<1000*5> ; ..
MOVEM A,TMPTX0 ; Save size of buffer
$CALL M%AQNP ; Allocate enough pages
JUMPF [CWARN (Can't run editor - insufficient memory)]
MOVEM A,TMPTX1 ; Save page number of buffer
LSH A,^D9 ; Form address
HRLI A,(POINT 7,) ; Form byte pointer
CALL TXTOUT ; Move the text there
MOVE A,TMPTX1 ; Get address of buffer again
LSH A,^D9 ; ..
HRLI A,(POINT 7,) ; Form byte pointer
MOVE B,TXTTOT ; Return count to caller
RET
;Release temporary text pages
RELTMP: DMOVE A,TMPTX0 ; Get size, page number
$CALL M%RLNP ; Release them
SETZM TMPTX0 ; Remember nothing left to clean up
RET
;(Still inside TOPS20)
;(Still inside TOPS20)
;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
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
;(Still inside TOPS20)
;(Still inside TOPS20)
;Here if using editor other than EMACS
;Invoke the editor, snarf edited text and return
;Return +1: failure
; +2: OK
TVORED: ACVAR<TJFN>
TRVAR<OLDCNT,NEWCNT,EDTPNT> ; *** Must match TRVAR at EDREPL and EDINS
STKVAR<<STRING,30>> ; MSG.TMP filespec
CALL TMPTXT ; Move text to contiguous place
MOVEM A,EDTPNT ; Save pointer to it
MOVEM B,OLDCNT ; and count
CALL EDTMP ; Write text into tmp file
RET ; Problem, return failure
HRRZ TJFN,A ; Remember its JFN
MOVEI A,STRING
HRLI A,(POINT 7,)
MOVEI B,[ASCIZ /EDIT /] ; Build command for editor
CALL MOVSTR
MOVE B,TJFN
MOVX C,<1B2+1B5+1B8+1B11+1B14>!JS%PAF ; Complete filespec
JFNS
MOVEI B," " ; Plunk a space in there
IDPB B,A
MOVE B,TJFN
MOVX C,<1B2+1B5+1B8+1B11+1B14>!JS%PAF ; Complete filespec
JFNS ; Output to this spec too
MOVEI B,CRLF0
CALL MOVST0 ; Move CRLF and null
HRROI A,STRING
RSCAN ; Command string for editor
JFCL
; .. (Still inside TOPS20)
; .. (Still inside TOPS20)
; Command string has been built ... now try to fetch and run the editor
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
ERJMP [JRETER (Cannot get editor)
RET]
PUSH P,A ; Save JFN of editor
MOVX A,CR%CAP
CFORK
ERJMP [JRETER (Cannot create editor fork)
RET]
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
CALL .ERST0 ; Erase text buffer
MOVE A,TJFN ; Re-open TMP file
MOVX B,<070000,,0>!OF%RD
OPENF ; Read, 7-bit bytes
ERJMP [CAIE A,OPNX2 ; Did editor empty the file?
JRST [ JRETER (Cannot open tmp file)
RET] ; Return failure
JRST TVORE1] ; Yes, this is OK then
MOVE D,A ; Put JFN into preserved place
; JRST TVORE2
; (Still inside TOPS20)
; (Still inside TOPS20)
TVORE2: MOVE A,D ; Get JFN back
BIN
ERJMP TVORE1
MOVE A,B ; Set up for TXTCHR
CALL TXTCHR ; Stuff next byte into text buffer
JRST TVORE2 ; Do for all
TVORE1: 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
RETSKP
>;End TOPS20
LLIT
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
$CALL KBFTOR
RET
%TYPE: CALL TYCRIF ; Check if we should do a crlf
HRRZ A,40 ; Get string
HRLI A,(POINT 7,)
$CALL KBFTOR
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: $SAVE <A,B>
$CALL K%FLSH ; Flush terminal output buffers first
$CALL K%TPOS ; Get terminal cursor position
SKIPF ; If K%TPOS fails, assume need CRLF
SKIPE A ; Cursor at left margin (position zero)?
CALL CRLF ; No, need CRLF then
RET
CRLF: PUSH P,A ; Save possibly clobbered regs
PUSH P,O
MOVE A,[POINT 7,CRLF0]
CALL KBFTOR ; Type it
AOS LFCNT ; Count lines for those interested
POP P,O
POP P,A
RET
CRLF0: BYTE (7) 15,12,0
%ERROR: CALL CLRCTO ; Clear ctrl-O
CALL CRIF ; Get a fresh line
MOVE B,40 ; Get instruction
TLNE B,(<10,0>) ; Wants %?
SKIPA A,["?"] ; No
MOVEI A,"%"
$CALL KBFTOR
TRNN B,-1 ; Any message to print?
JRST %ERR2 ; No
CALL %ETYE0 ; Yes,print it out
MOVEI A," "
$CALL KBFTOR
MOVE B,40 ; And recover instruction
%ERR2: TLNN B,(<4,0>) ; Wants JSYS error message?
JRST %ERR3
HRROI A,[ASCIZ /because: /]
$CALL KBFTOR
TOPS20<
$CALL K%FLSH
MOVEI A,.PRIOU
HRLOI B,.FHSLF ; This fork
SETZ C,
ERSTR
JFCL
JFCL
>;End TOPS20
TOPS10<
$TEXT (KBFTOR,<^E/[-1]/>)
>;End TOPS10
%ERR3: MOVEI A,^D10 ; Ten seconds for error msgs
CALL RDELAY ; Insure user gets time to read message
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
FATAL (Unimplemented error macro invoked)
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: $CALL KBFTOR
JRST %ETYP1
%ETYTB: %ETYPA ; A - Print time
%ETYPB ; B - Print date
CRLF ; C - CRLF
%ETYPD ; D - print decimal
%ETYP0 ; E
%ETYP0 ; F - floating *** WHY??? ***
%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: JUMPE V,.+2 ; If AC field specified
SKIPA B,UUOACS(V) ; Use it
SETO B, ; Otherwise use now
$TEXT (KBFTOR,<^C/B/^A>)
RET
%ETYPT: JUMPE V,.+2 ; If ac field spec'd
SKIPA B,UUOACS(V) ; Use it
SETO B, ; Else use now
$TEXT (KBFTOR,<^H15/B/^A>)
RET
%ETYPB: JUMPE V,.+2 ; If AC field specified
SKIPA B,UUOACS(V) ; Use it
SETO B, ; else use now
$TEXT (KBFTOR,<^H9/B/^A>)
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
CALL TNOUT
RET
%ETYPM: MOVEI C,^D10 ; Decimal
HRRZ B,UUOACS+M ; Current message
AOJA B,%ETYO0 ; Zero is msg 1
REPEAT 0,<
%ETYPF: MOVEI A,.PRIOU
MOVE B,UUOACS(V)
SETZ C,
FLOUT
JFCL
RET
>;End REPEAT 0
%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"
$CALL KBFTOR
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: ; Type a filespec
TOPS20<
$CALL K%FLSH
MOVEI A,.PRIOU
MOVE B,UUOACS(V)
SETZ C,
JFNS
RET
>;End TOPS20
TOPS10<
MOVE A,UUOACS(V) ; Get IFN
SETO B, ; Obtain exact filespec
$CALL F%FD ; ..
$TEXT (KBFTOR,<^F/A/^A>)
RET
>;End TOPS10
%ETYPN:
TOPS20<
MOVEI A,.PRIOU
MOVE B,UUOACS(V)
MOVEI C,10 ; Just in case
CVHST
NOUT
JFCL
>;End TOPS20
TOPS10<
FATAL (ARPANET doesn't exist on TOPS10 systems)
>;End TOPS10
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)
TOPS20<
DIRST
JFCL
>;End TOPS20
TOPS10<
$TEXT (KBFTOR,<^U/B/^A>)
>;End TOPS10
RET
LLIT
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!
;Since O is now AC 0 (forced by GALAXY's AC usage), we must use another
; AC because ADJBP does the wrong thing for AC 0
OO==M ; Destination byte pointer
FSCPY2: MOVEM M,FSCACS+M ; This is a pain, but faster than using PDL,
MOVEM O,FSCACS+O ; O and M are no longer contiguous...
MOVE M,[D,,FSCACS+D] ; and we need to do something
BLT M,FSCACS+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.
MOVE OO,O ; Put dest ptr into nonzero AC
LDB D,[360300,,OO] ; Repeat procedure for dest
SKIPGE D,FSCHT2(D) ; using slightly different table
AOSA V,OO ; and addr goes into 10
MOVEI V,(OO) ; and isn't normally bumped.
MOVEI OO,(C) ; update the destination pointer in OO
ADJBP OO,FSCACS+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 O,OO ; Return updated ptr in O
MOVE M,[FSCACS+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:
LIT
VAR
TOPS20< END <3,,EV> >
TOPS10< END GO >