FTN PROGRAM HEAD2(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-16015 C RELOC: 92069-16015 C C C****************************************************************: C C C C "BEGIN DATA BASE" COMMAND PROCESSOR C C C C ABSTRACT: C C HEAD HANDLES THE "BEGIN DATA BASE:" CONTROL STATEMENT. IT SAVES TEH DATA C BASE NAME, SECURITY CODE, AND CARTRIDGE NUMBER IN THE DATA BASE. C C COMMAND FORMAT: C C BEGIN DATA BASE: ; C C WHERE: C C DATA BASE NAMR C IS AN FMP NAMR WHICH CONTAINS THE FILE NAME, SECURITY CODE C AND CARTRIDGE NUMBER - NO MORE AND NO LESS. C C THE SECURITY CODE, AND THE CARTRIDGE NUMBER MAY BE C TWO ASCII CHARACTERS, OR AN INTEGER BETWEEN 1 AND C 32,767. C C C INTEGER LEVEL(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 LEVEL/2HLE,2HVL,2H2 / C C C VERIFY "BEGIN DATA BASE" C IF (RESNO .NE. BEGIN) GOTO 7010 CALL GGLOB IF (RESNO .NE. DATA) GOTO 7010 CALL GGLOB IF (RESNO .NE. BASE) GOTO 7010 C C GOOD, PROCESS DATA BASE NAME C NMFLG = .TRUE. CALL GGLOB NMFLG = .FALSE. C CALL DBNMR(RFILE,DSEC,DCRN,IERR) IF (IERR .LT. 0) GOTO 20 IF(DSEC .EQ. 0) CALL EMESS(ILNMR) C C VERIFY THE SEMICOLN C IF NOT OUTPUT MESSAGE C AND CONTINUE CALL GGLOB IF(TYPE .NE. SEMI) CALL EMESS(ILTRM) C C PUT DATA BASE NAME IN ROOT C INDX = DBNAM DO 10 I=1,3 CALL SROOT(INDX,RFILE(I) ) INDX = INDX + 2 10 CONTINUE C C PUT SECURITY NUMBER IN ROOT C CALL SROOT(DBSCD,DSEC) C C PUT CARTRIDGE NUMBER IN THE DATA BASE CONTROL BLOCK C CALL SROOT(DBCRN,DCRN) C C INITIALIZE NODE NUMBER TO -1 C CALL SROOT(DBDSN,-1) C C SCAN PAST SEMICOLN C 20 CONTINUE CALL SCAN(SEMI) C C LOAD AND EXECUTE NEXT SEGMENT C 30 CONTINUE CALL SEGLD(LEVEL,IERR) C C IF SEGLD RETURNS THEN ERROR C CALL OUTLN(LEVEL,3) CALL ERXIT(NOSEG) C C OUTPUT "'BEGIN DATA BASE' EXPECTED." C 7010 CALL EMESS(XBEGN) IF (RESNO .EQ. LEVL ) GO TO 30 GO TO 20 END