Google
 

Trailing-Edge - PDP-10 Archives - BB-J713A-BM - language-sources/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   25-Sept-79


;
;
;                COPYRIGHT (c) 1975,1976,1977,1978,1979
;                    DIGITAL EQUIPMENT CORPORATION
;
;     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==37		;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. Module Storage............................................   6
;    5. S%INIT  --  Initialize the GLXSCN Module..................   7
;    6. S%ERR - ERROR TYPEOUT ROUTINE.............................   8
;    7. S%ERR   --      ERROR MESSAGES FROM COMND.................   8
;    8. S%INTR  --  Interrupt Level Breakout Routine..............   9
;    9. S%CMND  --  Scan a command................................  10
;   10. S%EXIT  --      Exit Address for Interrupt Breakout.......  11
;   11. S%SIXB  --      Convert ASCII to SIXBIT...................  12
;   12. CNVSIX  --      CONVERT ATOM BUFFER TO SIXBIT.............  12
;   13. RETYPE  --  Retype current line including the prompt......  19
;   14. TYPRMT  --  Retype the prompt if there is one.............  19
;   15. TYLINE  --  Retype the line until current position........  19
;   16. Atom Buffer Routines / INILCH - Init Atom Buffer..........  26
;   17. Atom Buffer Routines / STOLCH - Store Character in Atom Buffer  26
;   18. Atom Buffer Routines / CHKLCH - Return Number of Characters  26
;   19. Atom Buffer Routines / TIELCH - Terminate Atom Buffer With NULL  26
;   20. CMCIN  --  Read One Character for Processing..............  27
;   21. HELPER  --  Do caller supplied and default HELP text......  30
;   22. DOHLP  --  Do caller supplied HELP text...................  30
;   23. CMAMB  --  Handle Ambiguous Typein........................  30
;   24. Command Function / .CMINI - Init the scanner and do ^H....  33
;   25. Command Function / .CMSWI - Parse a SWITCH................  34
;   26. Command Function / .CMKEY - Parse a KEYWORD...............  35
;   27. Command Function / .CMTXT - Parse Arbitrary Text to Action Character  39
;   28. Function .CMNOI  --  Parse a NOISE-WORD...................  39
;   29. Command Function / .CMCFM - Command Confirmation (end-of-line)  40
;   30. Command Function / .CMNUM - Parse an INTEGER in any base..  42
;   31. Command Function / .CMNUX - Parse an INTEGER in any base (special break)  42
;   32. Command Function / .CMDEV - Parse a DEVICE specification..  45
;   33. Command Function / .CMQST - Parse a QUOTED STRING.........  45
;   34. Command Function / .CMNOD - Parse a NODE Specification....  46
;   35. PATHIN  Routine to Parse TOPS-10 Path Specification.......  49
;   36. PATH SUPPORT ROUTINES.....................................  51
;   37. S%SCMP  --  String Comparison Routine.....................  55
;   38. S%TBLK  --  Table lookup routine..........................  57
;   39. S%TBAD  --      Table Add Routine.........................  60
;   40. S%TBDL  --      Table Delete Routine......................  61
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

\  ;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
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,TEXT)<
	  SKIPA	T1,[XWD	CODE,[ITEXT (<TEXT>)]]
	XLIST
	  SKIPA
	  JRST  XCOMNE
	LIST
	SALL
> ;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	Date and Time Data Base

TOPS10 <
	DEFINE	DAYERR,<
	X	IDT,<Invalid Date Field Specified>
	X	ITF,<Invalid Time Field Specified>
	X	DOR,<Date/time out of range>
	X	DTM,<Value missing in date/time>
	X	MDD,<Missing day in date/time>
	X	DFZ,<Field zero in date/time>
	X	MDS,<Mnemonic date/time switch not implemented>
	X	DFL,<Field too large in date/time>
	X	ILR,<Illegal year format in date/time>
	X	NND,<Negative number in date/time>
	X	NPF,<Not known whether past or future in date/time>
	X	RDP,<Relative Date Parse Required>
	>;END DAYERR

	.ZZ==0
	DEFINE	X(A,B),<
	E..'A==.ZZ
	.ZZ==.ZZ+1>

	DAYERR			;GENERATE THE CODES

	DEFINE	X(A,B),<
E$$'A:	MOVEI	1,E..'A		;GET THE ERROR
	PJRST	ERRRTN>		;SETUP ERROR RETURN

	XLIST
	SALL
	DAYERR			;GENERATE THE ROUTINES
	LIST


ERRRTN:	MOVEM	S1,LSTERR	;SAVE THE LAST ERROR
	$RETF			;RETURN FALSE


	DEFINE	X(A,B),<
	[ASCIZ\B\]>

	XLIST
	SALL
DERTBL:	DAYERR			;GENERATE MESSAGE TABLE
	LIST


DAYTBL:	$STAB
	KEYTAB(2,<FRIDAY>)
	KEYTAB(5,<MONDAY>)
	KEYTAB(3,<SATURDAY>)
	KEYTAB(4,<SUNDAY>)
	KEYTAB(1,<THURSDAY>)
	KEYTAB(6,<TUESDAY>)
	KEYTAB(0,<WEDNESDAY>)
	$ETAB

MONTBL:	$STAB
	KEYTAB(^D4,<APRIL>)
	KEYTAB(^D8,<AUGUST>)
	KEYTAB(^D12,<DECEMBER>)
	KEYTAB(^D2,<FEBRUARY>)
	KEYTAB(^D1,<JANUARY>)
	KEYTAB(^D7,<JULY>)
	KEYTAB(^D6,<JUNE>)
	KEYTAB(^D3,<MARCH>)
	KEYTAB(^D5,<MAY>)
	KEYTAB(^D11,<NOVEMBER>)
	KEYTAB(^D10,<OCTOBER>)
	KEYTAB(^D9,<SEPTEMBER>)
	$ETAB



>;END TOPS10
SUBTTL	Module Storage



	$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	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 RETURNED FROM NOPARS
	$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
	$DATA	ITARG1			;ITEXT ARGUMENT 1
	$DATA	ITARG2			;ITEXT ARGUMENT 2
	$DATA	ITARG3			;ITEXT ARGUMENT 3
TOPS10 <
	$DATA	CMDACS,20		;AC SAVE AREA FOR COMMAND
	$DATA	PTHBLK,.PTMAX	;STORAGE FOR JOB PATH
	$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	VAL1 		;DEFINE VALUES FOR THE DATA
	$DATA	VAL2 		;BLOCK FOR SECONDS
	$DATA	VAL3 		;BLOCK FOR MINUTES
	$DATA	VAL4 		;BLOCK FOR HOURS
	$DATA	VAL5 		;BLOCK FOR DAYS
	$DATA	VAL6 		;BLOCK FOR MONTHS
	$DATA	VAL7 		;BLOCK FOR YEARS
	$DATA	VAL8 		;BLOCK FOR DECADES
	$DATA	VAL9 		;BLOCK FOR CENTRIES

	$DATA	DAYNUM 		;DAY NUMBER VALUE "D"
	$DATA	SECOND 		;SECONDS
	$DATA	MINUTE 		;MINUTES
	$DATA	HOURS 		;HOURS
	$DATA	DAYS 		;DAYS
	$DATA	NOW 		;CURRENT DATE AND TIME
	$DATA	TIMPTR 		;POINTER FOR THE TIME
	$DATA	TIMCNT 		;COUNT FOR TIME BUFFER CHARACTERS
	$DATA	LSTCHR 		;LAST CHARACTER SEEN
	$DATA	FLFUTD 		;FUTURE TIME FLAG
	$DATA	FLFUTR 		;FUTURE TIME HOLDER
	$DATA	TIMSAV 		;TIME SAVE ADDRESS
	$DATA	STRDAT,5		;LEAVE ROOM FOR DATA
	$DATA	STRPTR 		;POINTER TO THE BLOCK
>;END TOPS10 CONDITIONAL
	$DATA	INTRPT			;FLAG FOR S%INTR
TOPS20 <
	$DATA	BLKSAV			;COMMAND BLOCK ADDRESS
	$DATA	BUFCNT			;SIZE OF COMMAND BUFFER
>;END TOPS20 CONDITIONAL
SUBTTL	S%INIT  --  Initialize the GLXSCN Module

