	INTEGER*2 FILE(39),EXT(2),SW(4,7),BLKNO,OUTCHN,S7,C,FREE
	INTEGER*2 DIR(2048),DBLK(4),EBLK(4),P,EXTRA,X
	INTEGER*2 ABLK,START,SUBSCR,BLOCK,EL,ENT,DK
	INTEGER*2 STOBLK,BUFF1(384),RBLK(8),FILES,BLKS
	INTEGER*2 X2,X1,BLK,MONTH(12),DATE(3),XBLK(4)
	LOGICAL FOUND,FLAG,ERR
	BYTE SFILE(9),TFILE(8),B1,B2,A(2),MON(3),EMPTY(9)
	BYTE AFILE(14),BFILE(14),CFILE(12)
	COMMON DIR
	EQUIVALENCE(C,A(1))
	DATA EXT/3R   ,3R   /,DBLK/0,0,0,0/,EBLK/0,0,0,0/
	DATA SW(1,1)/1H8/,SW(1,2)/1H8/,SW(1,7)/1HP/,DK/3RDK /
	DATA SW(1,3)/1HR/,SW(1,4)/1HL/,SW(1,5)/1HD/,SW(1,6)/1HF/
	DATA MONTH/3RJAN,3RFEB,3RMAR,3RAPR,3RMAY,3RJUN,3RJUL
     1,3RAUG,3RSEP,3ROCT,3RNOV,3RDEC/
	DATA EMPTY/1H<,1HE,1HM,1HP,1HT,1HY,1H>,1H ,1H /
	WRITE(7,391)			!PRINT VERSION NUMBER
1	INCHAN=IGETC(0)			!GET INPUT CHANNEL
	IF(INCHAN.LT.0)STOP 'NO CHANNEL'
	OUTCHN=IGETC(0)			!GET OUTPUT CHANNEL
	IF(OUTCHN.LT.0)STOP'NO OUTPUT CHANNEL'
145 	I=ICSI(FILE,EXT,,SW,7)		!GET COMMAND
	IF(I.EQ.0)GOTO 115
	WRITE(7,118)			!TELL USER ILLEGAL OPTION WAS TYPED
	GOTO 145
115	IF(SW(2,4).NE.0.OR.SW(2,7).NE.0)GOTO 195	!LIST DIRECTORY?
	IF(FILE(2).NE.0.OR.FILE(17).NE.0)GOTO 195	!ANY FILES SPECIFIED
	IF(FILE(1).NE.0.OR.FILE(16).NE.0)GOTO 195	!ANY DEVICES SPECIFIED
	WRITE(7,391)			!PRINT TITLE IF <CR> HAS BE TYPED
	GOTO 145			!GET NEXT COMMAND
195	IF(FILE(16).EQ.0)FILE(16)=DK
	DO 90 I=1,14
	BFILE(I)="40
90	AFILE(I)="40
	CALL R50ASC(12,FILE(16),CFILE)	!FILE-SPEC FOR ERROR MESSAGES
	CALL FILECN(CFILE,AFILE)
	DBLK(1)=FILE(16)		!ASSIGN DBLK AS INPUT DEVICE
	B1=1HI			!B1 IS FORMAT OF DISK RT/11="I"; OS/8="8"
	IF(SW(3,1).EQ.3.AND.SW(2,1).EQ.1)B1=1H8	!OS/8?
	IF(IDSTAT(DBLK,XBLK).EQ.1)GOTO 141	!INPUT HANDLER LOADED?
	IF(XBLK(4).NE.0)GOTO 200		!FILE STRUCTURED DEVICE?
	WRITE(7,210)AFILE		!NON FILE STRUCTURED INPUT DEVICE
210	FORMAT('+?PIP8-F-Non file structured input device '14A1,/)
	GOTO 145			!GET ANOTHER COMMAND
