FTN 
      PROGRAM ENTY2(5,90),92069-16015 REV.2026 800124 
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-18024
C     RELOC:     92069-16015
C 
C     ALTERED:   JANUARY 22, 1980 FOR SORTED CHAINS FEATURE - CEJ 
C 
C 
C****************************************************************:
C 
C 
C 
C "ENTRY:" COMMAND PROCESSOR
C 
C ABSTRACT: 
C 
C THE "ENTRY:" PROCESSOR WILL PROCESS ALL THE ITEM NAMES IN A 
C DATA SET ALLOWING A ITEM NAME TO BE USED ONLY ONCE PER DATA 
C SET.  IT BUILDS THE RECORD DEFINITION TABLE AND THE PATH TABLE
C IN TEMPORARY BUFFERS CALLED "RDEF" AND "PTHTB".  IT DETERMINES
C THE SIZE OF THE MEDIA RECORD AND THE DATA RECORD, AND PUTS THIS 
C IN THE SET TABLE.  BEFORE LOADING THE "CAPACITY:" PROCESSOR, THIS 
C SEGMENT WILL INSURE THAT ALL MASTER DATA SETS HAVE A PATH ITEM, 
C THAT ALL DATA SETS HAVE AT LEAST 1 ITEM, AND AUTOMATIC MASTERS
C HAVE ONLY 1 ITEM WHICH MUST BE A PATH ITEM. 
C 
C 
C 
C 
C 
C 
      INTEGER CAPAC(3)
      INTEGER CAPC(4) 
      INTEGER PTHCT,FLDCT,SIIDX,SITNM 
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
      DATA CAPAC/2HCA,2HPC,2H2 /
      DATA CAPC/2HCA,2HPA,2HCI,2HTY/
C 
C 
C INITIALIZE POINTERS 
C 
C FLDCT IS THE INDEX INTO THE RECORD DEFINITION TABLE BEING 
C      BUILT IN A TEMPORARY BUFFER
C 
C ENTL IS THE LENGTH OF ALL THE ITEMS IN THIS SET 
C 
C PTHCT IS THE NUMBER OF PATHS IN THIS SET.  IT IS ALSO USED
C      AS A WORD POINTER INTO THE TEMPOARAY PATH TABLE. 
C 
C RDEF IS THE TEMPORARY RECORD DEFINITION TABLE 
C 
C PTHTB IS THE TEMPORARY PATH TABLE 
C 
C 
      IF (RESNO .NE. ENTY) GOTO 7010
      FLDCT = 1 
      IERR = 0
      ENTL = 0
      PTHCT = 0 
      SINDX = SCNT*SETSZ+SETTB
C 
      DO 5 I = 1,(MXENT+1)/2
5     RDEF(I) = 0 
C 
      DO 6 I=1,PMAX*2 
6     PTHTB(I) = 0
C 
C 
C MEDIA IS THE LENGTH OF THE MEDIA RECORD FOR THIS SET. 
C THE FIXED MEDIA RECORD OVERHEAD FOR DETAILS IS 3, 
C FOR  MASTERS IT IS 5
C 
      MEDIA = 3 
      IF (STYPE .NE. DETAIL) MEDIA = 5
C 
C GET THE ITEM NAME TURNING OFF THE CHECK FOR RESERVE WORDS 
C 
10    CONTINUE
      CALL NWITM
C 
C STOP LOOP ON SEMICOLON, "CAPACITY:", OR WHEN MAXIMUM
C NUMBER OF ITEMS IS REACHED. 
C 
20    CONTINUE
      IF (TYPE .EQ. SEMI) GOTO 70 
      IF (RESNO .EQ. CAP) GOTO 80 
      IF(FLDCT .GT. MXENT) GOTO 7020
C 
C PROCESS THE ITEM NAME 
C 
      IERR = 0
      CALL GITEM (INDX,INUM,IERR) 
      IF(IERR .NE. 0) GOTO 60 
C 
C IS THERE A PATH?
C     GET THE ITEM TURNING OFF THE CHECK FOR RESERVED WORDS.
C     "NWITM" RETURNS THE SAME VALUES AS "GGLOB". 
C 
      CALL NWITM
      IF ( (TYPE .NE. SEMI) .AND. (TYPE .NE. COMMA) ) GOTO 25 
      IF(STYPE .EQ. AUTO) 7070,45 
