.TITLE	CCL
		.IDENT	/V5.2/
		.ENABLE	LC
 
		.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 PATTERNED AFTER DEC'S TDX OR CATCHALL TASK.
; IT IS INCLUDED IN THE SECTION 'DCL' WHICH COMPRISES A 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 PROGRAMMING 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.
;-
 
 
		.SBTTL	THE ORIGINAL CCL
;  R. J. KIRKMAN
; this program is converted from a fortran 4 plus assembly listing
; and therefore I apologise for the wierd names involved
;
; 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 ABILITY
;					FOR CCL TO WAIT FOR A SPECIFIC TASK
;					TO EXIT
;
;	24-Jun-80	P.A. Stephensen-Payne	Fixed everything into one module.
;					Removed worst F4P nasties.
;					Added Many Comments.
;					Allowed recursion.
;					Allowed dynamic installation.
; 
	.MCALL	GET$,OPEN$R,FDBDF$,FDRC$A,CLOSE$,EXIT$S,QIOW$S,SPWN$S
	.MCALL	FDOP$A,FSRSZ$,DIR$,EXST$S,GTSK$S,GLUN$,MRKT$S,SPWN$
	.MCALL	CNCT$,STSE$S,CLEF$S,GMCR$,QIOW$
EFN1=1
EF1=1
EF2=2
LUN2=2				; LUN FOR TI:
SPA=40
ESC=33
CR=15
BELL=7
	.NLIST	BEX
;
; the program reads inturn the user file SY:USERCCL.CCL
; and then the system file (SY:) 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!
;
PARAMS:	.WORD	0	;max # params to prompt for
MCRL:	.WORD	0	;length of mcr line
KEYL:	GMCR$		; Buffer for GMCR
MCR=KEYL+G.MCRB		; Address of buffer itself
KEYB:	.ASCII	/        /	;initial state of keyword buffer
PRMS:	.BLKB	416	;30.*9. 9 parameters @ 30. chars @
CMD:	.BLKB	80.	;output new command line
PMIN:	.WORD	0	;min # params to accept
DUIC:	.WORD	0	; FOR TERMINAL UIC
GLBUF:	.BLKB	12.	; FOR TERMINAL UNIT
EXSTAT:	.WORD	1	; Assume Successful return
	.BLKW	7	; TO COMPLETE THE REST OF EXIT STATUS BLOCK
;
; ERROR MESSAGES AND PROMPTS
;
STATUS:	.BLKW	8.	; FOR EXIT STATUS
SAVTYP:	.WORD	0	; SAVE DATA TYPE
MSG1:	.ASCIZ	<15><12>/>/
MSG2:	.ASCIZ	<15><12>/...CCL -- ERROR READING SYSTEM FILE/
MSG3:	.ASCIZ	<15><12>/...CCL -- NO COMMAND LINE !/
MSG4:	.ASCII	<15><12>/?        ?/<15><12>
	.ASCIZ	/CCL -- MCR SYNTAX ERROR OR UNKNOWN COMMAND/
MSG5:	.ASCIZ	<15><12>/CCL -- CCL COMMAND TOO LONG/<15><12>
MSG6:	.ASCIZ	<15><12>/CCL -- SPAWN FAILURE TO MCR/
EM2:	.ASCIZ	<15><12>/CCL -- COMMAND LINE TOO LONG/
EM3:	.ASCIZ	<15><12>/CCL -- SYNTAX ERROR/
EM4:	.ASCII	<15><12>/CCL -- TASK /
TSKNAM:	.ASCII	/XXXXXX/
	.ASCIZ	/ NOT ACTIVE OR NOT FOUND/
;
LBDEV:	.ascii	/LB:/		;dev for system file
SYDEV:	.ASCII	/SY:/		;dev for userccl file
SYUIC:	.ASCII	/[1,2]/		;uic for my system file
SYFIL:	.ASCII	/SYSCCL.CCL/	;name of my system file
USRFIL:	.ASCII	/USERCCL.CCL/	;name of users files
		.EVEN
$LNGFL:	.WORD	-1		; CLEARED ON COMMAND NOT TOO LONG
NOBYTE:	.WORD	0		; INCREMENT IF NOT DIR COMMAND AND NO SPACES
				; FOLLOW COMMAND
CMDNAM:	.WORD	0		; TO KEEP TRACK OF COMMAND NAME
;
; PIP COMMANDS FOR DIR,LIST, DELETE, SPOOL, PURGE, TRUNCATE, UNLOCK
;
TYPMSG:	.ASCIZ	/PIP TI:=/
PIPHD:	.ASCIZ	/PIP /
DELMSG:	.ASCIZ	\/DE\
DIRMSG:	.ASCIZ	\/LI\
PURMSG:	.ASCIZ	\/PU\
SPOMSG:	.ASCIZ	\/SP\
TRUMSG:	.ASCIZ	\/TR\
SORMSG:	.ASCIZ	\SRD \
CREMSG:	.ASCIZ	\=TI:\
FREMSG:	.ASCIZ	\/FR\
	.EVEN
;
; fdb for out ccl spec file
;
FDB::	FDBDF$
	FDRC$A	,INBF,80.
	FDOP$A	1,,,FO.RD!FA.SHR
;
; input buffer for spec lines
;
INBF::	.BLKB	80.
INUIC:	.WORD	0
QNMRK:	.ASCII	/?       /	;buffer for error text
$TEMPS:	.WORD	0
SYSDST:	.WORD	3,LBDEV,5,SYUIC,10.,SYFIL
USRDST:	.WORD	3,SYDEV,,,11.,USRFIL
GTBUF:	.BLKW	20
GLUN:	GLUN$	2,GLBUF
CNCT:	CNCT$	XX,4,,STATUS	; CONNECT TO TASK
	.PAGE
	.SBTTL	CODE
;
; startup point for program
; get our startup command line
;
CCL:
	GTSK$S	#GTBUF		; GET OUR TASK PARAMETERS
	DIR$	#GLUN		; GET OUR TERMINAL LUN INFORMATION
	MOV	GTBUF+14.,DUIC	; GET OUT DEFAULT UIC
	DIR$	#KEYL		; Get the MCR command line
	CLR	KEYL		; Clear out the first word
	MOV	$DSW,MCRL	; Store number of characters
	BGT	10$		; If GT a command line - process it
;
5$:
	MOV	#MSG3,R0	; Else output 'No Command Line'
	JMP	ERROR		; GO WRITE OUT ERROR AND EXIT
