.title	CCL
	.ident	/V6.AC/
; EDIT # 0102	3 Apr 1981   10:33:54	DR0:[344,60]CCL.MAC;162
; PREVIOUS EDIT	3 Apr 1981    8:40:22	DR0:[344,60]CCL.MAC;161
	.enabl	LC
	.nlist	BEX

	.sbttl	Introduction
;+
;		JAMES G. DOWNWARD
;		KMS FUSION, INC
;		3941 RESEARCH PARK DR.
;		ANN ARBOR, MICH
;		313-769-8500
;
; This program is the composite of two programs.  One part uses a list of pre-
; defined commands(LIST, TYPE, DELETE...etc.) and turns them into MCR commands
; to the utilities.  This part was paterned after DEC'S TDX or catchall task.
; It's included in the section 'DCL' which comprises the later part of CCL.MAC
;   The second part of the program consists of code to open a file
; (USERCCL.CCL or SYSCCL.CCL) and see if the command entered corresponds
; to a command entered in the file.  First the file USERCCL.CCL
; on the user's UIC and SY: is tried.  If either the file does not exist
; or the command is not found, the scan is repeated using SYSCCL.CCL.
;   The program logic is somewhat tangled since this is a melange of
; various programing styles, edits, and conversions from F4P.  Without
; a single doubt, it should be rewritten into a single coherent
; program.  The program starts out by seeing if it got a valid 
; command line from MCR.  If it did, it calls the DCL subroutine
; which checks to see if it matches the command in the command table.
; Note that if the first three letters match, DCL assumes it is a match,
; and will field the command, so commands which have the first three
; letters matching in a .CCL file will do no good at all. If a match is 
; found the command is spawned to MCR, and ...CA. will stop itself until
; the command is executed and then will exit with the appropriate status.
;   If DCL does not find the command a direct return is made to CCL
; which proceeds to open the .CCL files, and search for a command WHICH
; matches up to the first 9 letters.  If a match is found, the prototype
; command line in the file is DECODED, fleshed out, and spawned to MCR.
; If the command prototype ends with a %$% (signifying ESC) the CCL will exit
; without waiting for the MCR command to finish executing.  Otherwise CCL will
; hang around until the command spawned to MCR has finished.  To provide 
; notification when a lengthy CCL command exits, the user will be notified
; by the terminal bell ringing if %B is in the CCL command file line
;-
 
	.sbttl	Define assembly conditionals
$DCL	=	0		; Enable DCL				;ALI
$PIP	=	0		; Enable PIP subset of DCL		;ALI

;
; Define buffer length and maximum # of parameters allowed
;
MAXPAR	=	9.		; %1% to %9%
PARLNG	=	60.		; 60 bytes per %n%
PARLN1	=	PARLNG+1	; One more than PARLNG

;
; Further misc. definitions
;
CR	=	15		; <CR>
LF	=	12		; <LF>
ESC	=	33		; <ESC>
SPA	=	40		; Blank

	.SBTTL	The original CCL
;
;  R. J. KIRKMAN
;
; The main routine also requires SPNMCR, LOOKUP & FIXUP.
;
; MODIFIED BY:
;	15-MAR-79  	J. DOWNWARD	ADD VARIOUS ERROR MESSAGES, TEST FOR
;					LINES TOO LONG, AND FOR SPEED BUILD IN
;					ALL KINDS OF DCL-LIKE COMMANDS.
;					(EG. LIST, DIR, SPOOL, TRUNCATE,
;					PURGE, DELETE., ETC.)
;
;	24-SEP-79	J. DOWNWARD	ADD %U,'G%,%G,%T TO DECODED VARIABLES
;					ADD MULTIPLE LINE CCL COMMANDS AND A
;					ABILITY FOR CCL TO WAIT FOR A SPECIFIC
;					TASK TO EXIT
;
;	10-Jan-80	A. Li		Performed massive edit on all source
;			U of Miami	files and made the program legible.
;					Also made error messages upper/lower
;					and lower case.  Conditionalized
;					generation of DCL adn the PIP subset
;					of DCL. Added %A - pass entire command
;					line (except the keyword).
; 
;	18-JUN-80	J. DOWNWARD	SUPPORT FOR %B(RING BELL UPON EXIT)
;
;	6 Feb 1981	RAY VAN TASSLE	CHANGES TO PROPERLY HANDLE EXIT
;					STATUS OF SPAWNED COMMANDS
;				HAVE CCL EXIT AFTER SPAWNING THE LAST
;				COMMAND, WITHOUT PROMPT. THE SPAWNED
;				PGM WILL PROMPT.
;
;	CCL IS TASK-BUILT AS PRIVILEGED SO THAT IT CAN:
;		1) TURN OFF THE BIT TO GET MCR PROMPT ON EXIT.
;		2) USE THE ROUTINE USED BY AT. TO FIGURE OUT
;		   EXACTLY WHICH TASK TO WAIT ON.


	.MCALL	GET$S,OPEN$R,FDBDF$,FDRC$A,CLOSE$,EXIT$S,QIOW$S
	.MCALL	TCBDF$
	TCBDF$			; TCB DEFINITION
	.MCALL	FDOP$A,FSRSZ$,DIR$,EXST$S,GTSK$S,GLUN$
	.MCALL	QIOW$C,SPWN$S,STSE$S,CLEF$S

;
; The program reads in turn the user file SY:USERCCL.CCL
; and then the system file LB1:SYSCCL.CCL in a specific directory
; LUN 1 is used for the files and LUN 2 for error reporting and
; for asking for parameters.
;

	fsrsz$	1		; One file only!

; 
; Note this was FORTRAN common - this is shared by ALL routines.
; 

	.PSECT	.$$$$.,rw,d,con,ovr,gbl
 
PARAMS:	.WORD	0	; Max # params to prompt for
MCRL:	.WORD	0	; Length of mcr line
KEYL:	.WORD	0	; Length of keyword
MCR:	.BLKB	80.	; MCR buffer as input
KEYB:	.ASCII	/        /; Initial state of keyword buffer
P:			; Buffer for parameters
	.rept	MAXPAR	; For this many parameters
	.blkb	PARLNG	;  This many bytes
	.endr
CMD:	.BLKB	80.	; Output new command line
PMIN:	.WORD	0	; Min # params to accept
EXSTAT:	.WORD	EX$SUC	; Assume sucessful exit
DUIC:	.WORD	0	; For terminal UIC				;JGD03
GLBUF:	.BLKB	12.	; For terminal unit				;JGD03
	.BLKW	7	; To complete the rest of exit status block
 

;
;	This common contains the original MCR command line
;	minus the keyword.
;
	.psect	MCRDAT,rw,d,con,ovr,gbl
OMCR:	.blkb	80.	; Kill a few bites
NOSTOP:	.word	0	;	
RING:	.WORD	0	;

	.PSECT
;
;	 Error messages and prompts
;
STATUS:	.BLKW	8.	; For EXIT status				;JGD03
SAVTYP:	.WORD	0	; Save data type				;JGD03
MSG2:	.ASCIZ	<CR><LF>/CCL -- Error reading system file on LB1:/	;JGD01
MSG3:	.ASCIZ	<CR><LF>/CCL -- No command line !/			;JGD01
MSG4:	.ASCII	<CR><LF>/?        ?/<CR><LF>				;JGD01
	.ASCIZ	/CCL -- MCR syntax error or unknown command/
MSG5:	.ASCIZ	<CR><LF>/CCL -- CCL command too long/<CR><LF>		;JGD02
MSG6:	.ASCIZ	<CR><LF>/CCL -- SPAWN failure to MCR/
MSG7:	.ASCIZ	/CCL -- Invalid CCL command line/
MSG8:	.ASCIZ	/CCL -- Remainder of CCL command bypassed/
EM2:	.ASCIZ	<CR><LF>/CCL -- Command line too long/
EM3:	.ASCIZ	<CR><LF>/CCL -- Syntax error/
EM4:	.ASCII	<CR><LF>/CCL -- Task /					;JGD03
TSKNAM:	.ASCII	/XXXXXX/						;JGD03
	.ASCIZ	/ not active or not found/				;JGD03
EM5:	.ASCIZ	<CR><LF>/CCL -- Missing parameter prompts in ?.CCL file/
 
LBDEV:	.ASCII	/LB1:/		; Dev for system file
SYDEV:	.ASCII	/SY:/		; Dev for userccl file
SYUIC:	.ASCII	/[1,5]/		; UIC for my system file
SYFIL:	.ASCII	/SYSCCL.CCL/	; Name of my system file
USRFIL:	.ASCII	/USERCCL.CCL/	; Name of users files
ESCMSG:	.BYTE	ESC		; AN ESCAPE
	.EVEN