200	X1=XBLK(1).AND."377		!X1 IS CODE FOR SPECIFIED DEVICE
	IF(X1.NE."22.AND.B1.EQ.1H8)GOTO 2660
	IF(XBLK(3).NE.0)GOTO 193	!IF NON ZERO HANDLER IS LOADED.
	IF(IFETCH(DBLK(1)).NE.0)STOP'BAD FETCH'	!LOAD INPUT HANDLER.
193	CALL CHECK(B1,DBLK,ERR)		!CORRECT FORMAT?
	IF(ERR.NE.0)GOTO 9000		!EVERYTHING OK
	CALL R50ASC(9,FILE(17),SFILE)	!CONVERT FILE NAME TO ASCII
	IF(SW(2,4).NE.0)GOTO 7500	!LIST DIRECTORY ON TT:?
	IF(SW(2,7).NE.0)GOTO 7499	!LIST DIRECTORY ON LP:?
	IF(FILE(17).NE.0)GOTO 80	!INPUT FILE SPECIFIED ?
	WRITE(7,75)
75	FORMAT('+?PIP8-F-Input file name missing ',/)
	GOTO 145
80	IF(SW(2,5).NE.0)GOTO 7600	!DELETE A FILE?
C NEED AN OUTPUT DEVICE
	IF(FILE(1).EQ.0.AND.FILE(2).NE.0)FILE(1)=DK
	IF(FILE(1).NE.0)GOTO 250
	WRITE(7,240)
240	FORMAT('+?PIP8-F-No output file specified '/)
	GOTO 145
250	FLAG=.FALSE.			!SAME DEVICE FLAG
	IF(FILE(1).EQ.FILE(16))FLAG=.TRUE.
	CALL R50ASC(12,FILE(1),CFILE)
	CALL FILECN(CFILE,BFILE)
	EBLK(1)=FILE(1)
	B2=1HI		!B2 IS FORMAT OF OUTPUT DEVICE
	IF(SW(3,1).EQ.0.AND.SW(2,1).EQ.1)B2=1H8
	IF(SW(3,2).EQ.0.AND.SW(2,2).EQ.1)B2=1H8
	IF(IDSTAT(EBLK,XBLK).EQ.1)GOTO 147	!OUTPUT DEVICE LOADED?
	X1=XBLK(1).AND."377		!X1 IS CODE FOR SPECIFIED DEVICE
	IF(X1.NE."22.AND.B2.EQ.1H8)GOTO 2660
	IF(XBLK(3).NE.0)GOTO 194	!IF NON ZERO HANDLER IS LOADED.
	IF(IFETCH(EBLK(1)).NE.0)STOP'BAD FETCH'	!LOAD OUTPUT HANDLER
194	IF(XBLK(4).EQ.0)GOTO 2933	!NON FILE STRUCTURED DEVICE
	CALL CHECK(B2,EBLK,ERR)		!CORRECT FORMAT?
	IF(ERR.NE.0)GOTO 9000		!EVERYTHING OK
	CALL R50ASC(8,FILE(2),TFILE)
	IF(SW(2,3).NE.0)GOTO 7000	!RENAME A FILE?
225	X=0
	BLKNO=0
	IF(B1.EQ.1H8.AND.B2.EQ.1H8)GOTO 2000	!BOTH FILES IN OS/8 FORMAT
	IF(B2.EQ.1H8)GOTO 5000			!OUTPUT FILE IN OS/8 FORMAT
	IF(B1.EQ.1H8)GOTO 4000			!INPUT FILE IN OS/8
	GOTO 3000				!BOTH FILES MUST BE RT/11
2933	IF(LOOKUP(OUTCHN,EBLK).LT.0)STOP'BAD LOOKUP 4'	!LOOKUP N.F.S O/F
	GOTO 225
C
C  IF FILE IS GREATER THAN 8 BLOCKS IN LENGTH TRANSFER 
C  8 BLOCKS AT ONE TIME IF LESS THAN 8 TRANSFER IN ONE GO.
C  READ UP TO 8 BLOCKS INTO A BUFFER THEN READ SAME BLOCKS OUT.
3000	LENGTH=LOOKUP(INCHAN,FILE(16))
	IF(LENGTH.EQ.-2)GOTO 3900		!FILE NOT FOUND
	IF(LENGTH.LT.0)STOP 'BAD LOOKUP 1'
	IF(XBLK(4).EQ.0)GOTO 3100		!N.F.S OUTPUT FILE
	I=IENTER(OUTCHN,FILE(1),LENGTH)
	IF(I.EQ.-2)GOTO 3950
	IF(I.LT.0)STOP' BAD ENTER 1'
3100	IF(LENGTH.GT.8)GOTO 3127
	I=IREADW(256*LENGTH,DIR,BLKNO,INCHAN)
	IF(I.LT.0)STOP'READ ERROR'
	I=IWRITW(256*LENGTH,DIR,BLKNO,OUTCHN)
	IF(I.LT.0)STOP'WRITE ERROR'		!WRITE ERROR
	GOTO 9000
3127	I=IREADW(2048,DIR,BLKNO,INCHAN)
	IF(I.LT.0)STOP'BAD READ'
	I=IWRITW(2048,DIR,BLKNO,OUTCHN)
	IF(I.LT.0)STOP'BAD WRITE'
	BLKNO=BLKNO+8		!INC BLOCK COUNTER
	LENGTH=LENGTH-8		!DECREMENT LENGTH
	GOTO 3100		!TRANSFER NEXT SET OF BLOCKS
C
C BOTH FILES IN OS/8 FORMAT
C
2000	IF(LOOKUP(INCHAN,DBLK).LT.0)STOP' BAD LOOKUP 2'
	IF(LOOKUP(OUTCHN,EBLK).LT.0)STOP'BAD LOOKUP 3'
	CALL DIRECT(INCHAN,ABLK)	!LOAD INPUT OS/8 DIRECTORY 
C  SEARCH FOR INPUT FILE
	CALL SEARCH(SFILE,START,LENGTH,ABLK,FOUND,IBLK,ENT)
C START IS THE STARTING BLOCK OF THE FILE
C LENGTH IIS THE LENGTH OF THE FILE
	IF(FOUND.EQ..FALSE.)GOTO 3900	!IF NOT FOUND TELL USER
C FILE HAS BEEN FOUND
C IF FILES ARE NOT ON THE SAME DEVICE LOAD OUTPUT DIRECTORY
	IF(FLAG.EQ..FALSE.)CALL DIRECT(OUTCHN,ABLK)
C DOES OUTPUT FILE ALREADY EXIST
	CALL SEARCH(TFILE,S7,L7,ABLK,FOUND,IBLK,ENT)
C L7 LENGTH OF FILE THAT ALREADY EXISTS
C IBLK IS BLOCK OF DIRECTORY IT IS IN
C ENT IS THE ENTRY NUMBER IN GIVEN BLOCK
	IF(FOUND.EQ..TRUE.)GOTO 347	!FILE EXISTS ,DELETE IT
C NOW SEARCH FOR THE SMALLEST EMPTY BLOCK LARGER THAN LENGTH
348	CALL FINDEM(LENGTH,ABLK,SUBSCR,BLOCK,INBLK,FOUND,EL)
C BLOCK IS THE STARTING BLOCK OF THE EMPTY FILE
C SUBSCR IS THE NUMBER OF THE ENTRY IN GIVEN BLOCK THAT FILE IS IN
C INBLK IS THE NUMBER OF THE BLOCK OF THE DIRECTORY IN WHICH 
C THE EMPTY FILE IS IN
	IF(FOUND.NE..TRUE.)GOTO 3950	!IF NO ROOM TELL USER
	ISLEN=LENGTH			!SAVE LENGTH OF FILE
2509	IF(ISLEN.GT.8)GOTO 2398
	I=IROS8W(256*ISLEN,DIR,START,INCHAN)
	IF(I.LT.0)STOP 'BAD OS/8 READ'
	I=IWOS8W(256*ISLEN,DIR,BLOCK,OUTCHN)
	IF(I.LT.0)STOP 'BAD OS/8 WRITE'
	GOTO 8999
2398	I=IROS8W(2048,DIR,START,INCHAN)
	IF(I.LT.0)STOP'BAD READ OS/8'
	I=IWOS8W(2048,DIR,BLOCK,OUTCHN)
	IF(I.LT.0)STOP 'BAD WRITE 8'
	START=START+8		!INC INPUT BLOCK COUNTER
	BLOCK=BLOCK+8		!INC OUTPUT BLOCK COUNTER
	ISLEN=ISLEN-8
	GOTO 2509
C NOW UPDATE THE DIRECTORY INSERT TFILE INTO DIRECTORY
C INBLK IS THE BLOCK OF THE DIRECTORY IN WHICH THE EMPTY FILE OCCURS 
8999	CALL UPDATE(INBLK,SUBSCR,TFILE,LENGTH,OUTCHN,EL,1HI)
	GOTO 9000
C  DELETE THE OUTPUT FILE FROM THE DIRETORY.SFILE IS DUMMY VARIABLE
347	CALL UPDATE(IBLK,ENT,SFILE,L7,OUTCHN,EL,1HD)
	CALL DIRECT(OUTCHN,ABLK)	!LOAD NEW OUTPUT DIR
	GOTO 348
C INPUT FILE IN RT/11 FORMAT,OUTPUT FILE IN OS/8 FORMAT
5000	LENGTH=LOOKUP(INCHAN,FILE(16))
	IF(LENGTH.EQ.-2)GOTO 3900
	IF(LENGTH.LT.0)STOP'BAD LOOKUP 3'
	IF(LOOKUP(OUTCHN,EBLK).LT.0)STOP' BAD LOOKUP 4'
	CALL DIRECT(OUTCHN,ABLK)	!LOAD OUTPUT DIRECTORY
C SEARCH FOR OUTPUT FILE,IF IT EXISTS DELETE IT
	CALL SEARCH(TFILE,S7,L7,ABLK,FOUND,IBLK,ENT)
	IF(FOUND.EQ..TRUE.)GOTO 5200	!DELETE OUTPUT FILE
5300	LENG=INT(3*LENGTH/2.+0.5)	!LENG IS LENGTH OF OUTPUT FILE
C SEARCH FOR EMPTY BLOCK JUST LARGER THAN LENG
	CALL FINDEM(LENG,ABLK,SUBSCR,BLOCK,INBLK,FOUND,EL)
	IF(FOUND.EQ..FALSE.)GOTO 3950
	MASK="162745
	STOBLK=BLOCK
C NOW CONVERT FROM RT/11 TO OS/8
5222	LEFT=1
C READ IN FIRST BLOCK OF INPUT FILE
5500	I=IREADW(256,BUFF1(LEFT),BLKNO,INCHAN)
	IF(I.LT.0)STOP 'BAD READW'
	BLKNO=BLKNO+1	!INC BLOCK COUNTER
	X=X+1		!COUNT OF BLOCKS READ IN
C CONVERT 1ST 192 I6 BIT WORDS TO 256 12 BIT WORDS IN DIR
	CALL CNVERT(BUFF1,DIR)
C CONVERT TO OS/8 FORMAT
	CALL IBIT(DIR,DIR(1792),MASK)
	I=IWOS8W(256,DIR(1792),BLOCK,OUTCHN)	!WRITE OUT OS/8 BLOCK
	IF(I.LT.0)STOP 'BAD OS8W'
	BLOCK=BLOCK+1	!INC OUTPUT BLOCK COUNTER
	LEFT=LEFT+64	!NUMBER OF WORDS LEFT OVER IN BUFF1
C MOVE ALL WORDS LEFT OVER TO START OF DIR(1792) BUFF1
	DO 5520 I=1,LEFT-1
5520	BUFF1(I)=BUFF1(I+192)
	IF(LEFT.EQ.193)GOTO 5563	!HAVE WE FILLED DIR(1792) BUFF1
	IF(LENGTH.EQ.X)GOTO 5700	!AT END OF INPUT FILE?
	GOTO 5500
C AT END OF DIR(1792),ZERO LEFT OVER WORDS AND WRITE OUT OS/8 BLOCK
5700	DO 5770 I=LEFT,192
5770	BUFF1(I)=0
5563	CALL CNVERT(BUFF1,DIR)
	CALL IBIT(DIR,DIR(1792),MASK)
	I=IWOS8W(256,DIR(1792),BLOCK,OUTCHN)
	IF(I.LT.0)STOP '8W'
	BLOCK=BLOCK+1
	IF(X.LT.LENGTH)GOTO 5222
5570 	LENG=BLOCK-STOBLK	!LENGTH OF OUTPUT FILE
C INSERT FILE INTO DIRECTORY
	CALL UPDATE(INBLK,SUBSCR,TFILE,LENG,OUTCHN,EL,1HI)
	GOTO 9000
5200	CALL UPDATE(IBLK,ENT,TFILE,L7,OUTCHN,EL,1HD)
	CALL DIRECT(OUTCHN,ABLK)
	GOTO 5300
C INPUT FILE IN OS/8 FORMAT,OUTPUT FILE IN RT/11 FORMAT
4000	IF(LOOKUP(INCHAN,DBLK).LT.0)STOP'BAD LOOKUP 5'
	CALL DIRECT(INCHAN,ABLK)	!LOAD INPUT DIRECTORY
C SEARCH FOR INPUT FILE
	CALL SEARCH(SFILE,START,LENGTH,ABLK,FOUND,IBLK,ENT)
	IF(FOUND.EQ..FALSE.)GOTO 3900	!FILE NOT FOUND
	IF(XBLK(4).EQ.0)GOTO 4321	!NON FILE STRUCTURED DONT ENTER
	I=IENTER(OUTCHN,FILE(1),LENGTH)
	IF(I.EQ.-2)GOTO 3950
	IF(I.LT.0)STOP 'BAD IENTER'
C NOW READ IN INPUT FILE AND CONVERT TO RT/11
4321	P=1
	INC=128
	DO 4325 LP=1,2
	I=IROS8W(256,DIR(1792),START,INCHAN)
	IF(I.LT.0)STOP'BAD READ'
	CALL IC(DIR(1792),DIR)
	CALL ACNVRT(DIR,BUFF1(P))
	START=START+1
	X=X+1
	P=P+192
	IF(X.EQ.LENGTH.AND.LP.EQ.1)GOTO 4350
4325	CONTINUE
C WRITE OUT RT/11 BLOCK
4378	I=IWRITW(256,BUFF1,BLKNO,OUTCHN)
	IF(I.LT.0)STOP'BAD WRITE'
	BLKNO=BLKNO+1	!INC OUTPUT BLOCK COUNTER
C MOVE LEFT OVER WORDS TO START OF OUTPUT ARRAY
	DO 4244 I=1,INC
4244	BUFF1(I)=BUFF1(I+256)
	P=INC+1	!P POINTS TO JUST AFTER TRANSFERRED WORDS
	IF(X.EQ.LENGTH)GOTO 4350
	I=IROS8W(256,DIR(1792),START,INCHAN)
	IF(I.LT.0)STOP'BAD READ'
	CALL IC(DIR(1792),DIR)
	CALL ACNVRT(DIR,BUFF1(P))
	START=START+1
	X=X+1
	INC=INC/2
	IF(INC.NE.32)GOTO 4378
	GOTO 4389
4350	DO 4590 I=P,256
4590	BUFF1(I)=0
4389	I=IWRITW(256,BUFF1,BLKNO,OUTCHN)
	IF(I.LT.0)STOP'BAAD WRITE'
4390	BLKNO=BLKNO+1
	IF(X.LT.LENGTH)GOTO 4321
	GOTO 9000		!END OF FILE COPY
C LIST REQUIRED DIRECTORY
7499	CALL CLOSE(7)
	CALL ASSIGN(7,'LP:',0,0,0,0)	!ASSIGN CHAN 7 TO LP:
7500	IF(LOOKUP(INCHAN,DBLK).LT.0)STOP 'BAD LOOKUP DIR'
	FREE=0		!NUMBER OF FREE BLOCKS IN DIRECTORY
	BLKS=0	!# OF BLOCKS USED ON THE DISC
	FILES=0	!# OF FILES ON THE DISC
	IF(SW(2,1).NE.0)GOTO 7639	!OS/8 DIRECTORY
7437	I=IREADW(512,DIR(1),6,INCHAN)	!READ IN 1ST SEGMENT OF RT/11 DIR.
	IF(I.LT.0)STOP'BAD READ'
	X2=1
7667	X1=X2
	IF(X1.EQ.1)X2=513
	IF(X1.EQ.513)X2=1
	NSEG=DIR(X1+1)		!NSEG IS NEXT SEGMENT TO BE READ IN
	IF(NSEG.EQ.0)GOTO 7666	!IF ZERO NO NEXT SEGMENT
	BLK=2*(NSEG-1)+6	!BLOCK ADDRESS OF START OF NEXT SEGMENT
	IK3=IREAD(512,DIR(X2),BLK,INCHAN)
	IF(IK3.LT.0)STOP'BAD READ'
7666	STOBLK=DIR(X1+4)	!STARTING BLOCK OF FILES
	EXTRA=DIR(X1+3)		!EXTRA BLOCKS
	X1=X1+5
7538	LENGTH=DIR(X1+4)		!LENGTH OF FILE
	IF(DIR(X1).EQ."2000)GOTO 7557	!PERMANENT ENTRY
	IF(DIR(X1).EQ."4000)GOTO 7800	!END OF SEGMENT
	IF(SW(2,6).EQ.0)GOTO 7539	!NO PRINTING OF EMPTY BLOCKS
	GOTO 7569			!PRINT EMPTY OR TENTATIVE FILES
7557	DO 7558 I=1,3			!CONVERT FILE NAME TO ASCII
7558	CALL R50ASC(3,DIR(X1+I),SFILE(3*I-2))
	FILES=FILES+1		!INCREMENT COUNT OF FILES
	BLKS=BLKS+LENGTH	!ADD LENGTH OF NEXT FILE TO # OF BLOCKS
	IF(DIR(X1+6).EQ.0)GOTO 7333	!DATE PRESENT?
	CALL IGETD(DIR(X1+6),DATE)	!GET DATE
	CALL R50ASC(3,MONTH(DATE(2)),MON)	!COVERT MONTH TO ASCII
	MON(2)=MON(2).OR."40	!CONVERT TO LOWER CASE LETTERS
	MON(3)=MON(3).OR."40
	IF(SW(2,6).NE.0)GOTO 7435	!PRINT STARTING BLOCKS?
	WRITE(7,7436)SFILE,LENGTH,DATE(1),MON,DATE(3)
	GOTO 7448
7435	WRITE(7,7436)SFILE,LENGTH,DATE(1),MON,DATE(3),STOBLK
	GOTO 7448
7333	IF(SW(2,6).NE.0)GOTO 7334
	WRITE(7,7438)SFILE,LENGTH
	GOTO 7448
7334	WRITE(7,7438)SFILE,LENGTH,STOBLK
	GOTO 7448
7569	WRITE(7,7438)EMPTY,LENGTH,STOBLK
7539	FREE=FREE+LENGTH	!INC NUMBER OF FREE BLOCKS
7448	STOBLK=STOBLK+LENGTH	!INC NUMBER OF STARTING BLOCK
	X1=X1+EXTRA+7		!POINTS AT NEXT ELEMENT (X1)
	GOTO 7538
7800	IF(NSEG.EQ.0)GOTO 7880	!END OF DIRECTORY
	IF(IWAIT(INCHAN).NE.0)STOP'BAD WAIT'
	GOTO 7667
C  LIST THE OS/8 DIRECTORY
7639	CALL DIRECT(INCHAN,ABLK)	!LOAD OS/8 DIRECTORY
	SFILE(9)=' '
	X=0
	X1=0
7602	X1=X1+1
	ENT=-NUMB(DIR(X1))	!# OF ENTRIES IN BLOCK
	EXTRA=-NUMB(DIR(X1+4))	!# OF EXTRA WORDS PER ENTRY
	STOBLK=DIR(X1+1)	!STARTING BLOCK OF FILES
	X1=X1+5			!POINTS TO FIRST ENTRY
	DO 7620	K=1,ENT
	IF(DIR(X1).EQ.0)GOTO 7685	!EMPTY ENTRY
	DO 7630 I=1,7,2		!CONVERT FILE NAMES TO ASCII
	C=ICON(DIR(X1))
	SFILE(I)=A(2)
	SFILE(I+1)=A(1)
7630	X1=X1+1
	LENGTH=-NUMB(DIR(X1+EXTRA))
	IF(LENGTH.GT.481)GOTO 7610
	FILES=FILES+1		!INC # OF FILES ON DISC
	BLKS=BLKS+LENGTH	!ADD LENGTH OF THIS FILE TO COUNT.
	IF(DIR(X1).EQ.0)GOTO 7683	!IS THERE A DATE FOR THIS FILE
	CALL IGETD8(DIR(X1),DATE)
	CALL R50ASC(3,MONTH(DATE(2)),MON)
	MON(2)=MON(2).OR."40
	MON(3)=MON(3).OR."40
	IF(SW(2,6).NE.0)GOTO 7608
	WRITE(7,7436)SFILE,LENGTH,DATE(1),MON,DATE(3)
	GOTO 7624
7608	WRITE(7,7436)SFILE,LENGTH,DATE(1),MON,DATE(3),STOBLK
	GOTO 7624
7610	LENGTH=0
	GOTO 7611
7683	IF(SW(2,6).NE.0)GOTO 7684
	WRITE(7,7438)SFILE,LENGTH
	GOTO 7624
7684	WRITE(7,7438)SFILE,LENGTH,STOBLK
	GOTO 7624
7685	LENGTH=-NUMB(DIR(X1+1))		!LENGTH OF EMPTY BLOCK
	FREE=FREE+LENGTH
7611	IF(SW(2,6).EQ.0)GOTO 7624	!PRINT EMPTY BLOCK?
	WRITE(7,7438)EMPTY,LENGTH,STOBLK
7624	STOBLK=STOBLK+LENGTH
7620	X1=X1+2
	X=X+1
	X1=X*256
	IF(X.LT.ABLK)GOTO 7602
7880	WRITE(7,7879)FILES,BLKS,FREE
	CALL CLOSE(7)		!RESET CHANNEL 7 TO TT:
7879	FORMAT(' ',I5' files,'I5' blocks'/' 'I5' free blocks'/)
	GOTO 9000
C  RENAME A FILE	
7000	IF(FLAG.EQ..FALSE.)GOTO 2770
	IF(SW(2,1).NE.0)GOTO 7100	!FILE IS IN OS/8 FORMAT?
	DO 7200 I=1,4			!CONVERT FILE NAMES TO RAD50
	RBLK(I)=FILE(I+15)		!AND STORE IN RBLK
7200	RBLK(I+4)=FILE(I)
	I=IRENAM(INCHAN,RBLK) 	!RENAME RT/11 FILE
	IF(I.EQ.2)GOTO 3900	!FILE NOT FOUND
	IF(I.NE.0)STOP'BAD RENAM'
	GOTO 9000
7100	IF(FLAG.EQ..FALSE.)GOTO 2770
	IF(LOOKUP(INCHAN,DBLK).LT.0)STOP'BAD LOOKUP 6'
	CALL DIRECT(INCHAN,ABLK)		!LOAD ITS DIRECTORY
C  SEARCH FOR OLD FILE NAME
	CALL SEARCH(SFILE,START,LENGTH,ABLK,FOUND,IBLK,ENT)
	IF(FOUND.EQ..FALSE.)GOTO 3900
C  SEARCH FOR NEW NAME IF IT EXISTS DELETE IT
	CALL SEARCH(TFILE,START,LEN2,ABLK,FOUND,MI,MT)
	IF(FOUND.EQ..TRUE.)GOTO 7327
C INSERT NEW FILE NAME INTO DIRECTORY
7110	CALL UPDATE(IBLK,ENT,TFILE,LENGTH,INCHAN,L3,SW(1,3))
	GOTO 9000
7327 	CALL UPDATE(MI,MT,TFILE,LEN2,INCHAN,EL,1HD)	!RENAME OS/8 FILE
	CALL DIRECT(INCHAN,ABLK)	!LOAD NEW DIRECTORY
	GOTO 7110
C  DELETE A FILE
7600	IF(SW(2,1).NE.0)GOTO 7654	!DELETE AN RT/11 FILE
	I=IDELET(INCHAN,FILE(16))
	IF(I.EQ.2)GOTO 3900
	IF(I.NE.0)STOP'BAD DELETE'
	GOTO 9000
7654	IF(LOOKUP(INCHAN,DBLK).LT.0)STOP'BAD LOOKUP 7'
	CALL DIRECT(INCHAN,DBLK)
	CALL SEARCH(SFILE,START,LENGTH,ABLK,FOUND,IBLK,ENT)
	IF(FOUND.EQ..FALSE.)GOTO 3900
	CALL UPDATE(IBLK,ENT,SFILE,LENGTH,INCHAN,L3,SW(1,5))
	GOTO 9000
C
C  TELL USER AN ILLEGAL DEVICE WAS SPECIFIED IN COMMAND LINE.
C
141	WRITE(7,142)AFILE
142	FORMAT('+?PIP8-F-Illegal device specified '14A1,/)
	GOTO 9000			!TRY AGAIN
147	WRITE(7,142)BFILE
	GOTO 9000			!PRINT ERROR MESSAGE
2660	WRITE(7,2661)			!NO OS/8 FILES ON DL:
	GOTO 9000
2661	FORMAT('+?PIP8-F-Illegal option for specified device '/)
118	FORMAT('+?PIP8-F-Illegal option specified '/)
391	FORMAT('+PIP8 Y08A'/)
7436	FORMAT('   '6A'.'3A,X,I4,X,I2'-'3A'-'I2,X,O6)
7438	FORMAT('   '6A'.'3A,X,I4,11X,O6)
2558	FORMAT('+?PIP8-F-Input disc in wrong format '/)
2559	FORMAT('+?PIP8-F-Output disc in wrong format '/)
2770	WRITE(7,2771)
2771	FORMAT('+?PIP8-F-Illegal rename;different devices '/)
	GOTO 9000
2775	WRITE(7,2776)
2776	FORMAT('+?PIP8-F-Read error '/)
	GOTO 9000
3900	WRITE(7,3901)AFILE
3901	FORMAT('+?PIP8-F-File not found '14A1,/) 
	GOTO 9000
3950	WRITE(7,3951)BFILE
3951	FORMAT('+?PIP8-F-Output device full '14A1,/)
C CLOSE FILES AND FREE CHANNELS BEFORE GETTING NEXT COMMAND
9000	CALL CLOSEC(INCHAN)
	IF(IFREEC(INCHAN).NE.0)STOP'BAD FREE'
	CALL CLOSEC(OUTCHN)
	IF(IFREEC(OUTCHN).NE.0)STOP'BAD FREEC OUT'
	GOTO 1
	STOP 'END'
	END
	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