;
; back in mainline
; and with real command line 
; Search for spaces or CR, ie end of keyword
;
10$:
	CMP	MCR,#"CA	; second-level spawning?
	BNE	17$		; If NE no - just parse as normal
	CMP	MCR+2,#"1 	; Sure?
	BEQ	12$		; If EQ yes - drop first 4 chars
	CMP	MCR+2,#"2 	; Sure it isn't?
	BNE	17$		; If NE yes - just parse
;
12$:
	MOV	#MCR+4,R0	; Get address of where command might be
	MOV	#MCR,R1		; Get address of where it is
	SUB	#4,MCRL		; Update size of line
	BLE	5$		; If LE it wasn't there after all
	MOV	MCRL,R2		; Get amount to move
;
15$:
	MOVB	(R0)+,(R1)+	; Shift it down by four
	SOB	R2,15$		;
	MOVB	(R0)+,(R1)+	; And the terminator
;
17$:
	CALL	DCL		; IS IT A BUILT-IN COMMAND
			; WE GET A RETURN ONLY IF BUILT IN COMMAND NOT FOUND
	MOV	#MCR,R0		; Get start address of buffer
	MOV	#8.,R1		; And number of chars to copy
	MOV	#MSG4+3,R2	; Get address of Error Print Buffer
	MOV	#KEYB,R3	; and keyword buffer
;
20$:
	CMPB	(R0),#40	; IS IT A SPACE OR CONTROL CHAR(CR, ESC, ETC)
	BLE	40$		; If LE yes - count it
	MOVB	(R0),(R2)+	; Store in error message buffer
	MOVB	(R0)+,(R3)+	; and in keyword buffer
	SOB	R1,20$		; If any more - copy them
;
30$:
	CMPB	(R0)+,#40	; COMMAND 8 CHAR OR MORE LONG, FIND SPACE OR CR
	BGT	30$		; If GT no this one - keep looking
	DEC	R0		; BUMP US DOWN ONE CHAR
;
; got to end of keyword or 8 chars which is enough for most people
;
40$:
	SUB	#MCR,R0		; Get number of chars
	MOV	R0,KEYL		; store correct keyword length
;
50$:
;
;now try for user file
;
	MOV	#USRDST,R1	; Set up DSD for User File
	CALL	OPEN		; Try to open it
	BCS	60$		; If CS Open failure - try system file
	CALL	LOOKUP		; Found User File - Look Up Keyword
	BCC	80$		; If CC found - process it
	CALL	CLOS		; Not in user file - so close it
;
60$:
	MOV	#SYSDST,R1	; Set up DSD for System File
	CALL	OPEN		; Try to open it
	BCC	70$		; If CC OK - look for keyword
	JMP	OPNFL		; Else report open failure
;
70$:
	CALL	LOOKUP		; Look up keyword
	BCC	80$		; If CC found - process it
	CALL	CLOS		; Close the system file
;***
;***	Next bit needs mod to MCR so not included
;***
;***; check was last char of keyword
;***; a "?" in which case see if "? name" is defined, cheats and uses
;***; error message buffer
;***	MOV	KEYL,R0
;***	CMPB	KEYB-1(R0),#77
;***; deal with "?"
;***	BEQ	.1010
	MOV	#MSG4,R0	; Output error message
	JMP	ERROR
;***; here lookup error message on both files as a type of help request
;***.1010:
;***	MOVB	#40,MCR-1(R0)
;***	MOV	#-1,KEYL
;***; use fpp to move 8 chars for us ( sorry its fortran!)
;***	SETD	
;***	LDD	QNMRK,F0
;***	STD	F0,KEYB
;***	BR	50$
;
; here on being given a valid keyword found in file
;
80$:
	CMPB	PMIN,#'*-60	; Special type?
	BNE	89$		; If NE no - carry on
	GET$	#FDB		; Get the next record
	MOV	FDB+F.NRBD,R0	; Get number of chars
	MOV	R0,SPWN+S.PWCL	; Put the command length in
	MOV	R0,R3		; Save the record-length
	MOV	#INBF,R1	; Get input address
	MOV	#CMD,R2		; Get output address
	CMPB	INBF-1(R3),#'$	; An immediate type thing?
	BNE	82$		; If ne no - keep going
	DEC	SPWN+S.PWCL	; yes - don't output it
;
82$:
	MOVB	(R1)+,(R2)+	; Copy the record over
	SOB	R0,82$		;
	CLR	NOSTOP		; Force synchronicity
	CALL	PUTMCR		; Spawn the line
	CMP	#1,R0		; Success?
	BEQ	84$		; If EQ yes - keep going
	JMP	FINISH		; No - give up
;
84$:
	MOV	MCRL,R0		; OK - get length of original line
	MOV	R0,SPWN+S.PWCL	; Put the command length in
	MOV	#MCR,R1		; And address
	MOV	#CMD,R2		; And output address
	CMPB	INBF-1(R3),#'$	; An immediate type thing?
	BNE	86$		; If ne no - keep going
	INC	NOSTOP		; Don't wait for it
;
86$:
	MOVB	(R1)+,(R2)+	; Copy a byte
	SOB	R0,86$		; And so on
	CALL	PUTMCR		; Send it to MCR
	CMPB	INBF-1(R3),#'$	; An immediate type thing?
	BEQ	88$		; If EQ yes - straight exit
	GET$	#FDB		; Get the next record
	MOV	FDB+F.NRBD,R0	; Get number of chars
	CMP	R0,#1		; One char or less?
	BLE	88$		; Yes - omit it
	MOV	R0,SPWN+S.PWCL	; Put the command length in
	MOV	#INBF,R1	; Get input address
	CMPB	(R1),#'$	; Did he forget the second line?
	BEQ	88$		; If eq yes - ignore it
	MOV	#CMD,R2		; Get output address
;
87$:
	MOVB	(R1)+,(R2)+	; Copy the record over
	SOB	R0,87$		;
	CALL	PUTMCR		; Spawn the line
;
88$:
	JMP	FINISH
;
89$:
	CLR	INUIC		; Not in a UIC spec
	MOV	#1,R3		; First char of..
	MOV	#1,R4		;..first parameter
	MOV	#1,R5		; Start of line