MCRNAM:	.RAD50	"MCR..."	
$LNGFL:	.WORD	-1		; Cleared on command not too long
NOBYTE:	.WORD	0		; Non-zero if a DCL command without
				; parameters after the command.
CMDNAM:	.WORD	0		; To keep track of command name
 
IOSTS:	.BLKW	2		; For prompting
TYPFLG:	.WORD	0		; IF INVOKED BY "RUN ...CA.", PRINT
				; THE LINES BEFORE SPAWNING THEM
;
; FLAGS TO SAY IF THE LAST COMMAND LINE WAS "INS" OR "RUN" FOR
;	SYNC
INSFLG:	.BYTE	0
RUNFLG:	.BYTE	0
INSNAM:	.ASCII	/INS/<CR>
	.IFNDF R$$MPL		; FOR M IT IS "MCR"
SYSNAM:	.ASCII	/MCR/<CR>
	.IFF			; FOR M-PLUS, IT IS "RUN"
SYSNAM:	.ASCII	/RUN/<CR>
	.ENDC

PR:	.ASCII	/CCL>/
	.if df	$DCL		; Only if we want it			;ALI
	.if df	$PIP		; Only if we really want		;ALI
;
; PIP commands for DIR,LIST, DELETE, SPOOL, PURGE, TRUNCATE, UNLOCK
;
TYPMSG:	.ASCIZ	/PIP TI:=/
PIPHD:	.ASCIZ	/PIP /
DELMSG:	.ASCIZ	\.;0/DE/LD/NM,\ ; A KLUDGY WAY TO GET /NM & /LD FOR ALL SPECS
PURMSG:	.ASCIZ	\.;0/PU/LD/NM,\
DIRMSG:	.ASCIZ	\/LI\
SPOMSG:	.ASCIZ	\/SP\
TRUMSG:	.ASCIZ	\/TR\
CREMSG:	.ASCIZ	\=TI:\
FREMSG:	.ASCIZ	\/FR\
SORMSG:	.ASCIZ	\SRD \
	.EVEN
	.endc;	$PIP							;ALI
	.endc;	$DCL							;ALI

;
; FDB for our CCL spec file
;
FDB::	FDBDF$
	FDRC$A	,INBF,80.
	FDOP$A	1,,,FO.RD!FA.SHR

;
; Input buffer for spec lines
;
INBF::	.BLKB	80.
FIXPRM:	.WORD	2,I,J		; PRL for calls to FIXUP
INUIC:	.WORD	0
L:	.WORD	0
K:	.WORD	0
J:	.WORD	0
I:	.WORD	0
N120:	.WORD	79.		; Only 79 bytes in buffer
PMCR:	.WORD	2,N120,CMD	; PRL for calls of PUTMCR
QNMRK:	.ASCII	/?       /	; Buffer for error text
$TEMPS:	.WORD	0
SYSDST:	.WORD	4,LBDEV,5,SYUIC,10.,SYFIL
USRDST:	.WORD	3,SYDEV,,,11.,USRFIL
GTBUF:	.BLKW	16.
GLUN:	GLUN$	2,GLBUF

	.PAGE
	.SBTTL	CCL - Root section

CCL:	MOV	$TKTCB,R1	; MAKE ME NON-PRIV
	BIC	#T3.PRV,T.ST3(R1)
	GTSK$S	#GTBUF		; Get our task parameters		;JGD
	DIR$	#GLUN		; Get our terminal LUN information	;JGD
	MOV	GTBUF+14.,DUIC	; Get our default UIC			;JGD
	MOV	(PC)+,R1
	.BYTE	127.,41.	; Setting up for DIR$ GMCR
	MOV	R1,KEYL		;
	DIR$	#KEYL		; GET COMMAND LINE
	MOV	@#$DSW,MCRL	; GET LENGTH OF COMMAND LINE
	CLR	KEYL
	TST	MCRL		; Any command line specified?
	BGT	CCL1		; Branch if one exists
;
; No command line, print a message and exit with severe status
; PROMPT THE TERMINAL FOR THE COMMAND LINE
	INC	TYPFLG		; TYPE THE COMMAND LINES
	QIOW$S	#IO.RPR,#2,#1,,#IOSTS,,<#MCR,#80.,,#PR,#4,#'$>
	MOV	IOSTS+2,R0	; TERMINATE INPUT WITH C/R
	MOVB	#CR,MCR(R0)
	MOV	IOSTS+2,MCRL
	BGT	CCL1

	MOV	#MSG3,R0	; Get appropriate error message
	JMP	ERROR		; Write it out and exit			;ALI
;
; Call DCL subroutine.  DCL returns only if command is not a DCL one.
;
CCL1:				;
	.if df	$DCL		; Sometimes useful
	CALL	DCL		; Is it a built-in command?
	.endc;	$DCL		;

;
; Split out command name from command line
;
	MOV	#1,R0
GETCOM:
	CMPB	MCR-1(R0),#SPA	; Is it a SPACE or control char(CR, ESC, ETC)
	BLE	GOTCOM		; Branch on delimiter
	MOVB	MCR-1(R0),MSG4+2(R0); Save it in message buffer
	MOVB	MCR-1(R0),KEYB-1(R0); Save it in keyword buffer
	INC	R0		; Increment index
	CMP	R0,#8.		; Do we have 8 characters?
	BLE	GETCOM		; Loop if not got 8 char yet
10$:	CMPB	MCR-1(R0),#SPA	; Command 8 char or more long,find SPACE or CR
	BLE	GOTCOM		; Got it
	INC	R0		; Bump us up one char
	BR	10$		; Loop till we get it

GOTCOM:				; Found a command
	DEC	R0		; Minus one
	MOV	R0,KEYL		; Save length of keyword
	MOV	#OMCR,R1	; Get address of save buffer
	MOV	MCRL,R3		; Get length of the whole line
	SUB	R0,R3		; Compute the length of the rest of the line
	BEQ	20$		; Branch if there is just a keyword
	DEC	R3		; Skip first character past the keyword
	BEQ	20$		; Branch just in case
	ADD	#MCR+1,R0	; Get address of first char in remaining line
10$:	MOVB	(R0)+,(R1)+	; One at a time
	SOB	R3,10$		; All little sob's moved?
20$:	CLRB	(R1)		; End the string with a null
;
;  Look for USERCCL.CCL
;
USROPN:
	MOV	#SYSOPN,R2	; Error return if "USERCCL.CCL" doesn't exist
	MOV	#USRDST,R1	; Data set descriptor
	CALL	OPEN		; Try and open it
;
; Found a user file , lookup the keyword in there
;
	CALL	LOOKUP		; Try and find the keyword
	TST	R0		; Is it there?
	BMI	KEYFND		; Branch if keyword found
;
; Keyword not found, close the file and look for it in "SYSCCL.CCL"
;
	CALL	CLOS		; FCS close
;
; Try opening "SYSCCL.CCL"
;
SYSOPN:
	MOV	#OPNFL,R2	; Error return prints a message and exits
	MOV	#SYSDST,R1	; "SYSCCL.CCL" dataset descriptor
	CALL	OPEN		; Perform the open
	CALL	LOOKUP		; Find the keyword
	TST	R0		; Is it there?
	BMI	KEYFND		; Branch if keyword found
;
; If found in system file deal in exactly same way as user file.
; If not then close file and check was last char of keyword
; a "?" in which case see if "? name" is defined, cheats and uses
; error message buffer
;
	CALL	CLOS		; Close "SYSCCL.CCL"
	MOV	KEYL,R0		; Get length of keyword
	CMPB	KEYB-1(R0),#'?	; Does it end with a question mark?
	BEQ	HELP		; Branch if it does end with "?"
	MOV	#MSG4,R0	; No question mark, unknown command
	JMP	ERROR		; Print error message and exit
;
; Generate HELP command for the above keyword
;
HELP:
	MOVB	#SPA,MCR-1(R0)	; Replace question mark with a blank
	MOV	#-1,KEYL	;
	MOV	QNMRK,KEYB	; Move it				;ALI
	MOV	QNMRK+2,KEYB+2	;  two bites				;ALI
	MOV	QNMRK+4,KEYB+4	;   at a time				;ALI
	MOV	QNMRK+6,KEYB+6	; No FFP needed				;ALI
	BR	USROPN		; We have a new command to interpret
;
; Keyword found, set up max parms and min parms
;
KEYFND:
	CLR	INUIC		; Not in UIC field
	MOV	#1,J		; Initialize loop indices
	MOV	#1,L		; Ditto
;
; Set all parameter strings empty ( clear 1st byte of each)
;
CLRPRM:				;
	MOV	#MAXPAR,r1	; Clear nine fields
	MOV	#P,R0;		; Get address of fields to clear
