.TITLE	EBCDIC UNLABLED-TAPE TRANSFER PROGRAM
.IDENT	/V01/
.MCALL	FSRSZ$,FDBDF$,FDAT$R,FDRC$A,FDOP$A,FINIT$
.MCALL	GCMLB$,GCML$,CSI$,CSI$1,CSI$2
.MCALL	OPEN$W,PUT$,CLOSE$
.MCALL	QIO$C,WTSE$C,ALUN$C,EXIT$C,QIO$S
;
; CITY OF GAINESVILLE, INFORMATION SYSTEMS DIVISION
;
; MARK WESTON 30-JAN-81
;
; MODIFIED BY:
;
; PURPOSE:
;	THIS PROGRAM IS USED TO TRANSFER FILES FROM UNLABLED EBCDIC TAPES
;
; EQUATED SYMBOLS
;
DBLUN	=	2		;DISK I/O LUN
MAXBLK	=	11700.		;MAXIMUM BLOCK SIZE
MAXREC	=	300.		;MAXIMUM RECORD SIZE
;
; LOCAL MACROS
;
.MACRO	NOERR	ARG1,ARG2	;MACRO TO CHECK IF EXEC CALL SUCCESSFUL
;
	BCC	ARG1		;BRANCH IF EXEC CALL OK
	MOV	#"ARG2,ERRM	;ELSE SET UP ERROR MESSAGE
	JMP	ERROR		;AND BRANCH TO PRINT IT AND EXIT
.ENDM	NOERR
;
.MACRO	TAPERR	ARG1,ARG2,?B	;MACRO TO CHECK FOR TAPE ERROR
;
	CMPB	#ARG1,IOST	;CHECK IOST STATUS RETURNED
	BNE	B		;NO MATCH
	MOV	#"ARG2,ERRM	;MOVE IN ERROR CODE
	JMP	ERROR		;PRINT IT
B:				;CONTINUE
.ENDM	TAPERR
;
; LOCAL DATA
;
IOST:	.BLKW	2		;I/O STATUS BUFFER
INBUF:	.BLKB	MAXBLK	 	;INPUT BUFFER FOR TAPE BLOCK
BOUT:	.BLKB	MAXREC		;RECORD OUTPUT BUFFER FOR PUT$
DUMMY2:	.WORD	0		;DUMMY WORD FOR BLKLEN
BLKLEN:	.WORD	0		;BLOCK LENGTH
DUMMY1:	.WORD	0		;DUMMY WORK FOR RECLEN
RECLEN:	.WORD	0		;RECORD LENGTH
BLKFAC:	.WORD	0		;BLOCKING FACTOR
RECNT:	.WORD	0		;RECORD COUNT OF OUTPUT RECORDS
;
; FILE CONTROL SERVICES DATA AREA
;
	FSRSZ$	1		;INIT FILE STORAGE REGION
DBOUT:	FDBDF$			;ALLOC FDB FOR GEOFIL OUTPUT
	FDRC$A			;INIT RECORD ACCESS
	FDOP$A	DBLUN,DBDESC,,FO.WRT ;INIT FILE OPEN
;
DBDESC:	.WORD	DEVLEN		;DATASET DESCRIPTOR FOR GBFOUT FDB
	.WORD	DEV		;DEVICE NAME DESC (LENGTH,ADDRESS)
	.WORD	DIRLEN		;DIRECTORY DESC LENGTH
	.WORD	DIR		;DIRECTORY DESC ADDR
FILLEN:	.WORD	0		;FILE NAME DESC LENGTH
FIL:	.WORD	FILNAM		;FILE NAME DESC ADDR
FILNAM:	.BLKW	9.		;FILE NAME
DEV:	.ASCII	/DB2:/
DEVLEN	=	.-DEV
DIR:	.ASCII	/[211,2]/
DIRLEN	=	.-DIR
;
; COMMAND LINE CONTROL BLOCK
;
.EVEN
CMDBLK:	GCMLB$	1,,,4		;INIT GCML CONTROL BLOCK
;
; COMMAND STRING INTERPRETER BLOCK
;
	CSI$			;INIT CSI BLOCK
	.EVEN
CSIBLK:	.BLKB	C.SIZE		;ALLOCATE STORAGE FOR CSI BLOCK
;
OUTCNT:	.BYTE	12,15
OCNT:	.ASCII	/00000/
	.ASCII	/ RECORDS TRANSFERRED TO /