;
; set all parameter strings empty ( clear 1st byte of each)
;
90$:
	MOV	R5,R1		; Multiply parameter number
	MUL	#36,R1		; by parameter size
	CLRB	PRMS-36(R1)	; and clear the first byte
	INC	R5		; Set to next parameter
	CMP	R5,#9.		; Done them all?
	BLE	90$		; If LE no - do next one
	MOV	KEYL,R5		; Get number of chars handled so far
	INC	R5		; and the terminator
	CMP	R5,MCRL		; is that all there is?
	BGE	170$		; If GE yes - check if no params is OK
	INC	R5		; No - skip the next separator
	MOV	MCRL,$TEMPS	; Store number of chars
	INC	$TEMPS		; plus one
;
100$:
	MOVB	MCR-1(R5),R0	; Get the next character
	CMPB	R0,#'[		; Start of UIC?
	BNE	110$		; If NE no - keep checking
	MOV	#-1,INUIC	; Yes - flag we're in UIC spec
;
110$:
	CMPB	R0,#']		; End of UIC?
	BNE	120$		; if NE no - keep checking
	CLR	INUIC		; Yes - show not in UIC spec
;
120$:
	CMPB	R0,#40		; Space or less?
	BLE	150$		; If LE yes - handle separator
	CMPB	R0,#'=		; Equals sign?
	BEQ	150$		; If EQ yes - handle separator
	CMPB	R0,#'<		; Left angle bracket?
	BEQ	150$		; If EQ yes - handle separator
	CMPB	R0,#'_		; Underscore?
	BEQ	150$		; If EQ yes - handle separator
	CMPB	R0,#',		; Comma?
	BNE	140$		; If NE no - stuff in parameter
	TST	INUIC		; In a UIC spec?
	BPL	150$		; If PL no - treat as separator
;
140$:
; here char is not a separator, stuff in parameter
;
	MOV	R4,R1		; Get parameter number
	MUL	#36,R1		; Multiply into offset
	ADD	R3,R1		; Add in parameter offset
	MOVB	R0,PRMS-37(R1)	; Stuff in this char
	INC	R3		; Increment offset in parameter
	BR	160$		; and check next character
;
150$:
;
; here with a separator
; insert a null and add 1 to parameter # 
; check text pointer still in mcr line text
;
	MOV	R4,R1		; Get parameter number
	MUL	#36,R1		; Convert to offset
	ADD	R3,R1		; Add parameter offset
	CLRB	PRMS-37(R1)	; Insert null at end
	MOV	#1,R3		; Initialise offset for next parameter
	INC	R4		; Increment parameter number
;
160$:
	INC	R5		; Count this one
	CMP	R5,$TEMPS	; End of line?
	BLE	100$		; If LE no - handle next character
;
170$:
;
; Line finished - see if parameters OK
;
	DEC	R4		; Back down number of parameters
	CMP	R4,PMIN		; At least minimum?
	BGE	GLIN		; If GE yes - go get action line
;
180$:
	CMP	PARAMS,R4	; Have we the maximum asked for?
	BLE	GLIN		; If LE yes - get action line
;
190$:
	GET$	#FDB		; Read the next line from the file
	BCC	200$		; If CC OK - check it
	JMP	OPNFL		; Else log error
;
200$:
	CMPB	INBF,#'?	; Is it a parameter line (starts ?)?
	BNE	190$		; If NE no - try next one
	CALL	PRMPT		; Yes - prompt for parameter
	BR	180$		; And check for next one
	;;
; We know we have sufficient parameters - get an action/skeleton line
;
GLIN:
	MOV	R4,PARAMS	; Get number of parameters
;
10$:				; COME BACK HERE IF MULTI LINE COMMAND
	GET$	#FDB		; Read next line from file
	CMPB	INBF,#'-	; IS IT A COMMAND TO WAIT FOR TASK TO EXIT?
	BNE	20$		; IF NE  , NO
	CALL	WAITCK		; IF EQ, YES, STOP UNTIL IT EXITS
	BR	10$		; AND GET ANOTHER COMMAND
;
20$:
	CMPB	INBF,#'+	; IS IT A CONTINUATION LINE
	BEQ	30$		; YES,
	CMPB	INBF,#'*	; IS IT THE FINAL COMMAND
	BNE	10$		; NO, MUST BE GARBAGE, SKIP OVER
;
30$:
	MOVB	INBF,SAVTYP	; SAVE THE COMMAND TYPE
	MOV	#80.,R0		; Clear out work buffers..
	MOV	#CMD,R2		;..
	MOV	#MCR,R1		;..
;
40$:
	MOVB	#' ,(R1)+	;..
	MOVB	#' ,(R2)+	;..
	SOB	R0,40$		;..
	MOV	FDB+F.NRBD,R0	; Get number of chars in record
	DEC	R0		; Minus the leading one
	BEQ	55$		; If EQ skip loop
	MOV	#INBF+1,R1	; Get address of record
	MOV	#MCR,R2		; Get buffer address
;
50$:
	MOVB	(R1)+,(R2)+	; Copy skeleton over
	SOB	R0,50$
;
55$:
	MOV	#1,R3		; Initialise pointers
	MOV	#1,R4
;
60$:
	CMPB	MCR-1(R3),#'%	; Time for a parameter?
	BEQ	70$		; If EQ yes - call FIXUP
	MOVB	MCR-1(R3),CMD-1(R4)	; No - copy char over
	INC	R3		; Update pointers
	INC	R4
	BR	80$		; and check for end of line
;
70$:
	CALL	FIXUP		; Insert a parameter
;
80$:
	CMP	R3,#80.		; Line full?
	BGE	90$		; If GE yes - output it
	CMP	R4,#79.		; Other one finished?
	BLT	60$		; If LT no - handle next char
;
90$:
	CMPB	#40,CMD+111	; SHOULD BE A SPACE, ELSE COMMAND TOO LONG
	BNE	TOLONG		;
	MOV	R4,SPWN+S.PWCL	; Put the command length in
	CALL	PUTMCR		; Line finished, output it
	BCC	100$		; ANY ERRORS
	MOV	#MSG6,R0	; WARN USER SPAWN FAILED
	JMP	ERROR		; EXIT WITH ERROR
;
100$:	
	CLR	NOSTOP		; RESET THIS IN CASE NEEDED NEXT TIME
	CMP	#1,R0		; IS IT SUCCESS
	BNE	FINISH		; IF NE, ERROR	- BAD STATUS
	CMPB	SAVTYP,#'*	; IS THIS THE FINAL COMMAND?
	BEQ	FINISH		; FINISH UP AND EXIT
	JMP	10$		; MORE COMMANDS COMING
