Trailing-Edge
-
PDP-10 Archives
-
BB-4170H-SM
-
sources/comnd.mac
There are 52 other files named comnd.mac in the archive. Click here to see a list.
;<4.MONITOR>COMND.MAC.110, 3-Jan-80 08:08:24, EDIT BY R.ACE
;UPDATE COPYRIGHT DATE
;<4.MONITOR>COMND.MAC.109, 16-Nov-79 09:02:33, EDIT BY OSMAN
;more 4.2500 - don't plug default string in when chain is NUM => KEY, and
;input is a keyword
;<4.MONITOR>COMND.MAC.108, 31-Oct-79 15:34:58, EDIT BY OSMAN
;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,1980 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
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
;FLAGS IN FUNCTION DISPATCH TABLE
;NOTE: ONLY THE LEFT HALF IS AVAILABLE
CMNOD==1B0 ;NO DEFAULT POSSIBLE
CMSBF==1B1 ;SPECIAL BREAK MASK ALLOWED
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
XCOMND::TRVAR <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>
;...
;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.
;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
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) ;SETUP 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 XCOM7 ;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
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
HRRZ T1,(T2) ;GET 0 OR ADDRESS OF STANDARD BREAK MASK
JUMPE T1,XC1 ;IF SPECIAL FUNCTION, DON'T DO ANYTHING
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 XCOMN0
;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 ;STOR 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 ;PREFIX CHARACTER OR 0
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 (DISP,BRK,BTS,PRE,SUF)
< DEFARG BRK..,BRK
DEFARG BTS..,BTS
DEFARG PRE..,PRE
DEFARG SUF..,SUF
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
.CMKEY:: MNX XCMKEY,KEYBRK,CMSBF ;KEYWORD
.CMNUM:: MNX XCMNUM,NUMBRK ;INTEGER
.CMNOI:: MNX XCMNOI ;NOISE WORD
.CMSWI:: MNX XCMSWI,SWIBRK,0,"/" ;SWITCH
.CMIFI:: MNX XCMIFI,FILBRK ;INPUT FILE
.CMOFI:: MNX XCMOFI,FILBRK ;OUTPUT FILE
.CMFIL:: MNX XCMFIL,FILBRK ;GENERAL FILESPEC
.CMFLD:: MNX XCMFLD,FLDBRK,CMSBF ;ARBITRARY FIELD
.CMCFM:: MNX XCMCFM ;CONFIRM
.CMDIR:: MNX XCMDIR,DIRBRK ;DIRECTORY NAME
.CMUSR:: MNX XCMUSR,USRBRK ;USER NAME
.CMCMA:: MNX XCMCMA ;COMMA
.CMINI:: MNX XCMINI,0,CMNOD ;INITIALIZE COMMAND
.CMFLT:: MNX XCMFLT,FLTBRK ;FLOATING POINT NUMBER
.CMDEV:: MNX XCMDEV,DEVBRK,CMSBF,0,[ASCIZ /:/] ;DEVICE NAME
.CMTXT:: MNX XCMTXT,TXTBRK,CMSBF ;TEXT
.CMTAD:: MNX XCMTAD ;TIME AND DATE
.CMQST:: MNX XCMQST ;QUOTED STRING
.CMUQS:: MNX XCMUQS,0,CMNOD ;UNQUOTED STRING
.CMTOK:: MNX XCMTOK ;TOKEN
.CMNUX:: MNX XCMNUM,NUXBRK ;NUMBER DELIMITED BY NON-DIGIT
.CMACT:: MNX XCMACT,ACTBRK ;ACCOUNT
.CMNOD:: MNX 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
SFCOC ;RESTORE THEM
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
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
CMIND: 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
JRST [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
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)
MOVEI T2," "
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
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
;****************************************
;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 ONLY
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 A PREFIX CHARACTER
;
; WORD COBSUF HAS 0 OR ADDRESS OF SUFFIX STRING
; T1/ ERROR CODE FOR PREFIX (IGNORED UNLESS PREFIX GIVEN)
;
;RETURNS +1: T1/ LENGTH OF FIELD INCLUDING PREFIX AND SUFFIX
CMRFLD: MOVEM T1,PREERR ;SAVE POSSIBLE ERROR CODE
CALL GETFUN ;GET FUNCTION CODE
HLRZ T4,CFNTAB(T1) ;GET ADDRESS OF CONTROL BLOCK
SKIPN T1,COBBRK(T4) ;GET ADDRESS OF STANDARD BREAK MASK
RET ;NONE, SO RETURN 0 LENGTH
MOVE T2,COBFGS(T4) ;GET SPECIAL FIELD FLAGS
TXNE F,CM%BRK ;USER HAVE A SPECIAL BREAK MASK?
TXNN T2,CMSBF ;YES, IS ONE ALLOWED?
CAIA ;NOT GIVEN OR NOT ALLOWED, DON'T USE IT.
MOVEI T1,SPCMSK ;GIVEN AND VALID, USE SPECIAL MASK.
MOVEM T1,CMRBRK ;REMEMBER ADDRESS OF BREAK MASK
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
MOVE T1,COBPRE(T4) ;GET POSSIBLE PREFIX CHARACTER
MOVEM T1,PRECHR ;REMEMBER IT
CALLRET CMRFL0 ;JOIN COMMON CODE
;CMRFLN READS EXACTLY N CHARACTERS. IN OTHER WORDS, THE N + 1TH 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
JRST CMRATR ;COUNT EXHAUSTED, EXIT
CALL RDCRLF ;NL NEXT?
JRST CMRAT2 ;NO
CALL UNCRLF ;YES, UNREAD IT
JRST CMRATT ;RETURN
CMRAT2: 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 CMAMB] ;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 [ TXO F,CMQCAN ;YES, FLAG
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
MOVE T3,ATBPTR ;REMEMBER CURRENT ATOM POINTER,
MOVEM T3,ATBSUF ;SO WE'LL KNOW WHERE SUFFIX BEGINS
JRST .+1]
CMRNS: CALL SKPNB ;SKIP IF CHARACTER IS NOT A BREAK CHARACTER
JRST CMRAT1 ;PREFIX SEEN, SKIP IT
JRST CMRATR ;YES
CMRAT3: CALL STOLCH ;BUILD KEYWORD STRING
JRST CMRAT1
;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
SKPNB1: MOVE T2,T1 ;GET COPY OF CHAR
IDIVI T2,40 ;COMPUTE INDEX TO BIT MASK
MOVE T3,BITS(T3)
ADD T2,CMRBRK
TDNE T3,0(T2) ;BREAK CHARACTER?
RETSKP ;YES
JRST SK2RET ;NO, GIVE DOUBLE SKIP
SKHPRE: CAME T1,PRECHR ;MAKE SURE PREFIX CHARACTER IS SUPPLIED
JRST [ TXNE F,CMPS1F ;MERELY MEASURING STRING?
JRST CMRTIE ;YES, ATOM ENDS BEFORE NON-PREFIX
CALL TIELCH ;FORCE NULL ATOM BUFFER
MOVE T1,PREERR ;PREFIX NOT SUPPLIED, GIVE APPORPRIATE ERROR
CALL XCOMNE]
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 CMROOM ;MAKE SURE WE'RE ALLOWED TO READ ANOTHER CHARACTER
JRST CMRATR ;WE'RE NOT (COUNT EXHAUSTED)
CALL CMCIN ;READ CHARACTER BEING QUOTED
JRST CMRAT3 ;STORE CHARACTER AND CONTINUE
;ROUTINE WHICH SKIPS IFF WE'RE ALLOWED TO READ ANOTHER CHARACTER
CMROOM: SKIPG CMRBRK ;BREAK SET GIVEN?
AOSG CMRBRK ;NO, COUNT. HAVE WE READ ENOUGH?
CAIA ;KEEP READING
RET
RETSKP
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 CMRTIE ;NO, SO JUST ALLOW NULL FIELD
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 ;FOUND ILLEGAL CHARACTER, STORE NO MORE!
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 ;WAS DEFAULT USED?
MOVEI T1,0 ;YES, SO USER DIDN'T TYPE ANY CHARACTERS
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 "
CMRQST: TXNE F,CMDEFF ;HAVE DEFAULT?
RETSKP ;YES
CALL CMCIN ;GET FIRST CHAR
CAIN T1,CMHLPC ;FIRST CHAR IS HELP?
JRST [ TXO F,CMQUES ;YES
RETSKP]
CAIE T1,.CHESC
CAIN T1,CMFREC ;RECOGNITION ATTEMPTED?
CALL CMAMB ;YES, AMBIGUOUS
CAIE T1,CMQTCH ;START OF STRING?
RET ;NO, FAIL
CMRQS1: CALL RDCRLF ;END OF LINE?
CAIA ;NO
CALLRET UNCRLF ;YES, UNREAD IT AND GIVE FAILURE RETURN
CAIE T1,CMQTCH ;ANOTHER QUOTE?
JRST CMRQS2 ;NO, GO STORE CHARACTER
CALL CMCIN ;YES, PEEK AT ONE AFTER
CAIN T1,CMQTCH ;PAIR OF QUOTES?
JRST CMRQS2 ;YES, STORE ONE
CALL CMDIP ;NO, PUT BACK NEXT CHAR
CALL TIELCH ;TIE OFF ATOM BUFFER
RETSKP ;GOOD
CMRQS2: CALL STOLCH ;STOR 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
;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 CMCIN0 ;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
RET] ;RETURN
TXZE F,CMCLCV ;QUOTED DASH? (AND CLEAR FLAG)
RET ;YES--RETURN THE DASH
CALL CMCIN0 ;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 CMCIN0 ;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
CMCIN0: SOJL P5,[SETZ P5, ;MAKE INPUT EXACTLY EMPTY
CALL CMCIN1 ;NONE LEFT, GO GET MORE
JRST CMCIN0]
XCTBU [ILDB T1,P4] ;GET NEXT ONE
SOS P3 ;UPDATE FREE COUNT
CALLRET CMCINT ;LIGHT SPECIAL FLAGS AND RETURN
;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 BACKUP OVER NEW-LINE, INSTEAD OF CMDIP.
RDCRLF: CALL CMCIN ;GET NEXT CHARACTER
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 ;SETUP 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) ;SETUP ^R BUFFER
UMOVE Q2,.CMBFP(P2) ;SETUP TOP OF BUFFER
UMOVE P1,.CMIOJ(P2) ;SETUP 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
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)
XCTBU [LDB T1,P4] ;GET LAST CHAR
CAIE T1,.CHLFD ;AN ACTION CHAR?
CAIN T1,.CHESC
JRST CMCIN3 ;YES
CAIE T1,CMHLPC
CAIN T1,CMFREC ;^F?
JRST CMCIN3 ;YES
MOVE T1,CMCSF ;GET SAVED FLAGS
TXNE T1,CM%WKF ;WAKEUP ON FIELDS?
JRST CMCIN3 ;YES
JRST CMCIN2 ;NO, GET MORE INPUT
CMCIN3: 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
CAIN T1,CMCOM2 ;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: MOVE T1,P4
CALL DBP ;DECREMENT BYTE PTR
MOVEM T1,P4
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
MOVE T1,P4 ;GET POINTER
CALL DBP ;DECREMENT IT
MOVEM T1,P4 ;PUT IT BACK
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 TYPEIN
;DOESN'T RETURN, BUT "CALL CMAMB" IS OFTEN MORE USEFUL THAN "JRST CMAMB"
;SO DURING DEBUGGING YOU CAN TELL HOW YOU GOT HERE
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 PRECEEDED BY SLASH
XCMSWI: TXO F,CMSWF ;NOTE DOING SWITCH
MOVEI T1,NPXNSW ;ERROR CODE IF SLASH NOT SEEN
CALL CMRFLD ;READ SWITCH FIELD
JRST KEYW0 ;FINISH LIKE KEYWORD
;KEYWORD LOOKUP FUNCTION
XCMKEY: TXZ F,CMSWF ;NOT SWITCH
CALL CMRFLD ;GET INPUT
KEYW0: UMOVE T2,.CMABP(P2) ;POINT TO KEYWORD BUFFER
MOVE T1,FNARG ;GET TABLE HEADER ADDRESS
CALL XTLOOK ;LOOKUP
ITERR () ;BAD TABLE
TXNE F,CMQUES ;HAD "?"
JRST CMQ1 ;YES, GO TYPE ALTERNATIVES
JXN T2,TL%NOM,[NOPARS NPXNOM] ;NO MATCH
JXN T2,TL%AMB,CMAMB ;DING
TXNN T2,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
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
;"?" TYPED, FIRST PARTIAL MATCH FOUND. TYPE ALL PARTIAL MATCHES
CMQ1: JXN T2,TL%NOM,[
JXN F,CMQUE2,CMRTYP ;DO NOTHING IF NOT FIRST ALTERNATIVE
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
;ARBITRARY TEXT TO ACTION CHARACTER
XCMTXT: CALL CMRFLD ;READ TEXT
JXN F,CMQUES,[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
;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
JRST [ CALL TIELCH ;MAKE ATOM LENGTH 0, SO "/BLECCH" ON "SWITCH OR CONFIRM" GIVES "INVALID SWITCH" INSTEAD OF "NOT CONFIRMED"
NOPARS NPXNC]
JRST XCOMXI ;OK
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
JRST CMRTYP] ;RETYPE AND TRY AGAIN
CAIE T1,CMFREC ;^F?
CAIN T1,.CHESC ;ESC?
CALL CMAMB ;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
UMOVE T1,.CMABP(P2) ;SETUP 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
NOPARS NPXICN ;INVALID CHARACTER IN NUMBER
;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
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
MOVE T2,DATPT ;GET END OF TIME AND DATE
UMOVE T1,.CMABP(P2) ;GET BEGINNING
CALL SUBBP ;CALCULATE NEGATIVE NUMBER OF CHARACTERS READ
MOVEM T1,DATPT ;REMEMBER HOW MANY CHARACTERS TO READ
CALL CMFSET ;RESET TO BEGINNING OF FIELD
MOVE T1,DATPT ;CMRFLN NEEDS TO KNOW HOW MANY 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 XCOMNP ;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 XCOMXR]
TXNN Q1,CM%IDA ;HAVE DATE?
JRST [ SETO T2, ;NO, DEFAULT TO TODAY
SETZ T4,
ODCNV ;GET TODAY
UMOVEM T2,T2 ;SETUP FOR IDCNV
UMOVEM T3,T3
JRST .+1]
IMCALL .IDCNV,MSEC1 ;CONVERT TO INTERNAL
JRST XCOMNP ;FAILED
JRST XCOMXR ;OK, TAD ALREADY IN T2
;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 ;SETUP 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
UMOVE T1,T4 ;GET USER'S AC4
IMCALL .IDTNC,MSEC1
JRST [ UMOVE T4,T1 ;RESTORE USER'S AC4
RET] ;IDTNC FAILED
UMOVE T4,T1 ;RESTORE USER'S AC4
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
JXN F,CMQUES,CMDEVH ;HELP
JXN F,CMDEFF,CMDEV1 ;ASSUME TERMINATOR IF DEFAULT GIVEN
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) ;SETUP STDEV ARGS
UMOVEM T1,T1
IMCALL .STDEV,MSEC1
JRST XCOMNP ;FAILED
CMDEV2: JRST XCOMXI
CMDEVH: CALL DOHLP ;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.
XCMUQS:
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
JRST FIXES1 ;CHECK FOR ESCAPE AND RETURN
;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
JXN F,CMQUES,NODHLP ;GO GIVE HELP IF REQUESTED
JXN F,CMDEFF,NOD1 ;DON'T REQUIRE COLONS IN DEFAULT STRING
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
NODHLP: CALL DOHLP ;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
PARNOD: MOVEI T2,CPN ;GET MAXIMUM NUMBER OF CHARACTERS IN NAME
XNOD0: ILDB C,A ;GET NEXT CHARACTER FROM NODE NAME
JUMPE C,[ MOVEI A,CPN ;NAME OVER, GET MAXIMUM LENGTH
SUB A,B ;SUBTRACT COUNTDOWN TO GET REAL LENGTH
RETSKP]
CAIL T3,"0" ;IS THE CHARACTER
CAILE T3,"Z" ;NUMERIC OR UPPER CASE
JRST XNOD2 ;ITS NOT
CAILE T3,"9" ;...
CAIL T3,"A" ;...
CAIA ;GOOD CHARACTER, JUST SAVE IT
JRST XNOD2 ;TRY FOR LOWER CASE ALPHA
XNOD1: SOJGE T2,XNOD0 ;HAVE WE SEEN ENOUGH CHARACTERS?
MOVEI A,COMX19 ;TOO MANY CHARACTERS IN NAME
RET
XNOD2: CAIG T3,"z" ;BIGGER THAN LOWER CASE Z?
CAIGE T3,"a" ;OR LESS THAN LOWER CASE A?
JRST XNOD3 ;YES, GIVE ILLEGAL CHARACTER IN NODE NAME
JRST XNOD1 ;LOOK FOR MORE
XNOD3: MOVEI A,COMX18 ;ILLEGAL CHARACTER IN NODE NAME
RET
;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) ;SETUP 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> ;SETUP 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) ;SETUP ^R PTR
UMOVEM T1,.GJRTY(Q1)
UMOVEM Q1,T1 ;SETUP 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
CALL CMGJC ;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
CMGJ3: MOVE T1,ATBPTR ;REMOVE TERMINATOR FROM ATOM BUFFER
CALL DBP
MOVEM T1,ATBPTR
AOS ATBSIZ ;UPDATE COUNT
CALL CMDIP ;DONE, PUT TERMINATOR BACK
SOJG Q3,CMGJ3 ;LOOP FOR ALL OF TERMINATOR
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
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 ;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 CMAMB ;ABIGUOUS
CAIN T1,CMHLPC ;HELP REQUEST?
JRST [ CALL DOHLP ;YES
JXN F,CM%SDH,CMRTYP
HRROI T1,[ASCIZ/ "/]
CALL CMSOUT
MOVE T1,FNARG
CALL CMUSOU
MOVEI T1,""""
CALL CMCOUT
JRST CMRTYP]
NOPARS NPXNMT ;NO MATCH OF TOKEN
;DIRECTORY OR USER NAME
XCMUSR: TXOA F,CMUSRF ;NOTE USER REQUIRED
XCMDIR: TXZ F,CMUSRF
CMDIR1: CALL CMRFLD ;READ FIELD
CMDIR4: TXNE F,CMQUES ;HELP?
JRST CMDIRH ;YES
TXNE F,CM%ESC ;RECOGNITION REQUESTED?
CALL CMDREC ;YES, SET UP FOR IT
TXNN F,CM%ESC
CALL CMDEMO ;NO, EXACT MATCH ONLY
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
CMDIRH: 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
;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 SETUP 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 SETUP 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 TYPEIN
UMOVEM T1,T1
UMOVEM T2,T2
RET
;COMMA, ARBITRARY CHARACTER
XCMCMA: MOVEI T1,"," ;SETUP 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 XCOMXI ;YES, WIN
CAIE T1,CMFREC ;^F?
CAIN T1,.CHESC ;ESC?
CALL CMAMB ;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
;LOCAL ROUTINE TO SETUP 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) ;SETUP 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 SETUP 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:
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 SETUP: 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>
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]
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 RDTXT1
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, BACKUP 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]
CALL STP6 ;STORE DEST POINTER
CALL STP3 ;STORE COUNT
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 ;SETUP TO GET CHAR CLASS
LDB B,CCBTAB(C) ;GET IT FROM BYTE TABLE
IDIVI B,2 ;SETUP 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
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
CCN(PUN,4) ;16-21 (^N-^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
; 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
LDB B,[POINT 6,A,11] ;CHECK BYTE SIZE
CAIGE B,7 ;7 OR GREATER?
RET ;NO, RETURN BAD
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: 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 - BACKUP 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, BACKUP P1 STRING
CALL DBP
MOVEM A,P1
RET]
HLRZ A,P1 ;BACKUP 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 ;BACKUP 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: 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 INSRT1 ;GO INSERT THE QUOTER
;DELETE CHARACTER (RUBOUT)
DELC: CALL BACK ;BACKUP 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, BACKUP 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: STKVAR <CRPOSI,CRPOSO>
SETOM CRPOSO ;ASSUME AT BEGINNING NOW
MOVEI A,0(P1) ;GET OUTPUT JFN
RFPOS ;GET CURSOR POSITION
HRRZM B,CRPOSI ;SAVE IT
MOVEI C,0
CALL FNDLIN ;FIND BEGINNING OF LINE
JRST DELIN1 ;NOTHING IN BUFFER
MOVE D,B ;COPY BYTE COUNT
SUB D,C ;DISCOUNT NON-PRINTERS
SUB D,P3 ;# OF BYTES IN LINE
MOVEM D,CRPOSO ;SAVE IT
XCTBU [LDB C,P4] ;GET LAST CHAR IN BUFFER
CAIN C,.CHLFD ;AT END OF LINE NOW?
SETOM CRPOSO ;YES. NO SPECIAL POSITIONING THEN
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,[MOVEI B,.CHCRT ;IF DISPLAY, DO CR
CALL RDBOUT
CAIN C,.CHLFD ;BACKED UP A LINE?
CALL CURUP ;YES, CURSOR UP ONE
MOVE A,CRPOSO ;BYTES IN LINE
CAMLE A,CRPOSI ;DID LINE WRAP?
CALL CURUP ;YES. DO A CURSOR UP THEN
CALL CLRPAG ;THEN CLEAR LINE (AND PAGE)
JRST DELIN3]
HRROI B,[ASCIZ / XXX
/]
CALL RDSOUT
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 ;BACKUP 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 CLRPGQ ;YES, THEN CLEAR TO END OF PAGE
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: STKVAR <TWID,NUPS>
JXE P5,DSPMF,[HRROI B,[ASCIZ /
/]
CALL RDSOUT ;NON-DISPLAY, GET CLEAN LINE
JRST RTYP33]
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 CLRPAG ;CLEAR THE LINE (AND PAGE)
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 CLRPAG ;CLEAR THE LINE (AND PAGE)
RTYP33: CALL FNDLIN ;FIND BEGINNING OF LINE
JRST [ MOVE A,Q2 ;AT TOP OF BUFFER- USE IT
JRST .+1] ;GO ON
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
;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
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
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
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 CLRPGQ ;NO, SO CLEAR PAGE HERE (UNLESS RIGHT ON MARGIN!)
CURSPT: CALL CURUP ;GO BACK TO PREVIOUS LINE
MOVEI B,.CHCRT ;UNDOING LINE, SO CLEAR LINE WE'RE LEAVING
CALL RDBOUT ;MUST CLEAR HERE SINCE WE MIGHT THEN BE
CALL CLRPAG ;AT END OF PREV LINE AND CAN'T DO ANOTHER CLRPAG WITHOUT CLOBBERING LAST CHAR ON LINE
CALL RTYPES ;RETYPE THE LINE
CALLRET CLRPGQ ;RETURN, MAYBE CLEARING PAGE
;ROUTINE TO CAUTIOUSLY CLEAR TO END OF PAGE ON SCREEN. ROUTINE CLEARS
;PAGE IF AND ONLY IF CURSOR ISN'T AT RIGHT MARGIN, FOR WHICH CASE
;CLEARING SCREEN MIGHT ERRONEOUSLY CLEAR VALID CHARACTER AT END OF LINE.
CLRPGQ: CALL GETWTH ;GET WIDTH OF LINE
JUMPE A,CLRPAG ;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 CLRPAG ;NO, SO IT'S SAFE TO CLEAR REST OF PAGE WITHOUT LOSING CHARACTERS
RET
;CLEAR FROM CURSOR TO END OF PAGE
CLRPAG: HRRZ A,P5 ;GET ADDRESS ONLY
MOVE A,.CURES(A) ;GET ERASE SCREEN 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?
JRST COL2 ;YES, CHARACTER TAKES 2 COLUMNS
JRST COL1 ;NO, ONLY TAKES ONE COLUMN
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