1$:	CLRB	(R0)		; Zero a byte
	ADD	#PARLNG,R0	; Each field is 60 bytes long
	SOB	R1,1$		; Loop until all are clear
;
; Is it keyword alone , if so check and see if all parameters were specified
;
	MOV	KEYL,R0		; Get length of keyword
	INC	R0		; Include terminator
	CMP	R0,MCRL		; Is it as long as the whole command?
	BGE	NEXTL		; Branch if so

	INC	R0		; Skip blank after keyword
	MOV	R0,I		; Load DO index
	MOV	MCRL,R0		; Get length of the command line
	INC	R0		; Add one to it
	MOV	R0,$TEMPS	; Stash it away
;
; Look at next character
;
SCANI:				;
	MOV	I,R0		; Look at next character
	CMPB	MCR-1(R0),#'[	; Is it start of the UIC?
	BNE	1$		; No, branch
	MOV	#-1,INUIC	; Set UIC flag
1$:	CMPB	MCR-1(R0),#']	; Is it the end of the UIC field?
	BNE	2$		; No, branch
	CLR	INUIC		; Yes, clear UIC flag
;
; Check for ' ', '=', '<', '_', ',' (Legal separators)
; If ',' then check if we are in a UIC field
;
2$:	CMPB	MCR-1(R0),#SPA	; Is it a blank?
	BLE	SEP		; Branch if it is
	CMPB	MCR-1(R0),#'=	; Equal sign?
	BEQ	SEP		; Branch if so
	CMPB	MCR-1(R0),#'<	; UNIX redirect?
	BEQ	SEP		; Could be
	CMPB	MCR-1(R0),#'_	; Underscore?
	BEQ	SEP		; Branch if underscore
	CMPB	MCR-1(R0),#',	; Comma?
	BNE	NOTSEP		; Branch if it is not
	TST	INUIC		; Found a comma, are we in a UIC field?
	BGE	SEP		; Branch if we are, comma is not special
;
; Character is not a separator, store it someplace
;
NOTSEP:				;
	MOV	L,R1		; Calculate P(J,L) address
	MUL	#PARLNG,R1	; This many bytes per field
	ADD	J,R1		; Offset into field
	MOVB	MCR-1(R0),P-PARLN1(R1)
	INC	J		; Increment to next place in field
	BR	NEXTI		; Go back for more
;
; Separator character was found, insert a null and try the next parameter.
;
SEP:				;
	MOV	L,R1		; Get parameter number
	MUL	#PARLNG,R1	; Calculate P(J,L)
	ADD	J,R1		; Add offset into this parameter
	CLRB	P-PARLN1(R1)	; Store a null to indicate end of string
	MOV	#1,J		; Reset offset pointer
	INC	L		; Done with this parameter, start on another
;
; Check and see if there are more characters to process
;
NEXTI:				;
	INC	I		; Point to the next character
	CMP	I,$TEMPS	; Are we done?
	BLE	SCANI		; Branch if there are some characters left
;
; Check and see if all parameters have been processed
;
NEXTL:				;
	DEC	L		; One less to do
	CMP	L,PMIN		; All done?
	BGE	ALLDON		; Branch if we have enough parameters
1$:	CMP	PARAMS,L	; Do we have the maximum number?
	BLE	ALLDON		; Branch if we do
;
; Prompt for next parameter
;
2$:	GET$S	#FDB		; Get a line from the .CCL file
	BCC	3$		; Branch if OK
	JMP	OPNFL		; EOF reached, very bad

3$:	CMPB	INBF,#'?	; Is the first byte a question mark?
	BNE	4$		; No, file format is bad
	CALL	PRMPT		; It's a question mark, get an answer
	BR	1$		; Check for too many parameters
;
4$:	MOV	#EM5,R0
	JMP	ERROR
;
; We have all necessary parameters, start building command lines.
;
ALLDON:	MOV	L,PARAMS	; Get the # of parameters

.NCMD:				; Come back here...
				; if multiple line command
	CLR	NOSTOP		; Reset this in case needed next time
	MOV	#EXSTAT,EXBLKP	; Set addr for SPAWNed pgm status
	MOV	#1,SPEFN	; SET EVENT FLAG 1 FOR THE SPAWN
	GET$S	#FDB		; Get next line from the .CCL file
	MOV	FDB+F.NRBD,R0	; NULL AFTER LAST BYTE
	CLRB	INBF(R0)
	BCC	10$		; Branch if OK
	JMP	OPNFL		; I/O error occured, exit
10$:	CMPB	INBF,#'-	; Is it a "Wait for task exit"?
	BNE	20$		; If NE  , No
	MOVB	#CR,INBF(R0)	; terminate it with a <CR> to make it happy
	CALL	WAITCK		; If EQ, Yes, stop until it exits
	BR	.NCMD		; and get another command
20$:	CMPB	INBF,#'+	; Is it a continuation line?
	BEQ	30$		; Yes,
	CMPB	INBF,#'*	; Is it the final command?
	BEQ	30$		; YES
	CMPB	INBF,#'?	; TAKE QUESTION MARK AS COMMENT
	BEQ	.NCMD

	MOV	#MSG7,R0	; TYPE INVALID CCL COMMAND MSG
	CALL	TYPERR
	MOV	#INBF,R0
	CLRB	INBF+79.
	JMP	ERROR

30$:	MOVB	INBF,SAVTYP	; Save the command type
	MOV	#80.,R0		; Blank out 80 bytes
	MOV	#CMD,R2		; What to blank
	MOV	#MCR,R1		; Something else to blank

40$:	CLRB	(R1)+	; Do one 
	CLRB	(R2)+	; Do the other
	SOB	R0,40$		; All done?

	MOV	FDB+F.NRBD,R0	; Get the # of bytes read in
	DEC	R0		; Minus first one
	BNE	41$
	JMP	ENDNX		; NOTHING TO DO ON THIS LINE

41$:	MOV	#INBF+1,R1	; Get them from here
	MOV	#MCR,R2		; Put them here

50$:	MOVB	(R1)+,(R2)+	; Copy one at a time
	SOB	R0,50$		; Into MCR buffer

	MOV	#1,I		; Initialize DO index
	MOV	#1,J		; Initialize another one
;
; Scan input line unit we hit a "%"
;
REPEAT:				;
	MOV	I,R0		; Get pointer to input line
	TSTB	MCR-1(R0)	; QUIT IF IT IS A NULL
	BEQ	3$
	CMPB	MCR-1(R0),#'%	; Is this a special character?
	BEQ	1$		; Yes, branch
	MOV	J,R1		; Nothing special, output as is
	MOVB	MCR-1(R0),CMD-1(R1); Do it
	INC	I		; Point to the next one
	INC	J		; Ditto
	BR	2$		; Check for buffer overflow

1$:	MOV	#FIXPRM,R5	; Special character, treat it as such
	CALL	FIXUP		; Call special subroutine

2$:	CMP	I,#80.		; Are we at the end of the input line?
	BGE	3$		; Yes, pass it to MCR
	CMP	J,#79.		; Out of output buffer?
	BLT	REPEAT		; No, branch back and repeat
;
; Done in one way or another
;
3$:	TSTB	CMD+111		; Should be NULL, else command too long
	BEQ	31$
	JMP	TOLONG		; Branch if too long


; THIS IS THE LAST LINE (WHICH IS NOT NULL). HAVE IT GIVE THE
;	MCR PROMPT WHEN IT QUITS, INSTEAD OF CCL, WHICH WILL EXIT
;	NOW. IF YOU REALLY WANT CCL TO STICK AROUND, MAKE THE LAST
;	LINE AN EMPTY COMMAND (* ONLY)
31$:	CMPB	SAVTYP,#'*	; LAST LINE?
	BNE	4$		; NO

	TST	RING		; IF HE WANTS ME TO RING THE BELL WHEN DONE
	BNE	4$		; DON'T GO AWAY NOW
	MOV	J,R1		; PUT <CR> AFTER IT, TO MAKE IT PROMPT
	MOVB	#15,CMD-1(R1)
	INC	NOSTOP
; SEE IF THE LAST LINE WAS INS OR RUN
	CMP	#"IN,CMD
	BNE	91$
	CMPB	#'S,CMD+2
	BNE	92$
	INCB	INSFLG
	BR	92$

91$:	CMP	#"RU,CMD
	BNE	92$
	CMPB	#'N,CMD+2
	BNE	92$
	INCB	RUNFLG

92$:	MOV	$TKTCB,R0	; FORCE NO PROMPT UPON EXIT
	BIT	#T3.MCR,T.ST3(R0) ; WILL CCL PROMPT ON EXIT?
	BNE	5$		; YES
	MOVB	#ESC,CMD-1(R1)	; NO--HAVE THIS NOT PROMPT EITHER