;
FINISH:	
	MOV	R0,EXSTAT	;
	BR	END1		; Output CRLF>
;
TOLONG:
	MOV	R0,EXSTAT	;
	MOV	#MSG5,R0	; WARNING MESSAGE
	CALL	TYPEIT
	MOVB	#0,CMD+116	; WRITE OUT COMMAND CAUSING PROBLEM
	MOV	#CMD,R0		; WRITE OUT THE TRUNCATED COMMAND
	CALL	TYPEIT		; WRITE IT OUT
	BR	END1		; Exit
;
ERROR:	
	CALL	TYPEIT		;
;
END1:
	CALL	CLOS	;
	CMP	GTBUF,#^RCA.	; First level Catchall?
	BEQ	END2		; If EQ yes - don't need CRLF>
	CMP	GTBUF+2,#^RCA.	; Sure it isn't
	BEQ	END2		; If EQ it is
	MOV	#MSG1,R0	; FINISH UP WITH CR,LF, >
	CALL	TYPEIT		; Output CRLF>
;
END2:
	EXST$S	EXSTAT		; EXIT WITH SEVERE ERROR
	EXIT$S			; IF EXIT WITH STATUS FAILS TRY THIS
 
;+
;
; DCL
; THIS SUBROUTINE IMPLEMENTS THE FOLLOWING COMMANDS AS THOUGH THEY WERE
; PART OF MCR:
;
;	BEL[L]					Ring terminal bell.
;	ERA[SE]					Erase screen of MKII/3
;	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 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"
;
	.PAGE
	.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
	 
CNNECT:	CNCT$	,EF1,,EXTBLK
QIOW:	QIOW$	IO.WVB,LUN2,31,,,,<0,0,40>
QIO:	QIOW$	IO.WVB,LUN2,EF2,,ISB,,<BUFFER,,40>
SPWN:	SPWN$	MCR...,,,,,1
;
; ERROR MESSAGES
;
	.NLIST 	BEX
EMM2:	.ASCII	/MCR -- TASK NOT IN SYSTEM/
EMM2L=.-EMM2
EMM3:	.ASCII	/MCR -- SYNTAX ERROR/
EMM3L=.-EMM3
EMM4:	.ASCII	/CCL -- COMMAND PARSING ERROR AFTER PIP:/
EMM4L=.-EMM4
	.LIST	BEX
 
;
; STRING MESSAGES (USED IN SPAWNED COMMANDS)
;
 
 
 
	.EVEN
CMDTBL:	.RAD50	/DIR/		; LIST DIRECTORY ON TI:
	.RAD50	/PUR/		; PURGE DIRECTORY
	.RAD50	/SPO/		; SPOOL FILES VIA PIP /SP
	.RAD50	/FRE/		; DISPLAY NUMBER OF FREE BLOCKS ON SY:
	.RAD50	/DEL/		; DELETE FILE(S)
	.RAD50	/TYP/		; TYPE FILE(S) ON TI:
	.RAD50	/LIS/		;
	.RAD50	/CRE/		; CREATE A FILE AND ENTER TEXT INTO IT
	.RAD50	/TRU/		; TRUNCATE A FILE[S]
	.RAD50	/SOR/		; SORT/BRIEF LISTING
	.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 LOGGED IN 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	/ERA/		; ERASE TERMINAL SCREEN OF VT52
ENDCMD:				; END OF COMMAND TABLE
 
JMPTBL:	.WORD	PIP		;
	.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 POINT
	.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
	.WORD	CHD		;
	.WORD	CHD		;
	.WORD	ATS		;
	.WORD	SHQ		;
	.WORD	SHW		;
	.WORD	DLG		;
	.WORD	POO		;
	.WORD	SYS		;
	.WORD	DLY		;
	.WORD	HEY		;
	.WORD	BELEP		; RING TERMINAL BELL
	.WORD	ERASE		; ERASE MKII/3 TERMINAL SCREEN
 
MCRBUF:	.BLKW	40		; BUFFER TO BUILD COMMAND LINE
	.BLKW	10		; SOMETHING VERY STRANGE HAPPENS HERE
				; NOTHING I CAN SEE SHOULD EVER OVERWRITE MCRBUF(INTO MCRNM)
				; BECAUSE A CHECK IS MADE TO SEE IF LINE >78. CHARACTERS.
				; HOWEVER, IF FIRST ATTEMPT IS TO SPAWN TO MCR... AND THE
				; SECOND ATTEMPT IS TO ...MCR, MCRNM GETS OVERWRITTEN BUT
				; ONLY ON LONG COMMAND LINES.(IE BUFFER OVERWRITTEN).
				; AN ALMOST PAINLESS FIX IS TO INSERT A 10 WORD BUFFER BETWEEN
				; MCRBUF AND MCRNM.  LATER IN V3.2 ALL THIS CODE CAN BE 
				; REMOVED SINCE ONLY WILL SPAWN TO MCR...(HOWEVER BUFFER WILL
				; STILL BE OVERWRITTEN.
				; TO SEND TO MCR
 
	.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 LABLE
	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
	CLR	R1		; CONTROL FOR $CAT5(DO NOT DECODE DOTS)
	CALL	$CAT5		; CONVERT RAD50 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 CMDNAME FOR LATER
10$:	CMP	R1,(R4)+	; SEE IF ITS A MATCH
	BEQ	20$		; GOT IT
	CMP	R4,#ENDCMD	; ARE WE AT END OF TABLE?
	BLO	10$		; IF LO , NO, TRY AGAIN
	RETURN			; GO AND TRY THE .CCL FILE FOR A MATCH
20$:				; REF LABLE
	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 CONSISTANT WITH MCR)
; A SPACE SEPERATED THE CMD NAME FROM ANY COMMAND QUALIFIER STRING
PARSE:	CMPB	(R0),#' 	; IS IT A SPACE?
	BEQ	REPACK		; IF EQ, YES, GO REPACK BUFFER
	CMPB	(R0),#33	; IS IT AN <ESC>?
	BEQ	REPACK		; IF EQ,YES
	CMPB	(R0),#15	; IS IT A <CR>
	BEQ	REPACK		; IF EQ, YES
	INC	R0		; ELSE INCREMENT COUNTER
	BR	PARSE		; AND CHECK NEXT CHARACTER
 
