************************************************** 1) DR3:[1,22]BRUDIR.FOR;27 1 C R J D Kirkman. 1981 - A program to produce directory listings of *************** 2) DR3:[1,22]BRUDIR.VAX;1 1 2 C R J D Kirkman. 1981 - A program to produce directory listings of ************************************************** 1) DR3:[1,22]BRUDIR.FOR;27 9 C slow version of BRUDIR, Uses a workfile to cater for 10000 files on disk *************** 2) DR3:[1,22]BRUDIR.VAX;1 10 C 2nd mod, convert to VMS, handle new IAS Format F. Borger, May 3, 1985 11 C 12 C slow version of BRUDIR, Uses a workfile to cater for 10000 files on disk ************************************************** 1) DR3:[1,22]BRUDIR.FOR;27 20 INTEGER IBUFF(2072) 21 BYTE BBUFF(4144) 22 INTEGER*4 LONG,IALLOC,IMAX,IUSED 23 INTEGER*4 KFIL,KUSD,KALL 24 C *************** 2) DR3:[1,22]BRUDIR.VAX;1 23 INTEGER*2 IBUFF(2072) 24 BYTE BBUFF(4144) 25 EQUIVALENCE(IBUFF(1),BBUFF(1)) 26 INTEGER*4 LONG,IALLOC,IMAX,IUSED 27 INTEGER*4 KFIL,KUSD,KALL 28 INTEGER*4 ISTAT,SYS$ASSIGN 29 C ************************************************** 1) DR3:[1,22]BRUDIR.FOR;27 27 INTEGER PRL(6),IOSB(2) 28 C *************** 2) DR3:[1,22]BRUDIR.VAX;1 32 INTEGER*2 IOSB(4) 33 C ************************************************** 1) DR3:[1,22]BRUDIR.FOR;27 32 INTEGER IDIR(8) 33 LOGICAL*1 RADGRO(3),RADUSR(3) *************** 2) DR3:[1,22]BRUDIR.VAX;1 37 INTEGER*2 IDIR(8) 38 LOGICAL*1 RADGRO(3),RADUSR(3) ************************************************** 1) DR3:[1,22]BRUDIR.FOR;27 39 EQUIVALENCE(IBUFF(1),BBUFF(1)) 40 C *************** 2) DR3:[1,22]BRUDIR.VAX;1 44 C ************************************************** 1) DR3:[1,22]BRUDIR.FOR;27 43 TYPE*,'** BRU Directory listing x01.00' 44 TYPE1000 45 1000 FORMAT('$Input Tapedeck:') 46 ACCEPT1010,TEMP 47 1010 FORMAT(40A1) 48 IF (TEMP(1).GT.'Z')TEMP(1)=TEMP(1)-32 49 IF (TEMP(2).GT.'Z')TEMP(2)=TEMP(2)-32 50 IUNIT=TEMP(3)-'0' 51 IF(IUNIT.GT.7.OR.UNIT.LT.0)IUNIT=0 52 IF(TEMP(5).EQ.':')IUNIT=IUNIT*8+TEMP(4)-48 !'0' 53 CALL ASNLUN(6,TEMP,IUNIT,IDS) 54 IF(IDS.NE.1)TYPE*,'ASNLUN fails ',IDS 55 IF(IDS.NE.1)CALL EXIT 56 1013 TYPE1015 57 1015 FORMAT(' IASV3.1/LATER RSX (1)'/ 58 1' EARLY RSX (2)'/ 59 2'$ OR IASV3.2 (3) ? ') *************** 2) DR3:[1,22]BRUDIR.VAX;1 47 COMMON/BUFFER/IBUFF 48 COMMON/TAPEIO/CHANNEL,IOSB 49 CHANNEL=6 50 ISTAT=SYS$ASSIGN('TAPE',CHANNEL,,) 51 IF(.NOT.ISTAT) CALL LIB$STOP(%VAL(ISTAT)) 52 TYPE*,'** BRU Directory listing x01.00' 53 C TYPE1000 54 C1000 FORMAT('$Input Tapedeck:') 55 C ACCEPT1010,TEMP 56 1010 FORMAT(40A1) 57 C IF (TEMP(1).GT.'Z')TEMP(1)=TEMP(1)-32 58 C IF (TEMP(2).GT.'Z')TEMP(2)=TEMP(2)-32 59 C IUNIT=TEMP(3)-'0' 60 C IF(IUNIT.GT.7.OR.UNIT.LT.0)IUNIT=0 61 C IF(TEMP(5).EQ.':')IUNIT=IUNIT*8+TEMP(4)-48 !'0' 62 C CALL ASNLUN(6,TEMP,IUNIT,IDS) 63 C IF(IDS.NE.1)TYPE*,'ASNLUN fails ',IDS 64 C IF(IDS.NE.1)CALL EXIT 65 1013 TYPE1015 66 1015 FORMAT(' IASV3.1/LATER RSX (1)'/ 67 1' EARLY RSX (2)'/ 68 2'$ OR IASV3.2 (3) ? ') ************************************************** 1) DR3:[1,22]BRUDIR.FOR;27 62 TYPE1020 63 ACCEPT*,IDENS 64 1020 FORMAT('$Density (800/1600):') 65 PRL(1)="4004 !1600 or coredump 66 IF(IDENS.EQ.800)PRL(1)=4 67 CALL WTQIO("1400,6,6) !attach 68 CALL WTQIO("2400,6,6) !rewind 69 CALL WTQIO("2500,6,6,,IOSB,PRL) !set density 70 TYPE1030 71 1030 FORMAT('$Listing format (FULL,BRIEF,LIST):') 72 ACCEPT1010,TEMP 73 IFORMT=1 !list *************** 2) DR3:[1,22]BRUDIR.VAX;1 71 C TYPE1020 72 C ACCEPT*,IDENS 73 C 1020 FORMAT('$Density (800/1600):') 74 C PRL(1)="4004 !1600 or coredump 75 C IF(IDENS.EQ.800)PRL(1)=4 76 C CALL WTQIO("1400,6,6) !attach 77 C CALL WTQIO("2400,6,6) !rewind 78 CALL REWIND 79 C CALL WTQIO("2500,6,6,,IOSB,PRL) !set density 80 TYPE1030 81 1030 FORMAT('$Listing format (FULL,BRIEF,LIST):') 82 ACCEPT 1010,TEMP 83 IFORMT=1 !list ************************************************** 1) DR3:[1,22]BRUDIR.FOR;27 81 IF(ILEN.EQ.0)CALL ASNLUN(4,'TI',0) !default TTY output 82 IF(ILEN.NE.0)CALL ASNLUN(4,'SY',0) 83 TEMP(ILEN+1)=0 *************** 2) DR3:[1,22]BRUDIR.VAX;1 91 C IF(ILEN.EQ.0)CALL ASNLUN(4,'TI',0) !default TTY output 92 C IF(ILEN.NE.0)CALL ASNLUN(4,'SY',0) 93 TEMP(ILEN+1)=0 ************************************************** 1) DR3:[1,22]BRUDIR.FOR;27 86 IF(ILEN.EQ.0)OPEN(UNIT=4,NAME='TI:',CARRIAGECONTROL='LIST', 87 / TYPE='NEW') 88 C 89 C at this point we should be at BOT with the tapedeck on LUN 6 90 C the listing file open on LUN 4. 91 C the terminal for errors/comments on lun 5 *************** 2) DR3:[1,22]BRUDIR.VAX;1 96 C IF(ILEN.EQ.0)OPEN(UNIT=4,NAME='TI:',CARRIAGECONTROL='LIST', 97 C / TYPE='NEW') 98 C 99 C at this point we should be at BOT with the tapedeck on LUN 6 100 C the listing file open on LUN 4. 101 C the terminal for errors/comments on lun 5 ************************************************** 1) DR3:[1,22]BRUDIR.FOR;27 98 CALL GETADR(PRL,IBUFF) 99 PRL(2)=4144 100 CALL WTQIO("1000,6,6,,IOSB,PRL) 101 IF(IOSB(1).NE.1)TYPE*,'Error on volume label read',IOSB 102 IF(IOSB(2).NE.80)TYPE*,'Unexpected length at BOT',IOSB 103 IF(IBUFF(1).NE.'VO'.OR.IBUFF(2).NE.'L1')TYPE*, 104 / 'Not VOL1 at BOT' *************** 2) DR3:[1,22]BRUDIR.VAX;1 108 C CALL GETADR(PRL,IBUFF) 109 C PRL(2)=4144 110 C CALL WTQIO("1000,6,6,,IOSB,PRL) 111 CALL READTP 112 IF(IOSB(1).NE.1) TYPE*,'Error on volume label read',IOSB 113 IF(IOSB(2).NE.80) TYPE*,'Unexpected length at BOT',IOSB 114 IF(IBUFF(1).NE.'VO'.OR.IBUFF(2).NE.'L1') TYPE*, 115 / 'Not VOL1 at BOT' ************************************************** 1) DR3:[1,22]BRUDIR.FOR;27 107 CALL WTQIO("1000,6,6,,IOSB,PRL) 108 IF(IOSB(2).NE.512)TYPE*,'Boot block error - Prob not BRU tape' *************** 2) DR3:[1,22]BRUDIR.VAX;1 118 C CALL WTQIO("1000,6,6,,IOSB,PRL) 119 CALL READTP 120 IF(IOSB(2).NE.512)TYPE*,'Boot block error - Prob not BRU tape' ************************************************** 1) DR3:[1,22]BRUDIR.FOR;27 116 CALL WTQIO("1000,6,6,,IOSB,PRL) 117 IF(IOSB(1).EQ."366)GOTO 8060 118 IF(IOSB(1).NE.1)TYPE*,'tape error',IOSB,' on HDR1' *************** 2) DR3:[1,22]BRUDIR.VAX;1 128 C CALL WTQIO("1000,6,6,,IOSB,PRL) 129 CALL READTP 130 IF(IOSB(1).EQ."4160)GOTO 8060 131 IF(IOSB(1).NE.1)TYPE*,'tape error',IOSB,' on HDR1' ************************************************** 1) DR3:[1,22]BRUDIR.FOR;27 124 CALL WTQIO("1000,6,6,,IOSB,PRL) 125 IF(IBUFF(1).NE.'HD'.OR.IBUFF(2).NE.'R2')TYPE*,'HDR2 expected' 126 CALL WTQIO("1000,6,6,,IOSB,PRL) 127 IF(IOSB(1).NE."366)TYPE*,'Tape mark expected' 128 CALL WTQIO("1000,6,6,,IOSB,PRL) !now backup descriptor 129 IF(IOSB(2).NE.80)TYPE*,'Backupset descriptor expected' *************** 2) DR3:[1,22]BRUDIR.VAX;1 137 C CALL WTQIO("1000,6,6,,IOSB,PRL) 138 CALL READTP 139 IF(IBUFF(1).NE.'HD'.OR.IBUFF(2).NE.'R2')TYPE*,'HDR2 expected' 140 C CALL WTQIO("1000,6,6,,IOSB,PRL) 141 CALL READTP 142 IF(IOSB(1).NE."4160)TYPE*,'Tape mark expected', IOSB 143 C CALL WTQIO("1000,6,6,,IOSB,PRL) !now backup descriptor 144 CALL READTP 145 IF(IOSB(2).NE.80)TYPE*,'Backupset descriptor expected' ************************************************** 1) DR3:[1,22]BRUDIR.FOR;27 143 CALL WTQIO("1000,6,6,,IOSB,PRL) !read boot block 144 CALL WTQIO("1000,6,6,,IOSB,PRL) !read home block 145 I=IBUFF(6) *************** 2) DR3:[1,22]BRUDIR.VAX;1 159 C CALL WTQIO("1000,6,6,,IOSB,PRL) !read boot block 160 CALL READTP 161 C CALL WTQIO("1000,6,6,,IOSB,PRL) !read home block 162 CALL READTP 163 if (ias.eq.3) CALL READTP !read ???? block 164 I=IBUFF(6) ************************************************** 1) DR3:[1,22]BRUDIR.FOR;27 154 C 155 IF (IAS.EQ.3) CALL WTQIO("1000,6,6,,IOSB,PRL) !read ? block 156 C 157 ICOUNT=0 !there are no stored entries yet *************** 2) DR3:[1,22]BRUDIR.VAX;1 173 ICOUNT=0 !there are no stored entries yet ************************************************** 1) DR3:[1,22]BRUDIR.FOR;27 168 C 169 1110 CALL WTQIO("1000,6,6,,IOSB,PRL) 170 IF(IOSB(1).EQ."366)GOTO 8000 !eof 171 1120 IF(IOSB(2).NE.80)TYPE*,'unexpected Sentinel length',IOSB *************** 2) DR3:[1,22]BRUDIR.VAX;1 184 C 185 C 1110 CALL WTQIO("1000,6,6,,IOSB,PRL) 186 1110 CALL READTP 187 IF(IOSB(1).EQ."4160)GOTO 8000 !eof 188 1120 IF(IOSB(2).NE.80)TYPE*,'unexpected Sentinel length',IOSB ************************************************** 1) DR3:[1,22]BRUDIR.FOR;27 192 1130 CALL WTQIO("1000,6,6,,IOSB,PRL) !look for something else. 193 IF(IOSB(1).EQ."366)GOTO 8000 !deal with eof 194 IF(IOSB(2).NE.80)GOTO 1130 !get more entries *************** 2) DR3:[1,22]BRUDIR.VAX;1 209 C 1130 CALL WTQIO("1000,6,6,,IOSB,PRL) !look for something else. 210 1130 CALL READTP 211 IF(IOSB(1).EQ."4160)GOTO 8000 !deal with eof 212 IF(IOSB(2).NE.80)GOTO 1130 !get more entries ************************************************** 1) DR3:[1,22]BRUDIR.FOR;27 208 1150 CALL WTQIO("1000,6,6,,IOSB,PRL) !read another block 209 IF(IOSB(1).EQ."366)GOTO 8000 !eof 210 IF(IOSB(2).EQ.80)GOTO 1120 !find what this is *************** 2) DR3:[1,22]BRUDIR.VAX;1 226 C 1150 CALL WTQIO("1000,6,6,,IOSB,PRL) !read another block 227 1150 CALL READTP 228 IF(IOSB(1).EQ."4160)GOTO 8000 !eof 229 IF(IOSB(2).EQ.80)GOTO 1120 !find what this is ************************************************** 1) DR3:[1,22]BRUDIR.FOR;27 221 IDIR(3)=IUFD 222 C *************** 2) DR3:[1,22]BRUDIR.VAX;1 240 IDIR(3)=IUFD 241 C ************************************************** 1) DR3:[1,22]BRUDIR.FOR;27 247 1170 CALL WTQIO("1000,6,6,,IOSb,PRL) !read ufd block 248 IF(IOSB(1).EQ."366)GOTO 8000 !eof 249 IF(IOSB(2).NE.80)GOTO 1180 *************** 2) DR3:[1,22]BRUDIR.VAX;1 266 C 1170 CALL WTQIO("1000,6,6,,IOSb,PRL) !read ufd block 267 1170 CALL READTP 268 IF(IOSB(1).EQ."4160)GOTO 8000 !eof 269 IF(IOSB(2).NE.80)GOTO 1180 ************************************************** 1) DR3:[1,22]BRUDIR.FOR;27 313 C 314 8000 CALL WTQIO("1000,6,6,,IOSB,PRL) !read EOF1/EOV1 315 IF(BBUFF(3).EQ.'F')GOTO 8040 !was eof1 *************** 2) DR3:[1,22]BRUDIR.VAX;1 333 C 334 C 8000 CALL WTQIO("1000,6,6,,IOSB,PRL) !read EOF1/EOV1 335 8000 CALL READTP 336 IF(BBUFF(3).EQ.'F')GOTO 8040 !was eof1 ************************************************** 1) DR3:[1,22]BRUDIR.FOR;27 318 CALL WTQIO("2540,6,6) !unload input tape 319 8020 CALL WTQIO("2520,6,6,,IOSB) !sense characteristics 320 IF(IAND(IOSB(2),"1400).EQ.0)GOTO 8030 !wait until a new tape 321 CALL WAIT(1,2) !wait 1 second 322 GOTO 8020 !and look again 323 C *************** 2) DR3:[1,22]BRUDIR.VAX;1 339 C CALL WTQIO("2540,6,6) !unload input tape 340 C 8020 CALL WTQIO("2520,6,6,,IOSB) !sense characteristics 341 C IF(IAND(IOSB(2),"1400).EQ.0)GOTO 8030 !wait until a new tape 342 C CALL WAIT(1,2) !wait 1 second 343 C GOTO 8020 !and look again 344 C ************************************************** 1) DR3:[1,22]BRUDIR.FOR;27 326 8030 PRL(1)=1 327 CALL WTQIO("2440,6,6,,IOSB,PRL) !skip 1 to get to header 328 CALL GETADR(PRL,IBUFF) ! 329 PRL(2)=4144 330 CALL WTQIO("1000,6,6,,IOSB,PRL) !after skipping Backupset header 331 GOTO 1110 *************** 2) DR3:[1,22]BRUDIR.VAX;1 347 C 8030 PRL(1)=1 348 C CALL WTQIO("2440,6,6,,IOSB,PRL) !skip 1 to get to header 349 8030 CALL SKIP(1) 350 C CALL GETADR(PRL,IBUFF) ! 351 C PRL(2)=4144 352 C CALL WTQIO("1000,6,6,,IOSB,PRL) !after skipping Backupset header 353 CALL READTP 354 GOTO 1110 ************************************************** 1) DR3:[1,22]BRUDIR.FOR;27 345 PRL(1)=1 !setup to skip eof labels 346 CALL WTQIO("2440,6,6,,IOSB,PRL) ! 347 CALL GETADR(PRL,BBUFF) 348 PRL(2)=4144 349 GOTO 1070 *************** 2) DR3:[1,22]BRUDIR.VAX;1 368 C PRL(1)=1 !setup to skip eof labels 369 C CALL WTQIO("2440,6,6,,IOSB,PRL) ! 370 CALL SKIP(1) 371 C CALL GETADR(PRL,BBUFF) 372 C PRL(2)=4144 373 GOTO 1070 ************************************************** 1) DR3:[1,22]BRUDIR.FOR;27 354 CALL WTQIO("2400,6,6) !rewind again 355 CALL WTQIO("2000,6,6) !and detach 356 CALL EXIT *************** 2) DR3:[1,22]BRUDIR.VAX;1 378 C CALL WTQIO("2400,6,6) !rewind again 379 CALL REWIND 380 C CALL WTQIO("2000,6,6) !and detach 381 CALL EXIT ************************************************** 1) DR3:[1,22]BRUDIR.FOR;27 375 DECODE (3,100,RADGRO) I 376 DECODE (3,100,RADUSR) J 377 100 FORMAT (O3) 378 IUFD=IAND(ISHFT(I,8),"177400) 379 IUFD=IOR(IUFD,J) 380 RETURN 381 END *************** 2) DR3:[1,22]BRUDIR.VAX;1 400 LOGICAL*1 ITMP(4) 401 INTEGER*2 JTMP(2) 402 EQUIVALENCE (ITMP(1),JTMP(1)) 403 DECODE (3,100,RADGRO) JTMP(2) 404 DECODE (3,100,RADUSR) JTMP(1) 405 100 FORMAT (O3) 406 ITMP(2)=ITMP(3) 407 IUFD=JTMP(1) 408 RETURN 409 END 410 c 411 c subroutine to read one record 412 c 413 SUBROUTINE READTP 414 dimension iosb(4) 415 integer*4 retcode,sys$qiow,bufsize 416 common/tapeio/channel,iosb 417 integer*2 ibuff(2072) 418 byte bbuff(4144) 419 equivalence(ibuff(1),bbuff(1)) 420 common/buffer/ibuff 421 parameter io$_readlblk='21'x 422 bufsize=4144 423 retcode=sys$qiow(,%val(channel),%val(io$_readlblk),iosb,,, 424 1%ref(bbuff(1)),%val(bufsize),,,,) 425 return 426 end 427 c 428 c subroutine to skip n records 429 c 430 SUBROUTINE skip(nskip) 431 dimension iosb(4) 432 integer*4 retcode,sys$qiow,bufsize 433 common/tapeio/channel,iosb 434 integer*2 ibuff(2072) 435 parameter io$_skiprecord='26'x 436 retcode=sys$qiow(,%val(channel),%val(io$_skiprecord),iosb,,, 437 1%val(nskip),,,,,) 438 return 439 end 440 c 441 c subroutine to rewind tape 442 c 443 SUBROUTINE rewind 444 dimension iosb(4) 445 common/tapeio/channel,iosb 446 parameter io$_rewind='24'x 447 retcode=sys$qiow(,%val(channel),%val(io$_rewind),iosb,,,,,,,,) 448 return 449 end 27 differences found BRUDIR.DIF=BRUDIR.FOR,BRUDIR.VAX