Google
 

Trailing-Edge - PDP-10 Archives - cuspjul86upd_bb-jf24a-bb - 10,7/galaxy/glxlib/glxscn.mac
There are 26 other files named glxscn.mac in the archive. Click here to see a list.
TITLE GLXSCN  --  Command Scanner Interface for GALAXY
SUBTTL Irwin L. Goverman/ILG/LSS/MLB/PJT/WLH/DC/CTK/LWS  1-Mar-84


;
;
;        COPYRIGHT (c) 1975,1976,1977,1978,1979,1980,1981,1982,
;			 1983,1984,1985,1986
;                    DIGITAL EQUIPMENT CORPORATION
;			 ALL RIGHTS RESERVED.
;
;     THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY  BE  USED
;     AND COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE
;     AND WITH THE INCLUSION OF THE ABOVE COPYRIGHT NOTICE.   THIS
;     SOFTWARE  OR ANY OTHER COPIES THEREOF MAY NOT BE PROVIDED OR
;     OTHERWISE MADE AVAILABLE TO ANY OTHER PERSON.  NO  TITLE  TO
;     AND OWNERSHIP OF THE SOFTWARE IS HEREBY TRANSFERRED.
;
;     THE INFORMATION  IN  THIS  SOFTWARE  IS  SUBJECT  TO  CHANGE
;     WITHOUT  NOTICE  AND SHOULD NOT BE CONSTRUED AS A COMMITMENT
;     BY DIGITAL EQUIPMENT CORPORATION.
;
;     DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
;     OF  ITS  SOFTWARE  ON  EQUIPMENT  WHICH  IS  NOT SUPPLIED BY
;     DIGITAL.


	SALL			;SUPPRESS MACRO EXPANSION

	SEARCH	GLXMAC		;OPEN SYMBOLS NEEDED
	PROLOG(GLXSCN,SCN)	;PART OF LIBRARY, ETC...

	SCNEDT==131		;VERSION OF MODULE

;This module emulates the command scanning routines (COMND JSYS) found
;	in the TOPS-20 operating system. (Somewhat)

SUBTTL Table of Contents

;               TABLE OF CONTENTS FOR GLXSCN
;
;
;                        SECTION                                   PAGE
;    1. Table of Contents.........................................   2
;    2. Revision History..........................................   3
;    3. Local Definitions.........................................   5
;    4. Date and Time Data Base...................................   6
;    5. Module Storage............................................   7
;    6. S%INIT  --  Initialize the GLXSCN Module..................   8
;    7. S%ERR - ERROR TYPEOUT ROUTINE.............................   9
;    8. S%ERR   --      ERROR MESSAGES FROM COMND.................   9
;    9. S%INTR  --  Interrupt Level Breakout Routine..............  10
;   10. S%CMND  --  Scan a command................................  11
;   11. S%EXIT  --      Exit Address for Interrupt Breakout.......  12
;   12. S%SIXB  --      Convert ASCII to SIXBIT...................  13
;   13. CNVSIX  --      CONVERT ATOM BUFFER TO SIXBIT.............  13
;   14. S%NUMI  --      NUMBER INPUT ROUTINE......................  14
;   15. S%DATI  Date input routine................................  15
;   16. RETYPE  --  Retype current line including the prompt......  22
;   17. TYPRMT  --  Retype the prompt if there is one.............  22
;   18. TYLINE  --  Retype the line until current position........  22
;   19. Atom Buffer Routines / INILCH - Init Atom Buffer..........  29
;   20. Atom Buffer Routines / STOLCH - Store Character in Atom Buffer  29
;   21. Atom Buffer Routines / CHKLCH - Return Number of Characters  29
;   22. Atom Buffer Routines / TIELCH - Terminate Atom Buffer With NULL  29
;   23. CMCIN  --  Read One Character for Processing..............  30
;   24. HELPER  --  Do caller supplied and default HELP text......  33
;   25. DOHLP  --  Do caller supplied HELP text...................  33
;   26. CMAMB  --  Handle Ambiguous Typein........................  33
;   27. Command Function / .CMINI - Init the scanner and do ^H....  36
;   28. Command Function / .CMSWI - Parse a SWITCH................  37
;   29. Command Function / .CMKEY - Parse a KEYWORD...............  38
;   30. Command Function / .CMTXT - Parse Arbitrary Text to Action Character  42
;   31. Function .CMNOI  --  Parse a NOISE-WORD...................  42
;   32. Command Function / .CMCFM - Command Confirmation (end-of-line)  43
;   33. Command Function / .CMNUM - Parse an INTEGER in any base..  45
;   34. Command Function / .CMNUX - Parse an INTEGER in any base (special break)  45
;   35. Command Function / .CMDEV - Parse a DEVICE specification..  47
;   36. Command Function / .CMQST - Parse a QUOTED STRING.........  48
;   37. Command Function / .CMNOD - Parse a NODE Specification....  49
;   38. PATHIN  Routine to Parse TOPS-10 Path Specification.......  52
;   39. PATH SUPPORT ROUTINES.....................................  54
;   40. DATIM   --      DATE AND TIME PARSER......................  58
;   41. TIMPAR  --      PARSE THE TIME FIELD......................  59
;   42. PLSRTN  --      PROCESS DATE WITH "+".....................  60
;   43. MINRTN  --      PROCESS DATE WITH "-".....................  60
;   44. DAYRTN  --      PROCESS DAY "D"...........................  60
;   45. CMPDAT  --      COMPUTE THE DATE FROM VALUES..............  61
;   46. DATEXT  --      DATE EXIT ROUTINE.........................  62
;   47. MAKDAT  --      ROUTINE TO MAKE A DATE AND TIME...........  62
;   48. DATPAR  --      PARSE A DATE/DAY FIELD....................  63
;   49. ALTDAT  --      PARSE ALTERNATE DATE FORM.................  64
;   50. MONPAR  --      ROUTINE TO CHECK FOR A MONTH..............  65
;   51. YEARPR  --      PARSE THE YEAR............................  66
;   52. CNVDT   --      CONVERT DATE TO UDT.......................  67
;   53. MNMPAR  --      PARSE MNEMONICS...........................  68
;   54. GETCHR  --      GET A CHARACTER FROM TIME FIELD...........  69
;   55. DECNUM  --      GET A DECIMAL NUMBER......................  69
;   56. DECBPT  --      DECREMENT THE BYTE POINTER................  69
;   57. GETSTG  --      GET A STRING TO WORK FROM.................  70
;   58. CMDOUT  --      CHARACTER OUTPUT FOR TERMINALS AND FILES..  72
;   59. CMDSTO  --      STRING OUTPUT TO FILE AND TERMINAL........  72
;   60. S%SCMP  --  String Comparison Routine.....................  73
;   61. S%TBLK  --  Table lookup routine..........................  75
;   62. S%TBAD  --      Table Add Routine.........................  78
;   63. S%TBDL  --      Table Delete Routine......................  79
SUBTTL	Revision History


COMMENT \

Edit	GCO	Reason
----	---	-------------------------------------------

0001		Create GLXSCN module
0002		Fix a number of interrupt race problems and
		start adding ESCape sequence code
0003		Add support for parsing of a string; fix bug in
		.CMINI which caused prompts not at left margin
0004	019	Add code for CR.COD and change S%ERR to return
		string. Add ERRBUF for the error messages.
0005	021	Use all the new terminal I/O routines in GLXKBD.
0006		Install S%INTR to request interrupt breakout.
0007	030	Fix S%INTR,S%CMND, and add S%EXIT for interrupt exit 
		address. Change call to S%INTR.

0010		Fix S%CMND to Allow Multiple File Specs to be separated

		by Commas (i.e DSK:FIL1,DSK:FIL2,etc)

		Also Changed FILBRK and PPNBRK sets to allow Full Path
		specifications (Path Not currently implemented)

		Added routine CMRPTH to Get [p,pn,foo,foo,...]

0011	037	Allow recognition on typed node name to be
		interpreted as a field terminator.
0012		Make Fix to Edit 10 for Multiple File Specs.
		Allow only DEV:FILNAM.EXE[P,PN,PATH,...] as filespec

0013	039	Change HELP text for .CMUSR function.

0014		Correct Path Specification added in edit 0010
0015		Code Clean up for ambiguous commands
0016		Make ^H work properly for commands with extra arguments
0017		Raise all LC to UC when comparing noise
		words. Changes made around label CMNOI4.
0020	G044	Add new Routines S%TBAD and S%TBDL for adding and
		deleting entries from command tables
0021		Fix S%TBAD Bug
0022		FIX .CMDEV and Let Node function do Parse Only on Names
		Also Make -10 NOPARS be ITEXT
0023		Fix S%TBLK, to save the P's
0024		Fix .CMNOD to save SIXBIT value when CM%PO is set
0025		Make S%SIXB to read sixbit strings from ascii strings
0026		If only one element in a Keyword or Switch Table do not
		Type out "one of the following" ..but put out a " ".
0027		Change name of ERRBUF to SAVBUF and make it Global. Saving
		of Stopcodes on the -20 will use this area.
0030		Change SAVE to $SAVE
0031		Make S%CMND return true if CM%NOP is set on the -20
0032		CORRECT EXTRA LINE TYPEOUT IN HELP TEXT
0033		DO NOT ALLOW NULL NODE NAMES
0034		Change all messages to Upper and lower case and change 
		Unrecognized Control Character to Ambiguous
0035		Support CM%BRK and output to other than terminal
0036		Change calling convention of NUMIN
0037		Add support for .CMTAD
0040		Fix bug in PATHIN to allow defaulting like [,]
		Change CMRFLD to test break character set before checking
		special characters like ? and ESCAPE.
0041		Add entry for S%NUMI to parse integer
0042		Add entry for S%DATI to parse date/time
0043		Change CMPDAT to use T3 instead of P1 to prevent
		illegal memory reference
0044		Change XCMDEV to require :, and do escape recognition
		Change XCMNOD to require :: or _ as delimiter,
		and to supply :: as the default.
0045		Fix XCMDEV, XCMNOD to not throw away char following :
		or :: so DISM ST GAL0:/REM , etc, etc work again
0046		Fix some caps in XCMDEV

0047		Dump help text if JFN is NULIO
		Don't display "or" for help if none is specified

0050		Rework error processing to use standard galaxy errors
0051		Fix date/time parsing code for TOPS10

