C PIP8 Y08B C MODIF. 24-MAR-81 /H.P.STOEHREL C USES NOW RX02 - FLOPPY DRIVES.OS/8-FLOPPIES,HOWEVER, C MUST BE IN SINGLE DENSITY. C 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 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."6.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."6.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 Y08B'/) 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