REPACK: MOVB	(R0),(R2)+	; MOVE IN FIRST BYTE
	CMPB	(R0),#33	; IS IT <ESC>
	BEQ	OUT		; IF EQ, YES
	CMPB	(R0),#15	; 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
;
; 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
 
	.PAGE
 
	.EVEN
	.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
	MOV	#EX$ERR,EXSTAT		; Set up exit status
	JMP	END1		; Exit
 
	.DSABLE	LSB
	.PAGE
	.SBTTL	PIP -LIKE COMMANDS
 
 
; DIR,SPOOL,DELETE,TRUNCATE,FREE,PURGE,CREATE, ..ETC. ALL PROCESSED HERE
	.EVEN
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	1$		; IF EQ YES
101$:	CMP	CMDNAM,#^RLIS	; PERHAPS LIST?
	BNE	2$		; IF NE, NO
1$:	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
2$:	MOV	#PIPHD,R0	; FIRST PART OF SPAWN COMMAND
COMON:				;
	MVZ	R0,R1		; MOV ASCIZ STRING TO SPAWN BUFFER
	MVZ	R5,R1		; MOV REST OF COMMAND UP TO ZERO
	DEC	R1		; BUMP OFF TERMINATING <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
	MOV	#PURMSG,R0	; MOVE IN SECOND HALF OF LINE
	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 INSECOND 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
	MOV	#DELMSG,R0	; MOVE IN SECOND HALF OF COMMAND
	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 DOIT
	CMP	CMDNAM,#^RLIS	; PERHAPS IT IS LIST?
	BEQ	DOIT		; IF YES, DOIT
40$:
	JMP	ERR4		; WARN USER CODE FELL THROUGH HERE
DOIT:
	MVZ	R0,R1		; MOVE IT IN
	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		; SPWAN 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
 
 
 
 
	.PAGE
 
	.SBTTL	CHD
 
