C CAT		MH-ICD. 	05/11/75.
C VERSION CATED E. RAPOPORT 1/22/76
C BLOCK NUMBERS CHANGED TO OS/8(2 TAPE BLOCKS PER BLOCK
C SPACES INTO PAGE FOR LPT
C ER 11/5/75
C
C
C
C .R FORT
C *CATED/L
C *IOH$
C
	COMMON IN,MSG,IS,IV
	DIMENSION IN(512),MSG(40),IS(4),IV(4)
	DIMENSION N00(6)
	READ(1,100) IDV
	IUN=1
500	READ(1,113) MSG
	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)
C SEE IF OS/8 INDEX
	CALL RLINC(IUN,2,2,IN,128)
	IF(IN(2)-7)407,508,407
407	IF(IN(2)-56)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)
	GO TO 412
512	CALL RLINC(IUN,IBLK,2,IN,128)
412	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
	GO TO 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
	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
S	JMS UNLT1
	WRITE(IDV,108) IEM1,IEM
	GO TO 511
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)
S	JMS UNLT1
	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
	GO TO 511
C
C - - - - - - - - - -
C
100	FORMAT('OUTPUT DEVICE? 'I1)
113	FORMAT('? '40A2)
102	FORMAT('1'6(/)11X5XD'.'22X'('D')'//(11X5X30A2))
103	FORMAT(5(/))
104	FORMAT(/11X5X'--FILE.--   BLK   LEN        DATE'/)
105	FORMAT(11X5X'EMPTY'4X,2(2XO4)'('I4')')
106	FORMAT(11XI4,X,3A2'.'A2,2(2XO4)'(I4')')
107	FORMAT(11XI4,X,3A2'.'A2,2(2XO4)'('I4')'2XD)
108	FORMAT(//11X6X,O4'('I4') EMPTY BLOCKS')
109	FORMAT(//11X6X'--FILE--    BLK   LEN')
110	FORMAT(11XI4,2X,4A2' S'2(2X,O4,2X,O4'.'I4))
111	FORMAT(11XI4,2X,4A2' B  'O4,2X,O4'.'I4)
112	FORMAT(/11X6X'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
C UNLOAD TAPE 1
SUNLT1,	0
S	TAD CHP		/MAKE LINC MODE JMP
S	AND (1777
S	TAD (6000
S	DCA CH0#
S	TAD (34
S	CPAGE 14
S	6141	/LINC
S	1	/AXO
S	6	/DJR
S	737	/CHK I U
SCH0,	727	/CHK I
S	0	/SET TO JMP .-1
S	703	/MTB
S	0
S	2	/PDP
S	CLA
S	JMP I UNLT1
SCHP,	CH0
	END