C CAT		MH-ICD. 	05/11/75.
C
C SW0	ON	SKIP HEADERS.
C	OFF	PRINT HEADERS.
C
C
C .FORT
C *CAT/L
C *IOH$
C
	COMMON IN,MSG,IS,IV
	DIMENSION IN(512),MSG(40),IS(4),IV(4)
	DIMENSION IOS(1),IDI(1),N00(6)
500	READ(1,100) IUN,IDV
	READ(1,113) MSG
	IF(ISENS(0))533,532,533
532	IF(MSG-IOS)503,505,503
503	IF(MSG-IDI)504,505,504
504	WRITE(1,101)
	GOTO 500
505	I=41
	DO 506 J=1,40
	I=I-1
	IF(MSG(I)+2016)507,506,507
506	CONTINUE
507	WRITE(IDV,102) 1,1,(MSG(J),J=1,I)
533	IF(MSG-IOS)509,508,509
511	WRITE(IDV,103)
	GOTO 500
C
C - - - - - - - - - -
C
C LIST OS/8 DIRECTORY.
C
508	IC=1
	IEM=0
	IBLK=2
	WRITE(IDV,104)
512	CALL RLINC(IUN,IBLK,2,IN,128)
	N=6
	NE=-IN
	IBL=IN(2)*2
	ISEG=IN(3)
	LAST=IN(4)
	IEX=IN(5)
	DO 519 I=1,NE
	IF(IN(N))514,513,514
513	N=N+1
S	JMS	NEXT
	IL=-IT
	IL1=IL+IL
	IEM=IEM+IL
	WRITE(IDV,105) IBL,IL1,IL
	GOTO 519
514	DO 515 J=1,4
S	JMS	NEXT
C BLANK THE CODE 00
S	TAD \IT
S	AND (7700
S	SZA CLA		; JMP HALF0
S	TAD (4040
SSTO0,	DCA \IT
S	JMP \515
SHALF0,	TAD \IT
S	AND (77
S	SZA CLA		; JMP \515
S	TAD \IT
S	TAD (40
S	JMP STO0
515	IV(J)=IT
S	JMS	NEXT
	ID=IT
	N=N-IEX-1
S	JMS	NEXT
	IL=-IT
	IL1=IL+IL
	IF(IEX)517,516,517
516	ID=0
517	WRITE(IDV,107) IC,IV,IBL,IL1,IL,ID
518	IC=IC+1
519	IBL=IBL+IL1
	IF(ISEG)521,521,520
520	IBLK=ISEG+ISEG
	GOTO 512
521	IEM1=IEM+IEM
	WRITE(IDV,108) IEM1,IEM
	IF(ISENS(0))500,511,500
C
C - - - - - - - - - -
C
C LIST DIAL DIRECTORY.
C
509	WRITE(IDV,109)
S	IAC
S	DCA \IC
S	TAD (5757
S	DCA \K57
S	TAD (346
S	DCA \IBLK
S	DCA \IEM
	CALL RLINC(IUN,IBLK,2,IN,256)
	DO 531 I=1,512,8
	IF(IN(I)-K57)522,531,522
522	DO 523 J=1,4
	IT=IN(I+J-1)
C BLANK THE CODE 77
S	TAD \IT
S	AND (7700
S	TAD (-7700
S	SZA CLA
S	JMP HALF
S	TAD (4040
SSTO,	DCA \IT
S	JMP \523
SHALF,	TAD \IT
S	AND (77
S	TAD (-77
S	SZA CLA		; JMP \523
S	TAD \IT
S	AND (7700
S	TAD (40
S	JMP STO
523	IS(J)=IT
	DO 525 J=1,4
	IT=IN(I+J+3)
	IF(IT-K57)525,524,525
524	IT=0
525	IV(J)=IT
	IEM=IEM+IV(2)+IV(4)
C
	IF(IV(1))526,528,526
526	IF(IV(3))527,529,527
527	WRITE(IDV,110) IC,IS,IV(1),IV(2),IV(2),IV(3),IV(4),IV(4)
	GOTO 530
528	WRITE(IDV,111) IC,IS,IV(3),IV(4),IV(4)
	GOTO 530
529	WRITE(IDV,110) IC,IS,IV(1),IV(2),IV(2)
530	IC=IC+1
531	CONTINUE
	WRITE(IDV,112) IEM,IEM
	IF(ISENS(0))500,511,500
C
C - - - - - - - - - -
C
100	FORMAT('TAPE UNIT? 'I1' OUTPUT DEVICE? 'I1)
113	FORMAT('? '40A2)
101	FORMAT('TITLE MUST BEGIN WITH TAPE OS NAME OF
	1 "OS/8" OR "DIAL" BLOCK LENGTH.')
102	FORMAT('1'6(/)5XD'.'22X'('D')'//(5X30A2))
103	FORMAT(5(/))
104	FORMAT(/5X'--FILE.--   BLK   LEN        DATE'/)
105	FORMAT(5X'EMPTY'4X,2(2XO4)'('I4')')
106	FORMAT(I4,X,3A2'.'A2,2(2XO4)'(I4')')
107	FORMAT(I4,X,3A2'.'A2,2(2XO4)'('I4')'2XD)
108	FORMAT(//6X,O4'('I4') EMPTY BLOCKS')
109	FORMAT(//6X'--FILE--    BLK   LEN')
110	FORMAT(I4,2X,4A2' S'2(2X,O4,2X,O4'.'I4))
111	FORMAT(I4,2X,4A2' B  'O4,2X,O4'.'I4)
112	FORMAT(/6X'BLOCKS USED: 'O4' ('I4')')
C
C - - - - - - - - - - - - - - - - - - -
C
C GET NEXT ELEMEMT IN INDEX (OS8).
C
SNEXT,	0
	IT=IN(N)
	N=N+1
S	JMP I NEXT
C
S	REORG 200
S	TEXT "OS"	/IOS
S	TEXT "DI"	/IDI
	END