FTN4
      LOGICAL FUNCTION TSRD(MEDIA,INDIC,ISTAT,NFORM,KBIN,KSCE,IBUF,IHD),
     . 92903-16312 REV.1913  790112 1705
C 
C     SOURCE 92903-18312
C 
C 
C 
C     **************************************************************
C     * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978.  ALL RIGHTS    *
C     * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- *
C     * PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  *
C     * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  *
C     **************************************************************
C 
C 
C 
C     PROGRAMMER *JCM* HPG
C*********************************************************************
C*                                                                   *
C*              THIS LOGICAL FUNCTION READS A TRANSACTION SPECIFICA- *
C*   TION STORED ON A GIVEN MEDIA AND TRANSFER ITS CONTENTS IN A BU- *
C*   FFER SPECIFIED BY THE USER .                                    *
C*                                                                   *
C*            A TRUE VALUE IS RETURNED IF THE READ OPERATION FAILS   *
C*            A FALSE VALUE IS RETURNED IF THE READ SUCCEEDS         *
C*                                                                   *
C*         DEFINITION OF PARAMETERS :                                *
C*                                                                   *
C*    MEDIA(4) : IS A 4 WORDS LONG BUFFER DEFINES THE MEDIA WHERE    *
C*               THE TRANS. SPECS. ARE STORED :                      *
C*                   -IF A DISC FILE THE FIRST 3 WORDS ARE FILE NAME *
C*                    AND THE FOURTH CR# (0 IF NOT GIVEN)            *
C*               IF MEDIA(1) IS   > 0    AN OPEN/REWIND OF THE MEDIA *
C*               IS PERFORMED                                        *
C*               IF MEDIA(1) IS   < 0    NO OPEN/NO REWIND           *
C*                                                                   *
C*    INDIC    : IS A 1 WORD LONG VARIABLE TO SPECIFY WHAT OPERATION *
C*               IS TO BE PERFORMED :                                *
C*                 INDIC=0  : READ ONLY HEADER OF LIBRARY            *
C*                      =1  : DO NOT READ SPECS ONLY FIND THEM FIRST *
C*                            INREC1 WORDS OF BINARY SPECS ARE STORED IN *
C*                            KBIN                                   *
C*                      =2  : READ BINARY + SOURCE SPECS             *
C*                      =3  : CLOSE MEDIA                            *
C*                      >3  : READ BINARY SPECS + FIRST 10 WORDS OF  *
C*                            SOURCE SPECS IF THE SPECS LENGTH ARE   *
C*                            LESS THAN INDIC                        *
C*                                                                   *
C*   ISTAT     : IS A 1 WORD LONG VARIABLE TO RETURN THE STATUS OF   *
C*               THE PERFORMED OPERATION  :                          *
C*                 ISTAT=0   : NO ERROR                              *
C*                      =1   : GARBAGE TAPE                          *
C*                      =2   : SPECS NOT FOUND                       *
C*                      =3   : OVERFLOW (INDIC>3 ONLY)               *
C*                      =4   : ILLEGAL PARAMETER                     *
C*                      =5   : ERROR IN   LOCKING TYPE 0 LU          *
C*                      =6   : ERROR IN UNLOCKING TYPE 0 LU          *
C*                      =7   : SPECS SECURITY CODE DOESN'T MATCH     *
C*                      =8   : 1ST RECORD INCORRECT LENGTH(BAD REV CODE)
C*                      <0   : FMGR ERROR                            *
C*                                                                   *
C*   NFORM     : IS A 5 WORD LONG BUFFER TO DEFINE THE SPEC TO READ  *
C*               THE FIRST 3 WORDS CONTAINS THE SPECS NAME IF NO NAME*
C*               NFORM(1)=100000B                                    *
C*               NFORM(4)=SPECS #  (IF=100000B NO SPEC # SPECIFIED)  *
C*               NFORM(5)=SPECS SECURITY (IF=100000B NO SC SPECIFIED)*
C*               THE SPEC FIND MUST HAVE THE SAME NAME OR # AS       *
C*               SPECIFIED.                                          *
C*               IF BOTH NFORM(1) AND NFORM(4) ARE = 100000B THE 1ST *
C*               SPECS FOUND WILL BE READ.                           *
C*                                                                   *
C*   KBIN      : ADDRESS OF STORAGE BUFFER FOR BINARY SPECS          *
C*               IF INDIC=1 KBIN(11) MUST BE DECLARED                *
C*                                                                   *
C*   KSCE      : ADDRESS OF STORAGE BUFFER FOR SOURCE SPECS          *
C*               IF INDIC>3  OR INDIC=1  KSCE(11) MUST BE DECLARED   *
C*                                                                   *
C*   IBUF      : 144 WORDS LONG BUFFER (IDCB BUFFER)                 *
C*                                                                   *
C*   IHD       : 15 WORDS LONG BUFFER FOR LIBRARY HEADER             *
C*               THE LIBRARY HEADER IS TRANSMITED ONLY IF INDIC=1    *
C*               OR 2.                                               *
C*                                                                   *
C*********************************************************************
C*
C*
C*
      INTEGER OPEN,BIT15
      LOGICAL IRW,IST,CMPW,READF,RWNDF
      DIMENSION MEDIA(1),NFORM(1),KBIN(1),KSCE(1),IBUF(1),IREG(2) 
      DIMENSION IHD(1)
