SUBROUTINE SEARCH(FILNM,STBLK,LENGTH,BLKNO,VAR,WBLK,E2)
	BYTE FILNM(8),A(2),TFILE(8)
	INTEGER*2 DP(2048),C,E,ADD,STBLK,BLKNO,WBLK,E2,DATE
	LOGICAL VAR
	COMMON /DAT/DATE
	COMMON DP
	EQUIVALENCE (C,A(1))
	N=0		!N IS NUMBER OF BLOCK MINUS 1
	LI=0		!INITIALISE SUBSCRIPT
2	LI=LI+1
	E=-NUMB(DP(LI))	!!
	ADD=-NUMB(DP(LI+4))	!NUMBER OF ADDITIONAL ENTRIES
	STBLK=DP(LI+1)
	LI=LI+5		!POINTS TO FIRST FILE NAME
	DO 200 K=1,E
	IF(DP(LI).EQ.0)GOTO 85	!EMPTY FILE ?
	LENGTH=-NUMB(DP(LI+4+ADD))
	IF(LENGTH.GT.481)GOTO 199	!TENTATIVE ENTRY
	DO 300 I=1,7,2
	C=ICON(DP(LI))
	TFILE(I)=A(2)
	TFILE(I+1)=A(1)
	LI=LI+1
300	CONTINUE
C TEST AGAINST INPUT FILE
	DO 400 I=1,8
	IF(TFILE(I).EQ.FILNM(I))GOTO 400
	GOTO 75
400	CONTINUE
	VAR=.TRUE.
	DATE=DP(LI)
	WBLK=N+1		!BLOCK ENTRY IS IN
	E2=K			!NUMBER OF ENTRY
	GOTO 1000
75	STBLK=STBLK+(-NUMB(DP(LI+ADD)))
	LI=LI+ADD+1
	GOTO 200
85	STBLK=STBLK+(-NUMB(DP(LI+1)))
199	LI=LI+2
	IF(LENGTH.GT.481)LI=LI+3+ADD
	LENGTH=0
200	CONTINUE
C SEARCH NEXT BLOCK
	N=N+1
	LI=N*256
	IF(N.LT.BLKNO)GOTO 2
	VAR=.FALSE.
1000	RETURN
	END
	SUBROUTINE FINDEM(L,BLK,SUB,SABLK,BLKNUM,VAR,L2)
	INTEGER*2 DP(2048),E,ADD,STBLK,BLK,SABLK,SUB,BLKNUM
	COMMON DP
	LOGICAL VAR
C FIND SMALLEST EMPTY BLOCK LARGER THAN L
C BLK IS NUMBER OF BLOCKS IN THIS DIRECTORY
C SUB IS THE ENTRY NUMBER OF EMPTY FILE IN GIVEN BLOCK
C  L2 IS LENGTH OF EMPTY FILE FOUND
C SABLK IS STARTING BLOCK
C BLOCKNUM IS BLOCK WHICH CONTAINS EMPTY BLOCK
	VAR=.FALSE.
	IMAX=500	!UPPER LIMIT FOR TEST
	N=0
	LU=0
1	LU=LU+1
	E=-NUMB(DP(LU))		!NUMBER OF ENTIES IN BLOCK
	ADD=-NUMB(DP(LU+4))	!NUMBER OF ADDITIONAL WORDS
	STBLK=DP(LU+1)		!STARTING BLOCK OF FIRST FILE
	LU=LU+5
C NOW LU POINTS TO FIRST ENTRY
	DO 10 I=1,E
	IF(DP(LU).EQ.0)GOTO 20	!EMPTY FILE
	L9=-NUMB(DP(LU+ADD+4))	!LENGTH OF FILE
C  IF FILE IS NOT TENATIVE ADD ON LENGTH TO STARTING BLOCK
	IF(L9.LE.481)STBLK=STBLK+L9
	LU=LU+5+ADD
	GOTO 10
