Google
 

Trailing-Edge - PDP-10 Archives - bb-lw55a-bm - galaxy-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	Preliminaries

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

	SALL			;SUPPRESS MACRO EXPANSION

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

	SCNMAN==:0			;Maintenance edit number
	SCNDEV==:111			;Development edit number
	VERSIN (SCN)			;Generate edit number

;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. Revision History . . . . . . . . . . . . . . . . . . .   3
;    2. Local Definitions  . . . . . . . . . . . . . . . . . .   5
;    3. Module Storage . . . . . . . . . . . . . . . . . . . .   6
;    4. S%INIT - Initialize the GLXSCN Module  . . . . . . . .   7
;    5. S%ERR - ERROR TYPEOUT ROUTINE  . . . . . . . . . . . .   8
;    6. S%INTR - Interrupt Level Breakout Routine  . . . . . .   9
;    7. S%CMND - Scan a command  . . . . . . . . . . . . . . .  10
;    8. S%EXIT - Exit Address for Interrupt Breakout . . . . .  11
;    9. S%SIXB - Convert ASCII to SIXBIT . . . . . . . . . . .  12
;   10. S%NUMI - NUMBER INPUT ROUTINE  . . . . . . . . . . . .  13
;   11. S%DATI Date input routine  . . . . . . . . . . . . . .  14
;   12. RETYPE - Retype current line including the prompt  . .  21
;   13. Atom Buffer Routines / INILCH - Init Atom Buffer . . .  28
;   14. CMCIN - Read One Character for Processing  . . . . . .  29
;   15. HELPER - Do caller supplied and default HELP text  . .  32
;   16. Command Function / .CMINI - Init the scanner and do ^H  35
;   17. Command Function / .CMSWI - Parse a SWITCH . . . . . .  36
;   18. Command Function / .CMKEY - Parse a KEYWORD  . . . . .  37
;   19. Command Function / .CMTXT - Parse Arbitrary Text to Ac  41
;   20. Command Function / .CMCFM - Command Confirmation (end-  42
;   21. Command Function / .CMNUM - Parse an INTEGER in any ba  44
;   22. Command Function / .CMDEV - Parse a DEVICE specificati  46
;   23. Command Function / .CMQST - Parse a QUOTED STRING  . .  47
;   24. Command Function / .CMNOD - Parse a NODE Specification  48
;   25. PATHIN Routine to Parse TOPS-10 Path Specification . .  51
;   26. PATH SUPPORT ROUTINES  . . . . . . . . . . . . . . . .  53
;   27. CMDOUT - CHARACTER OUTPUT FOR TERMINALS AND FILES  . .  58
;   28. S%SCMP - String Comparison Routine . . . . . . . . . .  59
;   29. S%TBLK - Table lookup routine  . . . . . . . . . . . .  61
;   30. S%TBAD - Table Add Routine . . . . . . . . . . . . . .  64
;   31. S%TBDL - Table Delete Routine  . . . . . . . . . . . .  65
;   32. CNTDT,CNVDT DATE/TIME CONVERSION ROUTINES  . . . . . .  66
;   33. XDATIM DATE/TIME PARSING ROUTINES FOR TOPS10 . . . . .  67
;   34. DATNCI ROUTINE TO RETURN 3 WORD TIME BLOCK . . . . . .  68
;   35. DATIM MACROS AND STORAGE DECLARATION . . . . . . . . .  69
;   36. SUBROUTINES FOR COMMAND INPUT - GET DATE/TIME  . . . .  70
;   37. SUBROUTINES FOR COMMAND INPUT - GET NEXT CHARACTER . .  84
;   38. .CNTDT - GENERALIZED DATE/TIME SUBROUTINE  . . . . . .  85
;   39. .LKNAM - ROUTINES TO GET AND PUT IN A COUNTED LIST . .  89
SUBTTL	Revision History


COMMENT \

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

*****  Release 4.2 -- begin maintenance edits  *****

*****  Release 5.0 -- begin development edits  *****

100	5.1002		28-Dec-82
	Move to new development area.  Clean up edit organization.  Update TOC.
*****	Release 5.0 -- begin maintenance edits	*****

105	Increment maintenance edit level for version 5 of GALAXY.

*****	Release 6.0 -- begin development edits	*****

110	6.1037		26-Oct-87
	Move sources from G5: to G6:

111	6.1225		8-Mar-88
	Update copyright notice.

\   ;End of Revision History
; Entry Points found in this module

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

; Special Accumulator definitions

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

; Bad parse return macro

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

; Special bit testing macros

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

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

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

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


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

	$DATA	SCNBEG,0		;START OF ZEROABLE $DATA SPACE
	$DATA	ATBPTR			;ATOM BUFFER POINTER (END)
	$DATA	ATBSIZ			;ATOM BUFFER SIZE
	$DATA	STKFEN			;FENCE FOR STACK RESTORATION
	$DATA	FNARG			;FUNCTION ARGUMENT
	$DATA	CMCCM,2			;SAVED CC CODES
	$DATA	CMRBRK			;POINTER TO BREAK SET TABLE
	$DATA	CMCSF			;SAVED FLAGS
	$DATA	CMCSAC,7		;SAVED ACS DURING S%TXTI FROM S%CMND
	$DATA	CMCSC			;
	$DATA	CMCBLF			;
	$DATA	TBA			;TABLE ARGUMENTS
	$DATA	STRG			;TEMP STRING POINTER
	$DATA	REMSTR			;"REMEMBER"ED STRING
	$DATA	XXXPTR			;RE-USABLE STRING POINTER STORAGE
	$DATA	CRBLK,CR.SIZ		;RETURNED BLOCK OF ANSWERS
	$DATA	TABDON			;END OF TAB FOR "?"
	$DATA	TABSIZ			;SIZE OF TAB LARGER THAN LARGEST KEYWORD
	$DATA	LSTERR			;ERROR CODE OF FIRST PARSE FAILURE
	$DATA	LSTEPC			;PC OF FIRST PARSE FAILURE
	$DATA	BIGSIZ			;LENGTH OF LONGEST KEYWORD
	$DATA	PWIDTH			;TERMINAL'S WIDTH
	$DATA	CURPOS			;LINE POSITION OF CURSOR
	$DATA	Q3SAVE			;NO Q3 EXISTS
	$DATA	IFOB			;INDIRECT FILESPEC FOB
	$DATA	IIFN			;IFN OF INDIRECT FILE
	$DATA	TI,.RDSIZ		;S%TXTI ARGUMENT BLOCK
	$GDATA	SAVBUF,ERRBSZ		;BUFFER FOR ERROR MESSAGES
					;S%ERR AND SCRATCH
TOPS10 <
	$DATA	CMDACS,20		;AC SAVE AREA FOR COMMAND
	$DATA	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	ACFLG			;FLAG TO VALIDATE INTERRUPT SAVED ACs
	$DATA	A07T16,10		;BLOCK TO SAVE ACS FROM 7 TO 16
					; DURING K%TXTI IN CASE OF INTERRUPT
>;END TOPS10 CONDITIONAL

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

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

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

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

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

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

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

;
;	RETURN	FALSE:	Not in COMND
;

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

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


;LOCAL FLAGS (RH OF F)

CMQUES==1B18			;? TYPED
CMSWF==1B19			;BEG OF SWITCH SEEN
CMUSRF==1B20			;USER NAME REQUIRED
CMDEFF==1B21			;DEFAULT FIELD GIVEN
CMCFF==1B22			;^F RECOGNIZED FIELD
CMQUE2==1B23			;IN SECOND OR SUBSEQUENT HELP POSSIBILITY
CMBOL==1B24			;FIELD IS AT BEG OF LINE
CMTF1==1B25			;INTERNAL TEMP FLAG
CMINDF==1B26			;DOING GTJFN ON INDIRECT FILE

;FLAGS IN FUNCTION DISPATCH TABLE

CMNOD==1B0			;NO DEFAULT POSSIBLE

NOIBCH=="("			;NOISE WORD BEG CHARACTER
NOIECH==")"			;NOISE WORD END CHARACTER
CMSWCH=="/"			;SWITCH CHARACTER
CMSWTM==":"			;SWITCH TERMINATOR
CMHLPC=="?"			;HELP CHARACTER
CMCOM1=="!"			;COMMENT CHARACTER
CMCOM2==";"			;FULL LINE COMMENT CHARACTER
CMDEFC=="#"			;DEFAULT FIELD CHARACTER
CMFREC=="F"-100			;FIELD RECOGNITION CHARACTER
CMINDC=="@"			;INDIRECT FILE CHARACTER
CMRDOC=="H"-100			;REDO COMMAND CHARACTER
CMQTCH==""""			;CHARACTER FOR QUOTED STRINGS
CMCONC=="-"			;LINE CONTINUATION CHARACTER
SUBTTL	S%EXIT - Exit Address for Interrupt Breakout

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

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


TOPS10 <
S%EXIT:

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

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

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

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

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

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

	SUBTTL	CNVSIX - CONVERT ATOM BUFFER TO SIXBIT
;Internal entry point
;Same calling args
;Returns false if more than 6 chars are passed
CNVSIX:	PUSHJ	P,.SAVET		;Preserve the caller's T's
	MOVEI	T2,6			;GET MAX NUMBER OF CHARACTERS IN NAME
	MOVE	T4,[POINT 6,S2]		; BP TO NODE STORAGE
	SETZM	S2			;START FRESH
CNVS.1:	ILDB	T3,S1			;GET NEXT CHARACTER FROM ATOM BUFFER
	CAIL	T3,"A"+40		;LESS THAN LC A
	CAILE	T3,"Z"+40		;OR GREATER THAN LC Z
	SKIPA				;YES, NOT A LC CHARACTER
	SUBI	T3,40			;NO, ITS LC, MAKE IT UC
	CAIL	T3,"0"			;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
SUBTTL	S%NUMI - NUMBER INPUT ROUTINE

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


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

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

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

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

;	RETURN	S1/ UPDATED POINTER
;		S2/ UDT

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


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

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

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


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


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

S%CMND:	SETZM	LSTERR		;CLEAR LAST ERROR INDICATOR
	MOVEM	0,CMDACS	;SAVE THE COMMAND ACS
	MOVE	0,[XWD 1,CMDACS+1] ;SET UP BLT POINTER
	BLT	0,CMDACS+17	;SAVE THE ACS
	MOVEI	0,@0(P)		;GET CALLING PC ADDRESS
	MOVEM	0,LSTEPC	;SAVE IN CASE OF NOPARSE
	MOVE	0,CMDACS	;RESTORE 0
	PUSHJ	P,XCOMND	;DO THE WORK
	HRRZ	T4,.CMFLG(P2)	;GET REPARSE ADDRESS IF ANY
	JUMPE	T4,COMN1	;NONE..JUST RETURN
	TXNN	F,CM%RPT	;REPARSE NEEDED..
	JRST	COMN1		;NO..JUST RESTORE AND RETURN
	HRRZ	T3,CMDACS+17	;GET STACK LOCATION
	HRRM	T4,@T3		;YES..RETURN TO REPARSE
COMN1:	SETZM	INCMND		;CLEAR IN COMMAND STATE
	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:	SKIPN	LSTERR		;ANY ERRORS YET?
	MOVEM	T1,LSTERR	;NO..SAVE ONLY THE FIRST
XCOMNP:	JXN	F,CMQUES,CMRTYP	;IF IN HELP, DON'T RETURN NOW
	PUSHJ	P,CMRSET	;RESET FIELD VARIABLES
	MOVEM	P5,.CMINC(P2)	;FIX USER BLOCK
	LOAD	T1,.CMFNP(P1),CM%LST	;GET PTR TO NEXT FN BLOCK
	HRRM	T1,P1		;SAVE IT
	JUMPN	T1,XCOMN0	;DISPATCH IF THERE IS ANOTHER FUNCTION
	TXO	F,CM%NOP	;NO OTHER POSSIBILITIES, SAY NO PARSE
	MOVE	T1,LSTEPC	;GET THE LAST ERROR PC
	MOVEM	T1,.LGEPC	;SAVE FOR ERROR ROUTINE
	MOVE	T1,LSTERR	;SET GLOBAL ERROR INDICATORS
	MOVEM	T1,.LGERR
	JRST	XCOMX2

;HERE AFTER EACH HELP OUTPUT

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

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

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


SUBTTL	TYPRMT  -  Retype the prompt if there is one

TYPRMT:	HRRZ	S1,.CMIOJ(P2)		;Get output designator
	CAIE	S1,.PRIOU		;TTY?
	$RETT				;No, just return then
	PUSHJ	P,K%TPOS		;Get horizontal position of terminal
	SKIPF				;Unknown, assume needs CRLF
	SKIPE	S1			;At column zero?
	PUSHJ	P,CRLF			;No, type crlf
	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
	JUMPE	S2,CMIND1	;Ignore nulls (Grrr...!!)
	CAIN	S2,CMCONC	;Possible line continuation?
	JRST [	MOVE	S1,IIFN		;Yes, see if EOL next
		PUSHJ	P,F%IBYT	;Get next char
		JUMPF [	MOVEI	T1,CMCONC	;EOF... stuff the hyphen
			PUSHJ	P,CMDIBQ	; ..
			JRST	CMIND2]		;Close file and finish up
		CAIE	S2,CMRDOC	;Ignore ^H
		CAIN	S2,.CHCRT	; and CR
		JRST	.
		CAIN	S2,.CHLFD	;Line feed?
		JRST	.+1		;Yes, stuff it and forget the hyphen
		MOVEI	T1,CMCONC	;No, I guess the hyphen was real, then
		PUSHJ	P,CMDIBQ	; so put it into the guy's buffer
		JRST	.+1]		;Now handle the next char
	CAIE	S2,CMRDOC	;IGNORE ^H
	CAIN	S2,.CHCRT	;IGNORE CR
	JRST	CMIND1
	CAIE	S2,.CHLFD	;CONVERT EOL TO SPACE
	CAIN	S2,.CHESC	;DITTO ESC (BUT THERE SHOULDN'T BE ANY)
	MOVEI	S2," "
	MOVE	T1,S2		;COPY CHARACTER
	PUSHJ	P,CMDIBQ	;PUT CHAR IN BUFFER WITHOUT TYPEOUT
	JRST	CMIND1

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

CMINDE:	PUSHJ	P,I%IOFF		;TURN OFF INTERRUPTS
	$TEXT(T%TTY,<^M^J?Problem with Indirect File: ^E/[-1]/>)
	PUSHJ	P,I%ION			;THEN TURN THEM BACK ON
	TXO	F,CM%NOP	;RETURN FAILURE, NO CHECK ALTERNATIVES
	JRST	XCOMX2
;****************************************
;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
	MOVE	T2,T1		;GET COPY OF CHAR
	IDIVI	T2,40		;COMPUTE INDEX TO BIT MASK
	MOVE	T3,BITS(t3)
	ADD	T2,CMRBRK
	TDNE	T3,0(T2)	;BREAK CHARACTER?
	JRST	CMRAT2		;YES
	PUSHJ	P,STOLCH	;BUILD KEYWORD STRING
	JRST	CMRAT1

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

CMRATR:	PUSHJ	P,CMDIP		;PUT CHARACTER BACK IN BUFFER
CMRATT:	PJRST	TIELCH		;TIE OFF ATOM BUFFER AND RETURN
;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]
	CAIE	T1,.CHCNZ		;Control-Z ?
	CAIN	T1,.CHLFD		;END OF LINE?
	TXO	F,CM%EOC		;YES, MEANS END OF COMMAND
	POPJ	P,0

CMDIN:	PUSHJ	P,CMCIN			;GET NEXT CHAR
	TXNE	F,CM%ESC		;IS IT THE RECOGNIZER?
	POPJ	P,			;YES, ALL SET
	PUSHJ	P,CMDIP			;NO, PUT IT BACK IN BUFFER
	SETZ	T1,			;NO CHAR
	POPJ	P,
CMCIN1:	MOVEM	F,CMCSF		;SAVE F
	SETZM CMCBLF		;INIT ACCUMULATED FLAGS
	MOVE	T1,[XWD P1,CMCSAC] ;PREPARE FOR BLT
	BLT	T1,CMCSAC+3	;SAVE P1-P4
	;***	REMOVE RD%RND FOR NOW 6/22/78
	MOVX	T1,RD%BRK+RD%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
	HRLZI	S1,7		;GET SOURCE
	HRRI	S1,A07T16	;GET DESTIONATION
	BLT	S1,A07T16+7	;SAVE SOME ACS
	SETOM	ACFLG		;REMEMBER THEY ARE IMPORTANT
	MOVEI	S1,TI		;GET LOCATION OF TEXTI BLOCK
	PUSHJ	P,K%TXTI	;DO INTERNAL TEXTI
	SETZM	ACFLG		;THE SAVED ACS ARE NO LONGER IMPORTANT
	JUMPF	[MOVEI	S1,EREOF$
		JRST	XCOMEO]
	IOR	F,TI+.RDFLG	;GET FLAGS
	IORB	F,CMCBLF	;ACCUMULATE FLAGS (RD%BLR)
	LDB	T1,TI+.RDDBP		;GET LAST CHAR
	MOVE	P4,TI+.RDDBP	;REMEMBER POINTER
	MOVE	P3,TI+.RDDBC	;AND COUNT
	TXNE	F,RD%BFE	;BUFFER EMPTY?
	JRST	CMCIN3		;YES, RETURN
	JUMPE	T1,CMCIN3	;JUMP IF NULL
	CAIE	T1,.CHLFD	;AN ACTION CHAR?
	CAIN	T1,.CHESC
	JRST	CMCIN3		;YES
	CAIE	T1,CMHLPC
	CAIN	T1,CMFREC	;^F?
	JRST	CMCIN3		;YES
	CAIE	T1,.CHCNZ		;Control-Z ?
	JRST	CMCIN2		;NO, GET MORE INPUT

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

;HERE ON RETURN FROM TEXTI WHICH REACHED BACKUP LIMIT OR WHICH RETURNED
;BECAUSE BUFFER EMPTY.  MUST REPARSE LINE.  RESTORE ACS, BUT LEAVE
;MAIN POINTER AS RETURNED BY TEXTI.

CMCIN4:	DMOVE	P1,CMCSAC	;RESTORE P1&P2
	MOVE	F,CMCSF		;RESTORE F
	SKIPE	INTRPT		;WAS THERE AN INTERRUPT CALL?
	TXO	F,CM%INT	;YES, LIGHT THE FLAG
	SETZM	INTRPT		;CLEAR CALL FLAG
	JRST	XCOMRP		;RETURN REPEAT PARSE
;SKIP LEADING TABS OR SPACES

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

;LOCAL ROUTINE - SUBTRACT ASCII BYTE PTRS
;	T1, T2/ ASCII BYTE PTRS
;	PUSHJ	P,SUBBP
; RETURNS +1 ALWAYS,
; T1/ T1-T2

SUBBP:	HRRZ	T3,T1		;COMPUTE 5*(A1-A2)+(P2-P1)/7
	SUBI	T3,0(T2)
	IMULI	T3,5		;COMPUTE NUMBER CHARS IN THOSE WORDS
	LDB	T1,[POINT 6,T1,5]
	LDB	T2,[POINT 6,T2,5]
	SUBM	T2,T1
	IDIVI	T1,7
	ADD	T1,T3
	POPJ	P,0

;LOCAL ROUTINE - DELETE LAST CHAR INPUT

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

;LOCAL ROUTINE - DECREMENT INPUT POINTER

CMDIP:	LDB	T1,P4		;CHECK THE CHARACTER
	CAIE	T1,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:	TXNN	F,CMQUE2		;IN ALTERNATE HELP POSSIBILITIES?
	JRST	DOHL2			;NO, SEE IF USER HELP WAS GIVEN
	TXNE	F,CM%HPP		;USER HELP SPECIFIED?
	JRST	DOHL1			;YES, DISPLAY "OR"
	TXNE	F,CM%SDH		;SUPPRESSING DEFAULT HELP
	POPJ	P,0			;YES, JUST RETURN
DOHL1:	MOVEI	S1,[ASCIZ /
  or/]
	PUSHJ	P,CMDSTO
DOHL2:	TXNN	F,CM%HPP		;HAVE HELP POINTER?
	POPJ	P,0			;NO
	MOVEI	S1," "
	PUSHJ	P,CMDOUT		;SPACE BEFORE USER TEXT
	MOVE	S1,.CMHLP(P1)		;YES, GET IT
	PJRST	CMDSTO			;AND TYPE IT


SUBTTL	CMAMB  -  Handle Ambiguous Typein

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

XMCOUT:	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	CMDSTO			;AND TYPE IT
;CHECK ALL BYTE PTRS
; T1/ PTR TO LIST OF ADDRESSES, TERMINATED BY 0

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

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

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

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

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

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

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

;SWITCH - LIKE KEYWORD BUT PRECEEDED BY SLASH

XCMSWI:	TXO	F,CMSWF			;NOTE DOING SWITCH
	TXNE	F,CMDEFF		;DEFAULT GIVEN?
	JRST	CMKEY0			;YES, SLASH ALREADY ASSUMED
	PUSHJ	P,CMCIN			;GET FIRST CHAR
	JXN	F,CM%ESC,CMAMB		;AMBIGUOUS
	CAIN	T1,CMHLPC		;HELP?
	JRST	[SETZ	T1,0
		 MOVE	T2,ATBPTR
		 IDPB	T1,T2
		 MOVE	T1,FNARG	;GET TABLE PTR
		 MOVEI	T1,1(T1)	;POINT TO FIRST TABLE ENTRY
		 JRST	CMQ2]		;TYPE OPTIONS
	CAIE	T1,CMSWCH		;THE SWITCH CHARACTER?
	JRST	[PUSHJ	P,CMDIP		;NO, PUT IT BACK
		 NOPARS	(NSW)]	;Not a switch
	JRST	CMKEY0			;CONTINUE LIKE KEYWORD
SUBTTL	Command Function / .CMKEY - Parse a KEYWORD

XCMKEY:	TXZ	F,CMSWF			;NOT SWITCH
CMKEY0:
KEYW1:	PUSHJ	P,CMRATM		;READ THE FIELD INTO LOCAL BUFFER
	MOVE	T1,FNARG		;GET TABLE HEADER ADDRESS
	MOVE	T2,.CMABP(P2)		;POINT TO KEYWORD BUFFER
	PUSHJ	P,XTLOOK		;LOOKUP
	TXNE	F,CMQUES		;HAD "?"
	JRST	CMQ1			;YES, GO TYPE ALTERNATIVES
	TXNE	T2,TL%NOM		;NO MATCH?
	NOPARS(NOM)			;Not a switch or keyword
	JXN	T2,TL%AMB,CMAMB		; ??? AMBIGUOUS
	MOVEM	T1,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 (NUL)]	;Null switch or keyword
	JXE	F,CMSWF,XCOMXI		;DONE IF NOT SWITCH
	PUSHJ	P,CMSKSP		;SKIP SPACES
	PUSHJ	P,CMCIN			;GET NON-BLANK CHAR
	CAIN	T1,CMSWTM		;SWITCH TERMINATOR?
	JRST	[TXO	F,CM%SWT	;YES, NOTE
		 JRST	XCOMXI]		;DONE
	PUSHJ	P,CMDIP			;NO, PUT IT BACK
	MOVE	Q1,FNARG
	JXN	Q1,CM%VRQ,XCOMNP 	;FAIL IF VALUE WAS REQUIRED
	JRST	XCOMXI			;OTHERWISE OK
;"?" TYPED, FIRST PARTIAL MATCH FOUND.  TYPE ALL PARTIAL MATCHES

CMQ1:	JXN	T2,TL%NOM,[
		JXN	F,CMQUE2,CMRTYP ;DO NOTHING IF NOT FIRST ALTERNATIVE
		MOVEI	S1,[ASCIZ / keyword (no defined keywords match this input)/]
		PUSHJ	P,CMDSTO	;TYPE MESSAGE
		JRST	CMRTYP]		;RETYPE LINE AND CONTINUE
CMQ2:	MOVEM	T1,Q2			;SAVE TABLE INDEX
	PUSHJ	P,DOHLP			;DO USER HELP IF ANY
	TXNE	F,CM%SDH		;DEFAULT HELP SUPPRESSED?
	JRST	CMRTYP			;YES, DONE
	MOVE	T1,FNARG		;GET TABLE PTR
	HLRZ	Q1,0(T1)		;GET TABLE SIZE
	MOVE	S1,Q1			;SAVE SIZE OF THE TABLE
	ADDI	Q1,1(T1)		;COMPUTE TABLE END ADDRESS FOR BELOW
	CAIN	S1,1			;ONLY ONE ELEMENT IN TABLE
	JRST	CMQ5			;YES.. BYPASS TEXT AND OUTPUT BLANK
	MOVEI	S1,[ASCIZ / one of the following:/]
	PUSHJ	P,CMDSTO		;TYPE IT
	PUSHJ	P,CRLF			;AND A CRLF
CMTAB0:	SOJ	Q2,0			;GETS INCREMENTED BEFORE EACH APPLICATION
	MOVEM	Q2,Q3SAVE		;SAVE SO IT CAN BE REINITIALIZED
	SETZM	TABSIZ			;START WITH TAB SIZE OF 0
CMTAB1:	PUSHJ	P,CMNXTE		;GET TO NEXT VALID KEYWORD IN TABLE
	JUMPF	CMTAB2			;NO MORE IN TABLE
	PUSHJ	P,CMGTLN		;CALCULATE LENGTH OF KEYWORD
	CAML	T1,TABSIZ		;LONGEST SEEN SO FAR?
	MOVEM	T1,TABSIZ		;YES, REMEMBER IT
	JRST	CMTAB1			;LOOK AT REST
CMTAB2:	MOVE	T1,TABSIZ
	MOVEM	T1,BIGSIZ		;REMEMBER LENGTH OF LONGEST KEYWORD
	MOVEI	S1,2			;LEAVE AT LEAST 2 SPACES
	ADDM	S1,TABSIZ		;BETWEEN ITEMS
	MOVE	Q2,Q3SAVE		;RESTART TABLE POINTER FOR ACTUAL LISTING
CMQ3:	PUSHJ	P,CMNXTE		;GET TO NEXT KEYWORD
	JUMPF	CMRTYP			;NO MORE, REPEAT COMMAND SO FAR AND CONTINUE
CMQ4:	MOVEI	S1,"/"			;LOAD A SLASH
	TXNE	F,CMSWF			;ARE WE DOING SWITCHES?
	PUSHJ	P,CMDOUT		;YES, TYPE THE SLASH
	PUSH	P,T1			;SAVE ADDRESS OF TABLE ENTRY
	PUSHJ	P,CMGTLN		;COMPUTE ITS LENGTH
	ADDM	T1,CURPOS		;MOVE CURRENT POSITION FORWARD
	POP	P,S1			;RESTORE POINTER
	PUSHJ	P,CMDSTO		;TYPE IT
	PUSHJ	P,CMNXTE		;GET TO NEXT KEYWORD
	JUMPF	CMRTYP			;NO MORE, REPEAT COMMAND SO FAR AND CONTINUE
	PUSHJ	P,NXTKEY		;AND POSITION FOR THE NEXT ONE
	JRST	CMQ4			;TRY NEXT
CMQ5:	MOVEI	S1," "			;GET A BLANK
	PUSHJ	P,CMDOUT		;OUTPUT A CHARACTER
	JRST	CMTAB0			;CONTINUE HELP PROCESSING
;ROUTINE WHICH TAKES POINTER TO TABLE IN Q2, POINTER TO END OF TABLE
;IN Q1, AND RETURNS POINTER TO KEYWORD NAME IN T1. SKIPS UNLESS TABLE
;IS EXHAUSTED. ONLY CONSIDERS PRINTABLE KEYWORDS, AND UPDATES Q2.

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

CMNXT1:	HLRZ	T2,0(Q2)	;GET PTR TO STRING FOR THIS ENTRY
	PUSHJ	P,CHKTBS
	MOVE	T1,T2
	$RETT			;RETURN TRUE!!
;ROUTINE TO CALL BEFORE TYPING KEYWORD IN RESPONSE TO "?". GIVE
;IT USER'S BYTE POINTER IN T1. IT DECIDES WHETHER KEYWORD WILL FIT
;ON THIS LINE, AND STARTS NEW LINE IF NOT. IT THEN OUTPUTS A TAB,
;FOLLOWED BY SWITCH DELIMITER (IF KEYWORD IS A SWITCH).

NXTKEY:	PUSHJ	P,.SAVET		;DON'T CLOBBER USER'S BYTE POINTER
	MOVE	T2,CURPOS		;GET OUR CURRENT POSITION
	PUSHJ	P,[CMTAB: ADD	T2,TABSIZ  ;FIGURE OUT MAXIMUM PLACE TAB CAN MOVE US TO
			   IDIV	T2,TABSIZ  ;SCALE DOWN TO REALLY WHERE
			   IMUL	T2,TABSIZ  ;TAB WILL BRING US TO
			   POPJ	P,0]
	ADD	T2,BIGSIZ		;MAKE SURE WE HAVE ROOM FOR ANOTHER COLUMN
	CAMLE	T2,PWIDTH		;ROOM FOR ANOTHER KEYWORD ON THIS LINE?
	PJRST	CRLF			;NO, TYPE A CRLF AND RETURN
	PJRST	TYPTAB			;YES, GET TO NEXT TAB STOP

;ROUTINE TO TYPE TAB OF SIZE TABSIZ. IT ASSUMES HARDWARE TABS ARE OF
;SIZE 8 AND TRIES TO TYPE AS MANY REAL TABS AS IT CAN, AND THEN SPACES
;OVER REST OF THE WAY.

TYPTAB:	MOVE	T2,CURPOS	;SEE WHERE WE'RE STARTING ON LINE
	PUSHJ	P,CMTAB		;SEE WHERE WE WANT TO GET TO
	MOVEM	T2,TABDON	;REMEMBER WHERE WE WANT TO GET TO
TYPTB1:	MOVE	T1,CURPOS	;GET WHERE WE ARE
	ADDI	T1,8		;HARDWARE TAB MIGHT GO THIS FAR
	TRZ	T1,7		;BUT MAYBE NOT QUITE
	CAMLE	T1,TABDON	;WILL HARDWARE TAB GO TOO FAR?
	JRST	TYPTB2		;YES
	MOVEI	S1,.CHTAB
	PUSHJ	P,XMCOUT	;AND TYPE IT
	JRST	TYPTB1		;LOOP FOR AS MANY HARDWARE TABS AS WE CAN GET AWAY WITH
TYPTB2:	MOVE	T1,CURPOS
	CAML	T1,TABDON	;ARE WE THERE YET?
	POPJ	P,0		;YES, SO TAB IS TYPED
	MOVEI	S1," "		;NO, SO SPACE OVER
	PUSHJ	P,XMCOUT
	JRST	TYPTB2		;AND LOOP FOR REST OF SPACES

;ROUTINE TAKING POINTER TO KEYWORD IN T1. RETURNS KEYWORD LENGTH IN
;T1. GIVES EXTRA 1 FOR SWITCH, ASSUMING A SLASH WILL PREFIX ITS
;PRINTOUT.

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

XCMTXT:	PUSHJ	P,CMRSTR		;READ 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	(INW)		;Invalid guide word
SUBTTL	Command Function / .CMCFM - Command Confirmation (end-of-line)

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

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

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

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

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

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

XCMNUX:	SKIPA	T1,[NUXBRK]	;USE SPECIAL BREAK SET
XCMNUM:	MOVEI	T1,NUMBRK	;USE REGULAR BREAK SET
	PUSHJ	P,CMRFLD	;READ FIELD
	TXNE	F,CMQUES	;SAW "?"
	JRST	CMNUMH		;YES
	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	(ICN)		;Invalid numeric character

;NUMBER BREAK SET, ALLOWS +, -, NUMBERS

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

NUXBRK:	777777,,777760
	777654,,001760
	777777,,777760
	777777,,777760
CMNUMH:	PUSHJ	P,DOHLP		;DO USER SUPPLIED MESSAGE
	JXN	F,CM%SDH,CMRTYP	;SUPPRESS DEFAULT HELP IF REQUESTED
	HRRZ	T2,FNARG	;GET BASE
	CAIL	T2,^D2		;LEGAL?
	CAILE	T2,^D10
	$STOP(IBN,Illegal base for number)
	CAIN	T2,^D10		;DECIMAL?
	JRST	CMNH10		;YES
	CAIN	T2,^D8		;OCTAL?
	JRST	CMNH8		;YES
	MOVEI	S1,[ASCIZ / a number in base /]
	PUSHJ	P,CMDSTO	;ARBITRARY BASE
	HRRZ	T1,.CMIOJ(P2)
	HRRZ	T2,FNARG
	MOVEI	T3,^D10
	ADDI	T2,"0"		;CONVERT BASE TO ASCII
	MOVE	S1,T2			;COPY THE BASE OVER
	PUSHJ	P,CMDOUT		;AND TYPE IT
	SUBI	T2,"0"			;CONVERT IT BACK
	JRST	CMRTYP		;RETYPE LINE AND CONTINUE

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

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

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

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

XCMQST:	PUSHJ	P,CMRQST		;READ THE STRING
	NOPARS(NQS)			;Not a quoted string
	MOVEI	S1,[ASCIZ /quoted string/]
	TXNE	F,CMQUES		;QUESTION MARK TYPED?
	PUSHJ	P,HELPER		;YES, GIVE HELP
	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
	TXNE	F,CMQUES		;DID HE TYPE A QUESTION MARK?
	PUSHJ	P,NODHLP		;YES, TYPE THE HELP TEXT(S)
	TXNE	F,CM%ESC		;WANT RECOGNITION?
	JRST	[PUSHJ	P,CMDIP		;YES, BACK UP TO RECOGNIZER
		PUSHJ	P,CMCIN		;GET THE RECOGNIZER
		PUSH	P,T1		;SAVE IT
		PUSHJ	P,CMDCH		;DELETE IT
		MOVEI	T1,":"		;GET TERMINATOR
		PUSHJ	P,CMDIB		;PUT IT IN
		PUSHJ	P,CMDIB		;TWICE
		POP	P,T1		;GET BACK RECOGNIZER
		PUSHJ	P,CMDIBQ	;PUT THAT BACK IN, NO TYPEOUT
		PUSHJ	P,CMDIP		;BACK UP OVER RECOGNIZER
		PUSHJ	P,CMDIP		;AND OVER 1 :
		PUSHJ	P,CMDIP		;AND OVER THE OTHER
		JRST	CMNOD1]		;REENETER FLOW
CMNOD1:	MOVE	S1,.CMABP(P2)		;GET THE BYTE POINTER
	ILDB	S2,S1			;GET THE FIRST BYTE
	SKIPN	S2			;BETTER NOT BE NULL
	JRST	ILLNOD			;IMPROPER NODE NAME
	MOVE	S1,.CMABP(P2)		;POINT AT THE ATOM BUFFER
	MOVEI	S2,^D8			;TRY AS AN OCTAL NUMBER
	PUSHJ	P,NUMIN			;READ IT
	JUMPT	CMNOD2			;WINS, CHECK LEGALITY
	MOVE	S1,.CMABP(P2)		;POINT AT THE ATOM BUFFER
	PUSHJ	P,CNVSIX		;CONVERT BUFFER TO SIXBIT
	SKIPT				;O.K.. CONTINUE
ILLNOD:	NOPARS	(NNC)		;Invalid node name
CMNOD2:	MOVEM	S2,CRBLK+CR.RES		;SAVE AS RESULT (SIXBIT OR #)
	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!
	PUSHJ	P,CMCIN			;GET NEXT CHAR AFTER FIELD
	CAIN	T1,":"			;BEGINING OF TERMINATOR?
	JRST	CMNOD3			;GOT ONE : GO LOOK FOR THE OTHER
	CAIN	T1,"_"			;NO, HOW ABOUT OTHER STYLE
	JRST	CMNOD4			;LOOKS GOOD KEEP GOING
	TXNN	F,CM%NSF		;NO SUFFIX REQUIRED?
	JRST	ILLNO1			;NOPE, QUIT (IE: IT WAS REQUIRED)
	PUSHJ	P,CMDIP			;BACK UP OVER THE TERMINATOR
	JRST	CMNOD4			;AND FINISH UP

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

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

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

XCMOFI:
XCMIFI:


XCMFIL:	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(IFS)		;Invalid file spec
	MOVE	T2,ATBPTR	;GET POINTER TO ATOM BUFFER END
	IBP	T2		;BUMP PAST TERMINATOR
	CAME	T2,XXXPTR	;DOES IT MATCH?
	  NOPARS(IFS)		;Invalid file spec
	TXZE	F,CMINDF	;ARE WE DOING INDIRECT FILE?
	RETSKP			;YES , RETURN FOR PROCESSING
	JRST	XCOMXI		;OTHERWISE, DONE


FILIN:	PUSHJ	P,.SAVE1	;SAVE A REG
	LOAD	S2,.CMGJB(P2),CM%GJB ;GET ADDR OF FD
	MOVEM	S2,CRBLK+CR.RES	;SAVE IT FOR CALLER
	MOVE	P1,S2		;AND REMEMBER IT
	MOVX	S1,FDXSIZ	;NOW ZERO IT OUT
	STORE	S1,.FDLEN(S2),FD.LEN ;STORE LENGTH INTO FD
	MOVEI	S1,.FDNAT	;GET NATIVE FD TYPE
	STORE	S1,.FDLEN(S2),FD.TYP	;STORE THE TYPE
	SKIPN	S1,.FDSTR(P1)	;SEE IF USER SUPPLIED A DEFAULT DEVICE
	MOVSI	S1,'DSK'	;NO, SUPPLY DEFAULT DEVICE
	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
	TLC	Q1,-1		;TOPS20-style string pointer?
	TLCN	Q1,-1		; ..
	HRLI	Q1,(POINT 7,)	;Yes, fix up
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	(NMT)		;Does not match token
SUBTTL	PATHIN	Routine to Parse TOPS-10 Path Specification

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

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

; Uses T1-T4 and XXXPTR

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

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

; Error Return is a non skip Return

PATHIN:	ILDB	S1,T1		;LOAD FIRST BYTE
	CAIE	S1,"["		;MUST BE BRACKET
	 POPJ	P,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,RDPPN		;GET CURRENT PPN 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		;GET PROJECT NUMBER
	SKIPT
	HLR	S2,PTHBLK+.PTPPN	;USE DEFAULT PROJECT NUMBER
	HRLM	S2,(P2)
	LDB	T1,S1		;GET TERMINATOR
	CAIE	T1,","		;MUST BE COMMA
	  POPJ	P,0		;FAIL -- PPN NOT NUMERIC
	MOVEI	S2,^D8		;SET OCTAL RADIX
	PUSHJ	P,NUMIN		;GET PROGRAMMER NUMBER
	SKIPT
	HRR	S2,PTHBLK+.PTPPN	;USE DEFAULT PROGRAMMER NUMBER
	HRRM	S2,0(P2)
	LDB	T1,S1		;GET TERMINATOR
	CAIE	T1,","		;MUST BE COMMA OR BRACKET
	CAIN	T1,"]"
	 SKIPA
	 POPJ	P,0		;FAIL -- PPN INCORECT
	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

; RDPPN routine to read PPN for channel or job
; CALL using no arguments
; RETURN with Job's PPN in PTHBLK

RDPPN:	MOVEI	S1,.PTMAX	;CLEAR ANSWER AREA
	MOVEI	S2,PTHBLK
	PUSHJ	P,.ZCHNK
	HRROI	S1,.GTPPN		;Want PPN
	GETTAB	S1,			;Go and get it
	 SETZB	S1,PTHBLK		;Rats
	MOVEM	S1,PTHBLK+.PTPPN	;Save it
	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	(IUS)		;Invalid user specified
	MOVE	T1,XXXPTR	;Ensure Entire atom was parsed
	CAME	T1,ATBPTR
	 NOPARS	(IUS)		;Invalid user specified
	JRST	XCOMXI		;DONE NOW
;COMMA, ARBITRARY CHARACTER

XCMCMA:	MOVEI	T1,","		;SETUP COMMA AS CHARACTER TO FIND
	MOVEM	T1,FNARG
CMCHR:	PUSHJ	P,CMCIN		;GET A CHAR
	CAIE	T1,.CHTAB	;BLANK?
	CAIN	T1," "
	JRST	CMCHR		;YES, IGNORE
	HRRZ	T2,FNARG	;GET SPECIFIED CHAR
	CAMN	T1,T2		;THE RIGHT ONE?
	JRST	XCOMXI		;YES, WIN
	JXN	F,CM%ESC,CMAMB		;AMBIGUOUS
	CAIN	T1,CMHLPC	;HELP?
	JRST	[PUSHJ	P,DOHLP
		JXN	F,CM%SDH,CMRTYP ;JUMP IF SUPPRESSING HELP
		MOVEI	S1,""""		;TYPE "char"
		PUSHJ	P,CMDOUT
		HRRZ	S1,FNARG
		PUSHJ	P,CMDOUT
		MOVEI	S1,""""
		PUSHJ	P,CMDOUT
		JRST	CMRTYP]
	NOPARS	(CMA)		;Not a comma
;DATE AND/OR TIME
;FLAGS IN ARG SPECIFY WHICH

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

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


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

TIMBRK:	777777,,777760		;Break on all control
	777774,,000760		;Allow 0-9 and :
	777777,,777760		;Break on A-Z
	777777,,777760		;Break on a-z
;LOCAL ROUTINE TO SETUP BYTE PTR TO TABLE STRING AND GET FLAGS
; T2/ ADDRESS OF STRING
;	PUSHJ	P,CHKTBS
; T1/ FLAGS
; T2/ BYTE POINTER TO STRING

CHKTBS:	HRLI	T2,(POINT 7)	;SETUP P AND S FIELDS
	SKIPE	T1,0(T2)	;CHECK FIRST WORD OF STRING
	TXNE	T1,177B6	;FIRST CHAR 0 AND WORD NOT ALL-0?
	TDZA	T1,T1		;NO, MAKE FLAGS ALL 0
	AOS	T2		;YES, HAVE FLAGS, ADJUST BYTE PTR
	POPJ	P,0


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

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

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

	SUBTTL	CMDSTO - STRING OUTPUT TO FILE AND TERMINAL

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

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

;CALL IS:	 S1/ TEST STRING POINTER
;		 S2/ BASE STRING POINTER
;TRUE RETURN:	  S1/ COMPARE CODE:
;	1B0 (SC%LSS) - TEST STRING LESS THAN BASE STRING
;	1B1 (SC%SUB) - TEST STRING SUBSET OF BASE STRING
;	1B2 (SC%GTR) - TEST STRING GREATER THAN BASE STRING
;	N.O.T.A. MEANS EXACT MATCH
;		S2/ UPDATED BASE STRING POINTER, USEFUL IN CASE TEST STRING
;	WAS SUBSET

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

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


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

USTCMP::ILDB	T3,T1		;GET NEXT BYTE FROM EACH STRING
	CAIL	T3,"A"+40	;LC LETTER?
	JRST	[CAIG	T3,"Z"+40
		SUBI	T3,40		;YES, CONVERT TO UC
		JRST	.+1]
	ILDB	T4,T2
	CAIL	T4,"A"+40	;LC LETTER?
	JRST	[CAIG	T4,"Z"+40
		SUBI	T4,40		;YES, CONVERT TO UC
		JRST	.+1]
	CAME	T3,T4		;STILL EQUAL?
	JRST	STRC2		;NO, GO SEE WHY
	JUMPN	T3,USTCMP	;KEEP GOING IF NOT END OF STRING
	SETZ	T1,		;STRINGS ENDED TOGETHER, EXACT MATCH.
	POPJ	P,0		;RETURN 0

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


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

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

TOPS10 <
S%TBLK:	PUSHJ	P,.SAVET		;SAVE SOME REGISTERS
	DMOVE	T1,S1			;COPY INPUT ARGUMENTS
	PUSHJ	P,XTLOOK		;DO THE WORK
	DMOVE	S1,T1			;RE-COPY ARGUMENTS
	$RETT				;AND RETURN
;WORKER ROUTINE - MAY BE CALLED INTERNALLY.
; RETURNS +1 SUCCESS, ACS AS ABOVE

;INTERNAL AC USAGE:
; T1/ TEST STRING FROM CALL
; T2/ STRING FROM TABLE
; T3/ CLOBBERED BY USTCMP
; T4/ " "
; P1/ CURRENT TABLE INDEX
; P2/ ADDRESS OF TABLE INDEXED BY P1 - USED FOR INDIRECTION
; P3/ INDEX INCREMENT FOR LOG SEARCH
; P4/ SIZE OF TABLE

XTLOOK::PUSHJ	P,.SAVE4	;PRESERVE ACS
	$SAVE	P5
	HLRZ	T3,T2		;CHECK STRING POINTER
	CAIE	T3,-1		;LH 0 OR -1?
	CAIN	T3,0
	HRLI	T2,(POINT 7)	;YES, FILL IN
	MOVEM	T2,STRG
	MOVEI	P2,1(T1)	;CONSTRUCT ADDRESS OF FIRST ENTRY
	HRLI	P2,P1		;MAKE IT INDEXED BY P1
	HLRZ	P4,0(T1)	;GET PRESENT SIZE
	MOVE	P3,P4		;INITIAL INCREMENT IS SIZE
	MOVE	P1,P4		;SET INITIAL INDEX TO SIZE/2
	ASH	P1,-1
	JUMPE	P4,TABLKX	;IF TABLE EMPTY THEN NO MATCH
TABLK0:	HLRZ	T2,@P2		;GET STRING ADR FROM TABLE
	PUSHJ	P,CHKTBS	;CONSTRUCT POINTER
	MOVE	T1,STRG		;GET TEST STRING
	PUSHJ	P,USTCMP	;COMPARE
	JUMPN	T1,TABLK1	;JUMP IF NOT EXACTLY EQUAL
TABLKF:	HLRZ	T2,@P2		;GET STRING ADDRESS
	PUSHJ	P,CHKTBS	;GET FLAGS
	JXN	T1,CM%NOR,TABLKM ;MAKE IT AMBIG IF NOREC ENTRY
	MOVX	T2,TL%EXM	;EXACTLY EQUAL, RETURN CODE
	JRST	TABLKA

TABLKM:	SKIPA	T2,[TL%AMB]	;AMBIGUOUS RETURN
TABLKX:	MOVX	T2,TL%NOM	;NO MATCH RETURN
TABLKA:	MOVEI	T1,@P2		;RETURN ADR WHERE ENTRY IS OR SHOULD BE
	POPJ	P,
;STRING MAY BE UNEQUAL OR A SUBSET, SEE WHICH

TABLK1:	JXE	T1,SC%SUB,TABLKN ;UNEQUAL, GO SETUP NEXT PROBE
TABLK3:	MOVEM	T2,REMSTR	;SUBSTRING, SAVE REMAINDER
	JUMPE	P1,TABLK2	;JUMP IF THIS FIRST ENTRY IN TABLE
	MOVEI	T1,@P2		;CHECK NEXT HIGHER ENTRY IN TABLE
	HLRZ	T2,-1(T1)	;GET ITS STRING ADDRESS
	PUSHJ	P,CHKTBS	;BUILD BYTE PTR
	MOVE	T1,STRG		;GET TEST STRING
	PUSHJ	P,USTCMP	;TEST PREVIOUS ENTRY
	JUMPE	T1,[SOJA P1,TABLKF] ;EXACTLY EQUAL, DONE. FIX INDEX.
	JXN	T1,SC%GTR,TABLK2 ;IF LESS THEN HAVE FOUND HIGHEST SUBSTR
	SOJA	P1,TABLK3	;STILL A SUBSTR, CHECK HIGHER

;NOW POINT AT HIGHEST ENTRY WHICH IS A SUBSTR.  IF THERE IS AN EXACT
;MATCH, IT IS BEFORE ALL SUBSETS AND HAS ALREADY BEEN FOUND

TABLK2:	MOVEI	T1,@P2		;CHECK NEXT ENTRY FOR AMBIGUOUS
	CAIL	P1,-1(P4)	;NOW AT LAST ENTRY IN TABLE?
	JRST	TBLK2A		;YES, THIS ENTRY IS DISTINCT
	HLRZ	T2,1(T1)	;GET STRING ADR OF NEXT ENTRY
	PUSHJ	P,CHKTBS	;BUILD BYTE PTR
	MOVE	T1,STRG		;GET TEST STRING
	PUSHJ	P,USTCMP	;COMPARE NEXT LOWER ENTRY
	JUMPE	T1,[$STOP(BTF,Bad table format)] ;EXACT MATCH,TABLE IS BAD
	JXN	T1,SC%SUB,TABLKM ;NEXT ENTRY NOT DISTINCT, DO AMBIG RETURN
TBLK2A:	HLRZ T2,@P2		;CHECK FLAGS FOR THIS ENTRY
	PUSHJ	P,CHKTBS
	JXN	T1,CM%NOR,TABLKM ;FAIL IF NOREC BIT SET
	MOVX	T2,TL%ABR	;GIVE LEGAL ABBREVIATION RETURN
	MOVE	T3,REMSTR	;RETURN PTR TO REMAINDER OF STRING
	JRST	TABLKA

;HERE WHEN PROBE NOT EQUAL

TABLKN:	CAIG	P3,1		;INCREMENT NOW 1?
	JRST	[JXN	T1,SC%LSS,TABLKX ;YES, NO MATCH FOUND
		AOJA	P1,TABLKX] 	;IF STRING GREATER, BUMP ADR FOR INSERT
	AOS	P3		;NEXT INC = <INC+1>/2
	ASH	P3,-1
	TXNE	T1,SC%GTR	;IF LAST PROBE LOW, ADD INCREMENT
	ADD	P1,P3
	TXNE	T1,SC%LSS
	SUB	P1,P3		;LAST PROBE HIGH, SUBTRACT INCR
TBLKN1:	CAIL	P1,0(P4)	;AFTER END OF TABLE?
	JRST	[MOVX	T1,SC%LSS	;YES, FAKE PROBE TOO HIGH
		JRST	TABLKN]
	JUMPGE	P1,TABLK0	;IF STILL WITHIN TABLE RANGE, GO PROBE
	MOVX	T1,SC%GTR	;BEFORE START OF TABLE, FAKE LOW PROBE
	JRST	TABLKN
>  ;END TOPS10 CONDITIONAL
	SUBTTL	S%TBAD - Table Add Routine

;THIS ROUTINE IS DESIGNED TO ADD AN ENTRY TO A COMMAND
;TABLE AND IS CALLED WITH THE FOLLOWING INFO
;
; CALL WITH:	S1/	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
	MOVEI	S1,EREIT$		;ENTRY ALREADY IN TABLE
	CAIN	S2,TADDX1		;WAS IT TABLE IS FULL
	MOVEI	S1,ERTBF$		;TABLE IS FULL
	$RETF
>;END TOPS20 CONDITIONAL


TOPS10 <
S%TBAD:	PUSHJ	P,.SAVET		;SAVE THE T REGS
	MOVEM	S1,TBADDR		;SAVE TABLE ADDRESS
	MOVEM	S2,ENTADR		;SAVE ENTRY ADDRESS
	HLRZ	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
	MOVX	S1,ERTBF$		;TABLE IS FULL
	CAIN	S2,TDELX2		;ENTRY ALREADY IN TABLE
	MOVX	S1,ERITE$		;ENTRY ALREADY IN TABLE
	$RETF
>;END TOPS20 CONDITIONAL



TOPS10 <
S%TBDL:	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
SUBTTL	CNTDT,CNVDT DATE/TIME CONVERSION ROUTINES


;CNTDT	CONVERTS UDT TO TWO WORD DATE/TIME

;ACCEPTS	S1/	UDT

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


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


;CNVDT	CONVERTS TWO WORD DATE/TIME TO UDT

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

;RETURNS	S1/	UDT

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

;DEFINE SPECIAL ACs REQUIRED BY THESE ROUTINES


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



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

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


;RETURNS TRUE	S1/ UPDATED POINTER
;		S2/	UDT

;	 FALSE	S1/  ERROR CODE


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

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

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

	POP	P,S1		; Restore the byte pointer

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

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

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


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

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


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

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

	ECHO$W==0		;MAKE NULL CONDITIONAL


;DEFINE THE ERROR PROCESSING MACROS


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

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

;DEFINE THE GLOBAL STORAGE REFERENCED BY THESE ROUTINES

	GLOB	LOGTIM		;TIME JOB WAS LOGGED IN


;DEFINE THE LOCAL STORAGE USED BY THESE ROUTINES

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

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


	$DATA	.LASWD
	$DATA	.NMUL
	SUBTTL	SUBROUTINES FOR COMMAND INPUT - GET DATE/TIME

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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


;MNEMONIC WORDS IN DATE/TIME SCAN

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

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

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

SPCDAY:	XX	YESTERDAY
	XX	TODAY
	XX	TOMORROW

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

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

;POINTERS

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

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

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

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

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

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

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

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


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

.CKNEG:	SETZB	N,FLNEG		;CLEAR N AND NEGATIVE FLAG
	CAIE	C,"-"		;CHECK IF NEGATIVE NUMBER
	POPJ	P,		;NO--RETURN
	SETOM	FLNEG		;YES--SET FLAG
	PJRST	.TIAUC		;GET NEXT CHAR AND RETURN
;.SIXSW -- INPUT A SIXBIT WORD FROM COMMAND STRING
;.SIXSC  -- DITTO (CHARACTER ALREADY IN C)
;TERMINATES AT FIRST NON-ALPHANUMERIC CHARACTER
;THROWS AWAY ANY CHARACTERS BEYOND THE FIRST SIX
;CALL:	PUSHJ	P,.SIXSC/.SIXSW
;	RETURN WITH WORD IN N
;USES T1    UPDATES C (SEPARATOR)

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

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

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

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

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

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

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

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

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

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



;DEFINE SOME DUMMY ROUTINES NORMALLY USED FOR ERROR PROCESSING

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

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

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

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

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

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

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

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

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

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

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

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

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

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


	;BACK TO OUR FAVORITE RADIX

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

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

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

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

	END