C 
      EQUIVALENCE (REG,IREG)
      DATA BIT15/100000B/ 
C-----"INREC1" IS THE LENGTH OF THE 1ST RECORD. AS A NEW VERSION OF TGP IS
C     RELEASED, THE VALUE OF "INREC1" SHOULD BE INCREMENTED BY 1 SO THAT
C     OLDER TRANSACTIONS CAN NO LONGER BE READ BY THE NEW VERSION & NO MIX
C     UP CAN OCCUR. THE SAME VARIABLE (INREC1) SHOULD BE SIMILARLY CHANGED
C     IN "TSWR".
      DATA INREC1/11/ 
C 
C INITIALISE LOGICAL FLAGS
C 
C  IRW : IF TRUE MUST REWIND
C  IST : IF FALSE MUST STORE
C 
      TSRD=.FALSE.
      IRW=.FALSE. 
      IST=.TRUE.
C 
C  CHECK CALLING PARAMETERS 
C 
      IF((MEDIA.NE.0).AND.(INDIC.GE.0)) GO TO 100 
      ISTAT=4 
      GO TO 900 
C 
C IF SPEC NAME AND # ARE NOT SPECIFIED STORE FIRST SPEC FOUND 
C 
100   IF((NFORM.EQ.BIT15).AND.(NFORM(4).EQ.BIT15)) IST=.FALSE.
C 
C  REWIND AND OPEN ?
C 
      IF(MEDIA.GT.0) IRW=.TRUE. 
      ISAV=MEDIA
      IF(MEDIA.LT.0) MEDIA=-MEDIA 
C 
      GO TO 500 
C 
C 
C  NORMAL RETURN
C 
270   ISTAT=0 
      MEDIA=ISAV
      RETURN
C 
C 
C  ERROR RETURN 
C 
900   TSRD=.TRUE. 
      MEDIA=ISAV
      RETURN
C 
C 
C  IF INDIC=3  CLOSE FILE 
C 
500   IF(INDIC.NE.3) GO TO 510
      JLU=0 
      IF(IBUF(3).EQ.0) JLU=IAND(77B,IBUF(4))
      CALL CLOSE(IBUF)
      IF(JLU.EQ.0) GO TO 270
C-----REWIND
      CALL EXEC(3,400B+JLU) 
      IF(LURQ(0,JLU,1).EQ.0) GO TO 270
C-----ERROR, UNABLE TO UNLOCK ANYTHING. 
      ISTAT=6 
      GO TO 900 
C 
C  REWIND /OPEN FILE ?
C 
510   IF(.NOT.(IRW)) GO TO 525
      IF(OPEN(IBUF,ISTAT,MEDIA,0,0,MEDIA(4)).LT.0) GO TO 900
C 
C  IF FILE OPENED CHECK FILE TYPE (0 OR 35) 
C 
      IF(ISTAT.EQ.35) GO TO 523 
      IF(ISTAT.EQ.0) GO TO 512
C 
C-----GO TO ERROR RETURN. 
C 
      ISTAT=1 
      GO TO 900 