20	LP=-NUMB(DP(LU+1))	!LENGTH OF THIS EMPTY FILE
	IF(LP.LT.L)GOTO 30	!TO SMALL
	IF(LP.GE.IMAX)GOTO 30	!BIGGER THAN FILE WE HAVE GOT
	IMAX=LP			!RESET IMAX
	VAR=.TRUE.
	SABLK=STBLK		!SABLK IS START BLK OF THIS FILE
	L2=LP			!LENGTH OF EMPTY FILE
	BLKNUM=N+1
	SUB=I
30	LU=LU+2
	STBLK=STBLK+LP
10	CONTINUE
C NOW SEARCH NEXT BLOCK
	N=N+1
	LU=N*256
	IF(N.LT.BLK)GOTO 1
	RETURN
	END
	SUBROUTINE DIRECT(ACHAN,IP)
	INTEGER*2 DIRS(2048),ACHAN
	COMMON DIRS
	IP=0
	L1=1
10	I=IROS8W(256,DIRS(1792),IP+1,ACHAN)
	IF(I.LT.0)STOP 'BAD READ'
	IP=IP+1
	CALL IC(DIRS(1792),DIRS(L1))
	L1=L1+256
	IF(DIRS(L1-254).NE.0)GOTO 10
	RETURN
	END
	SUBROUTINE UPDATE(INT,SUB,FILNM,LENG,CHAN,L2,OPTION)
C  L2 IS LENGTH OF EMPTY BLOCK
C  LENG IS LENGTH OF THE FILE
	INTEGER*2 SUB,CHAN,ADDTN,S,T2,C,E,DATE,DIR(2048),S1
	BYTE FILNM(8),OPTION
	COMMON DIR,/DAT/DATE
C  READ IN BLOCK THAT REQUIRES UPDATE
	I=IROS8W(256,DIR,INT,CHAN)
	IF(I.LT.0)STOP 'BAD READW'
C  STORE 256 12 BIT WORD DIRECTORY IN TEMP
	CALL IC(DIR,DIR(257))
C  REQUIRED BLOCK IS NOW LOADED
	ADDTN=-NUMB(DIR(261))	!NUMBER OF ADDITIONAL WORDS
	E=-NUMB(DIR(257))	!NUMBER OF ENTRIES IN THIS BLOCK
	LX=262			!START OF ENTRIES
	S=LX
	IF(OPTION.EQ.'R')GOTO 600
	IF(SUB.EQ.1)GOTO 55
	DO 40 IX=1,SUB-1
	IF(DIR(LX).EQ.0)GOTO 60
	LX=LX+ADDTN+5
	GOTO 40
60	LX=LX+2
40 	CONTINUE
C  LX NOW POINTS TO EMPTY ENTRY
55	DO 65 IK=1,LX-257
65	DIR(IK)=DIR(IK+256)
C NOW UPDATE THE ENTRY AND SHIFT ALL OTHER ENTRIES DOWN
	S1=LX-256
	IF(OPTION.EQ.'D')GOTO 200	!TO DELETE FILE
C INSERT FILE
	DO 100 I=1,4
100 	DIR(S1+I-1)=IAPACK(FILNM(I*2-1),FILNM(I*2))
C LAST LOOP PUTS IN NAME OF FILE
	LX=LX+2			!LX POINTS TO NEXT ENTRY IN TEMP
C NOW FILL IN ADDTIONAL WORDS
	S1=S1+4			!POINTS TO FIRST ADDITIONAL WORD
	DIR(S1)=DATE		!SET DATE 
	S1=S1+1			!NOW POINTS AT LENGTH
	T2=-LENG
	DIR(S1)=IACON(T2)
C IS NEW FILE SHORTER THAN THE EMPTY BLOCK
C IF SO INSERT EMPTY BLOCK AT END OF NEW FILE
	LDIFF=L2-LENG		!DIFFERENCE BETWEEN FILES
	IF(LDIFF.EQ.0)GOTO 240	!SAME SIZE
	S1=S1+1			!POINTS TO NEXT ENTRY IN DIR
	DIR(S1)=0		!INSERT EMPTY BLOCK
	S1=S1+1
	DIR(S1)=IACON(-LDIFF)	!INSERT LENGTH OF EMPTY BLOCK
	E=E+1			!ADD ONE TO NUMBER OF ENTRIES
	DIR(1)=IACON(-E)	!CHANGE NUMBER OF ENTRIES
	C=506			!NUMBER OF WORDS TO BE FILLED
	GOTO 250
