FTN 
      PROGRAM NAME2(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-18023
C     RELOC:     92069-16015
C 
C 
C****************************************************************:
C 
C 
C "NAME:" COMMAND PROCESSOR 
C 
C 
C ABSTRACT: 
C 
C THE "NAME:" PROCESSOR VERIFIES THAT THE DATA SET NAME IS A
C LEGAL DATA BASE NAMR, THAT THE SET NAME IS UNIQUE TO THIS DATA
C BASE, THEN BEGINS BUILDING THE DATA SET TABLE ENTRY. (NOTE THAT 
C THIS SEGMENT DOES NOT CHECK TO SEE IF THE DATA SET IS UNIQUE
C TO THE CARTRIDGE.  THAT IS DONE IN THE SEGMENT "ROOT".)  THIS 
C SEGMENT DETERMINES THE DATA SET TYPE AND PUTS IT IN THE SET 
C TABLE.  THEN LOADS AND EXECUTES THE SEGMENT WHICH PROCESSES THE 
C "ENTRY:" COMMAND.  THE SYNTAX OF THE SCHEMA "NAME:" COMMAND IS
C AS FOLLOWS: 
C 
C      NAME:  SETNAME::CRN,SETTYPE; 
C 
C 
C THIS SEGMENT ALSO RECOGNIZES THE "END." COMMAND AND WILL LOAD 
C AND EXECUTE THE SEGMENT WHICH WRAPS UP ALL THE DETAILS FOR THE
C SCHEMA PROCESSOR. 
C 
C 
C 
C 
C 
C 
      INTEGER SNAM(3) 
      INTEGER ENTRY(3)
      INTEGER RAPUP(3)
      INTEGER STYPE 
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 ENTRY/2HEN,2HTY,2H2 /
      DATA RAPUP/2HRA,2HPP,2H2 /
C 
C 
C 
C 
C 
C CHECK FOR "END." COMMAND
C 
      IF (RESNO .EQ. END) GOTO 80 
C 
C VERIFY THIS IS A "NAME:" COMMAND
C 
      IF (RESNO .NE. NM) GOTO 7060
C 
C INTIALIZE THE GLOBAL ERROR INDICATOR
C 
      GGERR = 0 
C 
C VERIFY THERE IS ROOM FOR MORE SETS
C 
      IF (SCNT .GE. SMAX) GOTO 7010 
C 
C PROCESS THE ITEM NAME 
C 
      NMFLG = .TRUE.
      CALL GGLOB
      NMFLG = .FALSE. 
C 
      CALL DBNMR(SNAM,ISC,ICR,IERR) 
      IF(IERR .LT. 0) GOTO 70 
C 
C IF THE SECURITY CODE IS NOT ZERO
C   THEN WARN THE USER IT WILL BE IGNORED 
C 
      IF(ISC .NE. 0) CALL OUTPT(IGNSC)
C 
C VERIFY THIS IS A UNIQUE SET  NAME 
C 
      CALL SSRCH(SCNT,INUM,SNAM)
C 
C SET INDEX TO NEXT SET TABLE ENTRY 
C 
      SINDX = SCNT*SETSZ+SETTB
C 
C ZERO OUT THE MEMORY OF THE NEW SET
C 
      DO 10 I = SINDX,SINDX+SETSZ,2 
      CALL SROOT(I,0) 
10    CONTINUE
C 
C WAS THE SET NAME UNIQUE 
C 
      IF (INUM .EQ. 0) GOTO 15
C 
C OUTPUT " DUPLICATE DATA SET NAME" 
C 
      GGERR = -1
      CALL EMESS(DUPST) 
      GOTO 25 
C 
C PUT SET NAME INTO THE TABLE 
C 
15    CONTINUE
      NMX = SINDX 
      DO 20 I = 1,3 
      CALL SROOT(NMX,SNAM(I) )
      NMX = NMX + 2 
20    CONTINUE
C 
C PUT CARTRIDGE NUMBER INTO SET TABLE 
C 
      CALL SROOT(SINDX+DSCRN,ICR) 
C 
C VERIFY THE COMMA
C 
25    CONTINUE
      CALL GGLOB
      IF (TYPE .NE. COMMA) GOTO 7040
C 
C PROCESS THE SET TYPE
C 
      CALL GGLOB
C 
C VERIFY THIS IS A VALID SET TYPE AND SAVE TYPE IN STYPE
C FOR LATER PROCESSORS.  STYPE IS IDENTICAL TO THE FLAG IN
C THE SET TABLE.
C 
      IF((RESNO .NE. ASET) .AND.(RESNO .NE. AUSET) )GOTO 30 
      STYPE = AUTO
      GOTO 50 
C 
30    CONTINUE
      IF ((RESNO .NE. MSET) .AND. (RESNO .NE. MASET))  GOTO 40
      STYPE = MANU
      GOTO 50 
C 
40    CONTINUE
      IF ((RESNO .NE. DSET) .AND. (RESNO .NE. DESET))  GOTO 7050
      STYPE = DETAIL
C 
C SAVE TYPE IN THE SET TABLE
C 
50    CONTINUE
      CALL RSPUT(SINDX+DSTYP,STYPE) 
C 
C VERIFY THE SEMICOLN 
C 
      CALL GGLOB
      IF(TYPE .NE. SEMI) GOTO 7080
C 
C SCAN PAST THE SEMICOLON 
C 
70    CONTINUE
      CALL SCAN(SEMI) 
C 
C LOAD AND EXECUTE "ENTRY:" PROCESSOR 
C 
75    CONTINUE
      CALL SEGLD(ENTRY,IERR)
C 
C IF SEGLD RETURNS THEN ERROR 
C 
      CALL OUTLN(ENTRY,3) 
      CALL ERXIT(NOSEG) 
C 
C SAVE THE NUMBER OF SETS DEFINED 
C 
80    CONTINUE
      CALL SROOT(DBSCT,SCNT)
      IF(SCNT .EQ. 0) GOTO 7070 
C 
C LOAD AND EXECUTE THE "END." PROCESSOR 
C 
90    CONTINUE
      CALL SEGLD(RAPUP,IERR)
C 
C IF SEGLD RETURNS THE ERRROR 
C 
      CALL OUTLN(RAPUP,2) 
      CALL ERXIT(NOSEG) 
C 
C 
C 
C ERROR PROCESSORS
C 
C 
C 
C OUTPUT "TOO MANY DATA SETS" 
C 
7010  CALL EMESS(STLIM) 
7015  CALL GGLOB
      IF (RESNO .NE. END) GOTO 7015 
      GOTO 80 
C 
C OUTPUT "ILLEGAL SEPARATOR"
C 
7040  CALL EMESS(ILSEP) 
      GOTO 7055 
C 
C OUTPUT "BAD TYPE DESIGNATOR." 
C 
7050  CALL EMESS(ILITP) 
7055  GGERR = -1
      GOTO 70 
C 
C OUTPUT "NAME: EXPECTED" 
C 
7060  CALL EMESS(NAMX)
      GGERR = -1
      IF (RESNO .EQ. ENTY) 75,70
C 
C OUTPUT "DATA BASE HAS NO DATA SETS" 
C 
7070  CALL EMESS(EMPTY) 
      GGERR = -1
      GOTO 90 
C 
C OUTPUT "ILLEGAL TERMINATOR" 
C 
7080  CALL EMESS(ILTRM) 
      GOTO 7055 
      END