FTN 
      PROGRAM ITEM2(5,90),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-18021
C     RELOC:     92069-16015
C 
C 
C****************************************************************:
C 
C 
C 
C             ITEM: PROCESSOR 
C 
C ABSTRACT: 
C 
C THIS SEGMENT PROCESSES THE "ITEMS:" COMMAND.  THE SYNTAX OF THE 
C ITEM DEFINITION FIELD IS AS FOLLOWS:
C 
C      ITEMS: 
C 
C      ITEM NAME, [ELEMENT COUNT] ITEM TYPE [(READ LEVEL,WRITE LEVEL)] ;
C 
C THE PROCESSING IS TERMINATED WHEN A "SETS:" IS FOUND INSTEAD OF AN ITEM 
C NAME. 
C 
C 
C 
      INTEGER SETS(3) 
C 
      INTEGER ECNT
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 SETS/2HSE,2HTS,2H2 / 
C 
C VERIFY THIS IS AN ITEM: COMMAND 
C 
      IF (RESNO .NE. ITM) CALL ERXIT(XITM)
C 
C INITIALIZE ITEM TABLE POINTER 
C 
      CALL SROOT(DBITP,ITMST) 
      ITMTB = ITMST * 2 
      ICNT = 0
C 
C GET THE ITEM NAME, TURNING OFF THE CHECK FOR RESERVED WORDS 
C 
10    CONTINUE
      NMFLG = .TRUE.
      CALL GGLOB
      NMFLG = .FALSE. 
C 
C 
C SINCE KEYWORDS WERE NOT CHECKED, THE "SETS:" COMMAND
C MUST BE MANUALLY CHECKED. 
C 
C 
      IF (LGLOB .NE. 2) GOTO 15 
      IF( JSCOM(IGLOB,1,4,SETS,1) .NE. 0) GOTO 15 
C 
C VERIFY THE COLON
C 
      CALL SGET(CARD,CRDPR,ICHK)
      IF(ICHK .NE. 72B) GOTO 15 
C 
C SKIP PAST THE COLON AND SET THE RESNO TO INDICATE A "SETS:" COMMAND 
C WAS FOUND 
C 
      CALL GGLOB
      RESNO = SET 
      GOTO 50 
C 
C ARE THERE TOO MANY ITEMS SPECIFIED ?
C 
15    CONTINUE
      IF(ICNT .GE. MXITM) GO TO 7010
C 
C IS THIS A VALID ITEM NAME?
C 
      IF(TYPE .NE. NAM) GOTO 7020 
C 
C SEARCH FOR DUPLICATE ITEM NAME
C 
      CALL ISRCH(ICNT,INUM) 
C FOUND?
      IF(INUM .NE. 0) GOTO 7030 
C NO, CALCULATE INDEX INTO ITEM TABLE 
      INDX = ICNT*ITMSZ + ITMTB 
      INDX2 = INDX
C 
C ZERO THE CURRENT ITEM TABLE ENTRY 
C 
      DO 20 I= INDX,INDX+ITMSZ,2
      CALL SROOT(I,0) 
20    CONTINUE
C 
C PUT SET NAME INTO THE SET TABLES
C 
      DO 30 I =1,3
      CALL SROOT(INDX2,IGLOB(I) ) 
      INDX2 = INDX2 + 2 
30    CONTINUE
C 
C VERIFY A COMMA EXISTS 
C 
      CALL GGLOB
      IF(TYPE .NE. COMMA) GOTO 7040 
C 
C PROCESS THE ELEMENT COUNT 
C 
      CALL ELEMT (ECNT,INDX,IERR) 
      IF (IERR .LT. 0) GOTO 40
C 
C PROCESS TYPE SPECIFICATION
C 
      CALL ITMT(ECNT,INDX,IERR) 
      IF (IERR .LT. 0) GO TO 40 
C 
C PROCESS READ/WRITE LEVELS 
C 
      CALL RDWRL(INDX,IERR) 
      IF (IERR .LT. 0) GO TO 40 
C 
C PUT ITEM ENTRY INTO SORT TABLE
C 
      CALL SSORT(ICNT,SORTI,ITMSZ,ITMTB)
      IF (IERR .LT. 0) GO TO 40 
C 
C INCREMENT COUNTER IN PREPERATION FOR NEXT ITEM
C 
      ICNT = ICNT + 1 
C 
C SCAN PAST THE SEMICOLON 
C 
40    CONTINUE
      IF(TYPE .EQ. SEMI) GOTO 10
      IF(RESNO .EQ. END) CALL ERXIT(UEND) 
      CALL GGLOB
      GOTO 40 
C 
C 
C PUT ITEM COUNT IN ROOT
C 
50    CONTINUE
      IF(ICNT .EQ. 0) CALL ERXIT(DEFIT) 
      CALL SROOT(DBICT,ICNT)
C 
C PUT ADDRESS OF SET TABLE IN ROOT
C 
      SETTB = (ICNT * ITMSZ + ITMTB) / 2
      CALL SROOT(DBSTP,SETTB) 
C 
C LOAD AND EXECUTE SEGEMENT SETS
C 
      CALL SEGLD(SETS,IERR) 
      CALL OUTLN(SETS,3)
      CALL ERXIT(NOSEG) 
C 
C 
C 
C ERROR PROCESSORS
C 
C 
C OUTPUT "TOO MANY ITEMS" 
C 
7010  CALL EMESS(ITLIM) 
C 
C SCAN TO THE SETS: COMMAND 
C 
7015  CONTINUE
      IF(RESNO .EQ. SET) GOTO 50
      CALL GGLOB
      GOTO 7015 
C 
C OUTPUT "ILLEGAL NAME" 
C 
7020  CALL EMESS(ILNAM) 
      GOTO 40 
C 
C OUTPUT "DUPLICATE ITEM NAME"
C 
7030  CALL EMESS(DUPIT) 
      GOTO 40 
C 
C OUTPUT "ILLEGAL SEPARATOR"
C 
7040  CALL EMESS(ILSEP) 
      GO TO 40
      END