C SINCE WE DID NOT INSERT EMPTY BLOCK WE HAVE TWO MORE
C WORDS TO FILL IN FROM TEMP TO DIR
240	C=508
C NOW SHIFT ALL OTHER ENTRIES DOWN
250	DO 201 ILK=LX,C
	S1=S1+1
201	DIR(S1)=DIR(ILK)
C NOW CONVERT TO CORRECT FORMAT
500	MASK="162745
	CALL IBIT(DIR,DIR(257),MASK)
	I=IWRITW(256,DIR(257),INT,CHAN)
	IF(I.LT.0)STOP 'BAD WRITEW'
	RETURN
200	DIR(S1)=0
	S1=S1+1
	DIR(S1)=IACON(-LENG)
	S1=S1+1
C S1 POINTS TO NEXT ENTRY IN DIR
C LX POINTS TO NEXT ENTRY IN TEMP STORAGE
	LX=LX+6
	DO 300 IZ=LX,512
	DIR(S1)=DIR(IZ)
300	S1=S1+1
	DO 400 IZ=252,256
400	DIR(IZ)=DIR(IZ+256)
	GOTO 500
C RENAME THE FILE ,1ST MOVE THROUGH THE DIRECTORY TO REQUIRED FILE
600	IF(SUB.EQ.1)GOTO 654
	DO 610 I=1,SUB-1
	IF(DIR(LX).EQ.0)GOTO 620	!EMPTY FILE
	LX=LX+ADDTN+5
	GOTO 610
620	LX=LX+2
610	CONTINUE
654	DO 655 I=1,4
655	DIR(LX+I-1)=IAPACK(FILNM(I*2-1),FILNM(I*2))
	DO 657 I=1,256
657	DIR(I)=DIR(I+256)
	GOTO 500
	END

	SUBROUTINE CHECK(TYPE,BLK,ERR)
C CHECKS TO SEE IF DISC IS IN OS/8 FORMAT
	INTEGER*2 BLK(4),A(5),BUF(4),CHAN
	LOGICAL*1 ERR,TYPE
C  ASSUMES NO EXTRA WORDS IN DIRECTORY
	CHAN=IGETC(0)
	IF(CHAN.LT.0)STOP 'NO CHANNEL'
	IF(LOOKUP(CHAN,BLK).LT.0)STOP 'BAD LOOKUP'
	IF(TYPE.EQ.1H8)GOTO 5
	I=IREADW(5,A,6,CHAN)
	IF(I.LT.0)GOTO 20	!READ ERROR
	IF(A(1).LE.0.OR.A(2).LT.0.OR.A(3).LE.0)GOTO 10
	IF(A(4).LT.0.OR.A(5).LT.14)GOTO 10
	GOTO 7
5	I=IROS8W(3,A,1,CHAN)
	IF(I.LT.0)GOTO 20
	CALL SWAP(A,BUF)
	IF(BUF(2).LT.0.OR.BUF(3).LT.0.OR.BUF(3).GT.6)GOTO 10
	IF(-NUMB(BUF(1)).LT.0)GOTO 10
7	ERR=0			!CORRECT FORMAT & NO READ ERROR
	GOTO 30			!RETURN
10	ERR=-1			!WRONG FORMAT
	WRITE(7,40)
40	FORMAT('+?PIP8-F-Disk is in the wrong format '/)
	GOTO 30			!RETURN
20	WRITE(7,50)
50	FORMAT('+?PIP8-F-Read error '/)
	ERR=-2			!READ ERROR
30	CALL CLOSEC(CHAN)
	IF(IFREEC(CHAN).NE.0)STOP 'BAD FRECC'
	RETURN
	END