5$:	BIC	#T3.MCR,T.ST3(R0)
4$:	MOV	#PMCR,R5	; Get parameter list
	TST	TYPFLG		; PRINT THE COMMAND LINE???
	BEQ	6$
	QIOW$S	#IO.WVB,#2,#1,,,,<#CMD,J,#040>
6$:	CALL	PUTMCR		; Spawn to MCR
	BCC	ENDDUP		; Any errors?
	MOV	#MSG6,R0	; Error, warn user SPAWN failed
	JMP	ERROR		; Exit with error

ENDDUP:	TST	NOSTOP
	BNE	ENDNX		; There is no status to look at
	CMP	#EX$SUC,EXSTAT	; Is it success				;JGD03
	BEQ	ENDNX
	JMP	EREXST		; If NE, Error	- Bad status		;JGD03

ENDNX:	CMPB	SAVTYP,#'*	; Is this the final command?		;JGD03
	BEQ	FINISH		; Finish up and exit			;JGD03
	JMP	.NCMD		; More commands coming			;JGD03

FINISH:	CALL	CLOS		; Close file
	TST	RING		; SHOULD WE RING BELL			;JGD04
	BEQ	THEEND		; IF EQ 0, NO				;JGD04
	MOV	#BELMSG,R0	; SET BELL MESSAGE			;JGD04
	CALL	TYPEIT		; AND SEND IT TO TI:			;JGD04

; if CCL was spawned (e.g., from AT.), pass the OCB along to the
; task that CCL just spawned (assuming that it has not yet exited).
; This will let CCl get out of the way, just like "RUN" does.
THEEND:	mov	$tktcb,r0
	TST	T.OCBH(R0)
	BEQ	200$		; CCL has no parent, skip over all this junk

; SPAWN A NULL COMMAND TO MCR, TO MAKE SURE IT IS DONE WITH THE
;	ONE WE JUST GAVE IT. THIS PREVENTS A POSSIBLE RACE CONDITION
; 	where MCR has not yet started the task & passed ownership to it
	SPWN$S	#MCRNAM,,,,,#17.,,,#ESCMSG,#1
	STSE$S	#17.
; FOR SYNCHRONIZATION WITH LAST COMMAND, MUST DO FUNNY THINGS
; A) IF IT WAS RUN OF NON-INSTALLED TASK, FLOW IS:
;    MCR... --> ...MCR(RUN) --> MCR... --> ...INS --> TASK
;		OTB IS PASSED ALONG TO THE FINAL TASK
;
; B) IF IT WAS INS/RUN=REM OF NON-INSTALLED TASK, FLOW IS:
;    MCR... --> ...INS --> TASK
;		OTB IS PASSED ALONG TO THE FINAL TASK
;
	TSTB	INSFLG
	BNE	8$		; IT WAS INS
	TSTB	RUNFLG
	BEQ	9$		; NEITHER
	MOV	#SYSNAM,R5	; RUN--WAIT FOR ...SYS
	CALL	TSKWAIT
	SPWN$S	#MCRNAM,,,,,#17.,,,#ESCMSG,#1 ; WAIT FOR MCR...
	STSE$S	#17.
8$:	MOV	#INSNAM,R5	; WAIT FOR ...INS
	CALL	TSKWAIT

; There is no way to tell what task is the offspring without looking
; at all tasks OCB's, to find which task has an OCB pointing to
; us as the parent.
; Because I am lazy, I only look at the first OCB on each task. This should
; be okay, because the OCB's are FIFO.
9$:	MOV	$TKTCB,R0	; GET MY TCB BACK
	CALL	$SWSTK,200$
	MOV	$TSKHD,R4
10$:	TST	T.TCBL(R4)	;; QUIT IF THIS IS THE NULL-TASK TCB
	BEQ	199$
	MOV	T.OCBH(R4),R2	;; POINT TO 1ST OCB OF THE TASK
	BEQ	15$		;; BR IF NONE
	CMP	O.PTCB(R2),R0	;; IS THIS TASK MY CHILD??
	BEQ	20$		;; YES--MY SON, MY SON!!!
15$:	MOV	T.TCBL(R4),R4	;; NO--KEEP LOOKING
	BR	10$

; R0 IS TCB OF CCL
; R4 IS TCB OF CCL'S CHILD
20$:	ADD	#T.OCBH,R0	;; GET OUR OCB
	CALL	$QRMVF
	BCS	199$		;; NONE
	MOV	R4,R0		;; PASS IT TO THE CHILD
	ADD	#T.OCBH,R0
	CALL	$QINSF
199$:	RETURN			;; BACK TO USER STATE
200$:	EXST$S	EXSTAT		; Exit and show success
	EXIT$S			; If exit with status fails, try just exit
 
TOLONG:	MOV	#MSG5,R0	; Warning message
	CALL	TYPERR		; Type on TI:
	CLRB	CMD+116		; Write out command causing trouble
	MOV	#CMD,R0		; Write out the truncated command

ERROR:	CALL	TYPERR		; Tell the user the bad news
ERRORE:	CALL	CLOS		; Close .CCL file
EREXIT:	EXST$S	#EX$SEV		; Exit with severe error		;ALI
	EXIT$S			; If exit with status fails, just exit


;;;;; THE COMMAND FINISHED WITH NON-SUCCESS STATUS
;; SEE WHAT THE PROBLEM IS AND IF WE SHOULD CONTINUE OR NOT
EREXST:	MOV	#BUFFER,R0	; Get output buffer address
	MOV	#MESS1-1,R1	; Get address of 1st part of MESSAGE
	CALL	MOVE		; Put it in output buffer
	MOVB	#BELL,-1(R0)
	MOV	#MESS2,R1	; Get address of 2nd part of message
	CALL	MOVE		; Move it into output buffer
	MOV	EXSTAT,R1	; Get exit status
	CMP	#5,R1		; Known return code
	BHI	60$		; If HI, YES
	CLR	R2		; Suppress leading zeroes
	CALL	$CBOMG		; Convert to octal
	BR	70$		;
60$:				;
	ASL	R1		; Get word index
	MOV	CODES(R1),R1	; Get address of exit code message
	CALL	MOVE		; Move it into buffer
70$:	SUB	#BUFFER,R0	; Get length of message
	MOV	R0,QIO+Q.IOPL+2 ; Move length of buffer into QIO
	DIR$	#QIO		; Print message
	STSE$S	#EF2

; TYPE OUT THE OFFENDING COMMAND
	MOV	#CMD,R0
	CALL	TYPERR
	CMP	EXSTAT,#2	; CONTINUE IF SUCCESS OR WARNING
	BGE	80$
	JMP	ENDNX		; ERROR OR SEVERE ERROR-STOP

80$:	MOV	#MSG8,R0
	CALL	TYPERR		; TELL HIM WE ARE GIVING UP EARLY
	EXST$S	EXSTAT
	EXIT$S
 
	.if df	$DCL			; Only if we really want it
;+
;
; DCL
; This subroutine implements the following commands as though they were
; part of MCR:
;
;	BEL[L]					Ring terminal bell.
;	PAG[E]					Erase screen on VT100/TEK 4014
;	ERA[SE]					Erase screen of VT52
;	HOL[D]					SET /HOLD =TI:
;	NOH[OLD]      				SET /NOHOLD =TI:
;	SCR[OLL]				Set VT100 to slow scroll.
;	NOS[CROLL]				Set VT100 to normal mode.
;	LIS[T] FILESPEC,FILESPEC,....		List files at user's TI:
;	TYP[E] FILESPEC,FILESPEC,....		Type files at user's TI:
;	DEL[ETE] FILESPEC,FILESPEC,...		Delete the specified files
;	DIR[ECTORY] FILESPEC,FILESPEC,...	Display a directory listing
;	PUR[GE] FILESPEC, FILESPEC,....		Purge a directory of files
;	SPO[OL] FILESPEC,FILESPEC,...		Send files to line printer
;	TRU[NCATE] FILESPEC,FILESPEC,....	Truncate list of files
;	FRE[E]  DDn:				Display free blocks on DDn:
;	SOR[T]  filespec/switches		SRD [filespec/switches]/LI
;	CREATE	FILENAME			PIP filename=TI:
;	POOL					SET /POOL
;	UIC ={ grp, mem}			Set or display UIC
;	CHD					Set or display UIC
;	ATS  or ATS TI:				List all active tasks or only
;						those on TI:
;	SHQ					Show full spool queue
;	SHW					Show spool queue waiting list
;	DLG					Display logged in terminals
;	SYS					Show current System UIC
;	DLY NNNU				Delay 'NNN' U units of time
;	HEY taskname				Connect to task and notify
;						it when exits
;
;
; The syntax of most of the commands is:
;
;	COMMAND [FILES]
;
; The directory command may be modified by using the switches
; "/BR", or "/FU"
;
	.SBTTL	DCL - Process DCL-like PIP commands
	 
	.MACRO	MVZ,RA,RB,?A,?B ; Move ASCIZ string without trailing zero
