;
;
;	THIS PROGRAM IS DESIGNED TO MANIPULATE MAGNETIC TAPE
;	DRIVERS IN THE FOLLOWING WAYS
;	1) REWIND A TAPE
;	2) REWIND A TAPE AND PUT DEVICE OFF LINE
;	3) SPACE FILES ON A FILE STRUTURED OR NON-FILE STRUCTURED TAPE
;	4) SPACE BLOCKS ON A TAPE
;	5) SET TAPE CHARACTERISTICS
;	6) ZERO A TAPE
;	7) WRITE TAPE MARKS
;	8) READ THE VOLUME LABEL OFF A FILE STRUCTURED TAPE
;	9) DO A FILE......BLOCK SUMMARY FOR FILE OR NON-FILE STRUCTURED TAPE
;	A) DO A FILE...BLOCK...BYTE SUMMARY FOR FILE OR NON-FILE
;	   STRUCTURED TAPE
;
;
;
;
	.MCALL	ALUN$,ALUN$S,CLOSE$,CSI$,CSI$ND,CSI$SW,CSI$SV,DIR$,EXIT$S
	.MCALL	EXTK$,FDAT$R,FDBDF$,FDBF$A,FDOP$A,FDRC$A,FINIT$
	.MCALL	FSRSZ$,GCMLB$,NMBLK$,OPEN$W,PUT$,QIOW$,RCML$
	.MCALL	CSI1G,CSI2,GCML,PCRLF,PSTR,TINIT,TTYOUT,RETURN
;
;
	.NLIST	BEX		;DONT LIST BINARY EXTENSIONS
ENDR:	EXIT$S			;END PROGRAM
GCLBLK:	GCMLB$	4,RAT,BUFF,5	;GCL BLOCK
BUFF:	.BLKW	41
	FSRSZ$	3		;WE WILL BE OPENING 3 FILES SIMUTAINOUSLY
FDOUT:	FDBDF$			;SET UP FDB BLOCK
	FDOP$A	6,CSIBLK+C.DSDS,NAME,FO.WRT
	FDRC$A	FD.INS
	FDBF$A	26
NAME:	NMBLK$	RAT,DMP,,TI,0	;DEFAULT TO FILE RAT.DMP ON DK1 UNDER THE USER UIC
	CSI$			;SET UP CSI BLOCK
	.EVEN