C 
C-----TYPE 0 FILE.
C 
C-----GET LU NO.
C 
512   JLU=IAND(377B,IBUF(4))
C 
C-----LOCK IT W/O WAIT. 
C 
      IF(LURQ(100001B,JLU,1).EQ.0) GO TO 523
C 
C-----ERROR, UNABLE TO LOCK IT, CLOSE IT, THEN EXIT.
      CALL CLOSE(IBUF)
C 
      ISTAT=5 
      GO TO 900 
C 
C  REWIND 
C 
523   IF(RWNDF(IBUF,ISTAT)) GO TO 900 
C 
C  READ LIBRARY HEADER
C 
      IF(READF(IBUF,ISTAT,KBIN,16,LEN)) GO TO 900 
      IF(LEN.NE.-1) GO TO 524 
      ISTAT=2 
      GO TO 900 
524   IF(LEN.EQ.15) GO TO 527 
      ISTAT=1 
      GO TO 900 
527   IF(INDIC.GT.2) GO TO 525
      CALL MOVEW(KBIN,IHD,15) 
      IF(INDIC.EQ.0) GO TO 270
C 
C 
C  READ FIRST RECORD
C 
525   IF(READF(IBUF,ISTAT,KBIN,INREC1+1,LEN)) GO TO 900 
C 
C  END OF FILE ?
C 
530   IF(LEN.NE.-1) GO TO 540 
      ISTAT=2 
      GO TO 900 
C 
540   IF(LEN.EQ.INREC1) GO TO 550 
      ISTAT=8 
      GO TO 900 
C 
C  IF INDIC > 3 CHECK IF SUFFICIENT SPACE 
C 
550   IF(INDIC.LT.4) GO TO 560
      IF(KBIN.LE.INDIC) GO TO 560 
      ISTAT=3 
      GO TO 900 
C 
C  CHECK IF NAME AND # MATCHES
C 
560   IF(CMPW(KBIN(2),NFORM,3)) IST=.FALSE. 
      IF(KBIN(5).EQ.NFORM(4)) IST=.FALSE. 
      IF(IST) GO TO 562 
      IF(NFORM(5).EQ.BIT15) GO TO 562 
      IF(KBIN(6).EQ.NFORM(5)) GO TO 562 
      ISTAT=7 
      GO TO 900 
C 
562   K=(KBIN-INREC1)/127 
      IR=(KBIN-INREC1)-K*127
C 
C   READ BINARY SPECS 
C 
      L=128 
      IF(INDIC.EQ.1) L=1
      DO 600 I=1,K+1
      IF((I.EQ.K+1).AND.(IR.EQ.0)) GO TO 610
      IOF=INREC1+1+(I-1)*127
      IF(INDIC.EQ.1) IOF=INREC1+1 
      IF(READF(IBUF,ISTAT,KBIN(IOF),L,LEN)) GO TO 900 
580   IF(L.EQ.1) GO TO 600
      ILX=127 
      IF(I.EQ.K+1) ILX=IR 
      IF(LEN.EQ.ILX) GO TO 600
      ISTAT=1 
      GO TO 900 
600   CONTINUE
C 
C   READ SOURCE SPECS 
C 
610   L=128 
      IF((INDIC.EQ.1).OR.(INDIC.GT.3)) L=10 
      DO 700 I=1,21 
      IF((I.GT.1).AND.(L.EQ.10)) L=1
      IOF=1+(I-1)*127 
      IF(L.EQ.1) IOF=11 
      IF((INDIC.EQ.2).AND.(I.EQ.1)) IOF=128 
      IF(READF(IBUF,ISTAT,KSCE(IOF),L,LEN)) GO TO 900 
620   IF(L.NE.128) GO TO 622
      ILX=127 
      IF(I.EQ.21) ILX=7 
      IF(LEN.EQ.ILX) GO TO 622
      ISTAT=1 
      GO TO 900 
622   IF((INDIC.NE.2).OR.(I.NE.1)) GO TO 700
      CALL MOVEW(KSCE(128),KSCE,6)
      CALL MOVEW(KSCE(148),KSCE(21),107)
700   CONTINUE
C 
C  SPECS FOUND ?
C 
      IF(IST) GO TO 525 
C 
      GO TO 270 
C 
C 
C 
      END 
      END$
                                                                    