.TITLE	TAPUTL -- TAPE UTILITY
	.IDENT	-000000-
	.SBTTL	TITLE PAGE
	.NLIST	LOC,BIN
;+
; ABSTRACT:	TAPUTL
;
;	THIS PROGRAM ALLOWS CERTAIN SIMPLE MANIPULATIONS OF THE
;	TAPE UNIT.
;
; OPERATING PROCEDURES:
;
;	THIS PROGRAM IS RUN AS AN MCR COMMAND. THE SYNTAX IS
;
;	MCR>REW MTNN:	  ;REWIND MTNN:
;	MCR>EOF MTNN:	  ;WRITE EOF MARK ON MTNN:
;	MCR>RWU MTNN:	  ;REWIND AND UNLOAD MTNN:
;	MCR>SPF MTNN: [N] ;SKIP PAST N EOF'S ON MTNN: (DEFAULT: 1)
;	MCR>SPB MTNN: [N] ;SKIP PAST N BLOCKS ON MTNN: (DEFAULT: 1)
;	MCR>BPF MTNN: [N] ;BACKSPACE PAST N EOF'S ON MTNN: (DEFAULT: 1)
;	MCR>BPB MTNN: [N] ;BACKSPACE PAST N BLOCKS ON MTNN: (DEFAULT: 1)
;
;	WHERE MTNN: IS THE TAPE WHICH IS TO HAVE THE COMMAND
;	RUN ON IT.
;
; WRITTEN: 22-APR-78, -0.0.0-, BRUCE C. WRIGHT
; MODIFIED:
; VERIFIED:
;-
	.LIST	LOC,BIN

	.SBTTL	MACRO CALLS
	.MCALL	GMCR$,DIR$,QIOW$,EXIT$S,ALUN$S,FDBDF$
;
	.MACRO	ERROR	STRING
	.NCHR	N,<STRING>
	JSR	R0,ERROR
	.WORD	N
	.ASCII	"STRING"
	.EVEN
	.ENDM
;
	.SBTTL	MAIN LINE CODE
;
TAPUTL::
	DIR$	#GMCR		;GET MCR COMMAND LINE.
	BCC	1$		;SKIP IF OK.
	ERROR	<CANNOT READ MCR COMMAND LINE>
1$:	MOV	@#$DSW,R0	;GET LENGTH OF MCR LINE
	ADD	#GMCR+G.MCRB,R0	;GET THE TERMINATING CHAR
	MOV	#1,R1		;SET .TPARS OPTIONS WORD
				;THIS MEANS THAT KEYWORDS
				;CANNOT BE ABBREVIATED AND
				;BLANKS ARE SIGNIFICANT.
	MOV	#KEYTBL,R2	;GET ADDRESS OF KEYWORD TABLE
	MOV	@#$DSW,R3	;GET CHARACTER COUNT.
	MOV	#GMCR+G.MCRB,R4	;GET ADDRESS OF DATA STRING
	MOV	#START,R5	;GET ADDRESS OF FIRST STATE.
	CALL	.TPARS		;CALL .TPARS TO PARSE STRING.
	BCC	20$		;CONTINUE IF NO ERROR
	ERROR	<ILLEGAL DEVICE NAME>
20$:	CMP	UNIT,#77	;UNIT TOO BIG?
	BLOS	21$		;NO
	ERROR	<ILLEGAL DEVICE UNIT NUMBER>
21$:	MOV	.PUDBA,R1	;GET PUD
22$:	CMP	U.DN(R1),DEV	;RIGHT DEVICE?
	BNE	23$		;NO
	CMPB	U.UN(R1),UNIT	;RIGHT UNIT?
	BEQ	24$		;YES
23$:	ADD	#U.SZ,R1	;ADD IN INCREMENT
	CMP	R1,.PUDEA	;END OF PUD?
	BLO	22$		;NO
	ERROR	<NO SUCH DEVICE>
24$:	BITB	#CH.FOR,U.CH(R1) ;IS IT FOREIGN?
	BNE	25$		;YES
	ERROR	<DEVICE MUST BE MOUNTED AS FOREIGN>