CSIBLK:	.BLKB	C.SIZE
ERRPFX::PSTR	^*<CR><LF>/RAT -- /*;ERROR PREFIX USED BY ERROR ROUTINES
	RETURN
TABLE:	CSI$SW	RW,RWM,,,,SVRW		;SWITCH TABLE
	CSI$SW	RU,RUM
	CSI$SW	ZE,ZEM
	CSI$SW	VL,VLM
	CSI$SW	SE,SEM
	CSI$SW	SF,SFM,,,,SVALT
	CSI$SW	SB,SBM,,,,SVALT
	CSI$SW	BS,BSM,,,,SVALT
	CSI$SW	SM,SMM,,,,SVALT
	CSI$SW	WT,WTM,,,,SVALT
	CSI$SW	SC,SCM,,,,SVALU
	CSI$SW	DF,DFM,,,,SASCII
	CSI$ND			;END OF SWITCN TABLE
SVALT:	CSI$SV	DECIMAL,SVAL,2	;SWITCH VALUE TABLE
SVALU:	CSI$SV	OCTAL,SVAL,2
SVRW:	CSI$SV	ASCII,SRWA,2
SASCII:	CSI$SV	ASCII,SASC,2
	CSI$ND			;END OF SWITCH VALUE TABLE
SVAL:	.WORD	0		;SIWTCH VALUE STORAGE LOCATION
SASC:	.WORD	0		;SWITCH VALUE ASCII STORAGE LOCATION
SRWA:	.WORD	0		;REWIND SWITCH VALUE STORAGE LOCATION
RWM=1				;SWITCH MASK WORDS
RUM=2
ZEM=4
SFM=10
SBM=20
BSM=40
SMM=100
SCM=200
WTM=400
DFM=1000
VLM=2000
SEM=4000
SUBTAB:	.WORD	RWS		;SUB-ROUTINE LOOK UP TABLE
	.WORD	RUS
	.WORD	ZES
	.WORD	SFS
	.WORD	SBS
	.WORD	BSS
	.WORD	SMS
	.WORD	SCS
	.WORD	WTS
	.WORD	DFS
	.WORD	VOL
	.WORD	SES
STPT:	.WORD	0		;USED FOR STORING STACK POINTER
Q:	QIOW$	IO.ATT,1,24,,QSTAT,,<1>
QSTAT:	.BLKW	2		;QIO STATUS BLOCK
START:	FINIT$			;BEGINNING OF PROGRAM
	TINIT	5,23		;INIALIZATION OF QUOTE MACROS
	ALUN$S	#5,#"TI,#0	;ASSIGN LUN TO USER TERMINAL
	MOV	SP,STPT		;SAVE STACK POINTER ORIGINAL VALUE
	MOV	#1,TSTALN	;SET FLAG FOR ASLUN SUB-ROUTINE
	MOV	#116,SASC	;SET DEFAULT TO NON-FILE STRUCTURED TAPE
	BR	DIE1
;
;
;	DIE IS USED BY ALL ERROR HANDLING ROUTINES
;
DIE::	RCML$	#GCLBLK		;RESET GCL BLOCK
	CMP	SMSTST,BSSTST	;WAS SUB-ROUTINE BSS OR SMS CALLED?
	BEQ	8$		;IF SO DELETE THE FILE IT OPENED
	BR	BEG		;IF NEITHER BSS OR SMS WERE CALLED THEN GOTO BEG
8$:	MOV	#FDOUT,R0	;IF BSS OR SCS WAS CALLED THEN
	CALL	.DLFNB		;DELETE THE FILE THEY CREATED
;
;
;
;	(DIE1 TO BEG) RESET ALL VALUES USED IN THE SUB-ROUTINES
;	BSS AND SMS TO ZERO
;
;
;
DIE1:	CLR	C3
	CLR	BLKCNT
	CLR	FILCNT
	CLR	BSSTST
	CLR	SMSTST
	CLR	CHEOV
BEG:	CLR	SVAL		;SET SVAL BACK TO ZERO
	MOV	STPT,SP		;RESTORE STACK POINTER TO IT'S ORIGINAL VALUE
	GCML	#GCLBLK,,,ENDR,GCERR	;ISSUE PROMPT "RAT>"
	CSI1G	#CSIBLK,GCLBLK,CS1ERR	;PARSE THE COMMAND LINE
	FDAT$R	#FDOUT,#R.VAR,#FD.CR,,#-1,#-1	;SET CERTAIN VALUES IN F.D.B.
	TST	CSIBLK+C.CMLD		;SEE IF A COMMAND LINE WAS GIVEN
	BNE	3$			;IF SO CONTINUE
	JMP	BEG			;IF NOT, ISSUE ANOTHER PROMPT
3$:	JSR	PC,CS			;GO TO CS, PARSE INPUT AND OUTPUT FILES
					;(IF ANY), AND ASSIGN L.U.N. TO PROPER
					; TAPE DRIVE
	MOV	#SUBTAB,R2		;MOVE ADRESS OF SUB-ROUTINE TABLE TO R2
	TST	CSIBLK+C.MKW1		;SEE IF A SWITCH IS SPECIFIED
	BNE	4$			;IF SO CONTINUE
	MOV	#4,QSTAT		;IF NOT WRITE AN ERROR MESSAGE
	JSR 	PC,ERROR		;AND START AGAIN
4$:	ROR 	CSIBLK+C.MKW1		;ROTATE MASK WORD
	BCS	LABEL			;IF WE ARE AT CORRECT SWITCH BR LABEL
	TST	(R2)+			;ELSE MOVE R2 ONE FURTHER DONE SUB TABLE
	BR	4$			;REPEAT PROCEDURE
LABEL:	TST	CSIBLK+C.MKW1		;SEE IF MORE THAN ONE SWITCH 
	BEQ	1$			;IF NOT, CONTINUE
	MOV	#5,QSTAT		;IF SO, WRITE ERROR MESSAGE 
	JSR	PC,ERROR		;AND START AGAIN
1$:	JSR	PC,@(R2)		;JUMP TO APPROPRIATE SUB-ROUTINE
	JMP	BEG			;REPEAT ENTIRE PROCEDURE
	
;******************************************************************
; ERROR IS A SUB-ROUTINE WHICH WRITES OUT ERROR MESSAGES
;
ERROR:	MOV	#ERTAB,R5
1$:	CMPB	QSTAT,(R5)+	;SEARCH THROUGH TABLE
	BEQ	2$
	CMPB	#11,(R5)
	BNE	1$
	TSTB	(R5)+
2$:	SUB	#ERTAB+1,R5	;FIND ERROR .
	ASL	R5
	ADD 	#ERRTAB,R5	;FIND PROPER LABEL
	PSTR	^*<CR><LF>/RAT -- /* ;WRITE ERROR MESSAGE
	TTYOUT	(R5),#32.
	JMP	DIE
ERTAB:	.BYTE	IE.BBE		;ERROR CODE TABLE
	.BYTE	IE.DNR
	.BYTE	IE.EOF
	.BYTE	IE.EOT
	.BYTE	IE.EOV
	.BYTE	IE.OFL
	.BYTE	IE.WLK
	.BYTE	IE.PRI
	.BYTE	2
	.BYTE	4
	.BYTE	5
	.BYTE	6
	.BYTE	10
	.BYTE	11
	.EVEN
ERRTAB:	.WORD	E1		;ERROR LABEL TABLE
	.WORD	E2
	.WORD	E3
	.WORD	E4
	.WORD	E5
	.WORD	E6
	.WORD	E7
	.WORD	P1
	.WORD	E8
	.WORD	A1	
	.WORD	A2	
	.WORD	A3
	.WORD	A4
	.WORD	A5
E1:	.ASCII	/BAD BLOCK ENCOUNTERED           /
E2:	.ASCII	/DEVICE NOT READY                /
E3:	.ASCII	/END OF FILE                     /
E4:	.ASCII	/END OF TAPE                     /
E5:	.ASCII	/END OF VOLUME                   /
E6:	.ASCII 	/DEVICE OFF LINE                 /
E7:	.ASCII	/DEVICE WRITE LOCKED             /
P1:	.ASCII	/PRIVILEGE VIOLATION             /
E8:	.ASCII	/ILLEGAL SWITCH VALUE SPECIFIED  /
A1:	.ASCII	/PLEASE SPECIFY A SWITCH         /
A2:	.ASCII	/PLEASE SPECIFY ONLY ONE SWITCH  /
A3:	.ASCII	/INVALID DEVICE STRING           /
A4:	.ASCII	/TAPE NOT FILE STRUCTURED        /
A5:	.ASCII	/OPERATION FAILED                /
	.EVEN
;
;*********************************************************
;
; ASLUN ASSIGN LOGICAL UNIT NUMBER TO A TAPE DRIVE IF NECESSARY
;
ASLUN:	TST	CSIBLK+C.DIRD	;SEE IF UIC SPECIFIED
	BNE	5$		;IF SO WRITE ERROR MESSAGE
	TST	CSIBLK+C.FILD	;SEE IF FILE NAME SPECIFIED
	BNE	5$		;IF SO WRITE ERROR MESSAGE
	MOV	CSIBLK+C.DEVD,R3	;SEE IF DEVICE SPECIFIED
	BNE	2$			;IF SO ASSIGN LUN TO IT, AND ATTACH IT
	CMP	#1,TSTALN		;IF NOT SEE IF THIS IS FIRST TIME 
	BEQ	1$			;IF IT IS THEN GOTO 1$
	RTS	PC			;OTHERWISE RETURN
5$:	MOVB	#6,QSTAT		;AN ERROR HAS BEEN MADE SO
	JMP	ERROR			;RETURN AN ERROR MESSAGE
2$:	CMP	#2,R3			;IS THE DEVICE NAME 'DD':
	BNE	10$			;NO
	CLR	ABLK+A.LUNU		;YES, SO DEFAULT DEVICE NO. = 0
	BR	20$			;NOW GET DEVICE NAME
10$:	MOV	CSIBLK+C.DEVD+2,R0	;GET DEVICE NAME ADRESS
	TST	(R0)+			;R0 NOW POINTS TO DEVICE NUMBER(S)
	CALL	$COTB			;CHANGE DEVICE NUMBER FROM
					;ASCII TO BINARY
	MOV	R1,ABLK+A.LUNU		;PUT DEVICE NUMBER IN ABLK
20$:	MOV	CSIBLK+C.DEVD+2,R0	;GET DEVICE NAME ADRESS
	MOVB	(R0)+,ABLK+A.LUNA	;NOW MOVE DEVICE NAME INTO ABLK
	MOVB	(R0),ABLK+A.LUNA+1
	CMP	#1,TSTALN		;AND IF FIRST TIME THROUGH GOTO ASLUN$
	BEQ	1$
	DIR$	#Q3,DIRERR		;IF NOT FIRST TIME DETACH OLD DEVICE FIRST
1$:	MOV	#0,TSTALN		;RESET FIRST TIME FLAG
	DIR$	#ABLK,DIRERR		;ASSIGN L.U.N. TO DEVICE
	DIR$	#Q2,DIRERR		;ATTACH THE DEVICE
	CMPB	#IS.SUC,QSTAT		;SEE IF ATTACH WAS SUCCESFUL
	BNE	4$			;IF NOT WRITE ERROR MESSAGE
	RTS	PC			;OTHERWISE RETURN
4$:	JMP 	ERROR
Q2:	QIOW$	IO.ATT,1,24,,QSTAT
Q3:	QIOW$	IO.DET,1,24,,QSTAT
ABLK:	ALUN$	1,MT,0
TSTALN:	.WORD	0
;
;**********************************************************************
; SKIBLK IS USED TO SKIP BLOCKS ON A FILE STRUCTERED TAPE
;
SKIBLK:	MOV	#IO.SEC,SKQIO+Q.IOFN	;SENSE TAPE CHARACTERISTICS
	DIR$	#SKQIO,DIRERR
	BIT	#1000,QSTAT+2		;WHAT'S THE TAPE DRIVE DOING?
	BEQ	1$			;IT'S STILL REWINDING
	JSR	PC,RWS			;MAKE SURE DONE REWINDING
					;BY QUEING ANOTHER REWIND
	BR	2$			;NOW AT LOAD POINT
1$:	BIT	#20000,QSTAT+2		;SEE IF TAPE IS AT LOAD POINT
	BEQ	SKIBL1			;NO, SO SKIP 3 BLOCKS
2$:	MOV	#4,R3			;SKIP 4 BLOCKS
	BR	N
SKIBL1:	MOV	#3,R3			;SKIP 3 BLOCKS
N:	MOV	#IO.SPB,SKQIO+Q.IOFN
M:	DIR$	#SKQIO,DIRERR
	JSR	PC,QIOERR
	SOB	R3,M			;SHOULD WE SKIP ANOTHER BLOCK?
	RTS	PC
SKQIO:	QIOW$	IO.SPB,1,24,,QSTAT,,<1>
;
;***********************************************************************
; QIOERR IS USED BY SMS AND BSS TO CHECK FOR ERRORS
;
QIOERR:	CMPB	#IS.SUC,QSTAT		;SEE IF QIO SUCCESSFUL
	BNE	2$			;IF SO RESET END OF
	MOV	#0,CHEOV		;VOLUME CHECK TO 0
	RTS	PC
2$:	CMPB 	#IE.EOF,QSTAT		;SEE IF END OF FILE
	BNE	5$			;IF NOT CHECK FOR OTHER ERRORS
	ADD	#1,CHEOV		;ADD 1 TO E.O.V. CHECK
	CMP	#2,CHEOV		;SEE IF E.O.V.
	BEQ	4$
	RTS	PC
4$:	JSR	PC,EOV			;IF E.O.V. JUMP TO EOV SUB-ROUTINE
5$:	CMPB	#IE.EOT,QSTAT		;SEE IF END OF TAPE
	BNE	8$
	JSR	PC,EOT			;IF SO GOTO EOT SUBROUTINE
8$:	CMPB	#IE.EOV,QSTAT		;SEE IF E.O.V. ERROR IN QSTAT
	BNE	6$
	JSR	PC,EOV			;IF SO GOTO EOV SUB-ROUTINE
6$:	JMP 	ERROR			;IF NONE OF ABOVE ERRORS WRITE
					;AN ERROR MESSAGE
;
;
;******************************************************************
; DFS IS A SUB-ROUTINE WHICH MAKES SURE THAT THE DEFAULT SWITCH
; SWITCH VALUE IS VALID (I.E. A F OR N)
;
;
DFS:	CMP	#106,SASC	;SEE IF IT IS AN F
	BNE	1$		;IF NOT SEE IF IT IS AN N
	JMP	BEG		;IF SO RETURN TO CALLING SECTION
1$:	CMP	#116,SASC	;SEE IF IT IS AN N
	BNE	2$		;IF NOT WRITE ERROR MESSAGE
	JMP	BEG		;IF SO RETURN TO CALLING SECTION
2$:	MOV	#2,QSTAT	;INCORRECT SWITCH VALUE SO
	JMP	ERROR		;WRITE ERROR MESSAGE
;
;****************************************************************
;CS IS THE SUBROUTINE WHICH TAKES CARE OF PARSING INPUT AND OUTPUT 
;FILES AND ASSIGNING A LOGICAL UNIT NUMBER TO THE CORRECT TAPE DRIVE
;BY WAY OF THE SUBROUTINE ASLUN.
;
;
CS:	BITB	CSIBLK+C.STAT,#CS.EQU	;SEE IF COMMAND LINE HAS = SIGN
	BEQ	1$			;IF NO EQUAL SIGN PARSE OUTPUT FILE
	BR	2$			;IF = SIGN PARSE INPUT
1$:	JSR	PC,OUTPUT		;PARSE OUTPUT FILE
	JSR	PC,ASLUN		;ASSIGN L.U.N. 1 TO PROPER TAPE DRIVE
	MOV	#C3,FDOUT+F.DSPT	;DEFAULT OUTPUT FILE TO RAT.DMP
	RTS	PC			;RETURN TO CALLING SECTION
2$:	CSI2	#CSIBLK,INPUT,#TABLE,CS2ERR	;PARSE INPUT FILE
	JSR	PC,ASLUN		;ASSIGN L.U.N. 1 TO PROPER TAPE DRIVE
	MOV	#CSIBLK+C.DSDS,FDOUT+F.DSPT
					;SET FDB TO USER DEFINED FILE
	MOV	CSIBLK+C.MKW1,-(SP)	;SAVE THE MASK WORD
	JSR	PC,OUTPUT		;PARSE OUTPUT FILE
	MOV	(SP)+,CSIBLK+C.MKW1	;RETURN MASK WORD TO PROPER VALUE
	RTS	PC			;RETURN TO CALLING SECTION
;
;
;******************************************************************
;OUTPUT IS A SUBROUTINE USED BY THE SUBROUTINE CS TO PARSE OUTPUT FILES
;
OUTPUT:	CSI2	#CSIBLK,OUTPUT,#TABLE,CS2ERR
	RTS	PC
;
;*********************************************************************
;ZES IS A SUBROUTINE WHICH IS RESPONSIBLE FOR REWINDING THE TAPE 
;AND THEN WRITING 3 TAPE MARKS AT THE BEGINNING OF IT
;
;
ZES:	JSR	PC,RWS		;JUMP TO REWIND SUBROUTINE
3$:	MOV 	#3,SVAL		;SUBSTITUTE A 3 FOR THE SWITCH VALUE
	JSR	PC,WTS		;WRITE 3 TAPE MARKS
5$:	JSR	PC,RWS		;REWIND TAPE
	RTS	PC		;RETURN TO MAIN PROGRAM
;
;****************************************************************
;RUS IS A SUBROUTINE WHICH IS RESPONSIBLE FOR REWINDING
;THE TAPE AND TAKING IT OFF-LINE
;
;
RUS:	MOV	#IO.RWU,Q+Q.IOFN	;MOV REWIND AND UNLOAD INSTRUC.
					;TO QIO
	DIR$	#Q,DIRERR		;EXECUTE QIO
	CMPB	#IS.SUC,QSTAT		;SEE IF QIO WAS SUCCESSFUL
	BEQ	1$			;IF SUCCESS RETURN TO CALLING SECTION
	JSR	PC,ERROR		;IF QIO FAILED PRINT ERROR MESSAGE
1$:	RTS	PC			;RETURN TO MAIN PROGRAM
;
;********************************************************************
;RWS IS A SUBROUTINE RESPONSIBLE FOR REWINDING THE TAPE
;
;
RWS:	MOV	#IO.RWD,Q+Q.IOFN	;MOV REWIND INSTRUCT.TO QIO
	DIR$	#Q,DIRERR		;EXECUTE QIO
	CMPB	#IS.SUC,QSTAT		;SEE IF SUCCESSFUL
	BEQ 	1$
	JSR	PC,ERROR		;IF UNSUCESSFUL PRINT ERROR MESSAGE
1$:	CMP	#127,SRWA		;SEE IF WAIT FOR REWIND
	BEQ	2$
	RTS	PC			;IF NOT RETURN
2$:	CLR	SRWA			;IF SO CLEAR REWIND FLAG
	BR	RWS			;AND QUE ANOTHER REWIND REQUEST
;
;****************************************************************
;WTS IS A SUBROUTINE WHICH WRITES N TAPE MARKS, WHERE N IS THE 
;SWITCH VALUE SPECIFIED
;
;
WTS:	MOV	#IO.EOF,Q+Q.IOFN	;MOVE WRITE FILE MARK INSTUCTION
					;TO QIO
	TST	SVAL			;SEE IF SVAL IS POSITIVE
	BPL	1$
	NEG 	SVAL			;IF SVAL NEGATIVE THEN CHANGE IT
1$:	DIR$	#Q,DIRERR		;EXECUTE REWIND QIO
	CMPB	#IS.SUC,QSTAT		;SEE IF QIO IS SUCCESSFUL
	BEQ	3$
	JSR	PC,ERROR		;IF UNSUCESSFUL WRITE A ERROR MESSAGE
3$:	SUB	#1,SVAL			;SHOULD WE REPEAT LOOP?
	BGT	1$			;IF R3 > 0 THEN WE SHOULD
	RTS	PC			;IF R3 <= 0 THEN WE ARE DONE
;
;***********************************************************************
;SFS IS A SUBROUTINE RESPNSIBLE FOR SPACING N FILES FOWARD, WHERE
;N IS THE SWITCH VALUED SPECIFIED
;
;
SFS:	MOV	#IO.SPF,Q+Q.IOFN;MOV SPACE FILE INSTRUC. TO QIO
	JSR	PC,SSBS		;MAKE NECCESSARY ADJUSTMENTS TO SVAL AND Q.IOPL
	CMP	#106,SASC	;SEE IF TAPE IS FILE STRUCTERED
	BNE	1$		;IF NOT DON'T SKIP ANY BLOCKS
5$:	JSR	PC,DIRQIO	;IF IT IS THEN SKIP A FILE
1$:	JSR	PC,DIRQIO	;EXECUTE QIO AND CHECK FOR ERRORS
	CMP	#106,SASC	;SEE IF TAPE FILE STRUCTERED
	BNE	9$		;IF NOT DON'T SKIP NEXT 2 BLOCKS
	JSR	PC,DIRQIO	;IF IT IS THEN SKIP
9$:	SUB	#1,SVAL		;SHOULD WE REPEAT LOOP?
	BGT	3$		;IF SVAL > 0 YES
	RTS	PC		;OTHERWISE WE ARE DONE
3$:	CMP	#106,SASC	;SEE IF TAPE FILE STRUCTERED
	BEQ	5$		;IF SO SKIP HEADER
	BR	1$		;IF NOT JUST SPACE A FILE
;
;***************************************************************************
; SSBS IS USED BY SFS AND SBS TO MAKE NECESSARY ADJUSTMENTS TO SVAL AND
; Q.IOFN
;
SSBS:	TST	SVAL			;SEE IF SWITCH VALUE IS + OR -
	BPL	2$			;IF + LEAVE IT AS IT IS
	NEG	SVAL			;IF SVAL NEGATIVE CHANGE IT TO +
	MOV	#-1,Q+Q.IOPL		;CHANGE QIO PARAMETER TO -1
	RTS	PC			;AND WE ARE DONE
2$:	MOV	#1,Q+Q.IOPL		;IF SVAL = +,THEN MAKE QIO PARAMETER +1
	RTS	PC			;AND WE ARE DONE
;
;******************************************************************
; DIRQIO IS USED BY SFS AND SBS TO EXECUTE THE QIO AND CHECK FOR
; ERRORS
;
DIRQIO:	DIR$	#Q,DIRERR		;EXECUTE QIO
	CMPB	#IS.SUC,QSTAT		;SEE IF QIO EXECUTED SUCCESSFULLY
	BEQ	5$			;IF SO RETURN
	JSR	PC,ERROR		;IF QIO NOT SUCESSFUL FIND OUT WHY
5$:	RTS 	PC
;
;******************************************************************
;SBS IS A SUBROUTINE WHICH SPACES N BLOCKS, WHERE N
;IS THE SWITCH VALUE SPECIFIED
;
SBS:	MOV	#IO.SPB,Q+Q.IOFN	;MOV SPACE BLOCK TO QIO
	JSR	PC,SSBS			;MAKE NECESSARY ADJUSTMENTS
2$:	JSR	PC,DIRQIO		;EXECUTE QIO AND CHECK FOR ERRORS
	SUB	#1,SVAL			;SEE IF WE SHOULD REPEAT LOOP
	BGT	2$			;IF SVAL > 0 WE SHOULD
	RTS	PC			;OTHERWISE WE ARE DONE
;
;**************************************************************************
; SES IS A SUB-ROUTINE WHICH PRINTS TO THE USER TERMINAL, THE TAPE
; CHARACTERISTIC WORD AS AN OCTAL VALUE
;
SES:	MOV	#IO.SEC,SKQIO+Q.IOFN	;MOV SENSE TAPE CHARACTERISTICS TO QIO
	DIR$	#SKQIO,DIRERR		;EXECUTE QIO
	CMPB	#IS.SUC,QSTAT		;SEE IF QIO WAS SUCCESSFUL
	BEQ	1$			;IF SO CONTINUE
	JMP	ERROR			;OTHER WISE PRINT AN ERROR MESSAGE
1$:	MOV	#SWXX,R0		;MOVE LOOKUP TABLE ADRESS TO R0
	PCRLF				;LEAVE A BLANK LINE ON THE TERMINAL
LAB:	ROR	QSTAT+2			;SEE WHICH BITS ARE SET
	BCC	IN			;IF BIT NOT SET THEN SEE IF WE'RE DONE
	PCRLF				;BIT SET SO LEAVE BLANK
	TTYOUT	(R0),#25.		;AND WRITE OUT MESSAGE
IN:	CMP	QSTAT+2,#0		;ANY MORE MESSAGES TO BE WROTE?
	BNE	1$			;YES, SO REPEAT PROCESS
	PCRLF				;LEAVE A BLANK LINE
	RTS	PC			;RETURN TO CALLING SECTION
1$:	TST	(R0)+			;MOVE R0 ONE DOWN LOOKUP TABLE
	CLC				;CLEAR BIT SO WE DON'T REDO
	JMP	LAB			;REPEAT PROCESS
SW01:	.ASCII	/TU10: 556 BPI DENSITY    /	;MESSAGES
SW02:	.ASCII	/TU10: 200 BPI DENSITY    /
SW03:	.ASCII	/TU10: CORE DUMP MODE     /
SW04:	.ASCII	/EVEN PARITY-DEFAULT ODD  /
SW05:	.ASCII	/TAPE IS PAST EOT         /
SW06:	.ASCII	/LAST CMD. ENCTR'D EOF    /
SW07:	.ASCII	/WRITING IS PROHIBITED    /
SW08:	.ASCII	/NO WRITING WITH EXT'D IRG/
SW09:	.ASCII	/SELECT ERROR             /
SW10:	.ASCII	/UNIT IS REWINDING        /
SW11:	.ASCII	/TAPE IS WRITE LOCKED     /
SW12:	.ASCII	/TU16: 1600 BPI DENSITY   /
SW13:	.ASCII	/TU10: 7 CHANNEL          /
SW14:	.ASCII	/TAPE IS AT LOAD PT.      /
SW15:	.ASCII	/TAPE IS AT EOV           /
	.EVEN
SWXX:	.WORD	SW01			;MESSAGE LOOKUP TABLE
	.WORD	SW02
	.WORD	SW03,SW04,SW05,SW06,SW07,SW08
	.WORD	SW09,SW10,SW11,SW12,SW13,SW14,SW15
;
;
;************************************************************************** 
;SCS IS A SUBROUTINE RESPONSIBLE FOR SETTING TAPE CHARACTERISTICS
;
;
SCS:	MOV	#IO.STC,Q+Q.IOFN	;MOV SET CHARATERISTICS COMMAND TO QIO
	MOV	SVAL,Q+Q.IOPL		;PUT SWITCH VALUE IN PARAMETER LIST
	DIR$	#Q,DIRERR		;EXECUTE QIO
	CMPB	#IS.SUC,QSTAT		;SEE IF QIO WAS SUCCESSFUL
	BEQ	1$
	JSR	PC,ERROR		;IF NOT SUCCESSFUL WRITE ERROR MESSAGE
1$:	JMP	SES			;SUCESS SO TELL HIM CHARACTERISTICS
;
;***********************************************************************
; OPEN IS A SUBROUTINE WHICH IS USED BY THE SUBROUTINES SMS AND BSS TO
; OPEN A OUTPUT FILE
;
OPEN:	MOV 	#ABLK+A.LUNA,R1		;FIND OUT
	MOV	#HEDDEV+11,R2		;WHICH TAPE DRIVE IS BEING
9$:	MOVB	(R1)+,(R2)+		;IS BEING USED AND PREPARE
	MOVB	(R1)+,(R2)+		;TO WRITE IT AT THE TOP OF THE
	MOVB	(R1),R1			;OUTPUT FILE
	ADD	#60,R1
	MOVB	R1,(R2)
8$:	OPEN$W	#FDOUT,,,,,,IOERR	;OPEN THE OUTPUT FILE
	MOV	#HEDDEV,NAM		;WRITE DEVICE NAME
	MOV	#14,NUM			;AT THE TOP OF THE FILE
	JSR	PC,PUT
	MOV	#HEAD1,NAM
	JSR	PC,PUT
	MOV	#HEAD2,NAM
	JSR	PC,PUT
	RTS	PC			;RETURN TO CALLING SECTION
;
;***********************************************************************
;SMS IS A SUBROUTINE WHICH DOES A SUMMARY OF THE NUMBER OF FILES
;AND THE NUMBER OF BLOCKS IN EACH FILE,FROM THE PRESENT TAPE POSITION
;TO THE SPECIFIED POINT. I.E. THE SWITCH /SM:3 WOULD DO A SUMMARY FOR
;THE NEXT THREE FILES. IF NO SWITCH VALUE IS SPECIFIED THEN THE
;SUMMARY GO TO THE END OF THE VOLUME.
;
SMS:	MOV	#1,SMSTST		;SET FLAG INDICATING SMS HAS BEEN CALLED
	JSR 	PC,OPEN			;OPEN THE OUTPUT FILE
	MOV	#1,Q+Q.IOPL		;PREPARE SPACE BLOCK QIO
	MOV	#IO.SPB,Q+Q.IOFN
	TST	SVAL			;SEE IF SVAL IS POSITIVE
	BPL	7$			;IF SO LEAVE IT AS IT IS
	NEG	SVAL			;IF NOT, MAKE IT POSITIVE
7$:	MOV	#HEAD,NAM		;WRITE HEADER FOR
	MOV	#32.,NUM		;THE COLUMNS 
	JSR	PC,PUT			;AND THEN UNDERLINE 
	MOV	#HEAD1,NAM		;THE HEADER
	JSR	PC,PUT			;AND THEN
	MOV	#HEAD2,NAM		;LEAVE A BLANK LINE
	JSR	PC,PUT
	CMP	#106,SASC		;SEE IF IT IS A FILE STRUCTERED TAPE
	BNE	1$			;IF IT ISN'T THEN DON'T SKIP ANY BLOCKS
	JSR	PC,SKIBLK		;IF IT IS THEN SKIP 3 BLOCKS IF AT BOT
1$:	DIR$	#Q,DIRERR		;EXECUTE SPACE BLOCK QIO
	JSR	PC,QIOERR		;SEE IF THERE WAS AN ERROR
	CMPB	#IS.SUC,QSTAT		;IF SUCESS THEN REPEAT LOOP
	BNE	8$
	ADD	#1,BLKCNT		;IF SUCESS ADD 1 TO THE BLOCK COUNT
	BR	1$
8$:	ADD 	#1,FILCNT		;IF THE QIO WAS NOT SUCESSFUL THEN
	MOV	FILCNT,R1		;WE MUST BE AT E.O.F. OTHERWISE
	MOV	#F,R0			;WE WOULD NOT HAVE RETURNED FROM
	MOV	#40,CHAR		;QIOERR, SO ADD 1 TO FILE COUNT
	JSR	PC,JUST			;AND RIGHT JUSTIFY IT WITH BLANKS
	MOV	BLKCNT,R1		;DO ASCII CONVERSION
	MOV	#B,R0			;OF THE NUMBER OF BLOCKS
	MOV	#56,CHAR		;AND RIGHT JUSTIFY THEM
	JSR	PC,JUST			;WITH PERIODS
	MOV	#F,NAM			;WRITE FILE NUMBER AND NO. OF BLOCKS
	JSR	PC,PUT			;IN FILE TO OUTPUT FILE
	ADD	BLKCNT,C3		;KEEP TOTAL OF NO. OF BLOCKS IN C3
	MOV	#0,BLKCNT		;RESET BLOCK COUNTER TO ZERO
	CMP	#106,SASC		;SEE IF TAPE IS FILE STRUCTERED
	BNE	3$			;IF NOT CONTINUE AS NORMAL
	JSR	PC,SKIBL1		;IF SO SKIP NECESSARY NO. OF BLOCKS
3$:	TST	SVAL			;SEE IF WE SHOULD CONTINUE
	BEQ	2$			;TILL END OF VOLUME
	SUB	#1,SVAL			;IF NOT, SEE IF WE HAVE
	BGT	2$			;SPACED ENOUGH FILES
5$:	JMP 	CLFILE			;IF WE HAVE CLOSE THE OUTPUT FILE
2$:	CMP	#106,SASC		;IS TAPE FILE STRUCTERED?
	BNE	1$			;NO, THEN PROCESS NEXT FILE
	JSR	PC,SKIBL1		;YES, THEN SKIP THE FILE HEADER
	BR	1$			;AND THEN PROCESS THE FILE
;
;*********************************************************************
; CLFILE IS A SUBROUTINE USED BY BSS AND SMS TO WRITE A SUMMARY AT
; THE BOTTOM OF THE OUTPUT FILE AND THEN CLOSE THE OUTPUT FILE
;
CLFILE:	MOV	#HEAD2,NAM		;WRITE 2 BLANK LINES
	JSR	PC,PUT
	JSR	PC,PUT
	MOV	C3,R1			;THEN WRITE THE TOTALS
	MOV	#D2,R0			;OF BLOCKS 
	MOV	#40,CHAR		;AND FILES, RIGHT JUSTIFYING BOTH
	JSR	PC,JUST			; WITH BLANKS
	MOV	FILCNT,R1
	MOV	#D3,R0
	JSR	PC,JUST
	MOV	#D1,NAM
	MOV	#40.,NUM
	JSR	PC,PUT
	MOV	#HEAD1,NAM		;THEN UNDERLINE THE STATEMENT
	JSR	PC,PUT
	CMP	#1,SMSTST		;SEE IF CLFILE WAS CALLED FROM CMS
	BEQ	9$			;IF SO DON'T SHRINK
	JSR	PC,SHRINK		;OTHERWISE SHRINK TO ORIGINAL SIZE
9$:	CLOSE$	#FDOUT,IOERR		;CLOSE THE OUTPUT FILE
	JMP	DIE1			;AND RESET VALUES USED IN SMS AND BSS
;
;****************************************************************************
; THIS SECTION IS CERTAIN BLOCKS NEEDED BY SMS AND/OR BSS
;
C3:	.WORD	0			;USED FOR BLOCK COUNT TOTALING
BLKCNT:	.WORD	0			;USED FOR COUNTING BLOCKS
FILCNT:	.WORD	0			;USED FOR COUNTING FILES
CHEOV:	.WORD	0			;USED TO CHECK FOR END OF VOLUME
	.BLKW	2
SMSTST:	.WORD	0			;FLAG USED BY SMS
BSSTST:	.WORD	0			;FLAG USED BY BSS
CHAR:	.WORD 	0			;PADDING CHARACTER USED BY JUST
HEAD:	.ASCII	/ FILE                    BLOCKS /	;VARIOUS MESSAGES 
HEAD1:	.ASCII	/*************************************************/;WRITTEN
HEAD2:	.ASCII	/                                /	;TO THE OUTPUT FILE
EOVMSG:	.ASCII	/******END OF VOLUME*************/
EOTMSG:	.ASCII	/********END OF TAPE*************/
	.EVEN