C 
C CHECK TO SEE IF THIS IS A PATH ITEM. A PATH WILL BE ENCLOSED
C IN PARENTHESIS. 
C     "NWITM" RETURNS THE SAME VALUES AS "GGLOB" BUT IT DOES
C      NOT CHECK FOR RESERVE WORDS.  THIS ALLOWS ANY ITEM TO
C      BE A PATH ITEM.
C 
25    CONTINUE
      IF (TYPE .NE. LPARN) GOTO 7030
C 
C MAKE SURE A NAME OR A NUMBER FOLLOWS. 
C 
      CALL NWITM
      IF ((TYPE .NE. NAM) .AND. (TYPE .NE. ICODE)) GOTO 7030
C 
C VERIFY PATH ITEM IS NOT AN ARRAY
C 
      CALL RSGET (INDX+ITECT,I) 
      IF(I .EQ. 1) GOTO 27
C 
C OUTPUT "PATH ITEM MUST BE SIMPLE" 
C 
      IERR = -1 
      CALL EMESS(SIMPT) 
      GOTO 35 
C 
C PROCESS THIS PATH ACCORDING TO SET TYPE 
C 
27    CONTINUE
      IF(STYPE .NE. DETAIL) GOTO 30 
      CALL DPTH(INUM,INDX,PTHCT,IERR) 
C 
C CHECK TO SEE IF THIS PATH IS SORTED 
C 
35    CONTINUE
      CALL GGLOB
      IF (TYPE .NE. LPARN) GOTO 37
C 
C PROCESS SORT ITEM 
C 
      CALL NWITM
      CALL STITM(INUM,PTHCT,IERR) 
C 
C VERIFY RIGHT PARENTHESIS
C 
      CALL GGLOB
      IF (TYPE .NE. RPARN) GOTO 7030
      GOTO 36 
C 
C 
C 
30    CONTINUE
      CALL MPTH(INUM,PTHCT,IERR)
C 
C VERIFY RIGHT PAREN
C 
36    CONTINUE
      CALL GGLOB
37    CONTINUE
      IF(TYPE .NE. RPARN) GOTO 7030 
C 
C VERIFY COMMA OR SEMICOLON 
C 
      CALL GGLOB
      IF ( (TYPE .NE. COMMA) .AND. (TYPE .NE. SEMI) ) GOTO 7080 
C 
C IF NO ERROR 
C   THEN PUT VALUES IN TABLES 
C   IF THE SET IS A DETAIL, INCREMENT THE PATH COUNT
C 
      IF (IERR .LT. 0) GOTO 60
      IF (STYPE .EQ. DETAIL) PTHCT = PTHCT+1
C 
C UPDATE MEDIA RECORD LENGTH
C 
      IF (STYPE .NE. DETAIL) GOTO 42
      MEDIA = MEDIA + 4 
      GOTO 45 
C 
C GET MEDIA FOR MASTER
C 
42    CONTINUE
      MEDIA = MEDIA + PTHCT*6 
C 
C PUT ITEM NUMBER IN RECORD DEFINITION TABLE
C CHECK TO BE SURE THIS ITEM HAS NOT ALREADY BEEN DEFINED IN THIS SET 
C 
45    CONTINUE
      IF (FLDCT .EQ. 1) GO TO 47
      DO 46 I = 1,FLDCT-1 
      CALL SGET(RDEF,I,ICHK)
      IF(ICHK .EQ. INUM) GOTO 7040
46    CONTINUE
47    CONTINUE
C 
C PUT THE ENTRY INTO THE RECORD DEFINITION TABLE
C 
      CALL SPUT(RDEF,FLDCT,INUM)
      FLDCT = FLDCT + 1 
C 
C UPDATE ENTRY LENGTH 
C 
      ENTL = ENTL + ROOTA(INDX+ITLNG) 
C 
C MAKE SURE RECORD ISN'T TOO LARGE
C 
      IF(ENTL+MEDIA .GT. MAXRC) GOTO 7090 
C 
C INCREASE SET COUNT IN ITEM TABLE
C 
      CALL RSGET (INDX + ITSCT, N)
      N = N+1 
      CALL RSPUT(INDX+ITSCT,N)
C 
C IF THIS IS FIRST SET TO USE ITEM PUT NUMBER IN TABLE
C 
      CALL RSGET(INDX+ITSNO,N)
      IF(N .EQ. 0) CALL RSPUT(INDX+ITSNO,SCNT+1)