0052		Add special case checking for Control-Z (TOPS-10 style
		program exit character.
0053		Zero out $DATA space for this module.
0054		Don't type CRLF at TYPRMT unless TTY not at column zero.
0055		Make TYPRMT a noop if output device (.CMIOJ) not TTY.
0056		Fix indirect files, allow continuation lines in them, etc.
0057		Fix XCMTAD so it handles date/time fields before end of
		line. [QAR 10-4894]
0060		Fix XCMTOK so it understands TOPS20-style string pointers.
0061		Have XDATIM check for future and past times and call
		.DATIF and .DATIP accordingly.  Also need to blast
		the fake colon since no time should be specified
		(MIDNIGHT and NOON)
0062		Rearrange AC usage at CMND.2 to avoid a TOPS20 Release 4
		bug which clobbers T2.
0063	3/25/81  Get rid of fake colon.  Change DATIC to check for space
		and tab instead of colon.  Remove colon adding code from
		XCMTAD.
0064	4/1/81  Allow DATIC to accept colons still.
0065	4/2/81	Make parsing date/times work (separate 'em with space)
0066	5/4/81  Make XDATIM set true before calling DATNCI.
		Have .DATIF and .DATIP check (-) and (+) for error.
0067	6/22/81  Make [,] return logged in PPN instead of current path.
		Try to solve date/time scanning problems by eating the
		extra space inserted @ DATIT.

0070	9/9/81	Fix GLXSCN bug at CMRAT2+7 :change JUMPG T1,CMRATT to
		JUMPG T1,CMRATR so that we put the character back into
		the atom buffer

0071		Make the S%DATI routines apply to both the -10 and
		-20.

0072		Make date/time parsing work with " " and ":" separators.

0073	1371	Handle CM%NSF.

0074	1456	Do some majic to fix ^U'ed command that receives IPCF
		interrupt.  Save some ACs and restore same when interrupting.
		Also set a couple if indeed in a ^U state.  T10 only.

;**;Begin Galaxy 4.1 code maintence

0075		12 Digit octal numbers sign bit is dropped by S%NUMI
		SPR 10-33455		27-SEP-83/CTK

0076		Fix problem when parsing "-" as a token. Always skip
		spaces following, EOL or not.

0077		Don't allow defaulted filnames for indirect files.
		Don't ABS when indirect file is too long to put in buffer.

0100		Fix problems parsing numeric field that has "+" or
		"-" embedded.
		3-Jan-84 /LWS/WD

0101		Make a $ALTERNATE that points to a $CRLF always work.
		4-Jan-84 /LWS/WD

0102		Don't let ":" be a valid device name. /LWS

0103	10020	Fix problem where $DEFAULTing wasn't being done
		correctly for tokens when CRLF was typed instead
		of the token.
		3-Apr-84 /LWS thanks to WXD

0106	10066	General cleanup and enhancements of TOPS-10 features:
		1.  Allow parsing of wildcarded PPNs.  If CM%WLD is on,
		    return a two word block containing the PPN and mask.
		2.  Separate directory and user parsing functions.
		3.  Allow control-F and ESCAPE recognition to terminate
		    a PPN or directory parse.
		4.  Allow trailing square brackets on PPNs and directories
		    to be omitted if at end of line.
		5.  Allow [-] syntax in a directory spec.
		6.  Do path defaulting correctly.
		7.  Narrow minded programmer prevented the defaulting
		    of file names from working if an extension was typed.
		8.  Remove duplicate sixbit parse routine (FTOKEN).
		    CNVSIX works just fine.
		9.  Directory, filespec, or PPN error messages can
		    contain trailing junk if the number of characters
		    previously parsed was longer than those that caused
		    the current error because the atom buffer was not
		    terminated with a nul.
		10. Account string parsing breaks on valid characters.
		    Allow all characters in the range of 40 to 176.
		 4-Aug-84 /DPM

0107	10070	Correct logic used to back up byte pointers when
		pointers other than 7-bits are being used.
		9-Aug-84 /DPM

0110	?????

0111	10105	Add entry points S%U2DT (CNTDT) and S%DT2U (CNVDT).
		12-OCT-84 /LWS

0112	10122	Add network filespec parsing routines.
		15-Nov-84 /DPR

0113	10152	Save S1 around calls to CMDOUT since it is not guaranteed
		to be saved by GLXLIB's K%BOUT.
		21-Feb-85 /NT

0114	10177	Allow help requests when parsing wildcarded PPNs.
		21-Mar-85 /DRB

0115	10205	Fix PPN parsing.  QAR #10-868046.
		 7-May-85  /DPM

0116	10265	Recognize CM%WLA and allow accounting-style wildcarding
		when parsing PPNs.
		30-Jul-85  /DPM

117	10269	Incorporate a few fixes from TOPS-20 %6 COMND.MAC
		1. Allow question mark in .CMTXT and .CMUQS fields.
		2. Advance to next field when ESCAPE typed following
		   a token or user (PPN).
		3. Handle ? in .CMFLD functions where ? is not a
		   break character (not fixed on the -20 yet).

120	10272	Don't try to type a prompt if the job is detached.
		12-Aug-85  /DPM

121	10274	Handle PPN defaulting in .CMUSR function.
		17-Aug-85  /DPM

122	10275	Don't allow a project or programmer number to be zero
		when parsing a PPN.
		21-Aug-85  /DPM

123		Change node name parsing to accept node names starting
		with a number (e.g. "2LATE") as SIXBIT.
		11-Oct-85  /CJA

124	10354	Don't use AC 17 as a BLT pointer in routine COMN1.
		7-Jan-86 /NT

125	10360	Don't clobber TF in COMN1.
		13-Jan-86  /RCB

126	10367	Parse full path spec with .CMDIR function.
		20-Jan-86 /CJA

127	10368	Handle indirect command files (via "@") on the -10 correctly.
		21-Jan-86  /JAD

130	10405	Add support for TB%ABR in S%TBAD and S%TBDL
		10-May-86	/TL

131	10410	Fix spurrious <CR> appearing in unquoted strings term by CR.
		24-May-86	/TL
\  ;END OF REVISION HISTORY
; Entry Points found in this module

	ENTRY	S%INIT			;INIT THE COMMAND SCANNER MODULE
	ENTRY	S%CMND			;SCAN A COMMAND
	ENTRY	S%SCMP			;COMPARE TWO STRINGS
	ENTRY	S%TBLK			;LOOK UP A STRING IN A TABLE
	ENTRY	S%ERR			;TYPE OUT SCANNER'S LAST ERROR
	ENTRY	S%INTR			;INTERRUPT BREAKOUT
	ENTRY	S%EXIT			;INTERRUPT DEBRK ADDRESS FOR COMND
	ENTRY	S%TBAD			;ADD ENTRY TO COMMAND TABLES
	ENTRY	S%TBDL			;DELETE ENTRY FROM COMMAND TABLES
	ENTRY	S%SIXB			;CONVERT ASCII STRING TO SIXBIT VALUE
	ENTRY	S%NUMI			;CONVERT ASCII STRING TO NUMBER
	ENTRY	S%DATI			;CONVERT ASCIZ STRING TO DATE
	ENTRY	S%U2DT			;CONVERT UDT TO SEPARATE DATE AND TIME
	ENTRY	S%DT2U			;CONVERT SEPARATE DATE AND TIME TO UDT
SUBTTL Local Definitions

; Special Accumulator definitions

	P5==P4+1			;S%CMND NEEDS LOTS OF ACS
	F==14				;FLAG AC
	Q1==15				;
	Q2==16				;DON'T DEFINE Q3 OR Q4

; Bad parse return macro

DEFINE	NOPARS(CODE) <
	 PJRST	[MOVEI	T1,ER'CODE'$
		 PJRST	XCOMNE]
> ;END OF NOPARS DEFINITION

; Special bit testing macros

DEFINE JXN(AC,FLD,ADDR)<
	  TXNN	AC,FLD
	XLIST
	  SKIPA
	  JRST  ADDR
	LIST
	SALL
> ;END OF JXN DEFINITION

DEFINE JXE(AC,FLD,ADDR)<
	  TXNE	AC,FLD
	XLIST
	  SKIPA
	  JRST	ADDR
	LIST
	SALL
> ;END OF JXE DEFINITION

	DEFINE	RETSKP<JRST	[AOS 0(P)
			         POPJ P,] >

; Bit table - 36. Words long with word N containing 1B<N>
	
	XX==0
BITS:	XLIST
	REPEAT ^D36,<EXP 1B<XX>
			XX==XX+1>
	LIST
SUBTTL	Module Storage


	GLOB	<.LGERR,.LGEPC>		;GLOBAL ERROR LOCATIONS

	$DATA	SCNBEG,0		;START OF ZEROABLE $DATA SPACE
	$DATA	ATBPTR			;ATOM BUFFER POINTER (END)
	$DATA	ATBSIZ			;ATOM BUFFER SIZE
	$DATA	STKFEN			;FENCE FOR STACK RESTORATION
	$DATA	FNARG			;FUNCTION ARGUMENT
	$DATA	CMCCM,2			;SAVED CC CODES
	$DATA	CMRBRK			;POINTER TO BREAK SET TABLE
	$DATA	CMCSF			;SAVED FLAGS
	$DATA	CMCSAC,7		;SAVED ACS DURING S%TXTI FROM S%CMND
	$DATA	CMCSC			;
	$DATA	CMCBLF			;
	$DATA	TBA			;TABLE ARGUMENTS
	$DATA	STRG			;TEMP STRING POINTER
	$DATA	REMSTR			;"REMEMBER"ED STRING
	$DATA	XXXPTR			;RE-USABLE STRING POINTER STORAGE
	$DATA	FDFSIZ			;Size of users FD string buffer
	$DATA	FDFPTR			;Pointer to users FD string buffer
	$DATA	BEGPTR			;Pointer to beginning of parsed field
	$DATA	ENDPTR			;Pointer to end of parsed field
	$DATA	PRSDND			;Flag parsed node name
	$DATA	PRSDAC			;Flag parsed access string
	$DATA	PRSDDV			;Flag parsed device name
	$DATA	PRSDNM			;Flag parsed file name
	$DATA	PRSDEX			;Flag parsed file extension
	$DATA	PRSDGN			;Flag parsed generation number
	$DATA	PRSDDR			;Flag parsed directory
	$DATA	CRBLK,CR.SIZ		;RETURNED BLOCK OF ANSWERS
	$DATA	TABDON			;END OF TAB FOR "?"
	$DATA	TABSIZ			;SIZE OF TAB LARGER THAN LARGEST KEYWORD
	$DATA	LSTERR			;ERROR CODE OF FIRST PARSE FAILURE
	$DATA	LSTEPC			;PC OF FIRST PARSE FAILURE
	$DATA	BIGSIZ			;LENGTH OF LONGEST KEYWORD
	$DATA	PWIDTH			;TERMINAL'S WIDTH
	$DATA	CURPOS			;LINE POSITION OF CURSOR
	$DATA	Q3SAVE			;NO Q3 EXISTS
	$DATA	IFOB			;INDIRECT FILESPEC FOB
	$DATA	IIFN			;IFN OF INDIRECT FILE
	$DATA	TI,.RDSIZ		;S%TXTI ARGUMENT BLOCK
	$GDATA	SAVBUF,ERRBSZ		;BUFFER FOR ERROR MESSAGES
					;S%ERR AND SCRATCH
TOPS10 <
	$DATA	CMDACS,20		;AC SAVE AREA FOR COMMAND
	$DATA	PPNWRD			;PPN WORD
	$DATA	PPNMSK			;PPN MASK
	$DATA	INCMND			;FLAG FOR IN COMMAND STATE
	$DATA	TBADDR			;ADDRESS OF COMMAND TABLE
	$DATA	ENTADR			;ADDRESS OF ENTRY FOR TABLE
	$DATA	SPCBRK			;SPECIAL BREAK MASK
	$DATA	JFNWRD			;WORD CONTAINING THE JFNS

	$DATA	ACFLG			;FLAG TO VALIDATE INTERRUPT SAVED ACs
	$DATA	A07T16,10		;BLOCK TO SAVE ACS FROM 7 TO 16
					; DURING K%TXTI IN CASE OF INTERRUPT
>;END TOPS10 CONDITIONAL

	$DATA	INTRPT			;FLAG FOR S%INTR
TOPS20 <
	$DATA	BLKSAV			;COMMAND BLOCK ADDRESS
	$DATA	BUFCNT			;SIZE OF COMMAND BUFFER
>;END TOPS20 CONDITIONAL
	$DATA	SCNEND,0		;END OF ZEROABLE $DATA SPACE
SUBTTL	S%INIT  --  Initialize the GLXSCN Module

TOPS10 <
S%INIT:	MOVE	S1,[SCNBEG,,SCNBEG+1]	;BLT PTR TO ZEROABLE $DATA SPACE
	SETZM	SCNBEG			;ZERO OUT FIRST LOC
	BLT	S1,SCNEND-1		;AND ZOOM OUT THE REST
	MOVSI	S2,'TTY'		;LOAD TTY NAME
	IONDX.	S2,			;GET THE I/O INDEX
	  JFCL				;IGNORE THE ERROR
	MOVX	S1,.TOWID		;GET TERMINAL WIDTH FUNCTION
	MOVE	T1,[2,,S1]		;ARG POINTER
	TRMOP.	T1,			;GET THE NUMBER
	  MOVEI	T1,^D72			;USE A DEFAULT
	MOVEM	T1,PWIDTH		;AND SAVE IT
	SETZM	ACFLG			;INITIALLY NO SAVED INTERRUPT ACS
	$RETT				;AND RETURN
>  ;END TOPS10 CONDITIONAL

TOPS20 <
S%INIT:	$RETT				;RETURN
>  ;END TOPS20 CONDITIONAL
SUBTTL S%ERR - ERROR TYPEOUT ROUTINE
	SUBTTL	S%ERR	--	ERROR MESSAGES FROM COMND

	;CALL		PUSHJ	P,S%ERR
	;
	;RETURN	TRUE:	S1/ ADDRESS OF MESSAGE--ASCIZ
	;
	;RETURN	FALSE:	NO MESSAGE

TOPS10 <
S%ERR:	HRRZ	S1,LSTERR		;GET THE LAST ERROR
	JUMPE	S1,.RETF		;NO MESSAGE RETURN FALSE
	$TEXT	(<-1,,SAVBUF>,<^E/S1/^0>) ;OUTPUT THE MESSAGE
	MOVEI	S1,SAVBUF		;ADDRESS OF MESSAGE
	$RETT				;RETURN TRUE
>  ;END TOPS10 CONDITIONAL

TOPS20 <
S%ERR:	HRROI	S1,SAVBUF		;POINTER TO BUFFER
	MOVE	S2,[.FHSLF,,-1]		;OUR LAST ERROR
	HRLZI	T1,-ERRBSZ*5		;MAXIMUM NUMBER OF CHARACTERS
	ERSTR				;TYPE OUT THE ERROR STRING
	$RETF				;UNDEFINED ERROR NUMBER
	$RETF				;BAD DESTINATION DESIGNATOR
	MOVEI	S1,SAVBUF		;POINT TO THE MESSAGE
	$RETT				;RETURN TRUE
>  ;END TOPS20 CONDITIONAL
SUBTTL	S%INTR  --  Interrupt Level Breakout Routine

;S%INTR should be called at interrupt level to request that command
;	breakout as soon as possible and to mark that interrupt occurred.
;	CALL:	S1/	PC Address at Interrupt
;
;	RETURN	TRUE:	In COMND	S1/ SPACE LEFT IN INPUT BUFFER

;
;	RETURN	FALSE:	Not in COMND
;

S%INTR:	SETOM	INTRPT			;SET THE FLAG
TOPS10 <
	SKIPN	INCMND			;ARE WE IN COMND
	$RETF				;NO..RETURN FALSE
	MOVE	S1,RD##+.RDDBC		;COUNT OF SPACE LEFT
	$RETT				;RETURN TRUE
>;END TOPS10 CONDITIONAL

TOPS20 <
	TXNE	S1,1B5			;IN EXEC MODE?
	$RETF				;NO..USER MODE..RETURN FALSE
	HRRZS	S1			;GET ONLY RIGHT HALF
	CAIL	S1,CMND.2		;IS PC IN COMND JSYS
	CAIL	S1,CMND.3		;THEN BETWEEN TWO LABELS
	$RETF				;NO..RETURN FALSE
	MOVE	S1,BLKSAV		;GET ADDRESS OF COMMAND BLOCK
	MOVE	S1,.CMCNT(S1)		;GET BUFFER SIZE IN S1
	$RETT				;YES..COMND..RETURN TRUE
>;END TOPS20 CONDITIONAL
SUBTTL S%CMND  --  Scan a command


;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

SUBTTL	S%EXIT	--	Exit Address for Interrupt Breakout

;THE ADDRESS OF S%EXIT IS PLACED IN THE INTERRUPT PC TO FORCE RETURN
;TO THAT ADDRESS AT INTERRUPT IN COMND THAT WE WANT TO BREAKOUT OF.
;THE NECESSARY CLEANUP WILL BE DONE SO S%CMND CAN RETURN.

TOPS20 <
S%EXIT:	PJRST	CMND.3			;FIX UP RETURN
>;END TOPS20 CONDITIONAL


TOPS10 <
S%EXIT:

;Restore some AC's from before K%TXTI if necessary

	SKIPN	ACFLG			;Want to restore some AC's?
	JRST	EXIT.1			;No, skip this part
	HRLZI	0,A07T16		;Source address
	HRRI	0,7			;Destination address
	BLT	0,16			;Restore some AC's
	SETZM	ACFLG			;Restore only once

;  Now if we are comming from a ^U, we need to fix some things up

EXIT.1:	MOVE	0,.CMCNT(P2)		;Get origional count of buffer
	CAME	0,RD##+.RDDBC		;Save as what is left?
	PJRST	XCOMXI			;No, must not be ^U
	MOVE	P3,0			;Set the count to the origional
	MOVE	P4,.CMBFP(P2)		;Set to beginning of user buffer
	SETZ	P5,			;No characters to be parsed
	TXZ	F,CM%ESC		;No way we can have ^U terminated
					;  with an escape
	PJRST	XCOMXI			;SETUP PROPER RETURN
>;END TOPS10 CONDITIONAL
SUBTTL	S%SIXB	--	Convert ASCII to SIXBIT

	;
	;S1/	ASCII BYTE POINTER Returned updated
	;S2/	SIXBIT value

S%SIXB:	TLCE	S1,-1			;Left half of ptr = 0?
	TLCN	S1,-1			;... or -1 ?
	JRST	[HRLI S1,(POINT 7,)	;Yes, Make up pointer for caller
		JRST	S%SIX1]		;Re enter flow
	HRRI	S1,@S1			;Compute effective addr
	TLZ	S1,(@(17))		;Remove indirection and index
S%SIX1:	PUSHJ	P,CNVSIX		;Do the work
	$RETT				;Always return true

	SUBTTL	CNVSIX	--	CONVERT ATOM BUFFER TO SIXBIT
;Internal entry point
;Same calling args
;Returns false if more than 6 chars are passed
CNVSIX:	PUSHJ	P,.SAVET		;Preserve the caller's T's
	MOVEI	T2,6			;GET MAX NUMBER OF CHARACTERS IN NAME
	MOVE	T4,[POINT 6,S2]		; BP TO NODE STORAGE
	SETZM	S2			;START FRESH
CNVS.1:	ILDB	T3,S1			;GET NEXT CHARACTER FROM ATOM BUFFER
	CAIL	T3,"A"+40		;LESS THAN LC A
	CAILE	T3,"Z"+40		;OR GREATER THAN LC Z
	SKIPA				;YES, NOT A LC CHARACTER
	SUBI	T3,40			;NO, ITS LC, MAKE IT UC
	CAIL	T3,"0"			;RANGE
	CAILE	T3,"9"			; CHECK
	CAIL	T3,"A"			;  THE
	CAILE	T3,"Z"			;   CHARACTER
	$RETT				;NO GOOD--RETURN
	SUBI	T3,"A"-'A'		;SIXBITIZE
	IDPB	T3,T4			;FILL OUT SIXBIT NODE NAME
	SOJGE	T2,CNVS.1		;HAVE WE SEEN ENOUGH CHARACTERS?
	$RETF				;ERROR..RETURN FALSE
SUBTTL	S%NUMI	--	NUMBER INPUT ROUTINE

	;THIS ROUTINE WILL PARSE A NUMBER FROM A STRING AND RETURN THE
	;VALUE
	;
	;CALL	S1/	POINTER TO THE STRING
	;	S2/	RADIX
	;
	;RETURN TRUE:
	;	S1/	UPDATED POINTER
	;	S2/	NUMBER


S%NUMI:	CAIL	S2,^D2		;CHECK FOR PROPER RADIX
	CAILE	S2,^D10
	 $RETE	(RAD)		;INVALID RADIX
	PUSHJ	P,NUMIN
	$RETIT			;RETURN IF TRUE
	 $RETE	(NUM)		;BAD NUMBER

NUMIN:	PUSHJ	P,.SAVE3	;GET 2 SCRATCH ACS
	SETZ	P2,		;CLEAR SIGN MODIFIER
NUMI.1:	ILDB	P1,S1		;GET FIRST CHARACTER
	CAIN	P1," "		;A BLANK?
	JRST	NUMI.1		;YES, IGNORE IT
	CAIN	P1,"-"		;IS IT MINUS SIGN?
	JRST	[JUMPN	P2,.RETF	;ONLY ALLOW ONE SIGN
		 MOVX	P2,-1		;SET NEGITIVE
		JRST NUMI.1]		;GET NEXT CHARACTER
	CAIN	P1,"+"		;IS IT PLUS SIGN?
	JRST	[JUMPN	P2,.RETF	;ONLY ALLOW ONE SIGN
		 MOVX	P2,+1		;SET POSITIVE
		 JRST	NUMI.1]		;GET NEXT CHARACTER
	CAIG	P1,"0"-1(S2)	;TOO BIG
	CAIGE	P1,"0"		;OR TOO SMALL?
	$RETF			;YES, TAKE FAILURE RETURN
	SETZ	P3,0		;CLEAR THE RESULT
NUMI.2:
;**;[75]ADD 3 LINES AT NUMI.2:+0L	27-SEP-83/CTK
	CAXN	S2,^D8		;[75] RADIX 8 ???
	LSH	P3,3		;[75] YES, USE SHIFT INSTEAD OF MULTIPLY
	CAXE	S2,^D8		;[75] NON-RADIX 8 ??
	IMULI	P3,0(S2)	;SHIFT OVER 1 DIGIT
	ADDI	P3,-"0"(P1)	;AND ADD IN THIS ONE
	ILDB	P1,S1		;GET NEXT CHAR
	CAIG	P1,"0"-1(S2)	;IN RANGE?
	CAIGE	P1,"0"
	JRST	NUMI.3		;FINISH OFF AND RETURN
	JRST	NUMI.2		;YES, REPEAT
NUMI.3:	SKIPGE	P2		;SHOULD BE NEGATIVE?
	MOVNS	P3		;MAKE IT NEGATIVE
	MOVE	S2,P3		;GET THE VALUE
	$RETT			;RETURN TRUE
SUBTTL	S%DATI	Date input routine

;THIS ROUTINE WILL PARSE DATE/TIME STRING
;AND RETURN A UDT

;	CALL	S1/ POINTER TO ASCIZ DATE/TIME STRING
;		S2/ FLAGS (CM%IDA!CM%ITM!CM%NCI+Address)

;	RETURN	S1/ UPDATED POINTER
;		S2/ UDT

;IF CM%NCI with an address (not in ACs) the time will also
;be returned in a three word block at address


S%DATI:	PUSHJ	P,.SAVET		;PRESERVE TEMPORARIES
	PJRST	XDATIM			;PARSE THE FIELXD ANXD RETURN
;The S%CMND routine provides a command scanner interface similar to the
;	TOPS-20 COMND JSYS.	

;CALL IS:	S1/ Pointer to Command State Block
;		S2/ Pointer to list of Function Descriptor Blocks
;		    See GLXMAC or MONSYM for a description of these

;TRUE RETURN:	S1/ Length of Command Reply block
;		S2/ Address of the Command Reply block


TOPS20 <
S%CMND:	MOVEM	S1,BLKSAV		;SAVE THE COMMAND BLOCK ADDRESS
	MOVE	S1,.CMCNT(S1)		;GET SIZE OF THE BUFFER
	MOVEM	S1,BUFCNT		;SAVE BUFFER COUNT
	MOVE	S1,BLKSAV		;RESTORE S1
	PUSH	P,.CMFLG(S1)		;SAVE THE REPARSE ADDRESS
	PUSH	P,S1			;SAVE ADDRESS OF CSB
	HLLZS	.CMFLG(S1)		;AND ZERO OUT REPARSE ADDRESS
	PUSHJ	P,CMND.2		;DO THE COMMAND JSYS
	POP	P,S2			;GET CSB ADDRESS
	POP	P,S1			;GET THE REPARSE ADDRESS
	HRRM	S1,.CMFLG(S2)		;RESET THE REPARSE ADR
	TRNN	S1,-1			;IS THERE ONE?
	JRST	CMND.1			;NO, RETURN NORMALLY
	MOVX	S2,CM%RPT		;YES, GET REPARSE BIT
	TDNE	S2,CRBLK+CR.FLG		;WAS IT SET???
	HRRM	S1,0(P)			;YES, STORE REPARSE ADDRESS FOR RETURN
CMND.1:	MOVEI	S1,CR.SIZ		;LOAD SIZE OF COMMAND RESPONSE BLOCK
	MOVEI	S2,CRBLK		;LOAD ADDRESS OF COMMAND RESP. BLK.
	POPJ	P,			;AND PROPAGATE T/F RETURN FROM CMND.2


CMND.2:	PUSHJ	P,.SAVET		;SAVE T1-T4
	SETZ	T3,			;ASSUME TRUE RETURN
	SKIPN	INTRPT			;DID INTERRUPT OCCUR SKIP COMND
	COMND				;DO THE COMMAND JSYS
	ERJMP	[SETO T3,		;SET FALSE RETURN
		 JRST CMND.3]		;AND CONTINUE ON
CMND.3:	SETZ	T2,			;SET FLAG
	EXCH	T2,INTRPT		;GET CURRENT FLAG AND RESET
	MOVE	T4,BLKSAV		;ADDRESS OF COMMAND BLOCK
	MOVE	T4,.CMCNT(T4)		;ROOM LEFT IN BUFFER
	CAMGE	T4,BUFCNT		;DID WE HAVE ANY DATA
	JRST	CMND.4			;YES..IGNORE INTERRUPT FLAG
	SKIPE	T2			;INTERRUPT BEFORE COMMAND
	TXO	S1,CM%INT		;YES..SET INTERRUPT FLAG
CMND.4:	MOVEM	S1,CRBLK+CR.FLG		;SAVE FLAGS
	MOVEM	S2,CRBLK+CR.RES		;SAVE DATA FIELD
	MOVEM	T1,CRBLK+CR.PDB		;SAVE PDB ADDRESS
;	TXNE	S1,CM%NOP		;NO PARSE?
;	SETO	T3,			;YES, RETURN FALSE
	LOAD	S1,.CMFNP(T1),CM%FNC	;GET FUNCTION DONE
	MOVEM	S1,CRBLK+CR.COD		;SAVE IT
	JUMPL	T3,.RETF		;RETURN FALSE IF COMND FAILED
	$RETT				;ELSE, RETURN TRUE
>  ;END TOPS20 CONDITIONAL
TOPS10 <
;!!!!!NOTE WELL - THIS CONDITIONAL RUNS TO THE END OF COMND ROUTINE

S%CMND:	SETZM	LSTERR		;CLEAR LAST ERROR INDICATOR
	MOVEM	0,CMDACS	;SAVE THE COMMAND ACS
	MOVE	0,[XWD 1,CMDACS+1] ;SET UP BLT POINTER
	BLT	0,CMDACS+17	;SAVE THE ACS
	MOVEI	0,@0(P)		;GET CALLING PC ADDRESS
	MOVEM	0,LSTEPC	;SAVE IN CASE OF NOPARSE
	MOVE	0,CMDACS	;RESTORE 0
	PUSHJ	P,XCOMND	;DO THE WORK
	HRRZ	T4,.CMFLG(P2)	;GET REPARSE ADDRESS IF ANY
	JUMPE	T4,COMN1	;NONE..JUST RETURN
	TXNN	F,CM%RPT	;REPARSE NEEDED..
	JRST	COMN1		;NO..JUST RESTORE AND RETURN
	HRRZ	T3,CMDACS+17	;GET STACK LOCATION
	HRRM	T4,@T3		;YES..RETURN TO REPARSE
COMN1:	SETZM	INCMND		;CLEAR IN COMMAND STATE
	MOVE	T1,[CMDACS+T2,,T2] ;SETUP TO RESTORE ACS
	BLT	T1,17		;RESTORE T2-17
	MOVE	T1,CMDACS+T1	;GET T1 BACK AS WELL
	POPJ	P,0		;THEN RETURN

XCOMND:	MOVEM	S1,P2		;SAVE BLOCK PTR
	MOVEM	S2,P1		;SAVE FN BLOCK PTR
	HRL	P1,P1		;SAVE COPY OF ORIGINAL
	MOVEM	P,STKFEN	;SAVE CURRENT STACK AS FENCE
	MOVE	T1,.CMIOJ(P2)	;GET THE JFN WORD
	MOVEM	T1,JFNWRD	;SAVE THE JFN WORD
	MOVEI	T1,[.CMRTY	;LIST OF BYTE POINTERS TO CHECK
		    .CMBFP
		    .CMPTR
		    .CMABP
		    0]		;MARK OF END OF LIST
	PUSHJ	P,CHKABP	;CHECK ALL BYTE PTRS
	MOVE	P3,.CMCNT(P2)	;SETUP ACTIVE VARIABLES
	MOVE	P4,.CMPTR(P2)
	MOVE	P5,.CMINC(P2)
	HLLZ	F,.CMFLG(P2) 	;GET 'GIVEN' FLAGS
	TXZ	F,CM%PFE
	TXZE	F,CM%ESC	;PREVIOUS FIELD HAD ESC?
	TXO	F,CM%PFE	;YES
	PUSHJ	P,K%RCOC		;GET COC MODES
	DMOVEM	S1,CMCCM	;SAVE THEM
	TXZ	S1,3B<CMFREC*2+1> ;NO ECHO ^F 
	TXZ	S1,3B<CMRDOC*2+1> ;OR ^H
	TXO	S1,3B<.CHLFD*2+1> ;PROPER HANDLING OF NL
	TXZ	S2,3B<.CHESC*2+1-^D36> ;SET ESC TO NO ECHO
	PUSHJ	P,K%WCOC	;AND WRITE THEM BACK
	SETOM	INCMND		;MARK THAT IN COMND
	SKIPE	INTRPT		;DID WE HAVE AN INTERRUPT
	PJRST	S%EXIT		;YES..RETURN NOW
	; ..
	; ..
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
	CAMN	P4,.CMBFP(P2)	;AT BEG OF LINE?
	TXO	F,CMBOL		;YES
XCOM1:	LOAD	T1,.CMFNP(P1),CM%FFL ;GET FUNCTION FLAGS
	STORE	T1,F,CM%FFL	;KEEP WITH OTHER FLAGS
	HLRZ	Q1,P1		;GET CM%DPP FLAG FROM FIRST BLOCK ONLY
	XOR	F,.CMFNP(Q1)
	TXZ	F,CM%DPP
	XOR	F,.CMFNP(Q1)
	TXNN	F,CM%BRK	;IS THERE A BREAK MASK SETUP
	JRST	XCOM2		;NO.. CONTINUE ON
	MOVE	T1,.CMBRK(P1)	;GET ADDRESS OF BREAK SET
	MOVEM	T1,SPCBRK	;SAVE AS SPECIAL BREAK
XCOM2:	MOVE	T1,.CMDAT(P1)	;GET FUNCTION DATA IF ANY
	MOVEM	T1,FNARG	;KEEP LOCALLY
	LOAD	T1,.CMFNP(P1),CM%FNC ;GET FUNCTION CODE
	CAIL	T1,0		;VALIDATE FN CODE
	CAIL	T1,MAXCFN
	$STOP(BFC,Bad function code)
	MOVE	T1,CFNTAB(T1)	;GET TABLE ENTRY FOR IT
	JXN	T1,CMNOD,XCOM4	;DISPATCH NOW IF NO DEFAULT POSSIBLE
	PUSHJ	P,INILCH	;SKIP SPACES AND INIT ATOM BUFFER
	PUSHJ	P,CMCIN		;GET INITIAL INPUT
	CAIN	T1,CMCONC	;POSSIBLE LINE CONTINUATION?
	JRST	[PUSHJ	P,CMCIN		;YES, SEE IF NL FOLLOWS
		CAIE	T1,.CHLFD
		PUSHJ	P,CMRSET	;NO, RESET FIELD
;**;[76] Insert 1 line at XCOM2+13L. 21-Dec-83 /LWS
		PUSHJ	P,INILCH	;[76] SKIP SPACES
		PUSHJ	P,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	[PUSHJ	P,CMDIP		;YES, PUT IT BACK
	        LOAD	T1,.CMFNP(P1),CM%FNC ;GET FUNCTION CODE
		CAIN	T1,.CMCFM	;CONFIRM?
		JRST	XCOM4		;YES, DO IT
		TXNE	F,CM%DPP	;HAVE DEFAULT?
		JRST	XCOM6		;YES, USE IT
		TXNN	F,CMBOL		;AT BGN OF BFR?
		JRST	XCOM4		;NO, TRY NULL FIELD
		PUSHJ	P,CHKCFM	;[101] SEE IF THERE IS A CONFIRM IN THE LIST
		  SKIPA			;[101] NO, REISSUE PROMPT
		JRST	XCOM4		;[101] YES, PROCESS IT
		PUSHJ	P,CMRSET
		SETZ	P5,0		;YES, EMPTY LINE.  IGNORE
		PUSHJ	P,RETYPE	;REDO PROMPT
		JRST	XCOMN0]		;TRY AGAIN
	CAIE	T1,.CHESC	;ESC AT BEG OF FIELD?
	CAIN	T1,CMFREC
	JRST	XCOM5		;^F AT BEG OF FIELD
   ;	CAIN	T1,CMDEFC	;OR DEFAULT REQUEST?
   ;	JRST	XCOM5		;YES
XCOM3:	PUSHJ	P,CMDIP		;PUT CHAR BACK
XCOM4:	LOAD	T1,.CMFNP(P1),CM%FNC	;GET FUNCTION CODE
	JRST	@CFNTAB(T1)	;DO IT


;[101] CHKCFM - ROUTINE TO SEE IF A .CMCFM FUNCTION APPEARS ON THE USER'S LIST
;[101] ACCEPTS  P1/	POINTER TO USER'S FUNCTION BLOCK
;[101] 	CALL	CHKCFM
;[101] RETURNS  +1:	IF THERE IS NO .CMCFM ON THE LIST, P1 UNCHANGED
;[101] 	  +2:	IF A .CMCFM IS ON THE LIST, P1 IS UPDATED FOR THAT BLOCK
;[101] USES T1.

CHKCFM:	STKVAR	<LSTPTR>	;[101] TO SAVE P1
	MOVEM	P1,LSTPTR	;[101] SAVE P1 IN CASE WE NEED TO RESTORE IT
CHKCFL:	LOAD	T1,.CMFNP(P1),CM%FNC	;[101] GET FUNCTION CODE FROM BLOCK
	CAIN	T1,.CMCFM	;[101] CONFIRM?
	 RETSKP			;[101] YES, RETURN SKIP, P1 POINTS TO ITS BLOCK
	LOAD	T1,.CMFNP(P1),CM%LST	;[101] GET THE POINTER TO THE NEXT BLOCK
	HRRM	T1,P1		;[101] UPDATE P1 TO THE NEXT BLOCK
	JUMPN	T1,CHKCFL	;[101] LOOP AND CHECK BLOCK IF IT EXISTS
	MOVE	P1,LSTPTR	;[101] BUT IF AT END, RESTORE OLD VALUE OF P1
	POPJ	P,		;[101] AND RETURN NONSKIP
	ENDSV.

;ESC OR ^F AT BEG OF FIELD

XCOM5:	TXNN	F,CM%DPP	;YES, HAVE DEFAULT STRING?
	JRST	XCOM3		;NO
	PUSHJ	P,CMDCH		;FLUSH RECOG CHAR
XCOM6:	HLRZ	Q1,P1		;GET PTR TO FIRST FLD BLOCK
	MOVE	S1,.CMDEF(Q1)	;GET DEFAULT STRING PTR
	PUSHJ	P,CHKBP		;CHECK POINTER
	MOVEM	S1,Q1
	TXO	F,CMDEFF	;NOTE FIELD ALREADY IN ATOM BFR
XCOM7:	ILDB	T1,Q1
	JUMPE	T1,[PUSHJ P,CHKLCH	;CHECK FOR NULL DEFAULT STRING
		CAIG	T1,0
		$STOP(BDS,Bad Default String) ;NULL STRING ILLEGAL
		PUSHJ	P,TIELCH	;END OF STRING, TIE OFF ATOM BUFFER
		TXNE	F,CMCFF		;^F RECOG?
		JRST	XCOMRF		;YES, GO GET MORE INPUT
		JXE	F,CM%ESC,XCOM4	;GO DIRECT TO FUNCTION IF NO RECOG
		MOVEI	T1,.CHESC
		PUSHJ	P,CMDIBQ	;YES, APPEND ESC TO BUFFER
		PUSHJ	P,CMRSET	;RESET LINE VARIABLES
		JRST	XCOMN0]		;TREAT AS ORDINARY INPUT
	PUSHJ	P,STOLCH	;STOR CHAR IN ATOM BUFFER
	TXNE	F,CM%ESC	;RECOGNIZING?
	PUSHJ	P,CMDIB		;YES, CHAR TO MAIN BUFFER ALSO
	JRST	XCOM7
;COMMENT

CMCMT2:	SETO	T1,		;SAY NO TERMINATOR OTHER THAN EOL
CMCMT1:	MOVEM	T1,Q2		;REMEMBER MATCHING TERMINATOR
CMCOM:	PUSHJ	P,CMCIN		;GET NEXT CHAR
	CAIN	T1,CMCONC	;POSSIBLE LINE CONTINUATION?
	JRST	[PUSHJ	P,CMCIN		;YES, CHECK FOR NL FOLLOWING
		CAIN	T1,.CHLFD
		JRST	CMCOM		;YES, STAY IN COMMENT
		JRST	.+1]		;NO, EXAMINE CHARACTER
	JXN	F,CM%ESC,CMAMB	;AMBIGUOUS
	CAIN	T1,.CHLFD	;END OF LINE?
	JRST	[PUSHJ	P,CMDIP		;YES, PUT IT BACK
		JRST	XCOM1]		;DO WHATEVER
	CAMN	T1,Q2		;MATCHING TERMINATOR?
	JRST	XCOM1		;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:	PUSHJ	P,CMRSET	;RESET VARIABLES TO BEGINNING OF FIELD
	PUSHJ	P,CMCIN1	;GET MORE INPUT
	HLR	P1,P1		;RESET ALTERNATIVE LIST
	JRST	XCOMN0

;[100] RESET EVERYTHING SUCH THAT FIELD CAN BE REREAD.
;[100] THIS ROUTINE IS USEFUL IF FIELD IS READ, AND THEN WE DECIDE WE WANT
;[100] TO REREAD IT WITH A DIFFERENT LENGTH OR BREAK SET SPECIFIED.

CMFSET:	PUSHJ	P,CMRSET	;[100] PUT MAIN POINTER TO BEGINNING OF FIELD
	PUSHJ	P,INILCH	;[100] RESET POINTER TO ATOM BUFFER
	TXZ	F,CM%ESC+CM%EOC+CMCFF+CMQUES ;[100] RESET PARSET
	POPJ	P,		;[100]

;RESET VARIABLES TO BEGINNING OF CURRENT FIELD

CMRSET:	SUB	P5,P3		;RESET VARIABLES TO BGN OF FIELD
	ADD	P5,.CMCNT(P2)	;KEEP ALL CURRENT INPUT
	MOVE	P3,.CMCNT(P2)
	MOVE	P4,.CMPTR(P2)
	POPJ	P,0
;STANDARD EXITS

;RETURN AND REPEAT PARSE BECAUSE USER DELETED BACK INTO ALREADY
;PARSED TEXT

XCOMRP:	TXNE	F,CM%INT	;INTERRUPT EXIT
	JRST	XCOMXI		;SETUP RETURN
	TXO	F,CM%RPT	;REQUEST REPEAT
	MOVE	T1,P4		;COMPUTE NUMBER CHARS IN BUFFER
	MOVE	T2,.CMBFP(P2)
	MOVEM	T2,P4		;RESET PTR TO TOP OF BUFFER
	PUSHJ	P,SUBBP		;COMPUTE PTR-TOP
	MOVEM	T1,P5		;SET AS NUMBER CHARS FOLLOWING PTR
	ADDM	T1,P3		;RESET COUNT TO TOP OF BUFFER
	JRST	XCOMX1		;OTHERWISE UPDATE VARIABLES AND EXIT

;GOOD RETURN

FIXESC:	PUSHJ	P,CMCIN		;READ CHARACTER AFTER FIELD
FIXES1:	TXNN	F,CM%ESC	;ESCAPE AFTER FIELD?
	PUSHJ	P,CMDIP		;NO, PUT IT BACK
XCOMXR:	TXNE	F,CM%ESC	;RECOG CHARACTER TERMINATED?
	PUSHJ	P,CMDCH		;YES, FLUSH IT
XCOMXI:	TXZ	F,CM%RPT	;CLEAR THE REPARSE FLAG
	TXZN	F,CM%ESC	;FIELD TERMINATED WITH RECOG?
	JRST	XCOMX1		;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
	PUSHJ	P,CMDIB
XCOMX1:	SETZ	S1,		;CLEAR S1
	EXCH	S1,INTRPT	;GET THE CURRENT FLAG AND RESET
	SKIPE	S1		;DID WE HAVE AN INTERRUPT
	TXO	F,CM%INT	;YES..SET RETURN FLAG
	CAMGE	P3,.CMCNT(P2)	;DID WE HAVE ANY PROCESSING
	TXZ	F,CM%INT	;YES..CLEAR POSSIBLE INTERRUPT FLAG
	MOVEM	P3,.CMCNT(P2)	;UPDATE VARIABLES
	MOVEM	P4,.CMPTR(P2)
	MOVEM	P5,.CMINC(P2)
XCOMX2:	MOVE	P,STKFEN	;RESET STACK
	DMOVE	S1,CMCCM	;GET SAVED CC MODES
	PUSHJ	P,K%WCOC	;RESTORE THEM
	MOVEM	P1,CRBLK+CR.PDB	;RETURN PTR TO FUNCTION BLOCK USED
	TXZ	F,CM%FFL	;FLUSH FUNCTION FLAGS
	HLLM	 F,.CMFLG(P2)	;RETURN FLAGS
	MOVEM	P2,CRBLK+CR.FLG	;STORE BLK ADDRESS
	HLLM	F,CRBLK+CR.FLG	;AND THE FLAGS
	HRRZ	T1,CRBLK+CR.PDB		;GET THE CURRENT PDB
	LOAD	S1,.CMFNP(T1),CM%FNC	;GET FUNCTION CODE
	MOVEM	S1,CRBLK+CR.COD		;SAVE THE CODE
	MOVEI	S1,CR.SIZ	;LOAD SIZE OF RETURNED BLOCK
	MOVEI	S2,CRBLK	;AND ITS LOCATION
	$RETT			;AND TAKE A GOOD RETURN
;FAILURE RETURNS - FAILED TO PARSE

XCOMNE:	SKIPN	LSTERR		;ANY ERRORS YET?
	MOVEM	T1,LSTERR	;NO..SAVE ONLY THE FIRST
XCOMNP:	JXN	F,CMQUES,CMRTYP	;IF IN HELP, DON'T RETURN NOW
	PUSHJ	P,CMRSET	;RESET FIELD VARIABLES
	MOVEM	P5,.CMINC(P2)	;FIX USER BLOCK
	LOAD	T1,.CMFNP(P1),CM%LST	;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	T1,LSTEPC	;GET THE LAST ERROR PC
	MOVEM	T1,.LGEPC	;SAVE FOR ERROR ROUTINE
	MOVE	T1,LSTERR	;SET GLOBAL ERROR INDICATORS
	MOVEM	T1,.LGERR
	JRST	XCOMX2

;HERE AFTER EACH HELP OUTPUT

CMRTYP:	PUSHJ	P,CMRSET	;RESET FIELD VARIABLES
	LOAD	T1,.CMFNP(P1),CM%LST ;GET NEXT FUNCTION IN LIST
	HRRM	T1,P1
	TXO	F,CMQUES+CMQUE2	;NOTE IN SECOND HELP POSSIBILITY
	JUMPN	T1,XCOMN0	;DO SUBSEQUENT HELPS
;[32]	MOVEI	S1,.CHLFD	;START NEW LINE
;[32]	PUSHJ	P,CMDOUT
	HLR	P1,P1		;END OF LIST, REINIT IT
	SOS P5			;FLUSH QMARK FROM INPUT
	TXZ	F,CMQUES+CMQUE2	;NOTE NOT IN HELP
	PUSHJ	P,RETYPE	;RETYPE LINE
	JRST	XCOMN0		;RESTART PARSE OF CURRENT FIELD

XCOMEO:	TXO	F,CM%NOP	;SET NO PARSE
	MOVEI	S2,CRBLK
	MOVE	P,STKFEN	;FIXUP STACK
	$RETF
SUBTTL	RETYPE  --  Retype current line including the prompt

RETYPE:	PUSHJ	P,TYPRMT		;RETYPE THE PROMPT
	PUSHJ	P,TYLINE		;RETYPE THE LINE THUS FAR
	$RETT				;AND RETURN


SUBTTL	TYPRMT  --  Retype the prompt if there is one

TYPRMT:	HRRZ	S1,.CMIOJ(P2)		;Get output designator
	CAIE	S1,.PRIOU		;TTY?
	$RETT				;No, just return then
	PUSHJ	P,K%TPOS		;Get horizontal position of terminal
	JUMPF	TYPR.0			;DON'T PROMPT IF DETACHED
	SKIPE	S1			;At column zero?
	PUSHJ	P,CRLF			;No, type crlf
TYPR.0:	SKIPE	Q1,.CMRTY(P2)		;GET ^R PTR IF ANY
TYPR.1:	CAMN	Q1,.CMBFP(P2)		;UP TO TOP OF BFR?
	$RETT				;DONE WITH PROMPT, RETURN
	ILDB	S1,Q1			;TYPE ^R BFR
	JUMPE	S1,.RETT		;RETURN IF END OF STRING
	PUSHJ	P,CMDOUT		;ELSE, OUTPUT THE CHARACTER
	JRST	TYPR.1			;AND LOOP


SUBTTL	TYLINE  --  Retype the line until current position

TYLINE:	MOVE	Q1,.CMBFP(P2)		;GET MAIN BFR PTR
TYLI.1:	CAMN	Q1,P4			;UP TO CURRENT PTR?
	JRST	TYLI.2			;YES, GO DO ADVANCE INPUT
	ILDB	S1,Q1			;TYPE OUT COMMAND BFR
	PUSHJ	P,CMDOUT
	JRST	TYLI.1

TYLI.2:	MOVE	Q2,P5			;GET INPUT COUNT
TYLI.3:	SOJL	Q2,[SETZ T1,0		;ALL INPUT PRINTED, TIE OFF
		    IDPB T1,Q1		;BUFFER
		    POPJ P,0]
	ILDB	S1,Q1
	PUSHJ	P,CMDOUT
	JRST	TYLI.3
;INDIRECT FILE HANDLING

CMIND:	TXNE	F,CMQUE2	;NO SECOND HELP POSSIBILITIES?
	JRST	XCOMNP		;GUESS NOT
	PUSHJ	P,CMATFI	;GET A JFN ON THE INDIRECT FILE
	 JRST CMINDE		;FAILED
	PUSHJ	P,CMCFM0	;DO A CONFIRM
	 JRST	[MOVEI S1,[ASCIZ /
?Indirect file not confirmed.
/]
		PUSHJ	P,CMDSTO
		TXO	F,CM%NOP
		JRST	XCOMX2]
	LOAD	S1,.CMGJB(P2),CM%GJB ;GET ADDR OF FD
	SKIPN	S2,.FDSTR(S1)	;IF DEVICE HAS NOT BEEN SPECIFIED,
	MOVSI	S2,'DSK'	;DEFAULT TO DISK
	MOVEM	S2,.FDSTR(S1)	;
	SKIPN	S2,.FDEXT(S1)	;AND DEFAULT THE EXTENSION
	MOVSI	S2,'CMD'	;TO ".CMD"
	MOVEM	S2,.FDEXT(S1)	;
	STORE	S1,IFOB+FOB.FD	;STORE IT
	MOVX	S1,FB.LSN!<INSVL.(7,FB.BSZ)> ;IGNORE LINE NUMBERS
	STORE	S1,IFOB+FOB.CW	;STORE
	MOVEI	S1,2		;SHORT FOB
	MOVEI	S2,IFOB		;AND ITS ADDRESS
	PUSHJ	P,F%IOPN	;OPEN FOR INPUT
	JUMPF	CMINDE		;IF FAILS,TELL WHY
	MOVEM	S1,IIFN		;STORE IFN
	PUSHJ	P,CMRSET	;FLUSH INDIRECT FILESPEC FROM BUFFER
	MOVEI	T1," "		;[127] TERMINATE PRECEDING FIELD
	PUSHJ	P,CMDIBQ	;[127]
CMIND1:	MOVE	S1,IIFN		;GET IFN
	PUSHJ	P,F%IBYT	;GET A BYTE
;**;[77] Insert 1 line at CMIND1+1L. 28-Dec-83 /LWS
	JUMPE	P3,CMINE1	;[77] JUMP IF BUFFER FULL
	JUMPF	CMIND2		;IF FAILS FIND OUT WHY
	JUMPE	S2,CMIND1	;Ignore nulls (Grrr...!!)
	CAIN	S2,CMCONC	;Possible line continuation?
	JRST [	MOVE	S1,IIFN		;Yes, see if EOL next
		PUSHJ	P,F%IBYT	;Get next char
		JUMPF [	MOVEI	T1,CMCONC	;EOF... stuff the hyphen
			PUSHJ	P,CMDIBQ	; ..
			JRST	CMIND2]		;Close file and finish up
		CAIE	S2,CMRDOC	;Ignore ^H
		CAIN	S2,.CHCRT	; and CR
		JRST	.
		CAIN	S2,.CHLFD	;Line feed?
		JRST	.+1		;Yes, stuff it and forget the hyphen
		MOVEI	T1,CMCONC	;No, I guess the hyphen was real, then
		PUSHJ	P,CMDIBQ	; so put it into the guy's buffer
		JRST	.+1]		;Now handle the next char
	CAIE	S2,CMRDOC	;IGNORE ^H
	CAIN	S2,.CHCRT	;IGNORE CR
	JRST	CMIND1
	CAIE	S2,.CHLFD	;CONVERT EOL TO SPACE
	CAIN	S2,.CHESC	;DITTO ESC (BUT THERE SHOULDN'T BE ANY)
	MOVEI	S2," "
	MOVE	T1,S2		;COPY CHARACTER
	PUSHJ	P,CMDIBQ	;PUT CHAR IN BUFFER WITHOUT TYPEOUT
	JRST	CMIND1

CMIND2:	MOVE	S1,IIFN		;CLOSE OFF THE FILE NOW
	PUSHJ	P,F%REL		;
	MOVEI	T1,.CHLFD	;TIE OFF LINE
	PUSHJ	P,CMDIBQ
	JRST	XCOMRP		;REPARSE LINE AS NOW CONSTITUTED

CMINDE:	PUSHJ	P,I%IOFF		;TURN OFF INTERRUPTS
	$TEXT(T%TTY,<^M^J?Problem with Indirect File: ^E/[-1]/>)
	PUSHJ	P,I%ION			;THEN TURN THEM BACK ON
	TXO	F,CM%NOP	;RETURN FAILURE, NO CHECK ALTERNATIVES
	JRST	XCOMX2

;**;[77] Insert 3 lines after CMINDE+4L. 28-Dec-83  /LWS
CMINE1:	MOVE	S1,IIFN		;[77] GET INDIRECT FILE IFN
	PUSHJ	P,F%REL		;[77] RELEASE THE FILE
	NOPARS	(IFB)		;[77] GIVE THE ERROR MESSAGE
;****************************************
;COMND - LOCAL SUBROUTINES
;****************************************

;READ NEXT FIELD ATOM
;ASSUMES ATOM BUFFER ALREADY SETUP

CMRATM:	MOVEI	T1,FLDBRK	;USE STANDARD FIELD BREAK SET
	TXNE	F,CM%BRK	;WAS THERE A BREAK SET PROVIDED?
	MOVE	T1,SPCBRK	;YES.. USE SPECIAL BREAK SET
	PJRST	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 (: . < > ) WITH EXCEPTION OF "," WHICH IS HANDLED
;WITH [P,PN] AS SPECIAL CASE
;ACCEPT FILESPECS IN THE FORM OF "DEV:FILNAM.EXT[P,PN,PATH,...]

CMRFIL:	MOVEI	T1,FILBRK
	PUSHJ	P,CMRFLD	;GET DEV:NAME.EXT
	MOVE	T1,P4		;GET POINTER TO LAST BYTE PARSED
	ILDB	T1,T1		;GET TERMINATOR
	CAIN	T1,"["		;PPN ?
	PUSHJ	P,CMRPTH	;YES -- GET DIRECTORY
	POPJ	P,0

FILBRK:	777777,,777760		;BREAK ON ALL CC
	777764,,000760		;ALLOW . 0-9 :
	400000,,000760		;ALLOW UC
	400000,,000760		;ALLOW LC
;CMRPTH	Routine to Read TOPS-10 Path Specification from buffer

CMRPTH:	MOVEI	T1,PTHBRK	;POINT TO PATH BREAK SET
	PUSHJ	P,CMRFLD	;GET PATH (UP TO "]")
	PJRST	CMRPP1		;ENTER COMMON PPN/PATH TERMINATION CODE

PTHBRK:	777777,,777760		;BREAK ON ALL CONTROL CHARACTERS
	777714,,001760		;ALLOW , - 0-9
	400000,,000360		;BREAK ON "]" ALLOW UC AND "["
	400000,,000760		;ALLOW LC
;READ NETWORK FILESPEC FIELD - FILESPEC PUNCTUATION CHARACTERS
;ARE LEGAL (: . < > ) WITH EXCEPTION OF "," WHICH IS HANDLED
;WITH [P,PN] AS SPECIAL CASE
;ACCEPT FILESPECS IN THE FORM OF "DEV:FILNAM.EXT[P,PN,PATH,...]

CMRNFL:	MOVEI	T1,NFLBRK
	PUSHJ	P,CMRFLD	;GET NODE::DEV:NAME.EXT
;	TXZE	F,CMQUES	;IF HELP (?)
;	  JRST	CMRNFL		;THAT IS A WILD CHAR SO KEEP GOING
	MOVE	T1,P4		;GET POINTER TO LAST BYTE PARSED
	ILDB	T1,T1		;GET TERMINATOR
	CAIN	T1,""""		;IF QUOTED STRING
	  JRST	[PUSHJ P,CMRQUO	;READ IT IN
		   POPJ P,	;SOMETHING WRONG
		 JRST CMRNFL]	;LOOP FOR MORE
	CAIE	T1,"["		;PPN ?
	POPJ	P,0		;NO, DONE
	PUSHJ	P,CMRNPT	;YES -- GET DIRECTORY
	JRST	CMRNFL		;COULD BE MORE TO FOLLOW

NFLBRK:	777777,,777760		;BREAK ON ALL CC
	747544,,000120		;ALLOW . 0-9 :-$*%<>;
	400000,,000740		;ALLOW UC _
	400000,,000760		;ALLOW LC

;CMRPTH	Routine to Read a possible TOPS-10 Path Specification from buffer

CMRNPT:	MOVEI	T1,NPTBRK	;POINT TO PATH BREAK SET
	PUSHJ	P,CMRFLD	;GET PATH (UP TO "]")
	TXNE	F,CMQUES	;RETURN IF HELP REQUESTED
	  POPJ	P,
;	TXZE	F,CMQUES	;HELP (?)
;	  JRST	CMRNPT		;WILD CHAR, KEEP IT
	MOVE	T1,P4		;GET POINTER TO LAST CHARACTER
	ILDB	T1,T1		;GET TERMINATOR
	CAIN	T1,"]"		;END OF PATH?
	JRST	CMRN.1		;YES -- STORE TERMINATOR AND RETURN
	JXN	F,CM%ESC,CMAMB		;DING IF ESCAPE TYPED
	POPJ	P,0		;ELSE RETURN

CMRN.1:	PUSHJ	P,CMCIN		;GET TERMINATOR
	PUSHJ	P,STOLCH	;STORE IN ATOM
	POPJ	P,0

NPTBRK:	777777,,777760		;BREAK ON ALL CONTROL CHARACTERS
	747504,,001760		;ALLOW , 0-9, -$*%.
	400000,,000340		;BREAK ON "]" ALLOW UC AND "[" AND _
	400000,,000760		;ALLOW LC
;Read quoted string in the Atom Buffer, keeping the quotes
;  String delimited by ", "" means literal "

CMRQUO:	TXNE	F,CMDEFF	;Have a default?
	RETSKP			;Yes
	PUSHJ	P,CMCIN		;Get first character
	CAIN	T1,CMHLPC	;First character is help?
	  JRST	[TXO F,CMQUES	;Yes
		RETSKP]
	CAIE	T1,CMQTCH	;Start of string?
	  POPJ	P,		;No, fail
	JRST	CMRQU2		;Store the leading quote
CMRQU1:	PUSHJ	P,CMCIN		;Read next character
	CAIN	T1,.CHLFD	;Line end unexpectedly?
	  PJRST	CMDIP		;Yes, put back the LF and RETURN fail
	CAIE	T1,CMQTCH	;Another quote?
	  JRST	CMRQU2		;No, go store the character
	PUSHJ	P,CMCIN		;Yes, peek at the next one
	CAIN	T1,CMQTCH	;A pair of quotes?
	  JRST	CMRQU2		;Yes, store one
	PUSHJ	P,CMDIP		;No, put back next character
	MOVEI	T1,CMQTCH	;Get a quote character
	PUSHJ	P,STOLCH	;Store in the buffer
	PUSHJ	P,TIELCH	;Tie off the Atom Buffer
	RETSKP			;Good return

CMRQU2:	PUSHJ	P,STOLCH	;Store next character in Atom Buffer
	JRST	CMRQU1		;Loop for more
;[100] CMRFLN READS EXACTLY N CHARACTERS.  IN OTHER WORDS, THE N + 1ST CHARACTER
;[100] IS A BREAK CHARACTER, NO MATTER WHAT IT IS.
;[100] 
;[100] ACCEPTS:	T1/	-N

CMRFLN:	MOVEM	T1,CMRBRK	;[100] SET UP SPECIAL COUNT AS BREAK MASK
	PJRST	CMRFLO		;[100] JOIN COMMON CODE

;GENERAL FIELD PARSE ROUTINE - TAKES BREAK SET MASK
; T1/ ADDRESS OF 4-WORD BREAK SET MASK
;	PUSHJ	P,CMRFLD
; RETURNS +1, FIELD COPIED TO ATOM BUFFER, TERMINATOR BACKED UP

CMRFLD:	MOVEM	T1,CMRBRK	;SAVE BREAK TABLE ADDRESS
CMRFLO:	TXNE	F,CMDEFF	;[100] DEFAULT GIVEN?
	JRST	CMRATT		;[100] YES, ALREADY IN BUFFER
CMRAT1:	PUSHJ	P,CMROOM	;[100] MAKE SURE ROOM FOR ANOTHER CHARACTER
	PUSHJ	P,CMCIN		;[100] GET A CHAR
	SKIPG	CMRBRK		;[100] BREAK SET GIVEN?
	JRST	CMRAT3		;[100] 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	CMRAT2		;YES
CMRAT3:	TXZ	F,CM%ESC!CMCFF!CM%EOC!CMQUES ;CLEAR SPECIAL CHARACTER
	PUSHJ	P,STOLCH	;[100] BUILD KEYWORD STRING
	JRST	CMRAT1

CMRAT2:	CAIN	T1,.CHCNZ		;Control-Z ?
	JRST	[PUSHJ	P,STOLCH	;Yes - store character in buffer
		 JRST	CMRATT]		;And return
	CAIE	T1,CMFREC	;^F RECOGNITION?
	CAIN	T1,.CHESC	;ESC?
	JRST	[PUSHJ	P,CHKLCH	;YES, RETURN IF ANYTHING NOW
		JUMPG	T1,CMRATT	;IN ATOM BFR
		JRST	CMAMB]		;AMBIGUOUS
	CAIE	T1," "		;SPACE OR TAB?
	CAIN	T1,.CHTAB
	JRST	[PUSHJ	P,CHKLCH	;YES, RETURN IF ANYTHING
		JUMPG	T1,CMRATR	;IN ATOM BFR
		JRST	CMRAT1]		;OTHERWISE IGNORE
	CAIN	T1,.CHLFD	;OR EOL?
	JRST	CMRATR		;YES
	CAIN	T1,CMHLPC	;HELP REQUEST?
	JRST	[TXO	F,CMQUES	;YES, FLAG
		JRST	CMRATT]

CMRATR:	PUSHJ	P,CMDIP		;PUT CHARACTER BACK IN BUFFER
CMRATT:	PJRST	TIELCH		;TIE OFF ATOM BUFFER AND RETURN
;[100] CMROOM DECIDES IF WE CAN READ ANOTHER CHARACTER

CMROOM:	SKIPLE	CMRBRK		;[100] BREAK SET GIVEN?
	POPJ	P,		;[100] YES, SO KEEP READING
	AOSG	CMRBRK		;[100] NO, COUNT.  HAVE WE READ ENOUGH?
	POPJ	P,		;[100] COUNT NOT EXHAUSTED, KEEP READING.
	MOVEI	T1,[EXP -1,-1,-1,-1] ;[100]
	MOVEM	T1,CMRBRK	;[100] COUNT EXHAUSTED, FOR BREAK ON ANYTHING
	POPJ	P,		;[100] GO READ NEXT CHARACTER IN CASE ITS "?".

;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?
	POPJ	P,0		;YES
CMRSP1:	PUSHJ	P,CMCIN		;GET CHAR
	CAIN	T1,CMHLPC	;HELP?
	JRST	[TXO	F,CMQUES	;YES
		POPJ	P,0]
	JXN	F,CM%ESC,CMAMB	;AMBIGUOUS
	CAIE	T1,.CHTAB
	CAIN	T1," "		;END OF FIELD?
	JRST	[JXE	F,CMTF1,.+1	;CONTINUE IF NOT TERMINATING ON BLANK
		PUSHJ	P,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
	PUSHJ	P,STOLCH	;NO, CHAR TO ATOM BUFFER
	JRST	CMRSP1		;CONTINUE
;READ QUOTED STRING INTO ATOM BUFFER
;STRING DELIMITED BY ", "" MEANS LITERAL "

CMRQST:	TXNE	F,CMDEFF	;HAVE DEFAULT?
	RETSKP			;YES
	PUSHJ	P,CMCIN		;GET FIRST CHAR
	CAIN	T1,CMHLPC	;FIRST CHAR IS HELP?
	JRST	[TXO	F,CMQUES	;YES
		RETSKP]
	CAIE	T1,CMQTCH	;START OF STRING?
	POPJ	P,0		;NO, FAIL
CMRQS1:	PUSHJ	P,CMCIN		;READ NEXT CHAR
	CAIN	T1,.CHLFD	;LINE ENDED UNEXPECTEDLY?
	JRST	[PJRST	CMDIP]	;YES, PUT LF BACK AND RETURN FAIL
	CAIE	T1,CMQTCH	;ANOTHER QUOTE?
	JRST	CMRQS2		;NO, GO STORE CHARACTER
	PUSHJ	P,CMCIN		;YES, PEEK AT ONE AFTER
	CAIN	T1,CMQTCH	;PAIR OF QUOTES?
	JRST	CMRQS2		;YES, STORE ONE
	PUSHJ	P,CMDIP		;NO, PUT BACK NEXT CHAR
	PUSHJ	P,TIELCH	;TIE OFF ATOM BUFFER
	RETSKP			;GOOD

CMRQS2:	PUSHJ	P,STOLCH	;STOR CHAR IN ATOM BUFFER
	JRST	CMRQS1		;KEEP LOOKING
SUBTTL	Atom Buffer Routines / INILCH - Init Atom Buffer

INILCH:	MOVE	T1,.CMABP(P2)	;GET PTR
	MOVEM	T1,ATBPTR
	MOVE	T1,.CMABC(P2)	;GET SIZE
	MOVEM	T1,ATBSIZ
	PJRST	CMSKSP		;FLUSH INITIAL SPACES


SUBTTL	Atom Buffer Routines / STOLCH - Store Character in Atom Buffer

STOLCH:	SOSGE	ATBSIZ		;ROOM?
	$STOP(ABS,Atom buffer too small) ;NO
	IDPB	T1,ATBPTR
	POPJ	P,0


SUBTTL	Atom Buffer Routines / CHKLCH - Return Number of Characters

CHKLCH:	MOVE	T1,.CMABC(P2)	;GET ORIG COUNT
	SUB	T1,ATBSIZ	;COMPUTE DIFFERENCE
	POPJ	P,0


SUBTTL	Atom Buffer Routines / TIELCH - Terminate Atom Buffer With NULL

TIELCH:	SKIPG	ATBSIZ		;ROOM FOR NULL?
	PUSHJ	P,S..ABS	;NO, LOSE
	SETZ	T1,0
	MOVE	T3,ATBPTR	;GET POINTER
	IDPB	T1,T3		;DEPOSIT WITHOUT CHANGING PTR
	POPJ	P,0
SUBTTL	CMCIN  --  Read One Character for Processing

;APPEND TEXT TO BUFFER IF NECESSARY WITH INTERNAL TEXTI
;	PUSHJ	P,CMCIN
; RETURNS +1 ALWAYS, T1/ CHARACTER

CMCIN:	SOJL	P5,[SETZ P5,0		;MAKE INPUT EXACTLY EMPTY
		PUSHJ	P,CMCIN1	;NONE LEFT, GO GET MORE
		JRST	CMCIN]
	ILDB	T1,P4			;GET NEXT ONE
	SOS	P3			;UPDATE FREE COUNT
	CAIN	T1,.CHCRT		;IS IT A CARRIAGE RETURN?
	JRST	CMCIN			;YES, IGNORE IT
CMCINT:	CAIN	T1,CMFREC		;^F?
	JRST	[TXO F,CM%ESC+CMCFF	;YES
		 POPJ	P,0]
	CAIN	T1,.CHESC		;ESC?
	JRST	[TXO F,CM%ESC		;YES
		 POPJ	P,0]
	CAIE	T1,.CHCNZ		;Control-Z ?
	CAIN	T1,.CHLFD		;END OF LINE?
	TXO	F,CM%EOC		;YES, MEANS END OF COMMAND
	POPJ	P,0

CMDIN:	PUSHJ	P,CMCIN			;GET NEXT CHAR
	TXNE	F,CM%ESC		;IS IT THE RECOGNIZER?
	POPJ	P,			;YES, ALL SET
	PUSHJ	P,CMDIP			;NO, PUT IT BACK IN BUFFER
	SETZ	T1,			;NO CHAR
	POPJ	P,
CMCIN1:	MOVEM	F,CMCSF		;SAVE F
	SETZM CMCBLF		;INIT ACCUMULATED FLAGS
	MOVE	T1,[XWD P1,CMCSAC] ;PREPARE FOR BLT
	BLT	T1,CMCSAC+3	;SAVE P1-P4
	;***	REMOVE RD%RND FOR NOW 6/22/78
	MOVX	T1,RD%BRK+RD%BEL+RD%JFN+RD%BBG ;SETUP FLAGS
;	REMOVE CM%NJF 9/20/79 MLB SYMBOL USED FOR CM%BRK
;	TXNE	F,CM%NJF	;WERE JFN'S PASSED?
;	TXZ	T1,RD%JFN	;NO, PASS THAT FACT
	TXNE	F,CM%RAI	;RAISE INPUT REQUESTED?
	TXO	T1,RD%RAI	;YES, PASS IT
	MOVEM	T1,TI+.RDFLG	;STORE FLAGS FOR TEXTI
	MOVX	T1,.RDBKL	;GET NUMBER OF WORDS TO PASS
	MOVEM	T1,TI+.RDCWB	;AND STORE IT
	MOVE	T1,.CMRTY(P2)	;SETUP ^R BUFFER
	MOVEM	T1,TI+.RDRTY	;FOR TXTI
	MOVE	T1,.CMBFP(P2)	;SETUP TOP OF BUFFER
	MOVEM	T1,TI+.RDBFP	;
	MOVEI	T1,[EXP 1B6+1B27,1B31,0,0] ;Control F, Escape, Question mark
	MOVEM	T1,TI+.RDBRK	;Store The break mask
	MOVEM	P4,TI+.RDBKL	;STORE CURRENT PTR FOR BACK UP LIMIT
	MOVEM	P3,CMCSC	;SAVE CURRENT COUNT
	SUB	P3,P5		;ADJUST COUNT FOR ADVANCE INPUT
	MOVEM	P3,TI+.RDDBC	;AND STORE FOR THE TEXT INPUT
	SKIPE	P5		;PUSH POINTER PAST CURRENT INPUT
	IBP	P4		;
	SOJG	P5,.-1		;
	MOVEM	P4,TI+.RDDBP	;STORE FOR INPUT
CMCIN2:	MOVE	S1,.CMIOJ(P2)	;GET THE JFNS
	MOVEM	S1,TI+.RDIOJ	;STORE FOR TEXTI
	SKIPG	P3		;ROOM IN BUFFER FOR MORE INPUT?
	$STOP(TMT,Too much text) 	;NO
	HRLZI	S1,7		;GET SOURCE
	HRRI	S1,A07T16	;GET DESTIONATION
	BLT	S1,A07T16+7	;SAVE SOME ACS
	SETOM	ACFLG		;REMEMBER THEY ARE IMPORTANT
	MOVEI	S1,TI		;GET LOCATION OF TEXTI BLOCK
	PUSHJ	P,K%TXTI	;DO INTERNAL TEXTI
	SETZM	ACFLG		;THE SAVED ACS ARE NO LONGER IMPORTANT
	JUMPF	[MOVEI	S1,EREOF$
		JRST	XCOMEO]
	IOR	F,TI+.RDFLG	;GET FLAGS
	IORB	F,CMCBLF	;ACCUMULATE FLAGS (RD%BLR)
	LDB	T1,TI+.RDDBP		;GET LAST CHAR
	MOVE	P4,TI+.RDDBP	;REMEMBER POINTER
	MOVE	P3,TI+.RDDBC	;AND COUNT
	TXNE	F,RD%BFE	;BUFFER EMPTY?
	JRST	CMCIN3		;YES, RETURN
	JUMPE	T1,CMCIN3	;JUMP IF NULL
	CAIE	T1,.CHLFD	;AN ACTION CHAR?
	CAIN	T1,.CHESC
	JRST	CMCIN3		;YES
	CAIE	T1,CMHLPC
	CAIN	T1,CMFREC	;^F?
	JRST	CMCIN3		;YES
	CAIE	T1,.CHCNZ		;Control-Z ?
	JRST	CMCIN2		;NO, GET MORE INPUT

CMCIN3:	TXNE	F,RD%BLR	;BACKUP LIMIT REACHED?
	JRST	CMCIN4		;YES, CLEANUP AND REPARSE
	TXNE	F,RD%BFE	;BUFFER EMPTY
	SKIPN	INTRPT		;INTERRUPT OCCUR
	SKIPA			;NO..CHECK REST
	JRST	CMCIN4		;YES..SETUP TO RETURN
	MOVE	P5,CMCSC	;RECOVER PREVIOUS COUNT
	SUB	P5,P3		;COMPUTE CHARACTERS JUST APPENDED
	MOVSI	T1,CMCSAC	;RESTORE ACS P1-P4, F
	HRRI	T1,P1
	BLT	T1,P4
	MOVE	F,CMCSF
	POPJ	P,0

;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	P1,CMCSAC	;RESTORE P1&P2
	MOVE	F,CMCSF		;RESTORE F
	SKIPE	INTRPT		;WAS THERE AN INTERRUPT CALL?
	TXO	F,CM%INT	;YES, LIGHT THE FLAG
	SETZM	INTRPT		;CLEAR CALL FLAG
	JRST	XCOMRP		;RETURN REPEAT PARSE
;SKIP LEADING TABS OR SPACES

CMSKSP:	PUSHJ	P,CMCIN		;GET A CHAR
	CAIE	T1," "		;SPACE OR TAB?
	CAIN	T1,.CHTAB
	JRST	CMSKSP		;YES, KEEP LOOKING
	PJRST	CMDIP		;NO, PUT IT BACK

;LOCAL ROUTINE - SUBTRACT ASCII BYTE PTRS
;	T1, T2/ ASCII BYTE PTRS
;	PUSHJ	P,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
	POPJ	P,0

;LOCAL ROUTINE - DELETE LAST CHAR INPUT

CMDCH:	MOVE	S1,P4
	PUSHJ	P,DBP		;DECREMENT BYTE PTR
	MOVEM	S1,P4
	AOS	P3		;ADJUST SPACE COUNT
	SETZ	P5,0		;CAN'T BE ANY WAITING INPUT
	POPJ	P,0

;LOCAL ROUTINE - DECREMENT INPUT POINTER

CMDIP:	LDB	T1,P4		;CHECK THE CHARACTER
	CAIE	T1,.CHLFD	;IS IT <LF>?
	 JRST	CMDIP1		;NO, NOTHING SPECIAL
	MOVE	S1,P4		;YES, SEE IF <CR> PRECEEDED IT
	PUSHJ	P,DBP		;BECAUSE CMCIN MAY HAVE "SKIPPED" <CR>
	LDB	S1,S1		;GET PRECEEDING CHARACTER
	CAIN	S1,.CHCRT	;IS IT AN INVISIBLE <CR>?
	 PUSHJ	P,CMDIP2	;YES, BACK UP OVER IT TOO (PAST LEFT EDGE?)
CMDIP1:	CAIE	T1,CMFREC	;A RECOG REQUEST CHAR?
	CAIN	T1,.CHESC
	TXZ	F,CM%ESC+CMCFF	;YES, RESET FLAGS
CMDIP2:	MOVE	S1,P4		;GET POINTER
	PUSHJ	P,DBP		;DECREMENT IT
	MOVEM	S1,P4		;PUT IT BACK
	AOS	P5		;ADJUST COUNTS
	AOS	P3
	POPJ	P,0

;LOCAL ROUTINE - DEPOSIT INTO INPUT BUFFER

CMDIB:	MOVE	S1,T1		;COPY THE CHARACTER
	PUSHJ	P,CMDOUT	;TYPE IT
CMDIBQ:	SETZ	P5,0		;CLEAR ADVANCE COUNT
	SOSGE	P3		;ROOM?
	PUSHJ	P,S..ABS	;NO
	IDPB	T1,P4		;APPEND BYTE TO USER'S BUFFER
	POPJ	P,0


;LOCAL ROUTINE - DECREMENT BYTE POINTER
	;CALL	S1/	BYTE POINTER

DBP:	PUSH	P,S1		;SAVE BYTE POINTER
	MOVNI	S1,1		;-1 TO BACKUP ONE
	ADJBP	S1,(P)		;ADJUST
	POP	P,(P)		;PRUNE STACK
	POPJ	P,		;RETURN
SUBTTL	HELPER  --  Do caller supplied and default HELP text

;HELPER types out the caller supplied help text, if any, and then it types
;	the default help type unless it was suppressed.   Return is via CMRTYP
;	to retype the current line.
;
;Call:	S1/  address of default HELP text
;
;T Ret:	always

HELPER:	PUSH	P,S1			;SAVE S1
	PUSHJ	P,DOHLP			;DO CALLER SUPPLIED HELP IF ANY
	TXNE	F,CM%SDH		;ARE WE SUPPRESSING DEFAULT HELP?
	JRST	HELP.1			;YES, SKIP PRINTING IT
	MOVEI	S1," "			;LOAD A BLANK
	PUSHJ	P,CMDOUT		;PRINT IT
	MOVE	S1,0(P)			;GET THE MESSAGE
	PUSHJ	P,CMDSTO		;PRINT IT

HELP.1:	POP	P,S1			;GET THE STACK BACK
	PJRST	CMRTYP			;RETYPE THE LINE


SUBTTL	DOHLP  --  Do caller supplied HELP text

DOHLP:	TXNN	F,CMQUE2		;IN ALTERNATE HELP POSSIBILITIES?
	JRST	DOHL2			;NO, SEE IF USER HELP WAS GIVEN
	TXNE	F,CM%HPP		;USER HELP SPECIFIED?
	JRST	DOHL1			;YES, DISPLAY "OR"
	TXNE	F,CM%SDH		;SUPPRESSING DEFAULT HELP
	POPJ	P,0			;YES, JUST RETURN
DOHL1:	MOVEI	S1,[ASCIZ /
  or/]
	PUSHJ	P,CMDSTO
DOHL2:	TXNN	F,CM%HPP		;HAVE HELP POINTER?
	POPJ	P,0			;NO
	MOVEI	S1," "
	PUSHJ	P,CMDOUT		;SPACE BEFORE USER TEXT
	MOVE	S1,.CMHLP(P1)		;YES, GET IT
	PJRST	CMDSTO			;AND TYPE IT


SUBTTL	CMAMB  --  Handle Ambiguous Typein

CMAMB:	TXZN	F,CM%ESC		;ESC SEEN?
	NOPARS	(AMB)		;Ambiguous switch or keyword
	PUSHJ	P,CMDCH			;FLUSH RECOG CHAR FROM BUFFER
	MOVEI	S1,.CHBEL		;INDICATE AMBIGUOUS
	PUSHJ	P,CMDOUT
	JRST	XCOMRF			;GET MORE INPUT AND RESTART
;OUTPUT STRING FROM CURRENT CONTEXT

XMCOUT:	PUSH	P,S1			;Save the character
	PUSHJ	P,CMDOUT		;OUTPUT A CHARACTER
	POP	P,S1			;Restore it
	CAIE	S1,^D9
	JRST	XMCS.2
XMCS.1:	MOVE	S1,CURPOS
	ADDI	S1,8
	IDIVI	S1,8
	IMULI	S1,8
	MOVEM	S1,CURPOS
	SKIPA
XMCS.2:	AOS	CURPOS		;MAINTAIN POSITION
	POPJ	P,0

CRLF:	SETZM	CURPOS			;AT LEFT MARGIN
	MOVEI	S1,[BYTE (7) .CHCRT,.CHLFD,0]
	PJRST	CMDSTO			;AND TYPE IT
;CHECK ALL BYTE PTRS
; T1/ PTR TO LIST OF ADDRESSES, TERMINATED BY 0

CHKABP:	$SAVE	Q1		;SAVE ACS
	$SAVE	Q2		;THAT WE USE
	MOVEM	T1,Q1		;SAVE LIST PTR
CHKAB1:	MOVE	Q2,0(Q1)	;GET NEXT ADDRESS
	JUMPE	Q2,.RETT		;DONE ON 0
	ADDI	Q2,0(P2)	;MAKE PTR TO BLOCK
	MOVE	S1,0(Q2)	;GET BYTE PTR
	PUSHJ	P,CHKBP		;CHECK AND NORMALIZE
	MOVEM	S1,0(Q2)	;PUT IT BACK
	AOJA	Q1,CHKAB1	;DO NEXT

;CHECK A BYTE PTR
; S1/ BYTE PTR - IF LH IS -1, PTR IS FIXED

CHKBP:	HLRZ	S2,S1
	CAIN	S2,-1
	HRLI	S1,(POINT 7)
	LDB	S2,[POINT 6,S1,11] ;GET BYTE SIZE
	IBP	S1		;INCREMENT AND DECREMENT TO NORMALIZE
	PJRST	DBP
SUBTTL	Command Function / .CMINI - Init the scanner and do ^H

XCMINI:	HLRZ	T1,.CMIOJ(P2)		;DOING INPUT FROM TERMINAL?
	CAXE	T1,.PRIIN		;..
	JRST	CMINI4			;NO, SKIP REPAIR
	PUSHJ	P,TYPRMT		;GO TYPE A PROMPT

	CAMN	P4,.CMBFP(P2)		;BUFFER EMPTY?
	JRST	CMINI4			;YES, NO REDO POSSIBLE
	LDB	T1,P4			;CHECK LAST CHAR
	CAIN	T1,.CHLFD		;END OF LINE?
	JRST	CMINI4			;YES, LAST COMMAND OK, NO REDO
	PUSHJ	P,K%BIN			;GET FIRST CHARACTER
	CAIN	S1,CMRDOC		;IS IT REDO?
	JRST	CMINI5			;YES
	PUSHJ	P,K%BACK		;NO, BACKUP OVER IT

CMINI4:	MOVE	T1,P4			;RESET LINE VARIABLES
	MOVE	T2,.CMBFP(P2)
	MOVEM	T2,P4
	PUSHJ	P,SUBBP			;COMPUTE CHARACTERS IN LINE
	ADDM	T1,P3			;UPDATE SPACE COUNT
	SETZ	P5,0			;RESET ADVANCE COUNT
	JRST	XCOMXI			;RETURN GOOD

CMINI5:	MOVE	P3,.CMCNT(P2)		;RESET VARIABLES TO CURR FIELD
	MOVE	P4,.CMPTR(P2)
	LDB	T1,P4			;IF LAST CHARACTER WAS <CR>
	CAIN	T1,.CHCRT
	PUSHJ	P,CMDCH			;DELETE FROM INPUT BUFFER
	SETZ	P5,0			;NO INPUT
	PUSHJ	P,RETYPE		;RETYPE
	JRST	XCOMRP			;RETURN TO REPARSE
SUBTTL	Command Function / .CMSWI - Parse a SWITCH

;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
	PUSHJ	P,CMCIN			;GET FIRST CHAR
	JXN	F,CM%ESC,CMAMB		;AMBIGUOUS
	CAIN	T1,CMHLPC		;HELP?
	JRST	[SETZ	T1,0
		 MOVE	T2,ATBPTR
		 IDPB	T1,T2
		 MOVE	T1,FNARG	;GET TABLE PTR
		 MOVEI	T1,1(T1)	;POINT TO FIRST TABLE ENTRY
		 JRST	CMQ2]		;TYPE OPTIONS
	CAIE	T1,CMSWCH		;THE SWITCH CHARACTER?
	JRST	[PUSHJ	P,CMDIP		;NO, PUT IT BACK
		 NOPARS	(NSW)]	;Not a switch
	JRST	CMKEY0			;CONTINUE LIKE KEYWORD
SUBTTL	Command Function / .CMKEY - Parse a KEYWORD

XCMKEY:	TXZ	F,CMSWF			;NOT SWITCH
CMKEY0:
KEYW1:	PUSHJ	P,CMRATM		;READ THE FIELD INTO LOCAL BUFFER
	MOVE	T1,FNARG		;GET TABLE HEADER ADDRESS
	MOVE	T2,.CMABP(P2)		;POINT TO KEYWORD BUFFER
	PUSHJ	P,XTLOOK		;LOOKUP
	TXNE	F,CMQUES		;HAD "?"
	JRST	CMQ1			;YES, GO TYPE ALTERNATIVES
	TXNE	T2,TL%NOM		;NO MATCH?
	NOPARS(NOM)			;Not a switch or keyword
	JXN	T2,TL%AMB,CMAMB		; ??? AMBIGUOUS
	MOVEM	T1,Q1			;SAVE TABLE INDEX
	HLRZ	T2,0(Q1)		;GET TABLE ENTRY ADDRESS
	PUSHJ	P,CHKTBS		;GET TABLE ENTRY FLAGS
	JXE	T1,CM%ABR,KEYW03	;IF NO LINK TO FULL TEXT, USE THIS ENTRY
	HRRZ	Q1,0(Q1)		;GET ENTRY FOR WHICH THIS IS AN ABBREV
	HLRZ	T2,0(Q1)		;GET ADDRESS OF ITS STRING
	PUSHJ	P,CHKTBS		;GET A BYTE POINTER TO IT
KEYW03:	PUSHJ	P,CHKLCH		;GET NUMBER OF CHARACTERS TYPED
	MOVE	T3,T1			;GET CHARS TYPED
	ADJBP	T3,T2			;SKIP THAT MANY OF FULL KEYWORD
	MOVEM	Q1,CRBLK+CR.RES		;RESULT IS INDEX OF (UNABBREV) ENTRY
	JXE	F,CM%ESC,KEYW4		;DONE IF NO REC WANTED
	MOVEM	T3,Q1			;SAVE PTR TO REMAINDER OF STRING
	PUSHJ	P,CMDCH			;FLUSH RECOG CHARACTER
KEYW2:	ILDB	T1,Q1			;TYPE REMAINDER OF KEYWORD
	JUMPE	T1,KEYW3		;DONE
	PUSHJ	P,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?
		 PUSHJ	P,CMDIP		;NO, PUT TERMINATOR BACK
		 JRST	XCOMXI]		;DONE
	JRST	KEYW2

KEYW3:	JXE	F,CMSWF,XCOMXI		;DONE IF NOT SWITCH
	MOVE	Q1,FNARG		;CHECK FUNCTION FLAGS
	JXE	Q1,CM%VRQ,XCOMXI 	;DONE IF NO VALUE REQUIRED
	MOVEI	T1,CMSWTM		;INCLUDE COLON IN RECOGNITION
	PUSHJ	P,CMDIB
	TXO	F,CM%SWT		;NOTE SWITCH TERMINATOR
	JRST	XCOMX1			;INHIBIT ADDITIONAL SPACE

KEYW4:	PUSHJ	P,CHKLCH		;SEE IF ATOM NON-NULL
	JUMPE	T1,[NOPARS (NUL)]	;Null switch or keyword
	JXE	F,CMSWF,XCOMXI		;DONE IF NOT SWITCH
	PUSHJ	P,CMSKSP		;SKIP SPACES
	PUSHJ	P,CMCIN			;GET NON-BLANK CHAR
	CAIN	T1,CMSWTM		;SWITCH TERMINATOR?
	JRST	[TXO	F,CM%SWT	;YES, NOTE
		 JRST	XCOMXI]		;DONE
	PUSHJ	P,CMDIP			;NO, PUT IT BACK
	MOVE	Q1,FNARG
	JXN	Q1,CM%VRQ,XCOMNP 	;FAIL IF VALUE WAS REQUIRED
	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
		MOVEI	S1,[ASCIZ / keyword (no defined keywords match this input)/]
		PUSHJ	P,CMDSTO	;TYPE MESSAGE
		JRST	CMRTYP]		;RETYPE LINE AND CONTINUE
CMQ2:	MOVEM	T1,Q2			;SAVE TABLE INDEX
	PUSHJ	P,DOHLP			;DO USER HELP IF ANY
	TXNE	F,CM%SDH		;DEFAULT HELP SUPPRESSED?
	JRST	CMRTYP			;YES, DONE
	MOVE	T1,FNARG		;GET TABLE PTR
	HLRZ	Q1,0(T1)		;GET TABLE SIZE
	MOVE	S1,Q1			;SAVE SIZE OF THE TABLE
	ADDI	Q1,1(T1)		;COMPUTE TABLE END ADDRESS FOR BELOW
	CAIN	S1,1			;ONLY ONE ELEMENT IN TABLE
	JRST	CMQ5			;YES.. BYPASS TEXT AND OUTPUT BLANK
	MOVEI	S1,[ASCIZ / one of the following:/]
	PUSHJ	P,CMDSTO		;TYPE IT
	PUSHJ	P,CRLF			;AND A CRLF
CMTAB0:	SOJ	Q2,0			;GETS INCREMENTED BEFORE EACH APPLICATION
	MOVEM	Q2,Q3SAVE		;SAVE SO IT CAN BE REINITIALIZED
	SETZM	TABSIZ			;START WITH TAB SIZE OF 0
CMTAB1:	PUSHJ	P,CMNXTE		;GET TO NEXT VALID KEYWORD IN TABLE
	JUMPF	CMTAB2			;NO MORE IN TABLE
	PUSHJ	P,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	S1,2			;LEAVE AT LEAST 2 SPACES
	ADDM	S1,TABSIZ		;BETWEEN ITEMS
	MOVE	Q2,Q3SAVE		;RESTART TABLE POINTER FOR ACTUAL LISTING
CMQ3:	PUSHJ	P,CMNXTE		;GET TO NEXT KEYWORD
	JUMPF	CMRTYP			;NO MORE, REPEAT COMMAND SO FAR AND CONTINUE
CMQ4:	MOVEI	S1,"/"			;LOAD A SLASH
	TXNE	F,CMSWF			;ARE WE DOING SWITCHES?
	PUSHJ	P,CMDOUT		;YES, TYPE THE SLASH
	PUSH	P,T1			;SAVE ADDRESS OF TABLE ENTRY
	PUSHJ	P,CMGTLN		;COMPUTE ITS LENGTH
	ADDM	T1,CURPOS		;MOVE CURRENT POSITION FORWARD
	POP	P,S1			;RESTORE POINTER
	PUSHJ	P,CMDSTO		;TYPE IT
	PUSHJ	P,CMNXTE		;GET TO NEXT KEYWORD
	JUMPF	CMRTYP			;NO MORE, REPEAT COMMAND SO FAR AND CONTINUE
	PUSHJ	P,NXTKEY		;AND POSITION FOR THE NEXT ONE
	JRST	CMQ4			;TRY NEXT
CMQ5:	MOVEI	S1," "			;GET A BLANK
	PUSHJ	P,CMDOUT		;OUTPUT A CHARACTER
	JRST	CMTAB0			;CONTINUE HELP PROCESSING
;ROUTINE WHICH TAKES POINTER TO TABLE IN Q2, POINTER TO END OF TABLE
;IN Q1, AND RETURNS POINTER TO KEYWORD NAME IN T1. SKIPS UNLESS TABLE
;IS EXHAUSTED. ONLY CONSIDERS PRINTABLE KEYWORDS, AND UPDATES Q2.

CMNXTE:	AOS	Q2		;LOOK AT NEXT TABLE ENTRY
	CAML	Q2,Q1		;BEYOND END OF TABLE?
	$RETF			;YES, FINISHED LIST
	HLRZ	T2,0(Q2)	;GET STRING PTR FOR IT
	PUSHJ	P,CHKTBS	;GET FLAGS FROM STRING
	JXN	T1,CM%INV+CM%NOR,CMNXTE ;SKIP ENTRY IF INVISIBLE OR NOREC
	MOVE	T1,.CMABP(P2)	;PTR TO PARTIAL KEYWORD
	PUSHJ	P,USTCMP	;COMPARE
	JUMPE	T1,CMNXT1	;OK IF EXACT MATCH
	JXE	T1,SC%SUB,.RETF ;DONE IF NOT SUBSTRING

CMNXT1:	HLRZ	T2,0(Q2)	;GET PTR TO STRING FOR THIS ENTRY
	PUSHJ	P,CHKTBS
	MOVE	T1,T2
	$RETT			;RETURN TRUE!!
;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).

NXTKEY:	PUSHJ	P,.SAVET		;DON'T CLOBBER USER'S BYTE POINTER
	MOVE	T2,CURPOS		;GET OUR CURRENT POSITION
	PUSHJ	P,[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
			   POPJ	P,0]
	ADD	T2,BIGSIZ		;MAKE SURE WE HAVE ROOM FOR ANOTHER COLUMN
	CAMLE	T2,PWIDTH		;ROOM FOR ANOTHER KEYWORD ON THIS LINE?
	PJRST	CRLF			;NO, TYPE A CRLF AND RETURN
	PJRST	TYPTAB			;YES, GET TO NEXT TAB STOP

;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
	PUSHJ	P,CMTAB		;SEE WHERE WE WANT TO GET TO
	MOVEM	T2,TABDON	;REMEMBER WHERE WE WANT TO GET TO
TYPTB1:	MOVE	T1,CURPOS	;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	TYPTB2		;YES
	MOVEI	S1,.CHTAB
	PUSHJ	P,XMCOUT	;AND TYPE IT
	JRST	TYPTB1		;LOOP FOR AS MANY HARDWARE TABS AS WE CAN GET AWAY WITH
TYPTB2:	MOVE	T1,CURPOS
	CAML	T1,TABDON	;ARE WE THERE YET?
	POPJ	P,0		;YES, SO TAB IS TYPED
	MOVEI	S1," "		;NO, SO SPACE OVER
	PUSHJ	P,XMCOUT
	JRST	TYPTB2		;AND LOOP FOR REST OF SPACES

;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
CMGT.1:	ILDB	T2,T1		;PICK UP NEXT CHARACTER FROM KEYWORD
	CAIE	T2,0		;ASSUME KEYWORD ENDS ON NULL
	AOJA	T4,CMGT.1	;NOT OVER YET, ACCUMULATE ITS LENGTH
	TXNE	F,CMSWF		;IS THIS A SWITCH?
	AOJ	T4,0		;YES, DELIMITER TAKES UP ANOTHER SPACE
	MOVE	T1,T4		;RETURN LENGTH IN T1
	POPJ	P,0
SUBTTL	Command Function / .CMTXT - Parse Arbitrary Text to Action Character

XCMTXT:	PUSHJ	P,CMRSTR	;READ TEXT
	JXN	F,CMQUES,[
			TXNN	F,CMQUE2 ;IFIN MIDDLE OF HELP LIST, ? DOES HELP
			JUMPN	T1,XCMTQ ;USUALLY "?" IS JUST PART OF TEXT
			PUSHJ	P,DOHLP	;DO USER HELP
			HRROI	T1,[ASCIZ / text string/]
			TXNN	F,CM%SDH
			PUSHJ	P,CMDSTO;TYPE HELP UNLESS SUPPRESSED
			JRST	CMRTYP]	;NO DEFAULT MESSAGE
	JXN	F,CM%ESC,CMAMB		;DING IF HE TRIES TO DO RECOGNITION
	JRST	XCOMXI			;DONE

XCMTQ:	MOVEI	T1,CMHLPC		;PUT QUESTION MARK IN TEXT
	PUSHJ	P,STOLCH
	PUSHJ	P,TIELCH		;TIE OFF ATOM BUFFER INCASE LAST CHR
	TXZ	F,CMQUES		;FORGET WE'RE IN HELP STATE
	JRST	XCMTXT			;READ REST OF TET


SUBTTL	Function .CMNOI  --  Parse a NOISE-WORD

XCMNOI:	MOVE	S1,FNARG		;GET STRING PTR
	PUSHJ	P,CHKBP			;CHECK AND NORMALIZE
	MOVEM	S1,XXXPTR
	TXNN	F,CM%PFE		;PREVIOUS FIELD ENDED WITH ESC?
	JRST	CMNOI3			;NO
	TXO	F,CM%ESC		;YES, MEANS THIS ONE DID TOO
	MOVEI	T1,NOIBCH		;TYPE NOISE BEG CHAR
	PUSHJ	P,CMDIB			; AND PUT IT IN BUFFER
CMNOI2:	ILDB	T1,XXXPTR		;GET NEXT NOISE CHAR
	JUMPN	T1,[PUSHJ P,CMDIB	;PUT IT IN BUFFER IF NOT END OF STRING
		JRST	CMNOI2]
	MOVEI	T1,NOIECH		;END OF STRING, TYPE END CHAR
	PUSHJ	P,CMDIB
	JRST	XCOMXI			;EXIT

;PREVIOUS FIELD NOT TERMINATED WITH ESC - PASS NOISE WORD IF TYPED

CMNOI3:	PUSHJ	P,CMSKSP		;BYPASS SPACES
	PUSHJ	P,CMCIN			;GET FIRST CHAR
	CAIE	T1,NOIBCH		;NOISE BEG CHAR?
	JRST	[PUSHJ	P,CMDIP		;NO, NOT A NOISE WORD, PUT IT BACK
		 JRST	XCOMXI]		;RETURN OK
CMNOI4:	PUSHJ	P,CMCIN			;GET NEXT NOISE CHAR
	CAIE	T1,CMFREC		;^F?
	CAIN	T1,.CHESC		;ESC?
	JRST	[PUSHJ	P,CMDCH		;YES, FLUSH IT
		JRST	CMNOI2]		;COMPLETE NOISE WORD FOR USER
	ILDB	T2,XXXPTR		;COMPARE WITH GIVEN STRING
	CAIL	T1,"A"+40		;RAISE CASING FOR COMPARE
	CAILE	T1,"Z"+40
	SKIPA
	SUBI	T1,40
	CAIL	T2,"A"+40
	CAILE	T2,"Z"+40
	SKIPA
	SUBI	T2,40
	CAMN	T1,T2
	JRST	CMNOI4			;STILL SAME AS EXPECTED
	CAIN	T1,NOIECH		;NOT SAME, STRING ENDED TOGETHER?
	JUMPE	T2,XCOMXI		;YES, EXIT OK
	NOPARS	(INW)		;Invalid guide word
SUBTTL	Command Function / .CMCFM - Command Confirmation (end-of-line)

XCMCFM:	PUSHJ	P,CMCFM0		;DO THE WORK
	NOPARS(NC)			;Not confirmed
	JRST	XCOMXI			;OK

CMCFM0:	PUSHJ	P,CMCIN			;GET CHAR
	CAIE	T1,.CHTAB		;BLANK?
	CAIN	T1," "
	JRST	CMCFM0			;YES, IGNORE
	MOVEI	S1,[ASCIZ /confirm with carriage return/]
	CAIN	T1,CMHLPC		;HELP?
	PUSHJ	P,HELPER		;YES, GIVE IT
	JXN	F,CM%ESC,CMAMB		;AMBIGUOUS
	CAIE	T1,.CHLFD		;NL (NEW LINE, I.E. LINEFEED)
	POPJ	P,0			;NO, FAIL
	RETSKP				;YES
;FLOATING POINT NUMBER

XCMFLT:	$STOP(SFP,Scanning floating point not implemented)
REPEAT 0,<
	MOVEI	T1,FLTBRK	;USE SPECIAL BREAK SET
	PUSHJ	P,CMRFLD	;READ FIELD
	MOVEI	S1,[ASCIZ /number/]
	TXNE	F,CMQUES		;QUESTION MARK?
	PUSHJ	P,HELPER		;YES, HELP!
	MOVE	T1,.CMABP(P2)	;NUMBER NOW IN ATOM BUFFER, GET PTR
	MOVEM	T1,T1
	IMCALL	.FLIN
	 JRST	[MOVEM	T3,T2		;FAILED, RETURN ERROR CODE
		 JRST	XCOMNP]
	JRST	CMNUMR		;DO NUMBER CLEANUP AND RETURN

;FLOATING POINT BREAK SET MASK, ALLOWS +, -, ., E, NUMBERS

FLTBRK:	777777,,777760
	777644,,001760
	400000,,000760
	400000,,000760

 >;END OF REPEAT 0
SUBTTL	Command Function / .CMNUM - Parse an INTEGER in any base
SUBTTL	Command Function / .CMNUX - Parse an INTEGER in any base (special break)

XCMNUX:	SKIPA	T1,[NUXBRK]	;USE SPECIAL BREAK SET
XCMNUM:	MOVEI	T1,NUMBRK	;USE REGULAR BREAK SET
	PUSHJ	P,CMRFLD	;READ FIELD
	TXNE	F,CMQUES	;SAW "?"
	JRST	CMNUMH		;YES
XCMNX1:	MOVE	S1,.CMABP(P2)	;[100] SETUP NIN
	MOVE	S2,FNARG	;GET RADIX
	PUSHJ	P,NUMIN		;PARSE THE NUMBER
	JUMPF	CMNUM1		;NO PARSE
CMNUMR:	MOVEM	S2,CRBLK+CR.RES	;STORE RESULT
	MOVE	T2,ATBPTR
	IBP	T2		;BUMP PTR PAST TERMINATOR
	CAMN	S1,T2		;NIN SAW WHOLE FIELD?
	JRST	[MOVE	T2,CRBLK+CR.RES
		JRST	XCOMXR] ; YES, RECOVER RESULT AND RETURN
	LOAD	S2,.CMFNP(P1),CM%FNC ;[100] GET FUNCTION CODE
	CAIE	S2,.CMNUX	;[100] A .CMNUX FUNCTION?
	JRST	CMNUM1		;[100] NO, INVALID CHARACTER IN NUMBER
	MOVE	T2,S1		;[100] GET POINTER FROM NIN IN T2
	MOVE	T1,.CMABP(P2)	;[100] AND GET ATOM BUFFER POINTER IN T1
	PUSHJ	P,SUBBP		;[100] FIND NEG NUMBER OF BYTES ACTUALLY READ
	AOJ	T1,		;[100] DON'T INCLUDE THE TERMINATOR
	PUSH	P,T1		;[100] AND SAVE IT
	PUSHJ	P,CMFSET	;[100] RESET ALL POINTERS
	POP	P,T1		;[100] AND GET BACK NUMBER OF BYTES READ BY NIN
	PUSHJ	P,CMRFLN	;[100] AND REREAD THE FIELD UP TO TERM NIN SAW
	JRST	XCMNX1		;[100] NOW TRY NIN AGAIN.
CMNUM1:	NOPARS	(ICN)		;Invalid numeric character

;NUMBER BREAK SET, ALLOWS +, -, NUMBERS

NUMBRK:	777777,,777760
	777654,,001760
	400000,,000760
	400000,,000760

NUXBRK:	777777,,777760
	777654,,001760
	777777,,777760
	777777,,777760


CMNUMH:	PUSHJ	P,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
	$STOP(IBN,Illegal base for number)
	CAIN	T2,^D10		;DECIMAL?
	JRST	CMNH10		;YES
	CAIN	T2,^D8		;OCTAL?
	JRST	CMNH8		;YES
	MOVEI	S1,[ASCIZ / a number in base /]
	PUSHJ	P,CMDSTO	;ARBITRARY BASE
	HRRZ	T1,.CMIOJ(P2)
	HRRZ	T2,FNARG
	MOVEI	T3,^D10
	ADDI	T2,"0"		;CONVERT BASE TO ASCII
	MOVE	S1,T2			;COPY THE BASE OVER
	PUSHJ	P,CMDOUT		;AND TYPE IT
	SUBI	T2,"0"			;CONVERT IT BACK
	JRST	CMRTYP		;RETYPE LINE AND CONTINUE

CMNH8:	MOVEI	S1,[ASCIZ / octal number/]
	JRST	CMNH

CMNH10:	MOVEI	S1,[ASCIZ / decimal number/]
CMNH:	PUSHJ	P,CMDSTO
	JRST	CMRTYP
SUBTTL	Command Function / .CMDEV - Parse a DEVICE specification

XCMDEV:	MOVEI	T1,DEVBRK		;GET DEVICE BREAK SET
	PUSHJ	P,CMRFLD		;GET THE FIELD
	MOVEI	S1,[ASCIZ /Device name/]
	TXNE	F,CMQUES		;TYPE A QUESTION MARK?
	PUSHJ	P,HELPER		;YES, CALL THE HELPER
	TXNE	F,CM%ESC		;WANT RECOGNITION HERE?
	JRST	[PUSHJ	P,CMDIP		;BACKUP OVER RECOGNIZER
		PUSHJ	P,CMCIN		;GET IT BACK
		PUSH	P,T1		;SAVE IT A SEC
		PUSHJ	P,CMDCH		;DELETE THE RECOGNIZER
		MOVEI	T1,":"		;GET OUR TERMINATOR
		PUSHJ	P,CMDIB		;PUT IT IN
		POP	P,T1		;GET BACK TERMINATOR
		PUSHJ	P,CMDIBQ	;PUT THAT IN, TOO, NO TYPEOUT
		PUSHJ	P,CMDIP		;BACK OVER RECOGNIZER
		PUSHJ	P,CMDIP		;AND BACK OVER :, TOO
		JRST	CMDEV0]		;REENTER THE FLOW
CMDEV0:	MOVE	S1,.CMABP(P2)		;ADDRESS OF BUFFER
;**;[102] Insert 3 lines after CMDEV0+0L. /LWS
	ILDB	S2,S1			;[102] GET FIRST BYTE
	CAIN	S2,0			;[102] NULL?
	NOPARS(NDN)			;[102] YES,,SORRY
	PUSHJ	P,CMCIN			;READ THE TERMINATOR
	CAIN	T1,":"			;IS IT THERE?
	JRST	CMDEV1			;YES, KEEP GOING
	TXNN	F,CM%NSF		;ANY SUFFIX REQUIRED?
	NOPARS(DVT)			;Invalid device terminator
	PUSHJ	P,CMDIP			;NO SUFFIX REQUIRED, SPIT OUT TERMINATOR
CMDEV1:	PUSHJ	P,CMDIN			;PRIME THE PUMP
	MOVE	S1,.CMABP(P2)		;POINT AT THE ATOM BUFFER
	PUSHJ	P,CNVSIX		;CONVERT FIELD TO SIXBIT
	SKIPT				;O.K. S1/  FIELD NAME
	NOPARS(DGS)			;Device name too large
	TXNE	F,CM%PO			;PARSE ONLY ON FIELD ?
	JRST	XCOMXR			;YES..RETURN O.K.
	DEVCHR	S2,			;SEE IF IT EXISTS
	SKIPN	S2			;VALID DATA
	NOPARS(DNE)
	TXNE	S2,DV.IN!DV.OUT		;CHECK IF CAN DO INPUT OR OUTPUT
	PJRST	XCOMXR			;YES..RETURN O.K.
	NOPARS(DIO)			;Cant do input or output

DEVBRK:	777777,,777760			;BREAK ON ALL CONTROL CHARACTERS
	757754,,001760			;BREAK ON :, ALLOW 0-9
	400000,,000740			;ALLOW UC
	400000,,000760			;ALLOW LC
SUBTTL	Command Function / .CMQST - Parse a QUOTED STRING

XCMQST:	PUSHJ	P,CMRQST		;READ THE STRING
	NOPARS(NQS)			;Not a quoted string
	MOVEI	S1,[ASCIZ /quoted string/]
	TXNE	F,CMQUES		;QUESTION MARK TYPED?
	PUSHJ	P,HELPER		;YES, GIVE HELP
	TXZ	F,CM%ESC+CMCFF		;CLEAR IN CASE USED INSIDE STRING
	JRST	FIXESC			;CHECK FOR ESCAPE AND RETURN

;UNQUOTED STRING - TAKES BIT MASK (4 WORDS * 32 BITS) TO SPECIFY BREAKS.

XCMUQS:	JXE	F,CMQUES,CMUQS1	;? BEEN TYPED ALREADY?
	PUSHJ	P,DOHLP		;YES - DO USER HELP
	HRROI	T1,[ASCIZ / unquoted string/]
	TXNN	F,CM%SDH	;SUPPRESS DEFAULT?
	PUSHJ	P,CMDSTO	;NO, DO IT
	JRST	CMRTYP
CMUQS1:	PUSHJ	P,CMCIN		;GET A CHAR
	MOVE	T3,T1		;COPY CHARACTER
	IDIVI	T1,^D32		;COMPUTE INDEX TO BIT ARRAY
	MOVE	T2,BITS(T2)
	ADD	T1,FNARG
	TDNN	T2,0(T1)	;BIT ON?
	JRST	CMUQS1		;NO, KEEP GOING
	CAIN	T3,CMHLPC	;TERMINATED WITH HELP CHAR?
	JRST	[PUSHJ	P,DOHLP	;YES, DO USER HELP
		 JRST	CMRTYP]	;AND RETYPE LINE
	TXZ	F,CM%ESC+CMCFF	;CLEAR FLAGS
	PUSHJ	P,CMCINT	;SEE IF ESCAPE OR ^F TYPED
	JRST	FIXES1		;NO - TERMINATE NORMALLY
	PUSHJ	P,CMDIP		;YES, PUT CHAR BACK
	TXO	F,CM%ESC	;SET FLAG
	MOVEI	T1," "		;TERMINATE TYPESCRIPT WITH SPACE
	PUSHJ	P,CMDIB
	PUSHJ	P,CMDIP		;DON'T REALLY PARSE THE SPACE UNTIL NEXT FIELD!
	JRST	XCOMX1

;ARBITRARY FIELD

XCMFLD:	PUSHJ	P,CMRATM
CMFLD1:	TXNE	F,CMQUES	;"?" SEEN?
	JRST	[PUSHJ	P,DOHLP		;YES, DO USER MESSAGE
		 JRST	CMRTYP]
	JRST	XCOMXR		;LEAVE FIELD IN ATOM BUFFER

;ACCOUNT
XCMACT:	MOVEI	T1,ACTBRK	;POINT TO BREAK MASK
	PUSHJ	P,CMRFLD	;READ FIELD
	JRST	CMFLD1		;FINISH LIKE ARBITRARY FIELD

ACTBRK:	777777,,777760		;BREAK ON ALL CONTROLS
	000000,,000000		;ALLOW CHARACTERS
	000000,,000000		; IN THE RANGE OF
	000000,,000060		;  OCTAL 40 TO 176
SUBTTL	Command Function / .CMNOD - Parse a NODE Specification

XCMNOD:	PUSHJ	P,CMRATM		;GET AN ATOM
	TXNE	F,CMQUES		;DID HE TYPE A QUESTION MARK?
	PUSHJ	P,NODHLP		;YES, TYPE THE HELP TEXT(S)
	TXNE	F,CM%ESC		;WANT RECOGNITION?
	JRST	[PUSHJ	P,CMDIP		;YES, BACK UP TO RECOGNIZER
		PUSHJ	P,CMCIN		;GET THE RECOGNIZER
		PUSH	P,T1		;SAVE IT
		PUSHJ	P,CMDCH		;DELETE IT
		MOVEI	T1,":"		;GET TERMINATOR
		PUSHJ	P,CMDIB		;PUT IT IN
		PUSHJ	P,CMDIB		;TWICE
		POP	P,T1		;GET BACK RECOGNIZER
		PUSHJ	P,CMDIBQ	;PUT THAT BACK IN, NO TYPEOUT
		PUSHJ	P,CMDIP		;BACK UP OVER RECOGNIZER
		PUSHJ	P,CMDIP		;AND OVER 1 :
		PUSHJ	P,CMDIP		;AND OVER THE OTHER
		JRST	CMNOD1]		;REENETER FLOW
CMNOD1:	MOVE	S1,.CMABP(P2)		;GET THE BYTE POINTER
	ILDB	S2,S1			;GET THE FIRST BYTE
	SKIPN	S2			;BETTER NOT BE NULL
	JRST	ILLNOD			;IMPROPER NODE NAME
	MOVE	S1,.CMABP(P2)		;POINT AT THE ATOM BUFFER
	MOVEI	S2,^D8			;TRY AS AN OCTAL NUMBER
	PUSHJ	P,NUMIN			;READ IT
	JUMPF	CMNODS			;LOSES, TRY SIXBIT
	MOVE	T2,ATBPTR		;GET POINTER TO END OF ATOM BUFFER
	IBP	T2			;POINT AT TERMINATOR
	CAMN	S1,T2			;OUR POINTER END THE SAME PLACE?
	JRST	CMNOD2			;YES, WIN! ELSE TRY SIXBIT
CMNODS:	MOVE	S1,.CMABP(P2)		;POINT AT THE ATOM BUFFER
	PUSHJ	P,CNVSIX		;CONVERT BUFFER TO SIXBIT
	SKIPT				;O.K.. CONTINUE
ILLNOD:	NOPARS	(NNC)		;Invalid node name
	MOVE	T2,ATBPTR		;GET POINTER TO END OF ATOM BUFFER
	IBP	T2			;POINT AT TERMINATOR
	CAME	S1,T2			;OUR POINTER END THE SAME PLACE?
	JRST	ILLNOD			;NO, LOSE!
CMNOD2:	MOVEM	S2,CRBLK+CR.RES		;SAVE AS RESULT (SIXBIT OR #)
	PUSHJ	P,CMCIN			;GET NEXT CHAR AFTER FIELD
	CAIN	T1,":"			;BEGINING OF TERMINATOR?
	JRST	CMNOD3			;GOT ONE : GO LOOK FOR THE OTHER
	CAIN	T1,"_"			;NO, HOW ABOUT OTHER STYLE
	JRST	CMNOD4			;LOOKS GOOD KEEP GOING
	TXNN	F,CM%NSF		;NO SUFFIX REQUIRED?
	JRST	ILLNO1			;NOPE, QUIT (IE: IT WAS REQUIRED)
	PUSHJ	P,CMDIP			;BACK UP OVER THE TERMINATOR
	JRST	CMNOD4			;AND FINISH UP

CMNOD3:	PUSHJ	P,CMCIN			;READ NEXT CHAR AFTER THE :
	CAIN	T1,CMHLPC		;IS IT ?
	PUSHJ	P,NODHLP		;YES, GIVE SOME HELP
	TXNE	F,CM%ESC		;WANT RECOGNITION?
	JRST	[PUSH	P,T1		;SAVE RECOGNIZER
		PUSHJ	P,CMDCH		;DELETE IT
		MOVEI	T1,":"		;GET EXTRA DELIMITER
		PUSHJ	P,CMDIB		;PUT IT IN BUFFER
		POP	P,T1		;GET BACK RECOGNIZER
		PUSHJ	P,CMDIBQ	;PUT THAT IN, NO TYPEOUT
		PUSHJ	P,CMDIP		;BACK OVER RECOGNIZER
		JRST	CMNOD4]		;BACK IN LINE
	CAIE	T1,":"			;IS IT THE SECOND : ?
ILLNO1:	NOPARS(INT)			;Invalid node terminator
CMNOD4:	PUSHJ	P,CMDIN			;PRIME THE CHARACTER PUMP
	TXNE	F,CM%PO			;PARSE ONLY?
	JRST	XCOMXR			;YES, JUST RETURN WITH RESULT
	MOVE	T1,[XWD .NDRNN,T2] 	; MAKE SURE THAT THIS NODE NUMBER EXISTS
	MOVEI	T2,2			;2 ARGS
	MOVE	T3,CRBLK+CR.RES		;NODE NUMER WE JUST PARSED
	NODE.	T1,			;TRY IT FOR EXISTANCE
	  NOPARS(NSN)		;No such node
	JRST	XCOMXR			;A GOOD NODE NUMBER, RETURN

;HERE IF ? TYPED DURING NODE NAME PARSE
NODHLP:	TXO	F,CMQUES		;NOTE IT
	MOVEI	S1,[ASCIZ /Node name/]	;THE DEFAULT TEXT
	PUSHJ	P,HELPER		;HELP THE USER
	POPJ	P,			;NEVER GET HERE (HELPER DOESN'T RETURN)
;INDIRECT FILESPEC (INTERNAL CALL)

CMATFI:
	TXO	F,CMINDF	;NOTE GETTING INDIRECT FILE
	JRST	XCMIFI		;AND HANDLE AS INPUT FILE

XCMOFI:
XCMIFI:


XCMFIL:	LOAD	S1,.CMGJB(P2),CM%GJB ;GET ADDR OF FD
	LOAD	S1,.FDLEN(S1),FD.TYP ;GET FD TYPE
	PUSH	P,S1		;SAVE FOR LATER
	CAIN	S1,.FDNET	;IF WANTS NETWORK FILESPEC
	PUSHJ	P,CMRNFL	;THEN SCAN ONE
	MOVE	S1,(P)		;GET FD TYPE AGAIN
	CAIE	S1,.FDNET	;ELSE,
	PUSHJ	P,CMRFIL	;SCAN NATIVE FILE SPECIFICATION
	JXN	F,CMQUES,CMFHLP	;IF THEY WANT HELP, GIVE IT TO THEM
	JXN	F,CM%ESC,[PUSHJ P,CMDCH	;ALLOW ESCAPE AS VALID TERMINATOR
			  PUSHJ P,TIELCH
			  JRST XFIL.1 ]	;RETURN IN LINE

XFIL.1:	MOVE	S1,(P)		;GET FD TYPE AGAIN
	CAIN	S1,.FDNET	;IF NETWORK FILESPEC PARSING
	  JRST	XFIL.2		;DO IT
	PUSHJ	P,FILIN		;GET FILE SPEC
	  NOPARS(IFS)		;Invalid file spec
	JRST	XFIL.3		;JOIN COMMON CODE
XFIL.2:	PUSHJ	P,NFILIN	;GET NETWORK FILE SPEC
	  NOPARS(IFS)		;INVALID FILE SPEC
XFIL.3:	POP	P,(P)		;CLEAR FD TYPE FROM STACK
	MOVE	T2,ATBPTR	;GET POINTER TO ATOM BUFFER END
	IBP	T2		;BUMP PAST TERMINATOR
	CAME	T2,XXXPTR	;DOES IT MATCH?
	  NOPARS(IFS)		;Invalid file spec
	TXZE	F,CMINDF	;ARE WE DOING INDIRECT FILE?
	RETSKP			;YES , RETURN FOR PROCESSING
	JRST	XCOMXI		;OTHERWISE, DONE
FILIN:	PUSHJ	P,.SAVE1	;SAVE A REG
	LOAD	S2,.CMGJB(P2),CM%GJB ;GET ADDR OF FD
	MOVEM	S2,CRBLK+CR.RES	;SAVE IT FOR CALLER
	MOVE	P1,S2		;AND REMEMBER IT
	MOVX	S1,FDXSIZ	;NOW ZERO IT OUT
	STORE	S1,.FDLEN(S2),FD.LEN ;STORE LENGTH INTO FD
	MOVEI	S1,.FDNAT	;GET NATIVE FD TYPE
	STORE	S1,.FDLEN(S2),FD.TYP	;STORE THE TYPE
	SKIPN	S1,.FDSTR(P1)	;SEE IF USER SUPPLIED A DEFAULT DEVICE
	MOVSI	S1,'DSK'	;NO, SUPPLY DEFAULT DEVICE
	MOVEM	S1,.FDSTR(P1)	;STORE DEFAULT DEVICE
	MOVE	S1,.CMABP(P2)	;GET ATOM BUFFER POINTER
	MOVEM	S1,XXXPTR	;STORE IT
	PUSHJ	P,CNVSIX	;GET A SIXBIT WORD
;**;[77] Insert 2 lines after FILIN+13L. 28-Dec-83 /LWS
	TXNE	F,CMINDF	;[77] IN INDIRECT FILE?
	JUMPE	S2,.POPJ	;[77] YES,,DON'T ALLOW DEFAULT FILEN
	LDB	T2,S1		;GET TERMINATOR
	CAIE	T2,":"		;IS FIRST PART A DEVICE
	JRST	FILI.1		;NO
	MOVEM	S2,.FDSTR(P1)	;STORE STRUCTURE NAME
	PUSHJ	P,CNVSIX	;GET A SIXBIT WORD
	LDB	T2,S1		;AND TERMINATING CHARACTER
FILI.1:	SKIPE	S2		;IF NO FILE NAME, LOOK FOR EXTENSTION
	MOVEM	S2,.FDNAM(P1)	;STORE NAME
	CAIE	T2,"."		;IS THERE AN EXTENSION?
	JRST	FILI.3		;NO
	PUSHJ	P,CNVSIX	;GET A SIXBIT WORD
	LDB	T2,S1		;AND TERMINATING CHARACTER
	MOVEM	S2,.FDEXT(P1)	;SAVE EXTENSION
FILI.3:	MOVEM	S1,XXXPTR	;UPDATE BYTE POINTER
	CAIE	T2,"["		;HAVE WE GOT A PPN?
	JRST	.POPJ1		;NO--ALL DONE
	PUSHJ	P,DBP		;DECREMENT IT
	MOVE	T1,S1		;PLACE POINTER BACK IN T1
	MOVEI	T2,.FDPPN(P1)	;POINT TO DESTINATION
	HRLI	T2,<FDXSIZ-.FDPPN> ;AND SET MAXIMUM SFD DEPTH
	PUSHJ	P,PATHIN	;PARSE THE PATH
	  PJRST	TIELCH		;FAILED--TERMINATE ATOM BUFFER
	IBP	XXXPTR		;AND BUMP PAST TERMINATOR
	JRST	.POPJ1		;ALL DONE
; Here to parse a network file specification of the form:
;
;	node"user passw acct"::device:[directory]file.name;generation
;
; Example:
;
;	MARS"SMITH SPLIT A-1234"::SYS$SYSTEM:[SYSHLP]RUNOFF.HLP;1
;
NFILIN:	MOVE	S1,.CMABP(P2)	;Get atom buffer pointer
	MOVEM	S1,XXXPTR	;Save away
	ILDB	S1,S1		;Get first character
	JUMPE	S1,[CAIN T1,.CHLFD	;If it is null
		    JRST .+1		;And at EOL, we have a valid filespec
		    NOPARS(IFS)]	;Else, not a valid filespec
	LOAD	T1,.CMGJB(P2),CM%GJB ;Get address of FD
	MOVEM	T1,CRBLK+CR.RES	;Save for caller
	LOAD	T2,.FDLEN(T1),FD.LEN ;Get length of FD
	SUBI	T2,.FDFIL	;Minus the length field
	IMULI	T2,5		;Times 5 characters per word
	SUBI	T2,1		;Need to save space for null at end
	MOVEM	T2,FDFSIZ	;Save away
	ADDI	T1,.FDFIL	;Where to store string
	HRLI	T1,(POINT 7,0)	;Make into a byte pointer
	MOVEM	T1,FDFPTR	;Save away
	SETZM	LSTERR		;Save first file parsing error code
	SETZM	PRSDND		;Clear some flags
	SETZM	PRSDAC
	SETZM	PRSDDV
	SETZM	PRSDNM
	SETZM	PRSDEX
	SETZM	PRSDGN
	SETZM	PRSDDR

NFL.1:	MOVE	S1,XXXPTR	;Current Field begins here
	MOVEM	S1,BEGPTR	;Save for later
	MOVEI	T2,NFLDLM	;Get field delimiter break table
	PUSHJ	P,NFLSPN	;Span to end-of-field
	MOVE	S1,XXXPTR	;Pointer to end-of-filed
	MOVEM	S1,ENDPTR	;Save it

	CAIN	T1,":"		;Colon?
	  JRST	NFL.3		;Go parse a node or device
	CAIN	T1,"."		;Dot?
	  JRST	NFL.4		;Go parse a file name
	CAIE	T1,"["		;Square brackets?
	 CAIN	T1,74		;Or angle brackets?
	  JRST	NFL.5		;Go parse directory
	CAIN	T1,";"		;Semi-colon?
	  JRST	NFL.6		;Go parse a generation number
	CAIN	T1,""""		;Quote?
	  JRST	NFL.7		;Go parse access string
	CAIN	T1,0		;Null?
	  JRST	NFL.8		;Go finish up parse
	NOPARS(IFS)		;Bad file spec then

NFL.2:	SETZ	S1,
	IDPB	S1,FDFPTR	;Make sure a null terminates FD buffer
	RETSKP			;Give good return
; Here when delimiter is ":".  Could be a device or node name
NFL.3:	MOVE	S1,XXXPTR	;Could be node or device
	ILDB	S2,S1		;Get next character
	CAIE	S2,":"		;Another colon?
	JRST	[PUSHJ P,NFL.DV		;No, go copy the device name
		JRST NFL.1]		;And loop for next field

	MOVEM	S1,XXXPTR	;New atom buffer pointer
	MOVEM	S1,ENDPTR	;New end-of-field pointer
	PUSHJ	P,NFL.ND	;Go copy the node name
	JRST	NFL.1		;And loop for next field

; Here when delimiter was ".".  Could be a file name or extension
NFL.4:	SKIPN	PRSDNM		;Could it be a file name?
	JRST	[PUSHJ P, NFL.NM	;Yes, go copy it
		JRST NFL.1]		;And loop for next field

	SKIPN	PRSDEX		;Or, could it be an extension?
	JRST	[PUSHJ P,NFL.EX		;Yes, go copy it
		JRST NFL.1]		;And loop for next field

	NOPARS(IFS)		;Must be bad syntax

; Here when delimiter was "[" or angle bracket.  Could be a naked
;  directory, a file name, and extension, or a generation number.  After
;  deciding and parsing that field, go parse the directory that follows.
NFL.5:	MOVE	S1,BEGPTR	;Is this the beginning of field?
	IBP	S1
	CAMN	S1,ENDPTR
	JRST	[MOVE S1,T1		;Yes, copy the delimiter to FD buffer
		PUSHJ P,NFLCHR
		PUSHJ P,NFL.DR		;Then, parse the directory
		JRST NFL.1]		;And loop for next field

	SKIPN	PRSDNM		;No, Could be a file name?
	JRST	[PUSHJ P,NFL.NM		;Yes, copy copy it
		LDB T1,ENDPTR		;Get back delimiter
		PUSHJ P,NFL.DR		;Then, parse the directory
		JRST NFL.1]		;And loop for next field

	SKIPN	PRSDEX		;Or, it could be file extension?
	JRST	[PUSHJ P,NFL.EX		;Yes, copy it
		LDB T1,ENDPTR		;Get back delimiter
		PUSHJ P,NFL.DR		;Then, parse the directory
		JRST NFL.1]		;And loop for next field

	SKIPN	PRSDGN		;Or, it could be the generation number
	JRST	[PUSHJ P,NFL.GN		;Yes, copy it
		LDB T1,ENDPTR		;Get back delimiter
		PUSHJ P,NFL.DR		;Then, parse the directory
		JRST NFL.1]		;And loop for next field

	NOPARS(IFS)		;Must be bad syntax

; Here when delimiter was ";".  Parse an extension
NFL.6:	PUSHJ	P,NFL.EX	;Copy the file extension
	JRST	NFL.1		;Then loop for next field

; Here when  delimiter was a quote.  Could be a fully quoted file spec
;  or the access string following a node name
NFL.7:	MOVE	S1,BEGPTR	;Is this the beginning of field?
	IBP	S1
	CAME	S1,ENDPTR
	JRST	[PUSHJ P,NFL.ND		;No, so copy the node name
		LDB T1,ENDPTR		;Get back delimiter
		PUSHJ P,NFL.AC		;Then the access info
		JRST NFL.1]		;Then loop for next field

	PUSHJ	P,NFLQST	;Else a quoted filespec, copy as is
	ILDB	S1,XXXPTR	;Get next character
	SKIPN	S1		;Better be null
	JRST	NFL.2		;Yes, so finish off
	NOPARS(IFS)		;Syntax error

; Here when delimiter was null.  We may have a file name, extension,
;  or generation number.  After deciding and parsing it, go clean up.
NFL.8:	MOVE	S1,BEGPTR	;Is this the beginning of field?
	IBP	S1
	CAMN	S1,ENDPTR
	  JRST	NFL.2		;Yes, finish up

	SKIPN	PRSDNM		;No, Could be a file name?
	JRST	[PUSHJ P,NFL.NM		;Yes, copy copy it
		JRST NFL.2]		;And finish up

	SKIPN	PRSDEX		;Or, it could be file extension?
	JRST	[PUSHJ P,NFL.EX		;Yes, copy it
		JRST NFL.2]		;And finish up

	SKIPN	PRSDGN		;Or, it could be the generation number
	JRST	[PUSHJ P,NFL.GN		;Yes, copy it
		JRST NFL.2]		;And finish up

	NOPARS(IFS)		;Must be bad syntax
; Copy a node name from atom buffer to FD buffer
NFL.ND:	SKIPE	PRSDND		;Already seen one?
	 SKIPE	PRSDAC		;No, but if seen access string
	  CAIA			;All okay
	   JRST	NFLND1		;Not valid
	MOVEI	T2,NFLDND	;Break mask table
	PUSHJ	P,NFLCPY	;Copy to FD buffer
	  JRST	NFLND1		;Invalid systax
	SETOM	PRSDND		;Flag that we saw one
	POPJ	P,		;All done

NFLND1:	NOPARS(IND)

; Copy a access string from atom buffer to FD buffer
NFL.AC:	SKIPE	PRSDAC		;Already seen one?
	  JRST	NFLAC1		;Not valid
	MOVEI	T2,NFLDAC	;Break mask table
	MOVEI	S2,""""		;Get delimiter
	PUSHJ	P,NFLSTR	;Copy to FD buffer
	  JRST	NFLAC1		;Invalid systax
	SETOM	PRSDAC		;Flag that we saw one
	POPJ	P,		;All done

NFLAC1:	NOPARS(IAC)

; Copy a device name from atom buffer to FD buffer
NFL.DV:	SKIPE	PRSDDV		;Already seen one?
	  JRST	NFLDV1		;Not valid
	MOVEI	T2,NFLDDV	;Break mask table
	PUSHJ	P,NFLCPY	;Copy to FD buffer
	  JRST	NFLDV1		;Invalid systax
	SETOM	PRSDDV		;Flag that we saw one
	POPJ	P,		;All done

NFLDV1:	NOPARS(IDV)

; Copy a file name from atom buffer to FD buffer
NFL.NM:	SKIPE	PRSDNM		;Already seen one?
	  JRST	NFLNM1		;Not valid
	MOVEI	T2,NFLDNM	;Break mask table
	PUSHJ	P,NFLCPY	;Copy to FD buffer
	  JRST	NFLNM1		;Invalid systax
	SETOM	PRSDNM		;Flag that we saw one
	POPJ	P,		;All done

NFLNM1:	NOPARS(INA)

; Copy a extension from atom buffer to FD buffer
NFL.EX:	SKIPE	PRSDEX		;Already seen one?
	  JRST	NFLEX1		;Not valid
	MOVEI	T2,NFLDNM	;Break mask table
	PUSHJ	P,NFLCPY	;Copy to FD buffer
	  JRST	NFLEX1		;Invalid systax
	SETOM	PRSDEX		;Flag that we saw one
	POPJ	P,		;All done

NFLEX1:	NOPARS(IEX)

; Copy a generation number from atom buffer to FD buffer
NFL.GN:	SKIPE	PRSDGN		;Already seen one?
	  JRST	NFLGN1		;Not valid
	MOVEI	T2,NFLDGN	;Break mask table
	PUSHJ	P,NFLCPY	;Copy to FD buffer
	  JRST	NFLGN1		;Invalid systax
	SETOM	PRSDGN		;Flag that we saw one
	POPJ	P,		;All done

NFLGN1:	NOPARS(IGN)

; Copy a directory from atom buffer to FD buffer
NFL.DR:	SKIPE	PRSDDR		;Already seen one?
	  JRST	NFLDR1		;Not valid
	MOVEI	T2,NFLDDR	;Break mask table
	CAIN	T1,"["		;If delimiter was square bracket
	 SKIPA	S2,["]"]	;Scan to square bracket
	  MOVEI	S2,76		;Else scan to angle bracket
	PUSHJ	P,NFLSTR	;Copy to FD buffer
	  JRST	NFLDR1		;Invalid systax
	SETOM	PRSDDR		;Flag that we saw one
	POPJ	P,		;All done

NFLDR1:	NOPARS(IDR)
NFLDLM:	777777,,777760		;Break mask for filespec field delimiting
	100010,,001600		; Break on control characters and ":.;[
	000000,,000400
	000000,,000000

NFLDND:	777777,,777760		;Break mask for node name parsing
	777774,,000760		; Break on non-alphanumeric
	400000,,000760
	400000,,000760


NFLDAC:	777777,,777760		;Break mask for access string parsing
	000000,,000000		; Break on non-graphic characters
	000000,,000000
	000000,,000060

NFLDDV:	777777,,777760		;Break mask for device name parsing
	757774,,000760		; Break on NOT (alphanumeric or $_)
	400000,,000740
	400000,,000760

NFLDNM:	777777,,777760		;Break mask for file name/extention parsing
	747554,,001760		; Break on NOT (alphanumeric or -$_*%)
	400000,,000740
	400000,,000760

NFLDGN:	777777,,777760		;Break mask for generation parsing
	777574,,001760		; Break on non-numeric
	777777,,777760
	777777,,777760

NFLDDR:	777777,,777760		;Break mask for directory parsing
	747504,,001760		; Break on NOT (alphanumeric or .-$_*%)
	400000,,000740
	400000,,000760
; Copy a character to the FD buffer (if there is room)
NFLCHR:	SOSGE	FDFSIZ		;Room left?
	  POPJ	P,		;No, just return
	IDPB	S1,FDFPTR	;Append character to buffer
	POPJ	P,		;Return

; Copy a quoted string.  Terminated by NULL or ".
NFLQST:	ILDB	S1,XXXPTR	;Get next character
	JUMPE	S1,.POPJ	;If null, done
	CAIE	S1,""""		;Close quote?
	  JRST	[PUSHJ P,NFLCHR	;No, put in FD buffer
		JRST NFLQST]	;And loop
	MOVE	S1,XXXPTR	;Get pointer
	ILDB	S1,S1		;Get next character
	CAIE	S1,""""		;Another quote?
	  POPJ	P,		;No, done
	ILDB	S1,XXXPTR	;Yes, that means a single "
	PUSHJ	P,NFLCHR	;Put it in the FD buffer
	JRST	NFLQST		;And loop

; Copy a string until: 1) Delimiter seen, 2) Null character seen.
;
;	S2/ delimiter
;
; Returns CPOPJ if null seen before delimiter
;	  CPOPJ1 if delimiter seen
NFLSTR:	ILDB	S1,XXXPTR	;Get next character
	JUMPE	S1,.POPJ	;If null, return now
	PUSHJ	P,NFLCHR	;Put in FD buffer
	CAME	S1,S2		;Was it the delimiter we were looking for?
	JRST	NFLSTR		;No, loop
	JRST	.POPJ1		;Yes, skip return
	RETSKP

; Scan the Atom buffer for a break character.
;	T2/ address of break table
;
; Returns POPJ with T1 containing the break character, and XXXPTR
;  updated.
NFLSPN:	ILDB	S1,XXXPTR	;Get next character
	MOVE	T1,S1		;Save a copy
	IDIVI	S1,40		;Divide into word and bit number
	MOVE	S2,BITS(S2)	;Get bit mask
	ADD	S1,T2		;Address in break table
	TDNE	S2,(S1)		;Break character?
	  POPJ	P,		;Yes, return
	JRST	NFLSPN		;No, continue looking

; Copy from atom buffer (BEGPTR) to FD buffer until end of field (ENDPTR) or
;  break character.
;	T2/ address of break table
;
; Return POPJ if a break seen (character in T1), POPJ1 if ENDPTR reached
NFLCPY:	ILDB	S1,BEGPTR	;Get a character
	PUSHJ	P,NFLCHR	;Copy to FD buffer
	MOVE	S2,BEGPTR	;Get copy of byte pointer
	CAMN	S2,ENDPTR	;At end of field?
	  JRST	.POPJ1		;Yes, return
	MOVE	T1,S1		;Save copy of character
	IDIVI	S1,40		;Divide into word and bit number
	MOVE	S2,BITS(S2)	;Get bit mask
	ADD	S1,T2		;Address in break table
	TDNE	S2,(S1)		;Break character?
	  POPJ	P,		;Yes, return
	JRST	NFLCPY		;No, loop for more
;FILESPEC HELP

CMFHLP:	TXNE	F,CMINDF	;IS IT AN INDIRECT FILE?
	JRST	[HRROI	T1,[ASCIZ / filespec of indirect file/]
		JRST	CMFH1]	;SPECIAL HELP IF INDIRECT FILESPEC
	PUSHJ	P,DOHLP		;DO USER MESSAGE
	JXN	F,CM%SDH,CMRTYP	;SUPPRESS DEFAULT HELP IF REQUESTED
	LOAD	T2,.CMFNP(P1),CM%FNC	;GET FUNCTION CODE
	CAXE	T2,.CMIFI		;INPUT FILE?
	SKIPA	S1,[EXP [ASCIZ / output filespec/]] ;NO, OUTPUT
	MOVEI	S1,[ASCIZ \ input filespec\]	;YES,INPUT
CMFH1:	PUSHJ	P,CMDSTO
	JRST	CMRTYP

;TOKEN - ARBITRARY SYMBOL AS SPECIFIED BY FN DATA

XCMTOK:	MOVE	Q1,FNARG	;GET STRING ADDRESS
	TLC	Q1,-1		;TOPS20-style string pointer?
	TLCN	Q1,-1		; ..
	HRLI	Q1,(POINT 7,)	;Yes, fix up
	TXNN	F,CMDEFF	;USING DEFAULT STRING?
	  JRST	CMTOK1		;NO
	MOVE	Q2,Q1		;GET TOKEN POINTER IN Q2
	MOVE	Q1,.CMABP(P2)	;GET POINTER TO ATOM BUFFER (DEFAULT STRING)
XCMTK1:	ILDB	T1,Q2		;GET NEXT CHARACTER FROM TOKEN
	JUMPE	T1,XCOMXI	;SUCCESS IF END OF STRING
	ILDB	T2,Q1		;GET CHAR FROM DEFAULT STRING
	CAMN	T2,T1		;MATCH?
	JRST	XCMTK1		;YES, CONTINUE
	NOPARS	(NMT)		;NO, DOES NOT MATCH TOKEN
CMTOK1:	ILDB	Q2,Q1		;GET NEXT CHAR IN STRING
	JUMPE	Q2,[PUSHJ P,TIELCH	;SUCCESS IF END OF STRING
		JRST	FIXESC]
CMTOK2:	PUSHJ	P,CMCIN		;GET NEXT CHAR OF INPUT
	CAMN	T1,Q2		;MATCH?
	JRST	[PUSHJ	P,STOLCH	;YES, APPEND TO ATOM BUFFER
		JRST	CMTOK1]		;CONTINUE
	JXN	F,CM%ESC,CMAMB	;AMBIGUOUS
	CAIN	T1,CMHLPC	;HELP REQUEST?
	JRST	[PUSHJ	P,DOHLP		;YES
		JXN	F,CM%SDH,CMRTYP
		HRROI	S1,[ASCIZ / "/]
		PUSHJ	P,CMDSTO
		MOVE	S1,FNARG
		PUSHJ	P,CMDSTO
		MOVEI	S1,""""
		PUSHJ	P,CMDOUT
		JRST	CMRTYP]
	NOPARS	(NMT)		;Does not match token
SUBTTL	PATHIN	Routine to Parse TOPS-10 Path Specification

; PATHIN may be called to Parse a Path Specification in the Atom Buffer
; it builds a Path Block up to 6 words in length depending
; on the depth specified in T2 on the call.

; CALL	T1/ Byte Pointer to String
;	T2/ Length of Destination,,Destination Address

; Uses T1-T4 and XXXPTR

; Destination must not be an AC and Depth must be Less Than 6

; True Return is a Skip Return
;  With:	PPN and Path Stored Via Calling Arg in T2
;		XXXPTR Pointing to Terminating byte ("]") in String

; Error Return is a non skip Return

PATHIN:	ILDB	S1,T1		;LOAD FIRST BYTE
	CAIE	S1,"["		;MUST BE BRACKET
	POPJ	P,		;NO
	PUSHJ	P,.SAVE1	;SAVE P1
	HLRZ	P1,T2		;GET DESIRED LENGTH
	CAILE	P1,<FDXSIZ-.FDPPN> ;TOO LARGE?
	MOVEI	P1,<FDXSIZ-.FDPPN> ;YES--ADJUST A BIT
	MOVNS	P1		;NEGATE
	HRLZS	P1		;PUT IN LH
	HRRI	P1,(T2)		;POINT TO THE PPN STORAGE
	MOVE	S1,T1		;GET BYTE POINTER
	ILDB	S1,S1		;AND NEXT CHARACTER
	CAIE	S1,"-"		;DEFAULT PATH?
	JRST	PATH.1		;NO
	IBP	T1		;ADVANCE
	IBP	T1		;POINT PAST THE DASH
	MOVEM	T1,XXXPTR	;SAVE
	JRST	PATH.3		;ONWARD
PATH.1:	PUSHJ	P,PPNPRS	;PARSE PPN
	  POPJ	P,		;NO GOOD
	MOVEM	S1,XXXPTR	;SAVE IN CASE OF PPN FAILURE
	AOBJP	P1,PATH.3	;ADVANCE
PATH.2:	LDB	T1,S1		;GET TERMINATOR
	CAIE	T1,","		;SFD ON THE WAY?
	JRST	PATH.4		;NO
	MOVE	S1,XXXPTR	;GET BYTE POINTER
	PUSHJ	P,CNVSIX	;GET A SIXBIT WORD
	JUMPE	S2,.POPJ	;NULL SFDS ARE ILLEGAL
	MOVEM	S2,(P1)		;STORE SFD NAME
	MOVEM	S1,XXXPTR	;UPDATE BYTE POINTER
	AOBJN	P1,PATH.2	;YES--LOOP
PATH.3:	LDB	T1,XXXPTR	;GET TERMINATOR
PATH.4:	CAIE	T1,"]"		;END OF PATH?
	POPJ	P,		;NO
	JUMPGE	P1,PATH.5	;JUMP IF FULL SFD SPEC
	SETZM	(P1)		;CLEAR 'TILL END OF
	AOBJN	P1,.-1		; USER'S ARGUMENT BLOCK
PATH.5:	JRST	.POPJ1		;RETURN
; RDPPN
; Read PPN for this job into PPNWRD
RDPPN:	SETZM	PPNWRD		;CLEAR PPN WORD
	SETZM	PPNMSK		;CLEAR PPN MASK
	HRROI	S1,.GTPPN	;WANT PPN
	GETTAB	S1,		;GO AND GET IT
	  SETZ	S1,		;???
	MOVEM	S1,PPNWRD	;SAVE IT
	POPJ	P,0		;RETURN
; PARSE A USER ID (PPN)
; NOTE: SETTING CM%WLD AND GIVING THE ADDRESS OF A
;	TWO WORD ARGUMENT BLOCK WILL CAUSE THE PARSED
;	PPN AND MASK TO BE STORED IN SAID BLOCK.

XCMUSR:	PUSHJ	P,CMRPPN	;VALIDATE PPN STRING
	MOVEI	S1,[ASCIZ/[project,programmer]/]
	TXNE	F,CMQUES	;QUESTION MARK TYPED?
	PUSHJ	P,HELPER	;YES, GIVE HELP
	TXNN	F,CM%ESC	;ESCAPE TYPED?
	JRST	XUSR.1		;NO
	PUSHJ	P,CMDCH		;ALLOW ESCAPE AS TERMINATOR
	PUSHJ	P,TIELCH	;TERMINATE ATOM BUFFER WITH A NULL

XUSR.1:	MOVE	T1,.CMABP(P2)	;POINT TO ATOM
	MOVEI	T2,CRBLK+CR.RES	;POINT TO DESTINATION
	PUSHJ	P,PPNINP	;PARSE A POSSIBLY WILDCARDED PPN
	NOPARS	(IUS)		;INVALID USER SPECIFIED
	MOVE	T1,XXXPTR	;ENSURE ENTIRE ATOM WAS PARSED
	CAME	T1,ATBPTR	;BYTE POINTERS MUST BE THE SAME
	NOPARS	(IUS)		;INVALID USER SPECIFIED
	JRST	XCOMXI		;DONE NOW


CMRPPN:	PUSHJ	P,CMCIN		;GET THE FIRST CHARACTER OF INPUT
	CAIN	T1,CMHLPC	;IS IT THE HELP CHARACTER?
	JRST	[TXO	F,CMQUES	;YES, SAY WE NEED SOME HELP
		 POPJ	P,]		;TAKE THE ERROR (HELP) RETURN
	PUSHJ	P,CMDIP		;NO, JUST PUT IT BACK IN THE BUFFER
	MOVE	TF,FNARG	;GET FUNCTION ARGUMENTS
	MOVEI	T1,PPNBRK	;POINT TO NORMAL BREAK SET
	TXNE	TF,CM%WLD	;WANT WILDCARDING?
	MOVEI	T1,PPWBRK	;YES
	TXNE	TF,CM%WLA	;WANT WILDCARDING (ACCOUNTING-STYLE)?
	MOVEI	T1,PPABRK	;YES
	PUSHJ	P,CMRFLD	;READ FIELD
CMRPP1:	TXNE	F,CMQUES	;WANT HELP?
	POPJ	P,		;YES
	TXNE	F,CM%ESC!CMCFF	;RECOGNITION OF SOME SORT?
	JRST	CMRPP3		;YES
	PUSHJ	P,CMCIN		;GET TERMINATING CHARACTER
	CAIE	T1,"]"		;NORMAL ENDING?
	JRST	CMRPP2		;NO
	PUSHJ	P,STOLCH	;STORE BRACKET
	PUSHJ	P,CMCIN		;GET NEXT CHARACTER
	CAIN	T1,CMHLPC	;IS IT THE HELP CHARACTER?
	JRST	[TXO	F,CMQUES	;YES, SAY WE NEED HELP
		 POPJ	P,]		;TAKE THE ERROR (HELP) RETURN
	TXNN	F,CM%ESC!CMCFF	;RECOGNITION?
	PUSHJ	P,CMDIP		;NO--BACK UP OVER THE CHARACTER
	POPJ	P,		;RETURN
CMRPP2:	TXNN	F,CM%EOC	;EOL WITH NO TRAILING BRACKET?
	POPJ	P,		;NO
	MOVEI	T1,"]"		;GET TERMINATOR
	PUSHJ	P,STOLCH	;STORE IT
	PJRST	CMDIP		;BACKUP AND RETURN
CMRPP3:	PUSHJ	P,CMDIP		;BACKUP
	PUSHJ	P,CMCIN		;GET TERMINATING CHARACTER
	PUSH	P,T1		;SAVE CHARACTER
	PUSHJ	P,CMDCH		;DELETE THE RECOGNIZER
	MOVEI	T1,"]"		;GET OUR TERMINATOR
	PUSHJ	P,STOLCH	;STUFF IN ATOM BUFFER
	PUSHJ	P,CMDIB		;AND IN COMMAND BUFFER
	POP	P,T1		;GET BACK TERMINATOR
	PJRST	CMDIBQ		;STORE IN CMD BUFFER AND RETURN

; NORMAL PPN BREAK MASK
PPNBRK:	777777,,777760		;BREAK ON ALL CONTROL CHARACTERS
	777734,,001760		;BREAK ON PUNCTUATION, ALLOW , 0-9
	777777,,777360		;BREAK ON UC A-Z, ], ALLOW [
	777777,,777760		;BREAK ON LC A-Z

; WILDCARD PPN BREAK MASK
PPWBRK:	777777,,777760		;BREAK ON ALL CONTROL CHARACTERS
	777534,,001740		;BREAK ON PUNCTUATION, ALLOW * ? , 0-9
	777777,,777360		;BREAK ON UC A-Z, ], ALLOW [
	777777,,777760		;BREAK ON LC A-Z

; WILDCARD PPN (ACCOUNTING-STYLE) BREAK MASK
PPABRK:	777777,,777760		;BREAK ON ALL CONTROL CHARACTERS
	727534,,001740		;BREAK ON PUNCTUATION, ALLOW # % * ? , 0-9
	777777,,777360		;BREAK ON UC A-Z, ], ALLOW [
	777777,,777760		;BREAK ON LC A-Z

PPNINP:	ILDB	S1,T1		;LOAD FIRST BYTE
	CAIN	S1,"["		;MUST BE BRACKET
	PUSHJ	P,PPNPRS	;PARSE PPN
	  POPJ	P,		;NO GOOD
	MOVEM	S1,XXXPTR	;STORE UPDATED POINTER
	LDB	S1,S1		;GET TERMINATOR
	CAIE	S1,"]"		;END OK?
	POPJ	P,		;NO
	TXNE	F,CMDEFF	;WAS FIELD DEFAULTED?
	IBP	XXXPTR		;YES--UPDATE BYTE POINTER
	MOVE	T1,(T2)		;RECLAIM PPN
	MOVE	S1,FNARG	;GET FUNCTION SPECIFIC ARGUMENT WORD
	TXNN	S1,CM%WLD!CM%WLA ;WANT WILDCARD MASK?
	JRST	.POPJ1		;NO
	HRRZS	S1		;KEEP ONLY THE ADDRESS
	CAIG	S1,17		;IN THE ACS?
	$RETE	(NCI)		;LOSER
	MOVE	S2,PPNMSK	;GET MASK
	MOVEM	T1,0(S1)	;SAVE PPN WORD
	MOVEM	S2,1(S1)	;SAVE PPN MASK
	JRST	.POPJ1		;RETURN


; ROUTINE TO PARSE A PPN
; NOTE:	THIS DOESN'T HANDLE BRACKETS, ONLY PROJ#,PROG#
PPNPRS:	PUSHJ	P,RDPPN		;GET CURRENT PPN
	MOVEM	T1,XXXPTR	;SAVE IN CASE OF PPN FAILURE
	MOVE	S1,T1		;GET THE POINTER
	ILDB	T1,T1		;GET FIRST CHARACTER
	CAIN	T1,"#"		;NEVER VALID ON PROJECT NUMBER
	POPJ	P,		;GIVE UP
	PUSHJ	P,OCTWLD	;GET PROJECT NUMBER
	SKIPT			;ANYTHING PARSED?
	HLL	S2,PPNWRD	;USE DEFAULT
	PUSHJ	P,PPNZER	;WAS A ZERO TYPED?
	  POPJ	P,		;PROJECT ZERO ILLEGAL
	HLLM	S2,(T2)		;SAVE PROJECT NUMBER
	HRLM	S2,PPNMSK	;SAVE MASK
	LDB	T1,S1		;GET TERMINATOR
	CAIE	T1,","		;MUST BE COMMA
	POPJ	P,0		;FAIL -- PPN NOT NUMERIC
	PUSHJ	P,OCTWLD	;GET PROGRAMMER NUMBER
	SKIPT			;ANYTHING PARSED?
	HRL	S2,PPNWRD	;USE DEFAULT
	PUSHJ	P,PPNZER	;WAS A ZERO TYPED?
	  POPJ	P,		;PROGRAMMER ZERO ILLEGAL
	HLRM	S2,0(T2)	;SAVE PROGRAMMER NUMBER
	HRRM	S2,PPNMSK	;SAVE MASK
	JRST	.POPJ1		;RETURN


; CHECK FOR A SINGLE ZERO BEING TYPED
PPNZER:	TRNN	S2,-1		;WAS AT LEAST ONE NON-WILD DIGIT TYPED?
	SKIPA			;NO
	TLNE	S2,-1		;WAS A ZERO TYPED?
	AOS	(P)		;NO
	POPJ	P,		;RETURN


; INPUT A POSSIBLY WILD OCTAL HALF-WORD QUANTITY
; ON RETURN, S1 = TERMINATING BYTE POINTER, S2 = NUMBER,,MASK

OCTWLD:	PUSHJ	P,.SAVE1	;SAVE P1
	MOVE	P1,S1		;COPY BYTE POINTER
	MOVEI	S2,777777	;CLEAR RESULT AND INIT MASK
	ILDB	S1,P1		;GET A CHARACTER
	CAIN	S1,"%"		;ALL PROGRAMMER NUMBERS?
	JRST	OCTW.6		;YES
	CAIN	S1,"#"		;DEFAULT PROGRAMMER NUMBER?
	JRST	OCTW.5		;YES
	CAIN	S1,"*"		;ALL DIGITS WILD?
	JRST	OCTW.4		;YES
	CAIN	S1,"?"		;WILD DIGIT?
	JRST	OCTW.3		;YES
	CAIL	S1,"0"		;RANGE CHECK
	CAILE	S1,"7"		; FOR AN OCTAL DIGIT
	SKIPA			;NOTHING PARSED
	JRST	OCTW.2		;ONWARD
	MOVE	S1,P1		;GET UPDATED BYTE POINTER
	$RETF			;AND RETURN

OCTW.1:	ILDB	S1,P1		;GET A CHARACTER
	CAIN	S1,"?"		;WILD DIGIT?
	JRST	OCTW.3		;YES
	CAIL	S1,"0"		;RANGE CHECK
	CAILE	S1,"7"		; FOR AN OCTAL DIGIT
	JRST	OCTW.7		;NO GOOD--FINISH UP

OCTW.2:	TDZ	S2,[700000,,700000] ;PREVENT OVERFLOW
	LSH	S2,3		;SHIFT RESULT AND MASK
	SUBI	S1,"0"		;CONVERT ASCII TO OCTAL
	TLO	S1,7		;GET MASK
	TSO	S2,S1		;INCLUDE DIGIT AND MASK
	JRST	OCTW.1		;LOOP

OCTW.3:	TDZ	S2,[700000,,700000] ;PREVENT OVERFLOW
	LSH	S2,3		;SHIFT RESULT AND MASK
	TLO	S2,7		;DIGIT WAS WILD
	JRST	OCTW.1		;LOOP FOR ANOTHER DIGIT

OCTW.4:	ILDB	S1,P1		;ADVANCE BYTE POINTER
	MOVEI	S2,0		;SET FULL WILDCARD MASK
	JRST	OCTW.7		;FINISH UP

OCTW.5:	SKIPA	S2,[-2,,-1]	;SET RESULT AND MASK FOR [10,#]
OCTW.6:	MOVNI	S2,1		;SET RESULT AND MASK FOR [10,%]
	ILDB	S1,P1		;ADVANCE BYTE POINTER

OCTW.7:	MOVE	S1,P1		;GET UPDATED BYTE POINTER
	$RETT			;RETURN
; DIRECTORY
XCMDIR:	PUSHJ	P,CMRPTH	;GET PATH SPEC INTO ATOM
	MOVEI	S1,[ASCIZ/[path]/] ;HELP TEXT
	TXNE	F,CMQUES	;QUESTION MARK TYPED?
	PUSHJ	P,HELPER	;YES, GIVE HELP
	TXNN	F,CM%ESC	;ESCAPE TYPED?
	JRST	XDIR.1		;NO
	PUSHJ	P,CMDCH		;ALLOW ESCAPE AS TERMINATOR
	PUSHJ	P,TIELCH	;TERMINATE ATOM BUFFER WITH A NULL


XDIR.1:	MOVE	T1,.CMABP(P2)	;POINT TO ATOM
	SKIPN	T2,FNARG	;GET POSSIBLE ADDRESS OF BLOCK TO STORE PATH
	MOVEI	T2,CRBLK+CR.RES	;POINT TO DESTINATION IF STORING PPN ONLY
	HRRZM	T2,CRBLK+CR.RES	;SAVE PTR TO RESULT (MAYBE OVERWRIT W/PPN)
	HRLI	T2,<FDXSIZ-.FDPPN> ;AND SET MAXIMUM SFD DEPTH
	PUSHJ	P,PATHIN	;PARSE PATH
	  SKIPA			;FAILED
	JRST	XDIR.2		;ONWARD
	PUSHJ	P,TIELCH	;TIE OFF ATOM BUFFER FOR CLEAN ERROR TEXT
	NOPARS	(IPS)		;INVALID PATH SPECIFICATION

XDIR.2:	MOVE	T1,XXXPTR	;ENSURE ENTIRE ATOM WAS PARSED
	CAME	T1,ATBPTR	;BYTE POINTERS MUST BE THE SAME
	NOPARS	(IPS)		;INVALID PATH SPECIFICATION
	JRST	XCOMXI		;DONE NOW
;COMMA, ARBITRARY CHARACTER

XCMCMA:	MOVEI	T1,","		;SETUP COMMA AS CHARACTER TO FIND
	MOVEM	T1,FNARG
CMCHR:	PUSHJ	P,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
	JXN	F,CM%ESC,CMAMB		;AMBIGUOUS
	CAIN	T1,CMHLPC	;HELP?
	JRST	[PUSHJ	P,DOHLP
		JXN	F,CM%SDH,CMRTYP ;JUMP IF SUPPRESSING HELP
		MOVEI	S1,""""		;TYPE "char"
		PUSHJ	P,CMDOUT
		HRRZ	S1,FNARG
		PUSHJ	P,CMDOUT
		MOVEI	S1,""""
		PUSHJ	P,CMDOUT
		JRST	CMRTYP]
	NOPARS	(CMA)		;Not a comma
;DATE AND/OR TIME
;FLAGS IN ARG SPECIFY WHICH

XCMTAD:	MOVE	Q1,FNARG	;GET ARG
	MOVEI	T1,DAYBRK	;POINT TO DATE BREAK SET
	TXNE	Q1,CM%IDA	;WANT A DATE?
	PUSHJ	P,CMRFLD	;YES..READ DATE FIELD
	JXN	F,CMQUES,CMTADH	;DO HELP IF REQUESTED
	JXN	F,CMDEFF,CMTAD1	;JUMP IF NOW HAVE FIELD DEFAULT
	JXN	F,CM%ESC,CMAMB	;DING IF ESCAPE WAS TYPED
	TXNN	Q1,CM%ITM	;WANT THE TIME?
	JRST	CMTAD1		;NO..PROCEED
	TXNN	Q1,CM%IDA	;Did we parse a date also?
	 JRST	CMTAD2		; No, it was just time
	PUSHJ	P,CMCIN		; Get the break character
	CAIN	T1,":"		; Was it a colon?
	 JRST	CMTAD0		; Yes, go put it back
	MOVEI	T1," "		; Make sure it was a space
	PUSHJ	P,STOLCH	;  .  .  . that ended the field
CMTAD0:	PUSHJ	P,CMDIP		; Put the break character back
CMTAD2:	MOVEI	T1,TIMBRK	;POINT TO TIME BREAK SET
	PUSHJ	P,CMRFLD	;READ THE FIELD
	JXN	F,CMQUES,CMTADH ;DO HELP
	JXN	F,CM%ESC,CMAMB	;DING IF ESCAPE WAS TYPED
CMTAD1:	MOVE	S1,.CMABP(P2)	;POINT TO THE ATOM
	MOVE	S2,FNARG	;GET THE FLAGS
	PUSHJ	P,XDATIM	;GET PROPER ARGS
	MOVE	T1,S1		;GET POSSIBLE ERROR CODE
				;OR UPDATED POINTER
	JUMPF	XCOMNE		;PROCESS ERROR IF ANY
	LDB	T1,T1		;GET THE TERMINATING BYTE
	SKIPE	T1		;MUST BE A NULL
	 NOPARS(IDT)		;ELSE INVALID DATE/TIME
	MOVEM	S2,CRBLK+CR.RES	;STORE RESULT
	JRST	XCOMXR

;TIME/DATE HELP
CMTADH:	PUSHJ	P,DOHLP		;DO USER TEXT
	JXN	F,CM%SDH,CMRTYP	;CHECK SUPPRESS DEFAULT
	LOAD	T1,Q1,<CM%IDA+CM%ITM> ;GET FLAGS
	MOVE	S1,[[ASCIZ //]
		    [ASCIZ / time/]
		    [ASCIZ / date/]
		    [ASCIZ / date and time/]](T1)
	PUSHJ	P,CMDSTO	;PRINT APPROPRIATE MESSAGE
	JRST	CMRTYP


DAYBRK:	777777,,777760		;Break on all control
	777654,,001760		;Allow + - 0-9
	400000,,000760		;Allow A-Z
	400000,,000760		;Allow a-z

TIMBRK:	777777,,777760		;Break on all control
	777774,,000760		;Allow 0-9 and :
	777777,,777760		;Break on A-Z
	777777,,777760		;Break on a-z

;LOCAL ROUTINE TO SETUP BYTE PTR TO TABLE STRING AND GET FLAGS
; T2/ ADDRESS OF STRING
;	PUSHJ	P,CHKTBS
; T1/ FLAGS
; T2/ BYTE POINTER TO STRING

CHKTBS:	HRLI	T2,(POINT 7)	;SETUP P AND S FIELDS
	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
	POPJ	P,0


>  ;END TOPS10 CONDITIONAL
	SUBTTL	CMDOUT	--	CHARACTER OUTPUT FOR TERMINALS AND FILES

	;THIS ROUTINE WILL DUMP A CHARACTER TO THE TERMINAL OR A FILE
	;DEPENDING ON THE JFN IN THE TEXTI ARGUMENT BLOCK

IFN	FTUUOS,<
CMDOUT:	HRRZ	S2,JFNWRD		;GET OUTPUT JFN
	CAXN	S2,.NULIO		;NULL?
	  $RETT				;JUST IGNORE IT
	CAXN	S2,.PRIOU		;PRIMARY OUTPUT TERMINAL?
	  PJRST	K%BOUT			;OUTPUT IT
	MOVE	S2,S1			;GET THE CHARACTER
	HRRZ	S1,JFNWRD		;GET THE OUTPUT JFN
	PUSHJ	P,F%OBYT		;DUMP THE CHARACTER
	JUMPT	.POPJ			;O.K.. RETURN
	$TEXT	(T%TTY,<^M^J?File Output Failed  ^E/[-1]/>)
	TXO	F,CM%NOP		;RETURN FAILURE, NO CHECK ALTERNATIVES
	JRST	XCOMX2

	SUBTTL	CMDSTO	--	STRING OUTPUT TO FILE AND TERMINAL

	;This routine will check the output JFN and pass the data to
	;the file, terminal or null

CMDSTO:	HRRZ	S2,JFNWRD		;GET OUTPUT JFN
	CAXN	S2,.NULIO		;NULL?
	  $RETT				;JUST RETURN
	CAXN	S2,.PRIOU		;PRIMARY OUTPUT?
	  PJRST	K%SOUT			;YES.. DUMP THE STRING
	MOVE	T1,S1			;GET THE STRING POINTER
STRO.1:	ILDB	S1,T1			;GET A BYTE
	JUMPE	S1,.RETT		;RETURN TRUE
	PUSHJ	P,CMDOUT		;DUMP THE CHARACTER
	JRST 	STRO.1			;GET NEXT ONE
>;END FTUUOS
SUBTTL S%SCMP  --  String Comparison Routine

;CALL IS:	 S1/ TEST STRING POINTER
;		 S2/ BASE STRING POINTER
;TRUE RETURN:	  S1/ 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
;		S2/ UPDATED BASE STRING POINTER, USEFUL IN CASE TEST STRING
;	WAS SUBSET

TOPS20 <
S%SCMP:	STCMP				;DO THE JSYS
	$RETT				;AND RETURN
>  ;END TOPS20 CONDITIONAL

TOPS10 <
S%SCMP:	PUSHJ	P,.SAVET		;SAVE T REGS
	DMOVE	T1,S1			;COPY ARGUMENTS
	HLRZ	T3,T1
	CAIN	T3,-1
	HRLI	T1,(POINT 7)
	HLRZ	T3,T2
	CAIN	T3,-1
	HRLI	T2,(POINT 7)
	PUSHJ	P,USTCMP	;DO THE WORK
	DMOVE	S1,T1			;PUT THE ARGUMENTS BACK
	$RETT


;STILL IN TOPS10 CONDITIONAL
;STRING COMPARE ROUTINE - REFERENCES PREVIOUS CONTEXT.
; T1/ TEST STRING POINTER
; T2/ BASE STRING POINTER
;	PUSHJ	P,USTCMP
;RETURN AS FOR .STCMP

USTCMP::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]
	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.
	POPJ	P,0		;RETURN 0

STRC2:	JUMPE	T3,[MOVX T1,SC%SUB 	;TEST STRING ENDED, IS A SUBSET
		ADD	T2,[7B5] 	;DECREMENT BASE POINTER ONE BYTE
		POPJ	P,0]
	CAMG	T3,T4		;STRINGS UNEQUAL
	SKIPA	T1,[SC%LSS]	;TEST STRING LESS
	MOVX	T1,SC%GTR	;TEST STRING GREATER
	POPJ	P,0
>  ;END TOPS10 CONDITIONAL
SUBTTL S%TBLK  --  Table lookup routine


;CALL IS:	S1/ ADDRESS OF TABLE HEADER WORD
;		S2/ STRING POINTER TO STRING TO BE FOUND
;
;TRUE RETURN:	 S1/ ADDRESS OF ENTRY WHICH MATCHED OR WHERE ENTRY WOULD BE
;		IF IT WERE IN TABLE
;		  S2/ RECOGNITION CODE:
;	1B0 (TL%NOM) - NO MATCH
;	1B1 (TL%AMB) - AMBIGUOUS
;	1B2 (TL%ABR) - UNIQUE ABBREVIATION
;	1B3 (TL%EXM) - EXACT MATCH

TOPS20 <
S%TBLK:	PUSH	P,T1			;SAVE T1
	TBLUK				;DO THE JSYS
	POP	P,T1			;RESTORE T1
	$RETT				;AND RETURN
>   ;END TOPS20 CONDITIONAL

TOPS10 <
S%TBLK:	PUSHJ	P,.SAVET		;SAVE SOME REGISTERS
	DMOVE	T1,S1			;COPY INPUT ARGUMENTS
	PUSHJ	P,XTLOOK		;DO THE WORK
	DMOVE	S1,T1			;RE-COPY ARGUMENTS
	$RETT				;AND RETURN
;WORKER ROUTINE - MAY BE CALLED INTERNALLY.
; RETURNS +1 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::PUSHJ	P,.SAVE4	;PRESERVE ACS
	$SAVE	P5
	HLRZ	T3,T2		;CHECK STRING POINTER
	CAIE	T3,-1		;LH 0 OR -1?
	CAIN	T3,0
	HRLI	T2,(POINT 7)	;YES, FILL IN
	MOVEM	T2,STRG
	MOVEI	P2,1(T1)	;CONSTRUCT ADDRESS OF FIRST ENTRY
	HRLI	P2,P1		;MAKE IT INDEXED BY P1
	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:	HLRZ	T2,@P2		;GET STRING ADR FROM TABLE
	PUSHJ	P,CHKTBS	;CONSTRUCT POINTER
	MOVE	T1,STRG		;GET TEST STRING
	PUSHJ	P,USTCMP	;COMPARE
	JUMPN	T1,TABLK1	;JUMP IF NOT EXACTLY EQUAL
TABLKF:	HLRZ	T2,@P2		;GET STRING ADDRESS
	PUSHJ	P,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
	POPJ	P,
;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
	HLRZ	T2,-1(T1)	;GET ITS STRING ADDRESS
	PUSHJ	P,CHKTBS	;BUILD BYTE PTR
	MOVE	T1,STRG		;GET TEST STRING
	PUSHJ	P,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
	HLRZ	T2,1(T1)	;GET STRING ADR OF NEXT ENTRY
	PUSHJ	P,CHKTBS	;BUILD BYTE PTR
	MOVE	T1,STRG		;GET TEST STRING
	PUSHJ	P,USTCMP	;COMPARE NEXT LOWER ENTRY
	JUMPE	T1,[$STOP(BTF,Bad table format)] ;EXACT MATCH,TABLE IS BAD
	JXN	T1,SC%SUB,TABLKM ;NEXT ENTRY NOT DISTINCT, DO AMBIG RETURN
TBLK2A:	HLRZ T2,@P2		;CHECK FLAGS FOR THIS ENTRY
	PUSHJ	P,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
>  ;END TOPS10 CONDITIONAL
	SUBTTL	S%TBAD	--	Table Add Routine

;THIS ROUTINE IS DESIGNED TO ADD AN ENTRY TO A COMMAND
;TABLE AND IS CALLED WITH THE FOLLOWING INFO
;
; CALL WITH:	S1/	FLAG!ADDRESS OF TABLE HEADER
;		S2/	ADDRESS OF ENTRY TO BE ADDED
;
;	FLAG MAY BE TB%ABR - TABLE CONTAINS ABBREVIATIONS
;
;
; RETURNS TRUE:	S1/	ADDRESS IN TABLE OF NEW ENTRY IN AC1
;
; RETURNS FALSE:	S1/	ERROR CODE
;
;POSSIBLE ERRORS:	ERTBF$ -- TABLE IS FULL
;			EREIT$	-- ENTRY ALREADY IN TABLE
;
;

TOPS20 <
S%TBAD:	TBADD				;DO THE JSYS
	ERJMP	TBAD.1			;TRAP THE ERROR JUMP
	$RETT				;RETURN TRUE
TBAD.1:	MOVEI	S1,.FHSLF		;GET THE LAST ERROR
	GETER				;GET THE LAST ERROR
	HRRZ	S2,S2			;GET JUST THE CODE
	MOVEI	S1,EREIT$		;ENTRY ALREADY IN TABLE
	CAIN	S2,TADDX1		;WAS IT TABLE IS FULL
	MOVEI	S1,ERTBF$		;TABLE IS FULL
	$RETF
>;END TOPS20 CONDITIONAL


TOPS10 <
S%TBAD:	PUSHJ	P,.SAVET		;SAVE THE T REGS
	MOVEM	S1,TBADDR		;SAVE TABLE ADDRESS
	MOVEM	S2,ENTADR		;SAVE ENTRY ADDRESS
	HLRZ	T2,S2			;GET A COPY OF STRING ADDRESS
	PUSHJ	P,CHKTBS		;GET POINTER TO START OF STRING
	TXZ	S1,TB%ABR		;DELETE ABBREVIATION FLAG FOR S%TBLK
	MOVE	S2,T2			;SET UP FOR CALL TO S%TBLK
	PUSHJ	P,S%TBLK		;CHECK FOR ENTRY IN TABLE
	TXNE	S2,TL%EXM		;ENTRY IN TABLE
	$RETE(EIT)			;ENTRY ALREADY IN TABLE

		;S1 ADDRESS WHERE TO PLACE THE ENTRY

	MOVE	S2,TBADDR		;GET ADDRESS OF TABLE
	TXZ	S2,TB%ABR		;DELETE ABBREVIATION FLAG (IFIW)
	HLRZ	T2,0(S2)		;GET NUMBER OF ENTRIES IN USE
	AOS	T2			;BUMP THE COUNT
	HRRZ	T1,0(S2)		;GET THE TABLE SIZE
	CAMLE	T2,T1			;ROOM IN TABLE
	$RETE(TBF)			;TABLE IS FULL
	HRLM	T2,0(S2)		;UPDATE THE ENTRY COUNT
	ADD	T2,S2			;COMPUTE NEW END OF TABLE
TBAD.1:	CAML	S1,T2			;AT HOLE:
	JRST	[ MOVE	T1,ENTADR	;YES..INSERT THE ENTRY
		MOVEM	T1,0(S1)	;PLACE IN TABLE
		MOVE	T2,TBADDR	;GET ADR OF TABLE (AND FLAGS)
		TXNE	T2,TB%ABR	;ABRV'S PRESENT?
		PUSHJ	P,TAADJ		;YES, ADJUST THE TABLE
		$RETT]			;RETURN TRUE
	MOVE	T1,-1(T2)		;MOVE TABLE TO CREATE HOLE
	MOVEM	T1,0(T2)		;PLACE IN NEW LOCATION
	SOJA	T2,TBAD.1		;CHECK NEXT ENTRY
>;END TOPS10 CONDITIONAL
	SUBTTL	S%TBDL	--	Table Delete Routine

;THIS ROUTINE IS DESIGNED TO DELETE AN ENTRY TO A COMMAND
;TABLE AND IS CALLED WITH THE FOLLOWING INFO
;
; CALL WITH:	S1/	FLAG!ADDRESS OF TABLE HEADER
;		S2/	ADDRESS OF ENTRY TO BE DELETED
;
;	FLAG MAY BE TB%ABR - TABLE CONTAINS ABBREVIATIONS
;
;
; RETURNS TRUE:	S1/	ADDRESS IN TABLE OF NEW ENTRY IN AC1
;
; RETURNS FALSE:	S1/	ERROR CODE
;
;POSSIBLE ERRORS:	ERTBF$ -- TABLE IS FULL
;			ERITE$	-- INVALID TABLE ENTRY
;
;

TOPS20 <
S%TBDL:	TBDEL				;DO THE JSYS
	ERJMP	TBDL.1			;TRAP THE ERROR JUMP
	$RETT				;RETURN TRUE
TBDL.1:	MOVEI	S1,.FHSLF		;GET THE LAST ERROR
	GETER				;GET THE LAST ERROR
	HRRZ	S2,S1			;GET JUST THE CODE
	MOVX	S1,ERTBF$		;TABLE IS FULL
	CAIN	S2,TDELX2		;ENTRY ALREADY IN TABLE
	MOVX	S1,ERITE$		;ENTRY ALREADY IN TABLE
	$RETF
>;END TOPS20 CONDITIONAL



TOPS10 <
S%TBDL:	TXNN	S1,TB%ABR		;GOT ABBREVIATIONS IN TABLE?
	 JRST	TBDEL1			;NO, NOT MUCH TO DO
	PUSHJ	P,CHKABR		;YES, IS THIS ENTRY AN ABBREVIATION
	 PUSHJ	P,REMABR		;NO, REMOVE ANY OF IT'S ABBREVIATIONS

TBDEL1:	PUSHJ	P,.SAVET		;SAVE THE T REGS
	STKVAR	<TBA0,ENT>
	MOVEM	S1,TBA0
	MOVEM	S2,ENT
	TXZ	S1,TB%ABR		;DON'T NEED FLAGS (EXT ADDR)
	HLRZ	T2,0(S1)		;GET USED COUNT
	MOVE	T1,T2			;PLACE IN T1
	SOSGE	T1			;DECREMENT..SKIP IF NOT ZERO
	$RETE(TBF)			;FALSE RETURN..TABLE IS FULL
	ADD	T2,S1			;COMPUTE END OF TABLE
	CAILE	S2,(S1)			;ENTRY IN TABLE
	CAMLE	S2,T2			;MAKE SURE
	$RETE(ITE)			;INVALID TABLE ENTRY
	HRLM	T1,0(S1)		;SAVE COUNT
	JUMPE	T1,TBDL.1		;TABLE EMPTY
	HRLI	S2,1(S2)		;COMPACT TABLE
	BLT	S2,-1(T2)		;MOVE THE TABLE
TBDL.1:	SETZM	0(T2)			;CLEAR EMPTY WORD AT END
	MOVE	S1,ENT			;GET ENTRY WE'RE DELETING
	MOVE	S2,TBA0			;AND START OF TABLE
	TXNE	S2,TB%ABR		;GOT ABBREVIATIONS?
	 PUSHJ	P,TDADJ			;YES, ADJUST OLD POINTERS
	$RETT				;RETURN TRUE

	ENDSV.
;REMOVE ANY ABBREVIATIONS FOR THIS KEYWORD
;	S1/ADDRESS OF TABLE HEADER WORD
;	S2/ADDRESS OF ENTRY WE DELETED
;
;RETURNS:
;	S2/ NEW ADDRESS OF ENTRY AFTER IT'S ABREVIATIONS WERE REMOVED

REMABR:	$SAVE	<S1,T1,T2>
	STKVAR	<TBA0,TBSLOT,TB3,TB4>
	MOVEM	S1,TBA0
	MOVEM	S2,TBSLOT
	MOVEM	T1,TB3
	MOVEM	T2,TB4
	TXZ	S1,TB%ABR
	HLRZ	T1,0(S1)		;GET NUMBER OF ENTRIES IN USE
	ADD	T1,S1			;COMPUTE END OF USED TABLE SPACE
	MOVEI	T2,1(S1)		;GET ADDRESS AFTER HEADER WORD
REMADJ:	CAMLE	T2,T1			;END OF TABLE?
	 JRST	REMAD2			;YES, DONE
	MOVE	S2,T2			;GET ADDRESS OF CURRENT ENTRY
	PUSHJ	P,CHKABR		;DOUBLE CHECK ENTRY, IS IT AN ABBREV?
	 JRST	REMAD1			;NO, DO NOTHING WITH IT
	HRRZ	S2,0(T2)		;GET DATA PORTION OF THIS ENTRY
	CAME	S2,TBSLOT		;MATCH ADDR OF ENTRY WE'RE CHECKING?
	 JRST	REMAD1			;NO
	MOVE	S1,TBA0			;TM%ABR+ADDRESS
	MOVE	S2,T2			;THIS ENTRY - DELETE IT
	PUSHJ	P,TBDEL1		;DELETE THIS ABBREVIATION
	SOS	TBSLOT			;THE SLOT HAS MOVED
					;(ABRV MUST PRECEED FULLWORD IN TABLE)
	SOJA	T1,REMADJ		;AS HAS THE END OF THE TABLE.  LOOP.

REMAD1:	AOJA	T2,REMADJ		;TRY NEXT

REMAD2:	MOVE	S2,TBSLOT		;RETURN NEW ADDRESS
	ENDSV.

;CHECK CURRENT ENTRY TO SEE IF IT'S AN ABBREVIATION
;	S2/KEYWORD TO CHECK
;RETURN:
;	NON-SKIP		;NOT
;	SKIP			;IS

CHKABR:	$SAVE	<S1>
	HLRZ	S1,0(S2)		;GET ADDRESS OF ENTRY
	SKIPE	S1,0(S1)		;CHECK FIRST WORD OF STRING
	 TXNE	S1,177B6		;FIRST CHAR 0 AND WORD NOT ALL 0
	$RET				;NOT AN ABBREVIATION - NO FLAGS
	TXNE	S1,CM%ABR		;ABBREVIATION?
	 AOS	(P)			;YES
	$RET				;DONE
;TABLE ADJUSTMENT ROUTINES
;HANDLES INCREMENTING (ADD) OR DECREMENTING (DELETE) POINTERS TO KEYWORDS
;FOR ABBREVIATED KEYWORDS
;
;CALL WITH S1/ADDRESS OF SLOT BEING PROCESSED
;	   S2/START OF TABLE ADDRESS
;
;	PUSHJ	P,TDADJ			;TBDEL
;	PUSHJ	P,TAADJ			;TBADD

TAADJ:	TDZA	T1,T1			;MARK AS ADDING
TDADJ:	 SETO	T1,			;MARK AS DELETING
	$SAVE	<S1,S2,T1,T2>
	STKVAR	<TBSLOT,TBA0,TBFLAG>
	MOVEM	S1,TBSLOT
	MOVEM	S2,TBA0
	MOVEM	T1,TBFLAG
	TXZ	S2,TB%ABR		;CLEAR IFIW
	HLRZ	T2,0(S2)		;GET NUMBER OF ENTRIES IN USE
	ADD	T2,S2			;COMPUTE END OF USED TABLE SPACE
TBADJ1:	AOS	S2			;POINT AT NEXT ENTRY
	CAMLE	S2,T2			;END OF TABLE?
	 $RET				;YES, DONE
	HLRZ	S1,0(S2)		;GET ADDRESS OF ENTRY
	SKIPE	T1,0(S1)		;CHECK FIRST WORD OF STRING
	TXNE	T1,177B6		;FIRST CHAR 0 AND WORD NO ALL-0?
	 JRST	TBADJ1			;NOT AN ABBREVIATION, TRY NEXT ENTRY
	TXNN	T1,CM%ABR		;CHECK SOME MORE, ABBREVIATION FLAG?
	 JRST	TBADJ1			;NO
	HRRZ	S1,0(S2)		;YES, GET DATA (POINTER TO FULL WD)
	CAMGE	S1,TBSLOT		;DOES CHANGE MATTER?
	 JRST	TBADJ1			;NO
	SKIPE	TBFLAG			;ADDING OR DELETING?
	 SOSA	0(S2)			;DELETING, DECREMENT POINTER
	AOS	0(S2)			;ADDING, INCREMENT POINTER
	JRST	TBADJ1			;TRY NEXT ENTRY
	ENDSV.
>;END TOPS10 CONDITIONAL
SUBTTL	CNTDT,CNVDT DATE/TIME CONVERSION ROUTINES


;CNTDT	CONVERTS UDT TO TWO WORD DATE/TIME

;ACCEPTS	S1/	UDT

;RETURNS	S1/ TIME IN MILLISECONDS
;		S2/ DATE IN SYSTEM FORMAT


S%U2DT:
CNTDT::	PUSHJ	P,.SAVET	;SAVE THE TEMPS WE USE
	MOVE	T1,S1		;PUT UDT IN S1
	PUSHJ	P,.CNTDT	;CONVERT IT
	DMOVE	S1,T1		;RETURN SECONDS SINCE MIDNIGHT
	$RETT			;AND DATE IN SYSTEM FORMAT


;CNVDT	CONVERTS TWO WORD DATE/TIME TO UDT

;ACCEPTS	S1/ TIME IN MILLISECONDS
;		S2/ DATE IN SYSTEM FORMAT

;RETURNS	S1/	UDT

S%DT2U:
CNVDT::	PUSHJ	P,.SAVET	;SAVE THE TEMPS WE USE
	DMOVE	T1,S1		;GET SECONDS AND DATE
	PUSHJ	P,.CNVDT
	MOVE	S1,T1		;RETURN THE UDT
	$RETT
SUBTTL	XDATIM	DATE/TIME PARSING ROUTINES FOR TOPS10

;DEFINE SPECIAL ACs REQUIRED BY THESE ROUTINES


	C==13			;LAST CHARACTER AC
	N==14			;THE RESULT GOES HERE
	E==15			;NOT USED
      .FP==16			;FRAME POINTER



;XDATIM	CONVERTS AN ASCII STRING TO INTERNAL FORMAT DATE (UDT)

;ACCEPTS	S1/ POINTER TO ASCII STRING
;		S2/ (CM%IDA!CM%ITM!CM%NCI+Address)


;RETURNS TRUE	S1/ UPDATED POINTER
;		S2/	UDT

;	 FALSE	S1/  ERROR CODE


XDATIM:	$SAVE	<C,N,E,.FP>	;SAVE SPECIAL REGS
	MOVEM	P,.FP		;SAVE THE PDL
	TLC	S1,777777	;MAKE -1 A REAL POINTER
	TLCN	S1,777777
	 HRLI	S1,(POINT 7)
	TXNE	S2,CM%FUT	;Future time wanted?
	JRST	[PUSHJ P,.DATIF ;Yes, scan future time
		JRST 	XDAT.1] ;Go join finish code
	TXNE	S2,CM%PST	;Past time wanted?
	JRST	[PUSHJ P,.DATIP ;Yes, scan past time
		JRST	XDAT.1]	;Go join finish code
	PUSHJ	P,.DATIM	;Do the work for the default case
XDAT.1:	MOVE	T1,S2		;POSITION THE FLAGS
	SKIPE	FLFUTR		; If time relative
	 JRST	XDAT.2		; There is no need to convert
	PUSH	P,S1		; Save the byte pointer

TOPS10 <
	MOVX	S1,%CNGMT	; Offset to GMT
	GETTAB	S1,		; Read it
	  SETZ	S1,		; Not there
	ADDM	S1,N		; Convert to GMT
>;;End TOPS10 Conditional

TOPS20 <
	MOVX	S1,.SFTMZ	; Get the local time zone
	TMON			;  .  .  .
	MOVX	S1,<^D3600>	; Get the number of seconds/hour
	IMUL	S1,S2		; Calculate number of seconds
	$CALL	.SC2UD		; Convert to UDT format
	ADDM	S1,N		; Convert local time to GMT
>;;End TOPS20 Conditional

	POP	P,S1		; Restore the byte pointer

XDAT.2:	MOVE	S2,N		;GET THE ANSWER
	SETOM	TF		;We are true so far...
	TXNE	T1,CM%NCI	;WANT ONLY UDT?
	$CALL	DATNCI		;NO..ALSO RETURN 3 WORD BLOCK
	$RET			;AND RETURN

;DEFINE AN ERROR PROCESSING ROUTINE TO GET US BACK TO CALLER

.ERMSG:	MOVEM	TF,.LGEPC	;SAVE THE PC
	MOVEM	S1,.LGERR	;SAVE THE ERROR
	MOVE	P,.FP		;RESTORE THE PDL
	MOVX	TF,FALSE
	POPJ	P,0


;DEFINE A LOCAL ROUTINE TO GET THE NEXT CHARACTER FROM STRING

.TIALT:	ILDB	C,S1		;GET THE NEXT CHARACTER
	POPJ	P,
SUBTTL	DATNCI	ROUTINE TO RETURN 3 WORD TIME BLOCK


;DATNCI	WILL BE CALLED IF CM%NCI WAS SET ON THE CALL

DATNCI:	HRRZ	T1,T1		;GET THE DESTINATION ADDRESS
	CAIG	T1,17		;CANT BE IN THE ACs
	$RETE	(NCI)		;ELSE THATs AN ERROR
	MOVE	T2,VAL9		;GET CENTURY
	IMULI	T2,^D100	;MAKE IT YEARS
	MOVE	T3,VAL8		;GET DECADES
	IMULI	T3,^D10		;MAKE YEARS ALSO
	ADD	T3,T2		;COMBINE THEM
	ADD	T3,VAL7		;GET THE YEAR FIELD
	HRL	T2,T3		;PLACE IN LEFT HALF
	HRR	T2,VAL6		;GET THE MONTH
	MOVEM	T2,0(T1)	;SAVE IN THE BLOCK
	HRLZ	T2,VAL5		;DAY OF THE MONTH TO LEFT HALF
	MOVEM	T2,1(T1)	;SAVE THE DAY OF MONTH
	HLRZ	T2,S2		;GET ONLY THE DATE
	IDIVI	T2,7		;CONVERT TO DAY OF WEEK
	ADDI	T3,2		;MAKE MONDAY = 0
	CAIL	T3,7		;SATURDAY = 6
	SUBI	T3,7
	HRRM	T3,1(T1)	;SAVE DAY OF THE WEEK
	MOVE	T2,VAL4		;GET HOURS
	IMULI	T2,^D60		;CONVERT TO MINUTES
	ADD	T2,VAL3		;ADD THE MINUTES
	IMULI	T2,^D60		;CONVERT TO SECONDS
	ADD	T2,VAL2		;ADD THE SECONDS
	MOVEM	T2,2(T1)	;SAVE THIRD WORD
	$RETT
SUBTTL	DATIM MACROS AND STORAGE DECLARATION

	ECHO$W==0		;MAKE NULL CONDITIONAL


;DEFINE THE ERROR PROCESSING MACROS


DEFINE	M$FAIN(COD,TXT) <M$FAIL(<COD>,<TXT>)>

DEFINE	M$FAIL(COD,TXT) <
	ND ER'COD'$,ERIDT$	;;DEFAULT TO INVALID DATE TIME
E$$'COD':	JSP TF,[MOVEI S1,ER'COD'$
			    JRST .ERMSG]>

;DEFINE THE GLOBAL STORAGE REFERENCED BY THESE ROUTINES

	GLOB	LOGTIM		;TIME JOB WAS LOGGED IN


;DEFINE THE LOCAL STORAGE USED BY THESE ROUTINES

	$DATA	VAL1		;DEFAULT VALUES FLAG
	$DATA	VAL2		;SECONDS
	$DATA	VAL3		;MINUTES
	$DATA	VAL4		;HOURS
	$DATA	VAL5		;DAY OF MONTH (0 - 30)
	$DATA	VAL6		;MONTH OF YEAR (0 - 11)
	$DATA	VAL7		;YEAR
	$DATA	VAL8		;DECADE
	$DATA	VAL9		;CENTURY

	$DATA	NOW
	$DATA	FLFUTD
	$DATA	FLFUTR
	$DATA	FLNULL
	$DATA	FLNEG
	$DATA	MASK


	$DATA	.LASWD
	$DATA	.NMUL

	SUBTTL	SUBROUTINES FOR COMMAND INPUT -- GET DATE/TIME

;.DATIF -- ROUTINE TO SCAN DATE AND TIME ARGUMENT IN FUTURE
;.DATIG -- DITTO (CHARACTER ALREADY IN C)
;CALL:	PUSHJ	P,.DATIF/.DATIG
;	RETURN WITH VALUE IN INTERNAL FORMAT IN N
;USES T1-4	UPDATES C (SEPARATOR)

.DATIF:	PUSHJ	P,.TIAUC	;PRIME THE PUMP

.DATIG:	SETZM	FLFUTR		;CLEAR FUTURE RELATIVE
	SETZM	FLFUTD		;SET DEFAULT
	AOS	FLFUTD		;  TO FUTURE
	CAIE	C,"+"		;SEE IF FUTURE RELATIVE
	JRST	DATIF1		;NO--JUST GET DATE-TIME
	AOS	FLFUTR		;YES--SET FUTURE REL FLAG
	PUSHJ	P,.TIAUC	;GET ANOTHER CHARACTER
DATIF1:	CAIN	C,"-"		;Confused user?
	JRST	DATIF2		;Yes, skip the real stuff
	PUSHJ	P,DATIM		;GET DATE/TIME
	CAMGE	N,NOW		;SEE IF IN FUTURE
DATIF2:	JRST	E$$NFT		;NO--NOT FUTURE ERROR
	POPJ	P,		;RETURN

;.DATIP -- ROUTINE TO SCAN DATE AND TIME ARGUMENT IN THE PAST
;.DATIQ -- DITTO (CHARACTER ALREADY IN C)
;CALL:	PUSHJ	P,.DATIP/.DATIQ
;	RETURN WITH VALUE IN INTERNAL FORMAT IN N
;USES T1-4	UPDATES C (SEPARATOR)

.DATIP:	PUSHJ	P,.TIAUC	;PRIME THE PUMP

.DATIQ:	SETZM	FLFUTR		;CLEAR PAST RELATIVE
	SETOM	FLFUTD		;SET DEFAULT TO PAST
	CAIE	C,"-"		;SEE IF PAST RELATIVE
	JRST	DATIP1		;NO--JUST GET DATE-TIME
	SOS	FLFUTR		;YES--SET PAST REL FLAG
	PUSHJ	P,.TIAUC	;GET ANOTHER CHARACTER
DATIP1:	CAIN	C,"+"		;Confused user?
	JRST	DATIP2		;Yes, skip normal stuff
	PUSHJ	P,DATIM		;GET DATE/TIME
	CAMLE	N,NOW		;SEE IF IN PAST
DATIP2:	JRST	E$$NPS		;NO--NOT PAST ERROR
	POPJ	P,		;RETURN
;.DATIM -- ROUTINE TO SCAN DATE AND TIME ARGUMENT
;.DATIC -- DITTO (CHARACTER ALREADY IN C)
;CALL:	PUSHJ	P,.DATIM/.DATIC
;	RETURN WITH VALUE IN INTERNAL FORMAT IN N
;USES T1-4	UPDATES C (SEPARATOR)

.DATIM:	PUSHJ	P,.TIAUC	;PRIME THE PUMP

.DATIC:	SETZM	FLFUTR		;CLEAR RELATIVE FLAG
	SETZM	FLFUTD		;CLEAR DEFAULT FLAG
	CAIE	C,"+"		;SEE IF FUTURE RELATIVE
	JRST	DATIC1		;NO--PROCEED
	AOS	FLFUTR		;YES--SET FLAG
	JRST	DATIC2		;AND PROCEED
DATIC1:	CAIE	C,"-"		;SEE IF PAST RELATIVE
	PJRST	DATIM		;NO--JUST GET ABS DATE
	SOS	FLFUTR		;YES--SET FLAG
DATIC2:	PUSHJ	P,.TIAUC	;GET NEXT CHAR
				;AND FALL INTO DATE/TIME GETTER

;DATIM -- ROUTINE TO INPUT DATE/TIME
;CALL:	SET FLFUTR TO -1 IF PAST RELATIVE, 0 IF ABSOLUTE, +1 IF FUTURE RELATIVE
;	SIMILARLY FOR FLFUTD TO INDICATE DEFAULT DIRECTION IF FLFUTR=0
;	GET NEXT CHARACTER IN C
;	PUSHJ	P,DATIM
;RETURN WITH TRUE DATE/TIME IN N IN INTERNAL SPECIAL FORMAT
;	SETS NOW TO CURRENT DATE/TIME
;USES T1-4, UPDATES C
;
;TYPE-IN FORMATS:
;	(THE LEADING +- IS HANDLED BY CALLER)
;
;	[ [  DAY IN WEEK	    ]		     ]
;	[ [     NNND		    ]		     ]
;	[ [ [   MM-DD  [-Y   ] ]  : ] [HH[:MM[:SS]]] ]
;	[ [ [  MMM-DD  [-YY  ] ]    ]		     ]
;	[ [ [  DD-MMM  [-YYYY] ]    ]		     ]
;	[	       MNEMONIC			     ]
;WHERE:
;	D	LETTER D
;	DD	DAY IN MONTH (1-31)
;	HH	HOURS (00-23)
;	MM	MONTH IN YEAR (1-12)
;	    OR	MINUTES (00-59)
;	MMM	MNEMONIC MONTH OR ABBREV.
;	SS	SECONDS (0-59)
;	Y	LAST DIGIT OF THIS DECADE
;	YY	LAST TWO DIGITS OF THIS CENTURY
;	YYYY	YEAR
;	DAY IN WEEK IS MNEMONIC OR ABBREVIATION
;	MNEMONIC IS A SET OF PREDEFINED TIMES
				;DESCRIBED ABOVE
				;FALL HERE FROM .DATIC

DATIM:	SKIPE	T1,FLFUTR	;SEE IF FORCED DIRECTION
	MOVEM	T1,FLFUTD	; YES--THAT IMPLIES DEFAULT
	SETOM	VAL1		;CLEAR RESULT WORDS
	MOVE	T1,[VAL1,,VAL2]
	BLT	T1,VAL9		; ..
	PUSH	P,S1		; Save S1
	$CALL	I%NOW		;GET CURRENT DATE/TIME
	MOVE	T1,S1		; Transfer the time
	POP	P,S1		; Restore the various flags
	MOVEM	T1,NOW		;SAVE FOR LATER TO BE CONSISTENT
	CAIL	C,"0"		;SEE IF DIGIT
	CAILE	C,"9"		; ..
	JRST	.+2		;NO--MNEMONIC FOR SOMETHING
	JRST	DATIMD		;YES--GO GET DECIMAL
;HERE IF STARTING WITH ALPHA, MIGHT BE DAY, MONTH, OR MNEMONIC
	PUSHJ	P,.SIXSC	;GET SIXBIT WORD
	JUMPE	N,E$$DTM		;ILLEGAL SEPARATOR IF ABSENT	[274]
	MOVE	T1,MNDPTR	;POINT TO FULL TABLE
	PUSHJ	P,.NAME		;LOOKUP IN TABLE
	  JRST	E$$UDN		;ERROR IF NOT KNOWN
	MOVEI	N,(T1)		;GET
	SUBI	N,DAYS		;  DAY INDEX
	CAIL	N,7		;SEE IF DAY OF WEEK
	JRST	DATIMM		;NO--LOOK ON
;HERE WHEN DAY OF WEEK RECOGNIZED
	SKIPN	T1,FLFUTD	;GET DEFAULT DIRECTION
	JRST	E$$NPF		;ERROR IF NONE
	MOVEM	T1,FLFUTR	;SET AS FORCED DIRECTION
	HLRZ	T2,NOW		;GET DAYS
	IDIVI	T2,7		;GET DAY OF WEEK
	SUB	N,T3		;GET FUTURE DAYS FROM NOW
	SKIPGE	N		;IF NEGATIVE,
	ADDI	N,7		;  MAKE LATER THIS WEEK
	HLLZ	T1,NOW		;CLEAR CURRENT
	SKIPL	FLFUTD		;SEE IF FUTURE
	TROA	T1,-1		;YES--SET MIDNIGHT MINUS EPSILON
	SUBI	N,7		;NO--MAKE PAST
	HRLZ	N,N		;POSITION TO LEFT HALF
	ADD	N,T1		;MODIFY CURRENT DATE/TIME
DATIMW:	PUSH	P,N		;SAVE DATE
	PUSHJ	P,DATIC		;GO CHECK TIME
	  HRRZ	N,(P)		;NO--USE VALUE IN DATE
	POP	P,T1		;RESTORE DATE
	HLL	N,T1		;  TO ANSWER
;**; [576] Delete one line @ DATIMW + 5L, add lines at same
;**; [576] location.  LLN, 9-Sep-76
	SKIPG	FLFUTR		;[576] SKIP IF FUTURE
	JRST	DATIMK		;[576] ADJUST PAST RESULT
	CAMGE	N,NOW		;[576] IF NOT FUTURE, MUST HAVE
				;[576] WANTED A WEEK FROM TODAY,
				;[576] BUT EARLIER IN THE DAY.
	ADD	N,[7,,0]	;[576] MAKE TIME NEXT WEEK
	JRST	DATIMX		;[576] CHECK AND RETURN
DATIMK:	MOVE	T2,N		;[576] SIMILAR TEST FOR PAST
	ADD	T2,[7,,0]	;[576] ADD A WEEK TO PAST TIME
	CAMG	T2,NOW		;[576] WAS TIME OVER A WEEK AGO?
	MOVE	N,T2		;[576] YES, USE NEW ONE
	JRST	DATIMX		;[576] CHECK ANSWER AND RETURN
;HERE IF MONTH OR MNEMONIC
DATIMM:	MOVEI	N,(T1)		;GET MONTH
	SUBI	N,MONTHS-1	;  AS 1-12
	CAILE	N,^D12		;SEE IF MONTH
	JRST	DATIMN		;NO--MUST BE MNEMONIC
	MOVEM	N,VAL6		;YES--STORE MONTH
	CAIE	C,"-"		;MUST BE DAY NEXT
	JRST	E$$MDD		;NO--ERROR
	PUSHJ	P,.DECNW	;YES--GET IT
	JUMPLE	N,E$$NND	;ERROR IF NEGATIVE
	CAILE	N,^D31		;VERIFY IN RANGE
	JRST	E$$DFL		;ERROR IF TOO LARGE
	MOVEM	N,VAL5		;SAVE AWAY
	JRST	DATIY0		;AND GET YEAR IF PRESENT

;HERE IF MNEMONIC
DATIMN:	HRRZ	T2,T1		;GET COPY			[305]
	CAIN	T2,SPLGTM	;SEE IF "LOGIN"			[505]
	SKIPG	N,LOGTIM	;AND WE KNOW IT			[505]
	SKIPA			;NO--PROCEED			[505]
	JRST	DATIMX		;YES--GO GIVE ANSWER		[505]
	CAIN	T2,SPNOON	;SEE IF "NOON"			[520]
	JRST	[HLLZ N,NOW	;YES--GET TODAY			[520]
		 HRRI N,1B18	;SET TO NOON			[520]
		PUSHJ P,DATIM1	;Go to clean up input
		 JRST DATIMW]	;GO FINISH UP			[520]
	CAIN	T2,SPMIDN	;SEE IF "MIDNIGHT"		[520]
	JRST	[HLLZ N,NOW	;GET TODAY			[520]
		PUSHJ P,DATIM1	;Go to clean up input
		 JRST DATIMO]	;GO SET TO MIDNIGHT		[520]
	SUBI	T2,SPCDAY	;SUBTRACT OFFSET TO SPECIAL DAYS  [305]
	CAILE	T2,2		;SEE IF ONE OF THREE		[305]
	JRST	E.MDS		;NO--UNSUPPORTED		[305]
	HLRZ	N,NOW		;YES--GET TODAY			[305]
	ADDI	N,-1(T2)	;OFFSET IT			[305]
	HRLZS	N		;POSITION FOR ANSWER		[305]
DATIMO:	SKIPL	FLFUTD		;SEE IF FUTURE			[305]
	TRO	N,-1		;YES--SET TO MIDNIGHT MINUS EPSILON  [305]
	JRST	DATIMW		;AND GO FINISH UP		[305]
;HERE IF UNSUPPORTED MNEMONIC
E.MDS:	MOVE	N,(T1)		;GET NAME OF SWITCH
	M$FAIL	(MDS,Mnemonic date/time switch not implemented)

;The purpose of this next routine is to fix a problem created by XDATIM.
;In order to allow the user to type the date and time without the ":"
;normally required by SCAN (from where this code was taken) between the
;date and time, XDATIM places a colon in the string.  This fails if
;a mnemonic such as NOON and MIDNIGHT is typed.  This routine rips
;that out.

DATIM1:	CAIN	C," "		;Is there a space next
	PUSHJ	P,.TIAUC	;Yes, get the next character from the buffer
	POPJ	P,		;And return
;HERE IF STARTING WITH DECIMAL NUMBER
DATIMD:	PUSHJ	P,.DECNC	;YES--GO GET FULL NUMBER
	JUMPL	N,E$$NND	;ILLEGAL IF NEGATIVE
	CAIE	C,"D"		;SEE IF DAYS
	JRST	DATIN		;NO--MUST BE -
	MOVE	T1,FLFUTD	;YES--RELATIVE SO GET FORCING FUNCTION
	MOVEM	T1,FLFUTR	; AND FORCE IT
	JUMPE	T1,E$$NPF	;ERROR IF DIRECTION UNCLEAR
	CAIL	N,1B18		;VERIFY NOT HUGE
	JRST	E$$DFL		;ERROR--TOO LARGE
	MOVEM	N,VAL5		;SAVE RELATIVE DATE
	PUSHJ	P,.TIAUC	;GET NEXT CHARACTER (SKIP D)
	PUSHJ	P,DATIC		;GO CHECK FOR TIME
	  MOVEI	N,0		;0 IF NONE
	HRL	N,VAL5		;INCLUDE DAYS IN LH
	JRST	DATITR		;GO DO RELATIVE RETURN
;HERE WHEN DIGITS SEEN WITHOUT A FOLLOWING D
DATIN:	CAIE	C,"-"		;SEE IF DAY/MONTH COMBO
	JRST	DATIT		;NO--MUST BE INTO TIME
	CAILE	N,^D31		;MUST BE LESS THAN 31
	JRST	E$$DFL		;NO--ERROR
	JUMPE	N,E$$DFZ	;VERIFY NOT ZERO
	MOVEM	N,VAL5		;SAVE VALUE
	PUSHJ	P,.TIAUC	;SKIP OVER MINUS
	CAIL	C,"0"		;SEE IF DIGIT NEXT
	CAILE	C,"9"		; ..
	JRST	DATMMM		;NO-- MUST BE MNEMONIC MONTH
	PUSHJ	P,.DECNC	;YES-- MUST BE MM-DD FORMAT
	JUMPLE	N,E$$NND	;BAD IF LE 0
	CAILE	N,^D31		;VERIFY LE 31
	JRST	E$$DFL		;BAD
	EXCH	N,VAL5		;SWITCH VALUES
	CAILE	N,^D12		;VERIFY MONTH OK
	JRST	E$$DFL		;BAD
	JRST	DATMM1		;GO STORE MONTH
;HERE WHEN TIME SEEN BY ITSELF
DATIT:	CAIN	C," "		;Last character a space?
	PUSHJ	P,.TIALT	;Space over it
	PUSHJ	P,DATIG		;GET REST OF TIME
	 M$FAIL(IDT,The comment said this can never happen)
	SKIPN	FLFUTR		;SEE IF RELATIVE
	JRST	DATIRN		;NO--GO HANDLE AS ABS.
;HERE WITH DISTANCE IN N
DATITR:	SKIPGE	FLFUTR		;IF PAST,
	MOVN	N,N		;  COMPLEMENT DISTANCE
	ADD	N,NOW		;ADD TO CURRENT DATE/TIME
	JRST	DATIMX		;CHECK ANSWER AND RETURN
;HERE WHEN DD- SEEN AND MNEMONIC MONTH COMING
DATMMM:	PUSHJ	P,.SIXSC	;GET MNEMONIC
	MOVE	T1,MONPTR	;GET POINTER TO  MONTH TABLE
	PUSHJ	P,.NAME		;LOOKUP IN TABLE
	  JRST	E$$UDM		;NO GOOD
	MOVEI	N,(T1)		;GET MONTH
	SUBI	N,MONTHS-1	;  AS 1-12
;HERE WITH MONTH INDEX (1-12) IN T1
DATMM1:	MOVEM	N,VAL6		;SAVE FOR LATER
DATIY0:	CAIE	C,"-"		;SEE IF YEAR NEXT
	JRST	DATIRA		;NO--GO HANDLE TIME
;HERE WHEN YEAR NEXT AS ONE, TWO, OR FOUR DIGITS
	SETZB	N,T1		;CLEAR DIGIT AND RESULT COUNTERS
DATIY:	PUSHJ	P,.TIAUC	;GET NEXT DIGIT
	CAIL	C,"0"		;SEE IF NUMERIC
	CAILE	C,"9"		; ..
	JRST	DATIY1		;NO--MUST BE DONE
	IMULI	N,^D10		;ADVANCE RESULT
	ADDI	N,-"0"(C)	;INCLUDE THIS DIGIT
	AOJA	T1,DATIY	;LOOP FOR MORE, COUNTING DIGIT
DATIY1:	JUMPE	T1,E$$ILR	;ERROR IF NO DIGITS
	CAIE	T1,3		;ERROR IF 3 DIGITS
	CAILE	T1,4		;OK IF 1,2, OR 4
	JRST	E$$ILR		;ERROR IF GT 4 DIGITS
	MOVE	T2,N		;GET RESULT
	IDIVI	T2,^D100	;SEP. CENTURY
	IDIVI	T3,^D10		;SEP. DECADE
	CAIG	T1,2		;IF ONE OR TWO DIGITS,
	SETOM	T2		;  FLAG NO CENTURY KNOWN
	CAIN	T1,1		;IF ONE DIGIT,
	SETOM	T3		;  FLAG NO DECADE KNOWN
	MOVEM	T4,VAL7		;SAVE UNITS
	MOVEM	T3,VAL8		;SAVE DECADE
	MOVEM	T2,VAL9		;SAVE CENTURY
;HERE WITH VAL5-9 CONTAINING DAY, MONTH, YEAR, DECADE, CENTURY
DATIRA:	SOS	VAL5		;MAKE DAYS 0-30
	SOS	VAL6		;MAKE MONTHS 0-11
	PUSHJ	P,DATIC		;GET TIME IF PRESENT
	  SKIPG	FLFUTD		;IGNORE ABSENCE
	JRST	DATIRN		; UNLESS FUTURE
;HERE IF FUTURE WITHOUT TIME
	MOVEI	T1,^D59		;SET TO
	MOVEM	T1,VAL2		; 23:59:59
	MOVEM	T1,VAL3		; ..
	MOVEI	T1,^D23		; ..
	MOVEM	T1,VAL4		; ..
;HERE WITH VAL2-9 CONTAINING PARSE OR -1 IF TO BE FILLED IN
;	STRATEGY IS TO FILL-IN HOLES LESS SIGNIFICANT THAN
;	MOST SIGN. FIELD WITH 0; AND TO FILL IN MORE SIGNIFICANT
;	HOLES WITH CURRENT VALUE.  THEN IF WRONG DIRECTION FROM
;	NOW, ADD/SUB ONE TO FIELD JUST ABOVE MOST SIGNIFICANT DIFFERENT
;	(FIELD CARRY NOT NEEDED SINCE IT WILL HAPPEN IMPLICITLY).
DATIRN:	PUSHJ	P,.TICAN	;MAKE SURE NEXT CHAR IS SEPARATOR  [542]
	  SKIPA			;YES--OK			[542]
	JRST	E$$ILC		;NO--FLAG ERROR BEFORE DEFAULTING  [542]
	MOVE	T1,NOW		;GET CURRENT DATE/TIME
	PUSHJ	P,.CNTDT	;CONVERT TO EASY FORMAT
	MOVE	T3,T1		;SAVE MSTIME
	IDIVI	T3,^D1000	; AS SECONDS
	ADD	T2,[^D1964*^D12*^D31]  ;MAKE REAL
	MOVEI	T4,8		;TRY 8 FIELDS			[250]
DATIRB:	MOVE	T1,T2		;POSITION REMAINDER
	IDIV	T1,[1
		    ^D60
		    ^D60*^D60
		    1
		    ^D31
		    ^D31*^D12
		    ^D31*^D12*^D10
		    ^D31*^D12*^D10*^D10]-1(T4)  ;SPLIT THIS FIELD FROM REST  [250]
	SKIPL	VAL1(T4)	;SEE IF DEFAULT			[250]
	JRST	[TLNN T3,-1	;NO--FLAG TO ZERO DEFAULTS	[250]
		 HRL  T3,T4	; SAVING INDEX OF LAST DEFAULT	[250]
		 JRST DATRIC]	;AND CONTINUE LOOP
	SETZM	VAL1(T4)	;DEFAULT TO ZERO		[250]
	TLNN	T3,-1		;SEE IF NEED CURRENT		[250]
	MOVEM	T1,VAL1(T4)	;YES--SET THAT INSTEAD		[250]
DATRIC:	CAME	T1,VAL1(T4)	;SEE IF SAME AS CURRENT		[250]
	JRST	DATIRD		;NO--REMEMBER FOR LATER
	CAIN	T4,4		;SEE IF TIME FOR TIME		[250]
	HRRZ	T2,T3		;YES--GET IT
	SOJG	T4,DATIRB	;LOOP UNTIL ALL DONE		[250]
;HERE WHEN FILLED IN CURRENT FOR SIGNIFICANT DEFAULTS
DATIRD:	SKIPGE	VAL1(T4)	;SEE IF DEFAULT			[250]
	SETZM	VAL1(T4)	;CLEAR DEFAULT			[250]
	SOJG	T4,DATIRD	;LOOP UNTIL DONE		[250]
	HLRZ	N,T3		;RECOVER LAST SIGN. DEFAULT-1	[250]
	JUMPE	N,DATIRR	;DONE IF NONE			[250]
	PUSHJ	P,DATIRM	;MAKE CURRENT DATE, TIME
	MOVE	T4,FLFUTD	;GET DEFAULT DIRECTION
	XCT	[CAMGE	T1,NOW
		 JFCL
		 CAMLE	T1,NOW]+1(T4)  ;SEE IF OK
	JRST	DATIRR		;YES--GO RETURN
	SKIPG	FLFUTD		;NO--SEE WHICH DIRECTION
	SOSA	VAL2(N)		;PAST
	AOS	VAL2(N)		;FUTURE
DATIRR:	PUSHJ	P,DATIRM	;REMAKE ANSWER
	MOVE	N,T1		;MOVE TO ANSWER
;HERE WITH FINAL RESULT, CHECK FOR OK
	RADIX	10
DATIMX:	MOVEI	T1,.TDTTM	;SET DATE-TIME			[314]
	MOVEM	T1,.LASWD	; OUTPUTER			[314]
	CAML	N,[<1964-1859>*365+<1964-1859>/4+<31-18>+31,,0]	;[261]
	PJRST	STRNML		;STORE IN .NMUL AND RETURN	[314]
	RADIX	8
	M$FAIL	(DOR,Date/time out of range)

;SUBROUTINE TO MAKE DATE/TIME
DATIRM:	MOVE	T1,VAL4		;GET HOURS
	IMULI	T1,^D60		;MAKE INTO MINS
	ADD	T1,VAL3		;ADD MINS
	IMULI	T1,^D60		;MAKE INTO SECS
	ADD	T1,VAL2		;ADD SECS
	IMULI	T1,^D1000	;MAKE INTO MILLISECS
	MOVE	T2,VAL9		;GET CENTURIES
	IMULI	T2,^D10		;MAKE INTO DECADES
	ADD	T2,VAL8		;ADD DECADES
	IMULI	T2,^D10		;MAKE INTO YEARS
	ADD	T2,VAL7		;ADD YEARS
	IMULI	T2,^D12		;MAKE INTO MONTHS
	ADD	T2,VAL6		;ADD MONTHS
	IMULI	T2,^D31		;MAKE INTO DAYS
	ADD	T2,VAL5		;ADD DAYS
	SUB	T2,[^D1964*^D12*^D31]  ;REDUCE TO SYSTEM RANGE
	PJRST	.CNVDT		;CONVERT TO INTERNAL FORM AND RETURN
;SUBROUTINE TO GET TIME IF SPECIFIED
;RETURNS CPOPJ IF NO TIME, SKIP RETURN IF TIME
;  WITH TIME IN RH(N) AS FRACTION OF DAY
;USES T1-4, N

DATIC:	CAIE	C,"	"	;Have a tab?
	CAIN	C," "		;or a space?
	JRST	DATI1		;Yes, continue on
	CAIE	C,":"		;Colon?  (living in the past)
	POPJ	P,		;NO--MISSING TIME
DATI1:	PUSHJ	P,.DECNW	;GET DECIMAL NUMBER FOR TIME
;HERE WITH FIRST TIME FIELD IN N
DATIG:	JUMPL	N,E$$NND	;ERROR IF NEGATIVE		[326]
	CAIL	N,^D24		; AND GE 24,
	JRST	E$$DFL		;GIVE ERROR--TOO LARGE
	MOVEM	N,VAL4		;SAVE HOURS
	CAIE	C,":"		;SEE IF MINUTES COMING
	JRST	DATID		;NO--DONE
	PUSHJ	P,.DECNW	;YES--GET IT
	CAIL	N,^D60		;SEE IF IN RANGE
	JRST	E$$DFL		;NO--GIVE ERROR
	JUMPL	N,E$$NND	;ERROR IF NEG
	MOVEM	N,VAL3		;SAVE MINUTES
	CAIE	C,":"		;SEE IF SEC. COMING
	JRST	DATID		;NO--DONE
	PUSHJ	P,.DECNW	;GET SECONDS
	CAIL	N,^D60		;CHECK RANGE
	JRST	E$$DFL		;NO--GIVE ERROR
	JUMPL	N,E$$NND	;ERROR IF NEG
	MOVEM	N,VAL2		;SAVE SECONDS
;HERE WITH TIME IN VAL2-4
DATID:	SKIPGE	T1,VAL4		;GET HOURS
	MOVEI	T1,0		;  UNLESS ABSENT
	IMULI	T1,^D60		;CONV TO MINS
	SKIPL	VAL3		;IF MINS PRESENT,
	ADD	T1,VAL3		;  ADD MINUTES
	IMULI	T1,^D60		;CONV TO SECS
	SKIPL	VAL2		;IF SECS PRESENT,
	ADD	T1,VAL2		;  ADD SECONDS
	MOVEI	T2,0		;CLEAR OTHER HALF
	ASHC	T1,-^D17	;MULT BY 2**18
	DIVI	T1,^D24*^D3600	;DIVIDE BY SECONDS/DAY
	MOVE	N,T1		;RESULT IS FRACTION OF DAY IN RH
	JRST	.POPJ1		;RETURN
;DATE/TIME ERRORS

	M$FAIL	(ILC,Illegal character in date/time)
	M$FAIL	(NFT,Date/time must be in the future)
	M$FAIL	(NPS,Date/time must be in the past)
	M$FAIL	(NND,Negative number in date/time)
	M$FAIL	(NPF,Not known whether past or future in date/time)
	M$FAIL	(DFL,Field too large in date/time)
	M$FAIL	(DFZ,Field zero in date/time)
	M$FAIL	(UDM,Unrecognized month in date/time)
	M$FAIL	(ILR,Illegal year format in date/time)
	M$FAIL	(UDN,Unrecognized name in date/time)
	M$FAIL	(MDD,Missing day in date/time)
	M$FAIL	(DTM,Value missing in date/time)


;MNEMONIC WORDS IN DATE/TIME SCAN

	DEFINE	XX($1),<
	EXP	<SIXBIT	/$1/>>

DAYS:	XX	WEDNESDAY
	XX	THURSDAY
	XX	FRIDAY
	XX	SATURDAY
	XX	SUNDAY
	XX	MONDAY
	XX	TUESDAY

MONTHS:	XX	JANUARY
	XX	FEBRUARY
	XX	MARCH
	XX	APRIL 
	XX	MAY
	XX	JUNE
	XX	JULY
	XX	AUGUST
	XX	SEPTEMBER
	XX	OCTOBER
	XX	NOVEMBER
	XX	DECEMBER

SPCDAY:	XX	YESTERDAY
	XX	TODAY
	XX	TOMORROW

SPLGTM:	XX	LOGIN
SPNOON:	XX	NOON
SPMIDN:	XX	MIDNIGHT

SPDATM:	XX	LUNCH
	XX	DINNER
LSPDTM==.-DAYS

;POINTERS

MONPTR:	IOWD	^D12,MONTHS
MNDPTR:	IOWD	LSPDTM,DAYS
;.NAME -- LOOKUP NAME IN TABLE ALLOWING FOR UNIQUE ABBREVIATIONS
;ALWAYS CHECK FOR EXACT MATCH FIRST.
;CALL:	MOVE	N,NAME
;	MOVE	T1,[IOWD LENGTH,START OF TABLE]
;	PUSHJ	P,.NAME
;	ERROR RETURN IF UNKNOWN OR DUPLICATE
;	AND WITH T1.LT.0 IF NOT MATCH, .GT.0 IF SEVERAL MATCHES
;	SKIP RETURN IF FOUND WITH T1 POINTING TO ENTRY
;	AND WITH LH(T1)=0 IF ABBREVIATION, OR T1.LT.0 IF EXACT MATCH
;USES T2, T3, T4

.NAME:	MOVE	T2,N		;SET NAME FOR ROUTINE
	PJRST	.LKNAM		;GO HANDLE IT
;.DECNW -- INPUT A DECIMAL WORD FROM COMMAND STRING
;.DECNC  -- DITTO (CHARACTER ALREADY IN C)
;IF IT STARTS WITH #, THEN OCTAL TYPEIN
;TERMINATES AT FIRST NON-DECIMAL CHARACTER
;THROWS AWAY ANY CHARACTERS BEFORE THE LAST 10 OR SO
;CALL:	PUSHJ	P,.DECNC/.DECNW
;	RETURN WITH WORD IN N
;USES T1	UPDATES C (SEPARATOR)

.DECNW:	PUSHJ	P,.TIAUC	;PRIME THE PUMP
.DECNC:	PUSHJ	P,.CKNEG	;CHECK IF NEGATIVE
DECIN1:	CAIL	C,"0"		;SEE IF DECIMAL
	CAILE	C,"9"		; ..
	PJRST	DECMUL		;NO--AT END, SO HANDLE SUFFIX
	IMULI	N,^D10		;YES--MULTIPLY NUMBER
	ADDI	N,-"0"(C)	;INCORPORATE DIGIT
	PUSHJ	P,.TIAUC	;GET NEXT CHARACTER
	JRST	DECIN1		;LOOP BACK FOR MORE

;DECMUL -- HANDLE DECIMAL SUFFIX MULTIPLIER
;	K,M,G FOR 10**3,6,9
;CALL:	MOVE	N,NUMBER
;	PUSHJ	P,DECMUL
;	RETURN	WITH NUMBER MULTIPLIED BY SUFFIX
;USES T1  (MULTIPLIER--RETURNED)	UPDATES C (SEPARATOR)

DECMUL:	CAIN	C,"."		;SEE IF FORCING DECIMAL		[273]
	PUSHJ	P,.TIAUC	;YES--GET NEXT CHARACTER	[273]
	MOVEI	T1,.TDECW	;SET DECIMAL FORMAT		[314]
	MOVEM	T1,.LASWD	; FOR ERROR PRINTING		[314]
	MOVEI	T1,1		;INITIALIZE SUFFIX MULTIPLIER
	CAIN	C,"K"		;K = 1 000
	MOVEI	T1,^D1000
	CAIN	C,"M"		;M = 1 000 000
	MOVE	T1,[^D1000000]
	CAIN	C,"G"		;G =1 000 000 000
	MOVE	T1,[^D1000000000]
	IMUL	N,T1		;APPLY TO NUMBER
	CAILE	T1,1		;SEE IF SUFFIX
	PUSHJ	P,.TIAUC	;YES--GET ONE MORE CHARACTER
	PJRST	.SENEG		;SEE IF NEGATIVE AND RETURN
;.SENEG -- SEE IF NEGATIVE FOUND BY .CKNEG AND APPLY IT
;CALL:	MOVE	N,VALUE SO FAR
;	PUSHJ	P,.SENEG
;RETURNS WITH N COMPLEMENTED IF NUMBER PRECEEDED BY -

.SENEG:	SKIPE	FLNEG		;SEE IF NEGATIVE
	MOVNS	N		;YES--COMPLEMENT RESULT
IFN ECHO$W,<
	PUSHJ	P,NAMER
>

;HERE TO EXIT FROM MOST ONE WORD INPUT ROUTINES TO
;STORE A COPY OF THE RESULT IN .NMUL FOR LONG TERM STORAGE
;PURPOSES SUCH AS SOME ERROR MESSAGES

STRNML:	MOVEM	N,.NMUL		;STORE VALUE FOR ERROR PRINTER	[314]
	POPJ	P,		;RETURN


;.CKNEG -- CHECK IF NEGATIVE NUMBER COMING
;ALSO CLEARS N
;CALL:	MOVEI	C,NEXT CHAR
;	PUSHJ	P,.CKNEG
;USES NO ACS

.CKNEG:	SETZB	N,FLNEG		;CLEAR N AND NEGATIVE FLAG
	CAIE	C,"-"		;CHECK IF NEGATIVE NUMBER
	POPJ	P,		;NO--RETURN
	SETOM	FLNEG		;YES--SET FLAG
	PJRST	.TIAUC		;GET NEXT CHAR AND RETURN


;.SIXSW -- INPUT A SIXBIT WORD FROM COMMAND STRING
;.SIXSC  -- DITTO (CHARACTER ALREADY IN C)
;TERMINATES AT FIRST NON-ALPHANUMERIC CHARACTER
;THROWS AWAY ANY CHARACTERS BEYOND THE FIRST SIX
;CALL:	PUSHJ	P,.SIXSC/.SIXSW
;	RETURN WITH WORD IN N
;USES T1    UPDATES C (SEPARATOR)

.SIXSW:	PUSHJ	P,.TIAUC	;PRIME THE PUMP

.SIXSC:	MOVEI	N,0		;CLEAR NAME
	MOVEI	T1,.TSIXN	;SET SIXBIT FORMAT		[314]
	MOVEM	T1,.LASWD	; FOR ERROR PRINTING		[314]
	MOVE	T1,[POINT 6,N]	;INITIALIZE BYTE POINTER FOR WORD

SIXS1:	PUSHJ	P,.TICAN	;SEE IF CHARACTER IS ALPHA-NUMERIC
	  JRST	STRNML		;STORE IN .NMUL AND RETURN	[314]
	SUBI	C," "-' '	;CONVERT TO SIXBIT
	TLNE	T1,(77B5)	;DON'T OVERFLOW
	IDPB	C,T1		;STORE CHARACTER
	PUSHJ	P,.TIAUC	;GO GET ANOTHER CHARACTER
	JRST	SIXS1		;LOOP BACK TO PROCESS IT
	SUBTTL	SUBROUTINES FOR COMMAND INPUT -- GET NEXT CHARACTER

;.TICAN -- CHECK CHARACTER FOR ALPHA-NUMERIC
;ALPHA-NUMERIC IS A-Z OR 0-9
;CALL:	MOVEI	C,ASCII CHARACTER
;	PUSHJ	P,.TICAN
;	  RETURN IF NOT ALPHA-NUMERIC
;	SKIP RETURN IF ALPHA-NUMERIC
;PRESERVES ALL ACS

.TICAN:	CAIL	C,"A"+40	;SEE IF
	CAILE	C,"Z"+40	;  LOWER CASE ALPHA
	SKIPA			;NO--CONTINUE CHECKS
	JRST	.POPJ1		;YES--GIVE ALPHA RETURN
	CAIL	C,"0"		;SEE IF BELOW NUMERICS
	CAILE	C,"Z"		;OR IF ABOVE ALPHABETICS
	POPJ	P,		;YES--RETURN
	CAILE	C,"9"		;SEE IF NUMERIC
	CAIL	C,"A"		;OR IF ALPHABETIC

	AOS	(P)		;YES--SKIP RETURN
	POPJ	P,		;RETURN

;.TIAUC -- INPUT ONE COMMAND CHARACTER HANDLING LOWER CASE CONVERSION
;CALL:	PUSHJ	P,.TIAUC
;	RESULT IN C
;USES NO ACS

.TIAUC:	PUSHJ	P,.TIALT	;GO GET NEXT CHAR

;.TIMUC -- CONVERT LOWER CASE CHARACTER TO UPPER CASE
;CALL:	MOVEI	C,CHARACTER
;	PUSHJ	P,.TIMUC
;	RETURN WITH UPDATED C
;USES NO ACS

.TIMUC:	CAIGE	C,"A"+40	;SEE IF LOWER CASE
	POPJ	P,		;NO--RETURN
	CAIG	C,"Z"+40
	SUBI	C,40		;YES--CONVERT
	POPJ	P,		;RETURN



;DEFINE SOME DUMMY ROUTINES NORMALLY USED FOR ERROR PROCESSING

.TSIXN:	
.TDTTM:	
.TDECW:	
.TOCTW:	
SUBTTL	.CNTDT -- GENERALIZED DATE/TIME SUBROUTINE

;.CNTDT -- SUBROUTINE TO CONVERT FROM INTERNAL DATE/TIME FORMAT
;CALL:	MOVE	T1,DATE/TIME
;	PUSHJ	P,.CNTDT
;	RETURN WITH T1=TIME IN MS., T2=DATE IN SYSTEM FORMAT (.LT. 0 IF ARG .LT. 0)
;BASED ON IDEAS BY JOHN BARNABY, DAVID ROSENBERG, PETER CONKLIN
;USES T1-4

.CNTDT:	PUSH	P,T1		;SAVE TIME FOR LATER
	JUMPL	T1,CNTDT6	;DEFEND AGAINST JUNK INPUT
	HLRZ	T1,T1		;GET DATE PORTION (DAYS SINCE 1858)

	RADIX	10		;**** NOTE WELL ****

	ADDI	T1,<1857-1500>*365+<1857-1500>/4-<1857-1500>/100+<1857-1500>/400+31+28+31+30+31+30+31+31+30+31+17
				;T1=DAYS SINCE JAN 1, 1501	[311]
	IDIVI	T1,400*365+400/4-400/100+400/400
				;SPLIT INTO QUADRACENTURY	[311]
	LSH	T2,2		;CONVERT TO NUMBER OF QUARTER DAYS  [311]
	IDIVI	T2,<100*365+100/4-100/100>*4+400/400
				;SPLIT INTO CENTURY		[311]
	IORI	T3,3		;DISCARD FRACTIONS OF DAY	[311]
	IDIVI	T3,4*365+1	;SEPARATE INTO YEARS		[311]
	LSH	T4,-2		;T4=NO DAYS THIS YEAR		[311]
	LSH	T1,2		;T1=4*NO QUADRACENTURIES	[311]
	ADD	T1,T2		;T1=NO CENTURIES		[311]
	IMULI	T1,100		;T1=100*NO CENTURIES		[311]
	ADDI	T1,1501(T3)	;T1 HAS YEAR, T4 HAS DAY IN YEAR	[311]

	MOVE	T2,T1		;COPY YEAR TO SEE IF LEAP YEAR
	TRNE	T2,3		;IS THE YEAR A MULT OF 4?	[311]
	JRST	CNTDT0		;NO--JUST INDICATE NOT A LEAP YEAR  [311]
	IDIVI	T2,100		;SEE IF YEAR IS MULT OF 100	[311]
	SKIPN	T3		;IF NOT, THEN LEAP		[311]
	TRNN	T2,3		;IS YEAR MULT OF 400?		[311]
	TDZA	T3,T3		;YES--LEAP YEAR AFTER ALL	[311]
CNTDT0:	MOVEI	T3,1		;SET LEAP YEAR FLAG		[311]
				;T3 IS 0 IF LEAP YEAR
	;UNDER RADIX 10 **** NOTE WELL ****

CNTDT1:	SUBI	T1,1964		;SET TO SYSTEM ORIGIN
	IMULI	T1,31*12	;CHANGE TO SYSTEM PSEUDO DAYS
	JUMPN	T3,CNTDT2	;IF NOT LEAP YEAR, PROCEED
	CAIGE	T4,31+29	;LEAP YEAR--SEE IF BEYOND FEB 29
	JRST	CNTDT5		;NO--JUST INCLUDE IN ANSWER
	SOS	T4		;YES--BACK OFF ONE DAY
CNTDT2:	MOVSI	T2,-11		;LOOP FOR 11 MONTHS

CNTDT3:	CAMGE	T4,MONTAB+1(T2)	;SEE IF BEYOND THIS MONTH
	JRST	CNTDT4		;YES--GO FINISH UP
	ADDI	T1,31		;NO--COUNT SYSTEM MONTH
	AOBJN	T2,CNTDT3	;LOOP THROUGH NOVEMBER

CNTDT4:	SUB	T4,MONTAB(T2)	;GET DAYS IN THIS MONTH
CNTDT5:	ADD	T1,T4		;INCLUDE IN FINAL RESULT

CNTDT6:	EXCH	T1,(P)		;SAVE ANSWER, GET TIME
	TLZ	T1,-1		;CLEAR DATE
	MUL	T1,[24*60*60*1000]	;CONVERT TO MILLI-SEC.
	ASHC	T1,17		;POSITION RESULT
	POP	P,T2		;RECOVER DATE
	POPJ	P,		;RETURN
	;UNDER RADIX 10 **** NOTE WELL ****

;.CNVDT -- CONVERT ARBITRARY DATE TO SPECIAL FORMAT
;CALL:	MOVE	T1,TIME IN MILLISEC.
;	MOVE	T2,DATE IN SYSTEM FORMAT (Y*12+M)*31+DAY  SINCE 1/1/64
;	PUSHJ	P,.CNVDT
;RETURNS WITH RESULT IN T1 (.GT.0; OR -1 IF BEYOND SEPT. 27,2217)
;	NOTE THAT IN SPECIAL FORMAT, THE LEFT HALF DIVIDED
;	  BY 7 GIVES THE DAY OF THE WEEK (0=WED.)
;USES T2, T3, T4

.CNVDT:	PUSHJ	P,.SAVE1	;PRESERVE P1
	PUSH	P,T1		;SAVE TIME FOR LATER
	IDIVI	T2,12*31	;T2=YEARS-1964
	CAILE	T2,2217-1964	;SEE IF BEYOND 2217
	JRST	GETNW2		;YES--RETURN -1
	IDIVI	T3,31		;T3=MONTHS-JAN, T4=DAYS-1
	ADD	T4,MONTAB(T3)	;T4=DAYS-JAN 1
	MOVEI	P1,0		;LEAP YEAR ADDITIVE IF JAN, FEB
	CAIL	T3,2		;CHECK MONTH
	MOVEI	P1,1		;ADDITIVE IF MAR-DEC
	MOVE	T1,T2		;SAVE YEARS FOR REUSE
	ADDI	T2,3		;OFFSET SINCE LEAP YEAR DOES NOT GET COUNTED
	IDIVI	T2,4		;HANDLE REGULAR LEAP YEARS
	CAIE	T3,3		;SEE IF THIS IS LEAP YEAR
	MOVEI	P1,0		;NO--WIPE OUT ADDITIVE
	ADDI	T4,<1964-1859>*365+<1964-1859>/4+<31-18>+31(T2)
				;T4=DAYS BEFORE JAN 1,1964 +SINCE JAN 1
				; +ALLOWANCE FOR ALL LEAP YEARS SINCE 64
	MOVE	T2,T1		;RESTORE YEARS SINCE 1964
	IMULI	T2,365		;DAYS SINCE 1964
	ADD	T4,T2		;T4=DAYS EXCEPT FOR 100 YR. FUDGE
	HRREI	T2,64-100-1(T1)	;T2=YEARS SINCE 2001
	JUMPLE	T2,GETNW1	;ALL DONE IF NOT YET 2001
	IDIVI	T2,100		;GET CENTURIES SINCE 2001
	SUB	T4,T2		;ALLOW FOR LOST LEAP YEARS
	CAIE	T3,99		;SEE IF THIS IS A LOST L.Y.
GETNW1:	ADD	T4,P1		;ALLOW FOR LEAP YEAR THIS YEAR
	CAILE	T4,^O377777	;SEE IF TOO BIG
GETNW2:	SETOM	T4		;YES--SET -1

	POP	P,T1		;GET MILLISEC TIME
	MOVEI	T2,0		;CLEAR OTHER HALF
	ASHC	T1,-17		;POSITION
	DIV	T1,[24*60*60*1000]  ;CONVERT TO 1/2**18 DAYS
;**;[574] Insert @ GETNW2+6L	JNG	4-May-76
	CAMLE	T2,[^D24*^D60*^D60*^D1000/2]	;[574] OVER 1/2 TO NEXT?
	ADDI	T1,1		;[574] YES, SHOULD ACTUALLY ROUND UP
	HRL	T1,T4		;INCLUDE DATE
GETNWX:	POPJ	P,		;RETURN
	;UNDER RADIX 10 **** NOTE WELL ****

MONTAB:	EXP	0,31,59,90,120,151,181,212,243,273,304,334,365


	;BACK TO OUR FAVORITE RADIX

	RADIX	8
SUBTTL	.LKNAM -- ROUTINES TO GET AND PUT IN A COUNTED LIST

;.LKNAM -- LOOKUP NAME IN TABLE ALLOWING FOR UNIQUE ABBREVIATIONS
;ALWAYS CHECK FOR EXACT MATCH FIRST.
;CALL:	MOVE	T1,[IOWD LENGTH,START OF TABLE]
;	MOVE	T2,NAME
;	PUSHJ	P,.LKNAM
;	ERROR RETURN IF UNKNOWN OR DUPLICATE
;	AND WITH T1.LT.0 IF NOT MATCH, .GT.0 IF SEVERAL MATCHES
;	SKIP RETURN IF FOUND WITH T1 POINTING TO ENTRY
;	AND WITH LH(T1)=0 IF ABBREVIATION, OR T1.LT.0 IF EXACT MATCH
;USES T3, T4
;PRESERVES T2

.LKNAM:	JUMPGE	T1,[SETOM T1	;FLAG UNKNOWN
		    POPJ P,]	;ERROR RETURN
	PUSHJ	P,.SAVE2	;SAVE P1, P2
	PUSH	P,T1		;SAVE ARGUMENT
	MOVE	T3,T2		;SET ARG TO MASK MAKER
	PUSHJ	P,.MKMSK	;MAKE MASK
	MOVE	T2,T3		;RESTORE NAME
	MOVE	P1,T1		;SAVE FOR MATCHING
	POP	P,T1		;RECOVER ARGUMENT
	SETOM	P2		;SET ABBREVIATION MATCH COUNTER
	AOS	T1		;POSITION POINTER
NAME1:	MOVE	T3,(T1)		;FETCH TABLE ENTRY
	TLNE	T3,(3B1)	;NOTE THAT * IS 12 IN SIXBIT
	JRST	NAME2		;NOT FORCED MATCH
	LSH	T3,6		;SEE IF IT MATCHES
	XOR	T3,T2		;EVEN IN AN ABBR.
	TRZ	T3,77		;CLEAR LAST CHAR SINCE WE DON'T KNOW IT
	AND	T3,P1		; ..
	JUMPE	T3,.POPJ1	;YES--GIVE MATCH RETURN
	JRST	NAME3		;NO--LOOP
NAME2:	XOR	T3,T2		;SEE IF EXACT MATCH
	JUMPE	T3,.POPJ1	;YES--A WINNER
	AND	T3,P1		;SEE IF A SUITABLE ABBREVIATION
	JUMPN	T3,NAME3	;NO--LOOP BACK FOR MORE
	MOVE	T4,T1		;SALT AWAY THE LOCATION JUST IN CASE
	AOS	P2		;YES--COUNT 
NAME3:	AOBJN	T1,NAME1	;ADVANCE--LOOP IF NOT DONE YET
	HRRZ	T1,T4		;RESTORE LOCATION OF A WINNER
	JUMPE	P2,.POPJ1	;DONE--JUMP IF ONE ABBREVIATION
	MOVE	T1,P2		;GIVE FLAG TO CALLER
	POPJ	P,		;NONE OR TWO, SO FAIL
;.MKMSK -- MAKE MASK CORRESPONDING TO NON-BLANKS IN SIXBIT WORD
;CALL:	MOVE	T3,WORD
;CALL:	MOVE	T3,WORD
;	PUSHJ	P,.MKMSK
;RETURN WITH MASK IN T1
;USES T2

.MKMSK:	MOVEI	T1,0		;CLEAR MASK
	MOVSI	T2,(77B5)	;START AT LEFT END
MAKMS1:	TDNE	T3,T2		;SEE IF SPACE HERE
	IOR	T1,T2		;NO--IMPROVE MASK
	LSH	T2,-6		;MOVE RIGHT ONE CHAR
	JUMPN	T2,MAKMS1	;LOOP UNTIL DONE
	POPJ	P,		;RETURN

SCN%L:				;LABEL THE LITERAL POOL

	END