F:	.BLKB	6
	.ASCII	/..................../
B:	.BLKB	6
D1:	.ASCII	/A TOTAL OF /
D2:	.BLKB	6
	.ASCII	/ BLOCKS IN /
D3:	.BLKB	6
	.ASCII	/ FILES/
	.EVEN
HEDDEV:	.ASCII	/DEVICE =               /
	.EVEN
;
;**********************************************************************
;JUST IS A SUBROUTINE WHICH CONVERTS A BINARY NUMBER INTO ITS EQUVALENT
;DECIMAL ASCII FORM AND THEN RIGHT JUSTIFYS THE NUMBER IN A 5 CHARARACTER
;FIELD,PRECEDING THE JUSTIFIED NUMBER WITH THE CHARACTER SPECIFIED IN 
; THE WORD CHAR.
;
JUST:	MOV	#1,R2		;CONVERT NUMBER WITH LEADING ZEROS
	MOV	R0,R4
	CALL	$CBDMG
	MOV	#1,R2		;KEEP R2 AS A COUNTER
2$:	ADD	#1,R2
	CMP	#6,R2		;SEE IF WE ARE AT FIFTH FEILD
	BEQ	1$		;IF SO STOP
	CMPB	#60,(R4)	;SEE IF A 0 IS AT THIS SPOT
	BNE	1$		;IF NOT STOP
	MOVB	CHAR,(R4)	;IF SO REPLACE 0 BY CHAR
	TSTB	(R4)+		;INCREMENT R4 TO NEXT BYTE
	BR	2$		;REPEAT THE LOOP