TOPS10 <
S%INIT:	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
	$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 ADDRESS OF ERROR
	JUMPE	S1,.RETF		;NO MESSAGE RETURN FALSE
	$TEXT	(<-1,,SAVBUF>,<^I/(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

;NOPARSE ERROR CODES
NPXNSW==1
NPXNOM==2
NPXNUL==3
NPXINW==4
NPXNC==5
NPXICN==6
NPXIDT==7
NPXNQS==10
NPXAMB==11
NPXNMT==12
NPXCMA==13
NPXNNC==14	;TOO MANY CHARACTERS IN NODE NAME
NPXNNI==15	;ILLEGAL CHARACTER IN NODE NAME
NPXNSN==16	;NO SUCH NODE
NPXIPS==17		;Invalid Path Specification
NPXIFS==20		;Invalid File Specification
NPXIUS==21		;Invalid User Specification
NPXDGS==22	;DEVICE NAME GREATER THAN 6 CHARACTERS ARE INVALID
NPXDNE==23	;DEVICE DOESN'T EXIST
NPXDIO==24	;DEVICE CAN NOT DO INPUT OR OUTPUT
NPXBDF==25	;BAD DATE/TIME FORMAT
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:	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"			;IS THE CHARACTER
	CAILE	T3,"Z"			;NUMERIC OR UPPER CASE?
	$RETT				;RETURN TRUE..END OF FIELD
	CAILE	T3,"9"			;...
	CAIL	T3,"A"			;...
	CAIA				;GOOD CHARACTER, JUST SAVE IT
	$RETT				;RETURN TRUE..END OF FIELD
	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
;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:	ALWAYS, 
;		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	T2,			;ASSUME TRUE RETURN
	SKIPN	INTRPT			;DID INTERRUPT OCCUR SKIP COMND
	COMND				;DO THE COMMAND JSYS
	ERJMP	[SETO T2,		;SET FALSE RETURN
		 JRST CMND.3]		;AND CONTINUE ON
CMND.3:	SETZ	T3,			;SET FLAG
	EXCH	T3,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	T3			;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	T2,			;YES, RETURN FALSE
	LOAD	S1,.CMFNP(T1),CM%FNC	;GET FUNCTION DONE
	MOVEM	S1,CRBLK+CR.COD		;SAVE IT
	JUMPL	T2,.RETF		;RETURN FALSE IF NCESSARY
	$RETT				;ELSE, RETURN TRUE
>  ;END TOPS20 CONDITIONAL
TOPS10 <
;!!!!!NOTE WELL - THIS CONDITIONAL RUNS TO THE END OF COMND ROUTINE

S%CMND:	MOVEM	0,CMDACS	;SAVE THE COMMAND ACS
	MOVE	0,[XWD 1,CMDACS+1] ;SET UP BLT POINTER
	BLT	0,CMDACS+17	;SAVE THE ACS
	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
	MOVSI	17,CMDACS+T1	;SETUP TO RESTORE ACS
	HRRI	17,T1		;RESTORE FROM T1
	BLT	17,17		;RESTORE THE ACS
	POPJ	P,0		;NO 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
		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,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

;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

;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

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:	MOVEM	T1,LSTERR	;SAVE ERROR CODE
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
	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:	PUSHJ	P,CRLF			;TYPE CRLF TO GET TO LEFT MARGIN
	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
CMIND1:	MOVE	S1,IIFN		;GET IFN
	PUSHJ	P,F%IBYT	;GET A BYTE
	JUMPF	CMIND2		;IF FAILS FIND OUT WHY
	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
;****************************************
;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

;USERNAME BREAK SET. BREAKS ON EVERYTHING EXCEPT DOT AND ALPHABETICS.

USRBRK:	777777,,777760		;BREAK ON ALL CONTROLS
	777744,,001760		;ALLOW - . 0-9
	400000,,000760		;ALLOW UC
	400000,,000760		;ALLOW LC

;READ TO END OF LINE

EOLBRK:	1B<.CHLFD>		;END OF LINE ONLY
	EXP	0,0,0		;THREE WORDS OF 0'S
;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 "]")
	TXNE	F,CMQUES	;RETURN IF HELP REQUESTED
	 POPJ	P,0
	MOVE	T1,P4		;GET POINTER TO LAST CHARACTER
	ILDB	T1,T1		;GET TERMINATOR
	CAIN	T1,"]"		;END OF PATH?
	JRST	CMRP.1		;YES -- STORE TERMINATOR AND RETURN
	JXN	F,CM%ESC,CMAMB		;DING IF ESCAPE TYPED
	POPJ	P,0		;ELSE RETURN

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

PTHBRK:	777777,,777760		;BREAK ON ALL CONTROL CHARACTERS
	777734,,001760		;ALLOW , 0-9
	400000,,000360		;BREAK ON "]" ALLOW UC AND "["
	400000,,000760		;ALLOW LC
;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
	TXNE	F,CMDEFF	;DEFAULT GIVEN?
	JRST	CMRATT		;YES, ALREADY IN BUFFER
CMRAT1:	PUSHJ	P,CMCIN		;GET A CHAR
	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,CMRATT	;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]
	move	T2,t1		;get copy of char
	IDIVI	T2,40		;COMPUTE INDEX TO BIT MASK
	MOVE	T3,BITS(t3)
	ADD	T2,CMRBRK
	TDNE	T3,0(t2)	;BREAK CHARACTER?
	JRST	CMRATR		;YES
	PUSHJ	P,STOLCH	;BUILD KEYWORD STRING
	JRST	CMRAT1

CMRATR:	PUSHJ	P,CMDIP		;PUT CHARACTER BACK IN BUFFER
CMRATT:	PJRST	TIELCH		;TIE OFF ATOM BUFFER AND RETURN
;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
	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]
	CAIN	T1,.CHLFD		;END OF LINE?
	TXO	F,CM%EOC		;YES, MEANS END OF COMMAND
	POPJ	P,0
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%PUN+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	;
	SETZM	TI+.RDBRK	;NO SPECIAL 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
CMCN2B:	MOVEI	S1,TI		;GET LOCATION OF TEXTI BLOCK
	PUSHJ	P,K%TXTI	;DO INTERNAL TEXTI
	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
	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,CMFREC	;A RECOG REQUEST CHAR?
	CAIN	T1,.CHESC
	TXZ	F,CM%ESC+CMCFF	;YES, RESET FLAGS
	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:	SOS	S1		;BACK OFF ONE WORD
	IBP	S1		;AND THEN GO FORWARD 4 TIMES
	IBP	S1
	IBP	S1
	IBP	S1
	$RETT			;THEN 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:	MOVEI	S1,[ASCIZ /
  or/]
	TXNE	F,CMQUE2		;IN ALTERNATE HELP POSSIBILITIES?
	PUSHJ	P,CMDSTO
	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	K%SOUT			;AND TYPE IT


SUBTTL	CMAMB  --  Handle Ambiguous Typein

CMAMB:	TXZN	F,CM%ESC		;ESC SEEN?
	NOPARS (NPXAMB,Ambiguous)
	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:	PUSHJ	P,CMDOUT		;OUTPUT A CHARACTER
	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	K%SOUT			;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	(NPXNSW,Unrecognizable Switch Construction)]
	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(NPXNOM,No KEYWORD Match)
	JXN	T2,TL%AMB,CMAMB		; ??? AMBIGUOUS
	MOVEM	T1,T2			;SAVE TABLE INDEX
	MOVEM	T1,CRBLK+CR.RES		;AS RESULT
	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 (NPXNUL,KEYWORD Expected)] 	;FAIL IF NULL
	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 STRING
	MOVEI	S1,[ASCIZ /text string/]
	TXNE	F,CMQUES		;QUESTION MARK TYPED?
	PUSHJ	P,HELPER		;YES, GIVE HELP
	JRST	XCOMXI			;DONE


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	(NPXINW,Bad Noise Word)	;NO, PROBABLY BAD NOISE WORD
SUBTTL	Command Function / .CMCFM - Command Confirmation (end-of-line)

XCMCFM:	PUSHJ	P,CMCFM0		;DO THE WORK
	NOPARS(NPXNC,CONFIRMATION Required)
	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
	MOVE	S1,.CMABP(P2)	;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
CMNUM1:	NOPARS	(NPXICN,Numeric Character Expected)

