FTN4 SUBROUTINE TABLE,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-18049 C RELOC: 92069-16015 C C C****************************************************************: C INTEGER A,M,D INTEGER RCAP(2) INTEGER TBLH(40),TBLHZ INTEGER NUM(5) INTEGER PRTLN(40),PRTLM 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 PRTLM/40/ DATA A/101B/ DATA D/104B/ DATA M/115B/ DATA TBLH/2H ,2HSE,2HT ,2HNA,2HME,2H ,2H ,2HTY, 12HPE,2H ,2H ,2H# ,2HIT,2HEM,2HS ,2H ,2H #,2H P, 22HAT,2HHS,2H ,2H D,2HAT,2HA ,2H ,2H M,2HED,2HIA, 32H ,2H ,2HCA,2HPA,2HC ,2H ,2H ,2H C,2HAR,2HTR, 42HID,2HGE/ DATA TBLHZ/40/ C C C IS TABLE REQUESTED IN CONTROL OPTIONS? C NDX = NFONX(NOTAB) IF (INFO(NDX) .EQ. NFO(NOTAB) ) GOTO 60 C C SKIP TO TOP OF PAGE C IF(LIST .NE. -1) CALL EXEC(3,1100B+LIST,-1) C C YES, GET INDEX INTO SET TABLES C SCNT = ROOTA(DBSCT) SETTB = ROOTA(DBSTP) * 2 C C OUTPUT HEADING AND TWO BLANK LINES C CALL OUTLN(BLANK,1) CALL OUTLN(BLANK,1) CALL OUTLN(TBLH,TBLHZ) CALL OUTLN(BLANK,1) CALL OUTLN(BLANK,1) C C OUTPUT EACH DATA SET C IF(SCNT .LE. 0) GOTO 60 DO 50 J = 0,SCNT-1 SINDX = J*SETSZ+SETTB C C BLANK THE PRINT BUFFER C DO 10 I= 1,PRTLM PRTLN(I) = BLANK 10 CONTINUE C C PUT SET NAME IN BUFFER C DO 20 I= 0,2 PRTLN(I+3) = ROOTA(SINDX+DSNME+I*2) 20 CONTINUE C C PUT SET TYPE IN BUFFER C CALL RSGET(SINDX+DSTYP,STYPE) IF (STYPE .EQ. AUTO) STYPE = A IF(STYPE .EQ. MANU) STYPE = M IF(STYPE .EQ. DETAIL) STYPE = D CALL SPUT(PRTLN,17,STYPE) C C PUT FIELD COUNT IN BUFFER C CALL IFRM(SINDX+DSFCT,4,6,PRTLN,25) C C PUT PATH COUNT IN BUFFER C CALL IFRM(SINDX+DSPCT,5,6,PRTLN,36) C C PUT ENTRY LENGTH IN BUFFER C CALL CITA(ROOTA(SINDX+DSDRL),NUM) CALL SMOVE(NUM,3,6,PRTLN,44) C C PUT MEDIA RECORD IN BUFFER C CALL IFRM(SINDX+DSMDL,3,6,PRTLN,52) C C PUT CAPACITY COUNT IN BUFFER C RCAP(1) = ROOTA(SINDX+DSCAP) RCAP(2) = ROOTA(SINDX+DSCAP+2) CALL DCITA(RCAP,NUM) CALL SMOVE(NUM,1,10,PRTLN,59) C C PUT CARTRIDGE NUMBER IN BUFFER C N = ROOTA(SINDX+DSCRN) CALL CITA(N,NUM) CALL SMOVE(NUM,2,6,PRTLN,74) C C OUTPUT THE LINE C 40 CONTINUE CALL OUTLN(PRTLN,PRTLM) 50 CONTINUE C C RETURN TO CALLER C 60 CONTINUE RETURN END C C C C C SUBROUTINE IFRM(IINDX,ISTRT,IEND,IBUF,IOUT) & ,92069-16015 REV.1912 790130 INTEGER NUM(5) CALL RSGET(IINDX,N) CALL CITA(N,NUM) CALL SMOVE(NUM,ISTRT,IEND,IBUF,IOUT) RETURN END