FTN 
      SUBROUTINE RDWRL(IINDX,IERR),92069-16015 REV.2026 800124
C 
C 
C*****************************************************************
C (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED 
C NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR
C TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR
C WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. 
C****************************************************************** 
C 
C 
C     SOURCE:    92069-18041
C     RELOC:     92069-16015
C 
C 
C****************************************************************:
C 
C 
C SUBROUTINE RDWRL
C ABSTRACT:
C 
C THIS SUBROUTINE PROCESSED THE OPTIONAL READ/WRITE LEVEL OF THE
C "ITEMS:" COMMAND.  THE READ LEVEL IS DEFAULTED TO 0 AND THE WRITE 
C LEVEL IS DEFAULTED TO 15 WHEN THEY ARE NOT SPECIFIED.  THE READ 
C LEVEL MUST ALWAYS BE LESS THAN OR EQUAL TO THE WRITE LEVEL.  THIS 
C SUBROUTINE CHECKS THAT A WORD HAS BEEN  SPECIFIED FOR  THE LEVELS 
C BEING USED AS THE READ/WRITE LEVELS.
C 
C CALLING SEQUENCE: 
C 
C     CALL RDWRL(INDX,IERR) 
C 
C       WHERE:
C 
C         IINDX 
C         IS THE INDEX INTO THE ITEM TABLE FOR THE ITEM BEING PROCESSED.
C 
C         IERR
C         IS RETURNED BY RDWRL AND INDICATES ERROR CONDITIONS.
C 
C             0 INDICATES NO ERROR
C 
C            -1 INDICATES ERROR.  WHEN AN ERROR IS DETECTED THE 
C               ERROR MESSAGE IS WRITTEN TO THE LIST DEVICE.
C 
C 
C 
      INTEGER RLEV
      INTEGER WLEV
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980  
C 
C 
C                      CONSTANTS IN INTEGER 
C 
C 
C 
      INTEGER AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 
     1       CAP,CNTRL,COLON,COMMA,CRDLM, 
     2       DATA,DETAIL,DOLLR,DOT, 
     3       ELSE,END,ENTY,EQUAL,ERR, 
     4       FIELD, 
     5       ICODE,INTGR,ITM, 
     6       LEVL,LPARN,LST,
     7       MANU,MXCAP,MAXRC,
     8       MXELE,MXENT,MXITM,MXLEV,MXSTR, 
     9       NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX,NFO,
     C       NOLST,NORES,NOTAB, 
     1       OPSET, 
     2       PMAX,
     3       ROOTR,RPARN, 
     4       SEMI,SET,SMAX, 
     5       UPPER
C 
C 
C 
C 
C                      DATA BASE OFFSETS
C 
C 
C 
      INTEGER DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP,
     1       DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 
     2       DBLVE
C 
C 
C 
C                     ITEM TABLE OFFSETS
C 
C 
C 
      INTEGER ITNME,ITINF,ITTYP,ITSCT,
     1       ITSNO,ITECT,ITLNG,ITMSZ,ITMST
C 
C 
C                     DATA SET TABLE OFFSETS
C 
C 
      INTEGER DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT,
     1       DSITP,DSCAP,DSCCT,DSPAN,SETSZ
C 
C 
C 
C               OFFSET TO OVERHEAD RECORD 
C 
C 
C 
      INTEGER OVRRC,OVRTL,OVFRL,OVDCB,OVREC 
C 
C 
C 
C              ERROR MESSAGES 
C 
C 
      INTEGER ILCTR,ILCRN,ILSEC,XBEGN,XLEV, 
     1       DUPIT,ITLIM,ILITP,FLDER,ILXTP, 
     2       ILWR,ILTRM,NAMX,DUPST,STLIM, 
     3       ENTYX,NOITM,BDSET,BDKEY,DUPHS, 
     4       NOPTH,AERR,RCLIM,CAPX,ILCAP, 
     5       EMPTY,MXERR,EOF,NOSEG,NOMEM, 
     6       DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 
     7       ILRD,ILRNG,SETX,IGNSC,INMX,
     8       PTDUP,DBKEY,ENDX,PDEFC,SIMPT,
     9       BDCNT,RTERR,GOODS,GOODR,BADS,
     C       BADR,ABORT,OPNER,XCNTR,ILLVN,
     1       SRCH2,UEND,XITM,ELERR,ROTER, 
     2       UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 
     3       ILLSC,MORIT,ILPTH,DEFIT, 
     4       ILSRT,SIMPS,UNDST
C 
C 
C                 VARIABLES 
C 
C 
C 
      INTEGER CARD,CHAR,CODE,CRDPR
      REAL CPACK
      INTEGER DSEC,DCRN 
      INTEGER ENTL,ERROR
      LOGICAL NMFLG 
      INTEGER FWAM
      INTEGER GGERR 
      INTEGER ICNT,IDCB,INDX
      INTEGER INFPT,INFO,IGLOB,INPUT,ITMTB
      INTEGER KPACK 
      INTEGER LDCB,LGLOB,LIST,LWAM
      INTEGER MEDIA 
      INTEGER NPACK,NSETS 
      INTEGER OVRHD 
      INTEGER PTHTB 
      INTEGER RDEF,RESNO,RFILE,RINDX
      INTEGER SCNT,SETTB,SINDX,SORTI,SORTS,STYPE
      INTEGER TYPE,PRGFLG 
C 
C 
C    EXTERNAL REFERENCES
C 
C 
      INTEGER ROOTA 
C 
C                      CONSTANTS IN COMMON
C 
C 
C 
      COMMON/CONST/ AUTO,BADC,BASE,BEGIN,BLANK,BLKCD, 
     1       CAP,CNTRL,COLON,COMMA,CRDLM, 
     2       DATA,DETAIL,DOLLR,DOT, 
     3       ELSE,END,ENTY,EQUAL,ERR, 
     4       FIELD, 
     5       ICODE,INTGR,ITM, 
     6       LEVL,LPARN,LST,
     7       MANU,MXCAP(2),MAXRC, 
     8       MXELE,MXENT,MXITM,MXLEV,MXSTR, 
     9       NAM,RSRV,ASET,AUSET,MSET,MASET,DSET,DESET,NM,NFONX(10),
     C       NFO(10), 
     C       NOLST,NORES,NOTAB, 
     1       OPSET, 
     2       PMAX,
     3       ROOTR,RPARN, 
     4       SEMI,SET,SMAX, 
     5       UPPER
C 
C 
C 
C 
C                      DATA BASE OFFSETS
C 
C 
C 
      COMMON/DBCB/ DBNAM,DBSCD,DBCRN,DBDSN,DBRSN,DBICT,DBITP, 
     1       DBSCT,DBSTP,DBSOP,DBFRP,DBLMD,DBLVL, 
     2       DBLVE
C 
C 
C 
C                     ITEM TABLE OFFSETS
C 
C 
C 
      COMMON/ITCB/ ITNME,ITINF,ITTYP,ITSCT, 
     1       ITSNO,ITECT,ITLNG,ITMSZ,ITMST
C 
C 
C                     DATA SET TABLE OFFSETS
C 
C 
      COMMON/DSCB/ DSNME,DSCRN,DSTYP,DSMDL,DSDRL,DSFCT,DSPCT, 
     1       DSITP,DSCAP,DSCCT,DSPAN,SETSZ
C 
C 
C 
C               OFFSET TO OVERHEAD RECORD 
C 
C 
C 
      COMMON /OVCB/OVRRC,OVRTL,OVFRL,OVDCB,OVREC
C 
C 
C 
C              ERROR MESSAGES 
C 
C 
      COMMON/ERRM/ ILCTR,ILCRN,ILSEC,XBEGN,XLEV,
     1       DUPIT,ITLIM,ILITP,FLDER,ILXTP, 
     2       ILWR,ILTRM,NAMX,DUPST,STLIM, 
     3       ENTYX,NOITM,BDSET,BDKEY,DUPHS, 
     4       NOPTH,AERR,RCLIM,CAPX,ILCAP, 
     5       EMPTY,MXERR,EOF,NOSEG,NOMEM, 
     6       DUPLV,ILNAM,ILNMR,LVDEF,ILSEP, 
     7       ILRD,ILRNG,SETX,IGNSC,INMX,
     8       PTDUP,DBKEY,ENDX,PDEFC,SIMPT,
     9       BDCNT,RTERR,GOODS,GOODR,BADS,
     C       BADR,ABORT,OPNER,XCNTR,ILLVN,
     1       SRCH2,UEND,XITM,ELERR,ROTER, 
     2       UNITM,IOAIN,IOAOT,UNRDL,UNWRL,IOERR,ILOPT, 
     3       ILLSC,MORIT,ILPTH,DEFIT, 
     4       ILSRT,SIMPS,UNDST
C 
C 
C                 VARIABLES 
C 
C 
C 
      COMMON// CARD(36),CHAR,CODE,CPACK(50),CRDPR 
      COMMON DSEC,DCRN
      COMMON ENTL,ERROR 
      COMMON NMFLG
      COMMON FWAM 
      COMMON GGERR
      COMMON ICNT,IDCB(144),INDX
      COMMON INFPT,INFO(6),IGLOB(10),INPUT,ITMTB
      COMMON KPACK(50)
      COMMON LDCB(144),LGLOB,LIST,LWAM
      COMMON MEDIA
      COMMON NPACK(50),NSETS(50)
      COMMON OVRHD
      COMMON PTHTB(32)
      COMMON RDEF(64),RESNO,RFILE(3),RINDX
      COMMON SCNT,SETTB,SINDX,SORTI(255),SORTS(50),STYPE
      COMMON TYPE,PRGFLG
C 
C 
C    EXTERNAL REFERENCES
C 
C 
      EXTERNAL ROOTA
C$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ JANUARY 23,1980
C CHANGED COMMON TO ADD ILSRT,SIMPS,UNDST AND INCREASE SIZE OF PTHTB
C 
C 
C SET FLAG TO INDICATE NO ERRORS
C 
      IERR = 0
C 
C PUT DEFAULT READ/ WRITE LEVELS IN TEMP WORD 
C 
      ILEV = 17B
      CALL GGLOB
C 
C IS A READ/WRITE LEVEL SPECIFIED?
C   IF NOT THEN DEFAULT TO READ TO 0 AND WRITE TO 15
C 
      IF (TYPE .EQ. SEMI) GOTO 30 
C YES 
      IF(TYPE .NE. LPARN) GOTO 7050 
C 
C PROCESS READ LEVEL
C 
      CALL GGLOB
      IF (TYPE .NE. INTGR ) GOTO 7010 
      RLEV = IGLOB
      IF ( (RLEV .LT. 1) .OR. (RLEV .GT.15) ) GOTO 7020 
C 
C VERIFY LEVEL WORD EXIST FOR LEVEL 
C 
      CALL RSGET(DBLMD,IFLAG) 
      CALL RSGET( (RLEV-1)*6 + DBLVL,ICHAR) 
      IF(ICHAR .EQ. 40B   .AND. IFLAG .EQ. 0) GOTO 7070 
C 
C PUT READ LEVEL IN TEMP WORD BITS 3-5
C 
      ILEV = RLEV*2**4
C 
C VERIFY COMMA
C 
20    CONTINUE
      CALL GGLOB
      IF (TYPE .NE. COMMA) GOTO 7050
C 
C PROCESS WRITE LEVEL 
C 
      CALL GGLOB
      IF(TYPE .NE. INTGR) GOTO 7030 
      IF( (IGLOB .LT. RLEV) .OR. (IGLOB .GT. 15) ) GOTO 7040
C 
C VERIFY WRITE LEVEL WORD IS DECLARED 
C 
      CALL RSGET(DBLMD,IFLAG) 
      CALL RSGET( (IGLOB-1)*6+DBLVL,ICHAR)
      IF(ICHAR .EQ. 40B   .AND.   IFLAG .EQ. 0) GOTO 7080 
      ILEV = ILEV + IGLOB 
C 
C VERIFY RIGHT PAREN
C 
25    CONTINUE
      CALL GGLOB
      IF (TYPE .NE. RPARN) GOTO 7050
C 
C VERIFY SEMICOLON
C 
      CALL GGLOB
      IF (TYPE .NE. SEMI) GOTO 7060 
30    CONTINUE
      CALL RSPUT(IINDX+ITINF,ILEV)
40    CONTINUE
      RETURN
C 
C 
C 
C ERROR PROCESSORS
C 
C 
C OUTPUT "BAD READ LEVEL" 
C 
7010  CALL EMESS(ILRD)
      GOTO 7065 
C 
C OUTPUT "LEVEL OUT OF RANGE" 
C 
7020  CALL EMESS(ILRNG) 
      ILEV = 20B
      IERR = -1 
      GOTO 20 
C 
C OUTPUT "BAD WRITE LEVEL"
C 
7030  CALL EMESS(ILWR)
      GOTO 7065 
C 
C OUTPUT "LEVEL OUT OF RANGE" 
C 
7040  CALL EMESS(ILRNG) 
7045  ILEV = ILEV+15
      IERR = -1 
      GOTO 25 
C 
C OUTPUT "ILLEGAL SEPARATOR"
C 
7050  CALL EMESS(ILSEP) 
      GOTO 7065 
C 
C OUTPUT "ILLEGAL TERMINATOR" 
C 
7060  CALL EMESS(ILTRM) 
C 
C SET FATAL ERROR OCCURED 
C 
7065  IERR = -1 
      GOTO 40 
C 
C OUTPUT READ LEVEL WORD FOR LEVEL IS NOT DEFINED 
C 
7070  CALL EMESS(UNRDL) 
      GOTO 7065 
C 
C OUTPUT WRITE LEVEL WORD FOR LEVEL IS NOT DEFINED
C 
7080  CONTINUE
      CALL EMESS(UNWRL) 
      GOTO 7045 
      END