.TITLE	CCL
		.IDENT	/V3.2B/
;  R. J. KIRKMAN
; this program is converted from a fortran 4 plus assembly listing
; and therefore I apologise for the wierd names involved
;
; The main routine also requires GETMCR from F4POTS, PUTMCR, LOOKUP & FIXUP
;
; MODIFIED BY:
;	15-MAR-79  	J. DOWNWARD	ADD VARIOUS ERROR MESSAGES, TEST FOR
;					LINES TOO LONG, AND FOR SPEED BUILD IN 
;					THE COMMANDS LIST, DIR, SPOOL, TRUNCATE,
;					PURGE, DELETE.
; 
	.MCALL	GET$,OPEN$R,FDBDF$,FDRC$A,CLOSE$,EXIT$S,QIOW$S
	.MCALL	FDOP$A,FSRSZ$,DIR$,EXST$S
	.MCALL	QIOW$C

F0=%0
F1=%1
F2=%2
F3=%3
F4=%4
F5=%5
; 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!


 
 
; 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:	.BLKB	416	;30.*9. 9 parameters @ 30. chars @
CMD:	.BLKB	80.	;output new command line
PMIN:	.WORD	0	;min # params to accept
EXSTAT:	.WORD	1	; ASSUME SUCESSFUL EXIT
 
	.PSECT	$VARS,RW,D,CON,LCL
;
; ERROR MESSAGES AND PROMPTS
;
MSG1:	.ASCIZ	<15><12>/>/
MSG2:	.ASCIZ	<15><12>/...CCL -- ERROR READING SYSTEM FILE/<15><12>/>/; JGD01
MSG3:	.ASCIZ	<15><12>/...CCL -- NO COMMAND LINE !/<15><12>/>/	; JGD01
MSG4:	.ASCII	<15><12>/?        ?/<15><12>				; JGD01
	.ASCIZ	/CCL -- MCR SYNTAX ERROR OR UNKNOWN COMMAND/<15><12>/>/
MSG5:	.ASCIZ	<15><12>/CCL -- CCL COMMAND TOO LONG/<15><12>		; JGD02
MSG6:	.ASCIZ	<15><12>/CCL -- SPAWN FAILURE TO MCR/<15><12>/>/
EM2:	.ASCIZ	<15><12>/CCL -- COMMAND LINE TOO LONG/<15><12>/>/
EM3:	.ASCIZ	<15><12>/CCL -- SYNTAX ERROR/<15><12>/>/
 
 
LBDEV:	.ascii	/LB:/		;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
		.EVEN
	
$LNGFL:	.WORD	-1		; CLEARED ON COMMAND NOT TOO LONG
NOBYTE:	.WORD	0		; INCREMENT IF NOT DIR COMMAND AND NO SPACES
				; FOLLOW COMMAND
 
 
;
; PIP COMMANDS FOR DIR,LIST, DELETE, SPOOL, PURGE, TRUNCATE, UNLOCK
;
LISMSG:	.ASCIZ	/PIP TI:=/
PIPMSG:	.ASCIZ	/PIP /
BRIMSG:	.ASCIZ	\/BR\		; FORBRIEF DIRECTORY LISTING
DELMSG:	.ASCIZ	\/DE\
DIRMSG:	.ASCIZ	\/LI\
PURMSG:	.ASCIZ	\/PU\
SPOMSG:	.ASCIZ	\/SP\
TRUMSG:	.ASCIZ	\/TR\
	.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.
FIXPRM:	.WORD	2,I,J		;prl for calls of fixup
INUIC:	.WORD	0
L:	.WORD	0
K:	.WORD	0
J:	.WORD	0
I:	.WORD	0
N120:	.WORD	117		; 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	3,LBDEV,5,SYUIC,10.,SYFIL
USRDST:	.WORD	3,SYDEV,,,11.,USRFIL
;
;
 
	.PSECT	$CODE1,RW,I,CON,LCL
	; startup point for program
	; get our startup command line
CCL:
	MOV	(PC)+,R1
	.BYTE	127.,41.	; SETTING UP FOR DIR$ GMCR
	MOV	R1,KEYL
	DIR$	#KEYL
	MOV	@#$DSW,MCRL
	CLR	KEYL