25$:	BITB	#CH.UNL,U.CH(R1) ;DISMOUNT?
	BEQ	26$		;NO
	ERROR	<DISMOUNT IN PROGRESS>
26$:	ALUN$S	#2,DEV,UNIT
	BCC	30$		;ERROR?
	ERROR	<CANNOT ASSIGN LUN>
30$:	MOV	#ATTACH,-(SP)	;TRY TO ATTACH
	CALL	.DIRDL		;
	BCS	55$		;
	CMP	IOST,#IS.SUC	;SUCCESS?
	BNE	55$		;NO
50$:	MOV	#MTQIO,-(SP)
	CALL	.DIRDL		;
	BCC	60$
55$:	MOV	@#$DSW,FDB+F.ERR ;MOVE IN ERROR CODE
	BMI	56$		;WAS A DSW ERROR, CONTINUE
	MOVB	IOST,FDB+F.ERR	;
56$:	MOV	#FDB,R0		;GET FDB
	MOV	#GMCR+G.MCRB,R1	;GET STRING NAME
	MOV	#3,R2		;AND LENGTH
	CALL	.PRFCS		;PRINT ERROR
	MOV	#DETACH,-(SP)
	CALL	.DIRDL
	EXIT$S
60$:	CMPB	IOST,#IS.SUC
	BNE	55$
	MOV	#DETACH,-(SP)
	CALL	.DIRDL
	EXIT$S

	.SBTTL	COMMAND LINE PARSE TABLES
	.MCALL	ISTAT$,STATE$,TRAN$
;
; INITIALISE STATE TABLES
;
	ISTAT$	STATBL,KEYTBL
;
; SKIP OVER COMMAND NAME
;
	STATE$	START
	TRAN$	"REW",BLANK,REWSUB
	TRAN$	"RWU",BLANK,RWUSUB
	TRAN$	"EOF",BLANK,EOFSUB
	TRAN$	"SPB",BLANK,SPBSUB
	TRAN$	"SPF",BLANK,SPFSUB
	TRAN$	"BPB",BLANK,BPBSUB
	TRAN$	"BPF",,BPFSUB
 
	STATE$	BLANK
	TRAN$	$BLANK,READDV
	TRAN$	$ANY,BLANK
;
; READ DEVICE AND UNIT NUMBER
;
	STATE$	READDV
	TRAN$	$ANY,,SETDV1
 
	STATE$
	TRAN$	$ANY,,SETDV2
 
	STATE$
	TRAN$	$NUMBR,DEV1,SETUNT
	TRAN$	$LAMDA
 
	STATE$	DEV1
	TRAN$	':
;
; PICK UP A NUMBER IF ANY
;
	STATE$
	TRAN$	$BLANK,NUM
	TRAN$	$LAMDA
 
	STATE$	NUM
	TRAN$	$DNUMB,CHKLST,SETNUM
	TRAN$	$LAMDA
;
; AND SKIP TO THE END OF THE STRING.
;
	STATE$	CHKLST
	TRAN$	$BLANK,CHKLST
	TRAN$	$LAMDA
 
	STATE$	LAST
	TRAN$	$EOS,$EXIT
 
	STATE$

	.SBTTL	COMMAND LINE PARSE ACTION ROUTINES
;
; ACTION ROUTINES
;
; MARK AS "REW"
;
REWSUB:	MOV	#IO.RWD,MTQIO+Q.IOFN
	RETURN
;
; MARK AS "RWU"
;
RWUSUB:	MOV	#IO.RWU,MTQIO+Q.IOFN
	RETURN
;
; MARK AS "EOF"
;
EOFSUB:	MOV	#IO.EOF,MTQIO+Q.IOFN
	RETURN
;
; MARK AS "SPB"
;
SPBSUB:	MOV	#IO.SPB,MTQIO+Q.IOFN
	MOV	#1,MTQIO+Q.IOPL+0
	RETURN
;
; MARK AS "SPF"
;
SPFSUB:	MOV	#IO.SPF,MTQIO+Q.IOFN
	MOV	#1,MTQIO+Q.IOPL+0
	RETURN
;
; MARK AS "BPB"
;
BPBSUB:	MOV	#IO.SPB,MTQIO+Q.IOFN
	MOV	#-1,MTQIO+Q.IOPL+0
	RETURN