;NUMBER BREAK SET, ALLOWS +, -, NUMBERS

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

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


	SUBTTL	NUMIN	--	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


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:	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
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
	JXN	F,CM%ESC,CMAMB		;AMBIGUOUS
	MOVE	S1,.CMABP(P2)		;ADDRESS OF BUFFER
	MOVEM	S1,ITARG1		;SAVE ARGUMENT
	PUSHJ	P,CMCIN			;CHECK TERMINATOR
	CAIE	T1,":"			;DEVICE?
	NOPARS(NPXIDT,<Invalid Device ^Q/ITARG1/  Device Specifications Requires a :>)
	TXNE	F,CM%PO			;PARSE ONLY ON FIELD
	JRST	XCOMXR			;YES..RETURN O.K.
	MOVE	S1,.CMABP(P2)		;POINT AT THE ATOM BUFFER
	PUSHJ	P,CNVSIX		;CONVERT FIELD TO SIXBIT
	SKIPT				;O.K. S1/  FIELD NAME
	NOPARS(NPXDGS,<DEVICE Name ^Q/ITARG1/: is Greater Than Six Characters>)
	DEVCHR	S2,			;SEE IF IT EXISTS
	SKIPN	S2			;VALID DATA
	NOPARS(NPXDNE,<DEVICE Name ^Q/ITARG1/: Does Not Exist>)
	TXNE	S2,DV.IN!DV.OUT		;CHECK IF CAN DO INPUT OR OUTPUT
	PJRST	XCOMXR			;YES..RETURN O.K.
	NOPARS(NPXDIO,<DEVICE ^Q/ITARG1/: can not 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(NPXNQS,Quoted String Expected)
	MOVEI	S1,[ASCIZ /quoted string/]
	TXNE	F,CMQUES		;QUESTION MARK TYPED?
	PUSHJ	P,HELPER		;YES, GIVE HELP
	JRST	XCOMXI

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

XCMUQS:
CMUQS1:	PUSHJ	P,CMCIN		;GET A CHAR
	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
	PUSHJ	P,CMDIP		;YES, PUT CHAR BACK
	JRST	XCOMXI		;DONE

;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,USRBRK	;SAME BREAK SET AS USER NAME FIELD
	PUSHJ	P,CMRFLD	;READ FIELD
	JRST	CMFLD1		;FINISH LIKE ARBITRARY FIELD
SUBTTL	Command Function / .CMNOD - Parse a NODE Specification

XCMNOD:	PUSHJ	P,CMRATM		;GET AN ATOM
	MOVEI	S1,[ASCIZ /node name/]
	TXNE	F,CMQUES		;DID HE TYPE A QUESTION MARK?
	PUSHJ	P,HELPER		;YES, TYPE THE HELP TEXT(S)
	JXN	F,CM%ESC,[PUSHJ P,CMDCH	;DO RECOGNITION IF REQUESTED
			  PUSHJ P,TIELCH;TIE ATOM BUFFER
			  JRST  XNOD1]	;RETURN IN LINE
XNOD1:	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	XNOD2			;LOST, TRY AS A SIXBIT NAME
	MOVEM	S2,CRBLK+CR.RES		;SAVE AS RESULT
	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!
	MOVE	T3,CRBLK+CR.RES		;NODE NUMER WE JUST PARSED
	TXNE	F,CM%PO			;PARSE ONLY?
	JRST	XCOMXI			;YES, JUST RETURN WITH RESULT
	MOVE	T1,[XWD .NDRNN,T2] 	; MAKE SURE THAT THIS NODE NUMBER EXISTS
	MOVEI	T2,2			;2 ARGS
	NODE.	T1,			;TRY IT FOR EXISTANCE
	  JRST	ILLNOD			;IT DOESN'T!
	JRST	XCOMXI			;A GOOD NODE NUMBER, RETURN

XNOD2:	MOVE	S1,.CMABP(P2)		;POINT AT THE ATOM BUFFER
	PUSHJ	P,CNVSIX		;CONVERT BUFFER TO SIXBIT
	SKIPT				;O.K.. CONTINUE
ILLNOD:	NOPARS	(NPXNNC,Improper Node Name)
	MOVEM	S2,CRBLK+CR.RES		;SAVE SIXBIT NAME IN RESULT FIELD

XNOD3:	TXNE	F,CM%PO			;PARSE ONLY?
	PJRST	XCOMXR			;YES..RETURN NOW
	MOVE	T2,ATBPTR		;GET POINTER TO END OF ATOM BUFFER
	IBP	T2			;POINT AT TERMINATOR
	CAME	S1,T2			;OUR POINTER END THE SAME PLACE?
	NOPARS	(NPXNNI,Node Name Expected)

XNOD4:	MOVEI	T2,2			;2 ARGS
	MOVE	T3,S2			;GET NODE NAME RETURNED

	MOVEM	S2,ITARG1		;SAVE NODE NAME
	MOVE	T1,[XWD .NDRNN,T2]
	NODE.	T1,0
	  NOPARS(NPXNSN,<Node ^W/ITARG1/ Not a Valid  Node>)
	MOVEM	T1,CRBLK+CR.RES		;STORE NUMBER
	JRST	XCOMXI			;AND RETURN
;INDIRECT FILESPEC (INTERNAL CALL)

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

XCMOFI:
XCMIFI:


XCMFIL:	PUSHJ	P,CMRFIL	;GET 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:	PUSHJ	P,FILIN		;GET FILE SPEC
	  NOPARS (NPXIFS,Invalid File Specification)
	MOVE	T2,ATBPTR	;GET POINTER TO ATOM BUFFER END
	IBP	T2		;BUMP PAST TERMINATOR
	CAME	T2,XXXPTR	;DOES IT MATCH?
	  NOPARS (NPXIFS,Invalid File Specification)
	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
	SKIPN	S1,.FDSTR(P1)	;SEE IF USER SUPPLIED A DEFAULT DEVICE
	MOVSI	S1,'DSK'	;NO, SUPPLY DEFAULT DEVICE
	STORE	S1,.FDSTR(P1)	;STORE DEFAULT DEVICE
	MOVE	T1,.CMABP(P2)	;GET ATOM BUFFER POINTER
	MOVEM	T1,XXXPTR	;STORE IT
	PUSHJ	P,FTOKEN	;GET FIRST FILE TOKEN
	CAIE	T2,':'		;IS FIRST PART A DEVICE
	JRST	FILI.1		;NO
	MOVEM	T1,.FDSTR(P1)	;STORE STRUCTURE NAME
	PUSHJ	P,FTOKEN	;YES, LOAD NEXT TOKEN
FILI.1:	JUMPN	T1,FILI.2	;IF WE HAVE SOMETHING, IT MUST BE FILENAM
	CAIE	T2,'['		;IF NOT, EXPECT A PPN HERE
	JRST	FILI.4		;CHECK FOR SUFFICIENT FILE-SPEC
	MOVE	S1,XXXPTR	;GET POINTER TO PPN
	PUSHJ	P,DBP		;DECREMENT POINTER
	MOVE	T1,S1		;GET THE POINTER
	MOVEI	T2,.FDPPN(P1)	;POINT TO DESTINATION
	HRLI	T2,5		;AND SET MAXIMUM DEPTH FOR SFD'S
	PUSHJ	P,PATHIN	;PARSE PATH
	  POPJ	P,		;PASS ON FAILURE
	PUSHJ	P,FTOKEN	;AND GET NEXT PART
FILI.2:	SKIPE	T1		;IF NO FILE NAME, LOOK FOR EXTENSTION
	STORE	T1,.FDNAM(P1)	;STORE NAME
	CAIE	T2,'.'		;IS THERE AN EXTENSION?
	JRST	FILI.3		;NO
	PUSHJ	P,FTOKEN	;GET EXTENSION
	STORE	T1,.FDEXT(P1)	;AND STORE IT
FILI.3:	CAIE	T2,'['		;HAVE WE GOT A PPN?
	JRST	FILI.4		;CHECK FOR SUFFICIENT FILE-SPEC
	MOVE	S1,XXXPTR	;RELOAD THE POINTER
	PUSHJ	P,DBP		;DECREMENT IT
	MOVE	T1,S1		;PLACE POINTER BACK IN T1
	MOVEI	T2,.FDPPN(P1)	;POINT TO DESTINATION
	HRLI	T2,5		;AND SET MAXIMUM SFD DEPTH
	PUSHJ	P,PATHIN	;PARSE THE PATH
	  POPJ	P,		;RETURN A FAILURE
	IBP	XXXPTR		;AND BUMP PAST TERMINATOR
FILI.4:	SKIPN	.FDNAM(P1)	;MAKE SURE THERE IS A NAME
	POPJ	P,		;NO NAME, BAD FILE SPEC
	RETSKP			;TAKE GOOD RETURN


FTOKEN:	SETZM	T1		;CLEAR RESULT
	MOVE	T3,[POINT 6,T1]	;AND POINT TO STORAGE AREA
	
FTOK.1:	ILDB	T2,XXXPTR	;GET A BYTE
	PUSHJ	P,C7TO6		;CONVERT TO SIXBIT
	CAIG	T2,'Z'		;IS IT IN RANGE?
	CAIGE	T2,'0'		;
	POPJ	P,0		;NO
	CAILE	T2,'9'		;
	CAIL	T2,'A'		;
	SKIPA
	POPJ	P,0
	TXNE	T3,<INSVL.(77,BP.POS)> ;IS THERE ROOM?
	IDPB	T2,T3		;YES,STORE IT
	JRST	FTOK.1		;TRY ANOTHER

C7TO6:	CAIL	T2,"a"		;IS IT LC?
	SUBI	T2,40		;YES
	SUBI	T2," "		;CONVERT TO SIXBIT
	ANDI	T2,77		;MASK IT AND
	POPJ	P,		;RETURN
;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
CMTOK1:	ILDB	Q2,Q1		;GET NEXT CHAR IN STRING
	JUMPE	Q2,[PUSHJ P,TIELCH	;SUCCESS IF END OF STRING
		JRST	XCOMXI]
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
		MOVEI	S1,""""		;TYPE "token"
		PUSHJ	P,CMDOUT
		MOVE	S1,FNARG
		PUSHJ	P,CMDSTO
		MOVEI	S1,""""
		PUSHJ	P,CMDOUT
		JRST	CMRTYP]
	NOPARS	(NPXNMT,Invalid Token Found)	;NO MATCH OF 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,0		;ELSE FAIL
	PUSHJ	P,.SAVE2	;PRESERVE P1-P2
	HRRZ	P2,T2		;GET DESTINATION ADDRESS
	HRLI	P2,P1		;P2 IS NOW  DESTINATION(P1)
	AOBJP	T2,.+1		;ADD ONE TO INCLUDE PPN WITH SFD'S
	HLLZ	P1,T2		;GET DEPTH IN P1 LEFT HALF
	MOVN	P1,P1		;P1 IS NOW AOBJN POINTER
	PUSHJ	P,RDPATH	;GET CURRENT PATH IN PTHBLK
	MOVEM	T1,XXXPTR	;SAVE IN CASE OF PPN FAILURE
	MOVE	S1,T1		;GET THE POINTER
	MOVEI	S2,^D8		;SET OCTAL RADIX
	PUSHJ	P,NUMIN		;FOR PROJECT AND PROGRAMMER NUMBERS
	LDB	T1,S1		;GET TERMINATOR
	CAIE	T1,","		;MUST BE COMMA
	  POPJ	P,0		;FAIL -- PPN NOT NUMERIC
	SKIPN	S2		;WAS ANSWER 0?
	HLR	S2,PTHBLK+.PTPPN ;YES -- LOAD DEFAULT
	HRLM	S2,(P2)		;STORE IN DESTINATION
	MOVEI	S2,^D8		;SET OCTAL RADIX
	PUSHJ	P,NUMIN
	LDB	T1,S1		;GET TERMINATOR
	CAIE	T1,","		;MUST BE COMMA OR BRACKET
	CAIN	T1,"]"
	 SKIPA
	 POPJ	P,0		;FAIL -- PPN INCORECT
	SKIPN	S2		;WAS ANSWER 0
	HRR	S2,PTHBLK+.PTPPN ;YES -- LOAD DEFAULT
	HRRM	S2,(P2)		;STORE IN DESTINATION
	MOVEM	S1,XXXPTR	;STORE UPDATED POINTER
	MOVE	T1,(P2)		;RECLAIM PPN
	JRST	PATH.2		;LOOK FOR SFD'S
