FTN 
      SUBROUTINE GGLOB,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-18029
C     RELOC:     92069-16015
C 
C 
C****************************************************************:
C 
C 
C 
C 
C  ABSTRACT:
C 
C   GGLOB IS THE MOST FUNDAMENTAL OF THE DBDS ROUTINES.  IT EXTRACTS
C   A WORD AT A TIME FROM THE INPUT SCHEMA DESCRIPTION AND ASSIGNS A
C   TYPE AND A RESNO TO THE WORD.  INTEGERS ARE CONVERTED BEFORE THEY 
C   ARE RETURNED TO THE CALLER.  DOUBLE INTEGERS HAVE A LENGTH OF 2.
C 
C   ALL DATA BASE NAMES, LEVEL WORDS, ITEM NAMES AND SET NAMES
C   ARE PROCESSED IDENTICALLY.  CERTAIN TERMINATORS,
C   SUCH AS ";", ",", ":", "(", ")", AND "=" ARE TREATED AS A WORD AND
C   EACH CHARACTER HAS A UNIQUE TYPE ASSOCIATED WITH IT.  KEYWORDS ARE
C   RECOGNIZED BY GGLOB AND ARE GIVEN A SINGLE TYPE, BUT EACH KEYWORD 
C   HAS A UNIQUE RESNO.  WHEN A WORD IS NOT AN INTEGER, TERMINATOR, OR
C   RESERVE WORD IT IS RETURNED AS A NAME.
C 
C 
C 
C CALLING SEQUENCE: 
C 
C      CALL GGLOB 
C 
C ON EXIT:
C 
C    IGLOB - CONTAINS THE WORD ITSELF 
C    LGLOB - CONTAINS THE LENGTH IN WORDS OF IGLOB
C    RESNO - CONTAINS A RESERVED NUMBER INDICATING THE
C      KEYWORD PROCESSED
C    TYPE - CONTAINS THE TYPE OF KEYWORD
C 
C 
C 
C               RESNO'S 
C 
C 
C       RESNO         RESERVE WORD
C 
C        0             NAME OR INTEGER
C        1             LIST 
C        2             NOLIST 
C        3             ERROR
C        4             ROOT 
C        5             NOROOT 
C        6             TABLE
C        7             NOTABLE
C        8             SET
C        9             NOSET
C        10            FIELD
C        11            $CONTROL 
C        12            UNUSED 
C        13            BEGIN
C        14            DATA 
C        15            BASE 
C        16            END. 
C        17            LEVELS 
C        18            ITEMS
C        19            SETS 
C        20            NAME 
C        21            ENTRY
C        22            CAPACITY 
C        23            A
C        24            AUTOMATIC
C        25            M
C        26            MANUAL 
C        27            D
C        28            DETAIL 
C 
C 
C 
C 
C************************************************************ 
C 
C 
C 
C           TYPE NUMBERS
C 
C       TYPE           MEANING
C 
C        0             ILLEGAL WORD 
C        1             INTEGER
C        2             NAME 
C        3             RESERVE WORD 
C        4             =
C        5             (
C        6             :
C        7             UNUSED 
C        8             ,
C        9            [ BLANK ] 
C        10            )
C        11            ;
C 
C 
C 
C 
C 
C 
C 
C 
      INTEGER GLOBZ 
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 GLOBZ/20/
C 
C 
C 
C INITIALIZE RETURN PARAMETERS
C 
      LGLOB = 0 
      RESNO = 0 
      TYPE = 0
C 
C SHIP LEADING BLANKS 
C 
10    CONTINUE
      IF (CODE .NE. BLKCD)  GOTO 20 
      CALL GCHAR
      GOTO 10 
C 
C BLANK THE RETURN BUFFER 
C 
20    CONTINUE
      DO 30 I = 1,GLOBZ/2 
      IGLOB(I) = BLANK
30    CONTINUE
C 
C IF FIRST CHARACTER IS AN INTEGER THEN PROCESS IT
C 
      IF (CODE .NE. ICODE) GOTO 40
      CALL PINTG(GLOBZ) 
      GOTO 60 
C 
C   ELSE SEE IF IT IS A SPECIAL CHARACTER 
C 
40    CONTINUE
      IF ( (CODE .NE. COMMA) .AND. (CODE .NE. SEMI) .AND. 
     1      (CODE .NE. LPARN) .AND. (CODE .NE. RPARN) .AND. 
     2         (CODE .NE. COLON) .AND. (CODE .NE. EQUAL) ) GOTO 45
      TYPE = CODE 
      LGLOB = 1 
      IGLOB = CHAR
      CALL GCHAR
      GOTO 60 
C 
C  NOT A SPECIAL CHARACTER
C  IS IT AN ILLEGAL CHARACTER?
C 
45    CONTINUE
      IF((CODE .NE. ELSE) .AND. (CODE .NE. BADC) ) GOTO 50
      LGLOB = LGLOB+1 
      CALL SPUT(IGLOB,LGLOB,CHAR) 
      CALL GCHAR
      GOTO 55 
C 
C PICK UP NAME
C 
50    CONTINUE
      TYPE = NAM
      IF ((CODE .GE. EQUAL) .OR. (LGLOB .GT. GLOBZ) ) GOTO 55 
      LGLOB = LGLOB + 1 
      CALL SPUT(IGLOB,LGLOB,CHAR) 
      CALL GCHAR
      GOTO 50 
C 
C CHECK FOR RESERVE WORD
C 
55    CONTINUE
      IF( .NOT. NMFLG) CALL RESRV 
C 
C IF THIS IS A NAME BE SURE IT IS SIX CHARACTERS OR LESS
C 
      IF((LGLOB .GT. 6) .AND.(TYPE .EQ. NAM)) TYPE = 0
C 
C TURN LGLOB INTO A WORD COUNT
C 
      LGLOB = (LGLOB + 1)/2 
60    CONTINUE
      RETURN
      END