Trailing-Edge
-
PDP-10 Archives
-
BB-4170G-SM
-
sources/ncomnd.mac
There is 1 other file named ncomnd.mac in the archive. Click here to see a list.
;<3A.MONITOR>NCOMND.MAC.1, 7-Jun-78 14:02:20, Edit by KIRSCHEN
;DISALLOW NULL NODE NAME
;<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
;<OSMAN>NEWCOM.MAC.5, 12-Apr-78 14:19:11, EDIT BY OSMAN
;<OSMAN>NEWCOM.MAC.4, 12-Apr-78 13:43:41, 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
;<3A.MONITOR>COMND.MAC.7, 10-Apr-78 15:26:01, EDIT BY OSMAN
;<3A.MONITOR>COMND.MAC.6, 10-Apr-78 14:11:10, EDIT BY OSMAN
;IN CMGJ1 LOOP, MAKE SURE THERE'S A NULL AT END OF COMMAND STRING!
;<3A.MONITOR>COMND.MAC.5, 28-Mar-78 16:38:04, EDIT BY OSMAN
;ON SCREEN, PREVENT REPAINT UPON DELETION OF TAB AS FIRST CHAR OF SUBSEQUENT LINE
;<OSMAN>COMND.MAC.19, 17-Mar-78 16:18:07, 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.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)
;<3-MONITOR>COMND.MAC.164, 7-Nov-77 12:59:33, EDIT BY KIRSCHEN
;MORE COPYRIGHT UPDATING...
;<3-MONITOR>COMND.MAC.163, 25-Oct-77 10:20:08, EDIT BY KIRSCHEN
;INDIRECT FILE FIX IN XCMFIL ROUTINE
;<3-MONITOR>COMND.MAC.161, 10-Oct-77 10:05:54, EDIT BY KIRSCHEN
;UPDATE COPYRIGHT FOR RELEASE 3
;<3-MONITOR>COMND.MAC.160, 27-Sep-77 18:47:40, EDIT BY HURLEY
;MORE OR OR ...
;<3-MONITOR>COMND.MAC.159, 26-Sep-77 23:08:49, EDIT BY BORCHEK
; TCO #1863 - FIX INPUT OF <CR> IN TEXTI
;<3-MONITOR>COMND.MAC.158, 20-Sep-77 16:31:32, EDIT BY HURLEY
;FIXED THE "OR" "OR" PROBLEM
;<3-EXEC>COMND.MAC.13, 14-Sep-77 13:46:51, EDIT BY OSMAN
;DON'T LET EXEC INPUT "^E?" WHEN NOT ENABLED JUST SIT THERE.
;<3-EXEC>COMND.MAC.12, 9-Sep-77 18:36:35, EDIT BY OSMAN
;<3-EXEC>COMND.MAC.11, 9-Sep-77 18:10:25, EDIT BY OSMAN
;PREVENT "COMP /?" FROM LOOPING IN EXEC
;<3-MONITOR>COMND.MAC.155, 9-Sep-77 17:34:18, EDIT BY OSMAN
;FIX "SUBMIT /AFTER:3:0:0 /MUMBLE" EXEC COMMAND WHICH BROKE
;<3-MONITOR>COMND.MAC.154, 8-Sep-77 20:37:26, EDIT BY OSMAN
;MAKE "!COMMENT<CR>" JUST REPROMPT (AGAIN!)
;<3-MONITOR>COMND.MAC.153, 5-Sep-77 22:12:36, EDIT BY OSMAN
;PREVENT "JSB FULL" ON DUMPER COMMAND "LIST<CR>"
;<3-MONITOR>COMND.MAC.152, 5-Sep-77 21:35:13, EDIT BY OSMAN
;FIX MYSTERIOUS CHANGE AT FLDBRK+2 BACK TO 400000,,000760
;<3-MONITOR>COMND.MAC.151, 5-Sep-77 21:19:45, EDIT BY OSMAN
;FIX PROBLEM WHEREBY "COPY ABC?$" IGNORED $ (EXEC COMMAND)
;NOT FIXED EXPLICITLY!! SEEMED TO DISAPPEAR WHEN "LIST<CR>" BUG FIXED (SEE BELOW)
;<3-EXEC>COMND.MAC.10, 5-Sep-77 21:08:42, EDIT BY OSMAN
;<3-EXEC>COMND.MAC.9, 5-Sep-77 20:56:23, EDIT BY OSMAN
;<3-EXEC>COMND.MAC.8, 5-Sep-77 18:35:59, EDIT BY OSMAN
;<3-EXEC>COMND.MAC.7, 5-Sep-77 18:31:50, EDIT BY OSMAN
;<3-EXEC>COMND.MAC.6, 5-Sep-77 18:12:50, EDIT BY OSMAN
;<3-EXEC>COMND.MAC.5, 5-Sep-77 16:37:31, EDIT BY OSMAN
;<3-EXEC>COMND.MAC.4, 5-Sep-77 16:06:22, EDIT BY OSMAN
;FIX PROBLEM WHEREBY "LIST<CR>" TO DUMPER SAID "?FILENAME WAS NOT SPECIFIED"
;FIX BUG WHEREBY ^V WAS FAILING TO QUOTE NEXT CHARACTER IN COMND
;<3-MONITOR>COMND.MAC.149, 29-Aug-77 13:06:42, EDIT BY HURLEY
;<3.SEPT-FIELD-TEST>COMND.MAC.148, 29-Aug-77 11:32:20, EDIT BY HURLEY
;FIX HELP MESSAGES TO INDENT ONLY ONE SPACE
;<3-MONITOR>COMND.MAC.147, 24-Aug-77 18:18:05, EDIT BY MILLER
;<3-MONITOR>COMND.MAC.146, 24-Aug-77 18:15:54, EDIT BY MILLER
;MAKE ALL IMCALL'S PUT CODE IN SECTION MSEC1
;<3-MONITOR>COMND.MAC.145, 17-Aug-77 16:48:15, EDIT BY HURLEY
;MOVED CURSOR TABLES TO STG
;<3-MONITOR>COMND.MAC.144, 11-Aug-77 17:30:41, EDIT BY OSMAN
;FIX BUG WHEREBY "<CTRL/F>?" OR "<CTRL/F><CR>" CAUSES DING
;<3-MONITOR>COMND.MAC.143, 11-Aug-77 15:36:25, EDIT BY HURLEY
;ALLOW % AND * IN USER NAME STRINGS
;<ROMASH>COMND.MAC.142, 5-Aug-77 16:09:36, EDIT BY ROMASH
;<ROMASH>COMND.MAC.136, 29-Jul-77 15:40:31, EDIT BY ROMASH
;ADD TCO #1846--ADD .CMNOD FUNCTION TO READ A NODE NAME
;<3-MONITOR>COMND.MAC.135, 27-Jul-77 13:03:36, EDIT BY OSMAN
;FIX BUG WHEREBY "BUILD [HA$.A]<CR>" GAVE "?AMBIGUOUS" ($ CAUSED LL<DING>)
;<3-MONITOR>COMND.MAC.134, 21-Jul-77 18:02:19, EDIT BY OSMAN
;<3-EXEC>COMND.MAC.13, 21-Jul-77 15:23:55, EDIT BY OSMAN
;MAKE COMND UNDERSTAND PARTIAL RECOGNITION ON DIRECTORY NAMES
;<3-MONITOR>COMND.MAC.133, 21-Jul-77 14:33:02, EDIT BY OSMAN
;FIX BUG WHEREBY "?" IN LIEU OF DEFAULT KEYWORD FAILED TO GIVE ALTERNATIVE LIST
;ALSO, "UNIQUE-KEYWORD?" WASN'T LISTING THE ENTRY
;<3-MONITOR>COMND.MAC.132, 19-Jul-77 17:03:29, EDIT BY OSMAN
;<3-EXEC>COMND.MAC.12, 19-Jul-77 16:51:38, EDIT BY OSMAN
;<3-EXEC>COMND.MAC.11, 7-Jul-77 19:55:40, EDIT BY OSMAN
;MAKE SURE IF CR TYPED AT BEGINNING OF LINE THAT DEFAULT GETS USED
;<3-EXEC>COMND.MAC.10, 7-Jul-77 17:10:08, EDIT BY OSMAN
;ADD .CMACT TO READ ACCOUNT STRING
;<3-MONITOR>COMND.MAC.130, 1-Jul-77 16:19:12, EDIT BY OSMAN
;MAKE .CMUSR ALLOW DOTS IN USER NAMES
;<3-EXEC>COMND.MAC.9, 30-Jun-77 15:19:06, EDIT BY OSMAN
;MAKE CM%DWC GET CHECKED FROM FNARG
;<3-EXEC>COMND.MAC.4, 29-Jun-77 21:36:04, EDIT BY OSMAN
;MAKE "?" ON KEYWORDS TYPE THEM IN NEAT COLUMNS
;<3-EXEC>COMND.MAC.3, 29-Jun-77 15:27:30, EDIT BY OSMAN
;LIGHT RD%RND IF CM%WKF ON. MAKES "CONN$$^U" LEAVE ECHOING ON IN EXEC ETC.
;<3-EXEC>COMND.MAC.1, 28-Jun-77 13:49:44, EDIT BY OSMAN
;MAKE DEFAULTING WORK. "EXP,<CR>" WAS SAYING "?NO SUCH DIRECTORY".
;<3-MONITOR>COMND.MAC.127, 27-Jun-77 19:33:59, EDIT BY OSMAN
;FORGOT XCTBU IN FRONT OF LDB AT CMRAT2+6
;<3-EXEC>COMND.MAC.9, 24-Jun-77 18:01:38, EDIT BY OSMAN
;<3-EXEC>COMND.MAC.8, 24-Jun-77 17:39:58, EDIT BY OSMAN
;<3-EXEC>COMND.MAC.7, 24-Jun-77 16:46:02, EDIT BY OSMAN
;<3-EXEC>COMND.MAC.6, 24-Jun-77 15:57:13, EDIT BY OSMAN
;<3-EXEC>COMND.MAC.5, 24-Jun-77 15:41:27, EDIT BY OSMAN
;<3-EXEC>COMND.MAC.4, 23-Jun-77 17:28:53, EDIT BY OSMAN
;<3-EXEC>COMND.MAC.3, 23-Jun-77 13:15:23, EDIT BY OSMAN
;<3-EXEC>COMND.MAC.2, 23-Jun-77 13:11:12, EDIT BY OSMAN
;FIX CMTAD, SO "SUBMIT /AFTER:24-JUN-77/OUTP$" KNOWS THAT "/OUTP" IS OUT OF DATE FIELD
;<3-MONITOR>COMND.MAC.125, 21-Jun-77 15:38:37, EDIT BY OSMAN
;IMPLEMENT CM%DWC
;<3-MONITOR>COMND.MAC.124, 20-Jun-77 15:31:26, EDIT BY OSMAN
;MAKE STCMP TRULY IGNORE UPPER-LOWER-NESS OF STRINGS
;<3-MONITOR>COMND.MAC.123, 17-Jun-77 15:44:44, EDIT BY OSMAN
;FIX BUT IN .CMUSR. "F" LEFT OFF OF "CMUSRF"
;<3-MONITOR>COMND.MAC.122, 17-Jun-77 12:55:24, EDIT BY OSMAN
;MAKE EOF ON INDIRECT FILE TRANSPARENT TO CALLER OF COMND
;<3-MONITOR>COMND.MAC.121, 16-Jun-77 16:36:10, EDIT BY OSMAN
;PREVENT COMND FROM WIPING OUT USER'S EXTENDED GTJFN FLAGS
;<3-MONITOR>COMND.MAC.120, 10-Jun-77 21:48:56, EDIT BY OSMAN
;<3-MONITOR>COMND.MAC.119, 10-Jun-77 16:43:28, EDIT BY OSMAN
;ALLOW CM%PO ON .CMDIR, .CMUSR SO NONX NAMES CAN BE PARSED
;<3-MONITOR>COMND.MAC.118, 7-Jun-77 12:31:42, EDIT BY OSMAN
;<3-MONITOR>COMND.MAC.117, 7-Jun-77 12:29:36, EDIT BY OSMAN
;MAKE "?" TYPE MULTIPLE KEYWORDS ON ONE LINE
;<3-MONITOR>COMND.MAC.116, 30-May-77 14:36:17, EDIT BY MURPHY
;<3-MONITOR>COMND.MAC.115, 3-May-77 12:26:04, EDIT BY MURPHY
;TCO #1792 - USE G1%RIE IN GTJFN CALL, FIXES RUBOUT OF FILESPEC FIELD, ETC.
;<3-MONITOR>COMND.MAC.113, 29-Apr-77 16:25:04, Edit by HESS
;FIX CMCIN2 TO USE RESTORED P2 - GAVE ERRONEOUS EOF
;<3-MONITOR>COMND.MAC.112, 15-Mar-77 18:27:36, EDIT BY MURPHY
;TCO #1758 - ADD CM%WKF, CM%ABR, NO-PARSE CODES, ETC.
;<3-MONITOR>COMND.MAC.111, 28-Jan-77 20:59:17, Edit by MCLEAN
;<3-MONITOR>COMND.MAC.110, 18-Jan-77 13:25:26, Edit by MCLEAN
;<2-MONITOR>COMND.MAC.110, 14-Jan-77 16:11:21, EDIT BY MURPHY
;TCO #1713 - FIX NULL STRING IN TBLUK
;<3-MONITOR>COMND.MAC.108, 27-Dec-76 17:30:27, EDIT BY HURLEY
;<2-MONITOR>COMND.MAC.108, 20-Dec-76 16:35:08, EDIT BY MURPHY
;<2-MONITOR>COMND.MAC.107, 16-Dec-76 17:14:35, EDIT BY MURPHY
;<3-MONITOR>COMND.MAC.106, 28-Nov-76 14:51:50, Edit by MCLEAN
;TCO 1669 EXTENDED ADDRESSING
;<2-MONITOR>COMND.MAC.105, 11-Nov-76 18:23:30, EDIT BY MURPHY
;<2-MONITOR>COMND.MAC.104, 4-Nov-76 18:41:08, EDIT BY MURPHY
;<2-MONITOR>COMND.MAC.103, 3-Nov-76 15:00:15, EDIT BY MURPHY
;TCO #1644 - NEW FEATURES PER SPEC, CM%INV, .CMUQS, .CMTOK, .CMNUX, ETC
;<2-MONITOR>COMND.MAC.102, 2-Nov-76 17:55:31, EDIT BY MURPHY
;<2-MONITOR>COMND.MAC.101, 28-Oct-76 17:54:13, EDIT BY MURPHY
;TCO #1635 - XCTU AT CMINI1
;<2-MONITOR>COMND.MAC.100, 26-Oct-76 19:00:19, EDIT BY MURPHY
;<2-MONITOR>COMND.MAC.99, 26-Oct-76 18:03:41, EDIT BY MURPHY
;<2-MONITOR>COMND.MAC.98, 26-Oct-76 17:56:42, EDIT BY MURPHY
;<2-MONITOR>COMND.MAC.97, 14-Oct-76 19:38:31, EDIT BY MURPHY
;<2-MONITOR>COMND.MAC.96, 14-Oct-76 19:11:12, EDIT BY MURPHY
;<2-MONITOR>COMND.MAC.95, 14-Oct-76 18:36:19, EDIT BY MURPHY
;FIX BAD FLAG AT XCOMN0+1; ADD CHECK FOR ":" IN CMDEV; CHKLCH AT KEYW0
;<2-MONITOR>COMND.MAC.94, 14-Oct-76 18:31:20, EDIT BY MURPHY
;TCO #1596 - CHECK ECHOS OFF IN DELC, ETC.
;<2-MONITOR>COMND.MAC.93, 14-Oct-76 13:21:11, EDIT BY MURPHY
;TCO #1594 - TEXTI ERROR RETURN ON BAD INPUT JFN
;<2-MONITOR>COMND.MAC.92, 12-Oct-76 17:14:17, EDIT BY MURPHY
;TCO #1591 - .CMUQS, .CMCHR
;<2-MONITOR>COMND.MAC.91, 12-Oct-76 17:02:06, EDIT BY MURPHY
;<2-MONITOR>COMND.MAC.90, 12-Oct-76 10:45:59, EDIT BY MILLER
;TTY MTOPR'S RETURN DATA IN 3 INSTEAD OF 2
;<2-MONITOR>COMND.MAC.89, 7-Oct-76 11:43:41, EDIT BY MILLER
;CHANGE ASUBR VARIABLE NAME FROM STR TO STRG
;<2-MONITOR>COMND.MAC.88, 7-Oct-76 11:34:19, EDIT BY MILLER
;TCO 1570. USE MTOPR TO READ TERMINAL WIDTH
;<2-MONITOR>COMND.MAC.87, 5-Aug-76 16:53:04, EDIT BY HURLEY
;<2-MONITOR>COMND.MAC.86, 5-Aug-76 13:45:04, EDIT BY HURLEY
;MAKE CMDIR AND CMUSR USE RCDIR AND RCUSR JSYS'S
;<2-MONITOR>COMND.MAC.85, 9-Jul-76 17:13:35, EDIT BY MURPHY
;TCO #1462 - REDO
;<2-MONITOR>COMND.MAC.84, 1-Jul-76 22:40:14, EDIT BY BOSACK
;TCO 1462 - FIX ATOM BUFFER COUNT DISCREPANCY
;<2-MONITOR>COMND.MAC.83, 23-Jun-76 17:32:37, EDIT BY MURPHY
;TCO #1453 - DEFINE CM%RAI
;<1B-MONITOR>COMND.MAC.82, 22-Jun-76 18:48:59, EDIT BY MURPHY
;<1B-MONITOR>COMND.MAC.81, 21-Jun-76 17:49:47, EDIT BY MURPHY
;<1B-MONITOR>COMND.MAC.80, 21-Jun-76 16:07:15, EDIT BY MURPHY
;<1B-MONITOR>COMND.MAC.79, 21-Jun-76 14:01:33, EDIT BY MURPHY
;TCO #1385 ONE MORE TIME...
;<1B-MONITOR>COMND.MAC.78, 18-Jun-76 00:09:43, EDIT BY MURPHY
;<1B-MONITOR>COMND.MAC.77, 17-Jun-76 17:05:50, EDIT BY OSMAN
;TCO 1365 - MAKE SURE DELETED ENTRY ISN'T BEFORE TABLE ENTRIES
;<1B-MONITOR>COMND.MAC.76, 17-Jun-76 14:07:07, EDIT BY MURPHY
;<1B-MONITOR>COMND.MAC.75, 15-JUN-76 18:08:01, EDIT BY MURPHY
;<1B-MONITOR>COMND.MAC.74, 15-JUN-76 17:47:32, EDIT BY MURPHY
;<1B-MONITOR>COMND.MAC.73, 15-JUN-76 14:21:00, EDIT BY MURPHY
;<1B-MONITOR>COMND.MAC.72, 15-JUN-76 13:31:14, EDIT BY MURPHY
;<1B-MONITOR>COMND.MAC.71, 10-JUN-76 18:28:21, EDIT BY MURPHY
;<1B-MONITOR>COMND.MAC.70, 10-JUN-76 17:52:42, EDIT BY MURPHY
;TCO #1385 AGAIN
;<1B-MONITOR>COMND.MAC.69, 10-JUN-76 11:19:28, EDIT BY MILLER
;<1B-MONITOR>COMND.MAC.68, 10-JUN-76 11:12:16, EDIT BY MILLER
;TCO 1325. MORE WRAPPING FIXES
;<1B-MONITOR>COMND.MAC.67, 9-JUN-76 18:35:52, EDIT BY MURPHY
;TCO #1385 - MISC BUG FIXES
;<1B-MONITOR>COMND.MAC.63, 8-JUN-76 14:07:09, EDIT BY HURLEY
;TCO 1365 - TBDEL FAILS TO FAIL IF CALLED WITH AN ENTRY LOCATION
;THAT'S NOT IN THE TABLE
;<1B-MONITOR>COMND.MAC.62, 8-JUN-76 13:23:46, EDIT BY HURLEY
;TCO 1364 TBDEL DOESN'T WORK AND CAN CRASH THE SYSTEM
;<1B-MONITOR>COMND.MAC.61, 1-JUN-76 14:16:20, EDIT BY MILLER
;TCO 1325. FIX RETYPE FOR WRAPPED LINE
;<1A-MONITOR>COMND.MAC.60, 30-MAR-76 22:35:25, EDIT BY MURPHY
;TCO #1226 - CM%VRQ ADDED
;<1A-MONITOR>COMND.MAC.59, 30-MAR-76 21:07:49, EDIT BY MURPHY
;TCO #1225 - ^F IMPROVEMENTS AND VARIOUS BUG FIXES
;<2MONITOR>COMND.MAC.58, 9-FEB-76 19:30:41, EDIT BY MURPHY
;MCO #42 - FIX COMMENT LINES AND DEFAULT FIELD ESC
;<2MONITOR>COMND.MAC.55, 28-JAN-76 14:00:27, EDIT BY HURLEY
;MCO 38. FIX WAKE UP ON CERTAIN PUNCTUATION CHARACTERS
;<2MONITOR>COMND.MAC.54, 16-JAN-76 17:41:18, EDIT BY MURPHY
;<2MONITOR>COMND.MAC.53, 13-JAN-76 16:01:52, EDIT BY MURPHY
;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 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
JRST XCOMNE>
;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
;FLAGS IN FUNCTION DISPATCH TABLE
CMNOD==1B0 ;NO DEFAULT POSSIBLE
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 <ATBPTR,ATBSIZ,STKFEN,FNARG,<CMCCM,2>,PWIDTH,TABSIZ,DATPT,TABDON,CURSOR,CURPOS,KEYSIZ,BIGSIZ,RCFLGS,CMRBRK>
;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
MOVEM T1,P2 ;SAVE BLOCK PTR
MOVEM T2,P1 ;SAVE FN BLOCK PTR
HRL P1,P1 ;SAVE COPY OF ORIGINAL
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
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
; ..
; ..
XCOMN0: MOVE P,STKFEN ;NORMALIZE STACK IN CASE ABORTED ROUTINES
TXZ F,CM%ESC+CM%NOP+CM%EOC+CM%RPT+CM%SWT+CMBOL+CMCFF+CMDEFF+CMINDF ;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)]
HRRZ T1,P1
UMOVE T1,.CMDAT(T1) ;GET FUNCTION DATA IF ANY
MOVEM T1,FNARG ;KEEP LOCALLY
HRRZ T1,P1
ULOAD T1,CM%FNC,.CMFNP(T1) ;GET FUNCTION CODE
CAIL T1,0 ;VALIDATE FN CODE
CAIL T1,MAXCFN
ITERR COMNX1
MOVE T1,CFNTAB(T1) ;GET TABLE ENTRY FOR IT
JXN T1,CMNOD,XCOM0 ;DISPATCH NOW IF NO DEFAULT POSSIBLE
CALL INILCH ;SKIP SPACES AND INIT ATOM BUFFER
CALL CMCIN ;GET INITIAL INPUT
CAIN T1,CMCONC ;POSSIBLE LINE CONTINUATION?
JRST [ CALL CMCIN ;YES, SEE IF NL FOLLOWS
CAIE T1,.CHLFD
CALL CMRSET ;NO, RESET FIELD
CALL CMCIN ;RE-READ FIRST CHAR
JRST .+1] ;CONTINUE
CAIN T1,CMCOM2 ;COMMENT?
JRST CMCMT2 ;YES
CAIN T1,CMCOM1
JRST CMCMT1 ;YES
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
CAIN T1,.CHLFD ;EOL BEGINS FIELD?
JRST [ CALL CMDIP ;YES, PUT IT BACK
HRRZ T1,P1
ULOAD T1,CM%FNC,.CMFNP(T1) ;GET FUNCTION CODE
CAIN T1,.CMCFM ;CONFIRM?
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
CALL CMRSET
SETZ P5, ;YES, EMPTY LINE. IGNORE
CALL CMRTY0 ;REDO PROMPT
JRST XCOMN0] ;TRY AGAIN
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: HRRZ T1,P1
ULOAD T1,CM%FNC,.CMFNP(T1) ;GET FUNCTION CODE
HRRZ T1,CFNTAB(T1) ;DO IT
JRST 0(T1)
;ESC OR ^F AT BEG OF FIELD
XCOM2: TXNN F,CM%DPP ;YES, HAVE DEFAULT STRING?
JRST XCOM3 ;NO
CALL CMDCH ;FLUSH RECOG CHAR
XCOM4: 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
;COMMENT
CMCMT2: SETO T1, ;SAY NO TERMINATOR OTHER THAN EOL
CMCMT1: MOVEM T1,Q2 ;REMEMBER MATCHING TERMINATOR
CMCOM: CALL CMCIN ;GET NEXT CHAR
CAIN T1,CMCONC ;POSSIBLE LINE CONTINUATION?
JRST [ CALL CMCIN ;YES, CHECK FOR NL FOLLOWING
CAIN T1,.CHLFD
JRST CMCOM ;YES, STAY IN COMMENT
JRST .+1] ;NO, EXAMINE CHARACTER
CAIE T1,CMFREC ;RECOG REQUEST?
CAIN T1,.CHESC
JRST [ CALL CMAMB ;YES, DING
JRST CMCOM] ;KEEP GOING
CAIN T1,.CHLFD ;END OF LINE?
JRST [ CALL CMDIP ;YES, PUT IT BACK
JRST XCOM5] ;DO WHATEVER
CAMN T1,Q2 ;MATCHING CHARACTER?
JRST XCOM5 ;YES, END OF COMMENT
JRST CMCOM ;NO, KEEP LOOKING
;TABLE OF COMND FUNCTIONS
CFNTAB: PHASE 0
.CMKEY::!XCMKEY ;KEYWORD
.CMNUM::!XCMNUM ;INTEGER
.CMNOI::!XCMNOI+CMNOD ;NOISE WORD
.CMSWI::!XCMSWI ;SWITCH
.CMIFI::!XCMIFI ;INPUT FILE
.CMOFI::!XCMOFI ;OUTPUT FILE
.CMFIL::!XCMFIL ;GENERAL FILESPEC
.CMFLD::!XCMFLD ;ARBITRARY FIELD
.CMCFM::!XCMCFM ;CONFIRM
.CMDIR::!XCMDIR ;DIRECTORY NAME
.CMUSR::!XCMUSR ;USER NAME
.CMCMA::!XCMCMA ;COMMA
.CMINI::!XCMINI+CMNOD ;INITIALIZE COMMAND
.CMFLT::!XCMFLT ;FLOATING POINT NUMBER
.CMDEV::!XCMDEV ;DEVICE NAME
.CMTXT::!XCMTXT ;TEXT
.CMTAD::!XCMTAD ;TIME AND DATE
.CMQST::!XCMQST ;QUOTED STRING
.CMUQS::!XCMUQS+CMNOD ;UNQUOTED STRING
.CMTOK::!XCMTOK ;TOKEN
.CMNUX::!XCMNUX ;NUMBER DELIMITED BY NON-DIGIT
.CMACT::!XCMACT ;ACCOUNT
.CMNOD::!XCMNOD ;NODE NAME
DEPHASE
MAXCFN==.-CFNTAB
;HERE TO GET MORE INPUT AND RETRY FIELD
XCOMRF: CALL CMRSET ;RESET VARIABLES TO BEGINNING OF FIELD
CALL CMCIN1 ;GET MORE INPUT
HLR P1,P1 ;RESET ALTERNATIVE LIST
JRST XCOMN0
;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 BECAUSE ENTIRE COMMAND DELETED
XCOMXL: TXO F,CM%RPT ;NOTE REPEAT PARSE NEEDED
MOVE T1,P4 ;BACK POINTER TO BEG OF BUFFER
UMOVE T2,.CMBFP(P2)
MOVEM T2,P4
CALL SUBBP ;SEE HOW MANY CHARS DELETED
ADDM T1,P3 ;UPDATE SPACE COUNT
SETZ P5, ;NOTE NO INPUT
CALL CMRTY0 ;RETYPE PROMPT
JRST XCOMXI ;EXIT
;RETURN AND REPEAT PARSE BECAUSE USER DELETED BACK INTO ALREADY
;PARSED TEXT
XCOMRP: 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
JUMPE T1,XCOMXL ;JUMP IF LINE NOW EMPTY
JRST XCOMX2 ;OTHERWISE UPDATE VARIABLES AND EXIT
;GOOD RETURN
XCOMXR: TXNE F,CM%ESC ;RECOG CHARACTER TERMINATED?
CALL CMDCH ;YES, FLUSH IT
XCOMXI: TXZN F,CM%ESC ;FIELD TERMINATED WITH RECOG?
JRST XCOMX2 ;NO
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
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
;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 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
TXO F,CM%NOP ;NO OTHER POSSIBILITIES, SAY NO PARSE
MOVE T2,LSTERR ;RETURN ERROR CODE
UMOVEM T2,T2
JRST XCOMX1
;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+CMQUE2 ;NOTE IN SECOND HELP POSSIBILITY
JUMPN T1,XCOMN0 ;DO SUBSEQUENT HELPS
MOVEI T1,.CHLFD ;START NEW LINE
CALL CMCOUT
HLR P1,P1 ;END OF LIST, REINIT IT
SOS P5 ;FLUSH QMARK FROM INPUT
TXZ F,CMQUES+CMQUE2 ;NOTE NOT IN HELP
CALL CMRTY0 ;RETYPE LINE
JRST XCOMN0 ;RESTART PARSE OF CURRENT FIELD
;RETYPE LINE INCLUDING ADVANCE INPUT IF ANY
CMRTY0: XCTU [HRRZ T1,.CMIOJ(P2)] ;GET OUT JFN
RFPOS
HRRZ T2,T2
JUMPE T2,CMRTY1 ;JUMP IF AT LEFT MARGIN
MOVEI T1,.CHLFD ;NOT AT LM, DO CRLF
CALL CMCOUT
CMRTY1: 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 [ HRROI T1,[ASCIZ /
?Indirect file not confirmed.
/]
CALL CMSOUT
TXO F,CM%NOP
JRST XCOMX1]
UMOVE T1,T1 ;THE JFN
MOVX T2,<FLD(7,OF%BSZ)+OF%RD>
OPENF ;OPEN IND FILE
JRST CMINDE ;LOSS
CALL CMRSET ;FLUSH INDIRECT FILESPEC FROM BUFFER
CMIND1: UMOVE T1,T1 ;THE JFN
BIN ;READ CHAR FROM IND FILE
ERJMP CMIND2 ;FAILED, PROBABLY END OF FILE
CAIN T2,.CHCRT ;IGNORE CR
JRST CMIND1
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
CLOSF ;YES, CLOSE IT
JFCL
MOVEI T1,.CHLFD ;TIE OFF LINE
CALL CMDIBQ
JRST XCOMRP ;REPARSE LINE AS NOW CONSTITUTED
CMINDE: HRROI T1,[ASCIZ /
?Problem with indirect file: /]
CALL CMSOUT
XCTU [HRRZ T1,.CMIOJ(P2)]
HRLOI T2,.FHSLF
SETZ T3,
ERSTR
JFCL
JFCL
UMOVE T1,T1 ;GET INDIRECT JFN AGAIN
CLOSF ;CLOSE IT (HERE RATHER THAN EARLIER SO ERROR CODE IS CORRECT FOR ABOVE ERSTR)
JFCL ;COULDN'T CLOSE IT, IGNORE
MOVEI T1,.CHLFD
CALL CMCOUT
TXO F,CM%NOP ;RETURN FAILURE, NO CHECK ALTERNATIVES
JRST XCOMX1
;****************************************
;COMND - LOCAL SUBROUTINES
;****************************************
;READ NEXT FIELD ATOM
;ASSUMES ATOM BUFFER ALREADY SETUP
CMRATM: MOVEI T1,FLDBRK ;USE STANDARD FIELD BREAK SET
CALLRET CMRFLD ;PARSE THE FIELD
FLDBRK: 777777,,777760 ;ALL CONTROL CHARS
777754,,001760 ;ALL EXCEPT - , NUMBERS
400000,,000760 ;ALL EXCEPT UC ALPHABETICS
400000,,000760 ;ALL EXCEPT LC ALPHABETICS
;READ FILESPEC FIELD - FILESPEC PUNCTUATION CHARACTERS
;ARE LEGAL ( :, <, >, ., ;)
CMRFIL: MOVEI T1,FILBRK ;USE FILE BREAK SET
CALLRET CMRFLD
FILBRK: 777777,,777760 ;ALL CC
747544,,000120 ;PUNCT, NUMBERS
400000,,000260 ;UC, BRACKETS
400000,,000760 ;LC
;USERNAME BREAK SET. BREAKS ON EVERYTHING EXCEPT DOT AND ALPHABETICS.
USRBRK: -1,,777760 ;BREAK ON CONTROLS
767544,,001760 ;DON'T BREAK ON "-", ".", "%", "*", DIGITS
400000,,760 ;DON'T BREAK ON UPPERCASE LETTERS
400000,,760 ;OR LOWERCASE LETTERS
;READ TO END OF LINE
EOLBRK: 1B<.CHLFD> ;END OF LINE ONLY
EXP 0,0,0 ;THREE WORDS OF 0'S
;GENERAL FIELD PARSE ROUTINE - TAKES BREAK SET MASK OR MINUS NUMBER OF CHARS TO READ
; T1/ ADDRESS OF 4-WORD BREAK SET MASK
; OR
;T1/ -N TO READ N CHARACTERS (ASSUMES NTH IS BREAK CHARACTER)
; CALL CMRFLD
; RETURNS +1, FIELD COPIED TO ATOM BUFFER, TERMINATOR BACKED UP
CMRFLD: MOVEM T1,CMRBRK ;SAVE BREAK TABLE ADDRESS
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 CMCIN ;GET A CHAR
CMRAT2: CAIN T1,CMQUOT ;THE QUOTING CHARACTER?
JRST CMRQUT ;YES, READ NEXT CHARACTER REGARDLESS
CAIE T1,CMFREC ;^F RECOGNITION?
CAIN T1,.CHESC ;ESC?
JRST [ CALL CHKLCH ;YES, NOT SPECIAL IF ANYTHING NOW IN ATOM BFR
JUMPG T1,CMRATT
CALL CMAMB ;NOTHING THERE, DING
JRST CMRAT1] ;KEEP TRYING
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,.CHLFD ;OR EOL?
JRST CMRATR ;YES
CAIN T1,CMHLPC ;HELP REQUEST?
JRST [ TXO F,CMQUES ;YES, FLAG
JRST TIELCH]
SKIPG CMRBRK ;BREAK SET GIVEN?
JRST CMRAT3 ;NO, KEEP READING REGARDLESS OF CHARACTER
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?
JRST CMRATR ;YES
CMRAT3: CALL STOLCH ;BUILD KEYWORD STRING
JRST CMRAT1
;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: CALLRET CMGDEF ;RETURN, SUPPLYING DEFAULT IF ONE GIVEN AND NOTHING ELSE TYPED FOR THIS FIELD
;ROUTINE TO COPY DEFAULT STRING TO ATOM BUFFER IF ATOM BUFFER
;IS EMPTY (I.E. NO EXPLICIT FIELD HAS BEEN TYPED)
CMGDEF: CALL CHKLCH ;SEE HOW LARGE THE FIELD IS
JUMPE T1,CMRDEF ;IF NULL FIELD, USE DEFAULT IF GIVEN
CALLRET TIELCH ;TIE OFF ATOM BUFFER AND RETURN
;ROUTINE TO COPY DEFAULT VALUE OF FIELD TO ATOM BUFFER IF ONE HAS
;BEEN SUPPLIED
CMRDEF: TXNN F,CM%DPP ;DID USER SUPPLY A DEFAULT?
JRST TIELCH ;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,TIELCH ;DONE IF NULL
CALL STOLCH ;NON-NULL, STORE IN ATOM BUFFER
JRST CMRDF1 ;CONTINUE COPYING
;ATOM READ FOR SPECIAL FIELDS - DOES NOT ALLOW RECOGNITION
;READ FIELD TO CR
CMRSTR: TXZA F,CMTF1 ;FLAG NO TERMINATE ON SPACE
; .. ;CONTINUE IN CMRSPC
;READ FIELD TO SPACE OR CR
CMRSPC: TXO F,CMTF1 ;FLAG TERMINATE ON SPACE
TXNE F,CMDEFF ;HAVE FIELD ALREADY?
RET ;YES
CMRSP1: CALL CMCIN ;GET CHAR
CAIN T1,CMQUOT ;THE QUOTING CHARACTER?
JRST CMRSQT ;YES, KEEP IT AND ONE AFTER REGARDLESS
CAIN T1,CMHLPC ;HELP?
JRST [ TXO F,CMQUES ;YES
RET]
CAIE T1,.CHESC ;RECOG REQUEST?
CAIN T1,CMFREC
JRST [ CALL CMAMB ;DING
JRST CMRSP1] ;CONTINUE
CAIE T1,.CHTAB
CAIN T1," " ;END OF FIELD?
JRST [ JXE F,CMTF1,.+1 ;CONTINUE IF NOT TERMINATING ON BLANK
CALL CHKLCH ;SEE IF ANY NON-BLANK SEEN
JUMPE T1,CMRSP1 ;JUMP IF LEADING BLANK
JRST CMRATT] ;TERMINATING BLANK
CAIN T1,.CHLFD ;END OF LINE?
JRST CMRATR ;YES
CMRS1: CALL STOLCH ;NO, CHAR TO ATOM BUFFER
JRST CMRSP1 ;CONTINUE
CMRSQT: CALL STOLCH ;KEEP THE QUOTING CHARACTER
CALL CMCIN ;AND THE ONE BEING QUOTED
JRST CMRS1
;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,CMQTCH ;START OF STRING?
RET ;NO, FAIL
CMRQS1: CALL CMCIN ;READ NEXT CHAR
CAIN T1,.CHLFD ;LINE ENDED UNEXPECTEDLY?
JRST [ CALLRET CMDIP] ;YES, PUT LF BACK AND RETURN FAIL
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
;APPEND TEXT TO BUFFER IF NECESSARY WITH INTERNAL TEXTI
; CALL CMCIN
; RETURNS +1 ALWAYS, T1/ CHARACTER
CMCIN: SOJL P5,[SETZ P5, ;MAKE INPUT EXACTLY EMPTY
CALL CMCIN1 ;NONE LEFT, GO GET MORE
JRST CMCIN]
XCTBU [ILDB T1,P4] ;GET NEXT ONE
SOS P3 ;UPDATE FREE COUNT
cain t1,.chcrT ;carriage return?
jrst cmcin ;yes, ignore it
CALLRET CMCINT ;LIGHT SPECIAL FLAGS AND RETURN
;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%BRK+RD%PUN+RD%BEL+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%rnd ;yes, so we want reparse on ^u
MOVE F,T1 ;PASS FLAGS TO TEXTI
UMOVE Q1,.CMRTY(P2) ;SETUP ^R BUFFER
UMOVE Q2,.CMBFP(P2) ;SETUP TOP OF BUFFER
SETZ Q3, ;NO SPECIAL BREAK MASK
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 XCOMRP ;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
CALLRET CMDIP ;NO, PUT IT BACK AND RETURN
;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 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?
ITERR COMNX3 ;NO
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
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: 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
RFPOS
HRRZ T2,T2
JUMPE T2,CMINI5 ;JUMP IF ALREADY AT LEFT MARGIN
MOVEI T1,.CHLFD ;DO CR TO GET TO LEFT MARGIN
CALL CMCOUT
CMINI5: 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
BIN ;READ FIRST CHAR
CAIN T2,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 XCOMRP ;RETURN TO REPARSE
;SWITCH - LIKE KEYWORD BUT PRECEEDED BY SLASH
XCMSWI: TXO F,CMSWF ;NOTE DOING SWITCH
TXNE F,CMDEFF ;DEFAULT GIVEN?
JRST CMKEY0 ;YES, SLASH ALREADY ASSUMED
CALL CMCIN ;GET FIRST CHAR
CAIE T1,CMFREC ;^F
CAIN T1,.CHESC ;ESC?
JRST [ CALL CMAMB ;YES, INDICATE AMBIGUOUS
JRST XCMSWI] ;TRY AGAIN
CAIN T1,CMHLPC ;HELP?
JRST [ SETZ T1,
MOVE T2,ATBPTR
XCTBU [IDPB T1,T2]
MOVE T1,FNARG ;GET TABLE PTR
MOVEI T1,1(T1) ;POINT TO FIRST TABLE ENTRY
JRST CMQ3] ;TYPE OPTIONS
CAIE T1,CMSWCH ;THE SWITCH CHARACTER?
JRST [ CALL CMDIP ;NO, PUT IT BACK
NOPARS NPXNSW] ;RETURN NO PARSE
JRST CMKEY0 ;CONTINUE LIKE KEYWORD
;KEYWORD LOOKUP FUNCTION
XCMKEY: TXZ F,CMSWF ;NOT SWITCH
CMKEY0:
KEYW0: CALL CMRATM ;READ THE FIELD INTO LOCAL BUFFER
MOVE T1,FNARG ;GET TABLE HEADER ADDRESS
UMOVE T2,.CMABP(P2) ;POINT TO KEYWORD BUFFER
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,[CALL CMAMB ;AMBIGUOUS, DING OR FAIL
JRST KEYW0] ;GET MORE INPUT
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
ADDI Q1,1(Q3) ;COMPUTE TABLE END ADDRESS FOR BELOW
HRROI T1,[ASCIZ / one of the following:
/]
CALL CMSOUT
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
;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) ;PTR TO PARTIAL KEYWORD
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 CMRSTR ;READ STRING
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
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
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 [NOPARS NPXNC] ;FAILED
JRST XCOMXI ;OK
CMCFM0: CALL CMCIN ;GET CHAR
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?
JRST [ CALL CMAMB ;YES, DING
JRST CMCFM0] ;TRY AGAIN
CAIE T1,.CHLFD ;NL (NEW LINE, I.E. LINEFEED)
RET ;NO, FAIL
RETSKP ;YES
;FLOATING POINT NUMBER
XCMFLT: MOVEI T1,FLTBRK ;USE SPECIAL BREAK SET
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
XCMNUX: SKIPA T1,[NUXBRK] ;USE SPECIAL BREAK SET
XCMNUM: MOVEI T1,NUMBRK ;USE REGULAR BREAK SET
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: 777777,,777760
777654,,001760
400000,,000760
400000,,000760
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 ()
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 CMRFLD ;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 ;CMRFLD NEEDS TO KNOW HOW MANY CHARACTERS TO READ
CALL CMRFLD ;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
IMCALL .IDTNC,MSEC1
RET ;FAILED
RETSKP ;SUCCEEDED
;TIME/DATE HELP
CMTADH: CALL DOHLP ;DO USER TEXT
JXN F,CM%SDH,CMRTYP ;CHECK SUPPRESS DEFAULT
LOAD T1,<CM%IDA+CM%ITM>,Q1 ;GET FLAGS
HRRO T1,[[ASCIZ //]
[ASCIZ / time/]
[ASCIZ / date/]
[ASCIZ / date and time/]](T1)
CALL CMSOUT ;PRINT APPROPRIATE MESSAGE
JRST CMRTYP
;DEVICE
XCMDEV: CALL CMRATM ;GET THE FIELD
JXN F,CMQUES,CMDEVH ;HELP
JXN F,CM%ESC,[
CALL CMDCH ;FLUSH RECOG CHARACTER
JRST CMDEV1] ;GO TRY TO RECOG IF ESC
JXN F,CMDEFF,CMDEV1 ;ASSUME TERMINATOR IF DEFAULT GIVEN
CALL CMCIN ;CHECK TERMINATOR
CAIE T1,":" ;DEVICE?
JRST [ NOPARS NPXIDT] ;NO, FAIL
CMDEV1: UMOVE T1,.CMABP(P2) ;SETUP STDEV ARGS
UMOVEM T1,T1
IMCALL .STDEV,MSEC1
JRST XCOMNP ;FAILED
JXE F,CM%ESC,XCOMXR ;SUCCESS, DONE IF NO ESC
MOVEI T1,":" ;RECOG, APPEND TERMINATOR
CALL CMDIB
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]
JRST XCOMXI
;UNQUOTED STRING - TAKES BIT MASK (4 WORDS * 32 BITS) TO SPECIFY BREAKS.
XCMUQS:
CMUQS1: CALL CMCIN ;GET A CHAR
IDIVI T1,^D32 ;COMPUTE INDEX TO BIT ARRAY
MOVE T2,BITS(T2)
ADD T1,FNARG
XCTU [TDNN T2,0(T1)] ;BIT ON?
JRST CMUQS1 ;NO, KEEP GOING
CALL CMDIP ;YES, PUT CHAR BACK
JRST XCOMXI ;DONE
;ARBITRARY FIELD
XCMFLD: CALL CMRATM
CMFLD1: TXNE F,CMQUES ;"?" SEEN?
JRST [ CALL DOHLP ;YES, DO USER MESSAGE
JRST CMRTYP]
JRST XCOMXR ;LEAVE FIELD IN ATOM BUFFER
;ACCOUNT
XCMACT: MOVEI A,USRBRK ;SAME BREAK SET AS USER NAME FIELD
CALL CMRFLD ;READ FIELD
JRST CMFLD1 ;FINISH LIKE ARBITRARY FIELD
;NODE NAME
XCMNOD: PUSHJ P,CMRATM ;GET AN ATOM
JXN F,CMQUES,[CALL DOHLP ;TYPE OUT USER'S 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
UMOVE T1,.CMABP(P2) ;POINT AT THE ATOM BUFFER
MOVE T3,T1 ;COPY POINTER TO FIRST CHARACTER
XCTBU [ILDB T3,T3] ;GET FIRST CHARACTER
JUMPE T3,[NOPARS COMX20] ;FAIL IF NULL NAME
MOVEI T2,6 ;GET MAXIMUM NUMBER OF CHARACTERS IN NAME
XNOD0: XCTBU [ILDB T3,T1] ;GET NEXT CHARACTER FROM ATOM BUFFER
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: XCTBU [DPB T3,T1] ;SAVE THE CHARACTER BACK IN ATOM BUFFER
SOJGE T2,XNOD0 ;HAVE WE SEEN ENOUGH CHARACTERS?
NOPARS COMX19 ;TOO MANY CHARACTERS IN NODE NAME
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
SUBI T3,"a"-"A" ;CONVERT CHARACTER TO UPPER CASE
JRST XNOD1 ;SAVE IT AND LOOK FOR MORE
XNOD3: MOVE T2,ATBPTR ;GET POINTER TO END OF ATOM BUFFER
IBP T2 ;POINT AT TERMINATOR
CAMN T1,T2 ;OUR POINTER END THE SAME PLACE?
JRST XCOMXI ;YES, RETURN
NOPARS COMX18 ;ILLEGAL CHARACTER IN NODE NAME
;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
MOVSI T2,.GJDEV(Q1) ;CLEAR DEFAULT POINTERS
HRRI T2,.GJDEV+1(Q1)
XCTU [SETZM -1(T2)]
XBLTUU [BLT T2,.GJJFN(Q1)]
CMFIL0: TXO T1,GJ%XTN ;NOTE EXTENDED GTJFN ARG BLOCK
UMOVEM T1,.GJGEN(Q1) ;PUT FLAGS IN ARG BLOCK
CALL CMCIN ;CHECK FIRST CHAR
CAIN T1,CMHLPC ;HELP REQUEST?
JRST CMFHLP ;YES
CALL CMDIP ;NO, PUT CHARACTER BACK
TXNE F,CMQUES ;HELP WANTED STATE?
JRST CMRTYP ;YES, NO POSSIBILITY HERE
CALL CMCIN ;READ FIRST CHARACTER
CAIE T1,.CHESC
CAIN T1,CMFREC ;RECOGNITION REQUESTED AT BEG OF FIELD?
JRST CMFIL1 ;YES, DON'T CALL CMRFIL BECAUSE IT WOULD DING AND WAIT
CALL CMDIP ;PUT THE PREREAD CHARACTER BACK
CALL CMRFIL ;GET DEFAULT FILESPEC IF THERE IS ONE
TXNE F,CMQUES ;DID USE TYPE "?" IN FILESPEC?
JRST CMFHLP ;YES
CALL CMFSET ;BACKUP POINTERS TO LET GTJFN READ FILESPEC
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
CMFIL2: UMOVE T1,.GJGEN(Q1) ;GET FLAGS BACK
TXNE F,CMDEFF ;DEFAULT?
JRST [ TXC T1,GJ%SHT+GJ%XTN ;YES, USE SHORT FORM, TURN OFF GJ%XTN
UMOVEM T1,T1 ;SET FLAGS, GENERATION
UMOVE T2,.CMABP(P2) ;USE STRING IN ATOM BUFFER
UMOVEM T2,T2
IMCALL .GTJFN,MSEC1
JRST XCOMNP ;FAILED
UMOVEM T1,T2 ;RETURN THE JFN
JRST XCOMXR] ;RETURN GOOD
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
UMOVEM P4,T2 ; I.E. ARGBLK ADR, MAIN PTR
; ..
;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.
; ..
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
JXO F,CMINDF,RSKP ;RETURN NOW IF INDIRECT FILESPEC
JRST XCOMXR ;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]
MOVE T1,ATBPTR ;REMOVE TERMINATOR FROM ATOM BUFFER
CALL DBP
MOVEM T1,ATBPTR
AOS ATBSIZ ;UPDATE COUNT
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
CALL CMDIP ;DONE, PUT TERMINATOR BACK
CALLRET CMRATM ;READ NULL FIELD 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 XCOMXI]
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
JRST [ CALL CMAMB ;YES, CAN'T
JRST CMTOK2]
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: TXNN F,CMUSRF ;USE FILE BREAK SET FOR DIRECTORY FIELD
CALL CMRFIL ;GET FILESPEC FIELD
MOVEI T1,USRBRK ;GET USER BREAK SET
TXNE F,CMUSRF
CALL CMRFLD ;USE USERNAME BREAK SET FOR USER NAME
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 CMDIR2 ;STRING IS GOOD SYNTAX
CMDIR8: IMCALL .RCUSR,MSEC1
ERJMP CMDIR6
JRST CMDIR2
;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?
JRST [ CALL CMAMB ;YES, DING
JRST CMCHR] ;TRY AGAIN
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
HRLI T2,(POINT 7,0)
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
; 1B9 ;NOT USED
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
;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(RDTX1) ;NO. TELL HIM SO
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
ITEXTI: MOVX P5,INTT ;NOTE INTERNAL CALL
; .. ;FALL INTO COMMON SETUP
;COMMON ENTRY/SETUP FOR RDTTY, TEXTI
RCOMN: TRVAR <ccnt,ccptr,crptr,<COC,2>,<ourcoc,2>,MOD,STKP>
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
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,TT%WKN+<FLD(.TTASC,TT%DAM)> ;ASCII IN, WAKE NONFMT ALWAYS
SKIPE Q3 ;USER SPECIFYING BREAKS?
CALL RTSETW ;YES, COMPUTE WAKEUP SET FROM MASK
TXNE F,RD%TOP+RD%BEL ;USER WANTS WAKEUP ON FORMAT CTLS?
TRO B,TT%WKF ;YES
TXNE F,RD%PUN ;USER WANTS WAKEUP ON PUNCTUATION?
TRO B,TT%WKP!TT%WKF ;YES NEED SOME FC ALSO
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
; ..
;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%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
CALL STP6 ;STORE DEST POINTER
CALL STP3 ;STORE COUNT
CALL RDBIN ;DO BIN
MOVE A,B ;SAVE BYTE
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 GET BYTE IN B
JRST 0(D) ;DISPATCH TO ACTION ROUTINE
;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
ADD A,Q3 ;WORD TO TEST
XCTU [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
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: JUMPLE P3,WRAP1 ;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
;UPDATE USER VARIABLES AND RETURN
WRAP1: CALL WRAPX ;UPDATE USER VARIABLES, ETC.
JXN P5,INTT,RSKP ;DO RET IF INTERNAL CALL
SMRETN
;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
SFMOD
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)<
QQ=QQ+CCBITS
IFG QQ-^D35,<
QW
QW=0
QQ=CCBITS-1>
QW=QW+<C>B<QQ>>
QW==0
QQ==-1
CTBL: CC1(ZER) ;0
CCN(PUN,6) ;1-6
CC1(TOP) ;7
CCN(PUN,2) ;10-11
CC1(EOLC) ;12
CC1(PUN) ;VT
CC1(TOP) ;FF
CC1(RDCRC) ;CR
CCN(PUN,4) ;16-21 (^N-^Q)
CC1(RTYP) ;^R
CCN(PUN,2) ;^S,^T
CC1(KLL) ;^U
CC1(RDQTC) ;^V
CC1(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
CC1(RUBO) ;177
QW ;GET LAST WORD IN
;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 COMPUTE WAKEUP SET FROM CHARACTER BIT MASK
; Q3/ ADDRESS OF CALLERS 4-WORD MASK
; B/ CURRENT TERMINAL MODE WORD
; CALL RTSETW
; RETURN +1, B/ UPDATED TERMINAL MODE WORD
RTSETW: PUSH P,A
MOVSI A,-NRPTB ;SET TO SCAN LAST 3 WORDS OF TABLE
MOVEI D,1(Q3)
RTSW1: UMOVE C,0(D) ;GET USER MASK
TDNE C,RPTB(A) ;ANY PUNCTUATION HERE?
TXO B,TT%WKP ;YES, SET WAKEUP ON PUNCT
TDNE C,RATB(A) ;ANY ALPHANUMERICS HERE?
TXO B,TT%WKA ;YES, SET WAKEUP ON ALPHA
AOS D
AOBJN A,RTSW1 ;SCAN ALL MAK WORDS
UMOVE C,0(Q3) ;GET USERS FIRST WORD
TDNE C,[001660,,000020] ;ANY FORMAT CONTROLS HERE?
TXO B,TT%WKF ;YES, SET WAKEUP ON FORMAT CTL
POP P,A
RET
;PUNCTUATION MASK TABLE
RPTB: 777774,,001760 ;40-77
400000,,000760 ;100-137
400000,,000740 ;140-177
NRPTB==.-RPTB
;ALPHANUMERICS MASK TABLE
RATB: 000003,,776000 ;40-77
377777,,777000 ;100-137
377777,,777000 ;140-177
;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
FNDLN1: 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] ;NO, LOOK AT NEXT CHAR TO BE DELETED
CAIN B,.CHLFD ;EOL OR LF?
JRST FNDLN2 ;YES, RETURN
CAIL B,40 ;A CONTROL?
JRST FNDLN1 ;NO, KEEP LOOKING
DMOVE C,ourcoc ;YES. SEE IF IT IS PRINITNG
ROTC C,0(B)
ROTC C,0(B)
TLNN C,(3B1) ;IS IT?
AOS NOPRNT ;NO. COUNT IT THEN
JRST FNDLN1 ;AND 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: CAIGE P3,2 ; ROOM FOR BOTH?
JRST [ CALL RDBKIN ; NO. BACK UP
JRST WRAP0] ; AND WAIT FOR NEXT TIME
XCTBU [IDPB B,P4] ;STORE QUOTE
SOS P3 ; ONE LESS
CALL RDBIN ;GET THE NEXT CHAR
TXNE F,RD%PUN ;USER WANTS BREAK ON PUNCTUATION?
JRST WRAP ;YES
JRST INSRT ;NO
;DELETE CHARACTER (RUBOUT)
DELC: CALL BACK ;BACKUP PTR
JRST BNULL ;NOTHING LEFT IN BUFFER
MOVE B,MOD ;CHECK ECHOS
JXE B,TT%ECO,NINSRT ;NO OUTPUT IF ECHOS OFF
MOVE D,P4
XCTBU [ILDB A,D] ;GET CHAR JUST DELETED
CAIN A,.CHLFD ;WAS IT LF?
JRST DELC2 ;YES
JXO P5,DSPMF,[ CALL CURBK ;IF DISPLAY, BACKUP CURSOR
JRST DELC4]
MOVE B,A
CALL RDBOUT ;TYPE IT OUT
MOVEI B,"\" ;INDICATE DELETION
CALL RDBOUT
DELC4: JRST NINSRT ;CONTINUE INPUT UNLESS BUFFER EMPTY ETC.
DELC2: CAMN P4,Q2 ;AT BEGINNING OF DEST BUFFER?
JRST DELC1 ;YES
XCTBU [LDB B,P4] ;NO, CHECK CHARACTER PRECEEDING LF
CAIE B,.CHCRT ;A CR?
JRST DELC1 ;NO, LEAVE IT ALONE
CALL BACK ;YES, DELETE IT ALSO
JRST BNULL ;(CAN'T HAPPEN)
DELC1: JXO P5,DSPMF,[CALL CURUP ;DO CURSOR UP ONE LINE
JRST RTYPE] ;THEN RETYPE PREVIOUS LINE
HRROI B,[ASCIZ /
/]
CALL RDSOUT ;DO CRLF WHEN DELETING EOL OR CRLF
JRST DELC4
;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
CALL CHKBLP ;CHECK BACKUP LIMIT POINTER
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: RET ;CONTINUE
;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 BWRD3 ;YES, DON'T DELETE
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
BWRD3: 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
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
XCTBU [LDB B,P4] ;NO, GET LAST CHAR
CAIN B,.CHLFD ;END OF LINE?
CALL CURUP ;YES, CURSOR UP FIRST
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
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
MOVEM B,MD ;SAVE
TXZ B,TT%DAM ;SET TO BINARY
SFMOD
DPCTL1: ILDB B,PWRD ;GET BYTE
CAIE B,.STP ;STOP CODE?
JRST [ 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 ;HANDLE "DON'T KNOW" CASE
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 IT SUCCEEDS IN MEASURING
;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