PATH.1:	PUSHJ	P,FTOKEN	;GET TOKEN
PATH.2:SKIPN	T1		;IF FIELD IS ZERO
	MOVE	T1,PTHBLK+.PTPPN(P1) ;LOAD DEFAULT
	JUMPE	T1,.POPJ	;FAIL IF DEFAULT WAS 0
	MOVEM	T1,@P2		;STORE RESULT
	LDB	S1,XXXPTR	;GET TERMINATOR
	CAIN	S1,"]"		;AT END OF PATH?
	JRST	PATH.3		;YES -- CLEAR REST OF PATH
	CAIE	S1,","		;VALID SEPARATOR?
	 POPJ	P,0		;NO -- GIVE FAILURE RETURN
	AOBJN	P1,PATH.1	;REPEAT UNTIL MAXIMUM DEPTH
	POPJ	P,0		;TO DEEP -- GIVE FAILURE
	
PATH.3:	AOBJP	P1,PATH.4	;CLEAR REST OF PATH
	SETZM	@P2		;CLEAR REST OF DESTINATION
	JRST	PATH.3

PATH.4:	RETSKP			;GIVE GOOD RETURN
SUBTTL	PATH SUPPORT ROUTINES

; RDPATH Routine to Read Path for channel or job
; CALL Using No Arguments
; RETURN With Job's Path in PTHBLK

RDPATH:	MOVEI	S1,.PTMAX	;CLEAR ANSWER AREA
	MOVEI	S2,PTHBLK
	PUSHJ	P,.ZCHNK
	SETOM	PTHBLK			;REQUEST PATH FOR CURRENT JOB
	MOVE	S1,[.PTMAX,PTHBLK]	;POINT TO BLOCK
	PATH.	S1,
	 SETZM	PTHBLK			;OOPS -- FAILED
	POPJ	P,0			;RETURN
; PPN (EITHER DIRECTORY OR USER NAME FUNCTION)


XCMDIR:
XCMUSR:				;EQUIVALENT
	PUSHJ	P,CMRPTH	;GET PATH SPEC INTO ATOM
	MOVEI	S1,[ASCIZ/[Project,Programmer]/]
	JXN	F,CMQUES,HELPER	;GIVE HELP IF REQUESTED
	JXN	F,CM%ESC,[PUSHJ P,CMDCH	;ALLOW ESCAPE AS TERMINATOR
		  PUSHJ P,TIELCH
		  JRST XUSR.1]		;RETURN IN LINE