1$:	RTS	PC
;
;***********************************************************
; PUT IS A SUBROUTINE WHICH WRITES A RECORD TO THE OUTPUT FILE
;
PUT:	PUT$	#FDOUT,NAM,NUM,IOERR
	RTS	PC
	NAM:	.WORD	0
	NUM:	.WORD	0
;
;*************************************************************
; VOL IS A SUB-ROUTINE WHICH FINDS THE NAME OF THE TAPE IF IT IS FILE 
; STRUCTURED,OR WRITES AN ERROR MESSAGE THAT IT IS NOT FILE STRUCTURED
; IF IT IS NOT
;
VOL:	JSR	PC,RWS		;MAKE SURE WE'RE AT BEGINNING OF TAPE
	JSR	PC,STRECH	;MAKE ENOUGH ROOM IN INPUT BUFFER
	DIR$	#Q4,DIRERR	;NOW READ VOLUME HEADER(?)
	CMPB	#IS.SUC,QSTAT	;SEE IF QIO SUCCESSFUL
	BEQ	3$		;IF SO CONTINUE
	CMPB	#IE.DAO,QSTAT	;SEE IF DATA OVERFLOW, AND IF SO IT
	BEQ	4$		;WRITE AN ERROR MESSAGE SINCE IT IS OBVIOUSLY NOT
				;FILE STRUCTERED
	CMPB	#IE.BBE,QSTAT	;SEE IF BAD BLOCK READ
	BEQ	3$		;IF SO CONTINUE
	JSR	PC,ERROR	;IF NONE OF ABOVE 3 FIND WHAT WENT WRONG