;
; MARK AS "BPF"
;
BPFSUB:	MOV	#IO.SPF,MTQIO+Q.IOFN
	MOV	#-1,MTQIO+Q.IOPL+0
	RETURN
;
; GET DEVICE NAME CHARACTER 1
;
SETDV1:	MOVB	.PCHAR,DEV
	RETURN
;
; GET DEVICE NAME CHARACTER 2
;
SETDV2:	MOVB	.PCHAR,DEV+1
	RETURN
;
; GET UNIT NUMBER
;
SETUNT:	MOV	.PNUMB,UNIT
	BMI	10$		;ERROR?
	TST	.PNUMH		;ERROR?
	BNE	10$		;YES
	RETURN
10$:	ADD	#2,(SP)		;REJECT TRANSITION.
	RETURN			;AND RETURN.
;
; SET NUMBER FOR CERTAIN FUNCTION CODES.
;
SETNUM:	TST	.PNUMH		;DISALLOW NUMBERS > 32767.
	BNE	20$		;
	TST	.PNUMB		;DITTO
	BLE	20$		;
	TST	MTQIO+Q.IOPL+0	;WAS A PARAMETER ALREADY SUPPLIED?
	BEQ	20$		;NO -- THEN IT'S NOT A LEGAL FUNCTION.
	BPL	10$		;SKIP IF NUMBER TO BE POSITIVE.
	MOV	.PNUMB,MTQIO+Q.IOPL+0 ;MOVE IN THE NUMBER.
	NEG	MTQIO+Q.IOPL+0	;MAKE IT NEGATIVE.
	RETURN			;AND RETURN.
10$:	MOV	.PNUMB,MTQIO+Q.IOPL+0 ;RETURN THE NUMBER.
	RETURN
20$:	ADD	#2,(SP)		;REJECT THE TRANSITION
	RETURN			;AND RETURN.

	.SBTTL	SUBROUTINE TO PRINT ERROR MESSAGES
;
; THIS SUBROUTINE IS INVOKED BY THE "ERROR" MACRO. IT
; PRINTS THE ARGUMENT GENERATED BY THE "ERROR" MACRO ON
; THE USER'S TERMINAL.
;
; CALLING SEQUENCE:
;
;	JSR	R0,ERROR
;	.WORD	STRINGLENGTH
;	.ASCII	"STRING"
;
; THE SUBROUTINE WILL NEVER RETURN TO THE CALLER.
;
ERROR:	MOV	#BUFFER,R1	;POINT TO BUFFER.
	MOVB	GMCR+G.MCRB,(R1)+
	MOVB	GMCR+G.MCRB+1,(R1)+
	MOVB	GMCR+G.MCRB+2,(R1)+
	MOVB	#' ,(R1)+
	MOVB	#'-,(R1)+
	MOVB	#'-,(R1)+
	MOVB	#' ,(R1)+
	MOV	(R0)+,R2
10$:	MOVB	(R0)+,(R1)+
	SOB	R2,10$
	MOV	#BUFFER,R0
	MOV	R0,QIO+Q.IOPL
	SUB	R0,R1
	MOV	R1,QIO+Q.IOPL+2
	MOV	#QIO,-(SP)
	CALL	.DIRDL
	EXIT$S			;AND EXIT.

	.SBTTL	DATA AREA
;
; RESULTS FROM PARSE OF COMMAND STRING
;
DEV:	.ASCII	/  /		;ASCII DEVICE NAME
UNIT:	.WORD	0		;UNIT NUMBER
;
; MISCELLANEOUS DATA AREAS
;
IOST:	.WORD	0,0		;I/O STATUS BLOCK
;
; DIRECTIVE PARAMETER BLOCKS
;
QIO:	QIOW$	IO.WVB,1,1,,IOST,,<,,40>
MTQIO:	QIOW$	,2,2,,IOST,,<0>
ATTACH:	QIOW$	IO.ATT,2,2,,IOST
DETACH:	QIOW$	IO.DET,2,2,,IOST
GMCR:	GMCR$
FDB:	FDBDF$
BUFFER:	.BLKB	80.
	.END	TAPUTL