XUSR.1:	MOVE	T1,.CMABP(P2)	;POINT TO ATOM
	MOVEI	T2,CRBLK+CR.RES	;POINT TO DESTINATION
	PUSHJ	P,PATHIN	;PARSE PATH
	 NOPARS (NPXIUS,Invalid User Specification)
	MOVE	T1,XXXPTR	;Ensure Entire atom was parsed
	CAME	T1,ATBPTR
	 NOPARS (NPXIUS,Invalid User 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	(NPXCMA,Comma was Expected)	;FAIL
;DATE AND/OR TIME
;FLAGS IN ARG SPECIFY WHICH

XCMTAD:	MOVE	Q1,FNARG	;GET ARG
	PUSHJ	P,CMRSPC	;READ FIRST FIELD
	JXN	F,CMQUES,CMTADH	;DO HELP IF REQUESTED
	JXN	F,CMDEFF,CMTAD1	;JUMP IF NOW HAVE FIELD DEFAULT
;	TXC	Q1,CM%IDA+CM%ITM ;DATE AND TIME BOTH?
;	TXCN	Q1,CM%IDA+CM%ITM
;	JRST	[MOVEI	T1," "		;YES, PUT SPACE IN ATOM BUFFER
;		PUSHJ	P,STOLCH
;		PUSHJ	P,CMRSPC	;READ SECOND FIELD
;		JXN	F,CMQUES,CMTADH ;DO HELP
;		JRST	.+1]
CMTAD1:	PUSHJ	P,DATIM		;GET DATE AND TIME
	JUMPT	CMTAD2		;CONTINUE ON
	MOVEI	S2,@DERTBL(S1)	;GET MESSAGE ADDRESS
	MOVEM	S2,ITARG1	;SAVE THE ARGUMENT
	NOPARS	(NPXBDF,<^T/@ITARG1/>)

CMTAD2:	TXNE	Q1,CM%NCI	;CONVERT TO INTERNAL FORMAT?
	  JRST CMTAD3		;NO .. STORE DATA IN USER BLOCK 
	MOVEM	S1,CRBLK+CR.RES	;STORE RESULT
	JRST	XCOMXR		;OK, TAD ALREADY IN T2
CMTAD3:	MOVEM	S1,NOW		;SAVE THE TIME FOR NOW
	PUSHJ	P,CMPDAT	;GET THE VALUE
	MOVE	S1,VAL9		;GET CENTURY
	IMULI	S1,^D100	;MAKE IT YEARS
	MOVE	S2,VAL8		;GET DECADES
	IMULI	S2,^D10		;MAKE YEARS ALSO
	ADD	S2,S1		;COMBINE THEM
	ADD	S2,VAL7		;GET THE YEAR FIELD
	HRL	S1,S2		;PLACE IN LEFT HALF
	HRR	S1,VAL6		;GET THE MONTH
	MOVEM	S1,0(Q1)	;SAVE IN THE BLOCK
	HRLZ	S1,VAL5		;GET THE MONTH
	MOVEM	S1,1(Q1)	;SAVE THE SECOND WORD
	MOVE	S1,SECONDS	;GET SECONDS
	HRRZM	S1,2(Q1)	;RIGHT HALF OF THIRD WORD
	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
	SUBTTL	DATIM	--	DATE AND TIME PARSER
	;These routines are called by the .CMTAD function of GLXSCN
	;for processing date and time data
	;
	;
	;	CALL	S1/	POINTER TO THE STRING
	;		S2/	NUMBER OF CHARACTERS IN BUFFER
	;
	;
	;	RETURN TRUE	S1/	UDT FOR THE TIME
	;	RETURN FALSE	ERROR CODE IN S1


DATIM:	PUSHJ	P,.SAVE1		;SAVE P1
	MOVE	S1,.CMABP(P2)		;POINT TO ATOM BUFFER
	MOVE	S2,.CMABC(P2)		;COUNT IN THE ATOM BUFFER
	SUB	S2,ATBSIZ		;GET THE ACTUAL COUNT
	DMOVEM	S1,TIMPTR		;SAVE POINTER AND COUNT
	SETZM	FLFUTD			;CLEAR THE FUTURE
	SETZM	FLFUTR			;CLEAR THE VALUES
	SETOM	VAL1			;SET DEFAULT VALUES
	MOVE	S1,[VAL1,,VAL2]		;GET BLT POINTER
	BLT 	S1,VAL9			;DEFAULT ALL VALUES
	PUSHJ	P,I%NOW			;GET THE CURRENT DATE AND TIME
	MOVEM	S1,NOW			;SAVE THE TIME
	MOVE	S1,FNARG		;GET THE ARGS
	PUSHJ	P,GETCHR		;GET A CHARACTER
	CAIN	S1,"+"			;WAS IT A +
	  PJRST	PLSRTN			;CHECK PLUS ROUTINE
	CAIN	S1,"-"			;WAS IT A MINUS
	  PJRST	MINRTN			;MINUS ROUTINE
	CAIL	S1,"0"			;LESS THAN 0
	CAILE	S1,"9"			;LESS THAN 9
	  PJRST	DATPAR			;NO TRY PARSING THE DATE
	PUSHJ	P,DECBPT		;BACK UP TO FIRST CHARACTER
	PUSHJ	P,DECNUM		;GET THE NUMBER
	JUMPF	E$$IDT			;INVALID DATE AND TIME
	MOVEM	S1,DAYNUM		;SAVE THE NUMBER
	SKIPN	S2,LSTCHR		;GET LAST CHARACTER
	  PJRST	DATI.1			;SETUP FOR TIMPAR
	CAIN	S2,"D"			;CHECK IF DAYS	
	  JRST	DAYRTN			;PROCESS THE DAYS
	CAIE	S2,":"			;
	  PJRST	ALTDAT			;TRY THE ALTERNATE DATE FORMS
DATI.1:	MOVE	S1,.CMABP(P2)		;POINT TO ATOM BUFFER
	MOVE	S2,.CMABC(P2)		;COUNT IN THE ATOM BUFFER
	SUB	S2,ATBSIZ		;GET THE ACTUAL COUNT
	DMOVEM	S1,TIMPTR		;GET BACK TO START
DATI.2:	PUSHJ	P,TIMPAR		;PARSE THE TIME
	JUMPF	.POPJ			;ERROR..RETURN
	PJRST	CMPDAT			;COMPUTE THE DATE AND RETURN
	SUBTTL	TIMPAR	--	PARSE THE TIME FIELD

	;This routine will parse a time and return
	;
	;RETURN:	S1/	TIME IN SECONDS
	;		S2/	FRACTION OF DAY IN RH

TIMPAR:	MOVE	S1,FNARG		;GET THE ARGUMENT FLAGS
	TXNN	S1,CM%ITM		;TIME WANTED?
	  PJRST	E$$ITF			;TIME FIELD INVALID
	SETZM	SECOND			;CLEAR SECONDS
	SETZM	MINUTE			;CLEAR MINUTES
	SETZM	HOURS			;CLEAR HOURS
	PUSHJ	P,DECNUM		;GET A DECIMAL NUMBER
	JUMPF	E$$ITF			;INVALID DATE AND TIME FUNCTION
	JUMPL	S1,E$$ITF		;INVALID DATE AND TIME
	MOVEM	S1,DAYNUM		;SAVE THE NUMBER
	MOVEM	S1,SECOND		;SAVE AS SECONDS
	MOVE	S2,LSTCHR		;GET LAST CHARACTER
	CAIN	S2,"D"			;WAS IT A D(DAYS)
	  PJRST E$$RDP			;REQUIRES RELATIVE DATE CHECK
	CAIE	S2,":"			;WAS IT A COLON
	  PJRST	FINTIM			;FINISH OFF THE TIME
	PUSHJ	P,DECNUM		;GET THE NEXT FIELD
	JUMPF	E$$ITF			;INVALID DATE AND TIME FUNCTION
	JUMPL	S1,E$$ITF		;INVALID DATE AND TIME
	EXCH	S1,SECOND		;GET THE SECONDS AS MINUTES
	MOVEM	S1,MINUTE		;SAVE THE MINUTES
	MOVE	S1,LSTCHR		;GET THE LAST CHARACTER
	CAIE	S1,":"			;WAS IT A COLON
	  PJRST	FINTIM			;FINISH OFF THE TIME
	PUSHJ	P,DECNUM		;GET A DECIMAL NUMBER
	JUMPF	E$$ITF			;INVALID DATE AND TIME FUNCTION
	JUMPL	S1,E$$ITF		;INVALID DATE AND TIME
	EXCH	S1,SECOND		;SAVE AS SECONDS
	EXCH	S1,MINUTE		;SAVE AS MINUTES
	MOVEM	S1,HOURS		;SAVE AS HOURS

FINTIM:	MOVE	S1,SECOND		;GET THE SECONDS
	CAIL	S1,^D60			;LESS THAN 60
	  PJRST	E$$ITF			;INVALID DATE AND TIME
	MOVEM	S1,VAL2			;SAVE THE SECONDS
	MOVE	S1,MINUTE		;GET THE MINUTES
	CAIL	S1,^D60			;CHECK LESS THAN 60
	  PJRST	E$$ITF			;INVALID DATE AND TIME
	MOVEM	S1,VAL3			;SAVE THE MINUTES
	MOVE	S1,HOURS		;GET THE HOURS
	CAIL	S1,^D24			;LESS THAN 24
	  PJRST	E$$ITF			;INVALID DATE AND TIME
	MOVEM	S1,VAL4			;SAVE THE HOURS
	IMULI	S1,^D60			;CONVERT TO MINUTES
	ADD	S1,VAL3			;ADD IN THE MINUTES
	IMULI	S1,^D60			;CONVERT TO SECONDS
	ADD	S1,VAL2			;ADD IN THE SECONDS
	SETZM	T1			;CLEAR OTHER HALF
	MOVE	S2,S1			;GET THE VALUE
	ASHC	S2,-^D17		;MULTIPLY BY 2**18
	DIVI	S2,^D24*^D3600		;DIVIDE BY SECONDS PER DAY
					;GET FRACTION OF A DAY IN RH
	$RETT				;RETURN TRUE
	SUBTTL	PLSRTN	--	PROCESS DATE WITH "+"

	SUBTTL	MINRTN	--	PROCESS DATE WITH "-"

	SUBTTL	DAYRTN	--	PROCESS DAY "D"

PLSRTN:	AOS	FLFUTD			;INDICATE IN THE FUTURE
	SKIPA				;GET TIME
MINRTN:	SOS	FLFUTD			;INDICATE IN THE PAST
MINI.1:	PUSHJ	P,TIMPAR		;PARSE THE TIME
	JUMPT	RELDAY			;O.K. COMPUTE RELATIVE DAY
	CAIN	S1,E..RDP		;CHECK FOR RELATIVE DATE ERROR
	JRST	DAYRTN			;YES CHECK OUT DATE
	$RETF				;NO..PASS ERROR BACK
RELDAY:	SKIPGE	FLFUTD			;CHECK THE TIME
	MOVN	S2,S2			;PAST.. COMPLEMENT THE TIME
	ADD	S2,NOW			;GET THE VALUE
	MOVE	S1,S2			;GET THE TIME
	PJRST	DATEXT			;EXIT WITH DATE


DAYRTN:	SETZM	LSTERR			;CLEAR LAST ERROR
	HRLZ	S2,DAYNUM		;GET THE NUMBER
	SOSG	TIMCNT			;ANY CHARACTERS LEFT?
	  PJRST	RELDAY			;NO..COMPUTE THE DAY
	PUSHJ	P,GETCHR		;GET A CHARACTER
	JUMPF	E$$IDT			;INVALID DATE TIME
	CAIE	S1,":"			;BETTER BE A COLON
	  PJRST E$$IDT			;NO..BAD DATE/TIME
	HRLZ	S2,DAYNUM		;GET THE NUMBER
	SKIPGE	FLFUTD			;CHECK THE TIME
	MOVN	S2,S2			;PAST.. COMPLEMENT THE TIME
	ADDM	S2,NOW			;GET THE VALUE
	PJRST	MINI.1			;YES.. NOW GET DATE
	SUBTTL	CMPDAT	--	COMPUTE THE DATE FROM VALUES


	;This routine will default fields with the current values of time
	;for those fields that were not input

;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).