LCNT	=	.-OUTCNT
;
ERRMSG:	.ASCII	<12><15>/ DIRECTIVE ERROR  /
ERRM:	.ASCII	/00        /<12><15>
ERRLEN	=	.-ERRMSG
;
FIN:	.ASCII	<12><15>/OUTPUT FILE NAME>/
L.FIN	=	.-FIN
;
FERR:	.ASCII	<12><15>/FILE SPECIFICATION ERROR/<12><15>
L.FERR	=	.-FERR
;
RLEN:	.ASCII	<12><15>/ENTER LENGTH OF RECORD>/
L.RLEN	=	.-RLEN
;
RERR:	.ASCII	<12><15>/ERROR IN ENTRY/<12><15>
L.RERR	=	.-RERR
;
BLEN:	.ASCII	<12><15>/ENTER LENGTH OF TAPE BLOCK>/
L.BLEN	=	.-BLEN
;
BFERR:	.ASCII	<12><15>/ BLOCK LENGTH IS NOT A MULTIPLE/
	.ASCII	/ OF RECORD LENGTH/<12><15>
L.BFERR	=	.-BFERR
;
INPCK:	.ASCII	<12><15>/BLOCKING FACTOR IS  /
INPCK2:	.BLKB	5.
	.ASCII	<12><15>
L.INPC	=	.-INPCK
;+
;
; TRANSFER EBCDIC TAPE FROM 1600 BPI, 9 TRACK TAPE.
;	BLOCK SIZE IS VARYING PER FILE.
;	RECORD SIZE IS VARYING PER FILE.
;	CODE IS EBCDIC.
;
;	INPUTS: MM0: UNLABLED 1600BPI, 9 TRACK, EBCDIC, 
;		     BYTES/BLOCK VARYING PER FILE 
;
;	OUTPUTS: DB2:[200,1]'FIL' - 'RECLEN' BYTE ASCII RECORDS FROM TAPE 
;		 TI: - RECORD COUNT OF OUTPUT FILE AND ERROR MESSAGES
;
;	EFFECTS: NONE
;
;	GENERAL REGISTER USAGE:   (AFTER STBLK:)
;
;		R0 - FDB ADDRESS
;		R1 - BLOCK RECORD COUNTER
;		R2 - BLOCK RECORD POINTER
;		R3 - RECORD BYTE POINTER
;		R4 - RECORD WORD 
;-


.EVEN
START:	ALUN$C	1,MM,0		;ASSIGN LUN 1 TO MM0:
	NOERR	L01,01
L01:	ALUN$C	2,DB,2		;ASSIGN LUN 2 TO DB2:
	NOERR	L02,02
L02:	ALUN$C	3,TI,0		;ASSIGN LUN 3 TO TI:
	NOERR	L03,03
L03:	ALUN$C	4,TI,0		;ASSIGN LUN 4 TO TI:
	QIO$C	IO.ATT,1,1,,IOST ;ATTACH MAGTAPE
	NOERR	L04,04
L04:	WTSE$C	1		;WAIT ON QIO ATTACH
	CMPB	#IS.SUC,IOST	;WAS ATTACH SUCCESSFUL?
	BEQ	L05		;YES
	MOV	#"05,ERRM	;NO, ERROR
	JMP	ERROR		;PRINT ERROR MESSAGE
L05:	QIO$C	IO.SMO,1,1,,IOST,,<000100> ;MOUNT TAPE AND SET TAPE
				;CHARACTERISTICS TO 1600 BPI
				;NO-WRITE
	NOERR	L06,06
L06:	WTSE$C	1		;WAIT ON QIO MOUNT AND SET
	CMPB	#IS.SUC,IOST	;WAS MOUNT AND SET TAPE SUCCESSFUL?
	BEQ	L07		;YES
	MOV	#"07,ERRM	;NO, ERROR
	JMP	ERROR		;PRINT ERROR MESSAGE
L07:
NEXTF:	CLR	RECNT		;CLEAR RECORD COUNT
	GCML$	#CMDBLK,#FIN,#L.FIN ;GET COMMAND LINE
;
; CMDBLK+G.CMLD+2 = ADDRESS OF COMMAND LINE
; CMDBLK+G.CMLD = LENGTH OF COMMAND LINE
;
	BCC	L08		;ERROR, BRANCH NO
	CMPB	#GE.EOF,CMDBLK+G.ERR ;END OF FILE (CTRL Z)?
	BNE	1$		;NO
	JMP	QUIT		;YES
