Trailing-Edge
-
PDP-10 Archives
-
BB-M080H-SM
-
monitor-sources/comnd.mac
There are 52 other files named comnd.mac in the archive. Click here to see a list.
;Edit 3150 to COMND.MAC by PRATT on Wed 22-Aug-84, for SPR #15611
; Make filespec defaults work properly
;Edit 3149 to COMND.MAC by PRATT on Mon 20-Aug-84, for SPR #17658
; Make .CMQST handle defaults properly for crlf
;Edit 3148 to COMND.MAC by PRATT on Thu 16-Aug-84, for SPR #18336
; Make .CMTOK handle defaults correctly for crlf
;Edit 3067 to COMND.MAC by PRATT on Thu 5-Jan-84
; Update comments for edits 3043 and 3045
;Edit 3045 to COMND.MAC by PRATT on Thu 10-Nov-83
; Fix "section greater than 37" errors for .CMNUX
;Edit 3043 to COMND.MAC by PRATT on Thu 10-Nov-83
; Add no comment bit for Datatrieve
;Edit 3033 to COMND.MAC by PRATT on Tue 25-Oct-83, for SPR #16487
; Make ^F work for .CMUQS if it is a break character
;Edit 3022 to COMND.MAC by PRATT on Fri 30-Sep-83, for SPR #13260
; Fix XCMUQS to understand CMQUES
;Edit 3009 to COMND.MAC by TSANG on Wed 7-Sep-83, for SPR #19417
; Release extraneous JFNs which exist if an error occurs in an
;; indirect file command.
;Edit 2995 to COMND.MAC by PRATT on Tue 26-Jul-83, for SPR #17334
; Let user set break mask for switches. Change CFNTAB for .CMSWI
; UPD ID= 232, FARK:<5-1-WORKING-SOURCES.MONITOR>COMND.MAC.5, 18-Nov-82 10:05:28 by DONAHUE
;Edit 2871 - Remove previous edit (most of it)
; UPD ID= 199, FARK:<5-1-WORKING-SOURCES.MONITOR>COMND.MAC.4, 3-Nov-82 16:48:44 by DONAHUE
;Edit 2852 - Add default parsing for CMTOK, also change NPXNMD to NPXNMT
; UPD ID= 47, FARK:<5-WORKING-SOURCES.MONITOR>COMND.MAC.2, 20-May-82 15:54:42 by DONAHUE
;Edit 2620 - Allow ':' within keywords
; UPD ID= 489, SNARK:<5.MONITOR>COMND.MAC.52, 26-Feb-82 11:20:35 by GROUT
;Remove TCO 5.1637
; UPD ID= 459, SNARK:<5.MONITOR>COMND.MAC.51, 3-Feb-82 14:24:23 by GROUT
;TCO 5.1637 - Fix COMND so it doesn't echo CTRL/U and CTRL/H
; UPD ID= 426, SNARK:<5.MONITOR>COMND.MAC.50, 21-Jan-82 10:43:15 by PAETZOLD
;More TCO 5.1687
; UPD ID= 415, SNARK:<5.MONITOR>COMND.MAC.49, 19-Jan-82 08:22:08 by PAETZOLD
;TCO 5.1687 - Fix RDCBP to accept OWGBPs from non-zero section
; UPD ID= 367, SNARK:<5.MONITOR>COMND.MAC.48, 18-Dec-81 16:15:48 by CHALL
;TCO 5.1639 (RETROFIT TCO 6.1036): ADD FDB FLAG CM%NSF (NO SUFFIX NEEDED)
; TEACH XCMNOD AND XCMDEV TO USE CM%NSF
; UPD ID= 358, SNARK:<5.MONITOR>COMND.MAC.47, 11-Dec-81 15:45:18 by CHALL
;TCO 5.1631 XCMTAD- DON'T COUNT TERMINATOR AS PART OF DATE-TIME
; UPD ID= 281, SNARK:<5.MONITOR>COMND.MAC.46, 21-Oct-81 13:56:21 by GROUT
;TCO 5.1547 - SAVE .CMPTR/.CMCNT FOR .CMINI AFTER INTERRUPT OUT OF COMND
; UPD ID= 246, SNARK:<5.MONITOR>COMND.MAC.45, 6-Oct-81 13:42:43 by MOSER
;TCO 5.1526 MAKE .CMNOI WORK WHEN FIRST IN LIST.
; UPD ID= 156, SNARK:<5.MONITOR>COMND.MAC.44, 9-Sep-81 09:18:52 by CHALL
;TCO 5.1491 XCOM5A- REMOVE TCO 5.1475 UNTIL I GET IT RIGHT (SIGH)
; UPD ID= 136, SNARK:<5.MONITOR>COMND.MAC.43, 1-Sep-81 22:25:25 by DONAHUE
;TCO 5.1484 - Let CTRL/V be seen as a break character
; UPD ID= 120, SNARK:<5.MONITOR>COMND.MAC.40, 25-Aug-81 14:44:44 by CHALL
;TCO 5.1475 XCOM5A- IF THERE'S ONLY ONE KEYWORD (ETC.) OUTPUT IT
; UPD ID= 101, SNARK:<5.MONITOR>COMND.MAC.39, 14-Aug-81 10:28:51 by ZIMA
;TCO 5.1453 - Remove unneeded instructions at RTYP33.
; UPD ID= 53, SNARK:<5.MONITOR>COMND.MAC.38, 20-Jul-81 15:53:52 by MOSER
;TCO 5.1423 LOOK AT TT%LCA AS WELL AS TT%UOC TO DECIDE HOW FAR TO BACK UP.
; UPD ID= 2201, SNARK:<5.MONITOR>COMND.MAC.37, 16-Jun-81 08:22:15 by SCHMITT
;More of TCO 5.1361 - Remove checks for break in default string
; UPD ID= 2193, SNARK:<5.MONITOR>COMND.MAC.36, 12-Jun-81 12:12:13 by SCHMITT
;More of TCO 5.1361 - Make good check for break set supplied at GETBRK
; UPD ID= 2166, SNARK:<5.MONITOR>COMND.MAC.35, 10-Jun-81 15:17:33 by PAETZOLD
;TCO 5.1293 Fix breaks on <CR> for TEXTI
; UPD ID= 2163, SNARK:<5.MONITOR>COMND.MAC.34, 10-Jun-81 09:36:28 by DONAHUE
;TCO 5.1366 - Check if parsing a noise word at NLINE
; UPD ID= 2145, SNARK:<5.MONITOR>COMND.MAC.33, 8-Jun-81 11:52:06 by SCHMITT
;TCO 5.1361 - Check for break characters in default string.
; UPD ID= 2144, SNARK:<5.MONITOR>COMND.MAC.32, 8-Jun-81 10:12:06 by SCHMITT
;TCO 5.1360 - Make .CMCMA terminated with ESC function correctly
; UPD ID= 2114, SNARK:<5.MONITOR>COMND.MAC.31, 1-Jun-81 14:40:58 by SCHMITT
;TCO 5.1357 - in CHKDEF, jump back to XCOMB0 to reset pass 1
; UPD ID= 1940, SNARK:<5.MONITOR>COMND.MAC.30, 5-May-81 16:54:31 by MOSER
;TCO 5.1311 - Make help work as documented if parsing keyword or switch and
; nothing can match.
; UPD ID= 1782, SNARK:<5.MONITOR>COMND.MAC.29, 3-Apr-81 14:03:34 by MURPHY
;Make ^O act like ^R if ever seen in input stream.
; UPD ID= 1742, SNARK:<5.MONITOR>COMND.MAC.28, 19-Mar-81 21:44:18 by MURPHY
;Undo preceding edit. Put COMNX9 back in.
; UPD ID= 1641, SNARK:<5.MONITOR>COMND.MAC.27, 4-Mar-81 10:38:37 by OSMAN
;tco 6.1004 - Don't fail in .CMINI if end of file encountered in lieu of ^H.
; Note: As part of this, remove COMNX9 check so that IOX4 is all that need
; be checked for by user's error handler.
; UPD ID= 1532, SNARK:<5.MONITOR>COMND.MAC.26, 7-Feb-81 21:34:22 by GRANT
;REPLACE NTMX4 ERROR CODE WITH COMX21
; UPD ID= 1449, SNARK:<5.MONITOR>COMND.MAC.25, 16-Jan-81 08:50:10 by GRANT
;Initialize T4 at PARNOD
; UPD ID= 1353, SNARK:<5.MONITOR>COMND.MAC.22, 15-Dec-80 14:15:23 by DONAHUE
;TCO 5.1215 - Add routine ECOCHK to check if echoes are on or off (called
;when a '?' is seen)
; UPD ID= 1122, SNARK:<5.MONITOR>COMND.MAC.21, 3-Oct-80 14:17:24 by SCHMITT
;TCO 5.1166 - Fix parsing when .CMTXT is alternate to other functions
; Create new bit CMNP1 which will say not to perform pass 1
; for certain functions, (.CMTXT) is one.
; UPD ID= 988, SNARK:<5.MONITOR>COMND.MAC.20, 4-Sep-80 15:13:22 by GRANT
;Rewrite PARNOD - add a special entry point for non-ASCIZ strings and
;add DECnet Phase III restriction of at least 1 alphabetic character
; UPD ID= 780, SNARK:<5.MONITOR>COMND.MAC.19, 23-Jul-80 10:56:15 by MURPHY
; ^R after deleting one character after wraparound bug...
; UPD ID= 767, SNARK:<5.MONITOR>COMND.MAC.18, 18-Jul-80 21:19:50 by ZIMA
;TCO 5.1104 - fix typo in RETERR at RDTXT1:+12L
; UPD ID= 748, SNARK:<5.MONITOR>COMND.MAC.17, 9-Jul-80 09:41:23 by OSMAN
;tco 5.1101 - Make "MOU TAP FOO:/VOLID:ABC/WE" give correct error
; UPD ID= 742, SNARK:<5.MONITOR>COMND.MAC.15, 8-Jul-80 10:24:56 by MURPHY
;Fix bug: character left on line when deleting over wraparound
; UPD ID= 740, SNARK:<5.MONITOR>COMND.MAC.13, 7-Jul-80 09:05:22 by OSMAN
;tco 5.1094 - Fix "?" in time/date fields
; UPD ID= 714, SNARK:<5.MONITOR>COMND.MAC.12, 30-Jun-80 16:27:10 by MURPHY
;Fix RD%SUI
; UPD ID= 693, SNARK:<5.MONITOR>COMND.MAC.11, 25-Jun-80 08:46:47 by OSMAN
;tco 5.1076 - Make "SYS ABC^V$^V$<cr>" not beep
; UPD ID= 690, SNARK:<5.MONITOR>COMND.MAC.10, 24-Jun-80 13:33:41 by OSMAN
;tco 5.1075 - Make "SET LOC" do "2102" instead of "L2102"
; UPD ID= 674, SNARK:<5.MONITOR>COMND.MAC.9, 18-Jun-80 17:58:45 by OSMAN
;tco 5.1069 - Prevent "?Device is not a terminal"
; UPD ID= 585, SNARK:<5.MONITOR>COMND.MAC.8, 2-Jun-80 13:52:15 by MURPHY
;MAKE ^U HANDLE MULTIPLE WRAPAROUNDS BETTER
; UPD ID= 584, SNARK:<5.MONITOR>COMND.MAC.7, 2-Jun-80 13:03:22 by MURPHY
;Use clear EOL function instead of clear EOS for speed
; UPD ID= 572, SNARK:<5.MONITOR>COMND.MAC.6, 30-May-80 16:36:30 by MURPHY
;Fix cases where initial <esc> would ding instead of using GTJFN defaults
; UPD ID= 506, SNARK:<5.MONITOR>COMND.MAC.5, 5-May-80 10:52:51 by OSMAN
;tco 5.1032 - Don't return <Cr> after date/time in atom buffer
;Make CMRFLN work as its comment says (rather than nth character being
;break character)
;Make COMND jsys faster by using ADJBP instead of calling DBP
; UPD ID= 491, SNARK:<5.MONITOR>COMND.MAC.4, 30-Apr-80 09:33:52 by OSMAN
;<4.1.EXEC>COMND.MAC.9, 30-Apr-80 09:24:10, EDIT BY OSMAN
;tco 5.1027 - Don't say "ambiguous" when keyword or switch omitted entirely
; UPD ID= 474, SNARK:<5.MONITOR>COMND.MAC.3, 24-Apr-80 15:38:41 by OSMAN
;tco 5.1024 - Don't say "?Ambiguous" if switch input is "/A:" and table
;contains "A:" and "AB:"
;<4.1.MONITOR>COMND.MAC.119, 21-Mar-80 14:55:31, EDIT BY OSMAN
;More 4.2463, 4.2382 - Clear atom buffer if slash not seen for switch, so
;"PRINT XYZ" says "file not found" instead of "not a switch..."
; UPD ID= 340, SNARK:<4.1.MONITOR>COMND.MAC.118, 18-Mar-80 09:21:35 by OSMAN
;tco 4.1.1116 - Don't put in space for last linefeed in indirect file
; UPD ID= 326, SNARK:<4.1.MONITOR>COMND.MAC.117, 12-Mar-80 15:10:34 by OSMAN
;More 4.1.1016 - remove code after ITEXTI that checks for break character
; UPD ID= 206, SNARK:<4.1.MONITOR>COMND.MAC.116, 16-Jan-80 16:47:43 by SCHMITT
; Tco 4.1.1069 - Let '+' & '-' char be valid terminators to .CMNUX
; UPD ID= 96, SNARK:<4.1.MONITOR>COMND.MAC.115, 5-Dec-79 11:31:31 by OSMAN
;tco 4.1.1046 - Prevent double beep on "COPY <esc>"
; UPD ID= 42, SNARK:<4.1.MONITOR>COMND.MAC.114, 28-Nov-79 15:15:20 by OSMAN
;Tco 4.1.1034 - Allow "?" in text lines (like MS subject lines and
;^ESEND commands)
;<4.1.MONITOR>COMND.MAC.113, 14-Nov-79 16:17:50, EDIT BY OSMAN
;more 4.2500 - If chain is .CMNUM, .CMKEY with default string "0",
;and input is "b" which matches a keyword, give keyword return instead
;of trying to put in the default number
;<4.1.MONITOR>COMND.MAC.111, 14-Nov-79 10:28:00, EDIT BY OSMAN
;tco 4.1.1019 - Save and restore user's AC4 correctly in .CMTAD
;<4.1.MONITOR>COMND.MAC.110, 13-Nov-79 10:57:49, EDIT BY OSMAN
;TCO 4.1.1016 - Allow formfeed as end-of-line character
;<4.1.MONITOR>COMND.MAC.109, 12-Nov-79 15:50:32, EDIT BY OSMAN
;tco 4.1.1015 - give "does not begin with slash" error appropriately
;more 4.2463 - Give correct error for switch/filespec choice
;<4.MONITOR>COMND.MAC.107, 29-Oct-79 13:44:17, EDIT BY OSMAN
;more 4.2500
;<4.MONITOR>COMND.MAC.106, 22-Oct-79 18:23:02, EDIT BY OSMAN
;more 4.2500 - fix "build<osman>" (without the space!)
;<4.MONITOR>COMND.MAC.105, 18-Oct-79 15:19:53, EDIT BY OSMAN
;TCO 4.2500 - IF .CMUSR FOLLOWED BY .CMDIR IN CHAIN, AND INPUT IS "ME:"
;AND "ME" IS A USER AND "ME:" IS A LOGICAL NAME, RETURN THE LOGICAL NAME
;tco 4.2514 - Turn off ^O before reprompting after help messages
;<4.MONITOR>COMND.MAC.103, 3-Oct-79 12:57:45, EDIT BY ZIMA
;More 4.2493 - move .CMCFM list check to last to allow .CMFIL test to
; occur first for those who depend on it.
;<4.MONITOR>COMND.MAC.102, 27-Sep-79 16:44:23, EDIT BY ZIMA
;More 4.2161 - make ^V-<crlf> not a continuation line
;<4.MONITOR>COMND.MAC.101, 27-Sep-79 15:28:17, EDIT BY ZIMA
;TCO 4.2495 - assure correct error code returned if NOUT fails in CMNUMH.
;<4.MONITOR>COMND.MAC.100, 27-Sep-79 15:10:43, EDIT BY ZIMA
;TCO 4.2494 - Avoid incorrect leading "or" text from DOHLP by setting
; the CMQUE2 flag properly in CMRTYP.
;<4.MONITOR>COMND.MAC.99, 27-Sep-79 15:01:27, EDIT BY ZIMA
;TCO 4.2493 - recognize .CMCFM in the list on initial CRLF at NLINE
;<4.MONITOR>COMND.MAC.98, 13-Sep-79 09:51:09, EDIT BY OSMAN
;tco 4.2463 - Give correct error on "DISMOUNT CURDS:"
;<4.MONITOR>COMND.MAC.97, 13-Aug-79 16:24:30, EDIT BY OSMAN
;More of 4.2382 - First try broke "REWIND" command!!!
;<4.MONITOR>COMND.MAC.96, 10-Aug-79 13:41:10, EDIT BY OSMAN
;tco 4.2382 - Give better error on "TERMINAL TYPE VT06" error
;Say "not a switch or keyword" instead of "First non-space is not a digit"
;<4.MONITOR>COMND.MAC.95, 10-Aug-79 12:41:18, EDIT BY OSMAN
;MAKE THE SOURCE FILE SHORTER
;<4.MONITOR>COMND.MAC.94, 1-Aug-79 16:07:05, EDIT BY OSMAN
;tco 4.2365 - Don't clobber user's AC4 on .CMTAD function
;<4.MONITOR>COMND.MAC.93, 1-Aug-79 15:24:44, EDIT BY OSMAN
;tco 4.2364 - Close indirect file if bombout due to space exhaustion in CMDIBQ
;<4.MONITOR>COMND.MAC.92, 26-Jul-79 08:49:35, EDIT BY OSMAN
;MORE OF 4.2299 - UPDATE FLAG WORD WITH QUOTEF
;<4.MONITOR>COMND.MAC.91, 25-Jul-79 15:24:59, EDIT BY R.ACE
;FIX SETZM IN XCMIFI THAT FAILS IF USER NOT IN SECTION 0
;<4.MONITOR>COMND.MAC.90, 25-Jul-79 08:57:23, EDIT BY SCHMITT
;TCO 4.2341-call long form GTJFN all the time
;<4.MONITOR>COMND.MAC.89, 25-Jul-79 08:55:56, EDIT BY SCHMITT
;TCO 4.2340-allow parse if default name in GTJFN block present
;<4.MONITOR>COMND.MAC.88, 20-Jul-79 09:36:32, EDIT BY OSMAN
;MORE TCO 4.2299 - Use FLG2, DDT was doing ^U wrong
;<4.MONITOR>COMND.MAC.87, 20-Jun-79 16:08:23, EDIT BY OSMAN
;tco 4.2299 - Don't reject CTRL/V if char count is 1
;<4.MONITOR>COMND.MAC.86, 14-Jun-79 15:40:34, EDIT BY OSMAN
;tco 4.2288 Strip ESC after parse-only user name
;<4.MONITOR>COMND.MAC.85, 12-May-79 12:59:38, EDIT BY MILLER
;MORE FIXES
;<4.MONITOR>COMND.MAC.84, 11-May-79 14:34:53, EDIT BY MILLER
;<4.MONITOR>COMND.MAC.83, 11-May-79 14:25:56, EDIT BY MILLER
;MAKE DPCTL APPLY PARITY BIT IF NECESSARY
;<4.MONITOR>COMND.MAC.82, 27-Apr-79 17:05:12, EDIT BY OSMAN
;MAKE QUOTED CHARACTER (CTRL/V PRECEDES IT) NEVER BE A BREAK CHARACTER
;<4.MONITOR>COMND.MAC.81, 13-Apr-79 10:26:12, EDIT BY OSMAN
;USE SPECIAL MASK FOR ACCOUNT STRINGS
;<4.MONITOR>COMND.MAC.80, 13-Apr-79 10:06:44, EDIT BY OSMAN
;HONOR CM%BRK FOR .CMTXT AND NOT FOR .CMNOD
;<4.MONITOR>COMND.MAC.79, 4-Apr-79 09:51:44, EDIT BY OSMAN
;more of 4.2227
;<4.MONITOR>COMND.MAC.77, 30-Mar-79 15:36:27, EDIT BY OSMAN
;tco 4.2230 - Fix "!!OPR" to exec. (Comments on filespecs failed)
;<4.MONITOR>COMND.MAC.76, 29-Mar-79 13:25:01, EDIT BY OSMAN
;tco 4.2228 - Make CTRL/H work after "SUBMIT /DEP:-15<esc>" (it was causing a second error!)
;<4.MONITOR>COMND.MAC.75, 28-Mar-79 16:50:59, EDIT BY OSMAN
;tco 4.2227 - reparse more often
;<4.MONITOR>COMND.MAC.74, 27-Mar-79 17:23:11, EDIT BY OSMAN
;FIX "OPR> SHOW STATUS P?" WHICH WAS GIVING ERROR
;<4.MONITOR>COMND.MAC.73, 21-Mar-79 11:05:37, EDIT BY OSMAN
;tco 4.2221 - Prevent cr after filespec in atom buffer
;<4.MONITOR>COMND.MAC.72, 16-Mar-79 16:56:09, EDIT BY OSMAN
;CLEAR ATOM BUFFER IF .CMCFM FAILS, SO BETTER ERROR CHOICE RESULTS
;<4.MONITOR>COMND.MAC.71, 12-Mar-79 09:48:39, EDIT BY OSMAN
;TCO 4.2213 - CHeck for null device name and return DEVX7
;<4.MONITOR>COMND.MAC.69, 4-Mar-79 14:46:31, Edit by KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.MONITOR>COMND.MAC.68, 1-Mar-79 09:14:27, EDIT BY OSMAN
;Before reading next character in TEXTI, deposit a null at end of buffer
;<4.MONITOR>COMND.MAC.67, 21-Feb-79 10:36:54, EDIT BY OSMAN
;FIX SUFFIX CODE IN CMRFL0 (BROKE WHILE PUTTING IN COLON STUFF)
;<4.MONITOR>COMND.MAC.66, 20-Feb-79 13:39:26, EDIT BY OSMAN
;turn on colons after node names
;FIX SWITCH DEFAULTING
;<4.MONITOR>COMND.MAC.64, 14-Feb-79 16:32:35, EDIT BY OSMAN
;CALL CHKBLP AT DELIN3 INSTEAD OF WITHIN DELIN LOOP (SO ^U CAUSES RD%BEG TO
;WIN EVEN IF NO INPUT BEFORE THE ^U
;<4.MONITOR>COMND.MAC.63, 14-Feb-79 09:55:08, EDIT BY OSMAN
;TCO 4.2188 - REQUIRE DOUBLE COLONS ON NODE NAMES
;<4.MONITOR>COMND.MAC.62, 29-Jan-79 09:19:13, EDIT BY OSMAN
;demand that node exist for .CMNOD unless CM%PO on
;<4.MONITOR>COMND.MAC.61, 16-Jan-79 17:07:16, EDIT BY OSMAN
;tco 4.2165 - Give VACCX1 if account string too long
;<4.MONITOR>COMND.MAC.60, 13-Jan-79 18:14:39, EDIT BY ZIMA
;TCO 4.2161 - IMPROVE HANDLING OF CONTINUATION LINES AT CMCIN
;<4.MONITOR>COMND.MAC.59, 9-Jan-79 17:23:27, EDIT BY DBELL
;TCO 4.2158 - MAKE .CMUQS FUNCTION WORK PROPERLY IF BREAK MASK INCLUDES
;THE SPECIAL EDITING CHARACTERS ("?", ALTMODE, CONTROL-F).
;<4.MONITOR>COMND.MAC.58, 3-Jan-79 17:53:55, EDIT BY DBELL
;TCO 4.2147 - MAKE ALTMODES AND ^F'S WORK PROPERLY IN QUOTED STRINGS
;<4.MONITOR>COMND.MAC.57, 27-Dec-78 15:14:47, EDIT BY BERKOWITZ
;TCO 4.2134 - Do not Type "one of the following" on help if only 1 element
; in the switch or keyord table
;<4.MONITOR>COMND.MAC.55, 20-Dec-78 16:56:29, EDIT BY OSMAN
;tco 4.2128 - Get rid of escape and put in space if ESC typed on indirect filespec
;<4.MONITOR>COMND.MAC.54, 20-Dec-78 16:03:39, EDIT BY OSMAN
;tco 4.2126 - indirect files, indirect file errors, best error code
;<4.MONITOR>COMND.MAC.53, 15-Dec-78 16:52:28, EDIT BY OSMAN
;tco 4.2122 - Guarantee that the BIN reading the CTRL/H wakes up on it.
;MAKE ^R CAUSE RETURN IF RD%BEG IS ON (CALL CHKBLP AT RTYPE)
;<4.MONITOR>COMND.MAC.52, 7-Dec-78 16:18:58, EDIT BY OSMAN
;tco 4.2112 - Make comments before guidewords work right.
;<4.MONITOR>COMND.MAC.51, 16-Nov-78 10:45:02, EDIT BY DBELL
;TCO 4.2089 - FIX FNDLIN SO ^G^G^U DOESN'T MOVE CURSOR UP A LINE
;<4.MONITOR>COMND.MAC.50, 4-Nov-78 02:09:47, EDIT BY OSMAN
;tcO 4.2078 - make TBADD understand flags in table entry
;<4.MONITOR>COMND.MAC.49, 30-Oct-78 16:57:47, EDIT BY OSMAN
;TCO 4.2074 - ALLOW $ AND _ IN DEVICE NAMES
;<4.MONITOR>COMND.MAC.47, 27-Oct-78 17:33:17, EDIT BY OSMAN
;MAKE PARNDU RETURN LENGTH IN A
;<4.MONITOR>COMND.MAC.37, 24-Oct-78 17:41:45, EDIT BY OSMAN
;ADD PARNDU
;<4.MONITOR>COMND.MAC.36, 18-Oct-78 13:09:51, EDIT BY OSMAN
;<4.MONITOR>COMND.MAC.35, 17-Oct-78 11:27:45, EDIT BY OSMAN
;<4.MONITOR>COMND.MAC.34, 16-Oct-78 17:47:17, EDIT BY OSMAN
;TCO 4.2046 - ADD RD%BEG
;<4.MONITOR>COMND.MAC.33, 30-Sep-78 20:55:38, EDIT BY DBELL
;TCO 4.2027 - CHECK FOR ^Z ON INDIRECT FILES FOR TERMINALS
;<4.MONITOR>COMND.MAC.32, 28-Sep-78 15:07:43, EDIT BY DBELL
;TCO 4.2026 - IGNORE NULLS READ FROM AN INDIRECT FILE
;<4.MONITOR>COMND.MAC.31, 22-Sep-78 13:18:27, EDIT BY OSMAN
;tco 4.2019 - Beep instead of error if ESC typed at beginning of quoted string
;<4.MONITOR>COMND.MAC.30, 21-Sep-78 11:04:26, EDIT BY KIRSCHEN
;<4.MONITOR>COMND.MAC.29, 21-Sep-78 11:03:32, EDIT BY KIRSCHEN
;<4.MONITOR>COMND.MAC.28, 19-Sep-78 15:40:02, EDIT BY KIRSCHEN
;DISALLOW NULL NODE NAMES
;<4.MONITOR>COMND.MAC.27, 12-Sep-78 17:07:29, EDIT BY OSMAN
;FIX BREAK SET LOOKUP CODE
;<4.MONITOR>COMND.MAC.25, 6-Sep-78 17:17:00, EDIT BY OSMAN
;CHANGED NAMES OF BREAK MASKS IN MONSYM (TO HAVE DOTS IN NAMES)
;<4.MONITOR>NCOMND.MAC.1, 3-Sep-78 12:01:21, EDIT BY OSMAN
;ALLOW CUSTOM BREAK MASKS
;<4.MONITOR>COMND.MAC.23, 18-Aug-78 13:14:37, EDIT BY OSMAN
;PUT SQUARE BRACKETS BACK INTO FILESPEC BREAK SET
;<4.MONITOR>COMND.MAC.22, 11-Aug-78 09:11:26, EDIT BY OSMAN
;WHEN MOVING CURSOR UP ON SCREENS, DECREMENT LINE COUNTER (.MOSLC)
;<HEMPHILL.EXEC>COMND.MAC.3, 7-Aug-78 12:53:49, Edit by HEMPHILL
;TCO 1975 -- MAKE ESCAPE AFTER TOKEN WORK
;<HEMPHILL.EXEC>COMND.MAC.2, 7-Aug-78 12:48:19, Edit by HEMPHILL
;TCO 1974 -- MAKE ESCAPE AFTER COLON IN DEVICE NAMES WORK
;<OSMAN>COMND.MAC.4, 7-Aug-78 09:30:24, EDIT BY OSMAN
;MAKE SO ^R DOESN'T GO UP SCREENS MORE THAN IT SHOULD.
;<OSMAN>COMND.MAC.2, 7-Aug-78 08:59:17, EDIT BY OSMAN
;RESTORE TEXTI TO ALWAYS PERFORM ^U ^R ETC. REGARDLESS OF USER'S BREAK MASK
;<4.EXEC>COMND.MAC.4, 4-Aug-78 15:11:32, EDIT BY OSMAN
;MAKE TEXTI ONLY WAKE ON ITS EDITING CHARACTERS, RATHER THAN ALL CONTROL CHARACTERS
;<4.EXEC>1COMND.MAC.3, 4-Aug-78 14:49:44, EDIT BY OSMAN
;PREVENT TEXTI FROM WAKING ON EVERYTHING AFTER EXECUTING ^W ON SCREENS
;<OSMAN>COMND.MAC.1, 3-Aug-78 20:42:05, EDIT BY OSMAN
;MAKE COMND ONLY WAKE ON ^F $ ? LF
;<4.MONITOR>COMND.MAC.18, 3-Aug-78 11:01:08, EDIT BY R.ACE
;TCO #1966 - FIX BUG IF NODE NAME FIELD TERMINATED WITH ALTMODE
;<4.MONITOR>COMND.MAC.17, 27-Jul-78 15:31:20, EDIT BY OSMAN
;TCO #1960 - ALLOW CM%PO ON .CMDEV FUNCTION
;FIX INPUT OF NEGATIVE NUMBERS (BROKE IN CONJUNCTION WITH "-" STUFF
;WHEN CRLF LOGIC FIXED)
;<3A.MONITOR>COMND.MAC.11, 20-Jun-78 16:29:47, EDIT BY OSMAN
;FIX THE CRLF LOGIC
;<4.MONITOR>COMND.MAC.13, 2-Jun-78 15:26:10, EDIT BY R.ACE
;TCO #1918 - MAKE CTRL/W TREAT CRLF AS A PUNCTUATION CHARACTER
;TCO #1917 - CHANGE ERROR CODE RETURNED BY TEXTI WHEN ARG BLK TOO SHORT
;<OSMAN>COMND.MAC.1, 30-May-78 13:29:59, EDIT BY OSMAN
;PUT CRLF IN COMND BUFFER INSTEAD OF JUST LF
;<OSMAN>3ANEW.MAC.7, 12-Apr-78 17:16:19, Edit by OSMAN
;<4.MONITOR>COMND.MAC.11, 25-Apr-78 10:47:29, EDIT BY OSMAN
;IN .CMFIL FUNCTION, MAKE SURE GJ%CFM IS OFF IN GTJFN BLOCK
;<OSMAN>4MNEW.MAC.5, 12-Apr-78 17:17:07, Edit by OSMAN
;<OSMAN>NEWCOM.MAC.3, 12-Apr-78 11:33:21, EDIT BY OSMAN
;IF LINE WRAPS AND USER TYPES EOL AND RUBS IT OUT, MAKE REPAINT OVERPRINT ORIGINAL LINE
;<4.MONITOR>COMND.MAC.9, 10-Apr-78 15:27:33, EDIT BY OSMAN
;MAKE SURE NULL AT END OF COMMAND IN CMGJ1 LOOP
;<4.MONITOR>COMND.MAC.8, 28-Mar-78 16:39:16, EDIT BY OSMAN
;ON SCREEN, PREVENT REPAINT OF LINE WHEN DELETING TAB AS FIRST CHAR OF SUBSEQUENT LINE
;<OSMAN>NEW4M.MAC.3, 17-Mar-78 16:18:42, Edit by OSMAN
;<OSMAN>NEW4M.MAC.2, 17-Mar-78 15:55:01, Edit by OSMAN
;<OSMAN>COMND.MAC.18, 17-Mar-78 15:22:59, Edit by OSMAN
;<OSMAN>COMND.MAC.17, 17-Mar-78 15:21:08, Edit by OSMAN
;<OSMAN>COMND.MAC.16, 17-Mar-78 15:05:03, Edit by OSMAN
;<OSMAN>COMND.MAC.15, 17-Mar-78 14:57:31, Edit by OSMAN
;<OSMAN>COMND.MAC.14, 17-Mar-78 14:52:05, Edit by OSMAN
;make so no repainting happens on deleting tabs
;<OSMAN>COMND.MAC.13, 17-Mar-78 11:28:35, Edit by OSMAN
;<OSMAN>COMND.MAC.12, 17-Mar-78 10:56:46, Edit by OSMAN
;<OSMAN>COMND.MAC.11, 17-Mar-78 10:47:58, Edit by OSMAN
;DON'T REPAINT WHEN ERASING LAST CHAR ON LINE
;<OSMAN>COMND.MAC.10, 16-Mar-78 17:02:22, Edit by OSMAN
;DON'T CLEAR TO END OF PAGE AFTER ^W, ONLY DURING IF NECESSARY
;<OSMAN>COMND.MAC.4, 16-Mar-78 11:19:57, Edit by OSMAN
;<OSMAN>COMND.MAC.3, 16-Mar-78 10:59:32, Edit by OSMAN
;<OSMAN>COMND.MAC.2, 15-Mar-78 16:24:29, Edit by OSMAN
;CAUSE LESS REPAINTING BY NOT DOING SO ON $ FOR ALTMODE OR FLAGGED CHARACTERS OR UPARROWED CONTROLS
;<OSMAN>COMND.MAC.1, 15-Mar-78 15:22:08, Edit by OSMAN
;<4.MONITOR>COMND.MAC.6, 9-Mar-78 09:35:42, Edit by ENGEL
;ADD SUPPORT FOR THE FULL 128-CHARACTER WAKE UP MASK
;<4.MONITOR>COMND.MAC.5, 31-Jan-78 11:20:43, Edit by ENGEL
;TCO #1881 - CHANGE VERTICAL TAB FROM PUNCTUATION TO TOPS-10 WAKE-UP CLASS
;<4.MONITOR>COMND.MAC.4, 10-Jan-78 10:46:00, EDIT BY HELLIWELL
;CHECK FOR NULL OR MISSING DEFAULT POINTER WHEN CM%DPP SET AND IGNORE
;<4.MONITOR>COMND.MAC.3, 9-Jan-78 15:57:57, EDIT BY OSMAN
;DON'T WRITE NULL IN CMDIB (TOO INEFFICIENT). INSTEAD, CALLER SHOULD DO IT AT END OF STRING
;<4.MONITOR>COMND.MAC.2, 4-Jan-78 14:40:27, EDIT BY OSMAN
;<3.SM10-RELEASE-3>COMND.MAC.2, 4-Jan-78 14:40:09, EDIT BY OSMAN
;REPREVENT TRAILING SPACE FROM APPEARING ON EXEC COMMANDS LIKE "PRINT /LIM$" AFTER THE ":" (DON'T ASSUME CMDIB PRESERVES T1!)
;<4.MONITOR>COMND.MAC.1, 18-Dec-77 16:46:35, EDIT BY OSMAN
;PREVENT UNEXPECTED "?GENERATION NUMBER IS NOT NUMERIC" WHEN
;LPT: HAS BEEN DEFINED AS DSK: AND THEN "LIST SNARK:[HALL]FOO.BAR<CR>
;LIST $" IS TYPED TO THE DUMPER PROGRAM (DEPOSIT NULL AFTER CHAR IN CMDIBQ)
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978,1979 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
SEARCH PROLOG
TTITLE COMND
SWAPCD
;THIS FILE CONTAINS THE COMMAND AND TEXT INPUT SYSTEM, I.E.
;COMND, TBLUK, AND TEXTI. THESE ARE EFFECTIVELY LIBRARY
;ROUTINES BUT ARE IN THE MONITOR FOR CONVENIENT ACCESS.
;NO SPECIAL AC DEFINITIONS ARE USED HEREIN.
;THE COMMAND SCANNER JSYS. THIS ATTEMPTS TO PARSE THE NEXT FIELD
;OF AN INPUT COMMAND LINE. IT READS ADDITIONAL INPUT IF NECESSARY,
;AND ATTEMPTS TO RECOGNIZE THE FIELD SPECIFIED BY 'FN'.
; T1/ PTR TO COMND STATE BLOCK
; T2/ PTR TO LIST OF FUNCTION DESCRIPTOR BLOCKS
; COMND
; RETURNS +1 ALWAYS,
; T1/ FLAGS,,BLK PTR
; T2/ FUNCTION-SPECIFIC RESULT
; T3/ PTR TO FN BLOCK USED IF SUCCESSFUL PARSE
; QUANTITIES UPDATED IN STATE BLOCK. IF INPUT COULD NOT BE PARSED,
; CM%NOP IS SET AND THE CURRENT POINTER POINTS TO THE UNPARSED INPUT.
;FORMAT OF COMND STATE BLOCK:
.CMFLG==:0 ;USER FLAGS,,REPARSE DISPATCH ADDRESS
.CMIOJ==:1 ;INJFN,,OUTJFN
.CMRTY==:2 ;^R BUFFER POINTER
.CMBFP==:3 ;PTR TO TOP OF BUFFER
.CMPTR==:4 ;PTR TO NEXT INPUT TO BE PARSED
.CMCNT==:5 ;COUNT OF SPACE LEFT IN BUFFER AFTER PTR
.CMINC==:6 ;COUNT OF CHARACTERS FOLLOWING PTR
.CMABP==:7 ;ATOM BUFFER POINTER
.CMABC==:10 ;ATOM BUFFER SIZE
.CMGJB==:11 ;ADR OF GTJFN ARG BLOCK
CM%GJB==:777777 ;ADR OF GTJFN ARG BLOCK
;FUNCTION DESCRIPTOR BLOCK
.CMFNP==:0 ;FUNCTION AND POINTER
CM%FNC==:777B8 ;FUNCTION CODE
CM%FFL==:777B17 ;FUNCTION-SPECIFIC FLAGS
CM%LST==:777777 ;LIST POINTER
.CMDAT==:1 ;DATA FOR FUNCTION
.CMHLP==:2 ;HELP TEXT POINTER
.CMDEF==:3 ;DEFAULT STRING POINTER
;FLAGS
CM%ESC==:1B0 ;ESC SEEN
CM%NOP==:1B1 ;NO PARSE
CM%EOC==:1B2 ;END OF COMMAND SEEN
CM%RPT==:1B3 ;REPEAT PARSE NEEDED
CM%SWT==:1B4 ;SWITCH TERMINATED WITH ":"
CM%PFE==:1B5 ;PREVIOUS FIELD ENDED WITH ESC
CM%RAI==:1B6 ;RAISE INPUT
CM%XIF==:1B7 ;NO INDIRECT FILES
CM%WKF==:1B8 ;WAKEUP AFTER EACH FIELD
;**;[3067] Add the [3043] comment JMP 5-JAN-84
;**;[3043] Add 1 line JMP 10-NOV-83
CM%NOC==:1B11 ;SEMI COLON DOES NOT START COMMENT
;CM%NSF==:1B12 ;THE SUFFIX IS NOT NEEDED (BUT LEGAL IF THERE)
;CM%BRK==:1B13 ;BREAK SET IS SUPPLIED
;CM%PO ==:1B14 ;PARSE-ONLY - DON'T VERIFY
CM%HPP==:1B15 ;HELP PTR PRESENT
CM%DPP==:1B16 ;DEFAULT PTR PRESENT
CM%SDH==:1B17 ;SUPPRESS DEFAULT HELP MESSAGE
;FLAGS FOR CMTAD FUNCTION
CM%IDA==:1B0 ;INPUT DATE
CM%ITM==:1B1 ;INPUT TIME
CM%NCI==:1B2 ;NO CONVERT TO INTERNAL FORMAT
;FLAGS IN KEYWORD TABLE (FIRST WORD OF STRING IF B0-6 = 0)
CM%INV==:1B35 ;INVISIBLE
CM%NOR==:1B34 ;NO-RECOGNIZE (PLACE HOLDER)
CM%ABR==:1B33 ;ABBREVIATION
CM%FW==:1B7 ;FLAG WORD (ALWAYS SET)
;LOCAL MACRO FOR NOPARSE RETURNS
DEFINE NOPARS (CODE)<
MOVEI T1,CODE
CALL XCOMNE ;;"CALL" INSTEAD OF "JRST" TO HELP DEBUGGING
>
;BIT DEFENITIONS FOR THE TEXTI BREAK SETS
CM%CZE==0,,001400 ;CTRL/Z ESC
CM%TOP==2360,,001400 ;TOPS-10 CODES
CM%PU0==375417,,306360 ;TEXTI PUNCTUATION WORD 0
CM%PU1==777774,,001760 ; WORD 1
CM%PU2==400000,,000760 ; WORD 2
CM%PU3==400000,,00740 ; WORD 3
CM%BEL==220,,0 ;CARRIAGE RETURN, LINE FEED
;LOCAL FLAGS (RH OF F)
CMQUES==1B18 ;? TYPED
CMSWF==1B19 ;BEG OF SWITCH SEEN
CMUSRF==1B20 ;USER NAME REQUIRED
CMDEFF==1B21 ;DEFAULT FIELD GIVEN
CMCFF==1B22 ;^F RECOGNIZED FIELD
CMQUE2==1B23 ;IN SECOND OR SUBSEQUENT HELP POSSIBILITY
CMBOL==1B24 ;FIELD IS AT BEG OF LINE
CMTF1==1B25 ;INTERNAL TEMP FLAG
CMINDF==1B26 ;DOING GTJFN ON INDIRECT FILE
CMINDT==1B27 ;INDIRECT FILE IS A TERMINAL
CMCLCV==1B28 ;LAST CHARACTER WAS ^V (UNLESS ^V^V) FOR CMCIN
CMPS1F==1B29 ;PASS1 (FIND LONGEST STRING)
CMPS2F==1B30 ;PASS2 (REJECT FUNCTIONS NOT YIELDING LONGEST STRING)
CMQCAN==1B31 ;HELP CANDIDATE
CMILLF==1B32 ;LINEFEED LAST FLAG DURING INDIRECT
;FLAGS IN FUNCTION DISPATCH TABLE
;NOTE: ONLY THE LEFT HALF IS AVAILABLE
CMNOD==1B0 ;NO DEFAULT POSSIBLE
CMSBF==1B1 ;SPECIAL BREAK MASK ALLOWED
CMNP1==1B2 ;NO PASS ONE FOR THIS FUNCTION FLAG
NOIBCH=="(" ;NOISE WORD BEG CHARACTER
NOIECH==")" ;NOISE WORD END CHARACTER
CMSWCH=="/" ;SWITCH CHARACTER
CMSWTM==":" ;SWITCH TERMINATOR
CMHLPC=="?" ;HELP CHARACTER
CMCOM1=="!" ;COMMENT CHARACTER
CMCOM2==";" ;FULL LINE COMMENT CHARACTER
CMDEFC=="#" ;DEFAULT FIELD CHARACTER
CMFREC=="F"-100 ;FIELD RECOGNITION CHARACTER
CMINDC=="@" ;INDIRECT FILE CHARACTER
CMRDOC=="H"-100 ;REDO COMMAND CHARACTER
CMQTCH=="""" ;CHARACTER FOR QUOTED STRINGS
CMCONC=="-" ;LINE CONTINUATION CHARACTER
CMQUOT=="V"-100 ;CHARACTER TO QUOTE NEXT CHARACTER
;LOCAL AC USAGE
; F/ FLAGS
; P1/ ORIGINAL,,CURRENT POINTER TO FUNCTION DESCRIPTOR BLOCK
; P2/ POINTER TO STATE BLOCK (T1 OF CALL)
; P3/ REMAINING FREE SPACE COUNT OF USER'S BUFFER
; P4/ CURRENT POINTER
; P5/ COUNT OF VALID CHARACTERS FOLLOWING CURRENT POINTER
; P6/ TRVAR
.COMND::MCENT
CALL XCOMND ;DO THE WORK
XCTU [HRRZ T4,.CMFLG(P2)] ;GET REPARSE DISPATCH ADDRESS IF ANY
JUMPE T4,COMN1
TXNE F,CM%RPT ;REPARSE NEEDED?
HRRM T4,-1(P) ;YES, EFFECT TRANSFER
COMN1: MRETNG
;**;[3009] Modify 1L at XCOMND+0L YKT SEP-06-83
XCOMND::TRVAR <TDSAV4,EXPLEN,XTRALN,PRECHR,PREERR,FSLEN,BSTLEN,BSTERR,<CNODE,WPN>,<SPCMSK,4>,ATBPTR,ATBSIZ,STKFEN,FNARG,<CMCCM,2>,PWIDTH,TABSIZ,DATPT,TABDON,CURSOR,CURPOS,KEYSIZ,BIGSIZ,RCFLGS,CMRBRK,SUFPTR,SUFPT0,ATBSUF,INDFLG> ;[3009]
;...
;NOTE: THE REASON THIS LIST IS SO LONG IS THAT MANY OF THESE VARIABLES COULD
;APPROPRIATELY BE STKVARED IN LOCAL ROUTINES USED WITHIN XCOMND. HOWEVER, EACH
;STKVAR CALL TAKES TWO EXTRA MEMORY WORDS, SO THIS SINGLE TRVAR SEEMS
;LIKE A GOOD WAY TO DO IT.
;TDSAV4 - SAVED USER'S AC4 DURING TIME/DATE PARSING
;EXPLEN - EXPECTED LENGTH OF INPUT
;XTRALN - EXTRA LENGTH, LIKE 1 FOR COLON IN DEVICES
; OR 2 FOR DOUBLE COLON ON NODE NAMES
;PRECHR - PREFIX CHARACTER FOR CMRFLD
;PREERR - ERROR CODE FOR CMRFLD
;FSLEN - FILESPEC LENGTH
;BSTLEN - LONGEST ATOM BUFFER THAT HAS FAILED
;BSTERR - ERROR CODE ASSOCIATED WITH BSTLEN
;CNODE - NODE NAME IN ASCII
;SPCMSK - CUSTOM USER BREAK MASK FOR FIELD
;ATBPTR - ATOM BUFFER POINTER
;ATBSIZ - ATOM BUFFER SIZE
;STKFEN - STACK FENCE
;FNARG - DATA FOR FUNCTION
;CMCCM - SAVED CC MODE WORDS
;PWIDTH - TERMINAL WIDTH
;TABSIZ - TAB SIZE LARGER THAN LARGEST KEYWORD
;DATPT - POINTER USED DURING CMTAD
;TABDON - END OF TAB FOR "?" ON KEYWORD
;CURSOR - LINE POSITION (KEYWORD "?")
;CURPOS - " " "
;KEYSIZ - KEYWORD LENGTH ("?")
;BIGSIZ - LENGTH OF LONGEST KEYWORD
;RCFLGS - RCDIR/RCUSR RETURNED FLAGS
;CMRBRK - BREAK CONTROL FOR FIELD ROUTINE
;SUFPTR - POINTER TO SUFFIX STRING
;SUFPT0 - POINTER TO BEGINNING OF SUFFIX STRING
;ATBSUF - POINTER TO WHERE SUFFIX BEGINS IN
; ATOM BUFFER
;**;[3009] Add 1 line at XCOMND+2L YKT SEP-06-83
SETZM INDFLG ;[3009]
MOVEM T1,P2 ;SAVE BLOCK PTR
HRL P1,T2 ;KEEP BEGINNING OF FUNCTION CHAIN IN P1
MOVEM P,STKFEN ;SAVE CURRENT STACK AS FENCE
MOVEI T1,[COMX11,,.CMRTY ;LIST OF BYTE POINTERS TO CHECK
COMX12,,.CMBFP
COMX13,,.CMPTR
COMX14,,.CMABP
0] ;MARK OF END OF LIST
CALL CHKABP ;CHECK ALL BYTE PTRS
UMOVE P3,.CMCNT(P2) ;SET UP ACTIVE VARIABLES
UMOVE P4,.CMPTR(P2)
UMOVE P5,.CMINC(P2)
XCTU [HLLZ F,.CMFLG(P2)] ;GET 'GIVEN' FLAGS
TXZ F,CM%PFE!CMPS2F
TXZE F,CM%ESC ;PREVIOUS FIELD HAD ESC?
TXO F,CM%PFE ;YES
XCTU [HRRZ T1,.CMIOJ(P2)] ;GET OUTPUT JFN
RFCOC ;GET CC MODES
DMOVEM T2,CMCCM ;SAVE THEM
TXZ T2,3B<CMFREC*2+1> ;NO ECHO ^F
TXO T2,3B<.CHLFD*2+1> ;PROPER HANDLING OF NL
TXZ T3,3B<.CHESC*2+1-^D36> ;SET ESC TO NO ECHO
SFCOC
XCOMB0: SETZM EXPLEN ;CLEAR EXPECTED LENGTH OF FIELD
TXO F,CMPS1F ;MARK THAT WE'RE IN PASS 1
XCOMB: SETOM BSTLEN ;-1 IS SMALLER THAN ANY ATOM BUFFER SIZE
SETZM BSTERR ;SAY ONLY LENGTH ERRORS SEEN SO FAR
HLR P1,P1 ;START AT BEGINNING OF FUNCTION CHAIN
; ..
; ..
XCOMN0: MOVE P,STKFEN ;NORMALIZE STACK IN CASE ABORTED ROUTINES
SETZM XTRALN ;NO EXTRA LENGTH YET
TXZ F,CM%ESC+CM%NOP+CM%EOC+CM%RPT+CM%SWT+CMBOL+CMCFF+CMDEFF+CMINDF+CMCLCV ;INIT FLAGS
XCTU [CAMN P4,.CMBFP(P2)] ;AT BEG OF LINE?
TXO F,CMBOL ;YES
XCOM5: HRRZ T1,P1 ;GET ADDRESS ONLY
ULOAD T1,CM%FFL,.CMFNP(T1) ;GET FUNCTION FLAGS
STOR T1,CM%FFL,F ;KEEP WITH OTHER FLAGS
HLRZ Q1,P1 ;GET CM%DPP FLAG FROM FIRST BLOCK ONLY
XCTU [XOR F,.CMFNP(Q1)]
TXZ F,CM%DPP
XCTU [XOR F,.CMFNP(Q1)]
TXNN F,CM%BRK ;IS THERE SPECIAL BREAK MASK?
JRST XCOM6 ;NO
HRRZ T1,P1 ;GET ADDRESS OF CURRENT FUNCTION BLOCK
XCTU [MOVE T4,.CMBRK(T1)] ;YES, GET USER ADDRESS OF IT
XCTU [DMOVE T1,(T4)] ;GET FIRST TWO WORDS
XCTU [DMOVE T3,2(T4)] ;GET REST
DMOVEM T1,SPCMSK ;SAVE FIRST TWO WORDS
DMOVEM T3,2+SPCMSK ;AND REST
XCOM6: TXNN F,CM%DPP ;IS HE SUPPLYING DEFAULT STRING?
JRST XCOM5A ;NO, NO CHECK
UMOVE T1,.CMDEF(Q1) ;GET DEFAULT POINTER
CALL CHKBP ;CHECK IT FOR LEGALITY
CAIA ;ILLEGAL, SKIP ILDB (0 POINTER = NULL STRING)
XCTBU [ILDB T1,T1] ;GET FIRST BYTE OF STRING
SKIPN T1 ;NON-ZERO?
TXZ F,CM%DPP ;NO, MAKE BELIEVE NO DEFAULT GIVEN
XCOM5A: HRRZ T1,P1
UMOVE T1,.CMDAT(T1) ;GET FUNCTION DATA IF ANY
MOVEM T1,FNARG ;KEEP LOCALLY
CALL GETFUN ;GET FUNCTION CODE
CAIL T1,0 ;VALIDATE FN CODE
CAIL T1,MAXCFN
ITERR COMNX1
HLRZ T1,CFNTAB(T1) ;GET TABLE POINTER FOR IT
MOVE T1,COBFGS(T1) ;GET FLAG WORD
JXN T1,CMNOD,XCOM0 ;DISPATCH NOW IF NO DEFAULT POSSIBLE
TXNE F,CM%PFE ;PREVIOUS FIELD ENDED WITH ESCAPE?
JRST [ CALL GETFUN ;YES, SEE IF GUIDEWORD FUNCTION
CAIN T1,.CMNOI ;IS IT?
JRST XCOM8 ;YES, SO GO TYPE GUIDE WORDS, NO POSSIBLE COMMENT, LINE CONTINUATION ETC.
JRST .+1] ;NOT GUIDE WORD FUNCTION
CALL INILCH ;SKIP SPACES AND INIT ATOM BUFFER
NLINE: CALL RDCRLF ;END-OF-LINE FIRST THING ON IT?
CAIA ;NO
JRST [ TXNE F,CMPS1F ;JUST SCANNING?
JRST .+1 ;YES, SO CR NOT SPECIAL
CALL UNCRLF ;YES, PUT IT BACK
CALL GETFUN ;OBTAIN THE FUNCTION CODE
CAIN T1,.CMCFM ;CONFIRM FIRST? (TEST REST BEFORE REPROMPT)
JRST XCOM0 ;YES, DO IT
TXNN F,CM%DPP ;IF DEFAULT GIVEN, USE IT ON CR
TXNN F,CMBOL ;AT BGN OF BFR?
JRST XCOM0 ;NO, TRY NULL FIELD
CAIN T1,.CMFIL ;PARSE ARBITRARY FILE?
JRST CHKDEF ;YES, CHECK GTJFN BLOCK FOR DEFAULT NAME
CAIN T1,.CMNOI ;NO, PARSING A NOISE WORD?
JRST XCOM0 ;YES, DO IT
CALL CHKCFM ;NO, SEE IF THERE IS A CONFIRM IN THE LIST
JRST CHKDF1 ;NONE, REISSUE PROMPT
JRST XCOM0] ;YES, PROCESS IT
CAIN T1,CMINDC ;INDIRECT INDICATOR?
JRST [ TXNN F,CM%XIF ;YES, INDIRECT FILES ALLOWED?
JRST CMIND ;YES, DO IT
JRST .+1] ;NO, KEEP CHARACTER AS ORDINARY INPUT
CAIE T1,.CHESC ;ESC AT BEG OF FIELD?
CAIN T1,CMFREC
JRST XCOM2 ;^F AT BEG OF FIELD
; CAIN T1,CMDEFC ;OR DEFAULT REQUEST?
; JRST XCOM2 ;YES
XCOM3: CALL CMDIP ;PUT CHAR BACK
XCOM0: CALL GETFUN ;GET FUNCTION CODE
XCOM7: TXNN F,CMPS1F ;ARE WE ON PASS1?
JRST XCOM8 ;NO
HLRZ T2,CFNTAB(T1) ;YES, GET ADDRESS OF CONTROL WORD
MOVE T1,COBFGS(T2) ;GET SPECIAL FUNCTION FLAGS
TXNE T1,CMNP1 ;SHOULD WE PERFORM A PASS 1?
;*NOTE* Some functions should not be included
;in pass 1 because they will end up reading
;the whole line and as a result, will be the
;the only function which will get parsed due
;to the number of characters it has read.
;The check that used to be here tested whether
;the function had a break mask and would not
;perform pass1 if it did not. We don't want
;pass 1 performed on .CMTXT but it does have
;a break mask so previous check was inadequate.
JRST XC1 ;NO, FORGET THIS FUNCTION
CALL CMRFLD ;SEE HOW MUCH INPUT THIS FUNCTION WOULD READ
XCOM9: CAML T1,EXPLEN ;BETTER THAN ANY EXPECTED LENGTH SEEN SO FAR?
MOVEM T1,EXPLEN ;YES, REMEMBER NEW LONG LENGTH
JRST XC1 ;SIZE UP REST OF FUNCTIONS
XCOM8: HRRZ T1,CFNTAB(T1) ;DO IT
JRST 0(T1)
CHKDEF: UMOVE T3,.CMGJB(P2) ;GET GTJFN BLOCK ADDRESS
UMOVE T3,.GJNAM(T3) ;GET DEFAULT NAME STRING POINTER
JUMPN T3,XCOM0 ;IF ONE THERE, PARSE IT
CHKDF1: CALL CMRSET ;NO,
SETZ P5, ;EMPTY LINE, IGNORE
CALL CMRTY0 ;REDO PROMPT
JRST XCOMB0 ;RESET PASS1 AND TRY NEXT LINE
;ROUTINE TO GET FUNCTION CODE INTO T1.
GETFUN: HRRZ T1,P1
ULOAD T1,CM%FNC,.CMFNP(T1) ;GET FUNCTION CODE
RET
;CHKCFM - ROUTINE TO SEE IF A .CMCFM FUNCTION APPEARS ON THE USER'S LIST.
;ACCEPTS P1/ POINTER TO USERS FUNCTION BLOCK
; CALL CHKCFM
;RETURNS +1: IF THERE IS NO .CMCFM ON THE LIST, P1 UNCHANGED
; +2: IF A .CMCFM IS ON THE LIST, P1 IS UPDATED FOR THAT BLOCK
;USES T1.
CHKCFM: STKVAR <LSTPTR> ;TO SAVE P1
MOVEM P1,LSTPTR ;SAVE P1 IN CASE WE NEED TO RESTORE IT
CHKCFL: CALL GETFUN ;GET FUNCTION CODE FROM BLOCK
CAIN T1,.CMCFM ;CONFIRM?
RETSKP ;YES, RETURN SKIP, P1 POINTS TO ITS BLOCK
HRRZ T1,P1 ;POINT TO THE CURRENT BLOCK
ULOAD T1,CM%LST,.CMFNP(T1) ;AND GET THE POINTER TO THE NEXT
HRRM T1,P1 ;UPDATE P1 TO THE NEXT BLOCK
JUMPN T1,CHKCFL ;LOOP AND CHECK BLOCK IF IT EXISTS
MOVE P1,LSTPTR ;BUT IF AT END, RESTORE OLD VALUE OF P1
RET ;AND RETURN NONSKIP
;ESC OR ^F AT BEG OF FIELD
XCOM2: TXNN F,CM%DPP ;YES, HAVE DEFAULT STRING?
JRST XCOM3 ;NO
CALL CMDCH ;FLUSH RECOG CHAR
CALL CMGDP ;GET DEFAULT POINTER
TXO F,CMDEFF ;NOTE FIELD ALREADY IN ATOM BFR
XCOM1: XCTBU [ILDB T1,Q1]
JUMPE T1,[CALL CHKLCH ;CHECK FOR NULL DEFAULT STRING
CAIG T1,0
ITERR COMX10
CALL TIELCH ;END OF STRING, TIE OFF ATOM BUFFER
TXNE F,CMCFF ;^F RECOG?
JRST XCOMRF ;YES, GO GET MORE INPUT
MOVEI T1,.CHESC
CALL CMDIBQ ;YES, APPEND ESC TO BUFFER
CALL TIECMD ;MAKE SURE NULL AT END OF COMMAND
CALL CMRSET ;RESET LINE VARIABLES
JRST XCOMN0] ;TREAT AS ORDINARY INPUT
CALL STOLCH ;STORE CHAR IN ATOM BUFFER
CALL CMDIB ;YES, CHAR TO MAIN BUFFER ALSO
JRST XCOM1
;ROUTINE TO YIELD DEFAULT POINTER IN Q1
CMGDP: HLRZ Q1,P1 ;GET PTR TO FIRST FLD BLOCK
UMOVE T1,.CMDEF(Q1) ;GET DEFAULT STRING PTR
CALL CHKBP ;CHECK POINTER
ITERR COMX15 ;BAD
MOVEM T1,Q1
RET
;TABLE OF COMND FUNCTIONS
; RH: ADDRESS OF CODE THAT IMPLEMENTS THAT FUNCTION
; LH: ADDRESS OF CONTROL BLOCK
;
;FORMAT OF CONTROL BLOCK:
;
COBLEN==0 ;LENGTH OF BLOCK INCLUDING THIS WORD
COBBRK==1 ;0 OR ADDRESS OF BREAK MASK FOR FIELD
COBFGS==2 ;FLAG WORD
COBPRE==3 ;0 OR <XWD PREFIX CHARACTER ,, ERROR CODE>
COBSUF==4 ;ADDRESS OF SUFFIX STRING OR 0
;NOTE: IF YOU CHANGE THIS FORMAT, IT'S NICE TO LEAVE THE DISPATCH
; IN THE RIGHT HALF SO THAT CREF LISTINGS SHOW WHERE
; TO FIND THE CODE
DEFINE MNX (FCODE,DISP,BRK,BTS,PRE,SUF)
< DEFARG BRK..,BRK
DEFARG BTS..,BTS
..PRE==PRE ;MIGHT HAVE COMMAS IN IT
DEFARG PRE..,..PRE
DEFARG SUF..,SUF
IFN .-FCODE,<PRINTX ?CFNTAB item FCODE is out of order
>
XWD [EXP 5,BRK..,BTS..,PRE..,SUF..],DISP
>
;MACRO TO ASSIGN THE SECOND ARG TO THE FIRST, UNLESS THE SECOND IS BLANK,
;IN WHICH CASE 0 IS ASSIGNED
DEFINE DEFARG (VARG,VALUE)
< VARG==0 ;;FIRST ASSUME DEFAULTING TO 0
IFNB <VALUE>,<VARG==VALUE>
>
CFNTAB: PHASE 0
MNX .CMKEY,XCMKEY,KEYBRK,CMSBF ;KEYWORD
MNX .CMNUM,XCMNUM,NUMBRK ;INTEGER
MNX .CMNOI,XCMNOI,0,CMNP1 ;NOISE WORD
;**;[2995] Change one line at CFNTAB+4L JMP 26-Jul-83
MNX .CMSWI,XCMSWI,SWIBRK,CMSBF,<XWD "/",NPXNSW> ;SWITCH
MNX .CMIFI,XCMIFI,FILBRK ;INPUT FILE
MNX .CMOFI,XCMOFI,FILBRK ;OUTPUT FILE
MNX .CMFIL,XCMFIL,FILBRK ;GENERAL FILESPEC
MNX .CMFLD,XCMFLD,FLDBRK,CMSBF ;ARBITRARY FIELD
MNX .CMCFM,XCMCFM,0,CMNP1 ;CONFIRM
MNX .CMDIR,XCMDIR,DIRBRK ;DIRECTORY NAME
MNX .CMUSR,XCMUSR,USRBRK ;USER NAME
MNX .CMCMA,XCMCMA,0,CMNP1 ;COMMA
MNX .CMINI,XCMINI,0,CMNOD+CMNP1 ;INITIALIZE COMMAND
MNX .CMFLT,XCMFLT,FLTBRK ;FLOATING POINT NUMBER
MNX .CMDEV,XCMDEV,DEVBRK,CMSBF,0,[ASCIZ /:/] ;DEVICE NAME
MNX .CMTXT,XCMTXT,TXTBRK,CMSBF+CMNP1 ;TEXT
MNX .CMTAD,XCMTAD,0,CMNP1 ;TIME AND DATE
MNX .CMQST,XCMQST,0,CMNP1 ;QUOTED STRING
MNX .CMUQS,XCMUQS,0,CMNOD+CMNP1 ;UNQUOTED STRING
;**;[2852] Change 1 line at .CMTOK PED 3-NOV-82
;**;[2871] Remove [2852] changes at .CMTOK PED 18-NOV-82
MNX .CMTOK,XCMTOK,0,CMNP1 ;[2852][2871] TOKEN
MNX .CMNUX,XCMNUM,NUXBRK ;NUMBER DELIMITED BY NON-DIGIT
MNX .CMACT,XCMACT,ACTBRK ;ACCOUNT
MNX .CMNOD,XCMNOD,NODBRK,0,0,[ASCIZ /::/] ;NODE NAME
DEPHASE
MAXCFN==.-CFNTAB
;RESET EVERYTHING SUCH THAT FIELD CAN BE REREAD.
;THIS ROUTINE IS USEFUL IF FIELD IS READ, AND THEN WE DECIDE WE WANT
;TO REREAD IT WITH A DIFFERENT LENGTH OR BREAK SET SPECIFIED.
CMFSET: CALL CMRSET ;PUT MAIN POINTER TO BEGINNING OF FIELD
CALL INILCH ;RESET POINTER TO ATOM BUFFER
TXZ F,CM%ESC+CM%EOC+CMCFF+CMQUES ;RESET PARSER
RET
;RESET VARIABLES TO BEGINNING OF CURRENT FIELD
CMRSET: SUB P5,P3 ;RESET VARIABLES TO BGN OF FIELD
XCTU [ADD P5,.CMCNT(P2)] ;KEEP ALL CURRENT INPUT
UMOVE P3,.CMCNT(P2)
UMOVE P4,.CMPTR(P2)
RET
;STANDARD EXITS
;RETURN AND REPEAT PARSE BECAUSE USER DELETED BACK INTO ALREADY
;PARSED TEXT
;THIS ALSO HAPPENS ON CASES LIKE "COPY <ESC>" WHICH BEEPS. IF REPARSE WEREN'T
;DONE IN THIS CASE, THEN USER CAN'T CONTINUE WITH "(FROM)". REPARSE ALSO
;HAPPENS ON "EDIT FOO.XX<ESC>" IF IT BEEPS. THIS IS NECESSARY FOR PROGRAMS THAT
;CALL COMND ONCE FOR EACH FUNCTION CODE INSTEAD OF WITH A CHAIN, SINCE THE
;MODIFIED FIELD MAY BECOME VALID FOR A PREVIOUS FUNCTION. FOR INSTANCE, EXEC
;CALLS COMND IN THE "EDIT" COMMAND FOR OLD FILE, AND THEN IF THAT FAILS, IT
;CALLS COMND FOR ANY FILE. IF BOGUS FILESPEC PROVOKES THE "ANY FILE" CASE,
;AND THE USER EDITS THE FILESPEC INTO AN EXISTING FILE, WE WANT THE OLD FILE
;RETURN TO BE TAKEN.
XCOMRF: TXO F,CM%RPT ;REQUEST REPEAT
MOVE T1,P4 ;COMPUTE NUMBER CHARS IN BUFFER
UMOVE T2,.CMBFP(P2)
MOVEM T2,P4 ;RESET PTR TO TOP OF BUFFER
CALL SUBBP ;COMPUTE PTR-TOP
MOVEM T1,P5 ;SET AS NUMBER CHARS FOLLOWING PTR
ADDM T1,P3 ;RESET COUNT TO TOP OF BUFFER
JRST XCOMX2 ;OTHERWISE UPDATE VARIABLES AND EXIT
;GOOD RETURNS
;RETURN TO FIXESC TO CHECK FOR TRAILING ESCAPE.
FIXESC: CALL CMCIN ;READ CHARACTER AFTER FIELD
FIXES1: TXNN F,CM%ESC ;ESCAPE AFTER FIELD?
CALL CMDIP ;NO, PUT IT BACK
XCOMXR: TXNE F,CM%ESC ;RECOG CHARACTER TERMINATED?
CALL CMDCH ;YES, FLUSH IT
XCOMXI: CALL ESCSPC ;TYPE SPACE IF FIELD ENDED WITH ESCAPE
XCOMX2: UMOVEM P3,.CMCNT(P2) ;UPDATE VARIABLES
UMOVEM P4,.CMPTR(P2)
UMOVEM P5,.CMINC(P2)
XCOMX1: MOVE P,STKFEN ;RESET STACK
XCTU [HRRZ T1,.CMIOJ(P2)] ;GET OUTPUT JFN
DMOVE T2,CMCCM ;GET SAVED CC MODES
MOVE Q3,LSTERR ;DON'T LOSE REAL ERROR CODE IF SFCOC "FAILS"
SFCOC ;RESTORE THEM
MOVEM Q3,LSTERR ;RESTORE CORRECT ERROR
UMOVEM P2,T1 ;ENSURE BLK ADR UNCHANGED
UMOVEM P1,T3 ;RETURN PTR TO FUNCTION BLOCK USED
TXZ F,CM%FFL ;FLUSH FUNCTION FLAGS
XCTU [HLLM F,.CMFLG(P2)] ;RETURN FLAGS
XCTU [HLLM F,T1] ;RETURN IN T1 ALSO
RET
;ROUTINE TO PUT SPACE IN BUFFER IF ESCAPE ENDED FIELD.
ESCSPC: TXZN F,CM%ESC ;FIELD TERMINATED WITH RECOG?
RET ;NO, NOTHING TO DO
TXNE F,CMCFF ;^F RECOG?
JRST XCOMRF ;YES, GET MORE INPUT BEFORE RETURNING
TXO F,CM%ESC ;SET FLAG
MOVEI T1," " ;TERMINATE TYPESCRIPT WITH SPACE
CALL CMDIB
CALLRET CMDIP ;DON'T REALLY PARSE THE SPACE UNTIL NEXT FIELD!
;FAILURE RETURNS - FAILED TO PARSE
XCOMNE: MOVEM T1,LSTERR ;SAVE ERROR CODE
CALL TIELCH ;FIX ATOM BUFFER SO "/BLECCH" ON 'SWITCH OR CONFIRM' GIVES "?INVALID SWITCH" INSTEAD OF "?NOT CONFIRMED"
XCOMNP: JXN F,CMQUES,CMRTYP ;IF IN HELP, DON'T RETURN NOW
CALL ATMLEN ;GET LENGTH OF ATOM BUFFER
ADD A,XTRALN ;ADD IN POSSIBLE EXTRA LENGTH
CAMG A,BSTLEN ;DID THIS FUNCTION GET FURTHER BEFORE ERROR?
JRST XC1 ;NO
MOVEM A,BSTLEN ;YES, REMEMBER NEW BEST
MOVE A,LSTERR ;GET BEST ERROR SO FAR
MOVEM A,BSTERR ;REMEMBER IT
XC1: CALL CMRSET ;RESET FIELD VARIABLES
UMOVEM P5,.CMINC(P2) ;FIX USER BLOCK
HRRZ T1,P1
ULOAD T1,CM%LST,.CMFNP(T1) ;GET PTR TO NEXT FN BLOCK
HRRM T1,P1 ;SAVE IT
JUMPN T1,XCOMN0 ;DISPATCH IF THERE IS ANOTHER FUNCTION
TXZE F,CMPS1F ;WERE WE ON PASS 1?
JRST [ TXO F,CMPS2F ;SAY WE'RE ON PASS 2
JRST XCOMB] ;GO PARSE ANYTHING THAT'S LONG ENOUGH
TXZE F,CMPS2F ;WERE WE ON PASS2?
JRST [ TXNE F,CMQUES ;WERE WE GIVING HELP?
JRST CMRT1 ;YES, SO NOW HELP IS OVER
SETZM EXPLEN ;MERELY LENGTH PROBLEMS, ALLOW ANY LENGTH THIS TIME
JRST XCOMB] ;TRY AGAIN
TXO F,CM%NOP ;NO OTHER POSSIBILITIES, SAY NO PARSE
MOVE T2,BSTERR ;RETURN BEST ERROR CODE
MOVEM T2,LSTERR
UMOVEM T2,T2
JRST XCOMX1
;ROUTINE TO MEASURE CURRENT LENGTH OF ATOM BUFFER. IT RETURNS NUMBER
;OF CHARACTERS IN T1.
ATMLEN: MOVEI T1,0 ;START WITH NO CHARACTERS
UMOVE T2,.CMABP(P2) ;GET POINTER TO ATOM BUFFER
ATML1: XCTBU [ILDB T3,T2] ;GET NEXT CHARACTER FROM ATOM BUFFER
JUMPE T3,R ;NULL MEANS END
AOJA T1,ATML1 ;NOT END, COUNT CHARACTER AND LOOP
;HERE AFTER EACH HELP OUTPUT
CMRTYP: CALL CMRSET ;RESET FIELD VARIABLES
HRRZ T1,P1
ULOAD T1,CM%LST,.CMFNP(T1) ;GET NEXT FUNCTION IN LIST
HRRM T1,P1
TXO F,CMQUES ;MARK IN HELP SEQUENCE
TXNE F,CM%SDH ;MAKE CHECKS TO SET CMQUE2 ONLY AFTER
TXNE F,CM%HPP ; WE HAVE ALREADY TYPED SOMETHING
TXO F,CMQUE2 ;NOTE SECOND OR SUBSEQUENT POSSIBILITY
JUMPN T1,XCOMN0 ;DO SUBSEQUENT HELPS
CMRT1: CALL OSYNCH ;CAUSE ^O IN HELP TO FLUSH HELP BUT NOT FLUSH REPROMPT
SOS P5 ;FLUSH QMARK FROM INPUT
TXZ F,CMQUES+CMQUE2 ;NOTE NOT IN HELP
CALL CMRTY0 ;RETYPE LINE
JRST XCOMB0 ;RESTART PARSE OF CURRENT FIELD
;OSYNCH WAITS FOR ALL OUTPUT TO FINISH AND THEN UNDOES ANY POSSIBLE ^O.
;THE UNDOING IS SO THAT IF THE TYPIST TYPES ^O TO FLUSH THE OUTPUT OF THE
;PREVIOUS COMMAND, SHE'LL SEE THE PROMPT FOR THE NEXT COMMAND. THE PURPOSE
;OF WAITING (SOBE) BEFORE UNDOING ^O IS SO THAT SHE DOESN'T SEE ANY OF THE
;OUTPUT SHE EXPECTED TO FLUSH WITH THE ^O.
;
;OSYNCH THEN GETS TO THE LEFT MARGIN. THIS IS USED FOR PROMPTING FOR NEW
;COMMANDS, AND FOR RETYPING THE COMMAND AFTER HELP MESSAGES. (TYPISTS MAY
;TYPE ^O DURING LENGTHY HELP MESSAGES)
OSYNCH: XCTU [HRRZ T1,.CMIOJ(P2)] ;WAIT FOR ANY CURRENT OUTPUT
SOBE
DOBE
RFMOD ;GET MODES
TXZE T2,TT%OSP ;OUTPUT SUPPRESS WAS ON?
SFMOD ;YES, CLEAR IT
XCTU [HRRZ T1,.CMIOJ(P2)] ;GET HANDLE ON OUTPUT CHANNEL
RFPOS
HRRZ T2,T2
JUMPE T2,R ;DONE IF ALREADY AT LEFT MARGIN
MOVEI T1,.CHLFD ;DO CR TO GET TO LEFT MARGIN
CALLRET CMCOUT
;RETYPE LINE INCLUDING ADVANCE INPUT IF ANY
CMRTY0: XCTU [SKIPE Q1,.CMRTY(P2)] ;GET ^R PTR IF ANY
CMRTY3: XCTU [CAMN Q1,.CMBFP(P2)] ;UP TO TOP OF BFR?
JRST CMRTY2 ;DONE WITH ^R PTR
XCTBU [ILDB T1,Q1] ;TYPE ^R BFR
JUMPN T1,[CALL CMCOUT
JRST CMRTY3]
CMRTY2: UMOVE Q1,.CMBFP(P2) ;GET MAIN BFR PTR
CMRTY4: CAMN Q1,P4 ;UP TO CURRENT PTR?
JRST CMRTY5 ;YES, GO DO ADVANCE INPUT
XCTBU [ILDB T1,Q1] ;TYPE OUT COMMAND BFR
CALL CMCOUT
JRST CMRTY4
CMRTY5: MOVE Q2,P5 ;GET INPUT COUNT
CMRTY6: SOJL Q2,[SETZ T1, ;ALL INPUT PRINTED, TIE OFF BFR
XCTBU [IDPB T1,Q1]
RET]
XCTBU [ILDB T1,Q1]
CALL CMCOUT
JRST CMRTY6
;INDIRECT FILE HANDLING
;**;[3009] Add one line at CMIND+0L YKT SEP-06-83
CMIND: SETOM INDFLG ;[3009]
JXO F,CMQUE2,XCOMNP ;NO SECOND HELP POSSIBILITIES
CALL CMATFI ;GET A JFN ON THE INDIRECT FILE
JRST CMINDE ;FAILED
CALL CMCFM0 ;DO A CONFIRM
;**;[3009] Add one line at CMIND+4L YKT SEP-06-83
JRST [CALL INDRLJ ;[3009] RELEASE THE JFN
NOPARS NPXNC] ;NOT CONFIRMED
UMOVE T1,T1 ;GET JFN
DVCHR ;READ CHARACTERISTICS OF DEVICE
ERJMP CMIND0 ;FAIL, ASSUME NOT A TERMINAL
LDB T1,[POINTR T1,DV%TYP] ;GET DEVICE TYPE
CAIN T1,.DVTTY ;IS IT A TTY?
TXOA F,CMINDT ;YES, REMEMBER THAT
CMIND0: TXZ F,CMINDT ;NO, CLEAR FLAG
UMOVE T1,T1 ;THE JFN
MOVX T2,<FLD(7,OF%BSZ)+OF%RD>
OPENF ;OPEN IND FILE
JRST CMINDE ;LOSS
CALL CMFSET ;FLUSH INDIRECT FILESPEC FROM BUFFER BUT LEAVE SPACES IN
CMIND1: UMOVE T1,T1 ;THE JFN
BIN ;READ CHAR FROM IND FILE
ERJMP CMIND2 ;FAILED, PROBABLY END OF FILE
JUMPE T2,CMIND1 ;IGNORE NULLS
TXZ F,CMILLF ;FIRST ASSUME THIS ISN'T EOL
CAIN T2,.CHCRT ;IGNORE CR
JRST CMIND1
CAIN T2,.CHCNZ ;IS THIS A CONTROL-Z?
TXNN F,CMINDT ;AND FROM A TERMINAL?
SKIPA ;NO
JRST CMIND3 ;YES, TREAT AS END OF FILE
CAIE T2,.CHLFD ;CONVERT EOL TO SPACE
CAIN T2,.CHESC ;DITTO ESC (BUT THERE SHOULDN'T BE ANY)
JRST [ MOVEI T2," "
TXO F,CMILLF ;REMEMBER THAT TRAILING SPACE MAY HAVE TO BE REMOVED
JRST .+1]
MOVE T1,T2
CALL CMDIBQ ;PUT CHAR IN BUFFER WITHOUT TYPEOUT
JRST CMIND1
CMIND2: GTSTS ;GET FILE STATUS
TXNN T2,GS%EOF ;EOF?
JRST CMINDE ;NO, SOME KIND OF ERROR
CMIND3: CLOSF ;YES, CLOSE IT
JFCL
TXNE F,CMILLF ;TRAILING SPACE DUE TO EOL?
CALL CMDIP ;YES, REMOVE IT SINCE SOMEONE MAY BE STRICT
MOVEI T1,.CHLFD ;TIE OFF LINE
CALL CMDIBQ
JRST XCOMRF ;REPARSE LINE AS NOW CONSTITUTED
CMINDE: CALL CME0
JRST XCOMNP ;SAY PARSE FAILURE
CME0: UMOVE T1,T1 ;GET INDIRECT JFN AGAIN
MOVE T3,LSTERR ;DON'T LET CLOSF CLOBBER ERROR CODE
CLOSF ;CLOSE IT
JFCL ;COULDN'T CLOSE IT, IGNORE
MOVEM T3,LSTERR
RET
;**;[3009] Add 6 lines YKT SEP-06-83
INDRLJ: UMOVE T1,T1 ;[3009] GET INDIRECT JFN AGAIN
MOVE T3,LSTERR ;[3009] DON'T LET RLJFN CLOBBER ERROR CODE
RLJFN ;[3009] RELEASE IT
JFCL ;[3009] COULDN'T RELEASE IT, IGNORE
MOVEM T3,LSTERR ;[3009]
RET ;[3009]
;****************************************
;COMND - LOCAL SUBROUTINES
;****************************************
;TEXTI BREAK SET. NORMALLY ONLY COMND ACTION CHARACTERS, BUT IF
;CM%WKF ON (WAKE ON EVERY FIELD), MUST WAKE ON ALL FIELD TERMINATORS TOO
BRINI. ;INITIALIZE
BRKCH. .CHLFD ;BREAK ON LINEFEED
BRKCH. .CHFFD ;FORMFEED WORKS TO GET TO START COMMAND ON NEW PAGE
BRKCH. .CHESC ;BREAK ON RECOGNITION
BRKCH. CMHLPC ;BREAK ON HELP REQUEST
BRKCH. CMFREC ;BREAK ON FIELD COMPLETION CHARACTER
REGBRK: EXP W0.,W1.,W2.,W3. ;REGULAR TEXTI BREAK MASK
ALLBRK: W0.!FLDB0.
W1.!FLDB1. ;SPECIAL BREAK MASK FOR WAKING ON ALL FIELDS
W2.!FLDB2.
W3.!FLDB3.
KEYBRK: EXP KEYB0.,KEYB1.,KEYB2.,KEYB3. ;KEYWORD BREAK MASK
SWIBRK: EXP KEYB0.,KEYB1.,KEYB2.,KEYB3. ;SWITCH BREAK SAME AS KEYWORD
USRBRK: EXP USRB0.,USRB1.,USRB2.,USRB3. ;USER NAME BREAK MASK
ACTBRK: EXP ACTB0.,ACTB1.,ACTB2.,ACTB3.
FLDBRK: EXP FLDB0.,FLDB1.,FLDB2.,FLDB3. ;STANDARD FIELD BREAK SET
EOLBRK: EXP EOLB0.,EOLB1.,EOLB2.,EOLB3. ;BREAK SET FOR READING TO END OF LINE
TXTBRK: EXP EOLB0.,EOLB1.,EOLB2.,EOLB3. ;TEXT BREAK SET, READ TO END OF LINE
FILBRK: EXP FILB0.,FILB1.,FILB2.,FILB3. ;FILE BREAK SET
DIRBRK: EXP FILB0.,FILB1.,FILB2.,FILB3. ;DIRECTORY BREAK SET
;SAME AS FILE FOR NOW
NODBRK: EXP FLDB0.,FLDB1.,FLDB2.,FLDB3. ;NODE BREAK SET
;SAME AS FIELD RIGHT NOW
DEVBRK: EXP DEVB0.,DEVB1.,DEVB2.,DEVB3. ;DEVICE BREAK SET
;CMRFLD READS INPUT FOR THE CURRENT FUNCTION.
;
;ACCEPTS: P1/ RIGHT HALF TELLS WHAT FUNCTION
; F/ CM%BRK TELLS WHETHER USER HAS SUPPLIED SPECIAL BREAK
; MASK
; CFNTAB/ CMSBF TELLS WHETHER SPECIAL BREAK MASKS ARE ALLOWED FOR
; THIS FUNCTION
;
; WORD COBBRK TELLS ADDRESS OF STANDARD BREAK MASK
;
; WORD COBPRE HAS 0 OR CHAR,,ERROR
;
; WORD COBSUF HAS 0 OR ADDRESS OF SUFFIX STRING
;
;RETURNS +1: T1/ LENGTH OF FIELD INCLUDING PREFIX AND SUFFIX
CMRFLD: CALL GETBRK ;GET BREAK MASK FOR FUNCTION
MOVEM T2,CMRBRK ;SAVE BREAK SET ADDRESS
JUMPE T2,R ;IF NO BREAK MASK, RETURN
CALL GETFUN ;GET FUNCTION CODE
HLRZ T4,CFNTAB(T1) ;GET ADDRESS OF CONTROL BLOCK
SKIPE T1,COBSUF(T4) ;SKIP IF SPECIAL SUFFIX STRING
HRLI T1,440700 ;MAKE BYTE POINTER
MOVEM T1,SUFPTR ;REMEMBER SUFFIX POINTER
MOVEM T1,SUFPT0 ;REMEMBER INITIAL SUFFIX POINTER
HLR T1,COBPRE(T4) ;GET POSSIBLE PREFIX CHARACTER
HRRZM T1,PRECHR ;REMEMBER IT
HRRZ T1,COBPRE(T4) ;GET POSSIBLE ERROR CODE FOR WHEN PREFIX NOT TYPED
MOVEM T1,PREERR ;SAVE POSSIBLE ERROR CODE
CALLRET CMRFL0 ;JOIN COMMON CODE
;CMRFLN READS EXACTLY N CHARACTERS. IN OTHER WORDS, THE N + 1ST CHARACTER
;IS A BREAK CHARACTER, NO MATTER WHAT IT IS.
;
;ACCEPTS: T1/ -N
CMRFLN: MOVEM T1,CMRBRK ;SET UP SPECIAL COUNT AS BREAK MASK
CALLRET CMRFL0 ;JOIN COMMON CODE
;CMRFLX READS FIELD WITH SPECIFIED BREAK MASK. THIS IS USUALLY UNNECESSARY
;BECAUSE THE FUNCTION CODE HAS A STANDARD BREAK MASK WHICH CMRFLD CORRECTLY
;COMPUTES
CMRFLX: MOVEM T1,CMRBRK ;SAVE SPECIFIC BREAK MASK
SETZM SUFPTR ;NO SUFFIX
SETZM SUFPT0
SETZM PRECHR ;NO PREFIX CHARACTER
CMRFL0: MOVNI T1,1
ADJBP T1,ATBPTR
MOVEM T1,ATBSUF ;INITIALLY ASSUME NO SUFFIX IN ATOM BUFFER
TXNE F,CMDEFF ;DEFAULT GIVEN?
JRST CMRATT ;YES, ALREADY IN BUFFER
CMRAT1: CALL CMROOM ;MAKE SURE ROOM FOR ANOTHER CHARACTER
CALL CMCIN ;GET NEXT CHARACTER
CAIN T1,CMQUOT ;THE QUOTING CHARACTER?
JRST CMRQUT ;YES, READ NEXT CHARACTER REGARDLESS
CAIE T1,CMFREC ;^F RECOGNITION?
CAIN T1,.CHESC ;ESC?
JRST [ TXNN F,CMPS1F ;IF SCANNING, ESCAPE ISN'T SPECIAL
;WITHOUT THIS CHECK, "COPY FOO.BAR$$"
;BEEPS INSTEAD OF DEFAULTING!
CALL CHKLCH ;YES, NOT SPECIAL IF ANYTHING NOW IN ATOM BFR
JUMPG T1,CMRATT
CALL CMAMBT] ;NOTHING THERE, DING
CAIE T1," " ;SPACE OR TAB?
CAIN T1,.CHTAB
JRST [ CALL CHKLCH ;YES, RETURN IF ANYTHING IN ATOM BFR
JUMPG T1,.+1
JRST CMRAT1] ;OTHERWISE IGNORE
XCTBU [LDB T1,P4] ;CHKLCH CLOBBERED CHARACTER, GET IT BACK
CAIN T1,CMHLPC ;HELP REQUEST?
JRST [ CALL ECOCHK ;YES - ECHOES ON?
JRST [ MOVEI T1,.TICCG ;NO - SEND A BELL
CALL CMCOUT
CALL CMDCH ;DELETE '?' FROM BUFFER
JRST XCOMRF ] ;REPARSE
TXO F,CMQCAN ;YES, FLAG HELP REQUEST
JRST CMRTIE]
SKIPG CMRBRK ;BREAK SET GIVEN?
JRST CMRAT3 ;NO, KEEP READING REGARDLESS OF CHARACTER
SKIPN SUFPTR ;IS THERE A SUFFIX POINTER?
JRST CMRNS ;NO
ILDB T2,SUFPTR ;GET NEXT CHARACTER OF SUFFIX
CAMN T1,T2 ;DOES CURRENT CHARACTER MATCH SUFFIX CHARACTER?
JRST [ MOVE T3,SUFPTR ;YES, SEE IF SUFFIX ENTIRELY MATCHED NOW
ILDB T3,T3 ;PEEK AT NEXT CHARACTER IN SUFFIX
JUMPN T3,CMRAT3 ;IF NOT OVER, NOTHING TO DO YET
SETZM SUFPTR ;SUFFIX MATCHED, REMEMBER THAT.
CALL SUFLEN ;GIVE LENGTH CREDIT TO SUFFIX
MOVEI T1,[EXP -1,-1,-1,-1] ;FORCE BREAK ON EVERYTHING SINCE SUFFIX HAS BEEN SEEN
MOVEM T1,CMRBRK
JRST CMRAT1] ;CHECK FOR ESCAPE OR QUESTION MARK AFTER SUFFIX
CAME T1,T2 ;WAS CHARACTER PART OF SUFFIX?
JRST [ MOVE T3,SUFPT0 ;NO, SO RESTART THE SUFFIX SCAN
MOVEM T3,SUFPTR
JRST .+1]
CMRNS: CALL SKPNB ;SKIP IF CHARACTER IS NOT A BREAK CHARACTER
JRST CMRAT1 ;PREFIX SEEN, SKIP IT
JRST CMRATR ;CHAR IS A BREAK.
MOVE T3,ATBPTR ;NOT A BREAK, REMEMBER CURRENT ATOM POINTER,
MOVEM T3,ATBSUF ;SO WE'LL KNOW WHERE SUFFIX BEGINS
CMRAT3: CALL STOLCH ;BUILD KEYWORD STRING
JRST CMRAT1
;ROUTINE TO CHECK IF ECHOES ARE TURNED ON
;CALL ECOCHK
;
;ACCEPTS: P2/ POINTER TO STATE BLOCK IN USER'S ADDRESS SPACE
;
;RETURNS: +1 ECHOES ARE OFF
; +2 ECHOES ARE ON
; CLOBBERS T1,T2
ECOCHK: XCTU [HLRZ T1,1(P2)] ;GET INPUT JFN
RFMOD ;GET MODE WORD
TRNN T2,TT%ECO ;ECHOES ON?
RET ;NOPE
RETSKP ;YEP
;Routine to return the break mask for a function
;
;CALL GETBRK
;
;Returns +1 Always
;
; T2/ Address of break mask
;
;Preserves T1, Trashes T4
GETBRK: SAVEAC <T1> ;SAVE T1
CALL GETFUN ;GET THE FUNCTION
HLRZ T4,CFNTAB(T1) ;GET THE ADDRESS OF CONTROL BLOCK
SKIPN T2,COBBRK(T4) ;GET ADDRESS OF STANDARD BREAK MASK
RET ;NONE, SO RETURN 0
MOVE T1,COBFGS(T4) ;GET SPECIAL FIELD FLAGS
TXNE F,CM%BRK ;DOES USER HAVE SPECIAL BREAK MASK
TXNN T1,CMSBF ;IS ONE ALLOWED?
RET ;NOT GIVEN OR NOT ALLOWED, RETURN
MOVEI T2,SPCMSK ;USE SPECIAL MASK
RET ;AND RETURN
;Routine to check if a character is a break character or not.
;This routine allows one to specify a break set on the call
;
;CALL CHKBRK
;
;Accepts T1/ Character to check
; T2/ Address of break set mask
;
;Returns +1/ Character is a break character
; +2/ Character is not a break character
;
; T1/ Character
; T2 and T3 destroyed
;
CHKBRK: SAVEAC <T4>
JUMPE T2,RSKP ;IF NO BREAK SET, RETURN
CHKBR1: MOVE T4,T2 ;PUT BREAK SET ADDRESS IN T4
MOVE T2,T1 ;GET COPY OF CHAR
IDIVI T2,40 ;COMPUT INDEX INTO BIT MASK
MOVE T3,BITS(T3) ;GET BIT FOR CHARACTER
ADD T2,T4 ;GET WORD OFFSET INTO BREAK SET
TDNE T3,0(T2) ;BREAK CHARACTER?
RET ;YES
RETSKP ;NO
;ROUTINE USED WITHIN CMRFLD TO SKIP IF CHARACTER IN T1 IS NOT A BREAK
;CHARACTER.
;IF A PREFIX IS EXPECTED, AND THE CURRENT CHARACTER IS NOT THE CORRECT
;PREFIX CHARACTER, A PARSE ERROR OCCURS.
;
;ACCEPTS: T1/ CHARACTER
;
;RETURNS: +1 CHARACTER WAS PREFIX
; +2 CHARACTER IS A BREAK CHARACTER
; +3 CHARACTER NOT A BREAK CHARACTER
; T1/ CHARACTER
SKPNB: SKIPLE PRECHR ;SPECIAL PREFIX CHARACTER WANTED?
JRST SKHPRE ;HANDLE PREFIX
MOVE T2,CMRBRK ;GET ADDRESS OF BREAK SET
CALL CHKBR1 ;CHECK IF ITS A BREAK CHARACTER
RETSKP ;YES
JRST SK2RET ;NO, GIVE DOUBLE SKIP
SKHPRE: CAME T1,PRECHR ;MAKE SURE PREFIX CHARACTER IS SUPPLIED
JRST [ CALL TIELCH ;MAKE SURE 0-LENGTH ATOM SEEN FOR ERROR EVALUATION
RETSKP]
SETOM PRECHR ;IT'S BEEN SEEN, REMEMBER
RET ;RETURN TO SAY PREFIX SEEN
;ROUTINE USED TO COMPUTE LENGTH OF SUFFIX. THIS LENGTH IS USED AS CREDIT
;TOWARDS THE LENGTH OF ATOMS WHEN COMPUTING ERRORS. THIS CALCULATION ENABLES
;THE TYPIST TO BE TOLD THAT "ABC:" IS AN INCORRECT DEVICE, BUT "ABC" IS AN
;INCORRECT KEYWORD, WHEN THE CHOICES ARE DEVICE OR KEYWORD, AND "ABC" IS NOT
;EITHER.
;NOTE THAT IF WE EVER AGREE TO PUT THE COLON IN THE ATOM BUFFER, WHICH
;WOULD BE A CONSISTENT THING TO DO, THIS SPECIAL CODE WOULD BE UNNECESSARY,
;SINCE THE COLON WOULD BE IN THE ATOM BUFFER AS A REGULAR CHARACTER TO
;CONTRIBUTE TO THE LENGTH.
SUFLEN: MOVEI A,0 ;A WILL HOLD LENGTH
MOVE B,SUFPT0 ;GET POINTER TO BEGINNING OF SUFFIX
SUFL1: ILDB C,B ;GET NEXT CHARACTER FROM SUFFIX
CAIE C,.CHNUL ;LEAVE LOOP IF NULL FOUND
AOJA A,SUFL1
MOVEM A,XTRALN ;REMEMBER LENGTH OF SUFFIX
RET
;GET HERE WHEN QUOTING CHARACTER HAS BEEN SEEN. QUOTING CHARACTER
;MEANS NEXT CHARACTER SHOULD NEVER BE CONSIDERED A BREAK CHARACTER NO
;MATTER WHAT IT IS.
CMRQUT: CALL STOLCH ;STORE THE QUOTING CHARACTER
CALL CMCINX ;READ CHARACTER BEING QUOTED (BUT DON'T SET FLAGS!)
JRST CMRAT3 ;STORE CHARACTER AND CONTINUE
;CMROOM DECIDES IF WE CAN READ ANOTHER CHARACTER
CMROOM: SKIPLE CMRBRK ;BREAK SET GIVEN?
RET ;YES, SO KEEP READING
AOSG CMRBRK ;NO, COUNT. HAVE WE READ ENOUGH?
RET ;COUNT NOT EXHAUSTED, KEEP READING.
MOVEI T1,[EXP -1,-1,-1,-1]
MOVEM T1,CMRBRK ;COUNT EXHAUSTED, FOR BREAK ON ANYTHING
RET ;GO READ NEXT CHARACTER IN CASE IT'S "?".
CMRATR: CALL CMDIP ;PUT CHARACTER BACK IN BUFFER
CMRATT: SKIPN SUFPT0 ;IS THERE A SUFFIX?
JRST CMRNS2 ;NO
MOVEI T1,1 ;ATBSUF GOT SAVED BEFORE THE LAST IDPB
ADJBP T1,ATBSUF ;GET POSITION WHERE SUFFIX BEGAN IN ATOM BUFFER
MOVEM T1,ATBPTR ;RESET ATOM POINTER TO GET RID OF SUFFIX
CALL TIELCH ;REALLY GET RID OF IT BY PUTTING NULL AFTER IT
CMRNS2: TXNE F,CM%ESC ;DON'T TYPE SUFFIX IF GUY DIDN'T TYPE ESCAPE
SKIPN SUFPT0 ;IS THERE A SUFFIX?
JRST CMRNS1 ;NO SUFFIX, OR GUY DIDN'T TYPE ESCAPE BEFORE TYPING SUFFIX
TXNN F,CMPS1F ;DON'T REMOVE ESCAPE IF JUST SCANNING
CALL CMDCH ;REMOVE ESCAPE BEFORE APPENDING SUFFIX
SKIPN SUFPTR ;DID USER TYPE ENTIRE SUFFIX?
JRST CMRNS1 ;NO
TXNE F,CMPS1F ;ARE WE ONLY MEASURING LENGTHS?
JRST CMRNS1 ;YES, SO DON'T TYPE THE SUFFIX NOW
CALL SUFLEN ;NO, COMPUTE LENGTH
CMRS: ILDB T1,SUFPTR ;THERE'S A SUFFIX, GET THE NEXT CHARACTER OF IT
JUMPE T1,CMRNS1 ;LEAVE LOOP IF END OF SUFFIX
CALL CMDIB ;SHOW SUFFIX TO USER
JRST CMRS
;END OF FIELD, CHECK TO SEE IF DEFAULT SHOULD BE USED...
CMRNS1: CALL CHKLCH ;SEE HOW LARGE THE FIELD IS
JUMPN T1,CMRTIE ;DON'T USE DEFAULT IF SOMETHING TYPED
TXNN F,CM%DPP ;DID USER SUPPLY A DEFAULT?
JRST [ TXNN F,CMPS1F ;DON'T COMPLAIN IF MERELY MEASURING
SKIPG PRECHR ;NO DEFAULT. WAS PREFIX CHARACTER EXPECTED?
JRST CMRTIE ;NO
MOVE T1,PREERR ;YES, GET ERROR CODE (SUCH AS "SLASH NOT SEEN")
CALL XCOMNE] ;GIVE ERROR. "CALL" IS FOR DEBUGGING PURPOSES
SAVEQ ;ONLY BECAUSE CMGDP CLOBBERS Q1
TXO F,CMDEFF ;MARK THAT DEFAULT BEING USED
CALL CMGDP ;GET POINTER TO DEFAULT STRING
CMRDF1: XCTBU [ILDB T1,Q1] ;GET NEXT CHARACTER OF DEFAULT STRING
JUMPE T1,CMRTIE ;DONE IF NULL
CALL SKPNB ;STRIP ILLEGAL CHARS, SO CORRECT ERROR CODE GOES TO USER
JRST CMRDF1 ;PREFIX SEEN, GET NEXT CHARACTER
JRST CMRTIE ;BREAK CHARACTER, STOP COPYING
CALL STOLCH ;NON-NULL, STORE IN ATOM BUFFER
JRST CMRDF1 ;CONTINUE COPYING
CMRTIE: CALL TIELCH ;MAKE SURE NULL AT END OF ATOM BUFFER
CALL ATMLEN ;YES, GET LENGTH OF ATOM WE JUST READ
ADD T1,XTRALN ;INCLUDE POSSIBLE SUFFIX
SKIPGE PRECHR ;PREFIX CHARACTER SEEN?
AOJ T1, ;YES, COUNT IT
TXNE F,CMDEFF ;ARE WE USING THE DEFAULT STRING?
MOVEI T1,0 ;YES, SO USE 0 SINCE USER DIDN'T REALLY TYPE ANYTHING
TXNE F,CMPS1F ;PASS 1?
JRST XCOM9 ;YES, UPDATE BEST LENGTH SEEN SO FAR
CAMGE T1,EXPLEN ;IS IT LONG ENOUGH?
JRST XC1 ;NO, SO GIVE UP ON THIS FUNCTION
TXZE F,CMQCAN ;FIELD IS LONG ENOUGH. HELP CANDIDATE?
TXO F,CMQUES ;YES, IT'S ELECTED!
RET
;READ QUOTED STRING INTO ATOM BUFFER
;STRING DELIMITED BY ", "" MEANS LITERAL "
;**;[3149] Basically replace CMRQST down to CMRQS2 JMP Aug 20 84
CMRQST: TXNE F,CMDEFF ;HAVE DEFAULT?
RETSKP ;YES
CALL RDCRLF ;[3149] SEE IF CRLF FOR DEFAULTING ?
IFSKP.
TXNN F,CM%DPP ;[3149] YES - GOT A DEFAULT ?
RET ;[3149] NO - FAIL
CALL UNCRLF ;[3149] BACK UP SO OTHER FIELDS GET CRLF
MOVE Q2,Q1 ;[3149] SAVE ARG POINTER, CMGDP CLOBBERS Q1
CALL CMGDP ;[3149] GET DEFAULT STRING POINTER
TXO F,CMDEFF ;[3149] NOTE DEFAULT SHOULD BE TAKEN
XCTBU [ILDB T1,Q1] ;[3149] GET 1ST CHARACTER OF DEFAULT STRING
ELSE.
CAIN T1,CMHLPC ;FIRST CHAR IS HELP?
JRST [ TXO F,CMQUES ;YES
RETSKP]
CAIE T1,.CHESC
CAIN T1,CMFREC ;RECOGNITION ATTEMPTED?
CALL CMAMBT ;YES, AMBIGUOUS
ENDIF.
CAIE T1,CMQTCH ;START OF STRING?
RET ;NO, FAIL
CMRQS1: TXNE F,CMDEFF ;[3149] GOT DEFAULT ?
IFSKP.
CALL RDCRLF ;END OF LINE?
CAIA ;NO
CALLRET UNCRLF ;YES, UNREAD IT AND GIVE FAILURE RETURN
ELSE.
XCTBU [ILDB T1,Q1] ;[3149] GET NEXT CHARACTER OF DEFAULT STRING
JUMPE T1,R ;[3149] FAILURE IF NOT TERMINATED BY QUOTE
ENDIF.
CAIE T1,CMQTCH ;ANOTHER QUOTE?
JRST CMRQS2 ;NO, GO STORE CHARACTER
TXNE F,CMDEFF ;[3149] YES - GOT DEFAULT ?
IFSKP.
CALL CMCIN ;NO, PEEK AT ONE AFTER
ELSE.
XCTBU [ILDB T1,Q1] ;[3149] GET NEXT CHARACTER OF DEFAULT STRING
JUMPE T1,CMRQS3 ;[3149] IF NULL, END OF DEFAULT REACHED
ENDIF.
CAIN T1,CMQTCH ;PAIR OF QUOTES?
JRST CMRQS2 ;YES, STORE ONE
TXNN F,CMDEFF ;[3149] TAKING DEFAULT ?
CALL CMDIP ;NO, PUT BACK NEXT CHAR
CMRQS3: CALL TIELCH ;[3149] TIE OFF ATOM BUFFER
RETSKP ;GOOD
CMRQS2: CALL STOLCH ;STORE CHAR IN ATOM BUFFER
JRST CMRQS1 ;KEEP LOOKING
;INIT ATOM BUFFER
INILCH: CALL INILC1
CALLRET CMSKSP ;FLUSH INITIAL SPACES
INILC1: UMOVE T1,.CMABP(P2) ;GET PTR
MOVEM T1,ATBPTR
UMOVE T1,.CMABC(P2) ;GET SIZE
MOVEM T1,ATBSIZ
RET
;SHRINK removes characters from the end of the atom buffer.
;
;Accepts: T1/ number of characters to remove
SHRINK: MOVN T2,T1 ;GET NEGATIVE NUMBER OF CHARACTERS TO REMOVE
ADJBP T2,ATBPTR ;ADJUST ATOM POINTER TO SHRUNKEN END
MOVEM T2,ATBPTR ;REMEMBER NEW END
ADDM T1,ATBSIZ ;SHOW THAT THERE'S MORE ROOM NOW IN ATOM BUFFER
MOVEI T1,.CHNUL ;GET NULL TO MARK END OF ATOM BUFFER
XCTBU [IDPB T1,T2] ;PUT NULL IN
RET
;STORE CHARACTER IN ATOM BUFFER
STOLCH: SOSGE ATBSIZ ;ROOM?
ITERR (COMNX2) ;NO
XCTBU [IDPB T1,ATBPTR]
RET
;CHECK NUMBER OF CHARACTERS IN ATOM BUFFER
CHKLCH: UMOVE T1,.CMABC(P2) ;GET ORIG COUNT
SUB T1,ATBSIZ ;COMPUTE DIFFERENCE
RET
;TIE OFF ATOM BUFFER
TIELCH: SKIPG ATBSIZ ;ROOM FOR NULL?
ITERR COMNX2 ;NO, LOSE
SETZ T1,
MOVE T3,ATBPTR ;GET POINTER
XCTBU [IDPB T1,T3] ;DEPOSIT WITHOUT CHANGING PTR
RET
;GET NEXT INPUT CHARACTER FOR PROCESSING
;HANDLES CONTINUATION LINES
;APPEND TEXT TO BUFFER IF NECESSARY WITH INTERNAL TEXTI
; CALL CMCIN
; RETURNS +1 ALWAYS, T1/ CHARACTER
CMCIN: CALL CMCINX ;GET NEXT CHARACTER
CAIE T1,CMCONC ;POSSIBLE CONTINUATION LINE?
JRST [ CAIE T1,CMQUOT ;NO, CONTROL-V?
TXZA F,CMCLCV ;NO, CLEAR THE FLAG
TXC F,CMCLCV ;YES, TOGGLE FLAG TO HANDLE ^V^V
JRST CMCINT] ;RETURN
TXZE F,CMCLCV ;QUOTED DASH? (AND CLEAR FLAG)
JRST CMCINT ;YES--RETURN THE DASH
CALL CMCINX ;NO, POSSIBLE CONTINUATION, CHECK NEXT
CAIN T1,.CHLFD ;LINEFEED?
JRST CMCIN ;YES. CONTINUATION LINE
CAIE T1,.CHCRT ;NOT LF, MAYBE CR,LF?
JRST [ CALL CMDIP ;NOT CR EITHER, PUT BACK
MOVEI T1,CMCONC ;GET BACK HYPHEN
CALLRET CMCINT] ;LIGHT FLAGS AND RETURN
CALL CMCINX ;WAS CR, DOES LF FOLLOW?
CAIN T1,.CHLFD ;LINEFEED?
JRST CMCIN ;YES. CONTINUATION LINE
CALL CMDIP ;NO. PUT CHARACTER BACK
MOVEI T1,.CHCRT ;AND ALSO PUT
CALL CMDIP ;BACK THE CARRIAGE RETURN
MOVEI T1,CMCONC ;AND GET BACK THE HYPHEN TO
CALLRET CMCINT ;RETURN TO THE CALLER, SETTING FLAGS
;CMCINX READS THE CHARACTER BUT DOESN'T LIGHT ANY FLAGS.
CMCINX: SOJL P5,[SETZ P5, ;MAKE INPUT EXACTLY EMPTY
CALL CMCIN1 ;NONE LEFT, GO GET MORE
JRST CMCINX]
XCTBU [ILDB T1,P4] ;GET NEXT ONE
SOS P3 ;UPDATE FREE COUNT
RET
;ROUTINE TO SKIP IFF NEW-LINE IS NEXT IN BUFFER. IF NOT, THE
;CHARACTER SEEN IN LIEU OF NEW-LINE IS IN T1. NOTE: USE UNCRLF
;TO BACK UP OVER NEW-LINE, INSTEAD OF CMDIP.
RDCRLF: CALL CMCIN ;GET NEXT CHARACTER
CAIE T1,.CHFFD ;FORMFEED COUNTS AS END OF LINE
CAIN T1,.CHLFD ;LINEFEED?
RETSKP ;YES, NEW-LINE
CAIE T1,.CHCRT ;CARRIAGE RETURN?
RET ;NEITHER, SO NOT NEW-LINE
CALL CMCIN ;GET CHARACTER AFTER CARRIAGE RETURN
CAIN T1,.CHLFD ;CARRIAGE RETURN LINEFEED TOGETHER?
RETSKP ;YES, NEW-LINE
CALL CMDIP ;NO, PUT NON-LINEFEED BACK
MOVEI T1,.CHCRT ;SAY CARRIAGE RETURN SEEN
RET
;LIGHT SPECIAL FLAGS ROUTINE. TAKES CHARACTER IN T1.
CMCINT: CAIN T1,CMFREC ;^F?
JRST [ TXO F,CM%ESC+CMCFF ;YES
RET]
CAIN T1,.CHESC ;ESC?
JRST [ TXO F,CM%ESC ;YES
RET]
CAIN T1,.CHLFD ;END OF LINE?
TXO F,CM%EOC ;YES, MEANS END OF COMMAND
RET
CMCIN1: STKVAR <CMCSF,<CMCSAC,7>,CMCSC,CMCBLF>
MOVEM F,CMCSF ;PRESERVE ACS USED BY TEXTI
SETZM CMCBLF ;INIT ACCUMULATED FLAGS
MOVEI T1,CMCSAC
HRLI T1,Q1
BLT T1,P4-Q1+CMCSAC ;SAVE Q1-P4
MOVX T1,RD%JFN+RD%BBG ;SET UP FLAGS
TXNE F,CM%RAI ;RAISE INPUT REQUESTED?
TXO T1,RD%RAI ;YES, PASS IT
TXNE F,CM%WKF ;WAKING ON EVERY FIELD?
TXO T1,RD%BEG ;YES, SO WE WANT REPARSE ON ^U
MOVEI Q3,REGBRK ;FIRST ASSUME REGULAR BREAK SET
TXNE F,CM%WKF ;WAKING ON EVERY FIELD?
MOVEI Q3,ALLBRK ;YES, SO BREAK ON ALL PUNCTUATION TOO
MOVE F,T1 ;PASS FLAGS TO TEXTI
UMOVE Q1,.CMRTY(P2) ;SET UP ^R BUFFER
UMOVE Q2,.CMBFP(P2) ;SET UP TOP OF BUFFER
UMOVE P1,.CMIOJ(P2) ;SET UP JFNS
MOVE P2,P4 ;SET BACKUP LIMIT AS CURRENT PTR
MOVEM P3,CMCSC ;SAVE CURRENT COUNT
SUB P3,P5 ;ADJUST COUNT FOR ADVANCE INPUT
ADJBP P5,P4 ;PUSH POINTER PAST CURRENT INPUT
MOVEM P5,P4
CMCIN2: MOVE T1,P2-Q1+CMCSAC ;RESTORE P2 TO T1
XCTU [HLRZ T1,.CMIOJ(T1)] ;GET INPUT JFN
GTSTS
TXNE T2,GS%EOF ;AT EOF?
ITERR COMNX9 ;YES, BOMB
SKIPG P3 ;ROOM IN BUFFER FOR MORE INPUT?
ITERR COMNX3 ;NO
MOVE A,P2-Q1+CMCSAC ;RESTORE P2 TO A
CALL ITEXTI ;DO INTERNAL TEXTI
ITERR ;FAIL, POSSIBLY BAD INPUT JFN
TXNE F,RD%BFE ;BUFFER EMPTY?
JRST CMCIN4 ;YES
IORB F,CMCBLF ;ACCUMULATE FLAGS (RD%BLR)
TXNE F,RD%BLR ;BACKUP LIMIT REACHED?
JRST CMCIN4 ;YES, CLEANUP AND REPARSE
MOVE P5,CMCSC ;RECOVER PREVIOUS COUNT
SUB P5,P3 ;COMPUTE CHARACTERS JUST APPENDED
MOVSI T1,CMCSAC ;RESTORE ACS Q1-P4, F
HRRI T1,Q1
BLT T1,P4
MOVE F,CMCSF
RET
;HERE ON RETURN FROM TEXTI WHICH REACHED BACKUP LIMIT OR WHICH RETURNED
;BECAUSE BUFFER EMPTY. MUST REPARSE LINE. RESTORE ACS, BUT LEAVE
;MAIN POINTER AS RETURNED BY TEXTI.
CMCIN4: DMOVE Q1,Q1-Q1+CMCSAC ;RESTORE Q1-P2
DMOVE Q3,Q3-Q1+CMCSAC
MOVE P2,P2-Q1+CMCSAC
MOVE F,CMCSF ;RESTORE F
JRST XCOMRF ;RETURN REPEAT PARSE
;SKIP LEADING TABS OR SPACES
CMSKSP: CALL CMCIN ;GET A CHAR
CAIE T1," " ;SPACE OR TAB?
CAIN T1,.CHTAB
JRST CMSKSP ;YES, KEEP LOOKING
;**;[3067] Add the [3043] comment JMP 5-JAN-84
;**;[3043] At CMSKP+4 replace 1 line with 3 lines JMP 10-NOV-83
TXNN F,CM%NOC ;[3043] CAN SEMI COLON CAUSE A COMMENT?
CAIE T1,CMCOM2 ;[3043] YES, IS THIS A SEMI COLON?
SKIPA ;[3043] SEMI COLON WILL NOT CAUSE A COMMENT
JRST CMCMT2 ;YES
CAIN T1,CMCOM1
JRST CMCMT1 ;YES
CALLRET CMDIP ;NO, PUT IT BACK AND RETURN
;COMMENT
CMCMT2: SETO T1, ;SAY NO TERMINATOR OTHER THAN EOL
CMCMT1: MOVEM T1,Q2 ;REMEMBER MATCHING TERMINATOR
CMCOM: CALL RDCRLF ;NL?
CAIA ;NO
JRST [ CALL UNCRLF ;YES, PUT IT BACK
JRST CMSKSP] ;DO WHATEVER
CAIE T1,CMFREC ;RECOG REQUEST?
CAIN T1,.CHESC
CALL CMAMB ;YES, DING
CAMN T1,Q2 ;MATCHING CHARACTER?
JRST CMSKSP ;YES, END OF COMMENT
JRST CMCOM ;NO, KEEP LOOKING
;LOCAL ROUTINE - SUBTRACT ASCII BYTE PTRS
; T1, T2/ ASCII BYTE PTRS
; CALL SUBBP
; RETURNS +1 ALWAYS,
; T1/ T1-T2
SUBBP: HRRZ T3,T1 ;COMPUTE 5*(A1-A2)+(P2-P1)/7
SUBI T3,0(T2)
IMULI T3,5 ;COMPUTE NUMBER CHARS IN THOSE WORDS
LDB T1,[POINT 6,T1,5]
LDB T2,[POINT 6,T2,5]
SUBM T2,T1
IDIVI T1,7
ADD T1,T3
RET
;LOCAL ROUTINE - DELETE LAST CHAR INPUT
CMDCH: MOVNI T1,1 ;BACK UP BYTE POINTER
ADJBP T1,P4
MOVE P4,T1
AOS P3 ;ADJUST SPACE COUNT
SETZ P5, ;CAN'T BE ANY WAITING INPUT
RET
;LOCAL ROUTINE - DECREMENT INPUT POINTER
CMDIP: XCTBU [LDB T1,P4] ;CHECK THE CHARACTER
CAIE T1,CMFREC ;A RECOG REQUEST CHAR?
CAIN T1,.CHESC
TXZ F,CM%ESC+CMCFF ;YES, RESET FLAGS
MOVNI T1,1 ;BACK UP THE COMMAND POINTER ONE BYTE
ADJBP T1,P4
MOVE P4,T1
AOS P5 ;ADJUST COUNTS
AOS P3
RET
;ROUTINE TO UNREAD END-OF-LINE.
UNCRLF: CALL CMDIP ;PUT THE LINEFEED BACK
XCTBU [LDB T1,P4] ;GET CHARACTER BEFORE LINEFEED
CAIE T1,.CHCRT ;CARRIAGE RETURN?
RET ;NO, DON'T UNREAD IT
CALLRET CMDIP ;YES, UNREAD IT TOO
;ROUTINE TO CALL TO GUARANTEE NULL AT END OF COMMAND SO FAR.
TIECMD: MOVEI T1,.CHNUL ;GET A NULL
CALL CMDIBQ ;PUT IT IN COMMAND, CHECKING FOR ROOM
AOJ P3, ;DON'T REALLY COUNT IT HOWEVER
MOVNI T1,1
ADJBP T1,P4 ;LEAVE BYTE POINTER SO NEXT IDPB OVERWRITES NULL
MOVE P4,T1
RET
;LOCAL ROUTINE - DEPOSIT INTO INPUT BUFFER
CMDIB: CALL CMCOUT ;TYPE THE CHAR
CMDIBQ: SETZ P5, ;CLEAR ADVANCE COUNT
SOSGE P3 ;ROOM?
JRST [ TXNE F,CMINDF ;READING INDIRECT FILE?
CALL CME0 ;YES, CLOSE IT
ITERR COMNX3] ;SAY OUT OF ROOM
XCTBU [IDPB T1,P4] ;APPEND BYTE TO USER'S BUFFER
RET
;APPEND CHARACTER TO INPUT BUFFER
; T1/ CHARACTER
CMAPC: MOVEM T1,T4 ;SAVE CHAR
MOVE T2,P5 ;ADVANCE COUNT
ADJBP T2,P4 ;COMPUTE POINTER TO END OF INPUT
XCTBU [IDPB T4,T2] ;APPEND THE CHAR
AOS P5 ;UPDATE ADVANCE COUNT
RET
;DO CALLER-SUPPLIED HELP TEXT IF ANY
DOHLP: TXNN F,CM%HPP ;USER SPECIFING HELP MESSAGE?
TXNN F,CM%SDH ;NO, ALSO SUPPRESSING DEFAULT HELP?
SKIPA ;PRINTING AT LEAST ONE MESSAGE
RET ;NOT PRINTING ANYTHING
HRROI T1,[ASCIZ /
or/]
TXNE F,CMQUE2 ;IN ALTERNATE HELP POSSIBILITIES?
CALL CMSOUT ;YES, NOT ALTERNATIVE
TXNN F,CM%HPP ;HAVE HELP POINTER?
RET ;NO
MOVEI T1," "
CALL CMCOUT ;SPACE BEFORE USER TEXT
HRRZ T1,P1
UMOVE T1,.CMHLP(T1) ;YES, GET IT
CALL CMUSOU ;YES, TYPE IT
RET
;HANDLE AMBIGUOUS TYPE-IN
;DOESN'T RETURN, BUT "CALL CMAMB" IS OFTEN MORE USEFUL THAN "JRST CMAMB"
;SO DURING DEBUGGING YOU CAN TELL HOW YOU GOT HERE
;CMAMBT GIVES NOPARSE IF NOT LAST ITEM IN LIST
CMAMBT: HRRZ T1,P1
ULOAD T1,CM%LST,.CMFNP(T1) ;GET PTR TO NEXT FN BLOCK
JUMPN T1,[NOPARS NPXAMB] ;NO PARSE IF ANOTHER FN AVAILABLE
CMAMB: TXZN F,CM%ESC ;ESC SEEN?
JRST [ NOPARS NPXAMB] ;NO, SAME AS UNREC
XCTBU [LDB T1,P4] ;GET LAST CHARACTER
CAIE T1,CMFREC ;CHECK FOR ^F
CAIN T1,.CHESC ;DON'T FLUSH IT UNLESS RECOGNITION CHARACTER
;CHECK NECESSARY BECAUSE IF PARTIAL RECOGNITION
;DONE, ESCAPE WAS ALREADY REMOVED FROM
;BUFFER BEFORE APPENDING THE RECOGNITION STUFF
CALL CMDCH ;FLUSH RECOG CHAR FROM BUFFER
MOVEI T1,.CHBEL ;INDICATE AMBIGUOUS
CALL CMCOUT
JRST XCOMRF ;GET MORE INPUT AND RESTART
;OUTPUT CHARACTER TO SPECIFIED DESTINATION
; T1/ CHAR
; CALL CMCOUT
; RETURNS +1 ALWAYS
CMCOUT: MOVE T2,T1
XCTU [HRRZ T1,.CMIOJ(P2)] ;GET OUTPUT JFN
BOUT
MOVE T1,T2 ;RESTORE CHARACTER
RET
;OUTPUT STRING FROM CURRENT CONTEXT
; T1/ STRING PTR
; CALL CMSOUT
; RETURN +1 ALWAYS
CMSOUT: MOVE T2,T1
XCTU [HRRZ T1,.CMIOJ(P2)] ;GET OUTPUT JFN
SETZ T3,
SOUT
RET
;OUTPUT STRING FROM PREVIOUS CONTEXT
; T1/ STRING PTR
; CALL CMUSOU
; RETURNS +1 ALWAYS
CMUSOU: CALL CHKBP ;CHECK BYTE PTR
ITERR COMX16 ;BAD
MOVEM T1,T4
XCTU [HRRZ T1,.CMIOJ(P2)] ;GET OUTPUT JFN
CMUSO1: XCTBU [ILDB T2,T4] ;GET BYTE FROM PREVIOUS
JUMPE T2,R ;DONE ON NULL
BOUT
JRST CMUSO1
;CHECK ALL BYTE PTRS
; T1/ PTR TO LIST OF ADDRESSES, TERMINATED BY 0
CHKABP: SAVEQ
MOVEM T1,Q1 ;SAVE LIST PTR
CHKAB1: HRRZ Q2,0(Q1) ;GET NEXT ADDRESS
JUMPE Q2,R ;DONE ON 0
ADDI Q2,0(P2) ;MAKE PTR TO BLOCK
UMOVE T1,0(Q2) ;GET BYTE PTR
CALL CHKBP ;CHECK AND NORMALIZE
JRST [ HLRZ T1,0(Q1) ;BAD, GET ERROR CODE
ITERR ()] ;RETURN
UMOVEM T1,0(Q2) ;PUT IT BACK
AOJA Q1,CHKAB1 ;DO NEXT
;CHECK A BYTE PTR
; T1/ BYTE PTR - IF LH IS -1, PTR IS FIXED
CHKBP: HLRZ T2,T1
CAIN T2,-1
HRLI T1,(POINT 7,0)
LDB T2,[POINT 6,T1,11] ;GET BYTE SIZE
CAIE T2,7 ;PROPER?
RET ;NO
IBP T1 ;INCREMENT AND DECREMENT TO NORMALIZE
CALL DBP
RETSKP ;RETURN GOOD
;************************
;FUNCTIONS
;************************
;INITIALIZE LINE AND CHECK FOR REDO REQUEST
XCMINI: CALL OSYNCH ;SYNCHRONIZE OUTPUT DUE TO POSSIBLE ^O
XCTU [SKIPE Q1,.CMRTY(P2)] ;DO PROMPT IF ANY
CMINI2: XCTU [CAMN Q1,.CMBFP(P2)] ;STOP AT TOP OF BUFFER
JRST CMINI1
XCTBU [ILDB T1,Q1]
JUMPN T1,[CALL CMCOUT
JRST CMINI2]
CMINI1: XCTU [CAMN P4,.CMBFP(P2)] ;BUFFER EMPTY?
JRST CMINI4 ;YES, NO REDO POSSIBLE
XCTBU [LDB T1,P4] ;CHECK LAST CHAR
CAIN T1,.CHLFD ;END OF LINE?
JRST CMINI4 ;YES, LAST COMMAND OK, NO REDO
XCTU [HLRZ T1,.CMIOJ(P2)] ;GET IN JFN
RFMOD ;GET CURRENT WAKEUP CLASS
MOVE T4,T2 ;SAVE IN T4
TXO T2,TT%WAK ;MAKE SURE WE WAKE AFTER FIRST CHARACTER
SFMOD
BIN ;READ FIRST CHAR
EXCH T2,T4 ;PUT CHARACTER IN T4, ORIGINAL WAKEUP CLASS IN T2
SFMOD ;RESTORE WAKEUP BITS (APPROXIMATELY!)
CAIN T4,CMRDOC ;THE REDO CHARACTER?
JRST CMINI3 ;YES
BKJFN ;NO, PUT IT BACK
JFCL
CMINI4: MOVE T1,P4 ;RESET LINE VARIABLES
UMOVE T2,.CMBFP(P2)
MOVEM T2,P4
CALL SUBBP ;COMPUTE CHARACTERS IN LINE
ADDM T1,P3 ;UPDATE SPACE COUNT
SETZ P5, ;RESET ADVANCE COUNT
JRST XCOMXI ;RETURN GOOD
CMINI3: UMOVE P3,.CMCNT(P2) ;RESET VARIABLES TO CURR FIELD
UMOVE P4,.CMPTR(P2)
SETZ P5, ;NO INPUT
MOVEI T1,.CHLFD ;START NEW LINE
CALL CMCOUT
CALL CMRTY0 ;RETYPE
JRST XCOMRF ;RETURN TO REPARSE
;SWITCH - LIKE KEYWORD BUT PRECEDED BY SLASH
XCMSWI: TXO F,CMSWF ;NOTE DOING SWITCH
CALL CMRFLD ;READ SWITCH FIELD
JRST KEYW0 ;FINISH LIKE KEYWORD
;KEYWORD LOOKUP FUNCTION
XCMKEY: TXZ F,CMSWF ;NOT SWITCH
CALL CMRFLD ;GET INPUT
KEYW0: CALL DOLOOK ;PERFORM THE LOOKUP
TXNE F,CMQUES ;HAD "?"
JRST CMQ1 ;YES, GO TYPE ALTERNATIVES
MOVE Q1,T2 ;RETURN FLAGS
TXNE Q1,TL%AMB ;IF NOT AMBIGUOUS OR
TXNN F,CMSWF ;IF NOT DOING SWITCH,
JRST KEYW1 ;SKIP FOLLOWING CODE
JUMPE P5,KMAMB ;IF NOTHING ELSE IN BUFFER, CAN'T PEEK AHEAD
CALL CMCIN ;SWITCH AND AMBIGUOUS, SEE IF COLON NEXT
CAIE T1,CMSWTM ;DID USER TYPE COLON AFTER SWITCH?
JRST [ CALL CMDIP ;NO, UNREAD THE NONCOLON
CALL KMAMB] ;GO DING, IT'S A REAL AMBIGUOUS SWITCH
CALL STOLCH ;THERE'S A COLON, SO TRY PUTTING IT ON ATOM
CALL CMDIP ;UNREAD THE COLON
CALL TIELCH ;GUARANTEE NULL AFTER COLON IN ATOM BUFFER
CALL DOLOOK ;TRY THE LOOKUP WITH THE COLON THERE
MOVEI T1,1 ;PREPARE TO REMOVE COLON
CALL SHRINK ;NOW WE KNOW THERE'S SOMETHING LIKE "/A:" AND
;"/AB:" IN TABLE AND USER TYPED "/A:"
JXN Q1,TL%NOM,KMAMB ;IF WAS AMB AND COL MAKES IT NOM, THEN USE ORIGINAL DIAGNOSIS
KEYW1: JXN Q1,TL%NOM,[NOPARS NPXNOM] ;NO MATCH
JXN Q1,TL%AMB,KMAMB ;DING
TXNN Q1,TL%ABR ;AN ABBREVIATION?
SETZ T3, ;NO, REMAINDER OF STRING IS NULL
MOVEM T1,Q1 ;SAVE TABLE INDEX
XCTU [HLRZ T2,0(Q1)]
CALL CHKTBS ;GET TABLE ENTRY FLAGS
JXE T1,CM%ABR,KEYW3 ;JUMP IF NOT ABBREVIATION
CALL CHKLCH ;GET NUMBER OF CHARACTERS TYPED
MOVEM T1,Q2 ;SAVE IT
XCTU [HRRZ Q1,0(Q1)] ;GET ENTRY FOR WHICH THIS IS AN ABBREVIATION
XCTU [HLRZ T2,0(Q1)]
CALL CHKTBS ;GET STRING PTR FOR IT
MOVE T3,Q2 ;SKIP OVER PART OF STRING ALREADY TYPED
ADJBP T3,T2
KEYW3: UMOVEM Q1,T2 ;RETURN TABLE INDEX
JXE F,CM%ESC,KEYW4 ;DONE IF NO REC WANTED
MOVEM T3,Q1 ;SAVE PTR TO REMAINDER OF STRING
CALL CMDCH ;FLUSH RECOG CHARACTER
KEYW2: XCTBU [ILDB T1,Q1] ;TYPE REMAINDER OF KEYWORD
JUMPE T1,XCOMXI ;DONE
CALL CMDIB ;APPEND COMPLETION TO BUFFER
;**;[2620] Add 2 lines at KEYW2:+3L PED 20-MAY-82
TXNN F,CMSWF ;[2620] PARSING A SWITCH?
JRST KEYW2 ;[2620] NO
CAIN T1,CMSWTM ;A SWITCH TERMINATOR?
JRST [ TXZ F,CM%ESC ;YES, OVERRIDES ESC
TXO F,CM%SWT ;NOTE SWITCH TERMINAOTR
TXNN F,CMSWF ;IN SWITCH?
CALL CMDIP ;NO, PUT TERMINATOR BACK
JRST XCOMXI] ;DONE
JRST KEYW2
KEYW4: CALL CHKLCH ;SEE IF ATOM NON-NULL
JUMPE T1,[NOPARS NPXNUL] ;FAIL IF NULL
JXE F,CMSWF,XCOMXI ;DONE IF NOT SWITCH
CALL CMSKSP ;SKIP SPACES
CALL CMCIN ;GET NON-BLANK CHAR
CAIN T1,CMSWTM ;SWITCH TERMINATOR?
JRST [ TXO F,CM%SWT ;YES, NOTE
JRST XCOMXI] ;DONE
CALL CMDIP ;NO, PUT IT BACK
JRST XCOMXI ;OTHERWISE OK
DOLOOK: UMOVE T2,.CMABP(P2) ;POINT TO KEYWORD BUFFER
MOVE T1,FNARG ;GET TABLE HEADER ADDRESS
CALL XTLOOK ;LOOKUP
ITERR () ;BAD TABLE
RET
;COME HERE WHEN SWITCH OR KEYWORD IS AMBIGUOUS. IF THE USER TYPED ESCAPE,
;THEN WE'LL NOW TRANSFER TO CMAMB TO BEEP. IF ESCAPE WAS NOT TYPED AND THE
;ATOM BUFFER IS EMPTY MEANING THE USER TYPED NOTHING (SUCH AS CONFIRMING WHEN
;A SWITCH OR KEYWORD WAS REQUIRED), WE'LL GIVE THE NPXNUL ERROR.
KMAMB: JXN F,CM%ESC,CMAMB ;IF SHE TYPED ESCAPE, GO BEEP
CALL CHKLCH ;GET LENGTH OF ATOM BUFFER
JUMPN T1,CMAMB ;DO STANDARD AMBIGUOUS STUFF IF SOMETHING IN ATOM BUFFER
NOPARS NPXNUL ;OTHERWISE SAY KEYWORD OR SWITCH MISSING
;"?" TYPED, FIRST PARTIAL MATCH FOUND. TYPE ALL PARTIAL MATCHES
CMQ1: JXN T2,TL%NOM,[
CALL DOHLP ;DO USER HELP IF ANY
JXN F,CMQUE2,CMRTYP ;DO NOTHING IF NOT FIRST ALTERNATIVE
TXNE F,CM%SDH ;DEFAULT HELP SUPPRESSED?
JRST CMRTYP ;YES, DONE
HRROI T1,[ASCIZ / keyword (no defined keywords match this input)/]
CALL CMSOUT ;TYPE MESSAGE
JRST CMRTYP] ;RETYPE LINE AND CONTINUE
CMQ3: MOVEM T1,Q2 ;SAVE TABLE INDEX
CALL DOHLP ;DO USER HELP IF ANY
TXNE F,CM%SDH ;DEFAULT HELP SUPPRESSED?
JRST CMRTYP ;YES, DONE
MOVE Q3,FNARG ;GET TABLE PTR
XCTU [HLRZ Q1,0(Q3)] ;GET TABLE SIZE
MOVE T1,Q1 ;SAVE THE LENGTH OF THE TABLE
ADDI Q1,1(Q3) ;COMPUTE TABLE END ADDRESS FOR BELOW
CAIN T1,1 ;ONLY ONE ELEMENT IN THE TABLE
JRST CMQ6 ;YES.. BYPASS "ONE OF THE FOLLOWING"
HRROI T1,[ASCIZ / one of the following:
/]
CALL CMSOUT
CMTAB0: SOJ Q2, ;GETS INCREMENTED BEFORE EACH APPLICATION
MOVE Q3,Q2 ;SAVE IN Q3 SO IT CAN BE REINITIALIZED
SETZM TABSIZ ;START WITH TAB SIZE OF 0
SETOM PWIDTH ;MARK THAT WE DON'T KNOW WIDTH YET
CMTAB1: CALL CMNXTE ;GET TO NEXT VALID KEYWORD IN TABLE
JRST CMTAB2 ;NO MORE IN TABLE
CALL CMGTLN ;CALCULATE LENGTH OF KEYWORD
CAML T1,TABSIZ ;LONGEST SEEN SO FAR?
MOVEM T1,TABSIZ ;YES, REMEMBER IT
JRST CMTAB1 ;LOOK AT REST
CMTAB2: MOVE T1,TABSIZ
MOVEM T1,BIGSIZ ;REMEMBER LENGTH OF LONGEST KEYWORD
MOVEI T1,1+3 ;1 SPACES AFTER CRLF AND LEAVE AT LEAST 3 SPACE BETWEEN ITEMS
ADDM T1,TABSIZ
MOVE Q2,Q3 ;RESTART TABLE POINTER FOR ACTUAL LISTING
CMQ5: CALL CMNXTE ;GET TO NEXT KEYWORD
JRST CMRTYP ;NO MORE, REPEAT COMMAND SO FAR AND CONTINUE
CALL KEYTAB ;JUSTIFY "TYPEBALL" FOR KEYWORD TYPEOUT
CALL CMUSOU ;TYPE IT
JRST CMQ5 ;TRY NEXT
CMQ6: MOVEI T1," " ;GET A BLANK
CALL CMCOUT ;OUTPUT THE CHARACTER
JRST CMTAB0 ;CONTINUE TABLE PROCESSING
;ROUTINE WHICH TAKES POINTER TO TABLE IN Q2, POINTER TO END OF TABLE
;IN Q1, AND RETURNS POINTER TO KEYWORD NAME IN T1. SKIPS UNLESS TABLE
;IS EXHAUSTED. ONLY CONSIDERS PRINTABLE KEYWORDS, AND UPDATES Q2.
CMNXTE: AOS Q2 ;LOOK AT NEXT TABLE ENTRY
CMQ2: CAML Q2,Q1 ;BEYOND END OF TABLE?
RET ;YES, FINISHED LIST
XCTU [HLRZ T2,0(Q2)] ;GET STRING PTR FOR IT
CALL CHKTBS ;GET FLAGS FROM STRING
JXN T1,CM%INV+CM%NOR,CMNXTE ;SKIP ENTRY IF INVISIBLE OR NOREC
UMOVE T1,.CMABP(P2) ;POINT TO KEYWORD BUFFER
CALL USTCMP ;COMPARE
JUMPE T1,CMQ4 ;OK IF EXACT MATCH
JXE T1,SC%SUB,R ;DONE IF NOT SUBSTRING
CMQ4: XCTU [HLRZ T2,0(Q2)] ;GET PTR TO STRING FOR THIS ENTRY
CALL CHKTBS
MOVE T1,T2
RETSKP
;ROUTINE TO CALL BEFORE TYPING KEYWORD IN RESPONSE TO "?". GIVE
;IT USER'S BYTE POINTER IN T1. IT DECIDES WHETHER KEYWORD WILL FIT
;ON THIS LINE, AND STARTS NEW LINE IF NOT. IT THEN OUTPUTS A TAB,
;FOLLOWED BY SWITCH DELIMITER (IF KEYWORD IS A SWITCH).
KEYTAB: SAVET ;DON'T CLOBBER USER'S BYTE POINTER
CALL CMGTLN ;COMPUTE LENGTH OF KEYWORD
MOVEM T1,KEYSIZ ;REMEMBER LENGTH
XCTU [HRRZ T1,.CMIOJ(P2)] ;GET OUTPUT CHANNEL
SKIPL PWIDTH ;DO WE ALREADY KNOW HOW WIDE PAPER IS?
JRST KEY2 ;YES, SO DON'T DO SYSTEM CALL
RFMOD ;ASK SYSTEM WHERE RIGHT MARGIN IS
LDB T3,[220700,,T2] ;ISOLATE RIGHT MARGIN VALUE
CAIE T3,1 ;RIGHT MARGIN TOO LARGE FOR RFMOD?
JRST KEY3 ;NO, WE'VE GOT IT
MOVEI T2,.MORLW ;YES, ASSUME TERMINAL AND READ IT WITH MTOPR
MTOPR
KEY3: MOVEM T3,PWIDTH ;SAVE WIDTH, SO NO JSYS CALL NEXT TIME
JRST KEY5 ;FIRST TIME THROUGH, ASSUME NO TAB NEEDED
KEY2: CALL GETPOS ;FIND OUT WHERE ON LINE WE ARE
MOVEM T2,CURPOS ;REMEMBER WHERE WE ARE
CALL CMTAB ;SEE WHERE TAB BRINGS US
ADD T2,BIGSIZ ;MAKE SURE WE HAVE ROOM FOR ANOTHER COLUMN
HRROI T1,[ASCIZ /
/]
CAMG T2,PWIDTH ;ROOM FOR ANOTHER KEYWORD ON THIS LINE?
JRST KEY4 ;YES, SO DON'T START NEW LINE
CALL CMSOUT ;GET TO NEXT LINE
CALL GETPOS ;FIGURE OUT WHERE WE ARE NOW
MOVEM T2,CURPOS
CAIA ;NO TAB NECESSARY AT BEGINNING OF LINE
KEY4: CALL TYPTAB ;TYPE A TAB
KEY5: MOVX T1,CMSWCH
TXNE F,CMSWF ;IN SWITCH FIELD?
CALL CMCOUT ;YES, TYPE SWITCH INDICATOR
RET ;READY TO TYPE KEYWORD ALL ON SAME LINE NOW
CMTAB: ADD T2,TABSIZ ;FIGURE OUT MAXIMUM PLACE TAB CAN MOVE US TO
IDIV T2,TABSIZ ;SCALE DOWN TO REALLY WHERE
IMUL T2,TABSIZ ;TAB WILL BRING US TO
RET
;ROUTINE TO TYPE TAB OF SIZE TABSIZ. IT ASSUMES HARDWARE TABS ARE OF
;SIZE 8 AND TRIES TO TYPE AS MANY REAL TABS AS IT CAN, AND THEN SPACES
;OVER REST OF THE WAY.
TYPTAB: MOVE T2,CURPOS ;SEE WHERE WE'RE STARTING ON LINE
MOVEM T2,CURSOR ;REMEMBER WHERE WE ARE
CALL CMTAB ;SEE WHERE WE WANT TO GET TO
MOVEM T2,TABDON ;REMEMBER WHERE WE WANT TO GET TO
TYPTB2: MOVE T1,CURSOR ;GET WHERE WE ARE
ADDI T1,8 ;HARDWARE TAB MIGHT GO THIS FAR
TRZ T1,7 ;BUT MAYBE NOT QUITE
CAMLE T1,TABDON ;WILL HARDWARE TAB GO TOO FAR?
JRST TYPTB1 ;YES
MOVEM T1,CURSOR ;NO, SO REMEMBER WHERE IT BRINGS US
MOVEI T1,.CHTAB
CALL CMCOUT ;AND TYPE IT
JRST TYPTB2 ;LOOP FOR AS MANY HARDWARE TABS AS WE CAN GET AWAY WITH
TYPTB1: AOS T1,CURSOR ;START SINGLE SPACING
CAMLE T1,TABDON ;ARE WE THERE YET?
RET ;YES, SO TAB IS TYPED
MOVEI T1," " ;NO, SO SPACE OVER
CALL CMCOUT
JRST TYPTB1 ;AND LOOP FOR REST OF SPACES
;ROUTINE TO FIND OUT WHERE ON LINE WE ARE. IF NOT A TERMINAL, ASSUMES
;WE'RE AT RIGHT MARGIN (COLUMN 72)
GETPOS: RFPOS ;FIND WHERE ON LINE WE ARE
CAIN T2,0 ;NOT A TERMINAL?
MOVEI T2,^D72 ;RIGHT, SO ASSUME WE'RE AT COLUMN 72
HRRZ T2,T2 ;ISOLATE COLUMN POSITION
RET
;ROUTINE TAKING POINTER TO KEYWORD IN T1. RETURNS KEYWORD LENGTH IN
;T1. GIVES EXTRA 1 FOR SWITCH, ASSUMING A SLASH WILL PREFIX ITS
;PRINTOUT.
CMGTLN: MOVEI T4,0 ;COUNT OF NUMBER OF CHARACTERS NEEDED FOR THIS KEYWORD
KEY1: XCTBU [ILDB T2,T1] ;PICK UP NEXT CHARACTER FROM KEYWORD
CAIE T2,0 ;ASSUME KEYWORD ENDS ON NULL
AOJA T4,KEY1 ;NOT OVER YET, ACCUMULATE ITS LENGTH
TXNE F,CMSWF ;IS THIS A SWITCH?
AOJ T4, ;YES, DELIMITER TAKES UP ANOTHER SPACE
MOVE T1,T4 ;RETURN LENGTH IN T1
RET
;READ REST OF LINE AS ATOM
XCMTXT: CALL CMRFLD ;READ TEXT
JXN F,CMQUES,[
TXNN F,CMQUE2 ;IF IN MIDDLE OF HELP LIST, THEN "?" ALWAYS DOES HELP
JUMPN T1,XCMTQ ;USUALLY "?" IS JUST PART OF TEXT
CALL DOHLP ;DO USER HELP
HRROI T1,[ASCIZ / text string/]
TXNN F,CM%SDH
CALL CMSOUT ;TYPE HELP UNLESS SUPPRESSED
JRST CMRTYP] ;NO DEFAULT MESSAGE
JXN F,CM%ESC,CMAMB ;JUST DING IF HE TRIES TO DO RECOGNITION
JRST XCOMXI ;DONE
XCMTQ: MOVEI T1,CMHLPC ;PUT QUESTION MARK IN TEXT
CALL STOLCH
CALL TIELCH ;TIE OFF ATOM BUFFER IN CASE IT IS LAST CHARACTER
TXZ F,CMQUES ;FORGET THAT WE'RE IN HELP STATE
JRST XCMTXT ;READ REST OF TEXT
;NOISE WORD FUNCTION
XCMNOI: MOVE T1,FNARG ;GET STRING PTR
CALL CHKBP ;CHECK AND NORMALIZE
ITERR COMX17 ;BAD
MOVEM T1,Q3
TXNN F,CM%PFE ;PREVIOUS FIELD ENDED WITH ESC?
JRST CMNOI1 ;NO
CMNOI4: TXO F,CM%ESC ;YES, MEANS THIS ONE DID TOO
CMN1: JUMPN P5,[CALL CMCIN ;PASS OVER SPACE PROVOKED BY ESC ON PREVIOUS COMMAND
JRST CMN1]
MOVEI T1,NOIBCH ;TYPE NOISE BEG CHAR
CALL CMDIB ; AND PUT IT IN BUFFER
CMNOI3: XCTBU [ILDB T1,Q3] ;GET NEXT NOISE CHAR
JUMPN T1,[CALL CMDIB ;PUT IT IN BUFFER IF NOT END OF STRING
JRST CMNOI3]
MOVEI T1,NOIECH ;END OF STRING, TYPE END CHAR
CALL CMDIB
JRST XCOMXI ;EXIT
;PREVIOUS FIELD NOT TERMINATED WITH ESC - PASS NOISE WORD IF TYPED
CMNOI1: CALL CMSKSP ;BYPASS SPACES
CALL CMCIN ;GET FIRST CHAR
CAIE T1,NOIBCH ;NOISE BEG CHAR?
JRST [ CALL CMDIP ;NO, NOT A NOISE WORD, PUT IT BACK
JRST XCOMXI] ;RETURN OK
CMNOI2: CALL CMCIN ;GET NEXT NOISE CHAR
CAIE T1,CMFREC ;^F?
CAIN T1,.CHESC ;ESC?
JRST [ CALL CMDCH ;YES, FLUSH IT
JRST CMNOI3] ;COMPLETE NOISE WORD FOR USER
XCTBU [ILDB T2,Q3] ;COMPARE WITH GIVEN STRING
CAIL T1,"A"+40 ;CONVERT TO UC
CAILE T1,"Z"+40
SKIPA
SUBI T1,40
CAIL T2,"A"+40
CAILE T2,"Z"+40
SKIPA
SUBI T2,40
CAMN T1,T2
JRST CMNOI2 ;STILL SAME AS EXPECTED
CAIN T1,NOIECH ;NOT SAME, STRING ENDED TOGETHER?
JUMPE T2,XCOMXI ;YES, EXIT OK
NOPARS NPXINW ;NO, PROBABLY BAD NOISE WORD
;CONFIRM
XCMCFM: CALL CMCFM0 ;DO THE WORK
CAIA ;FAILED
JRST XCOMXI ;OK
NOPARS NPXNC
CMCFM0: CALL RDCRLF ;CRLF SEEN?
CAIA ;NO
RETSKP ;YES, DONE
CAIE T1,.CHTAB ;BLANK?
CAIN T1," "
JRST CMCFM0 ;YES, IGNORE
CAIN T1,CMHLPC ;HELP?
JRST [ CALL DOHLP ;DO USER HELP
HRROI T1,[ASCIZ / confirm with carriage return/]
TXNN F,CM%SDH
CALL CMSOUT ;GIVE HELP MESSAGE
;**;[3009] Add two lines YKT SEP-06-83
SKIPE INDFLG ;[3009] IS INDIRECT FILE?
CALL INDRLJ ;[3009] YES, SO RELEASE THE JFN
JRST CMRTYP] ;RETYPE AND TRY AGAIN
CAIE T1,CMFREC ;^F?
CAIN T1,.CHESC ;ESC?
;**[3009] Add two lines YKT SEP-06-83
JRST [SKIPE INDFLG ;[3009] IS INDIRECT FILE?
CALL INDRLJ ;[3009] YES, SO RELEASE THE JFN
CALL CMAMBT] ;AMBIGUOUS
RET ;NO, FAIL
;FLOATING POINT NUMBER
XCMFLT: CALL CMRFLD ;READ FIELD
JXN F,CMQUES,[CALL DOHLP
HRROI T1,[ASCIZ / number/]
TXNN F,CM%SDH ;SUPPRESS DEFAULT?
CALL CMSOUT ;NO, DO IT
JRST CMRTYP]
UMOVE T1,.CMABP(P2) ;NUMBER NOW IN ATOM BUFFER, GET PTR
UMOVEM T1,T1
IMCALL .FLIN,MSEC1
JRST XCOMNP ;FAILED
JRST CMNUMR ;DO NUMBER CLEANUP AND RETURN
;FLOATING POINT BREAK SET MASK, ALLOWS +, -, ., E, NUMBERS
FLTBRK: 777777,,777760
777644,,001760
400000,,000760
400000,,000760
;NUMBER
XCMNUM: CALL CMRFLD ;READ FIELD
TXNE F,CMQUES ;SAW "?"
JRST CMNUMH ;YES
XCMNX1: UMOVE T1,.CMABP(P2) ;SET UP NIN
UMOVEM T1,T1
MOVE T3,FNARG ;GET RADIX
UMOVEM T3,T3
IMCALL .NIN,MSEC1
JRST XCOMNP ;FAILS
CMNUMR: MOVE T2,ATBPTR
IBP T2 ;BUMP PTR PAST TERMINATOR
CAMN T1,T2 ;NIN SAW WHOLE FIELD?
JRST XCOMXR ;RETURN NUMBER ALREADY IN T2
;**;[3067] Add the comment line JMP 5-JAN-84
;**;[3045] At CMNUMR+4 replace 1 line with 2 lines JMP 10-NOV-83
HRRZ T4,P1 ;[3045] GET ADDRESS OF USER FUNCTION BLOCK
ULOAD T3,CM%FNC,.CMFNP(T4) ;[3045] GET FUNCTION CODE
CAIE T3,.CMNUX ;A .CMNUX FUNCTION?
JRST [ NOPARS NPXICN] ;NO, INVALID CHARACTER IN NUMBER
MOVE T2,T1 ;GET PNTR FROM NIN IN T2
UMOVE T1,.CMABP(P2) ;AND GET ATOM BUFFER POINTER IN T1
CALL SUBBP ;FIND NEG NUMBER OF BYTES ACTUALLY READ
AOJ T1, ;DON'T INCLUDE THE TERMINATOR
PUSH P,T1 ;AND SAVE IT
CALL CMFSET ;RESET ALL POINTERS
POP P,T1 ;AND GET BACK NUMBER OF BYTES READ BY NIN
CALL CMRFLN ;AND REREAD THE FIELD UP TO TERM NIN SAW
JRST XCMNX1 ;NOW TRY NIN AGAIN.
;NUMBER BREAK SET, ALLOWS +, -, NUMBERS
NUMBRK: BRMSK. -1,-1,-1,-1,<0123456789+-> ;START WITH ALL, REMOVE DIGITS, PLUS, AND MINUS
NUXBRK: 777777,,777760
777654,,001760
777777,,777760
777777,,777760
CMNUMH: CALL DOHLP ;DO USER SUPPLIED MESSAGE
JXN F,CM%SDH,CMRTYP ;SUPPRESS DEFAULT HELP IF REQUESTED
HRRZ T2,FNARG ;GET BASE
CAIL T2,^D2 ;LEGAL?
CAILE T2,^D10
ITERR COMNX8 ;NO
CAIN T2,^D10 ;DECIMAL?
JRST CMNH10 ;YES
CAIN T2,^D8 ;OCTAL?
JRST CMNH8 ;YES
HRROI T1,[ASCIZ / a number in base /]
CALL CMSOUT ;ARBITRARY BASE
XCTU [HRRZ T1,.CMIOJ(P2)]
HRRZ T2,FNARG
MOVEI T3,^D10
NOUT ;TYPE BASE
ITERR (,<MOVE T1,LSTERR>) ;RETURN WITH PROPER ERROR CODE
JRST CMRTYP ;RETYPE LINE AND CONTINUE
CMNH8: HRROI T1,[ASCIZ / octal number/]
JRST CMNH
CMNH10: HRROI T1,[ASCIZ / decimal number/]
CMNH: CALL CMSOUT
JRST CMRTYP
;DATE AND/OR TIME
;FLAGS IN ARG SPECIFY WHICH
XCMTAD: MOVE Q1,FNARG ;GET ARG
MOVEI T1,EOLBRK ;READ TO END OF LINE
CALL CMRFLX ;SINCE WE REALLY DON'T KNOW HOW MUCH TIME AND DATE JSYS WILL READ
; MOVE Q2,T1 ;REMEMBER MAXIMUM CHARACTERS IN TIME AND DATE
UMOVE T1,T4 ;GET USER'S AC4 WHICH JSYS'S WILL CLOBBER
MOVEM T1,TDSAV4 ;REMEMBER IT
CALL CMTSET ;SET UP FOR AND DO DATE/TIME PARSING
JFCL ;FIRST PASS WE DON'T CARE WHETHER IT SUCCEEDS OR NOT
UMOVE T1,T1
MOVEM T1,DATPT ;REMEMBER HOW FAR WE READ
UMOVE T2,.CMABP(P2) ;GET BEGINNING
CALL SUBBP ;CALCULATE NUMBER OF CHARACTERS READ
SOJ T1, ;DON'T INCLUDE THE TERMINATOR
; CAMLE T1,Q2 ;IF JSYS READ SOME CRLFS,
; MOVE T1,Q2 ;WE DON'T WANT THEM IN ATOM BUFFER!
MOVEM T1,DATPT ;REMEMBER HOW MANY CHARACTERS TO READ
CALL CMFSET ;RESET TO BEGINNING OF FIELD
MOVN T1,DATPT ;CMRFLN NEEDS NEGATIVE NUMBER OF CHARACTERS TO READ
CALL CMRFLN ;READ EXACT NUMBER OF CHARACTERS COMPRISING TIME AND DATE FIELD
JXN F,CMQUES,CMTADH ;DO HELP IF REQUESTED
CALL CMTSET ;NO HELP REQUESTED, PARSE FOR REAL
JRST TDBAD ;FAILED
TXNE Q1,CM%NCI ;CONVERT TO INTERNAL FORMAT?
JRST [ MOVSI T1,T2 ;NO, STORE DATA IN USER BLOCK
HRR T1,Q1
XBLTUU [BLT T1,2(Q1)]
JRST TDGOOD]
TXNN Q1,CM%IDA ;HAVE DATE?
JRST [ SETO T2, ;NO, DEFAULT TO TODAY
SETZ T4,
ODCNV ;GET TODAY
UMOVEM T2,T2 ;SET UP FOR IDCNV
UMOVEM T3,T3
JRST .+1]
IMCALL .IDCNV,MSEC1 ;CONVERT TO INTERNAL
JRST TDBAD ;FAILED
TDGOOD: MOVE T1,TDSAV4 ;GET USER'S ORIGINAL AC4
UMOVEM T1,T4 ;RESTORE IT
JRST XCOMXR ;GIVE GOOD RETURN
TDBAD: MOVE T1,TDSAV4 ;RESTORE USER;S AC4
UMOVEM T1,T4
JRST XCOMNP ;GIVE FAILURE RETURN
;ROUTINE THAT DOES DATE/TIME PARSING. SKIPS IFF SUCCESFUL PARSE.
CMTSET: UMOVE T1,.CMABP(P2) ;POINT TO ATOM BUFFER
UMOVEM T1,T1
MOVX T2,1B0+1B6 ;SET UP FLAGS FOR IDTNC
TXNE Q1,CM%IDA ;DATE WANTED?
TXZ T2,1B0 ;YES
TXNE Q1,CM%ITM ;TIME WANTED?
TXZ T2,1B6 ;YES
UMOVEM T2,T2
IMCALL .IDTNC,MSEC1
RET ;IDTNC FAILED
RETSKP ;SUCCEEDED
;TIME/DATE HELP
CMTADH: CALL DOHLP ;DO USER TEXT
JXN F,CM%SDH,CMRTYP ;CHECK SUPPRESS DEFAULT
LOAD T1,<CM%IDA+CM%ITM>,Q1 ;GET FLAGS
HRRO T1,[[ASCIZ //]
[ASCIZ / time/]
[ASCIZ / date/]
[ASCIZ / date and time/]](T1)
CALL CMSOUT ;PRINT APPROPRIATE MESSAGE
JRST CMRTYP
;DEVICE
XCMDEV: CALL CMRFLD ;READ FIELD
TXNE F,CMQUES!CMDEFF!CM%NSF ;WANT SOMETHING SPECIAL?
JRST CMDEVS ;YES - CHECK FOR HELP OR NO-SUFFIX
CALL ATMLEN ;GET LENGTH OF ATOM BUFFER
JUMPE A,[NOPARS DEVX7] ;CATCH NULL DEVICE
XCTBU [LDB T1,P4] ;MAKE SURE DEVICE ENDED WITH COLON
CAIE T1,":" ;DEVICE?
JRST [ NOPARS NPXIDT] ;NO, FAIL
CMDEV1: TXNE F,CM%PO ;PARSE-ONLY REQUESTED?
JRST CMDEV2 ;YES, DON'T CHECK FOR EXISTENCE
UMOVE T1,.CMABP(P2) ;SET UP STDEV ARGS
UMOVEM T1,T1
IMCALL .STDEV,MSEC1
JRST XCOMNP ;FAILED
CMDEV2: JRST XCOMXI
CMDEVS: TXNN F,CMQUES ;REALLY WANT HELP?
JRST CMDEV1 ;NO - FINISH OFF, IGNORING THE SUFFIX
CALL DOHLP ;YES - DO USER HELP
HRROI T1,[ASCIZ / device name/]
TXNN F,CM%SDH ;SUPPRESS DEFAULT?
CALL CMSOUT ;NO, DO IT
JRST CMRTYP
;QUOTED STRING
XCMQST: CALL CMRQST ;READ THE STRING
JRST [ NOPARS NPXNQS] ;FAILED
JXN F,CMQUES,[CALL DOHLP ;DO USER HELP
HRROI T1,[ASCIZ / quoted string/]
TXNN F,CM%SDH ;DEFAULT HELP?
CALL CMSOUT ;YES
JRST CMRTYP]
TXZ F,CM%ESC+CMCFF ;CLEAR IN CASE USED INSIDE STRING
JRST FIXESC ;CHECK FOR ESCAPE AND RETURN
;UNQUOTED STRING - TAKES BIT MASK (4 WORDS * 32 BITS) TO SPECIFY BREAKS.
;**;[3022] At XCMUQS insert 6 lines JMP Sep 29, 83
XCMUQS: JXE F,CMQUES,CMUQS1 ;? BEEN TYPED ALREADY?
CALL DOHLP ;YES - DO USER HELP
HRROI T1,[ASCIZ / unquoted string/]
TXNN F,CM%SDH ;SUPPRESS DEFAULT?
CALL CMSOUT ;NO, DO IT
JRST CMRTYP
CMUQS1: CALL CMCIN ;GET A CHAR
MOVE T2,T1 ;COPY CHAR
IDIVI T2,^D32 ;COMPUTE INDEX TO BIT ARRAY
MOVE T3,BITS(T3)
ADD T2,FNARG
XCTU [TDNN T3,0(T2)] ;BIT ON?
JRST CMUQS1 ;NO, KEEP GOING
CAIN T1,CMHLPC ;TERMINATED WITH HELP CHAR?
JRST [ CALL DOHLP ;YES, DO USER HELP
JRST CMRTYP] ;AND RETYPE LINE
TXZ F,CM%ESC+CMCFF ;CLEAR FLAGS
CALL CMCINT ;SEE IF ESCAPE OR ^F TYPED
;**;[3033] At CMUQS1 + 12 L Replace one line with 8 lines JMP Oct 24 83
TXNN F,CMCFF ;GOT ^F ?
JRST FIXES1 ;NO - TERMINATE NORMALLY
CALL CMDCH ;YES, FLUSH IT
TXO F,CM%ESC ;SET FLAG
MOVEI T1," " ;TERMINATE TYPESCRIPT WITH SPACE
CALL CMDIB
CALL CMDIP ;DON'T REALLY PARSE THE SPACE UNTIL NEXT FIELD
JRST XCOMX2 ;FINISH UP
;ARBITRARY FIELD
XCMFLD: CALL CMRFLD ;READ FIELD
TXNE F,CMQUES ;"?" SEEN?
JRST [ CALL DOHLP ;YES, DO USER MESSAGE
JRST CMRTYP]
JRST XCOMXR ;LEAVE FIELD IN ATOM BUFFER
;ACCOUNT
XCMACT: CALL CMRFLD ;READ FIELD
TXNE F,CMQUES ;"?" SEEN?
JRST [ CALL DOHLP ;YES, DO USER MESSAGE
JRST CMRTYP]
CALL ATMLEN ;MEASURE LENGTH OF ACCOUNT STRING
CAILE A,MAXLC ;SHORT ENOUGH?
JRST [NOPARS VACCX1] ;NO "ACCOUNT MORE THAN 39 CHARACTERS"
JRST XCOMXR ;YES, SUCCESS
;NODE NAME
XCMNOD: CALL CMRFLD ;READ INPUT
TXNE F,CMQUES!CMDEFF!CM%NSF ;WANT SOMETHING SPECIAL?
JRST NODSPC ;YES - CHECK FOR HELP OR NO-SUFFIX
MOVNI T1,1 ;BACK UP POINTER TO CHECK FOR COLONS
ADJBP T1,P4
XCTBU [LDB T2,T1] ;READ FIRST COLON
XCTBU [ILDB T1,T1] ;READ SECOND COLON
CAIN T1,":" ;ERROR IF EITHER CHARACTER ISN'T COLON
CAIE T2,":"
JRST [ NOPARS NPX2CL] ;NO, ERROR
NOD1: UMOVE A,.CMABP(P2) ;POINT AT THE ATOM BUFFER
MOVE B,A ;GET A COPY
XCTBU [ILDB D,B] ;GET FIRST CHARACTER
JUMPE D,[NOPARS COMX20] ;FAIL IF NULL NAME
MOVEI B,CNODE ;GET PARSED NODE NAME IN CNODE
CALL PARNDU ;CHECK NODE NAME IN ATOM BUFFER
JRST XCOMNE ;FAILED, REASON IN A
TXNE F,CM%PO ;PARSE ONLY?
JRST NOD2 ;YES, GIVE GOOD RETURN NOW
DMOVE A,[.NDVFY
C] ;PREPARE TO VALIDATE NODE NAME
HRROI C,CNODE ;POINT TO NAME BEING VALIDATED
NODE ;VERIFY THE NAME
TXNN D,ND%EXM ;EXACT MATCH?
JRST [NOPARS DCNX13] ;NODE NOT ACCESSIBLE
NOD2: JRST XCOMXI ;CHECK FOR TRAILING ESCAPE AND RETURN
NODSPC: TXNN F,CMQUES ;REALLY WANT HELP?
JRST NOD1 ;NO - FINISH OFF, IGNORING THE SUFFIX
CALL DOHLP ;YES - DO USER'S SPECIAL HELP
HRROI T1,[ASCIZ/ Node Name/] ;SET UP DEFAULT HELP
TXNN F,CM%SDH ;DOES USER NOT WANT IT
CALL CMSOUT ;NO, TYPE IT
JRST CMRTYP ;AND RETYPE COMMAND
;ROUTINE TO PARSE A NODE NAME IN USER SPACE. IN ORDER TO PREVENT SLY
;PROGRAMS FROM MANAGING TO CHANGE THE STRING AFTER PARNOD HAS BEEN CALLED BUT
;BEFORE THE STRING IS COPIED INTO MONITOR SPACE, CALLERS MUST SUPPLY THIS
;ROUTINE WITH A MONITOR SPACE ADDRESS INTO WHICH TO WRITE THE PARSED STRING
;YOU MUST BE SURE THAT YOUR BUFFER AS SPECIFIED IN B IS LARGE ENOUGH FOR THE
;LONGEST LEGAL NODE NAME
;ACCEPTS: A/ POINTER TO ASCIZ NODE NAME IN USER SPACE
; B/ BUFFER ADDRESS FOR RECEIVING PARSED NAME
;RETURNS: +1 PARSE ERROR, ERROR CODE IN A
; +2 SUCCESSFUL PARSE, NODE NAME COPIED TO BUFFER
; A/ UPDATED USER BYTE POINTER
; B/ LENGTH OF NAME
PARNDU::STKVAR <UUP,MB>
MOVEM B,MB ;REMEMBER ADDRESS OF MONITOR BUFFER
EXCH A,B ;USER POINTER IN B, BUFFER ADDRESS IN A
SOJ A, ;CPYFU2 WANTS ADDRESS BEFORE THE STRING
MOVEI C,1+CPN ;LEAVE ROOM FOR LONG NODE NAME PLUS A NULL
CALL CPYFU2 ;COPY NODE NAME TO BUFFER, RAISE LOWER CASE
NOP ;CPYFU2 ALWAYS RETURNS +2
MOVEM C,UUP ;REMEMBER UPDATED USER POINTER
MOVE A,MB ;GET POINTER TO MONITOR BUFFER
HRLI A,440700 ;MAKE REAL BYTE POINTER
CALL PARNOD ;PARSE THE NODE NAME IN MONITOR SPACE
RET ;FAILED, REASON IN A
MOVE B,A ;RETURN LENGTH IN B
MOVE A,UUP ;SUCCEEDED, SKIP WITH UPDATED USER POINTER IN A
RETSKP ;SUCCESSFUL
;PARSE A NODE NAME IN MONITOR SPACE. TAKES ASCIZ POINTER IN A, SKIPS IF
;SUCCESSFUL, NON-SKIP WITH ERROR IN A IF FAILS. IF SUCCESSFUL, RETURNS LENGTH
;IN A. THE NODE NAME MUST CONSIST OF 6 OR LESS ALPHANUMERIC CHARACTERS,
;AT LEAST ONE OF WHICH MUST BE ALPHABETIC.
;
;PARNO1 IS A SPECIAL ENTRY POINT IF YOU ALREADY KNOW THE NUMBER OF CHARACTERS
;IN THE NAME BEING PARSED AND THE STRING DOES NOT END IN A NULL. 2/ THE COUNT
PARNOD: SKIPA T4,[0] ;"ASCIZ" ENTRY POINT
PARNO1::SKIPA T4,[-1] ;"NOT ASCIZ" ENTRY POINT
MOVEI T2,CPN ;GET MAXIMUM NUMBER OF CHARACTERS IN NAME
SAVEAC <P6>
SETZM P6 ;INIT THE "FOUND ALPHA CHAR" FLAG
XNOD0: ILDB C,A ;GET NEXT CHARACTER FROM NODE NAME
JUMPE C,XNOD1 ;IF NULL, DONE
CALL XNODAL ;IS IT ALPHABETIC?
JRST [CALL XNODNM ;NO, HOW ABOUT NUMERIC?
RETBAD (COMX18) ;NO, ERROR - INVALID CHAR IN NODE NAME
JRST .+1] ;YES, IS GOOD
SOJG T2,XNOD0 ;DECR CHAR. COUNT - IF MORE, GET THE NEXT
JUMPL T2,[RETBAD (COMX19)] ;IF NEGATIVE, ERROR - TOO MANY CHARS.
JUMPGE T4,XNOD0 ;CHAR. COUNT IS 0 - IF ASCIZ, LOOP FOR THE NULL
;HERE WHEN PARSING IS DONE
XNOD1: SKIPN P6 ;DID WE FIND AN ALPHA CHAR?
RETBAD (COMX21) ;NO, GIVE ERROR
MOVEI A,CPN ;GET MAX LENGTH OF A NODE NAME
SUB A,B ;SUBTRACT COUNTDOWN TO GET REAL LENGTH
RETSKP ;RETURN SUCCESS
;LOCAL ROUTINE TO TEST FOR ALPHABETIC CHARACTER
XNODAL: CAIL T3,"A" ;IS IT
CAILE T3,"Z" ; ALPHABETIC?
RET ;NO
SETOM P6 ;YES, SET THE "FOUND ALPHA" FLAG
RETSKP ;IS ALPHA
;LOCAL ROUTINE TO TEST FOR NUMERIC CHARACTER
XNODNM: CAIL T3,"0" ;IS IT
CAILE T3,"9" ; NUMERIC?
RET ;NO
RETSKP ;YES
;INDIRECT FILESPEC (INTERNAL CALL)
CMATFI: TXO F,CMINDF ;NOTE GETTING INDIRECT FILE
JRST XCMIFI ;OTHERWISE, LIKE INPUT FILE
;FILESPEC
XCMFIL: XCTU [HRRZ Q1,.CMGJB(P2)] ;GENERAL - GET GTJFN ARG BLOCK ADR
UMOVE T1,.GJGEN(Q1) ;GET FLAGS FROM IT
JRST CMFIL0 ;DO COMMON CODE
XCMOFI: SKIPA T1,[GJ%FOU+GJ%MSG] ;OUTPUT FILE
XCMIFI: MOVX T1,GJ%OLD ;INPUT FILE
XCTU [HRRZ Q1,.CMGJB(P2)] ;GET GTJFN ARG BLOCK ADR
MOVEI T2,.GJDEV+1(Q1) ;CLEAR DEFAULT POINTERS
XCTU [SETZM -1(T2)]
HRLI T2,.GJDEV(Q1)
XBLTUU [BLT T2,.GJJFN(Q1)]
CMFIL0: TXZ T1,GJ%CFM ;DON'T LET GTJFN DO ITS OWN CONFIRMATION
TXO T1,GJ%XTN ;NOTE EXTENDED GTJFN ARG BLOCK
UMOVEM T1,.GJGEN(Q1) ;PUT FLAGS IN ARG BLOCK
CALL CMCIN ;READ FIRST CHARACTER
CAIE T1,.CHESC
CAIN T1,CMFREC ;RECOGNITION REQUESTED AT BEG OF FIELD?
JRST CMFIL1 ;YES, DON'T CALL CMRFLD BECAUSE IT WOULD DING AND WAIT
CALL CMDIP ;PUT THE PREREAD CHARACTER BACK
TXNE F,CMINDF ;READING INDIRECT SPEC?
JRST [ MOVEI T1,FILBRK ;YES, FORCE FILE SPEC BREAK MASK
CALL CMRFLX
JRST CMFIL3]
CALL CMRFLD ;READ FILESPEC
CMFIL3: TXNE F,CMQUES ;DID USE TYPE "?" IN FILESPEC?
JRST CMFHLP ;YES
CALL ATMLEN ;GET LENGTH OF FILESPEC SO FAR
MOVEM T1,FSLEN
CALL CMRSET ;BACKUP POINTERS TO LET GTJFN READ FILESPEC
CALL INILCH ;SKIP LEADING SPACES (CAN'T CALL CMFSET BECAUSE WE NEED CM%ESC)
TXNE F,CMINDF ;READING INDIRECT FILESPEC ?
CALL CMCIN ;YES, READ THE "@"
JRST CMFIL2 ;SKIP OVER THE OTHER "PUTTING BACK"
CMFIL1: CALL CMDIP ;PUT BACK THE ESCAPE OR ^F
TXO Z,CM%ESC ;BUT REMEMBER THAT USER DOING RECOGNITION
CMFIL2: TXNE F,CMDEFF ;DEFAULT STRING?
JRST [ UMOVE T2,.CMABP(P2) ;YES, GET ATM BUF PNTR
UMOVEM T2,T2 ;GIVE TO USER
CALL ATMLEN ;FIND LENGTH OF ATOM BUFFER
MOVE T2,ATBSIZ
SUB T2,T1 ;SUBTRACT WHAT'S THERE ALREADY
MOVEM T2,ATBSIZ ;UPDATE BUFFER SIZE LEFT
ADJBP T1,ATBPTR ;ADJUST POINTER TO PNT TO END OF BUFFER
MOVEM T1,ATBPTR
MOVEI T1,.CHCRT ;SET UP TO PUT <CR> IN BUFFER
CALL STOLCH ;DO IT
MOVEI T1,.CHLFD ;SET UP TO PUT <LF> IN BUFFER
CALL STOLCH
CALL INILC1 ;REINITIALIZE PNTR & COUNT
JRST .+2]
UMOVEM P4,T2 ;NO DEFAULT, PUT MAIN PNTR IN T2
UMOVE T1,.CMIOJ(P2) ;SET UP IO JFNS (INPUT NOT USED)
UMOVEM T1,.GJSRC(Q1)
UMOVE T1,.GJF2(Q1) ;DON'T WIPE OUT OTHER EXTENDED FLAGS
TXO T1,<G1%RND+G1%RBF+G1%RCM+G1%RIE+3> ;SET UP SECOND FLAG AND COUNT WORD
UMOVEM T1,.GJF2(Q1)
UMOVE T1,.CMABP(P2) ;SET ATOM BUFFER TO GET COPY
UMOVEM T1,.GJCPP(Q1) ; OF FILESPEC
UMOVE T1,.CMABC(P2)
UMOVEM T1,.GJCPC(Q1)
UMOVE T1,.CMBFP(P2) ;SET UP ^R PTR
UMOVEM T1,.GJRTY(Q1)
UMOVEM Q1,T1 ;SET UP T1, T2 ARGS
; ..
;ALL DATA NOW SETUP FOR GTJFN - DATA IS IN BLOCK IN PREVIOUS CONTEXT.
;WILL DO INTERNAL CALL TO GTJFN SO PREVIOUS CONTEXT IS NOT CHANGED.
;IF MORE INPUT IS NEEDED, GTJFN WILL RETURN WITH GJFX48.
;ON ANY RETURN, STRING PROCESSED BY GTJFN (WHICH MAY INCLUDE SOME
;RECOGNITION OUTPUT) IS IN ATOM BUFFER AND WILL BE COPIED TO
;MAIN BUFFER.
; ..
MOVEI Q2,0 ;NO GTJFN ERROR YET
IMCALL .GTJFN,MSEC1 ;DO INTERNAL CALL TO GTJFN
JRST CMGJE ;FAILED
UMOVEM T1,T2 ;RETURN JFN TO CALLER
;**;[3150] Replace 1 line with 3 lines at CMGJE - 6L JMP Aug 22 84
TXNE F,CMDEFF ;[3150] GOT FIELD BY DEFAULT ?
TXNE F,CM%ESC ;[3150] YES - GOT IT BY RECOGNITION ?
CALL CMGJC ;[3150] YES - COPY INPUT TO MAIN BUFFER
TXNE F,CM%ESC ;RECOG CHARACTER TERMINATED?
CALL CMDCH ;YES, FLUSH IT
CALL ESCSPC ;TYPE SPACE IF FILESPEC RECOGNIZED WITH ESCAPE
JXO F,CMINDF,RSKP ;RETURN NOW IF INDIRECT FILESPEC
JRST XCOMX2 ;EXIT GOOD
CMGJE: MOVEM T1,Q2 ;SAVE ERROR CODE
CALL CMGJC ;GET USER INPUT
CAIN Q2,GJFX48 ;MORE INPUT NEEDED?
JRST [ TXNE F,CM%ESC ;YES, FLUSH ESC IF NECESSARY
CALL CMDCH
JRST XCOMRF] ;GET MORE INPUT AND TRY AGAIN
JXO F,CMINDF,R ;RETURN FAIL IF INDIRECT FILESPEC
JRST XCOMNP ;YES, RETURN FAILURE
CMGJC: UMOVE T4,.CMABP(P2) ;SUCCESS, GET PTR TO FILESPEC
CMGJ1: XCTBU [ILDB T1,T4] ;COPY FILESPEC TO MAIN BUFFER
JUMPN T1,[SOSGE P3
ITERR COMNX3
XCTBU [IDPB T1,P4]
SOS P5 ;COUNT DOWN ADVANCE BYTES
CALL STOLCH ;PUT CHAR IN ATOM BFR & UPDATE VARIABLES
JRST CMGJ1]
CAIE Q2,GJFX48 ;THIS ERROR MEANS NO TERMINATOR IN ATOM BUFFER
TXNE Z,CM%ESC ;ESCAPE MEANS USER DIDN'T TYPE TERMINATOR
CAIA ;USER DIDN'T TYPE TERMINATOR
JRST [ CALL ATMLEN ;GET LENGTH OF ATOM BUFFER
SUB T1,FSLEN ;CALCULATE LENGTH OF TERMINATOR (MIGHT BE 2 FOR CRLF!)
MOVE Q3,T1 ;REMEMBER IN Q2
JRST CMGJ2] ;GO REMOVE TERMINATOR FROM ATOM BUFFER
MOVEI Q3,1 ;NOTE THAT ONE CHARACTER TO REMOVE
CMGJ2: SKIPGE P5 ;ANYTHING LEFT IN INPUT?
SETZ P5, ;NO, MAKE EXACTLY EMPTY
CAIN P5,0 ;ANY UNPARSED INPUT LEFT AFTER FILESPEC?
CALL TIECMD ;NO, END COMMAND STRING WITH NULL
MOVE T1,Q3 ;GET NUMBER OF CHARACTERS TO REMOVE
CALL SHRINK ;SHRINK THE ATOM BUFFER TO REMOVE TERMINATOR
CMGJ3: CALL CMDIP ;DONE, PUT TERMINATOR BACK
SOJG Q3,CMGJ3 ;LOOP FOR ALL OF TERMINATOR
CAIN Q2,GJFX48 ;IS THERE A TERMINATOR TO REMOVE?
RET ;NO, SO AVOID SECOND BEEP
MOVEI T1,FLDBRK
CALLRET CMRFLX ;READ NULL ATOM TO HANDLE TERMINATOR
;FILESPEC HELP
CMFHLP: JXO F,CMINDF,[HRROI T1,[ASCIZ / filespec of indirect file/]
JRST CMFH1] ;SPECIAL HELP IF INDIRECT FILESPEC
CALL DOHLP ;DO USER MESSAGE
JXN F,CM%SDH,CMRTYP ;SUPPRESS DEFAULT HELP IF REQUESTED
UMOVE T2,.GJGEN(Q1) ;GET GTJFN FLAGS
HRROI T1,[ASCIZ / output filespec/]
TXNN T2,GJ%OLD
TXNN T2,GJ%FOU
HRROI T1,[ASCIZ / input filespec/]
CMFH1: CALL CMSOUT
JRST CMRTYP
;TOKEN - ARBITRARY SYMBOL AS SPECIFIED BY FN DATA
XCMTOK: MOVE T1,FNARG ;GET STRING ADDRESS
CALL CHKBP ;CHECK IT
ITERR COMX17 ;BAD
MOVEM T1,Q1
;**;[3148] Add 18 lines at XCMTOK + 3 JMP 16-Aug-84
TXNN F,CM%DPP ;[3148] GOT A DEFAULT ?
JRST CMTOK1 ;[3148] NO
CALL RDCRLF ;[3148] SEE IF CRLF FOR DEFAULTING ?
JRST [CALL CMDIP ;[3148] NO - PUT CHAR BACK
JRST CMTOK1] ;[3148] CONTINUE NORMAL PROCESSING
CALL UNCRLF ;[3148] BACK UP
MOVE Q2,Q1 ;[3148] SAVE ARG POINTER, CMGDP CLOBBERS Q1
CALL CMGDP ;[3148] GET DEFAULT STRING POINTER
TXO F,CMDEFF ;[3148] NOTE DEFAULT SHOULD BE TAKEN
XCMTK1: XCTBU [ILDB T1,Q2] ;[3148] GET NEXT CHARACTER FROM TOKEN
JUMPE T1,[CALL TIELCH ;[3148] DONE ON NULL. TIE IT OFF
JRST XCOMX2] ;[3148] FINISH UP
XCTBU [ILDB T2,Q1] ;[3148] GET CHAR FROM DEFAULT STRING
CAME T2,T1 ;[3148] MATCH ?
JRST [NOPARS NPXNMT] ;[3148] NO. NO MATCH TOKEN
CALL STOLCH ;[3148] STORE IN ATOM BUFFER ONLY
JRST XCMTK1 ;[3148] NEXT CHAR
CMTOK1: XCTBU [ILDB Q2,Q1] ;GET NEXT CHAR IN STRING
JUMPE Q2,[CALL TIELCH ;SUCCESS IF END OF STRING
JRST FIXESC] ;CHECK FOR TRAILING ESCAPE AND RETURN
CMTOK2: CALL CMCIN ;NO, GET NEXT CHAR OF INPUT
CAMN T1,Q2 ;MATCH?
JRST [ CALL STOLCH ;YES, APPEND TO ATOM BUFFER
JRST CMTOK1] ;CONTINUE
CAIE T1,CMFREC ;RECOG REQUEST?
CAIN T1,.CHESC
CALL CMAMBT ;AMBIGUOUS
CAIE T1,CMHLPC ;HELP REQUEST?
;**;[2852] Change 1 line at CMTOK2:+8.L PED 3-NOV-82
JRST [ NOPARS NPXNMT] ;[2852] NO - NO MATCH OF TOKEN
CALL DOHLP ;YES - GIVE THE HELP
JXN F,CM%SDH,CMRTYP
HRROI T1,[ASCIZ/ "/]
CALL CMSOUT
MOVE T1,FNARG
CALL CMUSOU
MOVEI T1,""""
CALL CMCOUT
JRST CMRTYP
;DIRECTORY OR USER NAME
XCMUSR: TXOA F,CMUSRF ;NOTE USER REQUIRED
XCMDIR: TXZ F,CMUSRF
CMDIR1: CALL CMRFLD ;READ FIELD
CMDIR4: TXNE F,CMQUES!CM%ESC ;HELP OR RECOGNITION WANTED?
JRST CMDIRS ;YES - SEE WHICH ONE AND HANDLE IT
CALL CMDEMO ;NO RECOGNITION - SET FOR EXACT MATCH
CMDIR0: TXNE F,CMUSRF ;WANT A USER NAME?
JRST [ IMCALL .RCUSR,MSEC1 ;YES, GET A USER NAME
ERJMP XCOMNP ;ILLEGAL SYNTAX
JRST CMDIR3]
IMCALL .RCDIR,MSEC1 ;NO, GET A DIRECTORY NAME
ERJMP XCOMNP ;ILLEGAL SYNTAX
CMDIR3: MOVEM T1,RCFLGS ;REMEMBER FLAGS. WE MIGHT HAVE TO DING LATER
TXNE T1,RC%NOM ;FOUND A MATCH?
JRST CMDIR5 ;NO MATCH, BUT MAYBE PARSE-ONLY REQUESTED
UMOVEM T3,2 ;RETURN THE NUMBER TO THE USER
CMDIR9: TXNE F,CM%ESC ;DID USER END INPUT WITH ESCAPE?
CALL CMDCH ;YES, REMOVE IT FROM BUFFER
CMDIR2: XCTBU [ILDB T1,ATBPTR] ;TYPE AND APPEND REMAINDER OF NAME
JUMPE T1,CMDIR7 ;DONE WHEN NULL CHAR
CALL CMDIB
JRST CMDIR2
CMDIR7: MOVE T1,RCFLGS ;GET RESULT FLAGS FROM RCDIR
TXNN T1,RC%AMB ;WAS INPUT AMBIGUOUS?
JRST XCOMXI ;NO, GIVE SUCCESSFUL RETURN
JRST CMAMB ;YES, RING BELL
;DIRECTORY/USER HELP
CMDIRS: TXNN F,CMQUES ;HELP?
JRST CMDIRR ;NO - CM%ESC IS SET - ALLOW RECOGNITION
CALL DOHLP ;DO USER HELP
JXN F,CM%SDH,CMRTYP ;SUPPRESS DEFAULT HELP IF REQUESTED
HRROI T1,[ASCIZ / user name/]
TXNN F,CMUSRF ;USER?
HRROI T1,[ASCIZ / directory name/]
CALL CMSOUT
JRST CMRTYP ;RETYPE AND CONTINUE
CMDIRR: CALL CMDREC ;SET UP TO ALLOW RECOGNITION
JRST CMDIR0 ;BACK TO THE FLOW
;WE GOT A NO-MATCH RETURN ON TRYING TO PARSE USER OR DIRECTORY
;NAME. THIS MAY BE FOR ONE OF TWO REASONS: EITHER THE USER TYPED
;A PARTIAL NAME AND TRYED TO DO RECOGNITION, OR THE USER TYPED A
;COMPLETE NONEXISTENT NAME. IF CALL REQUESTED PARSE-ONLY, COMPLETE
;NONEXISTENT NAME IS ACCEPTABLE AND WE WANT TO GIVE GOOD RETURN TO
;COMND CALL. IF CALL REQUESTED NOT PARSE-ONLY, NONEXISTENT NAME IS
;UNACCEPTABLE, AND WE WANT TO GIVE NO-PARSE RETURN. IF CALL WAS FOR
;NOT PARSE-ONLY, PARTIAL NAME IS NO GOOD AND WE WANT TO
;GIVE NO-PARSE RETURN. IF CALL WAS FOR PARSE-ONLY, THEN PARTIAL NAME
;WARRANTS AMBIGUOUS RETURN, I.E. DING AND WAIT FOR MORE.
;THE FOLLOWING CODE DECIDES WHICH OF THE ABOVE CASES WE'RE DEALING
;WITH...
CMDIR5: TXNN F,CM%PO ;PARSE-ONLY REQUESTED?
JRST [ NOPARS NPXNMD] ;NO, SO GIVE NO-PARSE NOW
CALL CMDEMO ;EXACT MATCH ONLY SET UP THIS TIME
TXNE F,CMUSRF ;USER NAME FUNCTION?
JRST CMDIR8 ;YES, GO DO RCUSR
IMCALL .RCDIR,MSEC1 ;DIRECTORY FUNCTION
ERJMP CMDIR6 ;USER ATTEMPTED RECOGNITION ON PARTIAL STRING
JRST CMDIR9 ;STRING IS GOOD SYNTAX
CMDIR8: IMCALL .RCUSR,MSEC1
ERJMP CMDIR6
JRST CMDIR9
;GET TO HERE WHEN PARSE-ONLY REQUESTED, AND USER TYPED PARTIAL NAME
;FOLLOWED BY ALTMODE. WE'LL REGARD THIS AS AMBIGUOUS.
CMDIR6: MOVX A,RC%AMB ;PRETEND AMBIGUOUS
IORM A,RCFLGS
JRST CMDIR9 ;GO BACK AND JOIN COMMON CODE
;ROUTINE TO SET UP ARGS FOR IMCALL TO RCDIR/RCUSR. ENTRIES ARE CMDREC
;FOR RECOGNITION, AND CMDEMO FOR NO RECOGNITION.
CMDEMO: MOVX T1,RC%EMO+RC%PAR ;EXACT MATCH ONLY
CAIA ;SKIP SET UP FOR RECOGNITION
CMDREC: MOVX T1,RC%PAR ;RECOGNITION REQUESTED
MOVE T2,FNARG ;GET ARGUMENT WORD
TXNE T2,CM%DWC ;DIRECTORY WILDCARDING ALLOWED?
TXO T1,RC%AWL ;YES (ASSUMES RCUSR DOESN'T CARE!)
UMOVE T2,.CMABP(P2) ;PTR TO TYPE-IN
UMOVEM T1,T1
UMOVEM T2,T2
RET
;COMMA, ARBITRARY CHARACTER
XCMCMA: MOVEI T1,"," ;SET UP COMMA AS CHARACTER TO FIND
MOVEM T1,FNARG
CMCHR: CALL CMCIN ;GET A CHAR
CAIE T1,.CHTAB ;BLANK?
CAIN T1," "
JRST CMCHR ;YES, IGNORE
HRRZ T2,FNARG ;GET SPECIFIED CHAR
CAMN T1,T2 ;THE RIGHT ONE?
JRST CMCHR1 ;YES, WIN
CAIE T1,CMFREC ;^F?
CAIN T1,.CHESC ;ESC?
CALL CMAMBT ;AMBIGUOUS
CAIN T1,CMHLPC ;HELP?
JRST [ CALL DOHLP
JXN F,CM%SDH,CMRTYP ;JUMP IF SUPPRESSING HELP
MOVEI T1," " ;TYPE SPACE
CALL CMCOUT
MOVEI T1,"""" ;TYPE "char"
CALL CMCOUT
HRRZ T1,FNARG
CALL CMCOUT
MOVEI T1,""""
CALL CMCOUT
JRST CMRTYP]
NOPARS NPXCMA ;FAIL
CMCHR1: CALL CMCIN ;GET NEXT CHARACTER
CAIE T1,.CHESC ;CHECK FOR ESCAPE
JRST [ CALL CMDIP ;NOT AN ESCAPE, PLACE IT BACK
JRST XCOMXI] ;AND GIVE SUCCESSFUL RETURN
CALL CMDCH ;IS AN ESCAPE, REMOVE IT
JRST XCOMXI ;AND GIVE SUCCESS RETURN
;LOCAL ROUTINE TO SET UP BYTE PTR TO TABLE STRING AND GET FLAGS
; T2/ ADDRESS OF STRING
; CALL CHKTBS
; T1/ FLAGS
; T2/ BYTE POINTER TO STRING
CHKTBS: XCTU [SKIPE T1,0(T2)] ;CHECK FIRST WORD OF STRING
TXNE T1,177B6 ;FIRST CHAR 0 AND WORD NOT ALL-0?
TDZA T1,T1 ;NO, MAKE FLAGS ALL 0
AOS T2 ;YES, HAVE FLAGS, ADJUST BYTE PTR
HRLI T2,(POINT 7,0) ;SET UP P AND S FIELDS
RET
;STRING COMPARE JSYS
; T1/ TEST STRING POINTER
; T2/ BASE STRING POINTER
; STCMP
; RETURNS +1 ALWAYS,
; T1/ COMPARE CODE:
; 1B0 (SC%LSS) - TEST STRING LESS THAN BASE STRING
; 1B1 (SC%SUB) - TEST STRING SUBSET OF BASE STRING
; 1B2 (SC%GTR) - TEST STRING GREATER THAN BASE STRING
; N.O.T.A. MEANS EXACT MATCH
; T2/ UPDATED BASE STRING POINTER, USEFUL IN CASE TEST STRING
; WAS SUBSET
.STCMP::MCENT
HLRZ T3,T1
CAIN T3,-1
HRLI T1,(POINT 7,0)
HLRZ T3,T2
CAIN T3,-1
HRLI T2,(POINT 7,0)
CALL USTCMP ;DO THE WORK
UMOVEM T1,T1 ;RETURN THE RESULT
UMOVEM T2,T2
MRETNG
;STRING COMPARE ROUTINE - REFERENCES PREVIOUS CONTEXT.
; T1/ TEST STRING POINTER
; T2/ BASE STRING POINTER
; CALL USTCMP
;RETURN AS FOR .STCMP
USTCMP::XCTBU [ILDB T3,T1] ;GET NEXT BYTE FROM EACH STRING
CAIL T3,"A"+40 ;LC LETTER?
JRST [ CAIG T3,"Z"+40
SUBI T3,40 ;YES, CONVERT TO UC
JRST .+1]
XCTBU [ILDB T4,T2]
CAIL T4,"A"+40 ;LC LETTER?
JRST [ CAIG T4,"Z"+40
SUBI T4,40 ;YES, CONVERT TO UC
JRST .+1]
CAME T3,T4 ;STILL EQUAL?
JRST STRC2 ;NO, GO SEE WHY
JUMPN T3,USTCMP ;KEEP GOING IF NOT END OF STRING
SETZ T1, ;STRINGS ENDED TOGETHER, EXACT MATCH.
RET ;RETURN 0
STRC2: JUMPE T3,[MOVX T1,SC%SUB ;TEST STRING ENDED, IS A SUBSET
ADD T2,[7B5] ;DECREMENT BASE POINTER ONE BYTE
RET]
CAMG T3,T4 ;STRINGS UNEQUAL
SKIPA T1,[SC%LSS] ;TEST STRING LESS
MOVX T1,SC%GTR ;TEST STRING GREATER
RET
;KEYWORD TABLE ROUTINES.
;THESE ROUTINES PERFORM FUNCTIONS ON KEYWORD TABLES IN STANDARD
;FORMAT. A KEYWORD TABLE IS ONE DESIGNED TO ALLOW ABBREVIATION
;RECOGNITION AND COMPLETION FOLLOWING THE USUAL CONVENTIONS.
;THE TABLE FORMAT IS:
; TABLE: # OF ENTRIES IN USE, MAX SIZE OF TABLE
; XWD ADR OF STRING, ANYTHING
; ..
; ..
;THE TABLE MUST BE SORTED BY STRINGS SO THAT BINARY SEARCHING
;AND AMBIGUITY DETERMINATION MAY BE DONE EFFICIENTLY.
;THE RIGHT HALF OF EACH ENTRY CAN BE THE DATA FOR THE ENTRY OR
;A POINTER TO ADDITIONAL INFORMATION. THESE ROUTINES IGNORE IT.
;**************************************************************
;TBDEL - DELETE AN ENTRY FROM STANDARD KEYWORD TABLE
; T1/ ADDRESS OF TABLE HEADER WORD
; T2/ ADDRESS OF ENTRY TO BE DELETED (AS RETURNED BY LOOKUP)
; TDEL
; RETURN +1 ALWAYS, ITRAP IF TABLE EMPTY
.TBDEL::MCENT
CALL XTDEL ;DO THE WORK
ITERR ()
MRETNG
;THIS IS THE WORKER ROUTINE. IT MAY BE CALLED INTERNALLY, AND
;IT REFERENCES PREVIOUS CONTEXT FOR ALL ARGUMENT DATA.
; RETURNS +1 FAILURE, ERROR CODE IN T1
; RETURNS +2 SUCCESS
XTDEL:: XCTU [HLRZ T4,0(T1)] ;GET USED COUNT
MOVE T3,T4
SOSGE T3 ;REDUCE COUNT, TABLE ALREADY EMPTY?
RETBAD TDELX1 ;YES
ADD T4,T1 ;COMPUTE END OF TABLE
CAILE T2,(T1)
CAMLE T2,T4 ;DELETED ENTRY WITHIN TABLE?
RETBAD TDELX2 ;NO
XCTU [HRLM T3,0(T1)] ;YES, STORE DECREMENTED COUNT
JUMPE T3,TDELZ ;JUMP IF TABLE NOW EMPTY
HRLI T2,1(T2) ;COMPACT TABLE, FROM DELETED ENTRY +1
XBLTUU [BLT T2,-1(T4)] ;TO DELETED ENTRY UNTIL END
TDELZ: XCTU [SETZM 0(T4)] ;CLEAR EMPTY WORD AT END OF TABLE
RETSKP
;TBADD - ADD ENTRY TO STANDARD KEYWORD TABLE
; T1/ ADDRESS OF TABLE HEADER WORD
; T2/ ENTRY TO BE ADDED
; TADD
; RETURN +1 ALWAYS, ITRAP IF TABLE FULL OR BAD FORMAT
; T1/ ADDRESS OF NEW ENTRY
.TBADD::MCENT
CALL XTADD ;DO THE WORK
ITERR ()
UMOVEM T1,T1
MRETNG
;WORKER ROUTINE - MAY BE CALLED INTERNALLY. REFERENCES PREVIOUS CONTEXT.
; RETURN +1 FAILURE, TABLE FULL OR BAD FORMAT
; RETURN +2 SUCCESS
XTADD: ASUBR <TBA,ENT>
HLRZ T2,T2 ;CONSTRUCT STRING PTR TO NEW STRING
CALL CHKTBS ;GET POINTER TO ACTUAL STRING
MOVE T1,TBA ;GET TABLE ADDRESS
CALL XTLOOK ;FIND PLACE FOR NEW ENTRY
RETBAD() ;BAD FORMAT TABLE
TXNE T2,TL%EXM ;EXACT MATCH?
RETBAD TADDX2 ;YES, ENTRY ALREADY IN TABLE
;T1/ ADDRESS WHERE ENTRY SHOULD BE PUT
MOVE T2,TBA ;GET TABLE ADDRESS
XCTU [HLRZ T4,0(T2)] ;INCREMENT NUMBER ENTRIES IN USE
AOS T4
XCTU [HRRZ T3,0(T2)] ;GET TABLE SIZE
CAMLE T4,T3
RETBAD TADDX1 ;TABLE FULL
XCTU [HRLM T4,0(T2)] ;UPDATE ENTRY COUNT
ADD T4,T2 ;COMPUTE NEW END OF TABLE
XTADD2: CAML T1,T4 ;NOW AT 'HOLE'?
JRST [ MOVE T3,ENT ;YES, INSERT ENTRY
UMOVEM T3,0(T1)
RETSKP]
XCTU [MOVE T3,-1(T4)] ;MOVE TABLE TO CREATE HOLE
XCTU [MOVEM T3,0(T4)]
SOJA T4,XTADD2
;TBLUK - LOOKUP ENTRY IN STANDARD KEYWORD TABLE
; T1/ ADDRESS OF TABLE HEADER WORD
; T2/ STRING POINTER TO STRING TO BE FOUND
; TLOOK
; RETURNS +1 ALWAYS, ITERR IF BAD TABLE FORMAT
; T1/ ADDRESS OF ENTRY WHICH MATCHED OR WHERE ENTRY WOULD BE
; IF IT WERE IN TABLE
; T2/ RECOGNITION CODE:
; 1B0 (TL%NOM) - NO MATCH
; 1B1 (TL%AMB) - AMBIGUOUS
; 1B2 (TL%ABR) - UNIQUE ABBREVIATION
; 1B3 (TL%EXM) - EXACT MATCH
; T3/ POINTER TO REMAINDER OF STRING IN TABLE IF MATCH
; WAS AN ABBREVIATION. THIS STRING MAY BE TYPED OUT TO
; COMPLETE THE KEYWORD.
.TBLUK::MCENT
CALL XTLOK0 ;DO THE WORK
ITERR ()
UMOVEM T1,T1 ;STORE RESULTS
UMOVEM T2,T2
UMOVEM T3,T3
MRETNG
;WORKER ROUTINE - MAY BE CALLED INTERNALLY. REFERENCES PREVIOUS CONTEXT.
; RETURNS +1 FAILURE, BAD TABLE FORMAT
; RETURNS +2 SUCCESS, ACS AS ABOVE
;INTERNAL AC USAGE:
; T1/ TEST STRING FROM CALL
; T2/ STRING FROM TABLE
; T3/ CLOBBERED BY USTCMP
; T4/ " "
; P1/ CURRENT TABLE INDEX
; P2/ ADDRESS OF TABLE INDEXED BY P1 - USED FOR INDIRECTION
; P3/ INDEX INCREMENT FOR LOG SEARCH
; P4/ SIZE OF TABLE
XTLOOK::SAVEP ;PRESERVE ACS
XTLOK0: ASUBR <TBA,STRG,REMSTR> ;JSYS ENTRY, NO NEED TO PRESERVE ACS
HLRZ T3,T2 ;CHECK STRING POINTER
CAIE T3,-1 ;LH 0 OR -1?
CAIN T3,0
HRLI T2,(POINT 7,0) ;YES, FILL IN
MOVEM T2,STRG
MOVEI P2,1(T1) ;CONSTRUCT ADDRESS OF FIRST ENTRY
HRLI P2,P1!(IFIW) ;MAKE IT INDEXED BY P1
XCTU [HLRZ P4,0(T1)] ;GET PRESENT SIZE
MOVE P3,P4 ;INITIAL INCREMENT IS SIZE
MOVE P1,P4 ;SET INITIAL INDEX TO SIZE/2
ASH P1,-1
JUMPE P4,TABLKX ;IF TABLE EMPTY THEN NO MATCH
TABLK0: XCTU [HLRZ T2,@P2] ;GET STRING ADR FROM TABLE
CALL CHKTBS ;CONSTRUCT POINTER
MOVE T1,STRG ;GET TEST STRING
CALL USTCMP ;COMPARE
JUMPN T1,TABLK1 ;JUMP IF NOT EXACTLY EQUAL
TABLKF: XCTU [HLRZ T2,@P2] ;GET STRING ADDRESS
CALL CHKTBS ;GET FLAGS
JXN T1,CM%NOR,TABLKM ;MAKE IT AMBIG IF NOREC ENTRY
MOVX T2,TL%EXM ;EXACTLY EQUAL, RETURN CODE
JRST TABLKA
TABLKM: SKIPA T2,[TL%AMB] ;AMBIGUOUS RETURN
TABLKX: MOVX T2,TL%NOM ;NO MATCH RETURN
TABLKA: MOVEI T1,@P2 ;RETURN ADR WHERE ENTRY IS OR SHOULD BE
RETSKP
;STRING MAY BE UNEQUAL OR A SUBSET, SEE WHICH
TABLK1: JXE T1,SC%SUB,TABLKN ;UNEQUAL, GO SET UP NEXT PROBE
TABLK3: MOVEM T2,REMSTR ;SUBSTRING, SAVE REMAINDER
JUMPE P1,TABLK2 ;JUMP IF THIS FIRST ENTRY IN TABLE
MOVEI T1,@P2 ;CHECK NEXT HIGHER ENTRY IN TABLE
XCTU [HLRZ T2,-1(T1)] ;GET ITS STRING ADDRESS
CALL CHKTBS ;BUILD BYTE PTR
MOVE T1,STRG ;GET TEST STRING
CALL USTCMP ;TEST PREVIOUS ENTRY
JUMPE T1,[SOJA P1,TABLKF] ;EXACTLY EQUAL, DONE. FIX INDEX.
JXN T1,SC%GTR,TABLK2 ;IF LESS THEN HAVE FOUND HIGHEST SUBSTR
SOJA P1,TABLK3 ;STILL A SUBSTR, CHECK HIGHER
;NOW POINT AT HIGHEST ENTRY WHICH IS A SUBSTR. IF THERE IS AN EXACT
;MATCH, IT IS BEFORE ALL SUBSETS AND HAS ALREADY BEEN FOUND
TABLK2: MOVEI T1,@P2 ;CHECK NEXT ENTRY FOR AMBIGUOUS
CAIL P1,-1(P4) ;NOW AT LAST ENTRY IN TABLE?
JRST TBLK2A ;YES, THIS ENTRY IS DISTINCT
XCTU [HLRZ T2,1(T1)] ;GET STRING ADR OF NEXT ENTRY
CALL CHKTBS ;BUILD BYTE PTR
MOVE T1,STRG ;GET TEST STRING
CALL USTCMP ;COMPARE NEXT LOWER ENTRY
JUMPE T1,[RETBAD TLUKX1] ;EXACT MATCH, TABLE MUST BE BAD
JXN T1,SC%SUB,TABLKM ;NEXT ENTRY NOT DISTINCT, DO AMBIG RETURN
TBLK2A: XCTU [HLRZ T2,@P2] ;CHECK FLAGS FOR THIS ENTRY
CALL CHKTBS
JXN T1,CM%NOR,TABLKM ;FAIL IF NOREC BIT SET
MOVX T2,TL%ABR ;GIVE LEGAL ABBREVIATION RETURN
MOVE T3,REMSTR ;RETURN PTR TO REMAINDER OF STRING
JRST TABLKA
;HERE WHEN PROBE NOT EQUAL
TABLKN: CAIG P3,1 ;INCREMENT NOW 1?
JRST [ JXN T1,SC%LSS,TABLKX ;YES, NO MATCH FOUND
AOJA P1,TABLKX] ;IF STRING GREATER, BUMP ADR FOR INSERT
AOS P3 ;NEXT INC = <INC+1>/2
ASH P3,-1
TXNE T1,SC%GTR ;IF LAST PROBE LOW, ADD INCREMENT
ADD P1,P3
TXNE T1,SC%LSS
SUB P1,P3 ;LAST PROBE HIGH, SUBTRACT INCR
TBLKN1: CAIL P1,0(P4) ;AFTER END OF TABLE?
JRST [ MOVX T1,SC%LSS ;YES, FAKE PROBE TOO HIGH
JRST TABLKN]
JUMPGE P1,TABLK0 ;IF STILL WITHIN TABLE RANGE, GO PROBE
MOVX T1,SC%GTR ;BEFORE START OF TABLE, FAKE LOW PROBE
JRST TABLKN
;RDTTY, TEXTI -- INPUT WITH EDITING JSYSES. GENERAL DEFINITIONS:
REPEAT 0,<
;THE FOLLOWING DEFINITIONS ARE GIVEN IN MONSYM. THEY ARE DUPLICATED
;HERE FOR INFORMATION ONLY.
; CONTROL BITS:
RD%BRK==1B0 ;BREAK ON REGULAR BREAK SET
RD%TOP==1B1 ;BREAK ON TOPS10 BREAK SET
RD%PUN==1B2 ;BREAK ON PUNCTUATION
RD%BEL==1B3 ;BREAK ON EOL
RD%CRF==1B4 ;SUPPRESS CR IF 1
RD%RND==1B5 ;RETURN ON NULL BUFFER
RD%JFN==1B6 ;1= AC1 IS JFN,,JFN, 0= AC1 IS STRING PTR
RD%RIE==1B7 ;RETURN (RATHER THAN BLOCK) IF INPUT BFR EMPTY
RD%BBG==1B8 ;PTR TO BEGINNING OF DEST BUFFER GIVEN IN AC4
;RD%BEG
RD%RAI==1B10 ;RAISE LOWERCASE INPUT
RD%SUI==1B11 ;SUPPRESS ^U INDICATION
;BITS RETURNED TO USER
RD%BTM==1B12 ;A BREAK CHARACTER WAS SEEN.
RD%BFE==1B13 ;RETURNED BECAUSE BUFFER EMPTY
RD%BLR==1B14 ;BACKUP LIMIT REACHED
> ;END OF MONSYM DEFINITIONS
;DEFINED CHARACTER CLASSES:
;N.B. - MUST MATCH DISPTC TABLE BELOW
TOP==0 ;TOPS10 BREAK
BRK==1 ;REGULAR BREAK SET
ZER==2 ;NULL
EOLC==3 ;EOL
PUN==4 ;PUNCTUATION
SAFE==5 ;ALL OTHERS
RUBO==6 ;DELETE A CHARACTER
RTYP==7 ;RETYPE THE LINE
KLL==10 ;DELETE THE LINE
KWRD==11 ;DELETE A WORD
RDCRC==12 ;CARRIAGE RETURN
RDQTC==13 ;QUOTE CHARACTER
;AC USAGE HEREIN:
;Q1 ^R BUFFER
;Q2 TOP OF BUFFER
;Q3 POINTER TO BREAK CHAR MASK
;P1 SOURCE
;P2 BACKUP LIMIT
;P3 COUNT
;P4 DEST POINTER
;P5 INTERNAL CALLING FLAGS
;F - FLAGS FROM USER (LH)
BRFLGS==RD%TOP+RD%BRK+RD%PUN+RD%BEL ;ALL POSSIBLE BREAK SETS
;LOCAL FLAGS IN P5
DSPMF==1B16 ;IN DISPLAY MODE
RTTY==1B15 ;IN RDTTY
RTXT==1B14 ;IN RDTXT
TXTI==1B13 ;IN TEXTI
INTT==1B12 ;IN INTERNAL TEXTI
;NOTE: YOU CAN'T USE BITS TO "THE LEFT" OF 1B12 IN THIS WORD
;FOR LOCAL FLAGS, SINCE THE USER'S FLAGS ARE THERE.
;HOWEVER, THERE'S PLENTY OF ROOM IN FLG2...
;LOCAL FLAGS IN FLG2
QUOTEF==1B0 ;NEXT CHARACTER IS TO BE QUOTED
;RDTTY - READ TEXT WITH EDITING
; A/ DESTINATION STRING POINTER
; B/ CONTROL BITS ,, BYTE COUNT
; C/ ^R ECHO BUFFER IF NON -ZERO
; RDTTY
; RETURN +1: FAILURE
; RETURN +2: SUCCESS, 1 AND 2 UPDATED AS APPROPRIATE
.RDTTY::MCENT ;SET UP CONTEXT
UMOVE F,B ;GET FLAGS
TLNN F,(BRFLGS) ;ANY BREAK SETS SELECTED?
TXO F,RD%BEL ;NO. SET BREAK ON EOL THEN
TXO F,RD%JFN ;MUST GET INPUT FROM FILE
MOVE P1,[.PRIIN,,.PRIOU] ;FROM THE PRIMARIES
SETZ Q3, ;NO SPECIAL BREAK MASK
XCTU [HRRZ P3,B] ;BYTE COUNT
UMOVE P4,A ;DESTINATION POINTER
UMOVE Q1,C ;POSSIBLE ^R BUFFER
MOVE Q2,P4 ;TOP OF BUFFER
MOVE P2,Q2 ;BACKUP LIMIT IS TOP OF BUFFER
MOVX P5,RTTY ;NOTE IN RDTTY
JRST RCOMN ;GO DO COMMON CODE
;RDTXT
;INCLUDED FOR COMPATIBILITY ONLY, MAY BE REMOVED.
; A/ SOURCE
; B/ DESTINATION
; C/ FLAGS,,COUNT
; D/ OPTIONAL INITIAL DESTINATION PTR
; RDTXT
; RETURN +1: FAILURE
; RETURN +2: SUCCESS
.RDTXT::MCENT
UMOVE F,C ;GET CONTROL FLAGS
UMOVE P4,B ;GET DESTINATION BYTE POINTER
TXNN F,RD%BBG ;DID USER GIVE EXPLICIT BBUF PTR?
JRST [ MOVEM P4,Q2 ; NO, USE INITIAL DEST STRING PTR
JRST RDTXT2]
UMOVE Q2,D ;YES GET IT
RDTXT2: MOVE P2,Q2 ;BACKUP LIMIT IS TOP OF BUFFER
SETZB Q3,Q1 ;CANT HAVE THESE
MOVX P5,RTXT ;NOTE IN RDTXT
UMOVE P1,A ;SOURCE
XCTU [HRRZ P3,C] ;GET COUNT
JRST RCOMN ;GO DO COMMON CODE
;TEXTI - LONG FORM CALL OF RDTTY
; A/ POINTER TO ARGUMENT BLOCK (E)
;E+0 COUNT OF WORDS IN BLOCK
;E+1 FLAGS
;E+2 INJFN,,OUTJFN OR SOURCE PTR
;E+3 DESTINATION STRING POINTER
;E+4 COUNT OF BYTES IN DESTINATION STRING
;E+5 START OF BUFFER
;E+6 ^R ECHO BUFFER START
;E+7 POINTER TO BREAK CHARACTER MASK
;E+10 BACKUP LIMIT PTR
.TEXTI::MCENT ;ESTABLISH CONTEXT
MOVX P5,TXTI ;NOTE IN TEXTI
UMOVE A,A ;BLOCK POINTER
UMOVE B,.RDCWB(A) ;COUNT OF ARGS
CAIGE B,.RDDBC ;ENOUGH ARGS?
RETERR(ARGX17) ;NO, INVALID ARGUMENT BLOCK LENGTH
UMOVE F,.RDFLG(A) ;FLAGS
UMOVE P1,.RDIOJ(A) ;P1
UMOVE P4,.RDDBP(A) ;DESTINATION
UMOVE P3,.RDDBC(A) ;COUNT OF BYTES IN DESTINATION
SETZB Q1,Q3 ;ASSUME THESE ARENT PRESENT
MOVE Q2,P4 ;ASSUME NO BEGINNING OF BUFFER
CAIL B,.RDBFP ;Q2 GIVEN?
UMOVE Q2,.RDBFP(A) ;YES. GET IT
SKIPN Q2 ;WAS IT NON-ZERO?
MOVE Q2,P4 ;NO. USE DEFAULT
CAIL B,.RDRTY ;^R BUFFER GIVEN?
UMOVE Q1,.RDRTY(A) ;YES. GET IT
CAIL B,.RDBRK ;BREAK MASK GIVEN?
UMOVE Q3,.RDBRK(A) ;YES. GET IT
SETZ P2, ;ASSUME NO BACKUP LIMIT
CAIL B,.RDBKL ;BACKUP LIMIT GIVEN?
UMOVE P2,.RDBKL(A) ;YES, GET IT
SKIPN P2 ;HAVE ONE?
MOVE P2,Q2 ;NO, USE TOP OF BUFFER
JRST RCOMN ;CONTINUE WITH COMMON SETUP
;INTERNAL ENTRY, DOES NOT CHANGE PREVIOUS CONTEXT
;ASSUMES ACS PREVIOUSLY SET UP: Q1,Q2,Q3,P1,P2,P3,P4
;ENTERING HERE ASSUMES THE 4-WORD BREAK MASK AS POINTED TO BY Q3 IS
;IN CURRENT CONTEXT INSTEAD OF PREVIOUS
ITEXTI: MOVX P5,INTT ;NOTE INTERNAL CALL
; .. ;FALL INTO COMMON SETUP
;COMMON ENTRY/SETUP FOR RDTTY, TEXTI
RCOMN: TRVAR <FLG2,<UMSK,4>,CCNT,CCPTR,CRPTR,<COC,2>,<OURCOC,2>,MOD,STKP,<MASK,5>,FWTH,TTYIND,ADDPAR,CMDBAS>
JUMPE Q3,RCNM ;SKIP FOLLOWING CODE IF NO CUSTOM BREAK MASK
TXNN P5,INTT ;BREAK MASK, SKIP IF IN CURRENT CONTEXT
JRST [ XCTU [DMOVE A,(Q3)] ;PREVIOUS, GET FIRST TWO WORDS
XCTU [DMOVE C,2(Q3)] ;GET SECOND TWO
JRST RCNM1]
MOVEM A,CMDBAS ;SAVE COMND BASE ADDRESS FOR SAVES
DMOVE A,(Q3) ;CURRENT CONTEXT, GET BREAK MASK
DMOVE C,2(Q3)
RCNM1: DMOVEM A,UMSK ;REMEMBER BREAK MASK
DMOVEM C,2+UMSK
RCNM: SETZM TTYIND ;ASSUME NOT A TERMINAL
MOVEM P,STKP ;SAVE STACK PTR FOR FAIL RETURN
TXZ F,RD%BTM+RD%BFE+RD%BLR ;INIT RETURN FLAGS
TXNN F,RD%JFN ;HAVE JFNS IN 1?
JRST [ MOVE A,P1 ;NO. GET STRING POINTER
CALL RDCBP ;CHECK IT
RETERR(RDTX1) ;NO GOOD
MOVEM A,P1 ;PUT IT BACK IN P1
JRST RDTXT1]
HLRZ A,P1 ;GET INPUT JFN
RFCOC ;GET CURRENT CC STATES
DMOVEM B,COC ;SAVE THEM
ANDCM C,[3B1+3B7+3B9+3B11] ;NO ECHO OF ^R, ^U, ^V, ^W
SFCOC ;SET OUR MODES
DMOVEM B,OURCOC ;REMEMBER OURS
MOVEM C,MOD ;SAVE C
DVCHR ;MTOPR WORKS ON TTY ONLY
HLRZ A,P1 ;GET INPUT JFN
LDB T2,[POINTR T2,DV%TYP] ;GET DEVICE TYPE CODE
CAIE T2,.DVTTY ;SKIP IF IT'S A TERMINAL
JRST NOTTY ;NO - NOT A TTY
SETOM TTYIND ;INDICATE IT'S A TERMINAL
GDSTS ;GET DEVICE BITS
ANDX B,GD%PAR ;ISOLATE PARITY ADD BIT
MOVEM B,ADDPAR ;SAVE PARITY BIT
MOVEI B,4 ;SET THE LENGTH IN THE BLOCK
MOVEM B,MASK ;SET INTO THE BLOCK
MOVEI B,.MORBM ;GET WAKE-UP MASK FOR SAVING
XMOVEI C,MASK ;WHERE IT'S GOING
MTOPR
MOVEI B,.MORFW ;SAVE THE FIELD WIDTH
MTOPR
MOVEM C,FWTH
NOTTY: MOVE C,MOD ;RESTORE C
RFMOD ;GET CURRENT WAKEUP MODES
TXZ B,TT%OSP ;FORGET OUTPUT SUPPRESS
MOVEM B,MOD ;SAVE AND RESTORE WHEN DONE
TRZ B,TT%WAK+TT%DAM ;WILL SET THESE FIELDS
TRO B,<FLD(.TTASC,TT%DAM)> ;ASCII IN
CALL RTSETW ;COMPUTE AND SET WAKEUPS FROM MASK
TXO B,TT%IGN ;IGNORE TT%WAK IN THE SFMOD
SFMOD ;SET NEW MODES
GTTYP ;GET TERMINAL TYPE
HRRZ A,B
HRR P5,TTYPE1(A) ;GET ADDRESS OF CURSOR CONTROL TAALE
TRNE P5,-1 ;HAVE A TABLE?
TXO P5,DSPMF ;YES, SET DISPLAY MODE
; ..
;VERIFY ALL OF THE STRING POINTERS
RDTXT1: SKIPN A,P4 ;HAVE A DEST POINTER?
RETERR (RDTX1) ;NO. THAT IS AN ERROR
CALL RDCBP ;YES. CHECK IT OUT
RETERR(RDTX1) ;BAD
MOVE P4,A ;GET CONVERTED POINTER BACK
SKIPN A,Q1 ;HAVE A ^R BUFFER?
JRST RDTOPM ;NO. GO AROUND THEN
CALL RDCBP ;YES. VERIFY IT
RETERR (RDTX1) ;BAD
MOVE Q1,A ;GET VERIFIED POINTER
RDTOPM: MOVE A,P2 ;VERIFY BACKUP LIMIT PTR
CALL RDCBP
RETERR (RDTX1) ;RETURN ERROR
MOVEM A,P2 ;OK
MOVE A,Q2 ;GET TOP OF BUFFER
CALL RDCBP ;VERIFY IT
RETERR (RDTX1) ;BAD
MOVE Q2,A ;ALL VERIFIED NOW
JUMPLE P3,WRAP0 ;MAKE SURE COUNT HAS ROOM IN IT
MOVEI A,0 ;A WILL COUNT CONSECUTIVE QUOTERS
MOVE B,P4 ;WE'LL START SCANNING BACKWARDS FROM CURRENT END OF DESTINATION STRING
RDT1: CAMN B,P2 ;ANY MORE EDITABLE DATA?
JRST RDT2 ;NO
XCTBU [LDB C,B] ;YES, LOOK AT PREVIOUS CHARACTER
CAIE C,CMQUOT ;A QUOTER?
JRST RDT2 ;NO, SO WE'RE DONE SCANNING
MOVNI C,1 ;YES, BACK UP TO CONTINUE THE SCAN
ADJBP C,B
MOVE B,C
AOJA A,RDT1 ;KEEP TRACK OF HOW MANY QUOTES HAVE BEEN SEEN
RDT2: STOR A,QUOTEF,FLG2 ;NOTE WHETHER FIRST CHARACTER SEEN SHOULD BE QUOTED
;...
;MAIN LOOP - DOES INPUT OF BYTE AND DISPATCH ON CHARACTER CLASS
;ACTION ROUTINES EXIT TO:
; INSRT - APPEND CHARACTER AND CONTINUE
; NINSRT - CONTINUE WITHOUT APPENDING CHARACTER
; DING - BUFFER NOW EMPTY, POSSIBLE RETURN TO USER
; WRAP, WRAP0 - RETURNS TO USER
NINSRT: TXNE F,RD%BEG ;USER REQUEST INSTANT RETURN WHEN LIMIT REACHED?
TXNN F,RD%BLR ;YES, HAS LIMIT BEEN REACHED
CAIA ;NOT ALL OF THE ABOVE
JRST WRAP0 ;TIME TO RETURN (TYPIST EDITED BACK FAR ENOUGH)
TXNE F,RD%RIE ;USER WANTS RETURN ON NO INPUT?
JRST [ TXNN F,RD%JFN ;YES, HAVE A JFN FOR INPUT?
JRST .+1 ;NO, PROCESS UNTIL STRING RUNS OUT
HLRZ A,P1 ;GET INPUT JFN
SIBE ;STILL HAVE INPUT?
JRST .+1 ;YES, KEEP PROCESSING
JRST WRAP0] ;NO, RETURN
SKIPE TTYIND ;SKIP IF NOT A TERMINAL
JRST [ MOVEI B,.MOSFW ;SET FIELD WIDTH - IT CAN GET SCREWED UP
MOVE C,P3 ;GET THE BYTE COUNT
HLRZ A,P1 ;GET INPUT JFN
MTOPR
JRST .+1]
TXNN P5,INTT ;ARE WE IN INTERNAL MODE?
JRST NINSR0 ;NOPE, DO POINTER STORES
TXNN F,RD%BLR ;ARE WE PAST BACKUP LIMIT?
JRST NINSR1 ;NOPE, SKIP POINTER STORES
MOVE A,CMDBAS ;STORE INTERNAL POINTERS
UMOVEM P4,.CMPTR(A)
UMOVEM P3,.CMCNT(A)
JRST NINSR1 ;SKIP OVER OTHER POINTER STORES
NINSR0: CALL STP6NI ;STORE DEST POINTER
CALL STP3NI ;STORE COUNT
NINSR1: CALL WNULL ;GUARANTEE THAT BUFFER ENDS WITH NULL, IN CASE INTERRUPT
CALL RDBIN ;DO BIN
MOVE A,B ;SAVE CHARACTER IN A
IDIVI B,CHRWRD ;SET UP TO GET CHAR CLASS
LDB B,CCBTAB(C) ;GET IT FROM BYTE TABLE
IDIVI B,2 ;SET UP TO REF DISPATCH TABLE
JUMPE C,[HLRZ D,DISPTC(B) ;GET LH ENTRY
JRST .+2]
HRRZ D,DISPTC(B) ;GET RH ENTRY
MOVE B,A ;ROUTINES WANT CHARACTER IN B
MOVE C,FLG2
TXZN C,QUOTEF ;ARE WE SUPPOSED TO QUOTE THE NEXT CHARACTER?
JRST 0(D) ;DISPATCH TO ACTION ROUTINE
MOVEM C,FLG2 ;TURN OFF QUOTEF IN FLAG WORD
JRST INSRT ;YES, DON'T PERFORM SPECIAL ACTION
;RETURN FROM ACTION ROUTINE TO APPEND CHARACTER AND CONTINUE.
; B/ CHARACTER
INSRT: SKIPN Q3 ;USER SPECIFYING BREAKS?
JRST INSRT1 ;NO. GO ON
MOVE A,B ;YES. GET BYTE
IDIVI B,^D32 ;GET WORD AND OFFSET FOR TESTING
MOVE C,BITS(C) ;TEST MASK
EXCH A,B ;CHAR TO B
ADDI A,UMSK ;WORD TO TEST
TDNE C,0(A) ;IS THE BIT SET?
JRST WRAP ;YES. WRAP IT UP THEN
INSRT1: XCTBU [IDPB B,P4] ;APPEND BYTE TO USER STRING
SOJG P3,NINSRT ;CONTINUE IF STILL HAVE COUNT
JRST WRAP0 ;COUNT EXHAUSTED, RETURN
;BUFFER EMPTY, RING BELL OR RETURN TO USER
BNULL: TXNE F,RD%RND ;USER WANTS RETURN?
JRST WRAPE ;YES
DING: MOVEI B,"G"-100 ;NO, DO BELL
CALL RDBOUT
CALL CHKBLP ;UPDATE BACKUP DATABASE
JRST NINSRT ;AND WAIT FOR FOR INPUT
;RETURNS TO USER.
;HERE IF RETURNING BECAUSE BUFFER BECAME EMPTY AND RD%RND SET
WRAPE: TXO F,RD%BFE ;TELL USER
JRST WRAP0
;APPEND LAST CHARACTER AND RETURN
WRAP: XCTBU [IDPB B,P4] ;APPEND BYTE
SUBI P3,1 ;UPDATE COUNT
TXO F,RD%BTM ;SAY BREAK CHARACTER TERMINATED INPUT
;STORE NULL ON STRING AND RETURN
WRAP0: CALL WNULL ;PUT IN A NULL
CALL WRAPX ;UPDATE USER VARIABLES, ETC.
JXN P5,INTT,RSKP ;DO RET IF INTERNAL CALL
SMRETN
;ROUTINE TO WRITE A NULL AFTER LAST CHARACTER IN BUFFER IF ROOM.
WNULL: JUMPLE P3,R ;DON'T STORE NULL IF COUNT EXHAUSTED
MOVE D,P4 ;GET COPY OF DEST PTR
SETZ B,
XCTBU [IDPB B,D] ;STORE NULL WITHOUT CHANGING USER PTR
RET
;UPDATE USER VARIABLES AND RESTORE USER MODES ON RETURN
WRAPX: CALL STP3 ;UPDATE BYTE COUNT
TXNN F,RD%JFN ;HAVE JFNS?
JRST WRAPX1 ;NO
HLRZ A,P1 ;YES, GET INPUT JFN
MOVE B,MOD ;RESTORE MODES
SKIPE TTYIND ;SKIP IF NOT A TTY
TXO B,TT%IGN ;TTY - IGNORE THE TT%WAK FIELD
SFMOD
SKIPN TTYIND ;IF IT'S NOT TTY DON'T SKIP
JRST NOTTY2
MOVEI B,.MOSBM ; TO RESTORE THE MASK
XMOVEI C,MASK
MTOPR
MOVEI B,.MOSFW ;RESTORE FIELD WIDTH
MOVE C,FWTH
MTOPR
NOTTY2: DMOVE B,COC ;RESTORE CC
SFCOC
WRAPX1: CALL STP6 ;UPDATE POINTER
CALL STFLG ;UPDATE FLAGS
RET
;RETURN IF FAILURE DETECTED DURING TEXTI
TXIBAD: MOVE P,STKP ;RESET STACK
MOVE Q3,LSTERR ;SAVE ERROR CODE
CALL WRAPX ;UPDATE, ETC.
MOVE A,Q3 ;RETURN ERROR CODE
JXN P5,INTT,R ;LOCAL RETURN
RETERR
;PARAMETERS FOR CLASS TABLE
CCBITS==4 ;BITS/BYTE
CHRWRD==^D36/CCBITS ;BYTES/WORD
;TABLE OF BYTE PTRS TO REFERENCE CLASS TABLE
XX==CCBITS-1
CCBTAB: REPEAT CHRWRD,<
POINT CCBITS,CTBL(B),XX
XX=XX+CCBITS>
;CLASS DISPATCH TABLE
;N.B. - MUST MATCH DEFINITIONS OF CLASS TYPES ABOVE
DISPTC: TOPS10,,BREAKS
ZERO,,EOL1
PUNC,,INSRT
DELC,,RTYPE
DELIN,,KLWORD
RDCR,,RDQT
;CHARACTER CLASS TABLE
DEFINE CCN (A,B)<
REPEAT B,<
CC1 (A)>>
DEFINE CC1 (C)<
WCHAR==WCHAR+1 ;;KEEP TRACK OF WHICH CHARACTER WE'RE ON
QQ=QQ+CCBITS
IFG QQ-^D35,<
QW
QW=0
QQ=CCBITS-1>
QW=QW+<C>B<QQ>>
;MACRO WHICH DECLARES A CHARACTER TO BE A SPECIAL TEXTI EDITING CHARACTER
DEFINE CCED (C)<
CC1 (C) ;;DO SAME AS CC1
BRKCH. (WCHAR) ;;SAY WE HAVE TO BREAK ON IT
>
WCHAR==-1
QW==0
QQ==-1
BRINI. ;;INITIALIZE BREAK MASKS
CTBL: CC1(ZER) ;0
CCN(PUN,6) ;1-6
CC1(TOP) ;7
CCN(PUN,2) ;10-11
CC1(EOLC) ;12
CC1(TOP) ;VT
CC1(TOP) ;FF
CC1(RDCRC) ;CR
CC1(PUN) ;^N
CC1(RTYP) ;^O - ACTS LIKE ^R IF SEEN IN INPUT STREAM
CCN(PUN,2) ;^P, ^Q
CCED(RTYP) ;^R
CCN(PUN,2) ;^S,^T
CCED(KLL) ;^U
CC1(RDQTC) ;^V
CCED(KWRD) ;^W
CCN(PUN,2) ;^X,^Y
CCN(BRK,2) ;^Z,$
CCN(PUN,4) ;34-37
CCN(PUN,^D16) ;40-/
CCN(SAFE,^D10) ;0-9
CCN(PUN,7) ;:-@
CCN(SAFE,^D26) ;A-Z
CCN(PUN,6) ;]-140
CCN(SAFE,^D26) ;A-Z
CCN(PUN,4) ;173-176
CCED(RUBO) ;177
QW ;GET LAST WORD IN
EDC0==W0. ;REMEMBER BREAK MASKS (SEE "DEFINE BRKCH.")
EDC1==W1.
EDC2==W2.
EDC3==W3.
;LOCAL ROUTINES TO DO LOGICAL BIN AND BOUT. DO ILDB/IDPB IF
;HAVE STRING PTR
;RDBIN
; CALL RDBIN
; RETURN +1 ALWAYS, B/ BYTE READ FROM P1
RDBIN: TXNN F,RD%JFN ;HAVE JFN FOR SOURCE?
JRST [ XCTBU [ILDB B,P1] ;GET A BYTE
CALL STSRC ;STORE NEW POINTER
JRST RDBIN1]
RDBIN2: HLRZ A,P1 ;GET INJFN
BIN ;GET BYTE
ERJMP TXIBAD ;FAILS
JUMPE B,[GTSTS ;NULL ENCOUNTERED, SEE IF EOF
TXNN B,GS%EOF
JRST RDBIN2 ;NOT EOF, FLUSH NULL
JRST TXIBAD] ;EOF, CAUSE FAIL RETURN
RDBIN1: ANDI B,177 ;FLUSH POSSIBLE EXTRANEOUS BITS
TXNN F,RD%RAI ;RAISE INPUT?
RET ;NO, RETURN
CAIL B,"A"+40 ;YES, HAVE LC CHARACTER?
CAILE B,"Z"+40
SKIPA ;NO
SUBI B,40 ;YES, CONVERT TO UPPER
RET
;RDBOUT
; B/ BYTE
; CALL RDBOUT
; RETURN +1 ALWAYS, FLUSHES CHARACTER IF NO OUTPUT JFN
RDBOUT: TXNN F,RD%JFN ;HAVE OUTPUT JFN?
RET ;NO, DO NOTHING
HRRZ A,P1 ;YES. GET IT
BOUT ;OUTPUT THE BYTE
ERJMP TXIBAD ;FAILS
RET
;RDSOUT - OUTPUT STRING ALA RDBOUT
; B/ STRING PTR
; CALL RDSOUT
; RETURN +1 ALWAYS, LOSES CHARACTERS IF NO OUTPUT JFN
RDSOUT: TXNN F,RD%JFN ;HAVE OUTPUT JFN?
RET ;NO, DO NOTHING
HRRZ A,P1 ;YES, GET IT
SETZ C,
SOUT ;OUTPUT THE STRING
RET
;CHECK BYTE POINTER GIVEN AS ARGUMENT
;OWGBP FROM NON-ZERO SECTION IS ALLOWED
; A/ BYTE POINTER
; CALL RDCBP
; RETURN +1: NO GOOD, SIZE INVALID
; RETURN +2: OK, LH INITIALIZED IF NECESSARY
RDCBP:
HLRZ B,A ;GET LH
CAIN B,-1 ;IS DEFAULT?
HRLI A,(<POINT 7,0>) ;YES, FILL IN 7-BIT
CALL SPCSNZ ;CALLER FROM NON-ZERO SECTION?
JRST RDCBP2 ;NO
LDB B,[POINT 6,A,5] ;YES...GET THE P FIELD
CAIGE B,45 ;IS THIS A OWGBP?
JRST RDCBP2 ;NO
CAIL B,54 ;YES...IS IT 7,8,9, OR 18 BIT BYTES
CAIN B,77 ;AND NOT 77
RET ;NOT CORRECT SIZE OR 77 SO RETURN BAD
JRST RDCBP3 ;OK...RETURN GOOD
RDCBP2: LDB B,[POINT 6,A,11] ;CHECK BYTE SIZE
CAIGE B,7 ;7 OR GREATER?
RET ;NO, RETURN BAD
RDCBP3: IBP A ;INCR IT AND DECR IT ONCE SO WILL
CALL DBP ; BE IN KNOWN STATE FOR COMPARES
RETSKP
;ROUTINE TO SET WAKEUP SET FROM CHARACTER BIT MASK
; Q3/ 0 IFF NO CUSTOM MASK SUPPLIED
; B/ CURRENT TERMINAL MODE WORD
; CALL RTSETW
; RETURN +1, ALWAYS
RTSETW: SKIPN TTYIND ;SKIP IF IT'S A TERMINAL
RET
SAVEP
SAVET
SETZB P2,P3 ;ZERO AREA USED FOR MASK HOLDING
SETZB P4,P5
JUMPE Q3,RSET1 ;DID USER PROVIDE A MASK
DMOVE P2,UMSK ;YES, GET FIRST PART
DMOVE P4,2+UMSK ;AND REST
RSET1: TXNN P2,<1B<.CHCRT>> ;BREAK ON CR?
TXNE F,RD%BEL ;WANT END OF LINE WAKING?
TXO P2,CM%BEL ;YES - SET BITS
TXNE F,RD%TOP ;TOPS10 WAKE SET?
TXO P2,CM%TOP
TXNE F,RD%PUN ;PUNCTUATION?
JRST [ TXO P2,CM%PU0 ;YES - SET FOUR WORDS
TXO P3,CM%PU1
TXO P4,CM%PU2
TXO P5,CM%PU3
JRST .+1]
TXNE F,RD%BRK ;WAKE ON CTRL/Z OR ESC?
TXO P2,CM%CZE ;YES
TXO P2,EDC0 ;ALWAYS BREAK ON EDITING CHARACTERS
TXO P3,EDC1
TXO P4,EDC2
TXO P5,EDC3
MOVEI B,.MOSBM ;NOW TO SET THE MASK
MOVEI C,P1 ;POINT TO MASK
MOVEI P1,4 ;LENGTH OF BLOCK
MTOPR ;SET IT
RET
;LOCAL ROUTINES FOR EDITING FUNCTIONS
;DELETE CHARACTER FROM DESTINATION - BACK UP PTR AND CHECK
;FOR TOP OF BUFFER
; CALL BACK
; RETURN +1: AT TOP OF BUFFER, NO CHARACTER TO DELETE
; RETURN +2: CHARACTER DELETED
BACK: CAMN P4,Q2 ;AT TOP OF BUFFER?
RET ;YES
MOVE A,P4 ;GET DEST PTR
CALL DBP ;DECREMENT IT
MOVEM A,P4 ;PUT IT BACK
CALL CHKBLP ;CHECK BACKUP LIMIT
AOJA P3,RSKP ;UPDATE COUNT AND RETURN
;PUT BYTE BACK INTO SOURCE
; B/ BYTE
; CALL RDBKIN
; RETURN +1 ALWAYS
RDBKIN: TXNN F,RD%JFN ;HAVE JFN FOR SOURCE?
JRST [ MOVE A,P1 ;NO, BACK UP P1 STRING
CALL DBP
MOVEM A,P1
RET]
HLRZ A,P1 ;BACK UP THE JFN
BKJFN
JFCL
RET
;CHECK FOR POINTER AT OR BEFORE BACKUP LIMIT
CHKBLP: HRRZ T1,P4 ;GET ADR OF MAIN PTR
CAILE T1,0(P2) ;GREATER THAN LIMIT?
RET ;YES, OK
CAIE T1,0(P2) ;LESS THAN LIMIT?
JRST CHKBL1 ;YES, SET FLAG
HLRZ T1,P4 ;NO, GET P FIELDS
HLRZ T2,P2
CAML T1,T2 ;T1 SAME OR EARLIER BYTE?
CHKBL1: TXO F,RD%BLR ;YES, FLAG LIMIT REACHED
RET
;FIND BEGINNING OF CURRENT LINE.
; CALL FNDLIN
; RETURN +1: AT TOP OF BUFFER
; RETURN +2: A/ BACKED-UP BYTE PTR TO BEGINNING OF LINE
; B/ BYTE COUNT CONSISTENT WITH P4 IN A
; C/ # OF NON-PRINTING CONTROLS IN THE LINE
FNDLIN: CAMN P4,Q2 ;AT TOP OF BUFFER?
RET ;YES
STKVAR <NOPRNT,SAVP3,SAVP4> ;WORK CELLS
SETZM NOPRNT ;NO NO PRINTING CHARACTERS YET
MOVEM P3,SAVP3
MOVEM P4,SAVP4 ;SAVE CURRENT LINE VARIABLES
XCTBU [LDB B,P4] ;GET FIRST CHARACTER TO DELETE
FNDLN1: CAIL B,40 ;A CONTROL?
JRST FNDLN3 ;NO, KEEP LOOKING
DMOVE C,OURCOC ;YES. SEE IF IT IS PRINITNG
ROTC C,0(B)
ROTC C,0(B)
TLNN C,(1B1) ;IS IT?
AOS NOPRNT ;NO. COUNT IT THEN
FNDLN3: MOVE A,P4 ;BACK UP ONE CHARACTER
CALL DBP
MOVEM A,P4
ADDI P3,1
CAMN P4,Q2 ;NOW AT TOP OF BUFFER?
JRST FNDLN2 ;YES, RETURN
XCTBU [LDB B,P4] ;GET NEXT CHARACTER TO DELETE
CAIE B,.CHLFD ;EOL OR LF?
JRST FNDLN1 ;NO, GO LOOK AT SOME MORE
FNDLN2: MOVE A,P4 ;RETURN NEW LINE VARIABLES
MOVE B,P3
MOVE P3,SAVP3 ;RESORE OLD LINE VARIABLES
MOVE P4,SAVP4 ;""
MOVE C,NOPRNT ;AND RETURN # OF NON-PRINTING CONTROLS
RETSKP
;ACTION ROUTINES
;ZERO BYTE
ZERO: SKIPE Q3 ;USER HAVE A MASK?
JRST INSRT ;YES. GO SEE ABOUT IT THEN
JRST WRAP0 ;NO. ALWAYS BREAK THEN
;REGULAR BREAKS
BREAKS: TXNE F,RD%BRK+RD%TOP ;REGULAR INCLUDES TOPS10 - BREAK?
JRST WRAP ;YES
JRST INSRT ;NO, STORE BYTE AND RETURN
;PUNCTUATION AND TOPS10 BYTES
TOPS10: TXNN F,RD%TOP ;BREAK?
PUNC: TXNE F,RD%PUN ;BREAK?
JRST WRAP ;YES
JRST INSRT ;NO
;CARRIAGE RETURN - IF LINE FEED FOLLOWS, TREAT LIKE EOL
RDCR: ;HERE ON A CR
SKIPN Q3 ;USER SPECIFYING BREAKS?
JRST RDCR0 ;NO
MOVEI A,UMSK ;YES SO GET ADDRESS OF BREAK MASK
MOVE A,0(A) ;GET THE FIRST WORD OF THE MASK
TXNE A,<1B<.CHCRT>> ;BREAK ON CARRIAGE RETURN?
JRST INSRT ;YES SO GO DO IT
RDCR0: ;HERE ON CR AND NOT BREAKING ON CR
CALL RDBIN ;GET THE NEXT CHAR
CAIN B,.CHLFD ;LF?
JRST RDCR1 ;YES, NORMAL NEWLINE
CALL RDBKIN ;NO, PUT BACK THE SECOND BYTE
MOVEI B,.CHCRT ;APPEND A REAL CR
JRST TOPS10
RDCR1: TXNE F,RD%CRF ;USER WANTS CR RETURNED?
JRST RDCR2 ;NO, SUPPRESS IT
MOVEI B,.CHCRT
XCTBU [IDPB B,P4] ;APPEND CR
SOJLE P3,[CALL RDBKIN ;NO MORE ROOM
JRST WRAP0] ;PUT LF BACK
RDCR2: MOVEI B,.CHLFD
EOL1: TXNE F,RD%BEL+RD%TOP+RD%PUN ;BREAK ON END OF LINE?
JRST WRAP ;YES
JRST INSRT ;NO
;QUOTE CHARACTER (^V) - INHIBITS EDITING ACTION OF FOLLOWING CHARACTER
RDQT: MOVX C,QUOTEF
IORM C,FLG2 ;REMEMBER TO QUOTE NEXT CHARACTER
JRST INSRT ;GO INSERT THE QUOTER
;DELETE CHARACTER (RUBOUT)
DELC: CALL BACK ;BACK UP PTR
JRST BNULL ;NOTHING LEFT IN BUFFER
MOVE D,P4
XCTBU [ILDB A,D] ;GET CHAR JUST DELETED
CAIN A,.CHLFD ;WAS IT LF?
JRST [ CALL DELCR ;YES, DELETE C/R AND UPDATE DISPLAY
JRST NINSRT]
MOVE B,MOD
TXNN B,TT%ECO ;ECHOS ON?
JRST NINSRT ;NO, SKIP DISPLAY UPDATE
TXNE P5,DSPMF ;WHAT KIND OF TERMINAL?
JRST [ CALL CURBK ;IF DISPLAY, BACK UP CURSOR
JRST NINSRT]
MOVE B,A ;NOT A DISPLAY TERMINAL
CALL RDBOUT ;ECHO DELETED CHARACTER
MOVEI B,"\"
CALL RDBOUT ;FOLLOW IT WITH A BACKSLASH
JRST NINSRT
;DELETE LAST CHARACTER TYPED IF IT'S A CARRIAGE RETURN
;AND UPDATE TERMINAL DISPLAY TO REFLECT DELETION OF CR/LF
DELCR: CAME P4,Q2 ;AT START OF BUFFER NOW?
JRST [ XCTBU [LDB B,P4] ;NO, GET CHARACTER BEFORE LINEFEED
CAIE B,.CHCRT ;IS IT CARRIAGE-RETURN?
JRST .+1 ;NO
CALL BACK ;YES, KILL IT TOO
JFCL ;(NEVER RETURNS +1)
JRST .+1]
MOVX B,TT%ECO
TDNN B,MOD ;ECHO ON?
RET ;NO, DON'T OUTPUT TO TERMINAL
TXNN P5,DSPMF ;WHAT KIND OF TERMINAL?
JRST [ HRROI B,[ASCIZ/
/] ;NON-VIDEO TERMINAL,
CALLRET RDSOUT] ; SO ACKNOWLEDGE WITH CRLF
CALL CURUP ;MOVE CURSOR UP 1 LINE
CALLRET RTYPES ;RETYPE LINE AND RETURN TO CALLER
;DELETE LINE (CONTROL-U)
DELIN: CALL DELIN0 ;DO THE WORK
CAME P4,Q2 ;BUFFER NOW EMPTY?
JRST NINSRT ;NO, CONTINUE
TXNE F,RD%RND ;YES, USER WANTS RETURN?
JRST WRAPE ;YES, RETURN
CALL RTYPP ;NO, RETYPE PROMPT
JRST NINSRT ;CONTINUE
DELIN0: TXNN F,RD%SUI ;IF NOT SUPPRESSING CTRL-U INDICATION,
CALL CURCR ;PUT CURSOR AT BEGINNING OF LINE
CALL FNDLIN ;FIND BEGINNING OF LINE
JRST DELIN1 ;NOTHING IN BUFFER
MOVEM A,P4 ;SET LINE VARIABLES TO BEGINNING
MOVEM B,P3
CAME P4,Q2 ;BUFFER NOW EMPTY?
JRST DELIN2 ;NO, GO TYPE DELETE INDICATION
DELIN1: TXNE F,RD%SUI ;BUFFER EMPTY, USER SUPPRESSING INDICATION?
JRST DELIN3 ;YES
DELIN2: JXO P5,DSPMF,DELIN3 ;IF DPY, LINE ALEADX CLEAN
HRROI B,[ASCIZ / XXX
/]
CALL RDSOUT ;NON-DPY, NOTE DELETION
DELIN3: CALLRET CHKBLP ;UPDATE BOUNDARY BITS AND RETURN
;DELETE WORD (CONTROL-W)
KLWORD: CALL BACK ;DELETE AT LEAST ONE CHARACTER
JRST BNULL ;WASN'T ONE
MOVE D,P4
XCTBU [ILDB B,D] ;GET CHAR JUST DELETED
CAIN B,.CHLFD ;LF OR EOL?
JRST [ CALL DELCR ;YES, DELETE CR AND UPDATE DISPLAY
JRST BWRD1] ;ENTER BACKWARDS-SCAN LOOP
BWRD4: MOVE C,MOD ;CHECK ECHOS
JXE C,TT%ECO,BWRD1 ;NO OUTPUT IF ECHOS OFF
JXE P5,DSPMF,BWRD1 ;JUMP IF NOT DISPLAY
XCTBU [LDB A,D] ;GET CHAR
CALL CURBKW ;BACK UP CURSOR BUT DON'T CLEAR SCREEN YET
BWRD1: CALL BACK ;DELETE NEXT CHARACTER
JRST BWRD2 ;NO MORE LEFT
MOVE D,P4 ;LOOK AT CHARACTER JUST DELETED
XCTBU [ILDB B,D]
IDIVI B,CHRWRD ;GET ITS CHARACTER CLASS
LDB B,CCBTAB(C)
CAIN B,SAFE ;IS IT A WORD SEPARATOR?
JRST BWRD4 ;NO, KEEP DELETING
IBP P4 ;YES, KEEP THAT CHARACTER
SUBI P3,1
BWRD2: CALL CHKBLP ;CHECK BACKUP LIMIT POINTER
MOVEI B,"_" ;INDICATE WORD DELETION
TXNN P5,DSPMF ;BUT ONLY IF NONDISPLAY
CALL RDBOUT
TXNE P5,DSPMF ;DISPLAY?
CALL CLRLNQ ;YES, THEN CLEAR TO END OF LINE
JRST NINSRT ;CONTINUE INPUT UNLESS BUFFER EMPTY ETC.
;RETYPE LINE (CONTROL-R)
RTYPE: MOVE B,MOD ;CHECK ECHOS
JXE B,TT%ECO,DING ;DING IF ECHOS OFF
CALL RTYPES ;DO THE WORK
CALL CHKBLP ;CHECK FOR BACKUP LIMIT SO ^R CAUSES RETURN ON RD%BEG
JRST NINSRT
;RETYPE PROMPT ONLY, ASSUMING CURSER ALREADY POSITIONED AT BEGINNING
;OF LINE
RTYPP: JRST RTYP33 ;ENTER AFTER ALL POSITIONING STUFF
;SUBROUTINE TO RETYPE LINE
RTYPES: JXE P5,DSPMF,[HRROI B,[ASCIZ /
/]
CALL RDSOUT ;NON-DISPLAY, GET CLEAN LINE
JRST RTYP33]
CALL CURCR ;PUT CURSOR TO BEGINNING OF LINE
RTYP33: CALL FNDLIN ;FIND BEGINNING OF LINE
MOVE A,Q2 ;AT TOP OF BUFFER - USE IT
MOVE D,A ;SAVE PTR TO BEGINNING OF LINE
CAME D,Q2 ;BEG OF LINE IS TOP OF BUFFER?
JRST RTYP1 ;NO, DON'T TYPE ^R BFR
SKIPE D,Q1 ;GET ^R BFR IF ANY
RTYP3: CAMN D,Q2 ;UP TO TOP OF BFR?
JRST RTYP4 ;YES, DONE WITH ^R BFR
XCTBU [ILDB B,D] ;GET CHAR FROM ^R BFR
JUMPN B,[CALL RDBOUT ;TYPE IT
JRST RTYP3]
RTYP4: MOVE D,Q2 ;DONE WITH ^R BFR, NOW DO MAIN BFR
RTYP1: CAMN D,P4 ;BACK TO END OF LINE?
RET ;YES
XCTBU [ILDB B,D] ;NO, GET NEXT BYTE
CALL RDBOUT ;TYPE IT
JRST RTYP1 ;LOOP UNTIL AT END OF BUFFER
;ROUTINE TO PUT CURSOR AT BEGINNING OF LOGICAL LINE. WILL DO CURUP'S
;IF NECESSARY.
CURCR: STKVAR <TWID,NUPS>
JXE P5,DSPMF,CURCRX ;NON-DPY, DO NOTHING
MOVEI B,.CHCRT ;DISPLAY, GET TO LEFT MARGIN
CALL RDBOUT
CAMN P4,Q2 ;BEGINNING OF BUFFER?
JRST RTYP2 ;YES, SO DEFINITELY NOT END OF LINE
XCTBU [LDB B,P4] ;NO, GET LAST CHAR
CAIN B,.CHLFD ;END OF LINE?
CALL CURUP ;YES, CURSOR UP FIRST
RTYP2: CALL CLRLIN ;CLEAR THE LINE
CALL GETWTH ;GET WIDTH OF LINE
JUMPE A,RTYP0 ;NO CURSOR UPS NECESSARY IF INFINITE WIDTH LINE
MOVEM A,TWID ;REMEMBER IT
CALL MEASUR ;GET PHYSICAL LENGTH OF LINE
MOVEI A,1 ;CAN'T, SO DON'T TRY TO BACK CURSOR UP
SOJ A,
IDIV A,TWID ;NOW A HAS NUMBER OF CURSOR UPS NEEDED TO GET TO BEGINNING OF LINE
MOVEM A,NUPS ;REMEMBER NUMBER OF UPS NEEDED
RTYP20: SOSGE NUPS ;MORE UPS NEEDED?
JRST RTYP0 ;NO, PROCEED WITH RETYPING LINE
CALL CURUP ;YES, DO ANOTHER
JRST RTYP20 ;AND LOOP FOR REST
RTYP0: CALL CLRLIN ;CLEAR THE LINE
CURCRX: RET
;ROUTINES TO RETURN DATA TO USER FOR RDTXT ROUTINES
STSRC: TXNE P5,RTTY+INTT ;RDTTY OR INTERNAL?
RET ;NOTHING TO DO
TXNE P5,RTXT ;RDTXT?
UMOVEM P1,T1 ;RETURN UPDATED SOURCE
UMOVE T1,T1 ;GET TEXTI BLK PTR
TXNE P5,TXTI ;TEXTI?
UMOVEM P1,.RDIOJ(T1) ;YES
RET ;AND DONE
STFLG: TXNE P5,INTT ;INTERNAL?
RET ;NOTHING TO DO
TXNE P5,RTTY ;RDTTY?
XCTU [HLLM F,T2] ;FLAGS TO T2
TXNE P5,RTXT ;RDTXT?
XCTU [HLLM F,T3] ;FLAGS TO T3
UMOVE T1,T1 ;GET TEXTI BLK PTR
TXNE P5,TXTI ;TEXTI?
XCTU [HLLM F,.RDFLG(T1)] ;FLAGS TO BLOCK
RET ;AND DONE
STP6: TXNE P5,INTT ;INTERNAL?
RET ;NOTHING TO DO
STP6NI: TXNE P5,RTTY ;RDTTY?
UMOVEM P4,T1 ;YES, POINTER TO T1
TXNE P5,RTXT ;RDTXT?
UMOVEM P4,T2 ;YES, POINTER TO T2
UMOVE T1,T1 ;GET TEXTI BLK PTR
TXNE P5,TXTI ;TEXTI
UMOVEM P4,.RDDBP(T1) ;YES, POINTER TO BLK
RET ;AND DONE
STP3: TXNE P5,INTT ;INTERNAL?
RET ;NOTHING TO DO
STP3NI: TXNE P5,RTTY ;RDTTY?
XCTU [HRRM P3,T2] ;YES, COUNT TO T2
TXNE P5,RTXT ;RDTXT?
XCTU [HRRM P3,T3] ;YES, COUNT TO T3
UMOVE T1,T1 ;GET TEXTI BLK PTR
TXNE P5,TXTI ;TEXTI?
UMOVEM P3,.RDDBC(T1) ;YES, COUNT TO BLK
RET ;AND DONE
;CURSOR CONTROL FUNCTIONS FOR DISPLAY TERMINALS
;CURSOR UP ONE LINE
CURUP: HRRZ A,P1 ;GET OUT JFN
RFPOS ;GET POSITION
TLNE 2,-1 ;A NON-ZERO POSITION?
SUB 2,[1,,0] ;YES. DECREMENT LINE NUMBER
SFPOS ;SET NEW POSITION
MOVEI B,.MORLC ;READ LINE COUNTER
MTOPR
SOJ C, ;DECREASE IT
MOVEI B,.MOSLC
MTOPR ;TELL SYSTEM DECREASED VALUE
CALL CLRLIN ;CLEAR LINE BEFORE UPPING CURSOR
HRRZ A,P5 ;GET ADDRESS ONLY
MOVE A,.CURUP(A) ;GET APPROPRIATE STRING FOR TERM TYPE
CALLRET DPCTL ;SEND IT
;ROUTINE TO BACK UP CURSOR OVER CHARACTER BEING DELETED, BUT DON'T
;NECESSARILY CLEAR THE CHARACTER. THIS ROUTINE IS PROVIDED FOR EFFICIENCY DURING
;WORD DELETE, IN WHICH IT IS FASTER TO NOT DELETE TO END OF PAGE FOR
;EVERY CHAR OF WORD BEING DELETED. SUPPLY CHARACTER BEING DELETED IN A.
CURBKW: MOVNI B,1 ;-1 IN B TO MARK THAT PAGE CLEARS SHOULDN'T HAPPEN
JRST CURBK0
;ROUTINE TO BACK UP THE CURSOR OVER A CHARACTER BEING DELETED.
;CALL IT WITH CHARACTER IN A.
CURBK: MOVEI B,0 ;MARK NOT DOING WORD DELETE
CURBK0: STKVAR <CLMS,CTRLWF,ARMF>
SETZM ARMF ;FIRST ASSUME NOT AT RIGHT MARGIN
MOVEM B,CTRLWF ;REMEMBER WHETHER DOING PAGE CLEARS OR NOT
CALL COLUMS ;SEE HOW MANY COLUMNS THIS CHARACTER TAKES UP
JRST RTYPES ;RETYPE LINE IF WE DON'T KNOW HOW MANY COLUMNS CHARACTER TAKES UP
MOVEM A,CLMS ;REMEMBER HOW MANY
CALL GETWTH ;GET WIDTH OF TERMINAL
MOVE C,A ;REMEMBER IN C
HRRZ A,P1 ;GET OUT JFN
RFPOS ;GET CURRENT POSITION
HRRZ D,B ;MAKE SIGNED INTEGER
JUMPE C,CURNRM ;COULDN'T BE AT RIGHT MARGIN IF ISN'T ONE
CAML D,C ;ARE WE AT RIGHT MARGIN
SETOM ARMF ;YES, REMEMBER
CURNRM: SUB D,CLMS ;SEE WHAT EFFECT CHARACTER WILL HAVE
JUMPL D,CURSPT ;JUMP IF BACKING UP REQUIRES GOING TO PREVIOUS LINE
CAIN D,0 ;SKIP IF THIS DELETION DOESN'T HIT LEFT MARGIN
JRST [ CAMN P4,Q2 ;YES. AT TOP OF BUFFER
JRST .+1 ;YES. DON'T DELETE ANY MORE
XCTBU [LDB C,P4] ;NO. GET PREVIOUS BYTE
CAIN C,.CHLFD ;AN EOL?
JRST .+1 ;YES. DON'T WRAP
JRST CURSPT] ;NO, GO BACK TO END OF PREV LINE
HRR B,D ;GET NEW LINE POSITION
SFPOS ;SET NEW LINE POSITION
SKIPE ARMF ;AT PHYSICAL RIGHT MARGIN?
SOS CLMS ;YES, SO ONE LESS COLUMN TO BACK UP
CURBK1: SOSGE CLMS ;DONE ENOUGH BACKING UP YET?
JRST CURBK2 ;YES
HRRZ A,P5 ;GET ADDRESS ONLY
MOVE A,.CURBK(A)
CALL DPCTL ;BACK UP ONE COLUMN
JRST CURBK1 ;LOOP FOR NUMBER OF BACKUPS NEEDED
CURBK2: SKIPE CTRLWF ;DOING WORD DELETE?
RET ;YES, SO DON'T CLEAR PAGE HERE
CALLRET CLRLNQ ;NO, SO CLEAR LINE HERE (UNLESS RIGHT ON MARGIN!)
CURSPT: MOVEI B,.CHCRT ;UNDOING LINE, SO CLEAR LINE WE'RE LEAVING
CALL RDBOUT
CALL CURUP ;GO BACK TO PREVIOUS LINE
CALL RTYPES ;RETYPE THE LINE
CALLRET CLRLNQ ;RETURN, MAYBE CLEARING LINE
;ROUTINE TO CAUTIOUSLY CLEAR TO END OF LINE ON SCREEN. ROUTINE CLEARS
;LINE IF AND ONLY IF CURSOR ISN'T AT RIGHT MARGIN, FOR WHICH CASE
;CLEARING LINE MIGHT ERRONEOUSLY CLEAR VALID CHARACTER AT END OF LINE.
CLRLNQ: CALL GETWTH ;GET WIDTH OF LINE
JUMPE A,CLRLIN ;COULDN'T BE AT RIGHT MARGIN IF ISN'T ONE
MOVE C,A ;SAVE WIDTH IN C
HRRZ A,P1
RFPOS ;GET CURRENT POSITION
CAILE C,(B) ;MIGHT WE BE AT RIGHT MARGIN?
CALL CLRLIN ;NO, SO IT'S SAFE TO CLEAR REST OF LINE WITHOUT LOSING CHARACTERS
RET
;CLEAR FROM CURSOR TO END OF LINE
CLRLIN: HRRZ A,P5 ;GET ADDRESS ONLY
MOVE A,.CUREL(A) ;GET ERASE LINE CODE
CALL DPCTL ;GO ERASE IT
RET ;ALL DONE
;ROUTINE TO SEND CONTROL SEQUENCES TO TERMINAL. PUTS TERMINAL
;IN BINARY MODE WHILE SENDING
; A/ BYTE (8)C,C,.. OR Z [BYTE (8)C,C,..]
; CALL DPCTL
; RETURN +1 ALWAYS, TERMINAL MODES PRESERVED
DPCTL: TXNN F,RD%JFN ;HAVE JFNS?
RET ;NO, DO NOTHING
STKVAR <WRD,PWRD,MD>
MOVEM A,WRD ;SAVE WORD
TLNE A,-1 ;HAVE WORD OR POINTER?
MOVEI A,WRD ;WORD, MAKE POINTER TO WORD
HRLI A,(POINT 8,0) ;CONSTRUCT POINTER TO STRING
MOVEM A,PWRD ;SAVE IT
HRRZ A,P1 ;GET OUT JFN
RFMOD ;GET CURRENT TERM MODES
TXO B,TT%IGN ;DON'T CHANGE WAKEUP BITS
MOVEM B,MD ;SAVE
TXZ B,TT%DAM ;SET TO BINARY
SFMOD
DPCTL1: ILDB B,PWRD ;GET BYTE
CAIE B,.STP ;STOP CODE?
JRST [ SKIPE ADDPAR ;ADDING PARITY TO THIS LINE?
CALL TTCMPP ;COMPUTE PARITY FOR THIS CHARACTER
BOUT ;NO, SEND IT
JRST DPCTL1]
MOVE B,MD ;RESTORE TERM MODES
SFMOD
RET
;ROUTINE WHICH TAKES CHAR IN A, AND RETURNS IN A THE NUMBER OF COLUMNS
;USED TO PRINT THAT CHARACTER ON THE PAPER. SKIPS IF KNOWS.
COLUMS: STKVAR <CCHRX>
MOVEM A,CCHRX ;REMEMBER THE CHARACTER
CAIL A,40 ;CONTROL CHARACTER?
JRST COLNC ;NO
CALL GETCOC ;GET CONTROL BITS FOR CHARACTER
MOVE B,CCHRX ;GET THE CHARACTER
JUMPE A,COL0 ;IF NOT BEING DISPLAYED, CHAR TAKES NO COLUMNS
CAIN A,1 ;BEING SHOWN AS UPARROW-CHARACTER?
JRST COLUP ;YES, UPARROW-CHARACTER
CAIN B,.CHTAB ;IS CHARACTER A REAL OR SIMULATED TAB?
JRST COLTAB ;YES, GO FIGURE IT OUT
CAIN A,2 ;SENDING ACTUAL CODE?
JRST COLDN ;YES, SO WE DON'T KNOW HOW MANY COLUMNS IT TAKES
CAIN B,.CHESC ;IS CHARACTER ALTMODE?
JRST COL1 ;YES, SO SIMULATE WITH ONE POSITION
COLDN: RET
COL1: MOVEI A,1 ;FOR CHARS TAKING ONE COLUMN
RETSKP
COL2: MOVEI A,2 ;TWO COLUMNS
RETSKP
COL0: MOVEI A,0 ;CHARACTERS THAT TAKE NO COLUMNS
RETSKP
COLNC: CAIN A,.CHDEL ;RUBOUT?
JRST COL0 ;YES, TAKES NO COLUMNS
CAIL A,101 ;UPPERCASE LETTER?
CAILE A,132
JRST COL1 ;NO, ASSUME 1 COLUMN FOR EVERYTHING ELSE
HRRZ A,P1
RFMOD ;GET MODE WORD
TXNE B,TT%UOC ;FLAGGING UPPERCASE LETTERS?
TXNE B,TT%LCA ;AND NO LOWERCASE?
JRST COL1 ;NO TO EITHER, ONLY TAKES ONE COLUMN
JRST COL2 ;YES TO BOTH, CHARACTER TAKES 2 COLUMNS
COLUP: MOVE A,CCHRX ;GET CONTROL CHARACTER
ADDI A,100 ;SEE WHICH CHARACTER BEING "CONTROL"ED
CALL COLUMS ;SEE HOW MANY COLUMNS THAT CHARACTER TAKES
JRST COLDN ;CAN'T COMPUTE IF DON'T KNOW HOW TO PRINT THING BEING CONTROLED
AOJ A, ;ADD 1 FOR THE UPARROW (CONTROL-B WHEN
RETSKP ;FLAGGING ON TAKES 3 COLUMNS!!)
;CHARACTER IS TAB. FIGURE OUT HOW MANY COLUMNS IT TAKES BY COUNTING
;COLUMNS FROM BEGINNING OF LINE.
COLTAB: CAMN Q2,P4 ;IS THERE AT LEAST ONE CHAR LEFT IN BUFFER?
JRST COLT2 ;NO
XCTBU [LDB A,P4] ;YES, GET CHARACTER BEFORE THE TAB
CAIE A,.CHLFD ;IS TAB FIRST CHAR ON LINE?
JRST COLT2 ;NO
MOVEI A,8 ;YES, SO TAB TAKES 8 COLUMNS
RETSKP
COLT2: CALL MEASUR ;MEASURE LENGTH OF LINE IN PHYSICAL COLUMNS
JRST COLDN ;CAN'T, SO GIVE UP
MOVE B,A
ADDI A,8
TRZ A,7 ;SEE WHAT COLUMN TAB BROUGHT US TOO
SUB A,B ;CALCULATE COLUMNS TAKEN BY TAB
RETSKP ;DONE!
;ROUTINE TAKING CONTROL CHARACTER IN A AND RETURNING 2-BIT COC FIELD
;FOR THAT CHARACTER IN A.
GETCOC: DMOVE B,OURCOC ;GET BITS
LSH A,1 ;GET NUMBER OF PLACES TO SHIFT
LSHC B,(A) ;LEFT-JUSTIFY BITS IN B
LDB A,[420200,,B] ;GET CORRECT BITS
RET
;ROUTINE TO GET WIDTH OF LINE. SUBROUTINIZED SO THAT WHEN SOMEONE
;DECIDES TO FIX PROBLEMS ASSOCIATED WITH GETTING WIDTHS OF NONTERMINALS,
;THE FIX WILL ONLY NEED TO BE MADE IN ONE SPOT. THIS ROUTINE RETURNS
;WIDTH IN A.
GETWTH: MOVEI A,0(P1) ;NO
MOVEI B,.MORLW ;GET WIDTH OF LINE
MTOPR ;GO GET IT
MOVE A,C ;RETURN WIDTH IN A
RET
;ROUTINE TO MEASUR PHYSICAL COLUMNS TAKEN UP BY LINE. RETURNS VALUE
;IN A.
;SKIPS IFF SUCCESSFUL IN MEASURING LENGTH OF LINE
;CR AND LF ARE IGNORED DURING THE CALCULATION. (THAT IS SO THAT WHEN
;DOING ^R TO REPRINT PREVIOUS LINE AFTER CR HAS BEEN TYPED, LENGTH OF
;PREVIOUS LINE GETS RETURNED BY THIS ROUTINE REGARDLESS OF THE TERMINAT-
;ING CR)
MEASUR: SETZM CCNT ;INITIALIZE THE COLUMN COUNTER
CALL FNDLIN ;FIND BEGINNING OF LINE
MOVE A,Q2 ;USE BEGINNING OF BUFFER IF THAT'S WHERE WE ARE
MOVEM A,CCPTR ;SAVE POINTER TO LINE TO BE SCANNED
CAMN A,Q2 ;IS THIS LINE FIRST ONE OF BUFFER?
JRST COLTR ;YES, MUST SCAN ^R BUFFER TOO
COLT1: MOVE A,CCPTR
CAMN A,P4 ;HAVE WE SCANNED ENTIRE LINE YET?
JRST COLTE ;YES
XCTBU [ILDB A,CCPTR] ;NO, GET NEXT CHARACTER FROM BUFFER
CALL COLACC ;ACCOUNT FOR THIS CHARACTER
JRST COLDN ;DO THE "DON'T KNOW" CASE
JRST COLT1 ;LOOP FOR REST OF LINE
COLTE: MOVE A,CCNT ;RETURN COLUMN VALUE IN A
RETSKP
COLTR: SKIPN A,Q1 ;FIRST LINE OF BUFFER. IS THERE A ^R BUFFER?
JRST COLT1 ;NO
MOVEM A,CRPTR ;YES, REMEMBER POINTER TO IT
COLR1: MOVE A,CRPTR ;GET POINTER TO ^R BUFFER SO FAR
CAMN A,Q2 ;HAVE WE HIT BEG OF BUFFER?
JRST COLT1 ;YES
XCTBU [ILDB A,CRPTR] ;GET NEXT CHARACTER FROM ^R BUFFER
JUMPE A,COLT1 ;LEAVE LOOP IF DONE
CALL COLACC ;ACCOUNT FOR CHARACTER
JRST COLDN ;DO THE DON'T KNOW CASE
JRST COLR1 ;DO REST OF CHARACTERS IN ^R BUFFER
;SUBROUTINE USED FROM ABOVE TO ACCOUNT FOR A CHARACTER SCANNED IN THE
;LINE
;GIVE IT CHARACTER IN A.
;SKIPS IFF KNOWS HOW TO ACCOUNT FOR CHARACTER.
COLACC: CAIN A,.CHTAB ;A TAB?
JRST COLTI ;YES
CAIE A,.CHCRT ;END OF LINE?
CAIN A,.CHLFD
RETSKP ;YES, IGNORE IT
CALL COLUMS ;NO, SEE HOW MANY COLUMNS IT TAKES
RET ;NON-SKIP IF FUNNY CHARACTER
ADDB A,CCNT ;ADD NUMBER OF COLUMNS IT TAKES
RETSKP
COLTI: MOVE A,CCNT ;TAB SEEN DURING SCAN, GET CURRENT COUNT
ADDI A,8 ;SEE WHERE TAB BRINGS IT
TRZ A,7
MOVEM A,CCNT
; IDIVI A,^D72
; CAIL B,^D60 ;NEAR RIGHT MARGIN?
; RET ;YES, SO GIVE UP, SINCE STRANGE THINGS
;HAPPEN LIKE LINEWRAPPING, OR VT05S WHICH
;TYPE ONLY ONE SPACE ON TABS NEAR RIGHT MARGIN
RETSKP
TNXEND
END