CMPDAT:	MOVE	S1,NOW		;GET CURRENT DATE/TIME
	PUSHJ	P,CNTDT##	;CONVERT TO EASY FORMAT
				;RETURN S1 TIME IN SECONDS 
				;	S2 TIME IN SYSTEM FORMAT
	MOVEM	S1,SECONDS	;SAVE THE VALUE OF SECONDS
	ADD	S2,[^D1964*^D12*^D31]  ;MAKE REAL
	MOVEI	T2,8		;TRY 8 FIELDS			
CMPD.1:	MOVE	S1,S2		;POSITION REMAINDER
	IDIV	S1,ADJTBL-1(T2)	;GET THE ADJUSTMENT
	SKIPL	VAL1(T2)	;SEE IF DEFAULT			
	JRST	[TLNN T1,-1	;NO--FLAG TO ZERO DEFAULTS	
		 HRL  T1,T2	; SAVING INDEX OF LAST DEFAULT	
		 JRST CMPD.2]	;AND CONTINUE LOOP
	SETZM	VAL1(T2)	;DEFAULT TO ZERO		
	TLNN	T1,-1		;SEE IF NEED CURRENT		
	MOVEM	S1,VAL1(T2)	;YES--SET THAT INSTEAD		
CMPD.2:	CAME	S1,VAL1(T2)	;SEE IF SAME AS CURRENT		
	JRST	CMPD.3		;NO--REMEMBER FOR LATER
	CAIN	T2,4		;SEE IF TIME FOR TIME		
	HRRZ	S2,T1		;YES--GET IT
	SOJG	T2,CMPD.1	;LOOP UNTIL ALL DONE		

;HERE WHEN FILLED IN CURRENT FOR SIGNIFICANT DEFAULTS

CMPD.3:	SKIPGE	VAL1(T2)	;SEE IF DEFAULT			
	SETZM	VAL1(T2)	;CLEAR DEFAULT			
	SOJG	T2,CMPD.3	;LOOP UNTIL DONE		
	HLRZ	P1,T1		;RECOVER LAST SIGN. DEFAULT-1	
	JUMPE	P1,CMPD.4	;DONE IF NONE			
	PUSHJ	P,MAKDAT	;MAKE CURRENT DATE, TIME
	MOVE	T2,FLFUTD	;GET DEFAULT DIRECTION
	XCT	[CAMGE	S1,NOW
		 JFCL
		 CAMLE	S1,NOW]+1(T2)  ;SEE IF OK
	JRST	CMPD.4		;YES--GO RETURN
	SKIPG	FLFUTD		;NO--SEE WHICH DIRECTION
	SOSA	VAL2(P1)		;PAST
	AOS	VAL2(P1)		;FUTURE
CMPD.4:	PUSHJ	P,MAKDAT	;REMAKE ANSWER
	MOVE	P1,T1		;MOVE TO ANSWER
	PJRST	DATEXT		;DATE EXIT AND RETURN
	SUBTTL	DATEXT	--	DATE EXIT ROUTINE

	;THIS ROUTINE WILL CHECK DATE AND RETURN

	RADIX	10

DATEXT:	TRC	S1,-1			;COMPLEMENT THE LEFT SIDE
	TRCN	S1,-1			;CHECK IF -1
	AOS	S1			;BUMP S1
	CAML	S1,[<1964-1859>*365+<1964-1859>/4+<31-18>+31,,0] ;CHECK RANGE
	$RETT				;RETURN TRUE

	RADIX	8

	PJRST	E$$DOR			;DATE AND TIME OUT OF RANGE

	SUBTTL	MAKDAT	--	ROUTINE TO MAKE A DATE AND TIME

	;THIS ROUTINE WILL TAKE THE VALUES IN VAL1-VAL9 AND
	;GENERATE A UDT

MAKDAT:	MOVE	S1,VAL4		;GET HOURS
	IMULI	S1,^D60		;MAKE INTO MINS
	ADD	S1,VAL3		;ADD MINS
	IMULI	S1,^D60		;MAKE INTO SECS
	ADD	S1,VAL2		;ADD SECS
	IMULI	S1,^D1000	;MAKE INTO MILLISECS
	MOVE	S2,VAL9		;GET CENTURIES
	IMULI	S2,^D10		;MAKE INTO DECADES
	ADD	S2,VAL8		;ADD DECADES
	IMULI	S2,^D10		;MAKE INTO YEARS
	ADD	S2,VAL7		;ADD YEARS
	IMULI	S2,^D12		;MAKE INTO MONTHS
	ADD	S2,VAL6		;ADD MONTHS
	IMULI	S2,^D31		;MAKE INTO DAYS
	ADD	S2,VAL5		;ADD DAYS
	SUB	S2,[^D1964*^D12*^D31]  ;REDUCE TO SYSTEM RANGE
	DMOVE	T1,S1		;SETUP THE ARGUMENTS
	PJRST	CNVDT		;CONVERT TO INTERNAL FORM AND RETURN


	;ADJUSTMENT FACTORS FOR EACH TIME ELEMENT

ADJTBL:	EXP	1	
	EXP   ^D60
	EXP    ^D60*^D60
	EXP    1
	EXP    ^D31
	EXP    ^D31*^D12
	EXP    ^D31*^D12*^D10
	EXP    ^D31*^D12*^D10*^D10
	SUBTTL	DATPAR	--	PARSE A DATE/DAY FIELD

	;This routine will parse a date and save the values of the
	;fields that are found
	;
	;CALL	S1/	NUMBER

DATPAR:	MOVE	S1,FNARG		;GET THE ARGUMENT FLAGS
	TXNN	S1,CM%IDA		;DATE WANTED?..
	  PJRST	E$$IDT			;INVALID DATE FUNCTION
	MOVE	S2,LSTCHR		;GET THE LAST CHARACTER
	CAIN	S2,"-"			;SEPERATOR?
	  PJRST	ALTDAT			;YES.. TRY ALTERNATE DATE FORM
	PUSHJ	P,DECBPT		;DECREMENT THE BYTE POINTER
	PUSHJ	P,GETSTG		;GET A STRING
	SKIPT				;O.K. CONTINUE ON
	PJRST	E$$DTM			;VALUE MISSING IN DATE AND TIME
	MOVE	P1,S1			;SAVE THE STRING POINTER
	MOVEM	S1,STRPTR		;SAVE THE STRING POINTER
	MOVEI	S1,DAYTBL		;GET THE DAYS TABLE
	MOVE	S2,P1			;GET THE POINTER
	PUSHJ	P,S%TBLK		;CHECK THE TABLE
	TXNE	S2,TL%NOM!TL%AMB 	;IS IT AMBIGUOUS OR NO MATCH
	  JRST	datp.5			;TRY MONTHS OR MNEMONICS
	HRRZ	P1,(S1)			;GET THE VALUE
	HLRZ	S2,NOW			;GET DAYS
	IDIVI	S2,7			;GET DAY OF WEEK
	SUB	P1,T1			;GET FUTURE DAYS FROM NOW
	SKIPGE	P1			;IF NEGATIVE,
	ADDI	P1,7			;  MAKE LATER THIS WEEK
	HLLZ	S1,NOW			;CLEAR CURRENT
	SKIPL	FLFUTD			;SEE IF FUTURE
	TROA	S1,-1			;YES--SET MIDNIGHT MINUS EPSILON
	SUBI	P1,7			;NO--MAKE PAST
	HRLZ	P1,P1			;POSITION TO LEFT HALF
	ADD	P1,S1			;MODIFY CURRENT DATE/TIME
DATP.1:	MOVEM	P1,TIMSAV		;SAVE THE TIME
	SKIPG	TIMCNT			;ANY MORE CHARACTERS
	  JRST [ MOVE	S1,TIMSAV	;GET THE SAVED TIME
		JRST DATP.3]		;FINISH OFF THE TIME
	MOVE	S1,LSTCHR		;CHECK THE LAST CHARACTER
	CAIE	S1,":"			;WAS IT A :
	   JRST	E$$IDT			;GENERATE AN ERROR
DATP.2:	PUSHJ	P,TIMPAR		;PARSE THE TIME FIELD
	SKIPT				;SKIP IF TRUE
	  PJRST	E$$ITF			;INVALID TIME FIELD
	HLL	S1,TIMSAV			;  TO ANSWER
	HRR	S1,S2			;PLACE THE PORTION OF DAY IN RH
DATP.3:	SKIPG	FLFUTR			;SKIP IF FUTURE
	JRST	DATP.4			;ADJUST PAST RESULT
	CAMGE	S1,NOW			;IF NOT FUTURE, MUST HAVE
					;WANTED A WEEK FROM TODAY,
					;BUT EARLIER IN THE DAY.
	ADD	S1,[7,,0]		;MAKE TIME NEXT WEEK
	JRST	DATEXT			;CHECK AND RETURN
