FTN 
      PROGRAM RAPP2(5,90),92069-16015 REV.2026 800122 
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-18026
C     RELOC:     92069-16015
C 
C     ALTERED:   JANUARY 22, 1980 FOR SORTED CHAINS FEATURE - CEJ 
C 
C 
C****************************************************************:
C 
C 
C 
C "END." COMMAND PROCESSOR
C 
C 
C ABSTRACT: 
C 
C THIS SEGMENT PROCESSES THE "END." COMMAND.  IT SETS THE FLAG
C TO SUPPRESS THE ECHOING OF THE RECORD IN ERROR SINCE ALL RECORDS
C HAVE BEEN PROCESSED BY NOW.  IT VERIFIES THAT EVERY ITEM WAS
C USED.  IT COMPRESSES ANY UNUSED MEMORY BETWEEN THE LAST SET TABLE 
C AND THE RECORD DEFINITION AND PATH TABLES. (REMEBER THAT THE
C RECORD DEFINITION AND PATH TABLES WERE BEING BUILT AT THE 
C END OF MEMORY TOWARDS THE MAIN PART OF THE RUN TABLE.  THIS 
C WAS BECAUSE RECORD DEFINITION AND PATH TABLES ARE VARIABLE LENGTH.) 
C 
C THIS SEGMENT THEN PUTS THE SORT TABLES AFTER THE RECORD DEFINITION
C AND PATH TABLES.  THEN IT CREATES THE FREE RECORD TABLES, THEN THE
C OVERHEAD RECORD.
C 
C 
C             ------------------      ------------------
C             !                !      !                !
C             !  RUN TABLE     !      !   RUN TABLE    !
C                                     !                !
C             !                !      !                !
C             !                !      !                !
C             !                !      !                !
C             ------------------      ------------------
C             !                !      !                !
C             !      .         !      ! RECORD DEFIN.  !
C             !      .         !      !  & PATH TABLE  !
C             !                !      !                !
C             !                !      ------------------
C             !      .         !      !                !
C             !      .         !      ! ITEM & SET SORT!
C             !                !      !     TABLES     !
C             !                !      ------------------
C             !      .         !      !                !
C             !      .         !      ! FREE SPACE PTRS!
C             !      .         !      !                !
C             !                !      ------------------
C             !                !      ! OVERHEAD RECORD!
C             ------------------      ------------------
C             !  RECORD DEFIN. !      !                !
C             !   & SORT TABLES!      !        .       !
C             !                !      !        .       !
C             ------------------      ------------------
C 
C 
C 
C THIS SEGMENT THEN GATHERS UP INFORMATION NECESSARY FOR THE
C "TABLE" AND "FIELD" OPTIONS.  THEN LOADS AND EXECUTES THE 
C SUMARY SEGMENT. 
C 
C 
C 
C 
      LOGICAL OVF 
      INTEGER NPACK 
      INTEGER IDMAX(2)
      REAL DMAX 
      INTEGER PPTR,PCNT 
      INTEGER INAM(3) 
      INTEGER RCAP(2) 
      INTEGER SPACE 
      INTEGER SUMRY(3)
      INTEGER RCNT,RECSZ
      INTEGER PACK
      INTEGER ENDM
      INTEGER DI1(2),DI128(2) 
      INTEGER IBUF(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
C 
C 
      EQUIVALENCE (DMAX,IDMAX)
C 
C 
      DATA IDMAX/077777B,177777B/ 
      DATA SUMRY/2HSU,2HMY,2H2 /
      DATA DI1/0,1/ 
      DATA DI128/0,128/ 
C 
C VERIFY THIS IS AN "END." COMMAND
C 
      IF (RESNO .NE. END) GOTO 7010 
C 
C ANY EMPTY MEMORY
C 
C TURN THE LISTING FLAG ON, SO THE LAST RECORD WILL NOT 
C PRINTED ON ERRORS.
C 
      NDX = NFONX(LST)
      INFO(NDX) = NFO(LST)
      CRDPR = 0 
C 
C MAKE SURE EVERY ITEM IS USED
C 
      IFLAG = 0 
      ICNT = ROOTA(DBICT) 
      ITMTB = ROOTA(DBITP)*2
      IF(ICNT .LT. 1) GOTO 6
      DO 5 I=ITMTB,(ICNT-1)*ITMSZ+ITMTB,ITMSZ 
      IF(ROOTA(I+ITSCT) .NE. 0) GOTO 5
C 
C IF THIS IS THE FIRST UNUSED ITEM
C   OUTPUT "THE FOLLOWING ITEM(S) ARE UNUSED."
C     FOLLOWED BY THE ITEM NAME 
C 
      IF(IFLAG .EQ. 0) CALL EMESS(UNITM)
      IFLAG = -1
C 
C OUTPUT ITEM NAME
C 
      II=I
      DO 4 J=1,3
      IBUF(J) = ROOTA(II) 
4     II = II+2 
      CALL OUTLN(IBUF,3)
5     CONTINUE
6     CONTINUE
C 
C GET SET COUNT AND SET TABLE ADDRESS 
C 
      SCNT = ROOTA(DBSCT) 
      IF ( SCNT .LE. 0) GOTO 100
      SETTB = ROOTA(DBSTP) * 2
      ENDM = (LWAM-FWAM) * 2
C 
C GET POINTER TO MEMORY JUST PAST THE SET TABLES
C CHECK IF THERE ARE ANY PATH TABLES
C    NOTE: INFPT POINTS TO THE LAST UNUSED WORD, ABOVE
C          THE INFORMATION TABLES 
C 
      RINDX = SETTB + SCNT * SETSZ
      IF(INFPT .LT. RINDX) GOTO 25
      IF(INFPT .EQ. ENDM) GOTO 25 
C 
C YES, MOVE THE INFORMATION TABLES UNDER THE SET TABLES 
C 
      SPACE = ((INFPT+2) - RINDX) / 2 
C 
C 
      DO 10 I= (INFPT+2),ENDM,2 
      CALL SROOT(RINDX,ROOTA(I) ) 
      RINDX = RINDX + 2 
10    CONTINUE
C 
C UPDATE POINTERS IN SET TABLES 
C 
      DO 20 I=0,SCNT-1
      SINDX = I*SETSZ + SETTB 
      IVAL = ROOTA(SINDX + DSITP) - SPACE 
      CALL SROOT(SINDX+DSITP,IVAL)
20    CONTINUE
C 
C PUT POINTER TO SORT TABLE IN MEMORY 
C 
25    CONTINUE
      CALL SROOT(DBSOP,RINDX/2) 
C 
C PUT ITEM SORT TABLE IN MEMORY 
C 
      ICNT = ROOTA(DBICT) 
      IF (ICNT .LE. 0) GOTO 35
      DO 30 I=1,ICNT
      CALL SROOT (RINDX,SORTI(I) )
      RINDX = RINDX + 2 
30    CONTINUE
C 
C PUT SET SORT TABLE IN MEMORY
C 
35    CONTINUE
      DO 40 I = 1,SCNT
      CALL SROOT(RINDX,SORTS(I) ) 
      RINDX = RINDX + 2 
40    CONTINUE
C 
C SAVE THE START OF THE OVERHEAD RECORD 
C   AND INITIALIZE OVERHEAD 
C 
      OVRHD = RINDX 
C 
C GET START RECORD NUMBER OF ROOT FILE
C   START REC. # = 1 REC FOR OVERHEAD + # REC. NEEDED FOR 
C                       FREE SPACE POINTERS + 1 FOR DISPLACEMENT
C 
      N = (SCNT*4+127)/128 + 2
      IF( ( N.LT.3) .OR. (N .GT.4) ) CALL ERXIT(ABORT)
      CALL SROOT(RINDX,N) 
      RINDX = RINDX +2
C 
C PUT LENGTH OF ROOT FILE IN OVERHEAD 
C 
      CALL SROOT(RINDX,OVRHD/2) 
      RINDX = RINDX +2
C 
C PUT LENGTH OF FREE SPACE POINTERS IN ROOT FILE
C 
      N= SCNT*4 
      CALL SROOT(RINDX,N) 
      RINDX =RINDX +2 
C 
C LEAVE ROOM FOR MAXIMUM DCB, AND MAXIMUM RECORD SIZE 
C 
      CALL SROOT(RINDX,0) 
      RINDX = RINDX+2 
      CALL SROOT(RINDX,0) 
      RINDX = RINDX+2 
C 
C RINDX IS POINTING TO EMPTY FREE SPACE TABLE 
C PUT THE WORD OFFSET TO THE FREE SPACE TABLE IN THE DATA BASE CONTROL
C  BLOCK FOR THE SUBROUTINE "DBCRT" - NOTE: THE DBMS ROUTINES DO NOT
C  USE THIS VALUE FOR THE FREE TABLE POINTER BUT INITIALIZES THE POINTER
C  UPON A DBOPN CALL. 
C 
      CALL SROOT(DBFRP,RINDX/2) 
C 
C VERIFY EACH MASTER DATA SET HAS ALL ITS PATHS 
C 
C SELECT THE MAXIMUM NUMBER OF PATHS IN ANY DATA SET
C 
C SELECT THE MAXIMUM RECORD SIZE OF ANY DATA SET
C 
      NPACK = 0 
      MAXP = 1
      MAXR = 0
      IFLAG = 0 
C 
C INITIALIZE BUFFERS FOR SUMRY
C 
      DO 47 I= 1,SCNT 
      KPACK(I) = 0
      NSETS(I) = 0
      CPACK(I) = 0
47    CONTINUE
C 
C VERIFY DATA SETS AND SET UP PRINT BUFFER
C 
C 
      DO 90 J=0,SCNT-1
C GET THE INDEX FOR THE CURRENT SET 
      SINDX = J*SETSZ+SETTB 
C GET THE PATH COUNT FOR THE CURRENT SET
      CALL RSGET(SINDX+DSPCT,PCNT)
C GET THE DATA TYPE FOR THE CURRENT SET 
      CALL RSGET(SINDX+DSTYP,STYPE) 
      IF(STYPE .EQ. DETAIL) GOTO 55 
C GET THE ADDRESS TO THE PATH TABLE 
      PPTR = ROOTA (SINDX+DSITP) * 2
      CALL RSGET(SINDX+DSFCT,RCNT)
C MAKE PPTR ON A WORD BOUNDRY 
      PPTR = PPTR + (RCNT+1)/2*2
C 
C VERIFY THAT EACH PATH HAS BEEN DEFINED
C 
      IF (PCNT .EQ. 0) GOTO 55
      DO 50 I=1,PCNT
      IF(ROOTA(PPTR) .EQ.0) GOTO 7020 
      PPTR = PPTR + 4 
50    CONTINUE
C 
C SELECT THE MAXIMUM PATH COUNT 
C 
55    CONTINUE
      IF (MAXP .LT. PCNT+1) MAXP = PCNT+1 
C 
C SELECT THE MAXIMUM RECORD SIZE
C 
      CALL RSGET(SINDX+DSMDL,MEDIA) 
      RECSZ = ROOTA(SINDX + DSDRL)  +  MEDIA
      IF (MAXR .LT. RECSZ) MAXR = RECSZ 
C 
C WRITE THE CAPACITY COUNT FOR CURRENT SET TO ROOT
C 
C WRITE THE CAPACITY COUNT FOR CURRENT RECORD 
C 
      RCAP(1) = ROOTA(SINDX + DSCAP)
      RCAP(2) = ROOTA(SINDX + DSCAP + 2)
      CALL SROOT(RINDX,RCAP(1) )
      RINDX = RINDX + 2 
      CALL SROOT(RINDX,RCAP(2) )
      RINDX = RINDX + 2 
      CALL SROOT(RINDX,0) 
      RINDX = RINDX +2
      N = 0 
      IF(STYPE .EQ. DETAIL) N = 1 
       CALL SROOT(RINDX,N)
      RINDX = RINDX + 2 
C 
C 
C CALCULATE THE SET LENGTHS AND ADD THEM TO THE ACCUMULATOR FOR 
C ITS CARTRIDGE NUMBER. ( THESE TABLES WILL BE PRINTED IN SUMRY)
C 
      WLEN = SIZE(RCAP,RECSZ,IERR)
      WLEN = DAD(WLEN,DI1)
      IF((IERR .NE. 0) .OR. OVF(IDMY) ) WLEN = DMAX 
C 
C SAVE PACK FOR FUTURE PRINT OUT
C 
C 
      PACK = ROOTA(SINDX + DSCRN) 
      IF(NPACK .EQ. 0) GOTO 60
      DO 60 I = 1, NPACK
      IF (KPACK(I) .NE. PACK) GOTO 60 
      NSETS(I) = NSETS(I) + 1 
      CPACK(I) = DAD(CPACK(I),WLEN) 
      IF(OVF(IDMY)) CPACK(I) = DMAX 
      GOTO 90 
60    CONTINUE
      NPACK = NPACK + 1 
      KPACK(NPACK) = PACK 
      NSETS(NPACK) = 1
      CPACK(NPACK) = WLEN 
C 
C END OF DO LOOP
C 
90    CONTINUE
C 
C PUT MAXIMUM DCB, AND RECORD SIZE IN OVERHEAD
C 
      CALL SROOT(OVRHD+OVDCB,MAXP)
      CALL SROOT(OVRHD+OVREC,MAXR)
C 
C CHECK THAT A FMP WRITE TO TYPE 1 FILE WON'T 
C GENERATE A MEMORY PROTECT ERROR - THIS IS A 
C KLUDGE FOR RTE-IV'S FILE MANAGEMENT 
C 
      I = (RINDX - OVRHD +10 + 254)/256 * 256 
      CALL SROOT(OVRHD + 10 + I,0)
C 
C LOAD AND EXECUTE SUMRY
C 
100   CONTINUE
      CALL SEGLD(SUMRY,IERR)
C 
C IF SEGLD RETURNS THEN ERROR 
C 
      CALL OUTLN(SUMRY,3) 
      CALL ERXIT(NOSEG) 
C 
C 
C 
C ERROR PROCESSORS
C 
C 
C 
C OUTPUT " 'END.' EXPECTED" 
C 
7010  CALL EMESS(ENDX)
      GOTO 100
C 
C OUTPUT "NOT ENOUGH PATHS DEFINED IN MASTER" 
C 
7020  CONTINUE
      IF(IFLAG .EQ. 0) CALL EMESS(PDEFC)
      IFLAG = -1
      PPTR = SINDX + DSNME
      DO 7025 I = 1,3 
      INAM(I) = ROOTA(PPTR) 
      PPTR = PPTR+2 
7025  CONTINUE
      CALL OUTLN(INAM,3)
      GOTO 55 
      END