C
C
C-----------------------------------------------------------------------------
C
C	PROGRAM:	A N S D M P
C
C	PURPOSE:	Display of ANSI tape label blocks.
C
C	AUTHOR:		Jan H. Belgraver
C
C	DATE:		27-NOV-84
C
C	VERSION:	V1.1	3-JAN-85
C
C	DESCRIPTION:	
C
C	INPUT  FILES:	Tape
C
C	OUTPUT FILES:	TI:, or other device or file given
C
C	LUNS:		1	Alternative list device/file
C			2	MM:
C			5	TI:
C			6	TI: (default list device)
C
C	EVENT FLAGS:	None
C
C	CALLS TO:	ATDET,	INITMM,	RVOL1,	RHDR1,	RHDR2,	RHDR3
C			ASSIGN,	GETADR,	WTQIO
C
C	PARAMETERS:	NAME		DESCRIPTION
C
C	BUILDING:	TKB @ANSDMPBLD.CMD
C
C	MODIFIED BY:	Name			Date		Ident.	Vers.
C			Jan H. Belgraver	3-JAN-85	JB01	1.1
C			Addition of ABORT routine to enable closing file
C			in case task is aborted.
C
C-----------------------------------------------------------------------------
C
C

C
C
	PROGRAM		A N S D M P
C
C	
	PARAMETER	SIZ	= 512

	LOGICAL		ABOFLG						! JB01

	COMMON	/ABOCOM/ABOFLG						! JB01

	INTEGER*2	IPARM(6), IOST2(2)

	REAL*4		VOLLBL

	LOGICAL*1	BUF(SIZ), IOST(4), LSTDEV(34)

	EQUIVALENCE	(IOST(1),    IOST2(1))
	EQUIVALENCE	(BUF(1),  VOLLBL)

	DATA	VOL1	/'VOL1'/,
	1	HDR1	/'HDR1'/,
	2	HDR2	/'HDR2'/,
	3	HDR3	/'HDR3'/,
	4	EOF1	/'EOF1'/,
	5	EOF2	/'EOF2'/,
	6	EOV1	/'EOV1'/,
	7	EOV2	/'EOV2'/,
	8	TMRK	/"23/

	DATA	IORLB	/"1000/,	! Read logical block
	1	IODET	/"2000/,	! Detach device
	2	IORWD	/"2400/		! Rewind tape
	3	IOSTC	/"2500/,	! Set   tape characteristics
	4	IOSEC	/"2520/,	! Sense tape characteristics
	5	IORWU	/"2540/		! Rewind and unload tape

	NTM	= 0			! Tape mark counter
	IPARM(2)= SIZ			! QIO byte count
	LUNL	= 6			! LUN list device
	LUNT	= 2			! LUN Tape drive, (INITMM uses 2)

C-----------------------------------------------------------------------------
C
C	Initialize list device and abort flag.
C
C-----------------------------------------------------------------------------

	CALL	ABOINI			! Clear abort flag		! JB01
	CALL	ATDET	(5, 'A')	! Attach terminal

	WRITE	(6,10)
10	FORMAT	(/'$List device, <CR>=TI:', T25, ': ')
	READ	(5,11, END=999)	NB, (LSTDEV(I),I=1,NB)
11	FORMAT	(Q, 32A1)
	IF	(NB .EQ. 0)	GOTO	20
	LSTDEV(NB+1)= 0
	LUNL	= 1
	OPEN	(UNIT=LUNL, 
	1	 NAME=LSTDEV, 
	2	 CARRIAGECONTROL='LIST')
	
C-----------------------------------------------------------------------------
C
C	Check if magtape can be used (should be write-locked), if not Stop.
C	INITMM attaches tape unit.
C
C-----------------------------------------------------------------------------

20	CALL	ASSIGN	(LUNT, 'MM:')
	CALL	INITMM	(0)

	CALL	GETADR	(IPARM(1), BUF(1) )	! Tape buffer address

25	IF	(ABOFLG)	GOTO	999	! Serve abort request	! JB01
	CALL	WTQIO	(IORLB, LUNT, LUNT,, IOST, IPARM)

	IF	(IOST(1)  .EQ. -10)	GOTO	30	! EOF found
	IF	(IOST(1)  .EQ. -11)	GOTO	32	! EOV found
	IF	(IOST(1)  .EQ. -62)	GOTO	34	! EOT found
	IF	(IOST(1)  .LE.  0)	GOTO	999	! Any other error
	NTBL	= NTBL + 1

	IF	(VOLLBL .EQ. VOL1)	GOTO	100
	IF	(VOLLBL .EQ. HDR1)	GOTO	200
	IF	(VOLLBL .EQ. EOF1)	GOTO	200
	IF	(VOLLBL .EQ. EOV1)	GOTO	200
	IF	(VOLLBL .EQ. HDR2)	GOTO	300
	IF	(VOLLBL .EQ. EOF2)	GOTO	300
	IF	(VOLLBL .EQ. EOV2)	GOTO	300
	IF	(VOLLBL .EQ. HDR3)	GOTO	400
	GOTO	25

30	WRITE	(LUNL,31)
31	FORMAT	(/' *** Tape Mark ***')
	GOTO	25

32	WRITE	(LUNL,33)
33	FORMAT	(/' *** Tape Mark ***', /' *** Tape Mark ***')
	GOTO	25

34	WRITE	(LUNL,35)
35	FORMAT	(/' *** Tape Mark ***', /' *** Tape Mark ***',
	1	 /' *** Tape Mark ***')
	GOTO	999

100	CALL	RVOL1	(BUF, NTBL, LUNL, IER)
	GOTO	25	
200	CALL	RHDR1	(BUF, NTBL, LUNL, IER)
	GOTO	25	
300	CALL	RHDR2	(BUF, NTBL, LUNL, IER)
	GOTO	25	
400	CALL	RHDR3	(BUF, NTBL, LUNL, IER)
	GOTO	25	

999	CLOSE	(UNIT=LUNL)
	CLOSE	(UNIT=LUNT)
	CALL	ATDET	(5, 'D')

	STOP
	END