DATP.4:	MOVE	S2,S1			;SIMILAR TEST FOR PAST
	ADD	S2,[7,,0]		;ADD A WEEK TO PAST TIME
	CAMG	S2,NOW			;WAS TIME OVER A WEEK AGO?
	MOVE	S1,S2			;YES, USE NEW ONE
	JRST	DATEXT			;CHECK ANSWER AND RETURN
DATP.5:	PUSHJ	P,MONPAR		;TRY TO PARSE A MONTH
	JUMPF	MNMPAR			;TRY A MNEMONIC
	MOVE	S1,LSTCHR		;GET THE LAST CHARACTER
	CAIE	S1,"-"			;MUST BE DAY NEXT
	  PJRST E$$MDS			;MISSING DAY IN DATE /TIME
	PUSHJ	P,DECNUM		;GET DECIMAL NUMBER
	JUMPLE	S1,E$$NND		;NEGATIVE NUMBER
	CAILE	S1,^D31			;VERIFY IN RANGE
	JRST	E$$DFL			;ERROR IF TOO LARGE
	MOVEM	S1,VAL5			;SAVE AWAY
	 PJRST	YEARPR			;PARSE THE YEAR
	SUBTTL	ALTDAT	--	PARSE ALTERNATE DATE FORM

	;This routine will check dates in the form DD-MMM-YY
	;					    MM-DD-YY

ALTDAT:	CAILE	S1,^D31			;IS IT A VALID DAY?
	  PJRST	E$$DFL			;NO..GIVE ERROR
	SKIPN	P1			;CHECK IF ZERO?
	PJRST E$$DFZ			;FIELD ZERO IN DATE/TIME
	MOVEM	S1,VAL5			;SAVE VALUE
	PUSHJ	P,GETCHR		;SKIP OVER MINUS
	JUMPF	E$$IDT			;INVALID DATE AND TIME
	CAIL	S1,"0"			;SEE IF DIGIT NEXT
	CAILE	S1,"9"			; ..
	  JRST	ALTD.1			;SETUP FOR MONTH
	PUSHJ	P,DECNUM		;YES-- MUST BE MM-DD FORMAT
	JUMPLE	S1,E$$NND		;BAD IF LE 0
	CAILE	S1,^D31			;VERIFY LE 31
	JRST	E$$DFL			;BAD
	EXCH	S1,VAL5			;SWITCH VALUES
	CAILE	S1,^D12			;VERIFY MONTH OK
	JRST	E$$DFL			;BAD
	MOVEM	S1,VAL6			;SAVE THE MONTH
	PJRST	YEARPR			;NOW PARSE THE YEAR
ALTD.1:	PUSHJ	P,DECBPT		;BACKUP POINTER
	PUSHJ	P,GETSTG		;GET THE STRING
	JUMPF	E$$IDT			;INVALID DATE AND TIME
	MOVE	P1,S1			;SAVE THE POINTER
	PUSHJ	P,MONPAR		;CHECK FOR MONTH
	JUMPF	.POPJ			;ERROR..RETURN
	PJRST	YEARPR			;PARSE THE YEAR
	SUBTTL	MONPAR	--	ROUTINE TO CHECK FOR A MONTH

MONPAR:	MOVE	S1,FNARG		;GET THE ARGUMENT FLAGS
	TXNN	S1,CM%IDA		;DATE WANTED?..
	  PJRST	E$$IDT			;INVALID DATE FUNCTION
	MOVEI	S1,MONTBL		;GET THE DAYS TABLE
	MOVE	S2,P1			;GET THE POINTER
	PUSHJ	P,S%TBLK		;CHECK THE TABLE
	TXNE	S2,TL%NOM!TL%AMB 	;IS IT AMBIGUOUS OR NO MATCH
	  $RETF				;RETURN FALSE
	HRRZ	P1,(S1)			;GET MONTH INDEX
	MOVEM	P1,VAL6			;YES--STORE MONTH
	$RETT				;RETURN TRUE
	SUBTTL	YEARPR	--	PARSE THE YEAR

	;THIS ROUTINE WILL PARSE A YEAR
YEARPR:	MOVE	S1,LSTCHR		;GET THE LAST CHARACTER
	CAIE	S1,"-"			;SEE IF YEAR NEXT
	JRST	YEAR.3			;NO--GO HANDLE TIME
	;HERE WHEN YEAR NEXT AS ONE, TWO, OR FOUR DIGITS
	SETZB	T3,T4			;CLEAR DIGIT AND RESULT COUNTERS
YEAR.1:	PUSHJ	P,GETCHR		;GET NEXT DIGIT
	CAIL	S1,"0"			;SEE IF NUMERIC
	CAILE	S1,"9"			; ..
	JRST	YEAR.2			;NO--MUST BE DONE
	IMULI	T3,^D10			;ADVANCE RESULT
	ADDI	T3,-"0"(S1)		;INCLUDE THIS DIGIT
	AOJA	T4,YEAR.1		;LOOP FOR MORE, COUNTING DIGIT
YEAR.2:	JUMPE	T4,E$$ILR		;ERROR IF NO DIGITS
	CAIE	T4,3			;ERROR IF 3 DIGITS
	CAILE	T4,4			;OK IF 1,2, OR 4
	JRST	E$$ILR			;ERROR IF GT 4 DIGITS
	MOVE	S2,T3			;GET RESULT
	IDIVI	S2,^D100		;SEP. CENTURY
	IDIVI	T1,^D10			;SEP. DECADE
	CAIG	T4,2			;IF ONE OR TWO DIGITS,
	SETOM	S2			;  FLAG NO CENTURY KNOWN
	CAIN	T4,1			;IF ONE DIGIT,
	SETOM	T1			;  FLAG NO DECADE KNOWN
	MOVEM	T2,VAL7			;SAVE UNITS
	MOVEM	T1,VAL8			;SAVE DECADE
	MOVEM	S2,VAL9			;SAVE CENTURY
	;HERE WITH VAL5-9 CONTAINING DAY, MONTH, YEAR, DECADE, CENTURY
YEAR.3:	SOS	VAL5			;MAKE DAYS 0-30
	SOS	VAL6			;MAKE MONTHS 0-11
	SKIPG	TIMCNT			;ANY MORE CHARACTERS
	  JRST	YEAR.5			;NO..FINISH TIME NOW
	MOVE	S1,LSTCHR		;CHECK THE LAST CHARACTER
	CAIE	S1,":"			;WAS IT A :
	   JRST	E$$IDT			;GENERATE AN ERROR
YEAR.4:	PUSHJ	P,TIMPAR		;GET THE TIME 
	SKIPT				;SKIP IF TRUE
	  PJRST	E$$ITF			;INVALID TIME FIELD
	 PJRST	CMPDAT			;COMPUTE THE DATE AND RETURN
	;HERE IF FUTURE WITHOUT TIME
YEAR.5:	SKIPG	FLFUTD			;FUTURE TIME?
	  PJRST CMPDAT			;NO.. JUST GET DATE NOW
	MOVEI	S1,^D59			;SET TO
	MOVEM	S1,VAL2			; 23:59:59
	MOVEM	S1,VAL3			; ..
	MOVEI	S1,^D23			; ..
	MOVEM	S1,VAL4			; ..
	PJRST	CMPDAT			;COMPUTE THE DATE
	SUBTTL	CNVDT	--	CONVERT DATE TO UDT


	;THIS ROUTINE WILL MAKE A UDT OUT OF AN ARBITRAY DATE
	;
	;CALL	S1/	TIME IN SECONDS
	;	S2/	DATE IN SYSTEM FORMAT (Y*12+M)*31+DAY SINCE 1/1/64
	;
	;RETURN	S1/	UDT
	;
	;NOTE:	LEFT HALF DIVIDED BY 7 GIVES THE DAY OF THE WEEK

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


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

	POP	P,S1		;GET MILLISEC TIME
	MOVEI	S2,0		;CLEAR OTHER HALF
	ASHC	S1,-17		;POSITION
	DIV	S1,[24*60*60*1000]  ;CONVERT TO 1/2**18 DAYS
	CAMLE	S2,[^D24*^D60*^D60*^D1000/2]	; OVER 1/2 TO NEXT?
	ADDI	S1,1		;YES, SHOULD ACTUALLY ROUND UP
	HRL	S1,T2		;INCLUDE DATE
GETNWX:	POPJ	P,		;RETURN

MONTAB:	EXP	0,31,59,90,120,151,181,212,243,273,304,334,365
	RADIX	8
	SUBTTL	MNMPAR	--	PARSE MNEMONICS

	;THIS ROUTINE WILL CHECK FOR MNEMONICS

