FTN 
      PROGRAM CNTR2(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-18018
C     RELOC:     92069-16015
C 
C 
C****************************************************************:
C 
C 
C 
C 
C                $CONTROL PROCESSOR 
C 
C ABSTRACT: 
C 
C  THIS MODULE PROCESSES THE "$CONTROL:" COMMAND. 
C  WHEN A "$CONTROL:" COMMAND IS USED, IT MUST BE THE FIRST RECORD
C  IN THE SCHEMA COMMAND FILE.
C 
C  CNTR PARSES EACH PARAMETER AND SETS THE APPROPRIATE TOGGLE 
C  ON/OFF IN THE ARRAY "INFO".  IF AN ERROR IS ENCOUNTERED AFTER
C  THE "$CONTROL:" COMMAND, AN ERROR IS ISSUED AND THAT CONTROL 
C  OPTION IS SKIPPED.  PROCESSING FOR CONTROL OPTIONS CONTINUES 
C  UNTIL A "        " IS ENCOUNTERED. 
C 
C  EACH CONTROL OPTION IS ASSIGNED A "RESNO" BY THE MODULE GGLOB. 
C  THIS RESNO IS USED TO INDEX INTO AN ARRAY CALL "NFO" WHICH 
C  CONTAINS THE TOGGLE VALUE FOR THAT PARTICULAR PAAMETER.  THE 
C  RESNO IS ALSO USED TO INDEX INTO AN ARRAY CALLED "NFONX" WHICH 
C  CONTAINS THE INDEX VALUE INTO "INFO" FOR THAT PARTICULAR 
C  PARAMETER.  "INFO" IS THE TOGGLE ARRAY ACCESSED BY OTHER 
C  SUBROUTINES.  ( FOR MORE DETAILED DESCRIPTIONS OF RESNO'S
C  SEE THE MODULE GGLOB.) 
C 
C  NOTE: TYPE, RESNO AND IGLOB ARE RETURNED BY GGLOB WHO
C    CALLS GGLOB, WHO CALLS GCHAR, WHO CALLS GCARD. 
C 
C        TYPE IS THE TYPE OF VALUE IN IGLOB 
C        RESNO IS THE COMMAND WORD NUMBER 
C        IGLOB IS THE VALUE ITSELF
C 
C          (SEE GGLOB FOR MORE DETAIL)
C 
C 
C  NOTE: CODE, AND CHAR ARE RETURNED FROM GCHAR 
C 
C        CODE IS THE TYPE OF CHARACTER
C        CHAR IS THE LAST CHARACTER EXAMINED
C           (CHAR IS NOT DUPLICATED IN IGLOB, BUT IS THE
C             NEXT CHARACTER TO BE PROCESSED) 
C 
C           (SEE GCHAR FOR MORE DETAIL) 
C 
C 
C 
C  COMMAND FORAMT:
C 
C      $CONTROL: [OPTIONS LIST] 
C 
C      WHERE: 
C 
C      OPTIONS LIST 
C      IS A LIST OF OPTIONS SEPARATED BY COMMAS 
C 
C          ROOT -  REQUESTS THE ROOT FILE TO BE CREATED 
C          NOROOT- REQUESTS THE ROOT FILE NOT TO BE CREATED.
C 
C             WHEN NEITHER OPTIONS IS GIVEN ROOT IS ASSUMED.
C             WHEN NOROOT IS GIVEN NO DATA SETS ARE CREATED.
C 
C          SET - REQUESTS DATA SETS TO BE CREATED 
C          NOSET - REQUEST NO DATA SETS TO BE CREATED.
C 
C             WHEN NEITHER OPTIONS IS GIVEN SET IS ASSUMED
C             WHEN NOROOT IS GIVEN, THE SET OPTION IS IGNORED.
C 
C          LIST -  REQUESTS A LISTING OF THE SCHEMA AS IT IS PROCESSED. 
C          NOLIST -  REQUESTS THE SCHEMA LISTING TO BE SUPPRESSED,
C             ONLY RECORDS IN ERROR ARE LISTED. 
C 
C             WHEN NEITHER OPTIONS IS GIVEN LIST IS ASSUMED.
C 
C 
C          TABLE - REQUESTS A TABLE DESCRIBING THE DATA SETS
C             TO BE PRINTED.
C          NOTABLE -  REQUESTS THE TABLE TO BE SUPPRESSED.
C 
C             WHEN NEITHER OPTIONS IS GIVEN NOTABLE IS ASSUMED. 
C 
C 
C          FIELD - REQUESTS A TABLE DESCRIBING EACH SET'S ITEM'S
C             OFFSETS INTO THE DATA RECORD. WHEN THIS OPTION
C             IS NOT INCLUDED NO TABLE IS PRINTED.
C 
C          ERRORS = N - REQUESTS ERROR PROCESSING TO TERMINATE
C             ON THE NTH ERROR.  N MUST BE BETWEEN 1 AND 999. 
C             WHEN THIS OPTION IS NOT INCLUDED N IS SET TO 100. 
C 
C 
C 
C 
C 
C 
C 
C 
      INTEGER HEAD(3) 
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 HEAD/2HHE,2HAD,2H2 / 
C 
C 
C 
C VERIFY THAT THIS IS A "$CONTROL" COMMAND
C   IF IT IS NOT OUTPUT "$CONTROL EXPECTED" 
C 
      IF (RESNO .NE. CNTRL) CALL ERXIT(XCNTR) 
C 
C GOOD, PROCESS CONTROL OPTIONS 
C 
      CALL GGLOB
C 
C WHILE NOT(SEMICOLN OR BEGIN DATA BASE ) 
C 
10    CONTINUE
      IF (TYPE .EQ. SEMI) GOTO 50 
      IF (RESNO .EQ. BEGIN) GOTO 60 
C 
C VERIFY OPTION IS LEGAL
C 
      IF ((RESNO .LT. LST) .OR. (RESNO .GT. FIELD)) GOTO 7010 
C 
C HANDLE "ERROR = N" OPTION SPECIALLY 
C 
      IF (RESNO .NE. ERR) GOTO 20 
      CALL GGLOB
      IF (TYPE .NE. EQUAL) GOTO 7010
      CALL GGLOB
      IF ((TYPE .NE. INTGR) .OR. (IGLOB .GT. 999)) GOTO 7010
C 
C PUT ERROR COUNT IN INFO 
C 
      NDX = NFONX(ERR)
      INFO(NDX) = IGLOB 
      GO TO 30
C 
C GET INDEX INTO INFO FROM NFONX
C 
20    CONTINUE
      NDX = NFONX(RESNO)
C 
C GET CORRECT FLAG FROM NFO AND PUT IT INTO INFO
C 
      INFO(NDX) = NFO(RESNO)
C 
C VERIFY THE COMMA  OR SEMICOLON
C IF NOT THEN OUTPUT "ILLEGAL SEPARATOR"
C 
30    CONTINUE
      CALL GGLOB
      IF((TYPE .NE. COMMA) .AND. (TYPE .NE. SEMI) ) CALL EMESS(ILSEP) 
C 
C SKIP PAST THE COMMA, OR UPTO A SEMICOLN 
C  AND RETURN TO TOP OF WHILE LOOP
C 
40    CONTINUE
      CALL SCAN(COMMA)
      GOTO 10 
C 
C SCAN PAST THE SEMICOLON 
C 
50    CONTINUE
      CALL SCAN(SEMI) 
C 
C LOAD AND EXECUTE HEAD 
C 
60    CONTINUE
      CALL SEGLD(HEAD,IERR) 
C 
C IF SEGLD RETURNS THEN ERROR 
C 
      CALL OUTLN(HEAD,2)
      CALL ERXIT(NOSEG) 
C 
C 
C 
C ERROR HANDLERS
C 
C 
C 
C OUTPUT "ILLEGAL CONTROL OPTION" 
C 
7010  CALL EMESS(ILCTR) 
      GOTO 40 
      END