C MINDEX.FT WRITE OS/8 AND DIAL INDICES ON FILE SYS:INDEX.DA
C FOR SORTING AND LISTING
C ED RAPOPORT 1/5/76
C
C AKS '?' FOR TAPE NAME, MOUNT SUCCESIVE
C TAPES ON DRIVE 1.
C TO QUIT, TYPE TAPE NAME 'STOP'
C TAPES ARE UNLOADED AFTER INDEX IS READ
C
C	.R FORT
C	*MINDEX/L/O
C	*IOH$
C
	COMMON IN,IS,IV
	DIMENSION IN(512),MSG(40),IS(4),IV(4)
	DIMENSION N00(6)
	EQUIVALENCE (SG,MSG)
	SOURCE='S'
	BIN='B'
	IUN=1
	IDV=4
	CALL OOPEN('SYS','INDEX')
500	READ(1,113) MSG
	IF(SG-'STOP  ')501,700,501
501	IM=41
	DO 506 JM=1,40
	IM=IM-1
	IF(MSG(IM)+2016)507,506,507
506	CONTINUE
C SEE IF OS/8 INDEX
507	CALL RLINC(IUN,2,2,IN,128)
	IF(IN(2)-7)407,412,407
407	IF(IN(2)-56)509,412,509
700	CALL OCLOSE
	STOP
C
C - - - - - - - - - -
C
C LIST OS/8 DIRECTORY.
C
512	CALL RLINC(IUN,IBLK,2,IN,128)
412	N=6
	NE=-IN
	IBL=IN(2)
	ISEG=IN(3)
	LAST=IN(4)
	IEX=IN(5)
	DO 519 I=1,NE
	IF(IN(N))514,513,514
C SKIP EMPTY FILE
513	N=N+1
S	JMS NEXT
	IL=-IT
	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
C SKIP ADDITIONAL INFO WORDS
	N=N-IEX-1
S	JMS	NEXT
	IL=-IT
	IF(IEX)517,516,517
516	ID=0
517	WRITE(IDV,107) IV,IBL,IL,ID,(MSG(JM),JM=1,IM)

519	IBL=IBL+IL
	IF(ISEG)521,521,520
520	IBLK=ISEG+ISEG
	GOTO 512
S\521,	JMS UNLT1
	GO TO 500
C
C - - - - - - - - - -
C
C LIST DIAL DIRECTORY.
C
S\509,	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 SET DATE ZERO TO PRINT OUT BLANKS
	IZD=0
	IF(IV(3))528,526,528
528	WRITE(IDV,111) IS,BIN,IV(3),IV(4),IZD,(MSG(JM),JM=1,IM)
526	IF(IV(1))529,531,529
529	WRITE(IDV,111) IS,SOURCE,IV(1),IV(2),IZD,(MSG(JM),JM=1,IM)
531	CONTINUE
	GO TO 500
C
C - - - - - - - - - -
C
113	FORMAT('? '40A2)
107	FORMAT(3A2,2X'.'A2,3A2,40A2)
111	FORMAT(4A2,2XA1,3A2,40A2)
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