;was there any command line
	TST	MCRL
	BGT	.1000
;here if there wasnt type 'NO COMMNAD LINE ' & exit
	MOV	#MSG3,R0
	JMP	EREXIT			; GO WRITE OUT ERROR AND EXIT
;	JSR	PC,MSG
; back in mainline
; and with real command line 
; Search for spaces or CR, ie end of keyword
.1000:
	CALL	DCL		; IS IT A PIP COMMAND
				; WE GET A RETURN ONLY IF PIP COMMAND NOT FOUND
	MOV	#1,R0
L$HAPL:
	CMPB	MCR-1(R0),#40
	BLE	.1002
;store in keyword buffer and in error print buffer
; as we loop
	MOVB	MCR-1(R0),MSG4+2(R0)	; 0018
	MOVB	MCR-1(R0),KEYB-1(R0)
	INC	R0
	CMP	R0,#10
	BLE	L$HAPL
; got to end of keyword or 8 chars which is enough for most people
.1002:
	DEC	R0
	MOV	R0,KEYL
; store correct keyword length
.1003:
;now try for user file, if not found go 7$ to try system file
	MOV	#7$,R2
	MOV	#USRDST,R1
	JSR	PC,OPEN
; found a user file , lookup the keyword in there
	JSR	PC,LOOKUP
	TST	R0
	BMI	.1005
; -ve is fortran success so we found the keyword go 1005
; in line if we didnt , close this file, then try
; the system file
	CALL	CLOS
7$:
; back with was no userfile as well
; error message must appear if no system file
	MOV	#OPNFL,R2
	MOV	#SYSDST,R1
	JSR	PC,OPEN
	JSR	PC,LOOKUP
	TST	R0
	BMI	.1005
; 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
	MOV	KEYL,R0
	CMPB	KEYB-1(R0),#77
; deal with "?"
	BEQ	.1010
	MOV	#MSG4,R0
	JMP	ERROR
; above deal with unknown keyword go print "?NAME"
; 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	.1003
; here on being given a valid keyword found in file
; params,pmin are set up
; say at start of line for parameter 1 char 1 and not in a uic spec
.1005:
	CLR	INUIC
	MOV	#1,J
	MOV	#1,L
	MOV	#1,I
; set all parameter strings empty ( clear 1st byte of each)
L$EBIF:
	MOV	I,R1
	MUL	#36,R1
	CLRB	P-36(R1)
	INC	I
	CMP	I,#11
	BLE	L$EBIF
; is it keyword alone , if so go to are there enough params
	MOV	KEYL,R0
	INC	R0
	CMP	R0,MCRL
	BGE	.2008
; start after keyword +1 char
	MOV	KEYL,R0
	ADD	#2,R0
	MOV	R0,I
	MOV	MCRL,R0
	INC	R0
	MOV	R0,$TEMPS
L$EBOH:
; if next character is "[" set INUIC
	MOV	I,R0
	CMPB	MCR-1(R0),#133
	BNE	L$EBLJ
	MOV	#-1,INUIC
L$EBLJ:
; if it is "]" set not in uic
	CMPB	MCR-1(R0),#135
	BNE	L$EBBK
	CLR	INUIC
L$EBBK:
; is character ' ', '=' or '<' '<-' or ',' ( allowed separators)
; if ',' then check if in uic
	CMPB	MCR-1(R0),#40
	BLE	L$JBGH
	CMPB	MCR-1(R0),#75
	BEQ	L$JBGH
	CMPB	MCR-1(R0),#74
	BEQ	L$JBGH
	CMPB	MCR-1(R0),#137
	BEQ	L$JBGH
	CMPB	MCR-1(R0),#54
	BNE	L$EBHK
	TST	INUIC
	BMI	L$EBHK
L$JBGH:
; here it is a separator set up next param
	BR	.2002
L$EBHK:
; here char is not a separator, stuff in parameter
	MOV	L,R1
	MUL	#36,R1
	ADD	J,R1
	MOVB	MCR-1(R0),P-37(R1)
	INC	J
; go back for more
	BR	.2001