A:	TSTB	(RA)
	BEQ	B
	MOVB	(RA)+,(RB)+
	BR	A
B:
	.ENDM
	 
EFN1	=	1
EF1	=	1
EF2	=	2
LUN2	=	2		; LUN for TI:
BELL	=	7		; Chimes
 
	.MCALL	STSE$S,QIOW$,SPWN$S,MRKT$S,DIR$,SPWN$
	.MCALL	CNCT$
 
CNNECT:	CNCT$	,EF1,,EXTBLK
QIOW:	QIOW$	IO.WVB,LUN2,EF2,,,,<0,0,40>
QIO:	QIOW$	IO.WVB,LUN2,EF2,,ISB,,<BUFFER,,40>
SPWN:	SPWN$	MCR...,,,,,1
 
;
; Error messages
;
EMM2:	.ASCII	/CCL -- Task not in system/
EMM2L=.-EMM2
EMM3:	.ASCII	/CCL -- Syntax error/
EMM3L=.-EMM3
EMM4:	.ASCII	/CCL -- Command parsing error after PIP:/
EMM4L=.-EMM4
	.EVEN
 
;
; List of valid DCL commands.  Those entries that can also take
; a prefix of "NO" are indicated by "-1" in the table and must
; immediately follow the un-prefixed entry for the same command.
; 
CMDTBL:;
	.if df	$PIP		; Do we want this subset?
	.RAD50	/DIR/		; LIst directory on TI:
	.RAD50	/PUR/		; Purge directory
	.RAD50	/SPO/		; Spool files via PIP /SP
	.RAD50	/FRE/		; Display number of free blocks
	.RAD50	/DEL/		; Delete file(s)
	.RAD50	/TYP/		; Type file(s) on ti:
	.RAD50	/LIS/		;
	.RAD50	/CRE/		; Create a file
	.RAD50	/TRU/		; Truncate file(s)
	.RAD50	/SOR/		; Sort/brief listing
	.endc;	$PIP		;
	.RAD50	/CHD/		; Change default directory
	.RAD50	/UIC/		;   "      "        "
	.RAD50	/ATS/		; List active tasks
	.RAD50	/SHQ/		; Show print and batch queues in full format
	.RAD50	/SHW/		; Show print and batch queues in short format
	.RAD50	/DLG/		; Display terminals on TI:
	.RAD50	/POO/		; Display the current amount of pool
	.RAD50	/SYS/		; Display current system UIC
	.RAD50	/DLY/		; Delay
	.RAD50	/HEY/		; Notify terminal of specified task exit
	.RAD50	/BEL/		; Ring terminal bell
	.RAD50	/PAG/		; Erase terminal screen of VT100/TEK 4014
	.RAD50	/ERA/		; Erase terminal screen of VT52
	.RAD50	/SCR/		; Set VT100 to scroll mode
	.WORD	-1		; Set VT100 to noscroll mode
	.RAD50	/HOL/		; SET /HOLD=TI:
	.WORD	-1		; SET /NOHOLD=TI:
ENDCMD:				; End of command table
 
;
; Co-table to CMDTBL that contains the address the the servicing routine
; for the decoded command.
;
JMPTBL:				;
	.if df	$PIP		;
	.WORD	PIP		; Directory listing
	.WORD	PIP		; Use also for PURGE
	.WORD	PIP		; Use also for SPOOL
	.WORD	PIP		; Use also for FREE
	.WORD	PIP		; Use also for DELETE entry
	.WORD	PIP		; Use for TYPE
	.WORD	PIP		; Use for LIST
	.WORD	PIP		; Use PIP for CREATE
	.WORD	PIP		; Use PIP for TRUNCATE
	.WORD	SRD		; Use code template for SRD /LI
	.endc;	$PIP		;
	.WORD	CHD		;
	.WORD	CHD		;
	.WORD	ATS		;
	.WORD	SHQ		;
	.WORD	SHW		;
	.WORD	DLG		; Show actice terminals
	.WORD	POO		; Show pool
	.WORD	SYS		; Display SYSUIC
	.WORD	DLY		; Delay for just a moment
	.WORD	HEY		; Connect to task
	.WORD	BELEP		; Ring terminal bell
	.WORD	PAGE		; Erase VT100 screen
	.WORD	ERASE		; Erase VT52 screen
	.WORD	SCROLL		; Set VT100 to scroll mode
	.WORD	NSCROLL		; Set VT100 to normal mode
	.WORD	HOLD		; SET /HOLD =TI:
	.WORD	NOHOLD		; SET /NOHOLD=TI:
 
;MCRNM:	.RAD50	/MCR.../	; MCR task
NOPRE:	.BYTE	0		; 1 if "NO" prefixes command
MCRBUF:	.BLKB	40.		; Buffer to build command line
	.BLKB	8.		; (******) 
	.EVEN

	.PAGE
	.SBTTL	Compress Command Line
;
; Get the command line from MCR and peel off the command from it.
; The command is defined as the first N characters of the line up to
; but not including the first non-alphanumeric
;
DCL:				; REF label
	MOV	#MCRBUF,SPWN+S.PWCA ; Set buffer address in normal SPWN DPB
	MOV	#EXSTAT,SPWN+S.PWES ; and EXIT status block address
	MOV	#MCR,R0		; Start of MCR command buffer
	CLRB	NOPRE		; Assume regular command
	CMPB	(R0),#'N	; "NO"?
	BNE	5$		; Branch if not
	CMPB	1(R0),#'O	;
	BNE	5$		; Branch if not
	ADD	#2,R0		; Skip prefix
	INCB	NOPRE		; Signal "NO" seen
5$:	CLR	R1		; Control for $CAT5(Do not decode dots)
	CALL	$CAT5		; Convert R50 to ASCII
				; (R1 contains command name)
	MOV	#MCR,R0		; Get start of command buffer again
	MOV	R0,R2		; for compression
	MOV	R0,R5		; Points to rest of command line
 
	MOV	#CMDTBL,R4	; Search the command table for a match
	MOV	R1,CMDNAM	; Save command name for later
10$:	CMP	R1,(R4)+	; See if it's a match
	BEQ	20$		; Go it
	CMP	R4,#ENDCMD	; Are we at end of table?
	BLO	10$		; If LO , no, try again
15$:	RETURN			; Go and try the .CCL file for a match

20$:	TSTB	NOPRE		; Prefixed command?
	BEQ	25$		; Branch if not
	CMP	(R4),#-1	; Command takes "NO" prefix?
	BNE	15$		; Branch if not, invalid DCL command
	TST	(R4)+		; Use prefixed command entry
25$:	MOV	R2,R0		; Restore R0
;
; Find where command ends
; The typical command will look as follows:
;
; <CMDNAME><SPACE><COMMAND QUALIFIER STRING>
;
; The CMDNAME may be more than three characters long, but only the first
; three were tested against the jump table(this is consistent with MCR).
; A space separated the cmd name from any command qualifier string.
;
PARSE:	CMPB	(R0),#SPA	; Is it a space?
	BEQ	REPACK		; If EQ, Yes, go repack buffer
	CMPB	(R0),#ESC	; Is it an <ESC>?
	BEQ	REPACK		; If EQ, Yes
	CMPB	(R0),#CR	; Is it a <CR>
	BEQ	REPACK		; If EQ, Yes
	INC	R0		; Else increment counter
	BR	PARSE		; And check next character
 
	.PAGE
REPACK: MOVB	(R0),(R2)+	; Move in first byte
	CMPB	(R0),#ESC	; Is it <ESC>
	BEQ	OUT		; If EQ, Yes
	CMPB	(R0),#CR	; Is it <CR>
	BEQ	OUT		; If EQ, Yes
	INC	R0		; Increment counter
	BR	REPACK		; Pack next character
OUT:	CLRB	(R2)		; Leave a null byte to signify end of buffer
;
; At this point the command line appears as follows.
; The command name has been removed from the command buffer.
; Note however, that the first character of the compressed  buffer
; may be a space.  The line ends with either a <CR> or <ESC>
; depending on which key terminated the read.  A zero byte follows this
; in order to simplify checking for EOL
;
; R4 points to the address of command routine +2
; R5 points to the start of the command buffer
;
	MOV	R4,R0		; Restore R0
	MOV	#MCRBUF,R1	; Get SPAWN buffer
	TSTB	1(R5)		; Any files follow command?
	BNE	25$		; If NE, Yes
	INC	NOBYTE		; Show no data for later
