.;
.;  SLIB.ALL
.;	COMMAND FILE TO BUILD SLIB.TSK
.;
.OPEN SLIB.FTN;111
.ENABLE DATA
      PROGRAM SLIB
C+
C SLIB PROGRAM
C	PROGRAM TO SEARCH AN OBJECT LIBRARY
C	USING ENTRY POINT NAMES
C	INFORMATION TO LIST FILE
C
C  WRITTEN BY:  DAVID J. STRAIT      13-JUL-83
C               APPLIED DYNAMICS INTERNATIONAL
C
C  REVISION: 13-JUL-83     BY: DJS
C
C  INPUT:
C	>RRM $SLIB LSTFILE=LIBFILE-ENTNAME
C	OR
C	>RUN $SLIB
C	SLIB>LSTFILE=LIBFILE-ENTNAME
C
C	IF NO "=" LIST GOES TO TI:
C
C   OUTPUT:
C	FILE NAMED GETS LIB INFORMATION
C
C  SUBS CALLED:
C	SETEXT	- SET FILE EXTENSION ( DJS LIB )
C-
      LOGICAL*1 CMDBUF(80)
      INTEGER*2 CMDBEG,CMDLEN,LSTSIZ,LIBBEG,NAMBEG,NAME1(3)
      INTEGER*2 BEGENT,CNTENT,SIZENT,BEGMOD,CNTMOD,SIZMOD,NAME(3)
      INTEGER*2 NBLOCK,BLOCK(256),SIZE,I,LST,OLB,RADENT(2),RADMOD(2)
      DATA LST,OLB/3RLST,3ROLB/
C
C  GET COMMAND LINE
C
      CMDBEG = 1
      CALL ASSIGN(1,'TI:',3)
      CALL GETMCR(CMDBUF,CMDLEN)
      IF (CMDLEN.LE.0) GO TO 20
      DO 10 I = 1,CMDLEN
         CMDBEG = CMDBEG + 1
         IF (CMDBUF(I).EQ.' ') GO TO 25
  10  CONTINUE
C
  20  WRITE(1,1001)
1001  FORMAT('$SLIB>')
      READ(1,1000,END=9999) CMDLEN,CMDBUF
1000  FORMAT(Q,80A1)
C
C  FIND IF AN EQUALS
C
  25  DO 30 I = CMDBEG,CMDLEN
        IF (CMDBUF(I).NE.'=') GO TO 30
          LSTSIZ = I - CMDBEG
          LIBBEG = I + 1
          CALL ASSIGN(1,'SY:',3)
          CALL ASSIGN(1,CMDBUF(CMDBEG),LSTSIZ)
          CALL SETEXT(1,LST)
          GO TO 40
  30  CONTINUE
      LIBBEG = CMDBEG
C
C  FIND "-"
C
  40  DO 50 I=LIBBEG,CMDLEN
        IF (CMDBUF(I).EQ.'-') GO TO 60
  50  CONTINUE
      CALL CLOSE(1)
      CALL ASSIGN(1,'TI:',3)
      WRITE(1,*) 'COMMAND LINE ERROR - NO MODULE NAME FOUND'
      GO TO 9999
