program READLD c c Associates LD unit numbers with complete filespecs. c Results are written to the file WF:LDLGCL.TMP. c (The logical name WF must be assigned to some device). c Information on the LD units are written in descending order, c to make processing in IND files easier. c c The LD assignments are gotten by means of a SPFUN call, so c this part of the program works with both RT-11 and TSX+. c LDACTV tells if a unit is mounted (active). c DEVUNT is the unit number of the device on which the file c is mounted by LD. c LDUNIT is the LD unit number. c The physical - logical association is gotten in the subroutine c TRNLOG. It currently will accumulate up to three logical names c per LD unit. To change this, change LNSIZ. c This subroutine will not work with TSX+ because the logical names c are stored differently. c c Written by: c R. W. Barnard c BIO/Comp Applications c P. O. Box 5342 c Albuquerque, NM 87185 c c Version 2.0, 6-May-87. c parameter (LNSIZ=3) !Max number of names allowed. integer*2 BUF(80), LDHAN(4), SPFCOD integer*2 CTLWRD(8), LDACTV(8), DEVUNT(8) integer*2 LDUNIT(8), LOGCNT(8) character*48 NULLS character*13 OUTFIL character*3 LOGICL(8,LNSIZ) byte FILSTR(14,8), SUCCES, CRLF(2) c data FILSTR /112*' '/ data CRLF /13, 10/ data LOGCNT /8*1/ data LDNUM /LNSIZ/ !Pass this to TRNLOG. data LDHAN /3RLD ,3*0/ data MASK1, MASK2 /32767, 7/ c parameter (OUTFIL='WF:LDLGCL.TMP') parameter (SPFCOD='372'O) c ICHAN= IGETC () if (IFETCH (LDHAN).lt.0) stop 'READLD: bad FETCH on LD handler' if (LOOKUP (ICHAN, LDHAN).lt.0) stop 'READLD: bad LOOKUP on LD handler' IERR= ISPFNW (SPFCOD, ICHAN, 80, BUF, 0) if (IERR.ne.0) then type 90, IERR call EXIT (4) endif c do 10 K= 3, 10 J= K- 2 if (BUF(K).lt.0) then !If <0, then LD is in use. LDACTV(J)= 1 !Set the "active" flag. CTLWRD(J)= IAND (MASK1, BUF(K))/ 256 !Get rid of junk. else !LD unit not in use. LDACTV(J)= 0 CTLWRD(J)= BUF(K)/ 256 endif DEVUNT(J)= IAND (MASK2, CTLWRD(J)) !Mounted device unit number. LDUNIT(J)= J- 1 !LD unit number. 10 continue c do 20 K= 27, 58, 4 !Get the file names. J= (K- 26)/ 4+ 1 call R50ASC (3, BUF(K), FILSTR(1,J)) !Convert the pieces call R50ASC (3, BUF(K+1), FILSTR(5,J)) !from RAD50 to call R50ASC (3, BUF(K+2), FILSTR(8,J)) !ASCII. call R50ASC (3, BUF(K+3), FILSTR(12,J)) 20 continue c do 30 I= 1, 8 NSHIFT= 0 ISTART= 0 if (LDACTV(I).ne.0) then FILSTR(3,I)= DEVUNT(I)+ 48 !Add the device unit number FILSTR(4,I)= ':' !and the : and . in the FILSTR(11,I)= '.' !filespec. c do 25 K= 6, 10 if (FILSTR(K,I).eq.' ') then !Need to remove if (NSHIFT.eq.0) ISTART= K !embedded blanks. NSHIFT= NSHIFT+ 1 endif 25 continue c if (NSHIFT.gt.0) then !Get rid of embedded do 26 K= ISTART, 14- NSHIFT !blanks in file FILSTR(K,I)= FILSTR(K+NSHIFT,I) !names. 26 continue do 27 K= 15- NSHIFT, 14 FILSTR(K,I)= ' ' 27 continue endif endif 30 continue c c Get the logical associations. call TRNLOG (LOGICL, LOGCNT, LDNUM, SUCCES) c open (unit=1, file=OUTFIL, type='NEW', access='DIRECT', 1 form='FORMATTED', recl=48, associatevariable=IRD, initialsize=1, 2 err= 60) IRD= 1 if (.not.SUCCES) then !Failure getting logical write (1'IRD, 120) CRLF !names. call EXIT endif NMOUNT= 0 do 40 I= 8, 1, -1 !List the LDs in descending order. if (LDACTV(I).ne.0) then do 41 J= 14, 5, -1 if (FILSTR(J,I).ne.' ') then !Write the info. write (1'IRD, 100) LDUNIT(I), (FILSTR(K,I),K=1,J), 1 (LOGICL(I,K),K=1,3), CRLF NMOUNT= NMOUNT+ 1 go to 40 endif 41 continue endif 40 continue c if (NMOUNT.eq.0) write (1'IRD, 110) CRLF !Nothing mounted. do 50 K= IRD, 8 !Write nulls to the rest of write (1'IRD, '(A)') NULLS !the output file. 50 continue write (1'IRD, 130) CRLF !Write a blank line. close (unit=1) call EXIT c 60 type 140, 7 !Problem opening the output file. call EXIT (4) !Indicate error. c 90 format (' READLD: bad SPFUN on LD handler- ' I3) 100 format ('LD'I1, 1X A1, 1X 3(A, ','), T46, ' ' 2A1) 110 format ('No LD units mounted' 2A1) 120 format ('Error reading logical names' 2A1) 130 format (T46, ' ' 2A1) 140 format ('0 Be sure logical name WF: is assigned!' A1/) end subroutine TRNLOG (LOGICL, LOGCNT, LDNUM, SUCCES) c c Translate logical <-> physical names from the monitor. c Results are stored in a position-dependent array LOGICL. c It is dimensioned to allow up to LDNUM logical names c per device (e.g., DU1 is DK, A, WF). c integer*2 LOGCNT(8), SYSGEN, TSXQ, TBLSIZ integer*2 RTDATA, PNPTR, OFS, PNAME, USER1, USER2, SIZE character*3 LOGICL(8,LDNUM), PHYDEV, LOGDEV byte PHYNAM(3), LOGNAM(3), SUCCES c equivalence (PHYNAM, PHYDEV), (LOGNAM, LOGDEV) c parameter (TBLSIZ=200) !Allowance for size of $PNAME. parameter (SYSGEN='372'O) c TSXQ= ISPY (SYSGEN) !See if we're running TSX+. if (TSXQ.lt.0) then !If we are running TSX+, just do 5 K= 1, 8 !pretend there are no logical LOGCNT(K)= 1 !assignments. LOGICL(K,1)= ' ' 5 continue else !We're running RT. RTDATA= IPEEK('54'O) !Start of RMON. PNPTR= ISPY ('404'O) !Offset to $PNAME table. PNAME= RTDATA+ PNPTR-1 do 10 K= 1, TBLSIZ, 2 !Go through the $PNAME OFS= PNAME+ K !table to see how long K1= IPEEK (OFS) !it is. if (K1.eq.-1) go to 20 !At the end, continue. 10 continue SUCCES= .false. !We didn't find the end of the return !table - failure! c 20 SIZE= (K- 1)/2+ 4 !Size of the table. USER2= PNAME- SIZE !Location of PHYSICAL name table. USER1= USER2- SIZE !Location of LOGICAL name table. do 30 K= 1, SIZE, 2 !Run through physical table looking OFS= USER1+ K !for LD's. K1= IPEEK (OFS) !Read the physical name. call R50ASC (3, K1, PHYNAM) if (PHYDEV(1:2).eq.'LD') then !If it is LD, look at the OFS= USER2+ K !corresponding logical name. K1= IPEEK (OFS) call R50ASC (3, K1, LOGNAM) if (LOGDEV.eq.' ') go to 30 !Need this to clean up monitor tables. LDUNIT= PHYNAM(3)- 48+ 1 !Index into LOGICL is LD unit number. if (LOGCNT(LDUNIT).gt.LDNUM) LOGCNT(LDUNIT)= LDNUM LOGICL(LDUNIT, LOGCNT(LDUNIT))= LOGDEV !Copy to output array. LOGCNT(LDUNIT)= LOGCNT(LDUNIT)+ 1 endif 30 continue endif c do 40 K= 1, 8 !Now sanitize the output arrays if (LOGCNT(K).le.LDNUM) LOGCNT(K)= LOGCNT(K)-1 if (LOGCNT(K).eq.0) LOGCNT(K)= 1 !for better display. 40 continue SUCCES= .true. return c end