CCC FILE NAME : LIBCAT.FT LAST MOD : 20-NOV-81 C C PRINTS CATALOG OF SEGMENTS AND ENTRY POINTS C FROM FORTRAN II RELOCATBLE LIBRARY BUILT BY LIBSET. C C .COMP LIBCAT C .LOAD LIBCAT(IOUH) C .SAVE SYS LIBCAT DIMENSION IBUF(256),ITEXT(40),IIFN(4),IOFN(4),IIDN(2),IODN(2) WRITE(1,101) 101 FORMAT('L\IBCAT\ 1.6'T16'C\ATALOG OF RELOCATABLE LIBRARY.\') CALL FIXIO('@*@@') WHILE (.TRUE.) READ(1,111)ITEXT 111 FORMAT(40A2) CALL ZFILL(ITEXT,40) IF (INTFS(ITEXT,IODN,IOFN,IIDN,IIFN) .GT. 0) THEN IF (IODN .EQ. 0) CALL MOVE('TTY ',IODN,2) IF (IOFN .EQ. 0) CALL MOVE('LIBCATLS',IOFN,4) IOFX=IOFN(4) IF (IIDN .EQ. 0) CALL MOVE('DSK ',IIDN,2) IF (IIFN .EQ. 0) STOP IIFX=IIFN(4) IF (IIFX .EQ. 0) IIFX='RL' CALL ZFILL(IODN,-2) CALL ZFILL(IOFN,-3) CALL ZFILL(IOFX,-1) CALL ZFILL(IIDN,-2) CALL ZFILL(IIFN,-3) CALL ZFILL(IIFX,-1) IIFN(4)=IIFX IOFN(4)=IOFX CALL OPENI(4,IIDN,IIFN,IIFX) IF (IOHST(4)) THEN CALL READB(4,256,IBUF) IF (IOHST(4)) THEN CALL OPENO(5,IODN,IOFN,IOFX) IF (IOHST(5)) THEN WRITE(5,200)IIFN INDEX=0 ISEG=0 LCW=-1 WHILE (IBUF(INDEX+1) .NE. 0) L=IBUF(INDEX+3+1) IF (L .NE. LCW) THEN LCW=L ISEG=ISEG+1 IPAG=IBUF(LCW+1)/200B.AND.37B IF (IPAG.EQ.1) I=' ' IF (IPAG.NE.1) I='S ' WRITE(5,201)ISEG,IPAG,I, ENDIF CALL IOH(IBUF(INDEX+1)) INDEX=INDEX+4 ENDWHILE WRITE(5,202)INDEX/4,(LCW-INDEX)/5 CALL CHRIO(5,214B) CALL CLOSE(5) STOP ELSE WRITE(1,902)IODN,IOFN ENDIF ELSE WRITE(1,903)IIDN,IIFN ENDIF ELSE WRITE(1,901)IIDN,IIFN ENDIF ELSE CALL ZFILL(ITEXT,-40) WRITE(1,908)ITEXT ENDIF ENDWHILE 200 FORMAT(/// 1/8X'C\ATALOG OF \L\IBRARY \F\ILE\ '3A2'.'A2 1/8X'-\----------\-\-------\-\---\-----------'//) 201 FORMAT(//8X'S\EGMENT\ #'I2','I3' P\AGE'A1'\'99(T35,6(A6,X)/)) 202 FORMAT(///8X,I2' E\NTRY POINTS, WITH ROOM FOR ABOUT'I3' MORE.\'/) 901 FORMAT(/'I\NPUT\ F\ILE\ '2A2':'3A2'.'A2' \NOT FOUND.\'/) 902 FORMAT(/'O\UTPUT\ F\ILE\ '2A2':'3A2'.'A2' \NOT OPENED.\'/) 903 FORMAT(/'I\NPUT\ F\ILE\ '2A2':'3A2'.'A2' I/O E\RROR.\'/) 908 FORMAT(/'U\NABLE TO PROCESS *\'40A2/) END