.2002:
; here with a separator
; insert a null and add 1 to parameter # (in L) 
; check I ( text pointer) still in mcr line text
	MOV	L,R1
	MUL	#36,R1
	ADD	J,R1
	CLRB	P-37(R1)
	MOV	#1,J
	INC	L
; check if still in the line
.2001:
	INC	I
	CMP	I,$TEMPS
	BLE	L$EBOH
.2008:
; check have we enough for min params yet?
	DEC	L
	CMP	L,PMIN
	BGE	.2010
; if yes skip asking for more
.2009:
; have we the max asked for if so no more to do
	CMP	PARAMS,L
	BLE	.2010
.2004:
; get a parameter line ?n text
; give syserr message if not found since he guaranteed it
	GET$	#FDB
	BCC	1$
	JMP	OPNFL
1$:					; 0064
	CMPB	INBF,#77
; if it doesnt start ? then its anither keyword line, go and try
; again for more
	BNE	.2004
	CALL	PRMPT
; get a parameter in response
	BR	.2009
.2010:
;	here with sufficient parameters
; get an action or skeleton line
; which begins "*"
	MOV	L,PARAMS
					; 0076
	GET$	#FDB
					; 0078
	CMPB	INBF,#'*
	BNE	.2010
	MOV	#120,R0
	MOV	#CMD,R2
	MOV	#MCR,R1
; clear out work buffers
11$:	MOVB	#' ,(R1)+
	MOVB	#' ,(R2)+
	SOB	R0,11$
	MOV	FDB+F.NRBD,R0
	DEC	R0
	MOV	#INBF+1,R1
	MOV	#MCR,R2
; copy skeleton into old MCR buffer
12$:	MOVB	(R1)+,(R2)+
	SOB	R0,12$
	CALL	CLOS
; we have now finished with all files
	MOV	#1,I
	MOV	#1,J
.2030:
; scan skeleton transferring files, when hits "%" call fixup
	MOV	I,R0
	CMPB	MCR-1(R0),#45
	BEQ	.2031
	MOV	J,R1
	MOVB	MCR-1(R0),CMD-1(R1)
	INC	I
	INC	J
	BR	.2032
.2031:
	MOV	#FIXPRM,R5
	JSR	PC,FIXUP
.2032:
; done our 80 byte line
	CMP	I,#120
	BGE	L$JBEG
	CMP	J,#117
	BLT	.2030
; run out of one or other buffer
L$JBEG:
	CMP	J,#117		; CHECK TO SEE HOW LONG COMMAND IS
	BGT	TOLONG		; MCR COMMAND IS TOO LONG
	MOVB	#15,CMD+116	;WAS 117 IF USE WITH PUTMCR DIRECTIVE	; JGD01
; add a CR to end of buffer and send it
	MOV	#PMCR,R5
	JSR	PC,PUTMCR
	BCC	END
	MOV	#MSG6,R0	; WARN USER SPAWN FAILED
	JMP	ERROR		; EXIT WITH ERROR
END:	JMP	FINISH
; here when user types ctrl/Z for a prompt response as abort
.4000:
	CALL	CLOS
	MOV	#MSG1,R0
	CALL	ERROR		; EXIT WITH SEVERE ERROR
MSG:	CALL	TYPEIT		;
;	MOVB	#';,CMD		; FIX PROBLEM WITH CCL HANGING AT.	; JGD01
;	BR	L$JBEG		; BY SENDING DUMMY COMMAND TO MCR	; JGD01
FINISH:	
	EXST$S	#1		; EXIT AND SHOW SUCCESS
	EXIT$S			; IF EXIT WITH STATUS FAILS, TRY  EXIT
 
TOLONG:
	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
	MOV	#MSG1,R0	; FINISH UP WITH CR,LF, >
ERROR:	CALL	TYPEIT	;
EREXIT:	EXST$S	#4		; 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:
;
;	BRI[EF]
;	LIS[T]
;	DEL[ETE]
;	DIR[ECTORY]
;	PUR[GE]
;	SPO[OL]
;	TRU[NCATE]
;
;
; THE SYNTAX OF ALL THE COMMAND IS:
;
;	COMMAND [FILES]
;
; THE DIRECTORY COMMAND MAY BE MODIFIED BY USING THE SWITCHES
; "/BR", OR "/FU"
;
 
 
 
 
 
