.TITLE	TAPE
	.IDENT	/01.01/
	.NLIST	BEX
;
; COPYRIGHT   1978,  DEC PARIS
;
; THIS SOFTWARE IS FURNISHED TO PURCHASER UNDER A LICENSE FOR USE
; ON A  SINGLE COMPUTER SYSTEM AND CAN BE  COPIED (WITH INCLUSION
; OF DEC'S COPYRIGHT  NOTICE) ONLY FOR USE IN SUCH SYSTEM, EXCEPT
; AS MAY OTHERWISE BE PROVIDED IN WRITING BY DEC.
;
; THE  INFORMATION  IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT
; NOTICE  AND  SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DEC.
;
; DEC  ASSUMES NO  RESPONSIBILITY  FOR  THE  USE  OR  RELIABILITY
; OF  ITS  SOFTWARE ON  EQUIPMENT WHICH  IS  NOT SUPPLIED BY DEC.
;
;	AUTHOR:	D. MACRE
;
;	DATE:	JAN-78
;
;	COMMENT:
;
 ;THIS TASK IS INVOKED VIA MCR COMMAND "TAP" TO READ MAGTAPES WHOSE
; FORMAT IS UNKNOWN. (TO PIP OR FLX)
;

;		MCR>TAP "FILE SPECIFICATION" /SWITCHES=MXN: /SWITCHES
;		MCR>TAP MXN: /SWITCHES
;
; WHERE:
;	"FILE SPEC" IS AN OPTIONAL OUTPUT FILE
;
;	MXN: IS
;	 	MTN: IF TU10
;	        MMN: IF TU16
;
;	INPUT SWITCHES:
;		/LI LIST ON TERMINAL BLOCK SIZES IN BYTES
;		    BLOCK 1	=	 80
;		    BLOCK 2	=	1024
;		    ....
;		/FU FULL LIST OPTION . LIST ON TERMINAL BLOCK SIZES AND 
;		    CONTENT OF BLOCKS (80 CHAR PER LINE).
;		/EB:N1:M1:N2:M2 .... SPECIFIES FIELDS WHERE
;		    TO PERFORM EBCDIC TO ASCII CONVERSION .
;		    (NO SWITCH IS DEFAULT AND MEANS CONVERT WHOLE RECORD).
;		    WHERE N1,N2 ... SPECIFY EBCDIC FIELD POSITION IN BYTES 
;		      FROM 1 TO LENGTH
;		    WHERE M1,M2 ... SPECIFY FIELD LENGTH IN BYTES
;		      FROM 1 TO LENGTH
;		    NO VALUE MEANS ALL RECORD IS TO BE CONVERTED.
;		/BL:N:M SPECIFIES BLOCK LIMITS ON TAPES
;		    (DEFAULT IS ALL BLOCKS TIL EOT)
;		/FI:N SPECIFIES FILE ON TAPE (1 TO N)
;		/FX:N:M (SEE OUTPUT SWITCHES)
;		/PE SPECIFIES PHASE ENCODED (1600 BPI)
;		    TU16 ONLY
;		/LI AND /FU SHOULD NOT BE SPECIFIED WHEN AN OUTPUT FILE
;		    IS SPECIFIED.
;		/LI AND /FU ARE EXCLUSIVE.
;		/BL AND /FI ARE EXCLUSIVE.
;
;	OUTPUT SWITCHES:
;
;		/TR REMOVE TRAILING SPACES IN EACH RECORD
;		/CO FILE IS TO BE CONTIGUOUS (DEFAULT IS NO)
;		/AP RECORDS ARE TO BE APPEND AT THE END OF AN
;		    EXISTING FILE (DEFAULT IS NO) .
;		/FX:N:M FIXED RECORDS OF SIZE EQUAL TO N BYTES, TRUNCATED TO M BYTES.
;		    (DEFAULT IS VARIABLE = TO BLOCK SIZE)
;		/CR INDICATES CARRIAGE RETURN FORMAT WHEN CREATING
;		    A NEW OUTPUT FILE (DEFAULT).
;		/SB INDICATES THAT INPUT RECORDS SPAN BLOCK BOUNDARIES
;
;  Modified by:-
;
;        Phil Stephensen-Payne,
;        c/o Systime Ltd.,
;        Concourse Computer Centre,
;        432 Dewsbury Road,
;        LEEDS LS11 7DF,
;        England.
;
	.PAGE
	.SBTTL	MCALLS AND MACRO DEFINITIONS
;
;
;
	.MCALL	GCMLB$,GCMLD$,GCML$,SPWN$,DIR$		; for GCML
	.MCALL	EXIT$S,QIO$S,WTSE$,WTSE$S,GMCR$,DIR$,QIO$,ALUN$S,ALUN$
	.MCALL	CSI$,CSI$SW,CSI$SV,CSI$1,CSI$2,CSI$ND
	.MCALL	FDBDF$,FDAT$A,FDRC$A,FDOP$A,FDBF$A,FINIT$
	.MCALL	OPEN$,PUT$,CLOSE$,FSRSZ$
;
	.MACRO	MESS TASK,TEXT,ER
	.PSECT	MESS
$$$=	.
	.WORD	0
	.ASCII	/TASK --/
	.ASCII	/ TEXT/
$$$2=	.
	.IF NB ER
	.ASCII	/      /
	.ENDC
$$$1=	.
.=	$$$
	$$$1-$$$-2
.=	$$$1
	.EVEN
	.PSECT	MESTAB
	$$$
	.PSECT	MESER
	$$$2
	.PSECT	CODE
	.ENDM
	.PAGE
	.SBTTL	FILE DEFINITION
	.PSECT	IMPURE
;
;
;
FILFDB:	FDBDF$				; DEFINE FDB
	FDAT$A	R.VAR			; VARIABLE IS DEFAULT
	FDRC$A	FD.PLC			; 
	FDOP$A	FILUN,CSIBLK+C.DSDS,,FO.WRT
	FDBF$A	,,1
;
	FSRSZ$	2,20000
	.PSECT	$$FSR1
TAPBUF=	.-20000
TAPLEN=	20000
	.PAGE
	.SBTTL	CSI DEFINITION
	.PSECT	IMPURE
;
;
;
GCMBLK:	GCMLB$	1,TAP,,CMDLUN
	CSI$
	.EVEN
CSIBLK:	.BLKB	C.SIZE
	.EVEN
;
;	SWITCH TABLES
;
ISWTBL:				; INPUT SWITCHES
	CSI$SW	LI,LIMSK,MASKI,SET
	CSI$SW	FU,FUMSK,MASKI,SET
	CSI$SW	BL,BLMSK,MASKI,SET,,BLVTBL
	CSI$SW	FI,FIMSK,MASKI,SET,,FIVTBL
	CSI$SW	EB,EBMSK,MASKI,SET,,EBVTBL
	CSI$SW	PE,PEMSK,MASKI,SET,NEG
	CSI$SW	FX,FXMSK,MASK,SET,,FXVTBL
	CSI$SW	TR,TRMSK,MASK,SET
	CSI$SW	SB,SBMSK,MASK,SET
	CSI$SW	HE,HEMSK,MASK,SET	; Help
	CSI$ND
;
OSWTBL:				; OUTPUT SWITCHES
	CSI$SW	CO,COMSK,MASKO,SET
	CSI$SW	AP,APMSK,MASKO,SET
	CSI$SW	CR,CRMSK,MASKO,SET
	CSI$SW	FX,FXMSK,MASK,SET,,FXVTBL
	CSI$SW	TR,TRMSK,MASK,SET
	CSI$SW	HE,HEMSK,MASK,SET	; Help
	CSI$ND
;
; SWITCH MASKS DEFINITION
;
LIMSK=	1				; /LI 
FUMSK=	2				; /FU
BLMSK=	4				; /BL
FIMSK=	10				; /FI
EBMSK=	20				; /EB
PEMSK=	40				; /PE
SBMSK=	100				; /SB
;
COMSK=	1				; /CO
APMSK=	2				; /AP
CRMSK=	4				; /CR
;
FXMSK=	1				; /FX
TRMSK=	2				; /TR
HEMSK= 4				; /HE
; MASKS 
;
MASKI:	.WORD	PEMSK			; INPUT MASK(PE SET)
MASKO:	.WORD	0			; OUTPUT MASK
MASK:	.WORD	0			; INPUT/OUTPUT MASK
;
; SWITCH VALUE TABLE
;
BLVTBL:
	CSI$SV	DECIMAL,FIRBLK,5
	CSI$SV	DECIMAL,LASBLK,5
	CSI$ND
FIVTBL:
	CSI$SV	DECIMAL,FILVAL,3
	CSI$ND
FXVTBL:
	CSI$SV	DECIMAL,RECLEN,4
	CSI$SV	DECIMAL,RECOUT,4
	CSI$ND
EBNUM=	20			; MAX # OF FIELDS
EBVTBL:
$$$=	0
	.REPT	EBNUM*2
	.IRP	N,<\$$$>
	CSI$SV	DECIMAL,EBVAL+'N',4
	.ENDR
$$$=	$$$+2
	.ENDR
	CSI$ND
EBVAL:
	.WORD	-1
	.WORD	0
	.REPT	EBNUM
	.WORD	0
	.WORD	0
	.ENDR
;	SWITCH INCOMPATIBILITY TABLE FOR INPUT SWITCHES
IEXTBL:
	.WORD	22		; EXCLUSION WITH /LI
	.WORD	1		; EXCLUSION WITH /FU
	.WORD	10		; EXCLUSION WITH /BL
	.WORD	4		; EXCLUSION WITH /FI
	.WORD	1		; EXCLUSION WITH /EB
	.WORD	0		; EXCLUSION WITH /PE
MAXISW=	14				; MAX INPUT SWITCHES
	.PAGE
	.SBTTL LOCAL STORAGE AND DEFINITIONS
	.PSECT	IMPURE
;
;
;
SPACE=	40
TAB=	11
TTYLUN=	1
TTYEFN=	1
TAPLUN=2
TAPEFN=2
FILUN=3
CMDLUN=4
;
ERCOD:	.WORD	0			; ERROR CODE
ERSTS:	.WORD	0			; STATUS ERROR
FIRBLK:	.WORD	1			; FIRST BLOCK (DEFAULT IS 1)
LASBLK:	.WORD	32767.			; LAST BLOCK (DEFAULT IS MAX)
CURBLK:	.WORD	0			; CURRENT BLOCK 
TAPTYP:	.ASCII	/MT/			; DEFAULT IS TU10
TAPUNI:	.WORD	0			; MAGTAPE UNIT #
TAPSTA:	.BLKW	2.			; STATUS FOR TAPE PROCESSING 
OUTPUT:	.WORD	0			; 0= NO OUTPUT(DEFAULT)  1= OUTPUT
RECLEN:	.WORD	0			; RECORD LENGTH IN BYTES
RECOUT:	.WORD	0			; OUTPUT RECORD LENGTH IN BYTES
FILVAL:	.WORD	0			; FILE # VALUE
FILCNT:	.WORD	1			; CURRENT FILE COUNT
DS1600:	.WORD	0			; 0=DON'T DO ANYTHING 0
					; 1=SET 1600 BPI
					; 2=SET 800 BPI
RECBUF:	.BLKB	512.			; RECORD BUFFER
RECPNT:	.WORD	RECBUF			; POINTER IN RECORD BUFFER
;
HLSPWN:	SPWN$	MCR...,,,,,1,,,HELCMD,HELCML
HELCMD:	.ASCII	/HELP TAP/
HELCML=.-HELCMD
	.EVEN
EOFMSG:	.ASCII	/**EOF**/
	EOFMSL=.-EOFMSG
	.EVEN
BLKMSG:	.ASCII	/BLOCK # /
BLKNUM:	.ASCII	/     /
	.ASCII	/ SIZE= /
BLKSIZ:	.ASCII	/     /
	BLKMSL=.-BLKMSG
	.EVEN
	.PSECT	MESTAB
MSGS=	.
	.PSECT	MESER
MSER=	.
	.PSECT	CODE
	.PAGE
	.SBTTL COMMAND DECODING
	.PSECT	CODE
;
;
;
START:
	ALUN$S	#CMDLUN,#"TI,#0	; Assign prompt lun to TI:
;
GETCMD:
	MOV	#CRMSK,MASKO		; Set /CR as default
	MOV	#PEMSK,MASKI		; Initialise other masks
	MOV	#-1,EBVAL	; Initialize EBCDIC fields
	CLR	ERSTS		; Initialize status error
	MOV	#1,FIRBLK	; Set default first block
	MOV	#32767.,LASBLK	; Set default last block
	CLR	CURBLK		; Initialize current block
	CLR	OUTPUT		; Initialise output flag
	CLR	TAPSTA		; Initialize tape status
	CLR	TAPSTA+2	;
	CLR	RECLEN		; Clear record sizes
	CLR	RECOUT		;
	CLR	FILVAL		; Initialize file counts
	MOV	#1,FILCNT	;
	CLR	DS1600		; set BPI field
	MOV	#RECBUF,RECPNT	; Initialize record pointer
	CLR	ERCOD		; Initialise error code
	CLR	MASK		;
	GCML$	#GCMBLK	 	; Get Command Line
	BCC	30$		; If CC OK - carry on
	CMPB	#GE.EOF,G.ERR(R0) ; Was it an end-of-file?
	BEQ	10$		; If EQ yes - terminate program
	CMPB	#GE.OPR,G.ERR(R0)	; Invalid command file?
	BNE	10$		; If NE no - carry on
	JMP	240$		; Syntax error
;
10$:
	EXIT$S			; That's all
;
30$:
	MOV	G.CMLD+2(R0),R1	; Command start
	MOV	G.CMLD(R0),R2	; And length
	BEQ	GETCMD		; If not there, Re-Prompt
	MOV	R2,R3			; SAVE LENGTH
	MOV	R1,R4			; AND ADDRESS
50$:	CMPB	(R4)+,#'=		; IS THERE AN =?
	BNE	60$			; IF NE, NO
	INC	OUTPUT			; SAY OUTPUT SPECIFIED
	BR	70$
60$:	SOB	R3,50$
; COMMAND DECODING
70$:	CSI$1	#CSIBLK,R1,R2		; COMMAND ANALYSIS
	BCS	80$			; IF CS, SYNTAX ERROR
	TST	OUTPUT			; OUTPUT SPECIFIED?
	BNE	90$			; IF NE , YES
	CSI$2	#CSIBLK,OUTPUT,#ISWTBL	; ...
	BCC	100$			; IF CC, OK
80$:	JMP	240$			; SYNTAX ERROR
90$:	CSI$2	#CSIBLK,INPUT,#ISWTBL	; ...
	BCS	80$
100$:	BIT	#HEMSK,MASK	; Help switch?
	BEQ	105$		; If EQ no - process normally
	DIR$	#HLSPWN		; Yes - ask for help
	WTSE$S	#1		; Wait for it to finish
	JMP	GETCMD		; Get next line
;
105$:
	MOV	#CSIBLK+C.DSDS+2,R0	; GET MXN: ADDRESS
	MOV	(R0),R1
	CMPB	(R1)+,#'M		; IS IT MT OR MM?
	BNE	80$			; IF NE, NO
	MOVB	(R1),TAPTYP+1		;
	CMPB	(R1),#'T		; IS IT MT?
	BNE	110$			; 
	MOV	#CSIBLK+C.MKW2,R2	; /PE SPECIFIED WITH MT:?
	BIT	#PEMSK,(R2)		; ...?
	BNE	80$			; IF EQ, YES
	BIT	#PEMSK,MASKI		; /-PE SPECIFIED WITH MT:?
	BEQ	80$			; IF EQ, YES(ERROR)
	BR	130$			; OK
110$:	CMPB	(R1),#'M		; IS IT MM?
	BNE	80$			; SYNTAX ERROR
	MOV	#CSIBLK+C.MKW2,R2	; /PE SPECIFIED WITH MM:?
	BIT	#PEMSK,(R2)		; ...?
	BNE	120$			; IF NE, YES
	BIT	#PEMSK,MASKI		; /-PE SPECIFIED WITH MM:?
	BNE	130$			; IF NE, NO
	INC	DS1600			; SAY 800 BPI
120$:	INC	DS1600			; SAY 800 BPI MORE
130$:	TSTB	(R1)+
	CMPB	(R1),#':		; IS IT :?
	BEQ	140$			; IF EQ , ASSUME UNIT IS 0
	MOVB	(R1),TAPUNI		; PUT UNIT #
	SUB	#60,TAPUNI		; ...
; INPUT SWITCHES EXCLUSION ANALYSIS
140$:	MOV	#1,R3			; INITIALIZE MASK
	CLR	R4			; INIT TABLE POINTER
150$:	BIT	R3,MASKI		; SWITCH PRESENT?
	BEQ	160$			; IF EQ, NO
	BIT	IEXTBL(R4),MASKI	; ANY EXCLUSION INCOMPATIBILITY?
	BNE	80$			; YES
160$:	ASL	R3			; NEXT BIT IN MASK
	ADD	#2,R4
	CMP	R4,#MAXISW		; END OF ANALYSIS?
	BNE	150$
	TST	OUTPUT			; OUTPUT SPECIFIED?
	BEQ	190$			; IF EQ, NO
	CSI$2	#CSIBLK,OUTPUT,#OSWTBL	; ...
	BCC	170$			; IF CC,OK
	JMP	240$			; SYNTAX ERROR
;
170$:
	BIT	#LIMSK,MASKI		; /LI SPECIFIED?
	BNE	240$			; IF NE, YES (SYNTAX ERROR)
	BIT	#FUMSK,MASKI		; /FU SPECIFIED?
	BNE	240$			; IF NE, YES (SYNTAX ERROR)
	MOV	#FILFDB,R0		; GET FDB ADDRESS
	BIT	#APMSK,MASKO		; /AP SPECIFIED?
	BEQ	180$			; IF EQ, NO
	MOVB	#FO.APD,F.FACC(R0)	; OPEN FOR APPEND
180$:	BIT	#COMSK,MASKO		; /CO SPECIFIED?
	BEQ	190$			; IF EQ, NO
	MOV	#10,F.CNTG(R0)		; SAY FILE IS CONTIGUOUS
190$:	BIT	#FXMSK,MASK		; /FX SPECIFIED?
	BEQ	220$			; IF EQ, NO
	BIT	#TRMSK,MASK		; /TR SPECIFIED?
	BNE	200$			; IF NE YES - VARIABLE AFTER ALL
	MOVB	#R.FIX,F.RTYP(R0)	; SAY FIXED RECORDS
200$:	TST	RECOUT			; OUTPUT SIZE GIVEN?
	BNE	210$			; IF NE YES - CARRY ON
	MOV	RECLEN,RECOUT		; NO - DEFAULT TO INPUT SIZE
;
210$:
	MOV	RECOUT,F.RSIZ(R0)	; AND SIZE
;
;	SWITCH VALUES ANALYSIS
;
220$:	TST	FIRBLK			;  SWITCH VALUES ANALYSIS
	BLE	240$			; ... 
	CMP	LASBLK,FIRBLK		; ...
	BLT	240$			; ...
	MOV	#EBNUM,R1		; GET # OF FIELDS
	MOV	#EBVAL,R0		; POINT TO EB TABLE
230$:	DEC	(R0)			; DEC POSITION
	ADD	(R0)+,(R0)		; COMPUTE END OF FIELD
	DEC	(R0)+			; ...
	SOB	R1,230$
	BR	PROC			; BRANCH TO PROCESS THE TAPE
; SYNTAX ERROR
240$:	MOV	#2,ERCOD		; SYNTAX ERROR
	CALL	ERROR			; Log an error
	JMP	GETCMD			; and go again
	.PAGE
	.SBTTL	TAPE PROCESSING
;
;
;
PROC:
	FINIT$				; INIT FCS
	MOV	#FILFDB,R0		; GET FILE FDB
	TST	OUTPUT			; OUTPUT SPECIFIED?
	BEQ	10$			; IF EQ, NO
	BIT	#CRMSK,MASKO		; /CR SPECIFIED?
	BEQ	5$			; IF EQ, NO
	BISB	#FD.CR,F.RATT(R0)	; SET CR FORNAT
5$:	OPEN$
	BCC	10$
	MOV	#4,ERCOD		; SAY FILE PROCESSING ERROR
	MOVB	F.ERR(R0),R0		; ...
	MOV	R0,ERSTS		; ...
	CALL	ERROR			; Log an error
	JMP	GETCMD			; and go again
10$:	MOV	#TAPBUF,F.NRBD+2(R0)
	MOV	#TAPALN,R0		; GET DPB ADDR.
	MOV	TAPTYP,A.LUNA(R0)	; PUT TAPE TYPE
	MOV	TAPUNI,A.LUNU(R0)	; ... .... UNIT
	DIR$	#TAPALN			; ASSIGN LUN TO MAGTAPE
	BCC	20$			; IF CC, OK
	MOV	#10,ERCOD		; TAPE PROCESSING ERROR
	MOVB	TAPSTA,R0		; ...
	MOV	R0,ERSTS		; ...
	CALL	ERROR			; Log an error
	JMP	GETCMD			; and go again
20$:	DIR$	#TAPATT			; ATTACH TAPE
	DIR$	#TAPWAIT
	TST	DS1600			; 
	BEQ	25$			; =0, NOTHING TO DO
	CMP	DS1600,#1		; =1?
	BNE	22$			; IF NE, 800BPI
	MOV	#4000,TAPSTC+Q.IOPL	; SAY 1600 BPI
22$:	DIR$	#TAPSTC			; SET SPECIFIED BPI
	DIR$	#TAPWAIT
	BIC	#PEMSK,MASKI		; CLEAR /PE BIT IN MASKI
	TST	MASKI			; OTHER INPUT SWITCHES?
	BNE	25$
	CALL	ERROR			; Log an error
	JMP	GETCMD			; and go again
25$:	DIR$	#TAPRWD			; REWIND TAPE
	DIR$	#TAPWAIT		; WAIT FOR COMPLETION
	BCC	30$
	MOV	#10,ERCOD		; TAPE PROCESSING ERROR
	MOVB	TAPSTA,R0		; ...
	MOV	R0,ERSTS		; ...
	CALL	ERROR			; Log an error
	JMP	GETCMD			; and go again
30$:	MOV	#FILFDB,R0		; POINT TO FILE FDB
	MOV	#TAPBUF,F.NRBD+2(R0)	; PUT POINTER
	INC	CURBLK			; INCREMENT CURRENT BLOCK
	CMP	CURBLK,LASBLK		; COMPARE WITH LAST
	BLE	35$
	CALL	ERROR			; Log an error
	JMP	GETCMD			; and go again
35$:	TST	FILVAL			; /FI SPECIFIED?
	BEQ	36$			; IF EQ, NO
	CMP	FILCNT,FILVAL		; FILE REACHED?
	BLT	37$			; IF LT, NO
	BR	39$
36$:	CMP	CURBLK,FIRBLK		; PROCESSING REQUIRED?
	BLT	37$			; IF LT, NO
39$:	DIR$	#TAPQIO			; READ NEXT BLOCK ON TAPE
	BR	38$
37$:	DIR$	#TAPSKP			; SKIP BLOCK
38$:	DIR$	#TAPWAIT		; WAIT FOR COMPLETION
	TSTB	TAPSTA			; SUCCESSFUL?
	BPL	80$			; IF PL ,YES
	CMPB	TAPSTA,#IE.EOT		; END OF PHISICAL TAPE?
	BNE	40$			; NO
	MOV	#12,ERCOD		; YES, SAY IT
	CALL	ERROR			; Log an error
	JMP	GETCMD			; and go again
40$:	CMPB	TAPSTA,#IE.EOV		; END OF VOLUME?
	BNE	50$			; IF NE, NO
	MOV	#14,ERCOD		; SAY IT
	CALL	ERROR			; Log an error
	JMP	GETCMD			; and go again
50$:	CMPB	TAPSTA,#IE.EOF		; END OF FILE?
	BEQ	60$			; IF EQ,YES
	MOV	#10,ERCOD		; SAY TAPE PROCESSING ERROR
	MOVB	TAPSTA,R0		; ...
	MOV	R0,ERSTS		; ...
	CALL	ERROR			; Log an error
	JMP	GETCMD			; and go again
60$:	INC	FILCNT			; SAY ONE MORE FILE
80$:	TST	FILVAL			; FILE # SPECIFIED?
	BEQ	85$			; IF EQ, NO
	CMP	FILCNT,FILVAL		;  FILE?
	BLT	30$			; NOT REACHED
	BEQ	90$			; GO PROCEED IT
	CALL	ERROR			; Log an error
	JMP	GETCMD			; and go again
85$:	CMP	CURBLK,FIRBLK		; PROCESSING REQUIRED?
	BLT	30$			; IF LT, NO
90$:	BIT	#EBMSK,MASKI		; /EB SPECIFIED?
	BEQ	95$			; IF EQ, NO
	CALL	EBCAS			; CONVERT IN ASCII
95$:	TST	OUTPUT			; OUTPUT SPECIFIED?
	BNE	200$
;
;	COMMAND IS "TAP MXN: /SWITCHES" LIKE
;
100$:	CMPB	TAPSTA,#IE.EOF		; EOF?
	BNE	105$			; IF NE, NO
	MOV	#EOFMSG,TIQIO+Q.IOPL
	MOV	#EOFMSL,TIQIO+Q.IOPL+2
	DIR$	#TIQIO			; PRINT EOF MESSAGE
	DIR$	#TIWAIT			; WAIT FOR COMPLETION
	JMP	30$
105$:	MOV	CURBLK,R1		; CONVERT BLOCK #
	MOV	#BLKNUM,R0		; IN ASCII
	MOV	#1,R2			; WITH LEADING ZEROS
	CALL	$CBDMG			; IN MESSAGE
	MOV	TAPSTA+2,R1		; CONVERT BLOCK SIZE
	MOV	#BLKSIZ,R0		; IN ASCII
	MOV	#1,R2			; WITH LEADING ZEROS
	CALL	$CBDMG			; IN MESSAGE
	MOV	#BLKMSG,TIQIO+Q.IOPL	;
	MOV	#BLKMSL,TIQIO+Q.IOPL+2
	DIR$	#TIQIO			; PRINT BLOCK MESSAGE ON TI:
	DIR$	#TIWAIT			; WAIT FOR COMPLETION
	BIT	#LIMSK,MASKI		; /LI SPECIFIED?
	BEQ	106$			; IF EQ , YES
	JMP	30$
106$:	MOV	#TAPBUF,R0		; POINT TO BEG OF BLOCK
	MOV	TAPSTA+2,R1		; GET BLOCK SIZE
	MOV	#80.,R3			; ASSUME 80 CHAR PER LINR
	BIT	#FXMSK,MASK		; /FX SPECIFIED
	BEQ	110$			; IF EQ, NO
	CMP	RECLEN,#80.		; RECORD SMALLER THAN *)
	BGE	110$			; IF GE, NO
	MOV	RECLEN,R3
110$:	MOV	R0,TIQIO+Q.IOPL		;
	MOV	R1,R2			; SAVE R1
	CMP	R1,R3			; LINE SHORTER THAN SPECIFIED LENGTH?
	BLT	115$			; IF GT, NO
	MOV	R3,R2			;
115$:	MOV	R2,TIQIO+Q.IOPL+2	;
	DIR$	#TIQIO			; PRINT LINE
	DIR$	#TIWAIT			; WAIT FOR COMPLETION
	ADD	R2,R0			;
	SUB	R2,R1
	BGT	110$
	JMP	30$
;
;	COMMAND IS "TAP OUTPUT/SWITCHES=MXN:/SWITCHES" LIKE
;
200$:	MOV	#FILFDB,R0		; GET FFD ADDR.
	MOV	#TAPBUF,R3		; POINT TO BLOCK BUFFER
	MOV	TAPSTA+2,R1		; GET SIZE
210$:	MOV	R3,F.NRBD+2(R0)
	MOV	R1,R2
	MOV	R2,F.NRBD(R0)		; INITIALISE RECORD OUTPUT SIZE
	BIT	#FXMSK,MASK		; /FX SPECIFIED?
	BEQ	2155$			; IF EQ,NO
	CMP	RECPNT,#RECBUF		; ALREADY HALF-WAY THROUGH A RECORD?
	BEQ	214$			; IF EQ NO - SEE IF GOT WHOLE RECORD
	MOV	R0,-(SP)		; YES - SAVE FDB
	MOV	RECLEN,R0		; GET RECORD LENGTH
	ADD	#RECBUF,R0		; AND HENCE GET AMOUNT LEFT TO GET
	SUB	RECPNT,R0		;
	CMP	R0,R2			; ENOUGH IN THIS BLOCK?
	BLE	212$			; IF LE YES - GET IT AND CARRY ON
	MOV	RECPNT,R0		; NO - SET ADDRESS TO STORE FROM
	BR	2140$			; AND GET WHAT WE CAN
;
212$:
	MOV	R0,R2			; WE'RE ONLY TAKING WHAT WE NEED
	MOV	R2,-(SP)		; SAVE SOME MORE REGISTERS
	MOV	R3,-(SP)		;
	MOV	RECPNT,R0		; GET ADDRESS TO STORE REST FROM
;
213$:
	MOVB	(R3)+,(R0)+		; COPY A BYTE OVER
	SOB	R2,213$			; AND SO ON
	MOV	(SP)+,R3		; RESTORE THE REGISTERS
	MOV	(SP)+,R2		;
	MOV	(SP)+,R0		;
	MOV	#RECBUF,RECPNT		; RESET BUFFER POINTER
	MOV	#RECBUF,F.NRBD+2(R0)	; RECORD COMES FROM RECORD BUFFER
	BR	215$			; OUTPUT IT
;
214$:
	CMP	RECLEN,R2		; ENOUGH IN BLOCK FOR WHOLE RECORD?
	BLE	2145$			; IF LE YES - GO GET IT
	CMP	RECLEN,#512.		; NO - CAN WE BUFFER INTERNALLY?
	BGT	2145$			; IF GT NO - TOUGH
	MOV	#RECBUF,RECPNT		; INITIALISE POINTER
	BIT	#SBMSK,MASKI		; RECORDS SPAN BLOCKS?
	BEQ	220$			; IF EQ NO - GET NEXT BLOCK
	MOV	R0,-(SP)		; SAVE THE FDB
	MOV	#RECBUF,R0		; GET ADDRESS TO STORE RECORD AT
;
2140$:
	MOV	R2,-(SP)		; SAVE SOME MORE REGISTERS
	MOV	R3,-(SP)		;
;
2143$:
	MOVB	(R3)+,(R0)+		; STORE NEXT BYTE
	SOB	R2,2143$		; AND SO ON
	MOV	R0,RECPNT		; STORE CURRENT BUFFER ADDRESS
	MOV	(SP)+,R3		; RESTORE THE REGISTERS
	MOV	(SP)+,R2		;
	MOV	(SP)+,R0		;
	BR	220$			; AND GET THE NEXT BLOCK
;
2145$:
	MOV	RECLEN,R2		; PUT RECORD LENGTH
;
215$:
	MOV	RECOUT,F.NRBD(R0)	; RESET OUTPUT SIZE
;
2155$:
	BIT	#TRMSK,MASK		; /TR SPECIFIED?
	BEQ	218$			; IF EQ NO - LEAVE AS IS
	MOV	R3,-(SP)		; YES - SAVE A REGISTER
	MOV	F.NRBD+2(R0),R3		; GET RECORD ADDRESS (JUST IN CASE)
	ADD	F.NRBD(R0),R3		; SET JUST PAST THE END
;
216$:
	CMPB	-(R3),#' 		; TRAILING SPACE?
	BNE	217$			; IF NE NO - OUTPUT WHAT'S LEFT
	DEC	F.NRBD(R0)		; YES - DISCOUNT IT
	CMP	R3,F.NRBD+2(R0)		; END OF BUFFER?
	BGT	216$			; IF GT NO - TRY NEXT ONE
;
217$:
	MOV	(SP)+,R3		; RESTORE REGISTER
	TST	F.NRBD(R0)		; ANYTHING IN RECORD?
	BLE	220$			; IF LE NO - OMIT IT
218$:
	PUT$				; PUT RECORD TO FILE
	BCC	220$			; IF CC, OK
	MOV	#6,ERCOD		; RECORD PROCESSING ERROR
	MOVB	F.ERR(R0),R0		; ...
	MOV	R0,ERSTS		; ...
	CALL	ERROR			; Log an error
	JMP	GETCMD			; and go again
220$:	ADD	R2,R3
	SUB	R2,R1
	BGT	210$
	JMP	30$
	.PAGE
	.SBTTL	ERROR ERROR PROCESSING
;
;
;
ERROR:
	DIR$	#TAPDET			; DETACH TAPE
	DIR$	#TAPWAIT
5$:	TST	OUTPUT			; FILE OPENED?
	BEQ	10$
	MOV	#FILFDB,R0
	CLOSE$
10$:	TST	ERCOD
	BEQ	100$			; IF EQ, NO
	MOV	ERCOD,R1
	MOV	MSGS-2(R1),R3		; GET MESSAGE ADDRESS
	MOV	(R3)+,R4		; LENGTH
	TST	ERSTS			; FILE ERROR
	BEQ	20$			; IF EQ, NO
	MOV	MSER-2(R1),R0
	MOV	ERSTS,R1
	MOV	#1,R2
	CALL	$CBOMG
20$:	QIO$S	#IO.WLB,#TTYLUN,#TTYEFN,,,,<R3,R4,#40>; PRINT IT
	DIR$	#TIWAIT			; WAIT FOR PRINT COMPLETION
100$:	RETURN
	.PAGE
	.SBTTL	DPB DEFINITIONS
	.PSECT	IMPURE
;
;
;
MCRDPB:	GMCR$				; GET MCR COMMAND LINE
;
TIQIO:	QIO$	IO.WLB,TTYLUN,TTYEFN,,,,<.-.,.-.,40>; PRINT ON TI:
;
TIWAIT:	WTSE$	TTYEFN			; WAIT FOR PRINT COMPLETION
;
TAPQIO:	QIO$	IO.RLB,TAPLUN,TAPEFN,,TAPSTA,,<TAPBUF,TAPLEN>; READ BLOCK
TAPSTC:	QIO$	IO.STC,TAPLUN,TAPEFN,,TAPSTA,,<0>; SET SPECIFIED BPI
;
TAPATT:	QIO$	IO.ATT,TAPLUN,TAPEFN,,TAPSTA
TAPDET:	QIO$	IO.DET,TAPLUN,TAPEFN,,TAPSTA
;
TAPRWD:	QIO$	IO.RWD,TAPLUN,TAPEFN,,TAPSTA
;
TAPWAIT:WTSE$	TAPEFN
;
TAPSKP:	QIO$	IO.SPB,TAPLUN,TAPEFN,,TAPSTA,,<1>
;
TAPALN:	ALUN$	TAPLUN,MX,0		; ASSIGN LUN TO MXN:
;
	.SBTTL	ERRORS MESSAGES
	.PSECT MESS
;
;
;
	MESS	<TAP>,<COMMAND SYNTAX ERROR>
	MESS	<TAP>,<FILE PROCESSING ERROR: >,ER
	MESS	<TAP>,<RECORD PROCESSING ERROR: >,ER
	MESS	<TAP>,<TAPE PROCESSING ERROR: >,ER
	MESS	<TAP>,<END OF TAPE>
	MESS	<TAP>,<END OF VOLUME>
	.PAGE
	.SBTTL CONVERSION ROUTINES
	.PSECT	CODE
;
;
;
;	CONVERSION ROUTINE  EBCDIC--->ASCII
;
EBCAS:	
	MOV	#TAPBUF,R0	; POINT TO BUFFER
	CLR	R3		; CLEAR CHARACTER COUNT
	TST	RECLEN		; /FX SPECIFIED?
	BGT	5$		; IF GT, YES
	MOV	TAPSTA+2,RECLEN ; ASSUME RECLEN IS BLOCK
5$:	CLR	R5		; CLEAR CHARACTER COUNT IN RECORD
	CLR	R1
10$:	CMP	R3,TAPSTA+2	; CONVERSION TERMINATED ?
	BPL	20$		; IF PL, YES.
	MOVB	(R0),R4		; BYTE IN BUFFER
	CMP	EBVAL(R1),#-1	; NO MORE EBCDIC FIELD?
	BLT	12$		; IF LT , ALL RECORD IS EBCDIC
	BEQ	15$		; IF EQ, LAST FIELD ENCOUNTERED
	CMP	R5,EBVAL(R1)	; CHAR BELONGS TO FIELD?
	BLT	15$		; IF LT , NO
	CMP	R5,EBVAL+2(R1)	; ...
	BGT	14$		; IF GT, NO
12$:	BIC	#177400,R4	; CLEAR LEFT BYTE
	ADD	#TEBCAS,R4	; POINT TO TABLE 
	MOVB	(R4),R4		; GET CHARACTER
	BIC	#177400,R4	; CLEAR LEFT BYTE
	BR	15$
14$:	ADD	#4,R1		; POINT TO NEXT FIELD IN EBVAL
15$:	MOVB	R4,(R0)+	; PUT ASCII CHARACTER
	INC	R3
	INC	R5
	CMP	R5,RECLEN	;
	BLT	10$
	BR	5$
20$:	RETURN
 
TEBCAS:	
	.REPT	64.
	.BYTE	136	;^
	.ENDR
	.BYTE	40	;SP
	.REPT	10.
	.BYTE	136	;^
	.ENDR
	.BYTE	56	;.
	.BYTE	74	;<
	.BYTE	50	;(
	.BYTE	53	;+
	.BYTE	136	;^
	.BYTE	46	;&
	.REPT	9.
	.BYTE	136	;^
	.ENDR
	.BYTE	41	;!
	.BYTE	44	;$
	.BYTE	52	;*
	.BYTE	51	;)
	.BYTE	73	;;
	.BYTE	136	;^
	.BYTE	55	;-(MINUS)
	.BYTE	57	;/
	.REPT	9.
	.BYTE	136	;^
	.ENDR
	.BYTE	54	;,
	.BYTE	45	;%
	.BYTE	137	;_
	.BYTE	76	;>
	.BYTE	77	;?
	.REPT	10.
	.BYTE	136	;^
	.ENDR
	.BYTE	72	;:
	.BYTE	43	;#
	.BYTE	100	;@
	.BYTE	47	;'
	.BYTE	75	;=
	.BYTE	42	;"
	.BYTE	136	;^
	.BYTE	141	;A *** MINUSCULES: ***
	.BYTE	142	;B
	.BYTE	143	;C
	.BYTE	144	;D
	.BYTE	145	;E
	.BYTE	146	;F
	.BYTE	147	;G
	.BYTE	150	;H
	.BYTE	151	;I
	.REPT	7.
	.BYTE	136	;^
	.ENDR
	.BYTE	152	;J
	.BYTE	153	;K
	.BYTE	154	;L
	.BYTE	155	;M
	.BYTE	156	;N
	.BYTE	157	;O
	.BYTE	160	;P
	.BYTE	161	;Q
	.BYTE	162	;R
	.REPT	8.
	.BYTE	136	;^
	.ENDR
	.BYTE	163	;S
	.BYTE	164	;T
	.BYTE	165	;U
	.BYTE	166	;V
	.BYTE	167	;W
	.BYTE	170	;X
	.BYTE	171	;Y
	.BYTE	172	;Z
	.REPT	23.
	.BYTE	136	;^
	.ENDR
	.BYTE	101	;A *** MAJUSCULES: ***
	.BYTE	102	;B
	.BYTE	103	;C
	.BYTE	104	;D
	.BYTE	105	;E
	.BYTE	106	;F
	.BYTE	107	;G
	.BYTE	110	;H
	.BYTE	111	;I
	.REPT	6.
	.BYTE	136	;^
	.ENDR
	.BYTE	175	;}
	.BYTE	112	;J
	.BYTE	113	;K
	.BYTE	114	;L
	.BYTE	115	;M
	.BYTE	116	;N
	.BYTE	117	;O
	.BYTE	120	;P
	.BYTE	121	;Q
	.BYTE	122	;R
	.REPT	8.
	.BYTE	136	;^
	.ENDR
	.BYTE	123	;S
	.BYTE	124	;T
	.BYTE	125	;U
	.BYTE	126	;V
	.BYTE	127	;W
	.BYTE	130	;X
	.BYTE	131	;Y
	.BYTE	132	;Z
	.REPT	6.
	.BYTE	136	;^
	.ENDR
	.BYTE	60	;0
	.BYTE	61	;1
	.BYTE	62	;2
	.BYTE	63	;3
	.BYTE	64	;4
	.BYTE	65	;5
	.BYTE	66	;6
	.BYTE	67	;7
	.BYTE	70	;8
	.BYTE	71	;9
	.REPT	6.
	.BYTE	136	;^
	.ENDR
	.END	START