1$:	MOV	#"08,ERRM	;ERROR
	JMP	ERROR		;PRINT ERR MSG
L08:	CSI$1	#CSIBLK,CMDBLK+G.CMLD+2,CMDBLK+G.CMLD ;ANALYZE CMD LINE SYNTAX
	BCC	L09		;ERROR?
	QIO$C	IO.WLB,3,1,,IOST,,<FERR,L.FERR> ;YES, PRINT MSG
	NOERR	L10,10
L10:	WTSE$C	1		;WAIT ON MSG
	CMP	#IS.SUC,IOST	;WAS QIO SUCCESSFUL?
	BEQ	L11		;YES
	MOV	#"11,ERRM	;NO, ERROR
	JMP	ERROR		;PRINT ERR MSG
L11:	JMP	NEXTF		;TRY AGAIN
L09:	CSI$2	#CSIBLK,OUTPUT	;PARSE CMD LINE FOR SEMANTICS
	NOERR	L12,12
;
; CSIBLK+C.DSDS = DATASET DESCRIPTOR
; CSIBLK+C.DSDS+10 = FILENAME STRING LENGTH
; CSIBLK+C.DSDS+12 = FILENAME STRING ADDR
;
L12:	MOV	CSIBLK+C.DSDS+10,FILLEN ;GET FILENAME STRING LENGTH
	MOV	#FILNAM,R0	;GET FILENAME DESTINATION ADDRESS
	MOV	FILLEN,R1	;GET FILENAME LENGTH
	MOV	CSIBLK+C.DSDS+12,R2 ;GET FILENAME STRING ADDRESS
TRFN:	MOVB	(R2)+,(R0)+	;MOVE FILENAME FROM COMMAND LINE BLOCK
	DEC	R1		;FINISHED?
	BNE	TRFN		;NO
GETREC:	GCML$	#CMDBLK,#RLEN,#L.RLEN ;GET RECORD LENGTH
	NOERR	L13,13
L13:	MOV	CMDBLK+G.CMLD+2,R5 ;GET ADDR OF COMMAND INPUT
	MOV	CMDBLK+G.CMLD,R4 ;GET LENGTH OF COMMAND INPUT
	MOV	#DUMMY1,R3	;GET ADDR FOR CONVERSION OUTPUT
	CALL	.DD2CT		;CONVERT ASCII DECIMAL TO DBL WD BINARY
	BCC	L14		;WAS CONVERSION SUCCESSFUL?
	QIO$C	IO.WLB,3,1,,IOST,,<RERR,L.RERR> ;NO, PRINT ERR MSG
	NOERR	L15,15
L15:	WTSE$C	1		;WAIT ON QIO
	CMP	#IS.SUC,IOST	;WAS QIO SUCCESSFUL?
	BEQ	L16		;YES
	MOV	#"16,ERRM	;NO, ERROR
	JMP	ERROR		;PRINT ERR MSG
L16:	JMP	GETREC		;TRY AGAIN
L14:
GETBLK:	GCML$	#CMDBLK,#BLEN,#L.BLEN ;GET BLOCK LENGTH
	NOERR	L17,17
L17:	MOV	CMDBLK+G.CMLD+2,R5 ;GET ADDR OF COMMAND INPUT
	MOV	CMDBLK+G.CMLD,R4 ;GET LENGTH OF COMMAND INPUT
	MOV	#DUMMY2,R3	;GET ADDR FOR CONVERSION OUTPUT
	CALL	.DD2CT		;CONVERT ASCII DECIMAL TO DBL WD BINARY
	BCC	L18		;WAS CONVERSION SUCCESSFUL?
	QIO$C	IO.WLB,3,1,,IOST,,<RERR,L.RERR> ;NO, PRINT ERR MSG
	NOERR	L19,19
L19:	WTSE$C	1		;WAIT ON QIO
	CMP	#IS.SUC,IOST	;WAS QIO SUCCESSFUL?
	BEQ	L20		;YES
	MOV	#"20,ERRM	;NO, ERROR
	JMP	ERROR		;PRINT ERR MSG
L20:	JMP	GETBLK		;TRY AGAIN
L18:
	CLR	R2		;CLEAR R2 FOR DIVIDE
	MOV	BLKLEN,R3	;GET BLOCK LENGTH
	DIV	RECLEN,R2	;DIVIDE BLOCK LENGTH BY RECORD LENGTH
	MOV	R2,BLKFAC	;SAVE BLOCKING FACTOR