DCL:			
;
; PARSE INPUT LINE
;
	MOV	#MCR,R0		; GET ADDRESS OF BUFFER
FNDSPC:	CMPB	(R0)+,#40	; HAVE WE FOUND END OF COMMAND?
	BEQ	5$		; IF EQ, YES
	CMP	R0,#MCR+40.	; NO, REACHED END OF BUFFER?
	BLOS	FNDSPC		; IF LOS, NO
	CMP	#"DI,MCR	; YES,--IS THIS A DIRECTORY COMMAND?
	BEQ	4$		; IS DIR COMMAND SO IS OK
	CMP	#"BR,MCR	; IS THIS BRIEF DIRECTORY COMMAND?
	BEQ	4$		; IS BRIEF COMMAND SO IS OK
	INC	NOBYTE		; IF LIS/SPO/DEL/PUR, AN ERROR WILL OCCUR IF
				; NOBYTE IS SET
4$:	CLR	R0		; YES, FAKE A NULL COMMAND
5$:	MOV	R0,R2		; REMEMBER WHERE COMMAND STARTS
	MOV	#CMD,R0		; GET OUTPUT BUFFER ADDRESS
	MOV	#79.,R4		; SET MAX NO. OF CHARACTERS
	MOV	#LISMSG,R3	; ASSUME LIST
	CMP	#"LI,MCR	; WAS IT LIST?
	BNE	7$		; IF NE NO
	CMPB	#'S,MCR+2	;
	BEQ	10$		; IF EQ, YES IS LIST
7$:	MOV	#PIPMSG,R3	; NO, SET "PIP " INTO PUFER
10$:	CALL	20$		; COPY INTO BUFFER
	MOV	R2,R3		; COPY FILENAMES
	BEQ	12$		; IF EQ NO FILES TO COPY
	CALL	20$		;..
12$:	TST	R4		; OVERFLOW MCR BUFFER?
	BLE	40$		; IF LE, YES
	CMP	#"DE,MCR	; WAS IT THE DELETE COMMAND?
	BNE	13$		; IF NE, NO
	CMPB	#'L,MCR+2	; 
	BNE	13$		;
	MOV	#DELMSG,R3	; YES, SET "/DE" INTO BUFFER
	BR	17$		; GO FINISH UP
 
13$:	CMP	#"TR,MCR	; IS IT TRUNCATE COMMAND
	BNE	131$		; IF NE, NO
	CMPB	#'U,MCR+2	; DO ALL THREE LETTERS MATCH?
	BNE	131$		; IF NE, NO
	MOV	#TRUMSG,R3	; IF EQ, YES, SET UP FOR TRUNCATE
	BR	17$		; FINISH UP
 
131$:	CMP	#"BR,MCR	; IS IT BRIEF DIRECTORY COMMAND
	BNE	14$		; IF NE, NO
	CMPB	#'I,MCR+2	; DO ALL THREE LETTERS MATCH
	BNE	14$		; IF NE, NO
	MOV	#BRIMSG,R3	; IF EQ, YES, SET UP FOR /BR LISTING
	BR	17$		; FINISH UP
 
14$:	CMP	#"PU,MCR	; IS IT PURGE
	BNE	15$		; IF NE, NO
	CMPB	#'R,MCR+2	; MUST HAVE ALL THREE LETTERS
	BNE	15$		; IF NE, NO, CHECK SOME MORE
	MOV	#PURMSG,R3	; IT IS PURGE, TACK ON THE SWITCH
	BR	17$		; GO FINISH UP
15$:	CMP	#"DI,MCR	; IS THIS THE DIRECTORY COMMAND
	BNE	16$		; IF NE, NO
	CMPB	#'R,MCR+2	; 
	BNE	16$		;
	MOV	#DIRMSG,R3	; YES, SET UP FOR IT
	BR	17$		; AND CONTINUE
16$:	CMP	#"SP,MCR	; IS IT THE SPOOL COMMAND?
	BNE	161$		; IF NE, NO
	CMPB	#'O,MCR+2	;
	BNE	161$		;
	MOV	#SPOMSG,R3	; YES, SET UP FOR IT
	BR	17$		; GO FINISH UP