3$:	MOV	#3,R2		;INITIALIZE REGISTERS TO COMPARE CHARACTERS
	MOV	#DUMP,R0
	MOV	#V,R1
1$:	CMPB	(R0)+,(R1)+	;COMPARE THE CHARACTERS
	BEQ	2$		;IF THEY'RE EQUAL,SKIP AROUND THIS
4$:	JSR	PC,SHRINK	;  THEY'RE NOT EQUAL REDUCE TASK SIZE
	JSR	PC,RWS		;REWIND THE TAPE
	MOV	#10,QSTAT	;  LOAD ERROR CODE
	JSR	PC,ERROR	;  AND GIVE HIM HIS ERROR
2$:	SOB	R2,1$		;THE CHARACTERS MATCHED,CHECK NEXT ONES
	TSTB	(R0)+		;ALL THE CHARS. MATCHED, SKIP THE BLANK
	PSTR	^*<CR><LF>/  VOLUME:/*
	TTYOUT	R0,#6		;AND PRINT THE VOLUME HEADER
	JSR	PC,SHRINK	;REDUCE THE TASK SIZE
	JSR	PC,RWS		;REWIND THE TAPE
	RTS	PC		;AND WE'RE DONE
V:	.ASCII	/VOL/
	.EVEN
;
;********************************************************************
; BSS IS A SUBROUTINE THAT SPACES N FILES, WHERE N IS THE SWITCH 
; VALUE SPECIFIED (IF NO VALUE SPECIFIED THEN GO TO END OF TAPE (SAME
; APPLIES TO SUB. SMS)) AND PRINTS OUT FILE BY FILE THE BLOCKS AND
; NO. OF BYTES IN EACH BLOCK
;
BSS:	MOV	#1,BSSTST		;SET FLAG INDICATING BSS WAS CALLED
	JSR	PC,OPEN			;OPEN THE FILE
	CMP	#106,SASC		;SEE IF TAPE IS FILE STRUCTERED
	BNE	7$
	JSR	PC,SKIBLK		;IF SO SKIP 3 BLOCKS IF AT B.O.T.
7$:	JSR	PC,STRECH		;EXPAND INPUT BUFFER
	TST	SVAL			;SEE IF SWITCH VALUE IS +
	BPL	4$			;IF SO, LEAVE IT +
	NEG	SVAL			;IF NOT, MAKE IT +
4$:	DIR$	#Q4,DIRERR		;EXECUTE QIO
	MOV	#RETAB,R2		;LOOK UP SUB-ROUTINE TO
	MOV	#SBTB,R3		;GOTO ACCORDING TO THE OUTCOME OF
3$:	CMPB	(R2)+,QSTAT		;THE QIO
	BEQ	5$
	CMPB	(R2),#7			;IF UNEXPECTED OUTCOME THEN
	BEQ	5$			;WRITE ERROR MESSAGE
	TST	(R3)+
	BR	3$
5$:	JSR	PC,@(R3)		;HAVE FOUND SUB-ROUTINE,SO GO TO IT
	BR	4$			;REPEAT PROCEDURE
;
;********************************************************************
; SUC IS USED BY BSS WHEN A SUCESSFUL COMPLETION OF IT'S QIO OCCURS
;
SUC:	ADD	#1,BLKCNT		;ADD 1 TO THE BLOCK COUNT
	CMP	#1,BLKCNT		;SEE IF IT IS FIRST BLOCK IN THIS FILE
	BNE	1$			;IF NOT CONTINUE
	ADD	#1,FILCNT		;IF SO, ADD 1 TO THE FILE COUNT
	JSR	PC,HEDD			;AND WRITE OUT THE HEADING
1$:	MOV	#0,CHEOV		;RESET END OF VOLUME CHECK TO 0
	MOV	#F,R0			;WRITE THE BLOCK
	MOV	BLKCNT,R1		;NUMBER, AND
	MOV	#40,CHAR		; BYTE COUNT IN
	JSR	PC,JUST			;THE OUTPUT FILE
	MOV	#B,R0
	MOV	QSTAT+2,R1
	MOV	#56,CHAR
	JSR	PC,JUST
	MOV	#F,NAM
	MOV	#32.,NUM
	JSR	PC,PUT
	RTS	PC			;RETURN TO CALLING SECTION
;
;*******************************************************************
; EOF IS USED BY BSS WHEN AN END OF FILE IS ENCOUNTERED
;
EOF:	ADD	BLKCNT,C3		;KEEP TOTAL NUMBER OF BLOCKS IN C3
	MOV	#0,BLKCNT		;RESET BLOCK COUNT TO 0
	ADD	#1,CHEOV		;INCREASE END OF VOLUME CHECKER BY ONE
	CMP 	#2,CHEOV		;IF CHEOV=2 THEN WE HAVE REACHED E.O.V.
	BNE	3$			;OTHERWISE CONTINUE
	JSR	PC,EOV			;IF E.O.V. GOTO E.O.V. ROUTINE
3$:	CMP	#106,SASC		;SEE IF TAPE IS FILE STRUCTERED
	BNE	5$
	JSR	PC,SKIBL1		;IF SO THEN SKIP NECESSARY BLOCKS
5$:	TST	SVAL			;SEE IF SWITCH VALUE=0
	BEQ	8$			;IF SO, DO NEXT FILE
	SUB	#1,SVAL			;IF NOT, SUBTRACT 1 FROM SVAL
	BGT	8$			;IF SWITCH VALUE > 0, THEN DO NEXT FILE
	JMP	CLFILE			;OTHERWISE WE ARE DONE
8$:	CMP	#106,SASC		;IS TAPE FILE STRUCTERED?
	BNE	6$			;NO, THEN PROCESS NEXT FILE
	JSR	PC,SKIBL1		;YES, THEN SKIP FILE HEADER
6$:	RTS	PC			;AND PROCESS FILE
;
;************************************************************************
; EOT IS USED BY SMS AND BSS AND SKIBLK WHEN AN END OF TAPE IS ENCOUNTERED
;
EOT:	JSR	PC,RWS		;REWIND THE TAPE
	MOV	#HEAD2,NAM	;WRITE END OF TAPE MESSAGE
	JSR	PC,PUT		;AT THE BOTTOM OF THE OUT PUT
	JSR	PC,PUT		;FILE
	MOV	#EOTMSG,NAM
	MOV	#32.,NUM
	JSR	PC,PUT
	JMP	CLFILE		;CLOSE THE FILE
;
;******************************************************************
; EOV IS USED BY BSS,SMS, AND SKIBLK WHEN AN END OF VOLUME IS ENCOUNTERED
;
EOV:	JSR	PC,RWS		;REWIND THE TAPE
	MOV	#HEAD2,NAM	;WRITE END OF VOLUME MESSAGE 
	JSR	PC,PUT		;AT BOTTOM OF OUTPUT FILE
	JSR	PC,PUT
	MOV	#EOVMSG,NAM
	MOV	#32.,NUM
	JSR	PC,PUT
	JMP	CLFILE		;CLOSE THE FILE
;
;**********************************************************************
; DAO IS USED BY BSS WHEN PRESENT BUFFER SIZE IS TO SMALL TO ACCOMADATE
; THE BLOCK
;
DAO:	MOV	SVAL,-(SP)		;SAVE THE PRESENT SWITCH VALUE
	MOV 	#-1,SVAL		;SPACE BACK A BLOCK
	JSR	PC,SBS
	JSR	PC,STRECH		;INCREASE BUFFER SIZE 1300 BYTES
	MOV	(SP)+,SVAL		;RESTORE SWITCH VALUE
	RTS	PC			;AND TRY AGAIN
;
;*********************************************************************
; BBE IS USED BY BSS WHEN A BAD BLOCK IS ENCOUNTERED
;
BBE:	MOVB	#52,F+20		;PUT *  I.E. (BLOCK.......*......BYTE)
	JSR	PC,SUC			;DO SAME AS FOR A SUCCESS
	MOVB	#56,F+20		;MOVE . BACK IN PLACE OF *
	RTS	PC
;
;********************************************************************
; SHRINK IS USED BY BOTH VOL AND BSS TO SHRINK TASK BACK TO ITS
; ORIGINAL SIZE
;
SHRINK:	NEG 	CNT 	;MAKE EXTENSION COUNTER NEGATIVE
	MOV	CNT,R1	;MULTIPLY NUMBER OF EXTENSIONS BY
	MUL	GROW+E.XTIN,R1	;NUMBER OF BLOCKS EXPANDED EACH
	MOV	R1,GROW+E.XTIN	;EACH EXTENSION
	DIR$	#GROW,DIRERR	;SHRINK BACK TO SIZE
	MOV	#0,Q4+Q.IOPL+2	;RESET BUFFER SIZE TO 0
	MOV	#0,CNT		;RESET EXTENSION COUNTER TO 0
	MOV	#20,GROW+E.XTIN	;RESET BLOCK EXTENSION TO 20
	RTS 	PC
;
;***************************************************************************
; STRECH IS USED BY VOL AND BSS TO EXTEND THE TASK SIZE 
;
STRECH:	DIR$	#GROW,DIRERR		;EXTEND TASK
	ADD	#1300,Q4+Q.IOPL+2	;INCREASE BUFFER SIZE
	ADD	#1,CNT			;ADD 1 TO EXTENSION COUNTER
	RTS	PC
;
;*************************************************************************
; HEDD IS USED BY BSS TO WRITE OUT FILE HEADERS
;
HEDD:	MOV	#3,NUM		;WRITE 2 BLANK LINES
	MOV	#HEAD2,NAM
	JSR	PC,PUT
	JSR	PC,PUT
	MOV	FILCNT,R1	;WRITE CURRENT FILE NUMBER
	MOV	#FEFIFO+6,R0
	MOV	#40,CHAR
	JSR 	PC,JUST
	MOV	#FEFIFO,NAM
	MOV	#13,NUM
	JSR	PC,PUT
	MOV	#HEAD1,NAM	;UNDERLINE FILE HEADER
	JSR	PC,PUT
	MOV	#HEAD2,NAM
	JSR	PC,PUT
	MOV	#PHUC,NAM	;WRITE COLUMN HEADERS
	MOV	#40,NUM
	JSR	PC,PUT
	MOV	#HEAD1,NAM	;UNDERLINE COLUMN HEADERS
	JSR	PC,PUT
	RTS	PC
;
;*************************************************************************
; THESE ARE BLOCKS AND I/O OPERATIONS USED BY BSS
;
GROW:	EXTK$	20			;EXTEND THE TASK
Q4:	QIOW$	IO.RLB,1,24,,QSTAT,,<DUMP,0> ;READ A LOGICAL BLOCK
RETAB:	.BYTE	IS.SUC			;QIO STATUS LOOKUP TABLE
	.BYTE	IE.EOF
	.BYTE	IE.EOT
	.BYTE	IE.EOV
	.BYTE	IE.DAO
	.BYTE	IE.BBE
	.BYTE	7
	.EVEN	
SBTB:	.WORD	SUC			;SUB-ROUTINE LOOKUP TABLE
	.WORD	EOF
	.WORD	EOT
	.WORD	EOV
	.WORD	DAO
	.WORD	BBE
	.WORD	ERROR
FEFIFO:	.ASCII	/FILE       /	;VARIOUS MESSAGES WRITTEN TO THE OUTPUT FILE
PHUC:	.ASCII	/BLOCK                      BYTES/
	.EVEN
CNT:	.WORD 	0		;CNT IS THE EXTENSION COUNTER
	.END 	START