;
; PRINT OUT BLOCKING FACTOR
;
	MOV	#INPCK2,R0	;GET CONVERSION DESTINATION ADDR
	MOV	BLKFAC,R1	;GET VALUE TO CONVERT
	MOV	#1,R2		;LEADING ZEROS
	CALL	$CBDMG		;CONVERT BLOCKING FACTOR TO ASCII
	QIO$C	IO.WLB,3,1,,IOST,,<INPCK,L.INPC>
	WTSE$C	1
	TST	R2		;INVALID BLOCK LENGTH?
	BEQ	BE		;YES
	TST	R3		;WAS THERE A REMAINDER?
	BEQ	CONT		;NO
BE:	QIO$C	IO.WLB,3,1,,IOST,,<BFERR,L.BFERR> ;YES, PRINT ERR MSG
	NOERR	L33,33
L33:	WTSE$C	1		;WAIT ON QIO
	CMPB	#IS.SUC,IOST	;WAS QIO SUCCESSFUL?
	BNE	L34		;NO, ERROR
	JMP	GETREC		;TRY AGAIN
L34:	MOV	#"34,ERRM	;GET ERROR NUMBER
	JMP	ERROR		;PRINT ERR MSG
CONT:	FDAT$R	#DBOUT,#R.FIX,#FD.CR,RECLEN ;INIT FILE ATTR
	OPEN$W	#DBOUT		;OPEN FILE FOR OUTPUT
	NOERR	L21,21
L21:	MOV	#BOUT,DBOUT+F.NRBD+2 ;PUT ADDR OF NEXT REC BUF IN FDB
	MOV	RECLEN,DBOUT+F.NRBD ;PUT LENGTH OF NEXT REC BUF IN FDB
STBLK:	QIO$S	#IO.RLB,#1,#1,,#IOST,,<#INBUF,BLKLEN> ;READ BLOCK FROM TAPE
	NOERR	L22,22
L22:	WTSE$C	1		;WAIT ON TAPE READ
	CMPB	#IE.EOF,IOST	;EOF ON TAPE?
	BNE	L23		;NO, CONTINUE
	JMP	EOF		;YES, BRANCH
L23:	CMPB	#IS.SUC,IOST	;WAS TAPE READ SUCCESSFUL?
	BNE	L24		;NO, CONTINUE
	JMP	L25		;YES, BRANCH
;
;	CHECK ALL OF THE TAPE READ ERRORS
;
L24:	TAPERR	IS.PND,T0	;OPERATION PENDING?
	TAPERR	IE.ABO,T1	;ABORT?
	TAPERR	IE.BBE,T2	;BAD BLOCK?
	TAPERR	IE.BYT,T3	;BYTE ALIGNED?
	TAPERR	IE.DAA,T4	;DEVICE ALREADY ATTACHED?
	TAPERR	IE.DAO,T5	;DATA OVERRUN?
	TAPERR	IE.DNA,T6	;DEVICE NOT ATTACHED?
	TAPERR	IE.DNR,T7	;DEVICE NOT READY?
	TAPERR	IE.EOT,T8	;END OF TAPE?
	TAPERR	IE.EOV,T9	;END OF VOLUME?
	TAPERR	IE.FHE,TA	;FATAL HARDWARE ERROR?
	TAPERR	IE.IFC,TB	;ILLEGAL FUNCTION?
	TAPERR	IE.OFL,TC	;DEVICE OFFLINE?
	TAPERR	IE.SPC,TD	;ILLEGAL ADDRESS SPACE?
	TAPERR	IE.VER,TE	;UNRECOVERABLE ERROR?	
	TAPERR	IE.WLK,TF	;WRITE-LOCKED?
;
;	I GIVE UP, PRINT OUT THE IOST STATUS BUFFER.
;
;	CONVERT IOST STATUS ERROR CODE TO DECIMAL AND PRINT IT OUT
;
	MOV	R0,-(SP)	;SAVE R0
	MOV	R1,-(SP)	;     R1
	MOV	R2,-(SP)	;     R2
	MOV	#ERRM,R0	;LOAD CONVERSION OUTPUT ADDR
	MOVB	IOST,R1		;LOAD CONVERSION VALUE
	CLR	R2		;SUPRESS LEADING ZEROS
	CALL	$CBDSG		;CONVERT BINARY TO SIGNED DECIMAL
	INC	R0		;LEAVE A SPACE IN OUTPUT
	MOV	IOST+2,R1	;LOAD CONVERSION VALUE
	CLR	R2		;SUPRESS LEADING ZEROS
	CALL	$CBDSG		;CONVERT BINARY TO SIGNED DECIMAL
	MOV	(SP)+,R2	;RESTORE R2
	MOV	(SP)+,R1	;	 R1
	MOV	(SP)+,R0	;	 R0
	JMP	ERROR		;PRINT IT OUT