MNMPAR:	PJRST	E$$IDT			;INVALID DATE AND TIME


	COMMENT \

	HRRZ	S2,S1			;GET COPY			
	CAIN	S2,SPLGTM		;SEE IF "LOGIN"			
	SKIPG	P1,LOGTIM		;AND WE KNOW IT			
	SKIPA				;NO--PROCEED			
	JRST	DATEXT			;YES--GO GIVE ANSWER		
	CAIN	S2,SPNOON		;SEE IF "NOON"			
	JRST	[HLLZ P1,NOW		;YES--GET TODAY			
		 HRRI P1,1B18		;SET TO NOON			
		 JRST DATP.1]		;GO FINISH UP			
	CAIN	S2,SPMIDN		;SEE IF "MIDNIGHT"		
	JRST	[HLLZ P1,NOW		;GET TODAY			
		 JRST DATIMO]		;GO SET TO MIDNIGHT		
	SUBI	S2,SPCDAY		;SUBTRACT OFFSET TO SPECIAL DAYS  
	CAILE	S2,2			;SEE IF ONE OF THREE		
	JRST	E.MDS			;NO--UNSUPPORTED		
	HLRZ	P1,NOW			;YES--GET TODAY			
	ADDI	P1,-1(S2)		;OFFSET IT			
	HRLZS	P1			;POSITION FOR ANSWER		
DATIMO:	SKIPL	FLFUTD			;SEE IF FUTURE			
	TRO	P1,-1			;YES--SET TO MIDNIGHT MINUS EPSILON  
	JRST	DATP.1			;AND GO FINISH UP		

	;HERE IF UNSUPPORTED MNEMONIC

E.MDS:	MOVE	P1,(S1)			;GET NAME OF SWITCH
	  PJRST E$$MDS			;MNEMONIC DATE/TIME NOT IMPLEMENTED


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

SPCDAY:	XX	YESTERDAY
	XX	TODAY
	XX	TOMORROW

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

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

	\;END OF COMMENT
	SUBTTL	GETCHR	--	GET A CHARACTER FROM TIME FIELD

	;This Routine will return a character from the time field 
	;
	;RETURN	TRUE:	S1/	CHARACTER
	;
	;RETURN FALSE:	NO MORE DATA

GETCHR:	SOSGE	TIMCNT			;ANY CHARACTERS LEFT?
	  PJRST	GETC.1			;ERROR..RETURN
	ILDB	S1,TIMPTR		;GET A CHARACTER
	CAIL	S1,"a"			;LOWER CASE A
	CAILE	S1,"z"			;LOWER CASE Z
	SKIPA				;MUST BE O.K.
	SUBI	S1,40			;MAKE UPPER CASE
	MOVEM	S1,LSTCHR		;SAVE LAST CHARACTER
	$RETT				;RETURN TRUE
GETC.1:	SETZM	LSTCHR			;CLEAR LAST CHARACTER
	$RETF				;RETURN FALSE


	SUBTTL	DECNUM	--	GET A DECIMAL NUMBER

	;This routine will return a decimal number from the time field
	;
	;RETURN	TRUE	S1/	DECIMAL NUMBER

DECNUM:	SKIPG	TIMCNT			;ANY CHARACTERS LEFT
	  $RETF				;NONE.. RETURN FALSE
	MOVE	S1,TIMPTR		;GET THE POINTER
	MOVEI	S2,^D10			;GET THE RADIX (DECIMAL)
	PUSHJ	P,NUMIN		;GET THE NUMBER
	JUMPF	.POPJ			;ERROR...RETURN
DECN.1:	IBP	TIMPTR			;BUMP THE TIME POINTER
	CAMN	S1,TIMPTR		;ARE WE AT THE RIGHT PLACE
	  JRST	DECN.2			;YES.. FINISH UP
	SOS	TIMCNT			;DECREMENT TIME COUNT
	JRST	DECN.1			;KEEP GOING
DECN.2:	MOVE	S1,S2			;PLACE NUMBER IN S1
	LDB	S2,TIMPTR		;GET LAST CHARACTER
	CAIL	S2,"a"			;LOWER CASE A
	CAILE	S2,"z"			;LOWER CASE Z
	SKIPA				;MUST BE O.K.
	SUBI	S2,40			;MAKE UPPER CASE
	MOVEM	S2,LSTCHR		;SAVE LAST CHARACTER
	$RETT				;RETURN TRUE

	SUBTTL	DECBPT	--	DECREMENT THE BYTE POINTER

	;THIS ROUTINE WILL DECREMENT THE TIME BYTE POINTER


DECBPT:	MOVE	S1,TIMPTR		;GET CURRENT POINTER
	PUSHJ	P,DBP			;DECREMENT THE BYTE POINTER
	MOVEM	S1,TIMPTR		;SAVE THE POINTER
	AOS	TIMCNT			;BUMP THE CHARACTER COUNT
	$RETT				;RETURN
	SUBTTL	GETSTG	--	GET A STRING TO WORK FROM


	;THIS ROUTINE WILL GET A STRING FROM THE INPUT BUFFER AND BREAK ON 
	;A SEPERATOR
	;	RETURN	S1/	POINTER TO THE STRING


GETSTG:	PUSHJ	P,.SAVE1		;SAVE AN AC
	SETZM	STRDAT			;CLEAR STRING DATA
	HRLI	P1,STRDAT		;ADDRESS OF FIRST ONE
	HRRI	P1,1+STRDAT		;GET THE SECONDE WORD
	BLT	P1,4+STRDAT		;CLEAR THE DATA
	HRLI	P1,(POINT 7)		;GET POINTER
	HRRI	P1,STRDAT		;AND ADDRESS
GETS.1:	PUSHJ	P,GETCHR		;GET A CHARACTER
	JUMPF	GETS.3			;NO MORE.. FINISH AND RETURN
	CAIE	S1,40			;IS IT A BLANK?
	CAIN	S1,"-"			;OR A SEPERATOR
	JRST	GETS.3			;YES..CHECK IF SEEN ANYTHING
	CAIN	S1,":"			;WAS IT A SEPERATOR?
	  JRST	GETS.3			;YES..CHECK IS SEEN ANYTHING 
	CAIL	S1,"A"+40		;LOWER CASE A
	CAILE	S1,"Z"+40		;OR GREATER THAN LC Z
	SKIPA				;IGNORE ADJUSTMENT
	SUBI	S1,40			;MAKE IT UPPER CASE
	CAIL	S1,"0"			;IS IT 0 NUMBER OR UPPER CASE
	CAILE	S1,"Z"			;CHECK CHARACTER
	JRST GETS.3			;SETUP THE RETURN
GETS.2:	IDPB	S1,P1			;SAVE THE CHARACTER
	JRST	GETS.1			;GET NEXT ONE
GETS.3:	SKIPN	STRDAT			;ANY DATA SETUP?
	$RETF				;NO..RETURN FALSE
	MOVE	S1,[POINT 7,STRDAT]	;GET POINTER TO DATA 
	$RETT				;RETURN TRUE
;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,<
?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/	ADDRESS OF TABLE HEADER
;		S2/	ADDRESS OF ENTRY TO BE ADDED
;
;
; 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			;TRAB 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
	SETZ	S1,			;CLEAR S1
	CAIN	S2,TADDX1		;WAS IT TABLE IS FULL
	MOVEI	S1,ERTBF$		;TABLE IS FULL
	CAIN	S2,TADDX2		;ENTRY ALREADY IN TABLE
	MOVEI	S1,EREIT$		;ENTRY ALREADY IN TABLE
	JUMPN	S1,.RETF		;NON-ZERO..RETURN FALSE
	$STOP(UTR,UNRECOGNIZED TABLE ADD RETURN CODE)
>;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	S2,S2			;BUILD STRING POINTER FOR STRING
	HRLI	S2,(POINT 7,0)		;FINISH OFF POINTER
	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
	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
		$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/	ADDRESS OF TABLE HEADER
;		S2/	ADDRESS OF ENTRY TO BE DELETED
;
;
; 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			;TRAB 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
	SETZ	S1,			;CLEAR S1
	CAIN	S2,TDELX1		;WAS IT TABLE IS FULL
	MOVX	S1,ERTBF$		;TABLE IS FULL
	CAIN	S2,TDELX2		;ENTRY ALREADY IN TABLE
	MOVX	S1,ERITE$		;ENTRY ALREADY IN TABLE
	JUMPN	S1,.RETF		;NON-ZERO..RETURN FALSE
	PJRST	S..UTR			;UNRECOGNIZED TABLE RETURN CODE
>;END TOPS20 CONDITIONAL



TOPS10 <
S%TBDL:	PUSHJ	P,.SAVET		;SAVE THE T REGS
	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
	$RETT				;RETURN TRUE
>;END TOPS10 CONDITIONAL
SCN%L:				;LABEL THE LITERAL POOL

	END