C OS/8 LIBRARY - FUNCTIONS FOR ACCESSING BLOCKS FROM AN OS/8 FORMAT
C RX01 DISKETTE
C
C WRITTEN BY JOHN YARDLEY SOMETIME IN 1978
C
C	NOTE:	OS/8 BLOCKS ARE STORED IN BASICALLY THE SAME MANNER AS
C		RT-11 BLOCKS (IE USING A 2:1 SECTOR INTERLEAVE) EXCEPT
C		THAT OS/8 DOES NOT USE A SECTOR SKEW ACROSS TRACKS
C
C
C FUNCTION IROS8W (V1A) - SIMULATES AN "IREADW" USING THE PDP-8 OS8
C BLOCK STRUCTURE
C
	FUNCTION IROS8W(WCNT,BUFF,BLK,ICHAN)
	INTEGER WCNT,BUFF(1),BLK
C USE "IOS8" FUNCTION WITH READ CODE ("377)
	IROS8W=IOS8("377,WCNT,BUFF,BLK,ICHAN)
	RETURN
	END
C
C
C FUNCTION IWOS8W (V1A) - SIMULATES AN "IWRITW" USING THE PDP-8 OS8
C BLOCK STRUCTURE
C
	FUNCTION IWOS8W(WCNT,BUFF,BLK,ICHAN)
	INTEGER WCNT,BUFF(1),BLK
C USE "IOS8" FUNCTION WITH WRITE CODE ("376)
	IWOS8W=IOS8("376,WCNT,BUFF,BLK,ICHAN)
	RETURN
	END
C FUNCTION IOS8 (V1A) - READS OR WRITES ABSOLUTE BLOCKS IN OS8 FORMAT
C
	FUNCTION IOS8(ICODE,WCNT,BUFF,IBLK,CHAN)
	INTEGER WCNT,BUFF(1),BLK,CHAN,TRACK(4),SECTOR(4),LBUFF(65)
C DECODE BLOCK ADDRESS
	BLK=IBLK
	MYWCNT=1
10	CALL OS8BLK(BLK,SECTOR,ITK1,ITK2)
C ASSIGN TRACK ARRAY
	TRACK(1)=ITK1
	TRACK(2)=ITK1
	TRACK(3)=ITK2
	TRACK(4)=ITK2
C TRANSFER 4 SECTORS
	DO 11 N=1,4
C SET LBUFF INDEX
	J=1
C SET LIMIT
	LIMIT=MIN0(MYWCNT+64,WCNT)
C FILL LBUFF IF READ
	IF(ICODE.EQ."377)GOTO 15
	DO 16 M=MYWCNT,LIMIT
	J=J+1
16	LBUFF(J)=BUFF(M)
15	I=ISPFNW(ICODE,CHAN,TRACK(N),LBUFF,SECTOR(N))
C ABORT ON ERROR
	IF(I.NE.0)GOTO 12
C EMPTY LBUFF IF READ
	IF(ICODE.EQ."376)GOTO 17
	DO 14 M=MYWCNT,LIMIT
	J=J+1
14	BUFF(M)=LBUFF(J)
17	MYWCNT=MYWCNT+64
	IF(MYWCNT.GE.WCNT)GOTO 13
11	CONTINUE
C INCREMENT BLOCK NUMBER
	BLK=BLK+1
	GOTO 10
12	IOS8=-I
	RETURN
13	IOS8=0
	RETURN
	END
C SUBROUTINE OS8BLK (V1A) - CALCULATES ABSOLUTE TRACK AND SECTOR ADDRESSES
C OF A GIVEN OS/8 BLOCK NUMBER
C
	SUBROUTINE OS8BLK(BLOCK,SECTOR,TK1,TK2)
	INTEGER*2 TK1,TK2,SECPTR,BLOCK,SECTOR(4)
	BYTE INTL(28)
C
C INTERLEAVE TABLE - 2:1 SECTOR INTERLEAVE FOR OS/8
C
	DATA INTL/1,3,5,7,9,11,13,15,17,19,21,23,25,
     12,4,6,8,10,12,14,16,18,20,22,24,26,1,3/
C
C LOAD SECTOR ARRAY FROM INTERLEAVE TABLE
C
	SECPTR=MOD(BLOCK*4+1,26)-1
	DO 10 N=1,4
10	SECTOR(N)=INTL(SECPTR+N)
C
C LOAD TRACK ARRAY
C
	TK1=BLOCK*2/13+1
	TK2=TK1
	IF(SECPTR.EQ.24)TK2=TK2+1
	RETURN
	END