;
L25:	MOV	BLKFAC,R1	;INIT BLOCK RECORD COUNTER
	MOV	#INBUF,R2	;INIT BLOCK RECORD POINTER
STREC:	MOV	#BOUT,R3	;INIT RECORD BYTE POINTER
	MOV	RECLEN,R4	;INIT RECORD WORD COUNTER
	ASR	R4		;DIVIDE BY 2
NEXTB:	MOV	(R2)+,-(SP)	;PUSH EBCDIC WORD ONTO STACK
	CALL	EBASC		;CALL EBCDIC TO ASCII ROUTINE
	MOV	(SP)+,(R3)+	;POP ASCII WORD OFF OF STACK
	DEC	R4		;FINISHED RECORD?
	BNE	NEXTB		;NO, BRANCH
;
; THE FOLLOWING QIO IS USED FOR DEBUGGING.
; FUTURE RELEASES OF THIS PROGRAM WILL INCLUDE THIS
; AS A SELECTABLE FEATURE.
;
;	QIO$S	#IO.WLB,#3,#1,,#IOST,,<#BOUT,RECLEN> ;PRINT OUT RECORD TO TI:
;	WTSE$C	1		;WAIT ON QIO
;
	PUT$	R0		;YES, WRITE IT OUT TO DISK
	NOERR	L26,26


L26:	INC	RECNT		;INC RECORD COUNT
	DEC	R1		;LAST RECORD IN BLOCK?
	BNE	STREC		;NO, BRANCH NEXT RECORD
	JMP	STBLK		;YES, JUMP NEXT BLOCK
;
EOF:	CLOSE$	R0		;CLOSE GBFOUT FDB
	NOERR	L27,27
;
; PRINT OUT THE NUMBER OF RECORDS TRANSFERRED
;
L27:	MOV	#OCNT,R0	;OUTPUT AREA FOR CONVERSION
	MOV	RECNT,R1	;VALUE TO BE CONVERTED
	MOV	#1,R2		;SUPRESS LEADING ZEROS
	CALL	$CBDMG		;CONVERT RECORD COUNT TO ASCII
	QIO$C	IO.WLB,3,1,,IOST,,<OUTCNT,LCNT>	;WRITE RECORD COUNT
	NOERR	L28,28
L28:	WTSE$C	1		;WAIT ON RECORD COUNT MESSAGE
	CMPB	#IS.SUC,IOST	;WAS RECORD COUNT MESSAGE SUCCESSFUL?
	BEQ	L29		;YES
	MOV	#"29,ERRM	;NO, ERROR
	JMP	ERROR		;PRINT ERROR MESSAGE
L29:	QIO$S	#IO.WLB,#3,#1,,#IOST,,<#FILNAM,FILLEN> ;PRINT FILENAME
	WTSE$C	1		;WAIT ON QIO
	JMP	NEXTF		;JUMP TO GET NEXT FILE
;
ERROR:	QIO$C	IO.WLB,3,1,,IOST,,<ERRMSG,ERRLEN> ;WRITE ERROR MESSAGE
	BCC	L30
;
; NO ERROR CHECKING HERE
;
L30:	WTSE$C	1		;WAIT ON ERROR MESSAGE
	CLOSE$	R0		;CLOSE GBFOUT FDB
QUIT:	QIO$C	IO.DET,1,1,,IOST ;DETACH TAPE
	NOERR	L31,31
L31:	WTSE$C	1		;WAIT ON DETACH
	CMPB	#IS.SUC,IOST	;WAS DETACH SUCCESSFUL?
	BEQ	L32		;YES
	CMPB	#IE.DNA,IOST	;WAS DEVICE NOT ATTACHED?
	BEQ	L32		;YES
	MOV	#"31,ERRM	;NO, ERROR
	JMP	ERROR		;PRINT ERROR MESSAGE
L32:	EXIT$C			;EXIT
	.END	START