25$:	JMP	@JMPTBL-CMDTBL-2(R0) ; You can tell this line was BENN'S
 
	.enable	LSB
ERR2:	MOV	#EMM2,QIOW+Q.IOPL ; Address of error message
	MOV	#EMM2L,QIOW+Q.IOPL+2 ; Length of command
	BR	10$
ERR3:	MOV	#EMM3,QIOW+Q.IOPL
	MOV	#EMM3L,QIOW+Q.IOPL+2
	BR	10$
ERR4:	MOV	#EMM4,QIOW+Q.IOPL
	MOV	#EMM4L,QIOW+Q.IOPL+2
	BR 	10$
 
10$:	
	DIR$	#QIOW		; Print error message
	EXST$S	#EX$ERR		; Then comes the bad news
 
	.DSABLE	LSB
	.PAGE
	.if df	$PIP		; Only if defined
	.SBTTL	PIP-like commands
 
; 
; DIR,SPOOL,DELETE,TRUNCATE,FREE,PURGE,CREATE, ..etc. all processed here
;
SRD:	MOV	#SORMSG,R0	; Move in SRD
	MOV	#^RDIR,CMDNAM	; Pretend this is directory command
	BR	COMON		; Branch through common code
PIP:	CMP	CMDNAM,#^RTYP	; Is it TYPE command
	BEQ	10$		; If EQ Yes
	CMP	CMDNAM,#^RLIS	; Perhaps LIST?
	BNE	20$		; If NE, No
10$:	TST	NOBYTE		; Any files to list?
	BNE	XIT		; If NE, no files present
	MOV	#TYPMSG,R0	; Else point to start of command
	BR	COMON		; And skip over
20$:	MOV	#PIPHD,R0	; First part of SPAWN command

COMON:				;
	MVZ	R0,R1		; Mov ASCIZ string to SPAWN buffer
	CMP	CMDNAM,#^RPUR
	BNE	1$
	MOV	#PURMSG,R0      ; PURGE AND DELETE ACT FUNNY TO MAKE
	BR	2$		; /NM/LD ACT PROPERLY (LEFT TO RIGHT)
1$:	CMP	CMDNAM,#^RDEL
	BNE	3$
	MOV	#DELMSG,R0
2$:	MVZ	R0,R1
3$:	MVZ	R5,R1		; Mov rest of command up to zero
	DEC	R1		; BUMP OFF TRAILING <CR>
	CMP	CMDNAM,#^RPUR	; Is it purge?
	BNE	5$		; If NE no
	TST	NOBYTE		; Are any files present?
	BNE	XIT		; If NE, no, syntax error
	BR	DOIT		; 
5$:	CMP	CMDNAM,#^RDIR	; Is it directory?
	BNE	10$		; If NE, NO
	MOV	#DIRMSG,R0	; Mov in second half of name
	BR	DOIT		;
10$:	CMP	CMDNAM,#^RSPO	; Is it spool?
	BNE	15$		; If NE, no
	TST	NOBYTE		; Are any files present?
	BNE	XIT		; If NE, no , syntax error
	MOV	#SPOMSG,R0	; Move in /SP
	BR	DOIT		; Go do it
15$:	CMP	CMDNAM,#^RFRE	; Is it /FR command?
	BNE	20$		; If NE, no
	MOV	#FREMSG,R0	; Move in second half of name
	BR	DOIT		; Go issue command
20$:	CMP	CMDNAM,#^RDEL	; Is it delete?
	BNE	25$		; If NE,no
	TST	NOBYTE		; Any files present?
	BNE	XIT		; If NE, no, syntax error
	BR	DOIT		; Go issue command
25$:	CMP	CMDNAM,#^RCRE	; Is it create?
	BNE	30$		; If NE, no
	MOV	#CREMSG,R0	; Move in second half of command
	BR	DOIT		; Go issue command
30$:	CMP	CMDNAM,#^RTRU	; Is it truncate?
	BNE	35$		; If NE,no
	MOV	#TRUMSG,R0	; If YES, move in switch
	BR	DOIT		; And go do it.
35$:	CMP	CMDNAM,#^RTYP	; Is it type?
	BEQ	DOIT		; If EQ, Yes go do it
	CMP	CMDNAM,#^RLIS	; Perhaps it is LIST?
	BEQ	DOIT		; If YES, do it
40$:
	JMP	ERR4		; Warn user code fell through here

DOIT:
	MVZ	R0,R1		; Move it in
	CMPB	-1(R1),#CR	; put in a trailing <CR> so it will prompt
	BEQ	45$
	MOVB	#CR,(R1)+
45$:	SUB	#MCRBUF,R1	; Length of line to SPAWN
	CMP	R1,#78.		; Is composit line too long?
	BGT	LNGERR		; If GT, Yes
	MOV	R1,SPWN+S.PWCL	; And the length of the command
	JMP	SPWNIT		; SPAWN command and exit
XIT:	JMP	ERR3		; Say syntax error
LNGERR:	MOV	#EM2,R0		; Say it's too long
	JMP	ERROR		; Print message and exit with error
 
	.endc;	$PIP		; No PIP or SRD commands implemented
 
	.PAGE
 
	.SBTTL	CHD
; 
; CHD - Change (or show) current UIC
;
CHDM1:	.ASCIZ	\SET /UIC=[\
CHDM2:	.ASCIZ	\SET /UIC\<CR>
UICCL:	.ASCIZ	\]\
	.EVEN

CHD:				; Ref label
	TSTB	1(R5)		; Is there a UIC specified?
	BEQ	CHDSHW		; No - show current UIC
	MOV	#CHDM1,R0	; Get first part of command
	MVZ	R0,R1		; Move first part of string to spawn buffer
	MOV	R5,R0		;
	INC	R0		;
10$:	TSTB	(R0)		; Is it end of line
	BEQ	20$		; If EQ 0, YES, close up command
	CMPB	(R0),#'[	; Is it "["?
	BNE	11$		; If NE, NO, skip
	MOVB	#SPA,(R0)+	; Yes, make it a space
	BR	10$		; And try again
11$:	CMPB	(R0),#'=	; Is it an "="?
	BNE	12$		; If NE, NO
	MOVB	#SPA,(R0)+	; Yes, make it a space
	BR	10$		; And check again
12$:	CMPB	#'],(R0)	; Is it a "]"?
	BNE	13$		; If NE, NO
	MOVB	#CR,(R0)+	; Yes, so terminate command with <CR>
	CLRB	(R0)		; and 0 byte
	BR	10$		; And loop again to catch 0 byte
13$:				; If not [, ], = , either number or <SPA>
	CMPB	(R0)+,#SPA	; If a space seperates the GRM MEM
	BNE	10$		; If NE, must be number-get another
	MOVB	#',,-1(R0)	; Else move in a COMMA
 
20$:	MVZ	R5,R1		; Move in UIC
	DEC	R1		; STRIP OFF TRAILING <CR>
	MOV	#UICCL,R0
	JMP	DOIT

CHDSHW:				; Ref label
	MOV	#CHDM2,SPWN+S.PWCA ; Set buffer address
	MOV	#9.,SPWN+S.PWCL	 ; Set buffer length
	JMP	SPWNIT		; Spawn command and exit

	.PAGE
	.SBTTL	ATS
;
; ATS - LIST ALL ACTIVE TASKS ( OR ONLY THOSE FOR A TERMINAL)
; 
ATSM1:	.ASCII	\ACT /ALL\<CR>
ATSM2:	.ASCIZ	\ACT /TERM=\
	.EVEN

ATS:	TSTB	1(R5)		; US THERE A TERMINAL SPECIFIED
	BNE	ATSTTY		; YES, JUMP
	MOV	#9.,SPWN+S.PWCL	; SET COMMAND LENGTH
	MOV	#ATSM1,SPWN+S.PWCA ; SET BUFFER ADDRESS
	BR	SPWNIT		; SPAWN COMMAND AND EXIT
 
ATSTTY:	MOV	#ATSM2,R0	; FIRST PART OF SPAWN COMMAND
	MVZ	R0,R1		; MOVE ASCIZ STRING INTO SPAWN BUFFER
	INC	R5		;
	MVZ	R5,R1		; MOVE IN TERMINAL NUMBER
	SUB	#MCRBUF,R1	; LENGTH OF LINE TO SPAWN
	MOV	R1,SPWN+S.PWCL	; SET COMMAND LENGTH
	BR	SPWNIT		; SPAWN THE COMMAND
 

	.SBTTL Terminal setting routines
 
	.ENABL LC