C
C  OPEN LIBARY FILE
C
  60  NAMBEG = I + 1
      CALL ASSIGN(2,CMDBUF(LIBBEG),I-LIBBEG)
      CALL SETEXT(2,OLB)
      CALL FDBSET(2,'R')
      DEFINE FILE 2("77777,256,U,NBLOCK)
C
C  READ FIRST BLOCK
C
      READ(2'1,ERR=9010) BLOCK
C
C  GET ENTRY POINT RECORD SIZE, BEGINING BLOCK, NUMBER OF RECORDS
C  AND MODULE ENTRY RECORD SIZE, BEGINING BLOCK, NUMBER OF RECORDS
C
      SIZENT = ( BLOCK(10) .AND. "377 ) / 2	!  SIZE IN WORDS
      BEGENT = BLOCK(11)
      CNTENT = BLOCK(12) - BLOCK(13)
C
      SIZMOD = ( BLOCK(14) .AND. "377 ) / 2
      BEGMOD = BLOCK(15)
      CNTMOD = BLOCK(16) - BLOCK(17)
C
C  WRITE HEADER
C
      WRITE(1,1009)
1009  FORMAT(' NAME - MODULE')
      IF (NAMBEG.GT.CMDLEN) GO TO 9900
      do 90 i=nambeg,cmdlen
        if (cmdbuf(i).lt.97) go to 90
        if (cmdbuf(i).gt.172) go to 90
          cmdbuf(i) = cmdbuf(i) .and. "137	!  convert to upper case
  90  continue
C
C  GET ENTRY POINT NAME
C
 100  IF (NAMBEG.GT.CMDLEN) GO TO 9900
      NCHAR = IRAD50(6,CMDBUF(NAMBEG),RADENT)
      IF (NCHAR .EQ. 0) GO TO 9020
      CALL R50ASC(6,RADENT,NAME)	!  SAVE NAME IN ASCII
      NAMBEG = NAMBEG + NCHAR
      IF (CMDBUF(NAMBEG).EQ.'-') NAMBEG = NAMBEG + 1
C
C  SEARCH FOR ENTRY
C
      IBLOCK = BEGENT - 1
      IADD = 256 - SIZENT
      DO 150 I = 1,CNTENT
        IADD = IADD + SIZENT
        IF (IADD.LT.256) GO TO 120
          IBLOCK = IBLOCK + 1
          READ(2'IBLOCK) BLOCK
          IADD = IADD - 256
 120    IF (BLOCK(IADD+1).NE.RADENT(1)) GO TO 150
        IF (BLOCK(IADD+2).EQ.RADENT(2)) GO TO 200
 150    CONTINUE
C
C  ENTRY NOT FOUND
C
       WRITE(1,1900) NAME
1900  FORMAT(1X,3A2,'  NOT FOUND')
      GO TO 100
C
C   FIND MODULE NAME
C
 200  IB = BLOCK(IADD+3)
      IA = BLOCK(IADD+4)
      IBLOCK = BEGMOD - 1
      IADD = 256 - SIZMOD
      DO 220 I = 1,CNTMOD
        IADD = IADD + SIZMOD
        IF (IADD.LT.256) GO TO 210
          IBLOCK = IBLOCK + 1
          IADD = IADD - 256
          READ(2'IBLOCK) BLOCK
 210    IF (BLOCK(IADD+3).NE.IB) GO TO 220
        IF (BLOCK(IADD+4).EQ.IA) GO TO 230
 220  CONTINUE
C
C  ERROR MODULE NOT FOUND
C
      WRITE(1,*) ' ERROR SEARCHING FOR MODULE NAME'
      GO TO 9900
C
C   PRINT MODULE NAME
C
 230  CALL R50ASC(6,BLOCK(IADD+1),NAME1)
      WRITE(1,1010) NAME,NAME1
1010  FORMAT(1X,3A2,1X,3A2)
      GO TO 100
C
C  ERROR PRINT OUT
C
9010  CALL CLOSE(1)
      CALL ASSIGN(1,'TI:',3)
      WRITE(1,1910)
1910  FORMAT(' LIBRARY FILE READ ERROR')
      GO TO 9900
C
9020  CALL CLOSE(1)
      CALL ASSIGN(1,'TI:',3)
      WRITE(1,1920)
1920  FORMAT(' COMMAND LINE ERROR - BAD CHARACTER IN ENTRY NAME')
C
9900  CALL CLOSE(1)
      CALL CLOSE(2)
9999  CALL EXIT
      END
.DISABLE DATA
.CLOSE
.;
.OPEN SLIB.TKB;111
.ENABLE DATA
SLIB;1/CP,SLIB;1/-SP/-WI=SLIB
,DJS/LB:SETEXT
,LB:[1,1]FOROTS/LB
/
UNITS=2
ACTFIL=2
TASK=SLB
LIBR=FCSRES:RO
MAXBUF=512
//
.DISABLE DATA
.CLOSE
.;
FOR SLIB;1=SLIB/-SN
TKB @SLIB.TKB;111
PIP SLIB.TKB;111,SLIB.FTN;111,SLIB.OBJ;1/DE