C 
C SCAN PAST COMMA 
C 
60    CONTINUE
      GGERR = GGERR + IERR
C 
C SCAN PAST COMMA UPTO SEMICOLN 
C 
64    CONTINUE
      IF(TYPE .EQ. COMMA) GOTO 63 
      IF(TYPE .EQ. SEMI) GOTO 65
      CALL NWITM
      GOTO 64 
C 
C SCAN PAST THE COMMA 
C 
63    CALL NWITM
C 
C RETURN TO TOP OF LOOP 
C 
65    GOTO 20 
C 
C SCAN PAST SEMICOMMA 
C 
70    CONTINUE
      CALL SCAN(SEMI) 
C 
C DONE WITH "ENTRY:" COMMAND
C 
C VERIFY THAT PATHS ARE DEFINED IN MASTER SETS
C 
80    CONTINUE
      IF (STYPE .EQ. DETAIL) GOTO 81
      CALL RSGET(SINDX+DSCCT,INUM)
      IF(INUM .EQ. 0) 7060,85 
C 
C VERIFY THAT ALL SORT ITEMS ARE DEFINED IN DETAIL DATA SET 
C 
81    CONTINUE
      IF (PTHCT .EQ. 0) GOTO 85 
      DO 83 I=2,PTHCT*2,2 
      INUM = PTHTB(I) 
      IF (INUM .EQ. 0) GOTO 83
      DO 82 J=1,FLDCT-1 
      CALL SGET(RDEF,J,ICHK)
      IF (INUM .EQ. ICHK) GOTO 83 
82    CONTINUE
      GOTO 7110 
83    CONTINUE
C 
C PUT MEDIA + ENTRY LENGTH IN SET TABLE 
C 
85    CONTINUE
      CALL RSPUT(SINDX+DSMDL,MEDIA) 
      CALL SROOT(SINDX+DSDRL,ENTL)
C 
C PUT FIELD COUNT IN SET TABLE
C 
      FLDCT = FLDCT - 1 
      IF(FLDCT .EQ. 0) GOTO 7100
      CALL RSPUT(SINDX+DSFCT,FLDCT) 
C 
C PUT THE PATH COUNT IN THE SET TABLE 
C 
      CALL RSPUT(SINDX+DSPCT,PTHCT) 
C 
C LOAD AND EXECUTE "CAPACITY:" COMMAND PROCESSOR
C 
90    CONTINUE
      GGERR = IERR+GGERR
      CALL SEGLD(CAPAC,IERR)
C 
C IF SEGLD RETURNS THEN ERROR 
C 
      CALL OUTLN(CAPAC,3) 
      CALL ERXIT(NOSEG) 
C 
C 
C 
C ERROR PROCESSORS
C 
C 
C 
C OUTPUT "ENTRY: EXPECTED"
C 
7010  CALL EMESS(ENTYX) 
      IF (RESNO .EQ. CAP) 80,70 
C 
C OUTPUT "TOO MANY ITEMS" 
C 
7020  CALL EMESS(ITLIM) 
      IERR = -1 
      GOTO 70 
C 
C OUTPUT "ILLEGAL SEPARATOR"
C 
7030  CALL EMESS(ILSEP) 
      IERR = -1 
      GOTO 60 
C 
C OUTPUT "DUPLICATE ITEM NAME"
C 
7040  CALL EMESS(DUPIT) 
      IERR = -1 
      GOTO 60 
C 
C OUTPUT "MASTER MUST HAVE A PATH 
C 
7060  CALL EMESS(NOPTH) 
      IERR = -1 
      GOTO 85 
C 
C OUTPUT "AUTOMATIC MASTER MUST HAVE KEY ITEM ONLY" 
C 
7070  CALL EMESS(AERR)
      IERR = -1 
      GOTO 60 
C 
C OUTPUT "ILLEGAL TERMINATOR" 
C 
7080  CALL EMESS(ILTRM) 
      IERR = -1 
      GOTO 60 
C 
C OUTPUT "RECORD TOO BIG" 
C 
7090  CALL EMESS(RCLIM) 
      IERR = -1 
      GOTO 60 
C 
C OUTPUT "DATA SET MUST HAVE AN ITEM" 
C 
7100  CALL EMESS(MORIT) 
      IERR = -1 
      GOTO 90 
C 
C OUTPUT "SORT ITEM NOT DEFINED IN SET" 
C 
7110  CALL EMESS(UNDST) 
      IERR = -1 
      GOTO 85 
      END