ERAMSG:	.ASCII	<ESC>/H/	; Cursor to (1,1) VT52
	.ASCII	<ESC>/J/	; Erase to end of screen VT52
	.BYTE	176,034		; ERASE HAZELTINE 1500
	.BYTE	0		; Sentinal
PAGMSG:	.ASCII	<ESC>/[1;1H/	; Go to (1,1) VT100
	.ASCII	<ESC>/[2J/	; Erase screen VT100
	.BYTE	176,034		; ERASE HAZELTINE 1500
;	.ASCII	<ESC><14>	; Erase 4014 screen
;	.ASCII	/{WOR 0/<CR>	; Erase 4025
	.BYTE	0		; Sentinal
BELMSG:	.ASCIZ	<7>		; Ring bell
SCRMSG:	.ASCIZ	<ESC>/[?4h/	; Set terminal to scroll mode
NSCMSG:	.ASCIZ	<ESC>/[?4l/	; Set terminal to fast jump mode
HOLMSG:	.ASCII	\SET /HOLD=TI:\<CR>
NOHMSG:	.ASCII	\SET /NOHOLD=TI:\<CR>
	.EVEN

ERASE:	MOV	#ERAMSG,R0	; Erase VT52
	BR	TOTERM		; Branch 
PAGE:	MOV	#PAGMSG,R0	; Get escape string
	BR	TOTERM		; Go write out escape seq
SCROLL:	MOV	#SCRMSG,R0	; Set up output message
	BR	TOTERM		; Send it out
NSCROLL:MOV	#NSCMSG,R0	; Set up output message
	BR	TOTERM		; Send it to terminal
BELEP:	MOV	#BELMSG,R0	; Write out message

TOTERM:	CALL	TYPEIT		;
	EXST$S	#EX$SUC		; What could possibly go wrong?

HOLD:	MOV	#14.,SPWN+S.PWCL ; Set length
	MOV	#HOLMSG,SPWN+S.PWCA ; And buffer address
	BR	SPWNIT		; Spawn command and wait
NOHOLD:	MOV	#16.,SPWN+S.PWCL  ; Set length of command
	MOV	#NOHMSG,SPWN+S.PWCA ; And buffer length
	BR	SPWNIT		; SPawn command and wait
 
SPWNIT:	MOV	$TKTCB,R1	; WILL CCL PROMPT ON EXIT?
	BIT	#T3.MCR,T.ST3(R1)
	BNE	1$		; YES

	MOV	SPWN+S.PWCA,R1	; NO-DON'T LET THIS PROMPT AFTER ALL
	ADD	SPWN+S.PWCL,R1
	CMPB	#CR,-1(R1)
	BNE	1$
	MOVB	#ESC,-1(R1)
1$:	TST	TYPFLG		; PRINT THE COMMAND LINE???
	BEQ	6$
	MOV	SPWN+S.PWCA,R0
	MOV	SPWN+S.PWCL,R1
	DEC	R1
	QIOW$S	#IO.WVB,#2,#1,,,,<R0,R1,#040>
6$:	DIR$	#SPWN		; Try spawning to MCR... first
	BCC	10$		; If CC we got it
	MOV	#BADSPN,R0	; Print error message
	CALL	TYPERR		; Out on TI:
	EXST$S	#EX$SEV		; Very bad error

; HAVE THE SPAWNED TASK PROMPT ON EXIT, INSTEAD OF CCL
; ADD LATER--PASS THE OTB FROM CCL'S PARENT TASK TO THE JUST-SPAWNED TASK.
10$:	MOV	$TKTCB,R1	; HAVE CCL DO NOT PROMPT ON EXIT
	BIC	#T3.MCR,T.ST3(R1)
	JMP	THEEND	
 
	.PAGE
	.SBTTL	SHQ - SHW - DLG
;
; SHQ - Show full queue entries
;
 
SHQM:	.ASCII	\QUE /FU:ALL\<CR>
	.EVEN

SHQ:	MOV	#12.,SPWN+S.PWCL ; Set length
	MOV	#SHQM,SPWN+S.PWCA ; And buffer address
	BR	SPWNIT		; Spawn command
 
;
; SHW - Show QUE waiting list
;
 
SHWM:	.ASCII	\QUE /BR:ALL\<CR>
	.EVEN

SHW:	MOV	#12.,SPWN+S.PWCL; Set length
	MOV	#SHWM,SPWN+S.PWCA ; And address
	BR	SPWNIT		; Spawn command and exit
 
;
; DLG - Display logged in terminals
;
 
DLGM:	.ASCII	\DEV /LOG\<CR>
	.EVEN

DLG:	MOV	#9.,SPWN+S.PWCL ; Set length
	MOV	#DLGM,SPWN+S.PWCA ; And address
	BR	SPWNIT		; Spawn the command and exit
 
	.PAGE
 
;
; POO - Show pool amount
;
 
POOM:	.ASCII	\SET /POOL\<CR>
	.EVEN

POO:	MOV	#10.,SPWN+S.PWCL ; Set length
	MOV	#POOM,SPWN+S.PWCA ; And buffer address
	BR	SPWNIT		; Spawn the command and exit
 
; 
; SYS - Show current system UIC
; 

SYSM:	.ASCII	\SET /SYSUIC\<CR>
	.EVEN

SYS:	MOV	#12.,SPWN+S.PWCL ; Set length
	MOV	#SYSM,SPWN+S.PWCA; And buffer address
	BR	SPWNIT		; Spawn command and exit
 
	.PAGE
	.SBTTL	DLY
;
; DLY NNNU  -- Delay 'NNNN' units of time
;

DLY:
	MOV	R5,R0		; Copy buffer pointer
	CALL	$CDTB		; Convert units value
	MOV	R1,R5		; Save units value
	BEQ	30$		; Exit if null
	MOV	#1,R4		; Assume tics
	CMPB	R2,#'T		; Tics?
	BEQ	20$		; Yes
	INC	R4		; Try next time value
	CMPB	R2,#'S		; Seconds?
	BEQ	20$		; If EQ YES
	INC	R4		; No , assume minutes
	CMPB	R2,#'M		; Minutes?
	BEQ	20$		; If EQ, YES
	INC 	R4		; If NE, NO assume hours
	CMPB	R2,#'H		; Hours?
	BNE	30$		; If NE, illegal value
20$:	MRKT$S	#EFN1,R5,R4	; Issue marktime
	BCS	30$		; If directive ERROR
	JMP	END		; Go wait
30$:				; Ref label
	JMP	ERR3		; Syntax error
	
	.PAGE
	.SBTTL HEY
;
; HEY
;
 
BUFFER:	.BLKW	40.
EXTBLK:	.WORD	-1
ISB:	.WORD	0,0		; I/O Status block
 
CODES:	.WORD	E2
	.WORD	E3
	.WORD	E4
	.WORD	FUNNY		; Because exit status is 0,1,2,or 4
	.WORD	E5
 
ERRS:	.WORD	FUNNY		; 0 - Internal consistency error
	.WORD	CMLINE		; 2 - Command line I/O error
	.WORD	SYNTAX		; 4 - Syntax error
	.WORD	TSKCLI		; 6 - Task a CLI
	.WORD	NSTASK		; 8 - No such active task
 
BADSPN:	.ASCII	<CR><LF>/CCL -- Bad SPAWN to ...MCR,/
	.ASCIZ	/ Save printout and get help /
	.BYTE	15
MESS1:	.ASCIZ	/HEY -- Task /
MESS2:	.ASCIZ	/ exited with status - /
ERMES:	.ASCIZ	/HEY -- /
E2:	.ASCIZ	/warning/
E3:	.ASCIZ	/success/
E4:	.ASCIZ	/error/
E5:	.ASCIZ	/severe error/
NSTASK:	.ASCIZ	/Task not active "/
TSKCLI:	.ASCIZ	/Bad task-a CLI "/
SYNTAX:	.ASCIZ	/Invalid syntax "/
CMLINE:	.ASCIZ	/Bad command line "/
FUNNY:	.ASCIZ	/FUNNY -- Internal consistency error "/
	.EVEN

;;;;
; WAITCK -- PROCESS THE CCL COMMAND
;		-TASKNAME

WAITCK:	MOV	#INBF+1,R5
	CALL	TSKWAIT
	BCC	RET1
	JMP	ERRORE
RET1:	RETURN

HEY:	CALL	TSKWAIT
	BCC	EXOK
	EXST$S	#EX$SEV		; ERROR, EXIT WITH SEVERE CODE
	EXIT$S

EXOK:	MOV	#BUFFER,R0	; Get output buffer address
	MOVB	#BELL,(R0)+	; Put in a BELL
	MOV	#MESS1,R1	; Get address of 1st part of MESSAGE
	CALL	MOVE		; Put it in output buffer
	MOV	CNNECT+C.NCTN,R1 ; Get 1st part of taskname
	CALL	$C5TA		; Convert taskname to RAD50
	MOV	CNNECT+C.NCTN+2,R1 ; Get 2nd part of taskname
	CALL	$C5TA		; Convert second part of taskname
	MOV	#MESS2,R1	; Get address of 2nd part of message
	CALL	MOVE		; Move it into output buffer
	MOV	EXTBLK,R1	; Get exit status
	CMP	#5,R1		; Known return code
	BHI	60$		; If HI, YES
	CLR	R2		; Suppress leading zeroes
	CALL	$CBOMG		; Convert to octal
	BR	70$		;
60$:				;
	ASL	R1		; Get word index
	MOV	CODES(R1),R1	; Get address of exit code message
	CALL	MOVE		; Move it into buffer
70$:	SUB	#BUFFER,R0	; Get length of message
	MOV	R0,QIO+Q.IOPL+2 ; Move length of buffer into QIO
	DIR$	#QIO		; Print message
	EXST$S	#EX$SUC		; Exit successfully
	EXIT$S


; R5 POINTS TO TASK-NAME STRING. LEADING SPACES IGNORED
TSKWAIT:	; WAIT FOR TASK TO EXIT, RETURN WITH CARRY SET/CLEAR
	MOV	#CNNECT+C.NCTN,R3 ; Get address to put taskname
	CLR	(R3)
	CLR	2(R3)
	MOV	R5,R0		; Copy buffer pointer
	CLR	R5		; Zero error indicator
10$:	CMPB	(R0),#SPA	; Space?
	BNE	20$		; If NE, NO
	TSTB	(R0)+		; Yes, skip over it
	BR	10$
20$:				; Ref label
	CALL	$CAT5		; Convert ASCII takname to RAD50
	BCS	30$		; If CS less than 3 characters in taskname
	MOV	R1,(R3)+	; 1st part of taskname in connect DPB
	CALL	$CAT5		; Convert more taskname into RAD50
	BCS	40$		; If CS terminating character in R2
30$:				;
	MOVB	(R0),R2		; Get terminating character
40$:				;
	MOV	R1,(R3)		; Taskname in connect DPB
	CMPB	R2,#ESC		; Escape?
	BEQ	43$		; If EQ YES, OK
	CMPB	R2,#CR		; Carriage return?
	BNE	ERROR2		; If NE invalid terminator


; USE THE MCR ROUTINE THAT FINDS A TASK NAME FOR THE ...XXX
; NAMES, SO THAT HEY WILL WORK JUST LIKE "ABO" DOES, AND
; WILL TRACK DOWN THE TASK NAME OKAY.
43$:	MOV	#CNNECT+C.NCTN,R3	; POINT TO THE NAME
	CALL	$GTTSK
	BCS	ERROR4			; CAN'T FIND IT

; MAKE SURE WE GOT THE RIGHT TASK IF ONLY 3 CHARS SPECIFIED
	TST	2(R3)	
	BNE	45$			; >3 CHARS GIVEN, TAKE WHAT WE GOT
; IF ONLY 3 CHARS GIVEN, AND THE TASK IT FOUND STARTS WITH "..."
	CMP	T.NAM(R0),#^R...	; IT  MUST BE FOR MY TERMINAL
	BNE	45$
	MOV	$TKTCB,R1
	CMP	T.UCB(R0),T.UCB(R1)
	BNE	ERROR4			; TASK IS ON ANOTHER TERMINAL

45$:	MOV	T.NAM(R0),(R3)		;; GET THE REAL NAME FROM THE TCB
	MOV	T.NAM+2(R0),2(R3)
	TST	(R3)
	BEQ	ERROR4			; NO TASK

	DIR$	#CNNECT		; Connect to the specified task
	CMP	$DSW,#IS.SUC	; Successful connection?
	BEQ	50$		; If EQ, YES
	CMP	$DSW,#IE.INS	; Was specified task A CLI?
	BEQ	ERROR3		; If EQ YES
	CMP	$DSW,#IE.ACT	; Was task inactive?
	BEQ	ERROR4		; If EQ, YES
	BR	ERROR0		; No funny error
50$:				;
	STSE$S	#EF1		; Wait for connected task to EXIT
	CLC
	RETURN			; RETURN SUCCESS 
	.PAGE
	.SBTTL 	HEY error processing
 
ERROR4:	INC	R5		; Task not active
	TST	INSFLG		; FOR SYNC---NOT ACTIVE IS OKAY
	BNE	RET
ERROR3:	INC	R5		; Task a CLI
ERROR2:	INC	R5		; Invalid syntax
ERROR1:	INC	R5		; No command line
ERROR0:				; Funny internal error
	ASL	R5		; Get word index
	MOV	#ERMES,R1	; Get 1st part of error message		;ALI
	MOV	#BUFFER,R0	; Move to output buffer
	CALL	MOVE		; Move into output buffer
	MOV	ERRS(R5),R1	; Get address of error message
	CALL	MOVE		; Move message into output buffer
	MOV	CNNECT+C.NCTN,R1 ; Get 1st part of taskname
	CALL	$C5TA		; Convert taskname to RAD50
	MOV	CNNECT+C.NCTN+2,R1 ; Get 2nd part of taskname
	CALL	$C5TA		; Convert second part of taskname
	MOVB	#'",(R0)+
	SUB	#BUFFER,R0	; Get length of message
	MOV	R0,QIO+Q.IOPL+2	; Put it in DPB
	DIR$	#QIO		; Print the error message
RET:	SEC
	RETURN			; RETURN WITH ERROR STATUS
 
	.PAGE
	.SBTTL	The End
 
;
; The End
END:	STSE$S	#EF1		; Stop for spawn
	TST	EXSTAT		; If EQ 0, we have success
	BNE	5$		; If NE, use what's sent
	MOV	#EX$SUC,EXSTAT	; Show success
5$:	EXST$S	EXSTAT		; Exit successfully
 
	.PAGE
	.SBTTL	Subroutines
 
;+
; *** MOVE - Move an ASCIZ string
;
; INPUTS:
;	R0	- 	ADDRESS OF OUTPUT BUFFER
;	R1	-	ADDRESS OF ASCIZ STRING
;
; OUTPUTS:
;	R0	-	UPDATED
;-
MOVE:			;
	MOVB	(R1)+,(R0)+	; Move next character
	TSTB	(R1)		; End?
	BNE	MOVE		; If NE NO
	RETURN			; Return to caller

	.endc;
 

;
; Error message typer, error text ends in null
;
TYPERR:	MOV	#040,VFC	; MESSAGES GET STANDARD CONTROL
TYPEIT:	MOV	R1,-(SP)
	MOV	R0,R1
1$:	TSTB	(R1)+
	BNE	1$
	DEC	R1
	SUB	R0,R1
	QIOW$S	#IO.WLB!TF.WAL,#2,#1,,,,<R0,R1,VFC>
	MOV	(SP)+,R1
	CLR	VFC
	RETURN
VFC:	.WORD	0
;
; Close our 1 file
;
CLOS:	CLOSE$	#FDB
	RETURN

;
; Open a file on LUN 1, dataset descriptor in R1, error label in R2
;
OPEN:	OPEN$R	#FDB,#1,R1
	BCC	1$
	JMP	@R2
1$:	RETURN

;
; Print could not access system file & die
;
OPNFL:	MOV	#MSG2,R0
	JMP	ERROR		; Exit with severe error
 
;
; This has to find end of input line - add ?
; Type it and get result in correct 60 byte array chunk.
;
PRMPT:	MOVB	INBF+1,R3
	SUB	#'0,R3
	CMP	R3,L
;
; If the # for this line is lower than or equal to highest parameter
; we already have then get the next one instead, this is settled already.
;
	BLE	NO
	MOV	R3,L
	MUL	#PARLNG,R3
	ADD	#P-PARLNG,R3
	MOV	#INBF,R1
	MOV	FDB+F.NRBD,R2
	ADD	R1,R2
	ADD	#2,R1
	MOVB	#'?,(R2)+
	MOVB	#' ,(R2)+		; Insert a space
	SUB	R1,R2

	QIOW$S	#IO.RPR,#2,#1,,#IOSTS,,<R3,#PARLNG,,R1,R2,#44>
	CMPB	IOSTS,#1	; Ok return from read?
	BEQ	NO		; Branch if YES
	MOV	#EX$SEV,r0	; Exit with severe error
	JMP	FINISH		; Exit with no message
NO:	RETURN			; Return with success

	.END	CCL