; CHD - CHANGE (OR SHOW) CURRENT UIC
CHDM1:	.ASCIZ	\SET /UIC=[\
CHDM2:	.ASCIZ	\SET /UIC\
 
	.EVEN
CHD:				; REF LABLE
	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	#40,(R0)+	; YES, MAKE IT A SPACE
	BR	10$		; AND TRY AGAIN
11$:	CMPB	(R0),#'=	; IS IT AN =
	BNE	12$		; IF NE, NO
	MOVB	#40,(R0)+	; YES, MAKE IT A SPACE
	BR	10$		; AND CHECK AGAIN
12$:	CMPB	#'],(R0)	; IS IT A ']'?
	BNE	13$		; IF NE, NO
	MOVB	#15,(R0)+	; YES, SO TERMINATE COMMAND WITH <CR>
	MOVB	#0,(R0)		; AND 0 BYTE
	BR	10$		; AND LOOP AGAIN TO CATCH 0 BYTE
13$:				; IF NOT [, ], = , EITHER NUMBER OR <SPA>
	CMPB	(R0)+,#40	; 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		; BUMP <CR>
	MOVB	#'],(R1)+	; CLOSE UP COMMAND
	SUB	#MCRBUF,R1	; LENGTH OF SPAWN COMMAND
	MOV	R1,SPWN+S.PWCL	; SET LENGTH IN SPAWN DPB
	JMP	SPWNIT		; SPAWN COMMAND AND EXIT
CHDSHW:				; REF LABLE
	MOV	#CHDM2,SPWN+S.PWCA ; SET BUFFER ADDRESS
	MOV	#8.,SPWN+S.PWCL	 ; SET BUFFER LENGTH
	JMP	SPWNIT		; SPWAN COMMAND AND EXIT
 
 
 
	.PAGE
	.SBTTL	ATS
; ATS - LIST ALL ACTIVE TASKS ( OR ONLY THOSE FOR A TERMINAL)
 
ATSM1:	.ASCII	\ACT /ALL\
ATSM2:	.ASCIZ	\ACT /TERM=\
 
	.EVEN
ATS:	TSTB	1(R5)		; US THERE A TERMINAL SPECIFIED
	BNE	ATSTTY		; YES, JUMP
	MOV	#8.,SPWN+S.PWCL	; SET COMMAND LENGTH
	MOV	#ATSM1,SPWN+S.PWCA ; SET BUFFER ADDRESS
	BR	SPWNIT		; SPWAN 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
	DEC	R1		; BUMP <CR>
	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:	.BYTE	30,0		; Erase MKII/3 Screen
BELMSG:	.ASCIZ	<7>		; RING BELL
	.EVEN
ERASE:	MOV	#ERAMSG,R0	; ERASE VT52
	BR	TOTERM		; BRANCH 
BELEP:	MOV	#BELMSG,R0	; WRITE OUT MESSAGE
TOTERM:	CALL	TYPEIT		;
	MOV	#1,EXSTAT	; Set up exit status
	JMP	END1		; Exit
	.PAGE
	.SBTTL	SPWNIT
SPWNIT:				; REF LABLE
	MOV	SPWN+S.PWCA,QIOW+Q.IOPL	; ADDRESS OF LINE
	MOV	SPWN+S.PWCL,QIOW+Q.IOPL+2	; LENGTH OF COMMAND
	DIR$	#QIOW		; Echo the command to the user
	DIR$	#SPWN		; TRY SPAWNING TO MCR... FIRST
	BCC	10$		; IF CC WE GOT IT
	MOV	#BADSPN,R0	; PRINT ERROR MESSAGE
	CALL	TYPEIT		; OUT ON TI:
	MOV	#4,EXSTAT	; Set up exit status
	BR	20$		;
;
10$:
	STSE$S	#EF1		; Stop for Spawn
;
20$:
	JMP	END1		; END UP
 
	.PAGE
	.SBTTL	SHQ - SHW - DLG
; SHQ - SHOW FULL QUEUE ENTRIES
 
SHQM:	.ASCII	\QUE /LI:ALL\
 
	.EVEN
SHQ:	MOV	#11.,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\
 
	.EVEN
SHW:	MOV	#11.,SPWN+S.PWCL; SET LENGTH
	MOV	#SHWM,SPWN+S.PWCA ; AND ADDRESS
	BR	SPWNIT		; SPWN COMMAND AND EXIT
 
 
; DLG - DISPLAY LOGGED IN TERMINALS
 
DLGM:	.ASCII	\DEV /LOG\
 
	.EVEN
DLG:	MOV	#8.,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\
 
	.EVEN
POO:	MOV	#9.,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\
 
	.EVEN
SYS:	MOV	#11.,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$:				; RE LABLE
	JMP	ERR3		; SYNTAX ERROR
 
 
;
	
	.PAGE
	.SBTTL HEY
;
; HEY
;
 
BUFFER:	.BLKW	40.
EXTBLK:	.WORD	-1
ISB:	.WORD	0,0
 
 
 
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
 
	.NLIST	BEX
BADSPN:	.ASCIZ	<15><12>/...CA. -- BAD SPAWN TO ...MCR, SAVE PRINTOUT AND GET HELP /
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/
SYNTAX:	.ASCIZ	/INVALID SYNTAX/
CMLINE:	.ASCIZ	/BAD COMMAND LINE/
FUNNY:	.ASCIZ	/FUNNY -- INTERNAL CONSISTANCY ERROR/
 
	.LIST	BEX
	.EVEN
HEY:	MOV	#CNNECT+C.NCTN,R3 ; GET ADDRESS TO PUT TASKNAME
	MOV	R5,R0		; COPY BUFFER POINTER
	CLR	R5		; ZERO ERROR INDICATOR
	CMPB	(R0),#SPA	; SPACE?
	BNE	20$		; IF NE, NO
	TSTB	(R0)+		; YES, SKIP OVER IT
20$:				; REF LABLE
	CALL	$CAT5		; CONVERT ASCII TAKNAME TO RAD50
	BCS	30$		; IF CS LESS THAN 3 CHARACTERS INTASKNAME
	MOV	R1,(R3)+	; 1ST PART OF TASKNAME I N 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	50$		; IF EQ YES, OK
	CMPB	R2,#CR		; CARRIAGE RETURN?
	BNE	ERROR2		; IN NE INVALID TERMINATOR
	.PAGE
	.SBTTL	CONNECT AND WAIT
	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
	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 IN 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
	BR	ENDHEY		; FINISH UP
 
 
	.PAGE
	.SBTTL 	HEY ERROR PROCESSING
 
 
ERROR4:	INC	R5		; TASK NOT ACTIVE
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	#BUFFER,R0	; GET 1ST PART OF ERROR MESSAGE
	CALL	MOVE		; MOVE INTO OUTPUT BUFFER
	MOV	ERRS(R5),R1	; GET ADDRESS OF ERROR MESSAGE
	CALL	MOVE		; MOVE MESSAGE INTO OUTPUT BUFFER
	SUB	#BUFFER,R0	; GET LENGTH OF MESSAGE
	MOV	R0,QIO+Q.IOPL+2	; PUT IT IN DPB
	DIR$	#QIO		; PRINT THE ERROR MESSAGE
 
 
ENDHEY:	
	MOV	#EX$SUC,EXSTAT	; Set Exit Status
	JMP	END1		; And exit
 
 
	.PAGE
	.SBTTL	THE END
 
;
; THE END
;
END:
	STSE$S	#EF1		; STOP FOR SPAWN
	JMP	END1		; Exit with >
;***	TST	EXSTAT		; IF EQ 0, WE HAVE SUCCESS
;***	BNE	5$		; IF NE, USE WHAT'S SENT
;***	MOV	#1,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
 
 

; error message typer, error text ends in null
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,#0>
	MOV	(SP)+,R1
	RETURN
;
; close our 1 file
;
CLOS:	CLOSE$	#FDB
	RETURN
;
; open a file on lun 1, dataset descriptor in R1, eror label in R2
;
OPEN:
	OPEN$R	#FDB,#1,R1
	RETURN
;
; print couldnt access system file & die
;
OPNFL:
	MOV	#MSG2,R0
	JMP	ERROR		; EXIT WITH SEVERE ERROR
; 
IOSTS:	.BLKW	2
;
PRMPT:
	MOVB	INBF+1,R3	; Get first char in buffer
	SUB	#60,R3		; Convert to a number
	CMP	R3,R4		; Do we have this parameter already?
	BLE	10$		; If LE yes - get next one
	MOV	R3,R4		; No - update parameter number
	MUL	#36,R3		; Get parameter offset
	ADD	#PRMS-36,R3	; Convert to an address
	MOV	#INBF,R1	; Calculate byte after end..
	MOV	FDB+F.NRBD,R2	;..of input buffer
	ADD	R1,R2		;..
	ADD	#2,R1		;..
	MOVB	#'?,(R2)+	; Insert a ?
	MOVB	#' ,(R2)+	; INSERT A SPACE
	SUB	R1,R2		; Get length of string
	QIOW$S	#IO.RPR,#2,#1,,#IOSTS,,<R3,#30.,,R1,R2,#44>
				; Output prompt & get reply
	CMPB	IOSTS,#IS.SUC	; QIO OK?
	BEQ	10$		; If EQ yes - exit
	MOV	#MSG1,R0	; DISPLAY CR,LF,>
	JMP	ERROR		; EXIT WITH SEVERE ERROR
;
10$:
	RETURN
;+ 
; WAITCK -- WAIT FOR TASK TO EXIT
;	THIS SUBROUTINE PROCESSES THE CCL COMMAND
;		-TASKNAME
;-
WAITCK:	CLR	CNCT+C.NCTN+2	; CLEAR OUT OLD TASK NAME
	CLR	CNCT+C.NCTN	; CLEAR OUT OLD TASK NAME
	MOV	#TSKNAM,R0	; GET ADDRESS OF WHERE TO SHOVE TASK NAME
	MOV	#6,R1		; REPEAT 6 TIMES
1$:	MOVB	#40,(R0)+	; INSERT A SPACE
	SOB	R1,1$		; LOOP UNTIL DONE
	MOV	#INBF+1,R0	; GET TASK NAME
	MOV	PC,R2		; WHAT IN THE WORLD IS THIS FOR, ORIGIONAL KIRKMAN???
	MOV	#1,R1		; ACCEPT A . IN TASK NAME
	CALL	$CAT5
	BCC	2$		; IF CC, CONVERSION COMPLETE(ALL THREE CHAR)
	MOV	R1,CNCT+C.NCTN	; <THREE CHAR, INSERT, AND GO WAIT
	BR	3$		; GO WAIT
2$:	MOV	R1,CNCT+C.NCTN
	MOV	#1,R2		;???????
	MOV	#1,R1		; ACCEPT A . IN TASK NAME
	CALL	$CAT5
	MOV	R1,CNCT+C.NCTN+2
3$:	CLEF$S	#4		; CLEAR EVENT FLAG
	DIR$	#CNCT		; CONNECT TO TASK
	BCC	5$		; TASK FOUND, PROCEED TO STOP
	MOV	#TSKNAM,R0	; GET TASK NAME'S ADDRESS
	MOV	CNCT+C.NCTN,R1	; GET FIRST PART OF TASK NAME
	CALL	$C5TA		; CONVERT RAD50 TO ASCII
	MOV	CNCT+C.NCTN+2,R1; GET SECOND HALF OF TASK NAME
	CALL	$C5TA		; CONVERT TO ASCII
	MOV	#EM4,R0		; GET ADDRESS OF ERROR MESSAGE
	JMP	ERROR		; ERROR EXIT WITH MESSAGE
5$:	STSE$S	#4		; STOP UNTIL TASK EXITS
10$:	RETURN
	.PAGE
	.SBTTL SPNMCR
;
; Subroutine TO TAKE OUTPUT FROM CCL.MAC AS ADDR OF FIRST CHAR, 
; LENGTH IN CHARACTERS, AND TO OUTPUT AN MCR COMMAND LINE
; USE THE SPAWN DIRECTIVE TO SEND MESSAGES TO MCR
;
;
PUTMCR::
	MOV	#CMD,SPWN+S.PWCA ; INSERT COMMAND LINE ADDRESS
	MOV	#EXSTAT,SPWN+S.PWES ; INSERT EXIT STATUS BLOCK ADDRESS
	MOV	SPWN+S.PWCA,QIOW+Q.IOPL	; ADDRESS OF LINE
	MOV	SPWN+S.PWCL,QIOW+Q.IOPL+2	; LENGTH OF COMMAND
	DIR$	#QIOW		; Echo the command to the user
	DIR$	#SPWN		; SPAWN COMMAND TO MCR
	BCS	ERR		; SHOW ERROR
	MOV	#1,EXSTAT	; ASSUME SUCCESS
	TST	NOSTOP		; DID AN %$% TERMINATE THE LINE?
	BNE	10$		; IF NE, YES, DON'T STOP FOR COMMAND TO COMPLETE
	STSE$S	#EFN1		; STOP UNTIL COMMAND DONE
;***	TST	EXSTAT		; IF EQ 0,THEN WE HAVE SUCCESS
;***	BNE	10$		; IF NE, THEN USE WHAT EVER IS RETURNED
;***	MOV	#1,EXSTAT	; SHOW SUCCESS
;
10$:
	MOV	EXSTAT,R0	; SAVE EXIT STATUS
	RETURN			; AND RETURN
;
ERR:
	SEC			; SHOW SPAWN FAILED(CARRY SET)
	RETURN
	.PAGE
	.SBTTL	FIXUP
;	This subroutine fixes up the parameters in the final output line
; from the parameter specifications answered in return to 
; questions or on the initial command line.
;
NOSTOP::.WORD	0		; DO NOT STOP FOR EFN1 IF SET
				; IS SET IF %$% TERMINATES LINE
TERMIN=GLBUF			;TERMINAL CHAR 1 IE V OF VT
				; ............ 2 IE T OF VT
UNIT=GLBUF+2			;UNIT #	IE 1 IF VT1
SEEN:	.BYTE	0		;this is 0 if no explicent extender
				;field is matched, -1 if it is. The extender 
				;field is that field which will be added by
				;default to a pararmeter if the initial char
				; is not matched in the parameter
				;If it is matched then the default will not
				;be added
DEFCH:	.BYTE	0		;This is the character at the start
				;which determines the match
;
; AT this point all the parameters in the array should 
; have any value they will finally take
; The array PRMS is an array (9,30) bytes which contains
; as the initial bytes for each of the 9 parameters the
; the character text of all parameters
; The character text is terminated on a null
;
FIXUP::
;
; Entry here occurs for each occurrence of the parameter flag
; characeter "%" in the skeleton line which at this phase of
; processing lies in the MCR buffer since that information has been
; dealt with.
; The routine maintains R3 as the pointer into the skeleton in the MCR buffer
; and R4 as the pointer into the new command buffer which is being created.
;
	CLRB	SEEN		;say not seen extender delimiter yet
	INC	R3		;skip over "%" that caused call 
	MOV	R3,R2		;get pointer value
	MOVB	MCR-1(R2),R2	;and character from there
				;should be param # 1-9
	SUB	#60,R2		;try it as number -"0"
	BLE	10$		;<="0" then not number
	CMP	R2,#11		;>"9"
	BLE	20$		;a valid # I say
;
10$:				;error go look for better at end
	BR	110$
;
20$:
	MOV	R2,R1		;check for a null parameter in which case entire
				;parameter spec is skipped
	MUL	#36,R1
	TSTB	PRMS-36(R1)
	BEQ	100$		; null parameter skip to "%"
; now check for a prefix character %n,xxxxxxx% or %n=xxxxxx%
; if either we insert the prefix character now because we know
; the parameter is non null
	MOV	#1,R5
	MOV	R3,R0
	CMPB	MCR(R0),#',
	BEQ	30$
	CMPB	MCR(R0),#'=
	BNE	40$
;
; here there is a prefix character insert it
;
30$:
	INC	R3
	MOV	R3,R0
	MOV	R4,R1
	MOVB	MCR-1(R0),CMD-1(R1)
	INC	R4
;
40$:
;
; here we set the default starter character for an extender field
; into defch
;
	MOV	R3,R0
	MOVB	MCR(R0),DEFCH
;
50$:
;
;get the next character from the parameter
;
	MOV	R2,R1
	MUL	#36,R1
	ADD	R5,R1
	TSTB	PRMS-37(R1)
;
;if null,parameter is ended - go check for extenders
;
	BEQ	70$
	MOV	R4,R0
	MOVB	PRMS-37(R1),CMD-1(R0)
;
;copy the parameter character
;if it matches the default starter then default is not wanted
;so set default extender seen
;
	CMPB	CMD-1(R0),DEFCH
	BNE	60$
	MOVB	#-1,SEEN
;
60$:
	INC	R4
	INC	R5
	BR	50$
;
; parameter is done, is extender field required
;
70$:
	INC	R3
	MOV	R3,R0
	CMPB	MCR-1(R0),#'%
;
; there is no extender field to give anyway %n{,or=ornull}%
;
	BEQ	100$
	TSTB	SEEN
;
;if extender still wanted then handle it
;
	BPL	90$
;
80$:
	BR	100$	;go skip to %
;
90$:
;
;add default extender until we reach '%'
;
	MOV	R3,R0
	MOV	R4,R1
	MOVB	MCR-1(R0),CMD-1(R1)
	INC	R4
	INC	R3
	MOV	R3,R0
	CMPB	MCR-1(R0),#'%
	BNE	90$
;
; here skip until R3 points to '%' in skeleton
;
100$:
	MOV	R3,R0
	CMPB	MCR-1(R0),#'%
;
;found end of parameter
;
	BEQ	190$
	INC	R3
	BR	100$
;
110$:
;
; out of range for 1-9 is it %$ meaning altmode/escape
;
	MOV	R3,R0
	CMPB	MCR-1(R0),#'$
	BNE	120$
	MOV	R4,R0
	MOVB	#15,CMD-1(R0)	; MOVE IN <CR> SO IT WILL PROMPT	; JGD
	MOV	#80.,R3		; Terminate outside loop
	INC	R4
	INC	NOSTOP		; DO NOT STOP CCL UNTIL COMMAND TO EXITS; JGD
	BR	190$
;
120$:
	CMPB	MCR-1(R0),#'%	;was it %% meaning %
	BNE	130$
	MOV	R4,R0
	MOVB	#'%,CMD-1(R0)
	INC	R4
	BR	190$
;
130$:
	CMPB	MCR-1(R0),#'G
	BNE	140$
	MOVB	DUIC+1,R1
	BR	150$
;
140$:
	CMPB	MCR-1(R0),#'M
	BNE	160$
	MOVB	DUIC,R1
;
150$:
	MOV	R4,R0
	ADD	#CMD-1,R0
	MOV	PC,R2
	CALL	$CBTMG
	ADD	#3,R4
	BR	190$
;
160$:
	CMPB	MCR-1(R0),#'U
	BNE	170$
	MOV	R3,-(SP)
	MOV	DUIC,R3
	MOV	R4,R2
	ADD	#CMD-1,R2
	MOV	R4,-(SP)
	MOV	R2,-(SP)
	CLR	R4
	CALL	.PPASC
	SUB	(SP)+,R2
	MOV	(SP)+,R4
	MOV	(SP)+,R3
	ADD	R2,R4
	BR	190$
;
170$:
	CMPB	MCR-1(R0),#'T
	BNE	190$
	MOV	R4,R0
	ADD	#CMD-1,R0
	MOV	#11010,R2
	MOV	R0,-(SP)
	MOVB	TERMIN,(R0)+
	MOVB	UNIT,R1
	MOVB	UNIT,R2
	ASR	R2
	ASR	R2
	ASR	R2	;div by 8
	BIC	#177770,R2	;range 0-7
	BIC	#177770,R1
	TST	R2
	BEQ	180$
	ADD	#'0,R2
	MOVB	R2,(R0)+
;
180$:
	ADD	#'0,R1
	MOVB	R1,(R0)+
	SUB	(SP)+,R0
	ADD	R0,R4
;
; here we skip final '%' in skeleton and return to mainline
;
190$:
	INC	R3
	RETURN
	.PAGE
	.SBTTL	LOOKUP
;
; This subroutine is entered with a file open on LUN 1
; This file must be in the specified form for a CCL command set.
;
LMIN:	.WORD	0		;minimum length of keyword
;
; entry to get next record for processing.
; Note the effect of null records and of records with junk in the first
; 5 columns is undefined, but unlikely to be nasty in the extreme.
; worst case is CCL could spin on incomplete data set of CCL spec.
;
LOOKUP::
;
; The result of a  failure to find the keyword which is presented
; in the buffer keyb..keyb+7 of length keyl bytes is to return
; with the C-bit set
;
	GET$	#FDB,#INBF,#80.
	BCC	10$
	SEC
	RETURN
;
10$:
	MOV	#60,R2
;
;The first character of the line is checked for a "$" symbol
; if it is not that then the line is not a keyword line and can be 
; bypassed in our search
;
	MOV	#INBF,R0
	CMPB	(R0)+,#44		;IS IT $
	BNE	LOOKUP			;No, get next line
;
; The 4 number fields of a "$" record are now obtained with no
; checking and an enormous degree of hopefulness
; They are in turn
;	length minimum match
; 	length max(skipped)
;	parameter count minimum
;	parameter count required if no params specified
; A special case is when both parameter counts are *s in which
; case the next line in the file is executed at once, followed by
; the original line repeated.
;
	MOVB	(R0)+,R1
	SUB	R2,R1			;MAKE INTEGER
	MOVB	R1,LMIN			;GET MIN LENGTH
	TSTB	(R0)+			;IGNORE MAX LENGTH
	MOVB	(R0)+,R1
	SUB	R2,R1
	MOV	R1,PMIN
	MOVB	(R0)+,R1
	SUB	R2,R1
	MOV	R1,PARAMS		;AND LAST OF THE NUMBERS.
;
;If the input record was shorter than 13 characters, that is
; "$abcd"+keyword of 8 chars 
; pad it out with spaces until it is at least that length so
; the comparison is easier
;
	MOV	FDB+F.NRBD,R0		;SIZE OF RECORD READ
	CMP	R0,#13.			;MIN CHARS NEEDED
	BGE	30$			;YES
	ADD	#INBF,R0		;POINT AT LAST CHAR
	MOV	#13.,R4
;
20$:
	MOVB	#' ,(R0)+
	SOB	R4,20$
;
; here both keyword and item to test occupy 8 characters and
; they are both spce filled
;
30$:
	MOV	#1,R0
;
; now they must at least match up to the minimum length
; given on the keyword line
;
40$:
	CMPB	INBF+4(R0),KEYB-1(R0)
	BNE	LOOKUP
	INC	R0
	CMP	R0,LMIN
	BLE	40$
	CMP	LMIN,#10
	BEQ	70$
;
; they must also match spaces in the keyword typed, or real
; matches to characters in the keyword spec line
; for the rest of the 8 characters
;
	MOV	LMIN,R0
	INC	R0
;
50$:
	CMPB	KEYB-1(R0),INBF+4(R0)
	BEQ	60$
	CMPB	KEYB-1(R0),#40
	BNE	LOOKUP
;
60$:
	INC	R0
	CMP	R0,#10
	BLE	50$
;
70$:
;
; here they have matched to 8 characters exactly or to
; greater than LMIN and then have had the user typed keyword
; trailing space padded
; result is clear C-bit
;
	CLC
	RETURN
	.END	CCL