161$:	CMP	#"LI,MCR	; IS IT LIST
	BNE	162$		; IF NOT LIST, GO CHECK CCL FILE
	CMPB	#'S,MCR+2	; DOES THIRD LETTER MATCH
	BEQ	17$		; IF EQ, YES, GO DO IT
162$:	RETURN			; AND RETURN
17$:	CALL	20$		; SET STRING INTO BUFFER
19$:	SUB	#2,R4		; COUNT EOL AND NULL
	BLE	40$		; IF LE, NOT ENOUGH ROOM
	MOVB	#15,(R0)+	; SET END OF LINE
	CLRB	(R0)+		; MARK END OF LINE WITH NULL
	CLR	$LNGFL		; INDICATE COMMAND WAS NOT TOO LONG
	JMP	60$		; GO SPAWN COMMAND
 
; 
; COPY INTO BUFFER
;
20$:	TST	R4		; ALREADY FILL THE BUFFER?
	BLE	40$		; IF LE, YES, TUFF STUFF
25$:	MOVB	(R3)+,(R0)+	; COPY COMMAND
	BEQ	30$		; DONE ON NULL
	DEC	R4		; COUNT THE CHARACTER
	CMPB	-1(R0),#15	; JUST COPY CR?
	BEQ	30$		; IF EQ YES, QUIT
	CMPB	-1(R0),#33	; OR DID WE JUST COPY ESC
	BEQ	30$		; IF EQ YES, QUIT
	TST	R4		; CHECK NO. OF CHARACTERS
	BGT	25$		; IF ROOM , KEEP COPYING
30$:	DEC	R0		; BACK UP OVER NULL
40$:	RETURN			;
60$:				; REF LABLE
	TST	NOBYTE		; IF NOT 'DIR', WAS COMMAND TO SHORT?
	BNE	ERR3		; IF NE 0, SYNTAX ERROR
	TST	$LNGFL		; WAS COMMAND LINE TOO LONG
	BNE	ERR2		; IF NE YES
	MOV	#79.,N120	; CALCULATE THE TOTAL # CHARS USED
	SUB	R4,N120		; BY SUBTRACTING OFF THOSE LEFT
	MOV 	#PMCR,R5	; SET UP PARAMETER LIST
	CALL	PUTMCR		; GO SPAWN COMMAND
	JMP	FINISH		; AND EXIT
 
;
; ERROR PROCESSING
ERR2:	MOV	#EM2,R0		; COMMAND LINE TOO LONG
	JMP	ERROR		;
ERR3:	MOV	#EM3,R0		; SYNTAX ERROR
	JMP	ERROR		;

; 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,#2,#1,,,,<R0,R1,#0>
		MOV	(SP)+,R1
		RTS	PC

; close our 1 file
	CLOS:	CLOSE$	#FDB
		RTS	PC

; open a file on lun 1, dataset descriptor in R1, eror label in R2
	OPEN:	OPEN$R	#FDB,#1,R1
		BCC	1$
		JMP	@R2
	1$:	RTS	PC

; print couldnt access system file & die
	OPNFL:	MOV	#MSG2,R0
		JMP	ERROR		; EXIT WITH SEVERE ERROR
; 
	IOSTS:	.BLKW	2

	PRMPT:	; THIS HAS TO FIND END OF INPUT LINE - ADD ?
		; TYPE IT AND GET RESULT IN CORRECT 30 BYTE ARRAY CHUNK.
		MOVB	INBF+1,R3
		SUB	#60,R3
		CMP	R3,L
	; if the # for this line is lower than or equal to highest param
	; we alreay have get the next one instead, this is settled already
		BLE	NO
		MOV	R3,L
		MUL	#36,R3
		ADD	#P-36,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,#30.,,R1,R2,#44>
		CMPB	IOSTS,#1
		BEQ	NO
;		JMP	.4000
		MOV	#MSG1,R0	; DISPLAY CR,LF,>
		JMP	ERROR		; EXIT WITH SEVERE ERROR
	NO:	RTS	PC

		.END	CCL