ASMB,R,L,C
      HED 'DBSTR' ROUTINE OF 'DBUS' 
      NAM DBSTR,3 92063-16004 REV. 1645 
* 
* 
**************************************************************
* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976.  ALL RIGHTS    *
* RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- *
* PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  *
* OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  *
**************************************************************
* 
* 
*     LISTING:   92063-19004
*     SOURCE:    92063-18004
*     RELOC:     92063-16004
* 
* 
************************************************************* 
* 
*                                                                  *
*                                                                  *
********************************************************************
*                                                                  *
*     DBSTR ROUTINE OF DBUS                                        *
*                                                                  *
*         TURN ON SEQUENCE:                                        *
*                                                                  *
*             :RU,DRSTR,CONSOLE LU,MAG TAPE LU                     *
*                   WHERE CONSOLE DEFAULTS TO LU1                  *
*                         MAG TAPE DEFAULTS TO LU8                 *
*                                                                  *
*         OUTPUT:                                                  *
*                   NO ERROR - 1) SPECIFIED ROOT FILE AND DATA     *
*                                 BASE STORED ON MAGNETIC TAPE     *
*                              2) COMPLETION MESSAGE WRITTEN TO    *
*                                 SYSTEM CONSOLE                   *
*                                                                  *
*                   ERROR    - ERROR NUMBER WRITTEN TO SYSTEM      *
*                              CONSOLE                             *
*                                                                  *
*                                                                  *
*         FUNCTION:                                                *
*                   'DBSTR' PROMPTS THE USER FOR INFORMATION       *
*                   ABOUT THE ROOT FILE AND DATA BASE TO STORE.    *
*                   IF THE INFORMATION IS VALID 'DBSTR' STORES     *
*                   THE ROOT FILE AND DATA BASE ON THE MAGNETIC    *
*                   TAPE SECTOR BY SECTOR.  THE ROOT FILE IS       *
*                   STORED FIRST AND IS IDENTIFIED BY A TAPE       *
*                   HEADER.  THE DATA BASE FOLLOWS AND IS WRITTEN  *
*                   IN ONE OR MORE FILE HEADERS.                   *
*                                                                  *
********************************************************************
*                                                                  *
*                                                                  *
      ENT DBSTR 
      EXT EXEC,OPEN,READF,FMERR,PHIMV,PHIMC,PHICM,CMPCT 
      EXT FSTAT,CLOSE,LOCF,DBSPC,RMPAR
      SPC 3 
      SUP PRESS 
********************************************************************
*                                                                  *
*     EQUATES                                                      *
*                                                                  *
********************************************************************
A     EQU 0         A REGISTER
B     EQU 1         B REGISTER
MD3   DEC -3
MD1   DEC -1
MD12  DEC -12 
D1    DEC 1 
D3    DEC 3 
D4    DEC 4 
D6    DEC 6 
D7    DEC 7 
D2    DEC 2 
D9    DEC 9 
D10   DEC 10
D12   DEC 12
D14   DEC 14
D15   DEC 15
D16   DEC 16
H8BTA OCT 17
H8BT  OCT 377 
B40   OCT 40
WCODE DEC 2         WRITE CODE = 2
RCODE DEC 1         READ CODE = 1 
L8BT  OCT 177400
QCODE DEC 6 
EFCDE DEC 3 
DSCWD DEC 2 
ERRML EQU D7        LENGTH OF ERROR MESSAGE 
DBNML DEC 8         NAME MSG. LENGTH
DSPKN DEC 14        DATA SET PACK NO. 
      SKP 
************************************************************************
*                                                                  *   *
*     RUN TABLE FOR IMAGE-DBMS                                     *   *
*                                                                  *   *
*         THE RUN TABLE IS COMPRISED OF THE FOLLOWING SECTIONS:    *   *
*                                                                  *   *
*              1) DATA BASE CONTROL BLOCK                          *   *
*              2) ITEM TABLE                                       *   *
*              3) DATA SET TABLE                                   *   *
*                                                                  *   *
*         THESE SECTIONS APPEAR IN THE ORDER DESCRIBED.            *   *
*         DETAILS OF EACH SECTION FOLLOW.                          *   *
*                                                                  *   *
************************************************************************
*****                                                          *********
*                                                                  *   *
*     DATA BASE CONTROL BLOCK                                      *   *
*                                                                  *   *
*****                                                          *********
DBLNG DEC 55        DATA BASE CONTROL BLOCK LENGTH
DBZ   DEC 0 
DBSTA EQU EFCDE 
DBSCD EQU D4        DATA BASE SECURITY CODE(EFMP) 
DBICT DEC 5         DATA BASE ITEM COUNT
DBSCT EQU D6        DATA BASE DATA SET COUNT
DBITB DEC 7         ADDRESS OF ITEM TABLE 
DBSTB DEC 8         ADDRESS OF DATA SET TABLE 
DBLMD EQU D9        DATA BASE ACCESS LEVEL AND MODE 
DBLVL EQU DBZ+9     1ST BYTE: ACCESS LEVEL GRANTED BY 'DBOPN' 
DBMOD EQU DBZ+9     2ND BYTE: MODE GRANTED BY 'DBOPN' 
DBILV EQU D10       DATA BASE ITEM LEVEL WORDS - 3 WORDS/LEVEL
DBOCT EQU DBZ+10    DATA SET OPEN COUNT 
*****                                                          *********
*                                                                  *   *
*     ITEM TABLE - ONE FIVE-WORD ENTRY PER ITEM                    *   *
*                                                                  *   *
*****                                                          *****
ITLNG EQU DBZ+5     ITEM ENTRY LENGTH 
ITNME EQU DBZ       ITEM NAME(LEFT JUSTIFIED) 
ITRWL EQU DBZ+3     ITEM READ/WRITE MINIMUM ACCESS LEVEL
ITRDL EQU DBZ+3     1ST BYTE: MINIMUM ACCESS LEVEL TO READ ITEM 
ITWRL EQU DBZ+3     2ND BYTE: MINIMUM ACCESS LEVEL TO WRITE ITEM
ITTDN EQU DBZ+4     ITEM TYPE AND DATASET NUMBER
ITTYP EQU DBZ+4     1ST BYTE: ITEM TYPE 
ITDSN EQU DBZ+4     2ND BYTE: ITEM DATASET NUMBER 
*****                                                          *********
*                                                                  *   *
*     DATA SET TABLE - COMPRISED OF THE FOLLOWING SECTIONS IN      *   *
*                      THE ORDER PRESENTED:                        *   *
*                                                                  *   *
*                        1) DATA SET CONTROL BLOCK                 *   *
*                        2) RECORD DEFINITION TABLE                *   *
*                        3) MASTER PATH TABLE, DETAIL PATH TABLE,  *   *
*                           OR NO PATH TABLE                       *   *
*                                                                  *   *
*****                                                          *********
*                                                                  *   *
*                                                                  *   *
***** DATA SET CONTROL BLOCK                                   *****
*                                                                  *   *
*                                                                  *   *
DSLNG DEC 16        DATA SET CONTROL BLOCK LENGTH 
DSTYP EQU DBZ       DATA SET TYPE 
DSMDL EQU DBZ+1     DATA SET MEDIA RECORD LENGTH
DSENL EQU DBZ+2     DATA SET LOGICAL RECORD LENGTH
DSFPC EQU DBZ+3     DATA SET FIELDS/ENTRY AND PATHS/ENTRY 
DSFCT EQU DBZ+3     1ST BYTE: FIELDS/ENTRY
DSPCT EQU DBZ+3     2ND BYTE: PATHS/ENTRY 
DSCPN EQU DBZ+4     DATA SET SRCH FIELD NO. AND PATH NO. OF CURR. CHAIN 
DSCCT EQU DBZ+4     1ST BYTE: FIELD NUMBER OF SRCH ITEM(0 IF DETAIL)
DSPAN EQU DBZ+4     2ND BYTE: PATH NUMBER OF CURRENT CHAIN
DSPAT EQU DBZ+5     ADDRESS OF PATH TABLE 
DSFRC EQU DBZ+6     FREE CHAIN COUNT(DETAIL)/FREE RECORD COUNT(MASTER)
DSFRH EQU DBZ+7     0 OR RECORD NO.OF 1ST FREE RECORD IN CHAIN
DSRCN EQU DBZ+8     LAST ACCESSED RECORD NUMBER 
DSPAL EQU DBZ+9     0 OR PATH LENGTH OF CURRENT CHAIN 
DSCHF EQU DBZ+10    0 OR RECORD NUMBER OF CURRENT CHAIN FOOT
DSFWN DEC 11        0 OR NEXT RECORD NUMBER IN CHAIN
DSNME DEC 12        DATA SET NAME(LEFT JUSTIFIED) 
DSCAP DEC 15        CAPACITY(MAXIMUM NUMBER OF RECORDS) 
*                                                                  *   *
*                                                                  *   *
***** RECORD DEFINITION TABLE - ONE ONE-WORD ENTRY PER FIELD   *********
*                                                                  *   *
*                                                                  *   *
RDLNG EQU DBZ+1     RECORD DEFINITION TABLE ENTRY LENGTH
RDINF EQU DBZ       ITEM NUMBER OF FIELD,ITEM LENGTH AND ACCESSABILITY
RDITN EQU DBZ       1ST BYTE: ITEM NUMBER OF FIELD
RDILA EQU DBZ       2ND BYTE: ITEM LENGTH AND R/W ACCESSABILITY 
RDITL EQU DBZ       1ST 6 BITS: ITEM LENGTH 
RDWRA EQU DBZ       7TH BIT: ITEM WRITE ACCESSABILITY 
RDRDA EQU DBZ       8TH BIT: ITEM READ ACCESSABILITY
*                                                                  *
*                                                                  *
***** PATH TABLE(MASTER) - ONE TWO-WORD ENTRY PER PATH         *****
*                                                                  *
*                                                                  *   *
PTMLG EQU DBZ+2     MASTER PATH TABLE ENTRY LENGTH
PTMSD EQU DBZ            DETAIL DATASET SRCH ITEM NO. AND DATA SET NO.
PTMSN EQU DBZ            1ST BYTE: DETAIL DATA SET SEARCH ITEM NUMBER 
PTMDN EQU DBZ            2ND BYTE: DETAIL DATA SET NUMBER 
PTMPS EQU DBZ+1          DETAIL DATA SET PATH NUMBER AND SCRATCH
PTMPN EQU DBZ+1          1ST BYTE: DETAIL DATA SET PATH NUMBER
PTMSC EQU DBZ+1          2ND BYTE: SCRATCH
*                                                                  *   *
*                                                                  *   *
***** PATH TABLE(DETAIL) - ONE TWO-WORD ENTRY PER PATH         *********
*                                                                  *   *
*                                                                  *   *
PTDLG EQU DBZ+2     DETAIL PATH TABLE ENTRY LENGTH
PTDSM EQU DBZ       SEARCH FIELD NO. IN DETAIL AND MASTER DATA SET NO.
PTDSF EQU DBZ       1ST BYTE: SEARCH FIELD NUMBER IN DETAIL 
PTDMN EQU DBZ       2ND BYTE: MASTER DATA SET NUMBER
PTDPS EQU DBZ+1     MASTER DATA SET PATH NUMBER AND SCRATCH 
PTDPN EQU DBZ+1     1ST BYTE: MASTER DATA SET PATH NUMBER 
PTDSC EQU DBZ+1     2ND BYTE: SCRATCH 
      SKP 
********************************************************************
*                                                                  *
*     VERIFY THAT THE LOGICAL UNIT IS VALID AND PROMPT THE USER    *
*     FOR THE DATA BASE NAME, SECURITY CODE, AND LEVEL 15 WORD.    *
*                                                                  *
********************************************************************
DBSTR NOP 
      JSB RMPAR     GET PARAMETERS
      DEF *+2 
      DEF CONSL 
* 
      JSB DBSPC     GET FREE
      DEF *+4 
      DEF PNAME       SPACE 
      DEF FWAM
      DEF LWAM          LIMITS
* 
      LDA MT
      SZA,RSS 
      LDA D8
      STA MT
      CMA,INA 
      ADA D63 
      SSA           VALID LOG. UNIT NO. ? 
      JSB ER1       NO
      LDA CONSL 
      SZA,RSS 
      CLA,INA 
      IOR B400
      STA TECWD     SET LU CONTROL WORD 
      LDA MT
      STA TPCNW     BUILD TAPE CONTROL WORD 
      JSB IACVT     CONVERT LOGICAL UNIT TO ASCII 
      LDA CELL
      STA LUNIT     SAVE ASCII LOGICAL UNIT 
      LDA TPCNW     BUILD TAPE REWIND CONTROL WORD
      IOR RWMSK 
      STA RWCNW 
      LDA TPCNW      BUILD DYNAMIC TAPE STATUS CONTROL WORD 
      IOR DYMSK 
      STA DYCNW 
      ISZ TSEQ      INCREMENT TAPE SEQUENCE NO. 
      LDA TPCNW 
      IOR EF        CREATE TAPE EOF CONTROL WORD
      STA EFCWD     SAVE TAPE EOF CONTROL WORD
      JSB BLNKB     BLANK RESPONSE BUFFER 
      LDA ADBNM     GET DATA BASE NAME
      LDB DBNML 
      JSB TERMW 
      JSB TERMR 
      LDA ADBSM     GET DATA BASE SECURITY CODE 
      LDB DBSML 
      JSB TERMW 
      JSB TERMR 
      LDA ASCDE 
      STA ATSCD 
      LDA A,I 
      ALF,ALF 
      AND H8BTA 
      STA SCODE 
      LDA ASCDE,I 
      JSB COMP
      JMP GLVLW 
      ISZ ATSCD 
      LDA ATSCD,I 
      ALF,ALF 
      JSB COMP
      JMP GLVLW 
      LDA ATSCD,I 
      JSB COMP
      JMP GLVLW 
      ISZ ATSCD 
      LDA ATSCD,I 
      ALF,ALF 
      JSB COMP
      JMP GLVLW 
GLVLW EQU * 
      LDA ADBLM     GET DATA BASE LEVEL WORD
      LDB DBLML 
      JSB TERMW 
      JSB TERMR 
      SPC 3 
********************************************************************
*                                                                  *
*     SEARCH FOR AND READ THE ROOT FILE THEN VERIFY THE SECURITY   *
*     CODE AND LEVEL 15 WORD                                       *
*                                                                  *
********************************************************************
* 
      LDA D3
      STA PHIMC 
      LDA ANAME 
      LDB TNAM
      JSB PHIMV 
      LDA SCODE 
      CMA,INA 
      STA SC        COMPLEMENT SECURTITY CODE 
      CLA           SET FOR TOTAL 
      STA CARNO       CARTRIDGE SEARCH
      LDA ANAME 
      JSB FOPEN     OPEN ROOT FILE
* 
      JSB FSTAT     GET 
      DEF *+2 
      DEF FWAM,I      CARTRIDGE LABEL INFO
      LDB FWAM      NOW 
NXLU  LDA B,I         FIND
      CPA LU            CARTRIDGE 
      JMP LUFND           LABEL 
      ADB D4
      JMP NXLU
LUFND ADB D2        GET THE LABEL 
      LDA B,I         FOR THIS DISC LU
      STA LU
      LDA SECCT 
      MPY D64       COMPUTE ROOT SIZE 
      STA RTSIZ 
      ADA FWAM        AND CHECK FOR 
      ADA D9            ENOUGH
      CMA,INA             ROOM
      ADA LWAM
      SSA           ENOUGH ROOM?
      JMP ER4       NO! 
* 
      LDA FWAM
      ADA D9
      STA AROOT 
      JSB FILRD     READ ROOT FILE
      LDB FWAM      PLACE 
      ADB D6          ROOT
      LDA LEN           FILE SIZE 
      STA RTSIZ           AND SECURITY
      STA B,I               CODE IN HEADER
      LDA SC
      INB 
      STA B,I 
      INB 
      LDA LU        STORE CARTRIDGE 
      STA B,I         IN HEADER 
      LDA D6        MOVE
      STA PHIMC       HEADER
      LDA ATPHD 
      LDB FWAM
      JSB PHIMV 
      LDA AROOT     GET SECURITY CODE IN ROOT FILE
      ADA DBSCD 
      LDB A,I 
      CPB SC        CORRECT SECURITY CODE ? 
      RSS           YES 
      JSB ER2       NO
      LDA AROOT     GET LEVEL 15 WORD 
      ADA DBLNG 
      ADA MD3 
      LDB A,I       GET 1ST WORD OF LEVEL 15
      CPB BLNKD     ANY LEVEL WORDS ? 
      JMP RINGA     NO
      LDB D3
      STB CMPCT     LEVEL WORD LENGTH 
      LDB ALEVL     ADDR OF USER SUPPLIED WORD
      JSB PHICM     LEVEL WORDS EQUAL ? 
      JSB  ER3      NO
      SPC 3 
RINGA EQU * 
      JSB TSTAT     CHECK TAPE I/O STATUS 
      LDA STATS 
      AND MASK2     WRITE RING OUT ?
      SZA,RSS 
      JMP WTHDR 
      JSB RING      REQUEST WRITE RING
      JMP RINGA     TRY AGAIN 
WTHDR EQU * 
      LDB FWAM      ADDR OF BUFFER TO WRITE 
      LDA D9
      JSB TAPEW     WRITE HEADER
* 
      LDA RTSIZ     LENGTH OF RECORD TO WRITE 
      LDB AROOT 
      JSB TAPEW     WRITE ROOT FILE 
      SKP 3 
********************************************************************
*                                                                  *
*     BUILD THE FILE HEADER                                        *
*                                                                  *
********************************************************************
      LDB AROOT 
      ADB DBSCT     LOOP ON DSET COUNT TO CREATE
      LDA B,I 
      CMA,INA       DATA-SETS AND INITIALIZE INFO 
      STA DINX      WITHIN THESE DATA-SETS FOR MODE 
      ADB D2        SET UP
      LDB B,I 
      ADB AROOT 
      ADB MD1 
      JMP SBST8 
NEXST LDB DSET      CALCULATE THE ADDRESS OF THE
      ADB D3        NEXT DATA-SET.
      LDA B,I 
      LDB 0 
      AND H8BT
      RAL 
      SWP 
      ALF,ALF 
      AND H8BT
      ADB 0         DSET=2*PATHCT+FIELDCT+16+DSET 
      ADB D16 
      ADB DSET
SBST8 STB DSET
      ADB D12       YES,OPEN THIS DATA-SET AND
      LDA B,I 
      STA FNAM      PLACE 
      INB 
      LDA B,I         NAME
      STA FNAM+1
      INB 
      LDA B,I           IN HEADER 
      AND L8BT
      ADA B40 
      STA FNAM+2
      LDA D4        MOVE
      STA PHIMC       HEADER
      LDA APNHD         INTO
      LDB AHDR            PLACE 
      JSB PHIMV 
      LDB DSET      FNAM IS ADDRESS OF DSET NAME
      ADB D15 
      LDA B,I 
      STA FLGTH     FLGTH IS MAXIMUM NUMBER OF
      STA FLEN
      LDB DSET      ENTRIES 
      ADB D1        RLGTH IS RECORD LENGTH(IN WORDS)
      LDA B,I 
      ISZ 1 
      ADA B,I 
      STA RLGTH 
      STA RLEN
      LDB DSET      PICK UP CART NUMBER 
      ADB D14       FROM DATA SET CONTROL 
      LDA B,I       BLOCK AND STORE IN
      AND H8BT      CART NO 
      STA CARNO 
      LDA AFNAM 
      JSB FOPEN     OPEN
WFHDR EQU * 
      LDA D10       LENGTH OF RECORD TO WRITE 
      LDB AHDR      ADDR OF BUFFER TO WRITE 
      JSB TAPEW     WRITE FILE HEADER 
      JSB TSTAT     CHECK TAPE I/O STATUS 
      LDA STATS 
      AND MASK5     END OF TAPE ? 
      SZA,RSS 
      JMP FWD 
      JSB EOT       END OF TAPE 
      JMP WFHDR     TRY AGAIN 
FWD   EQU * 
      SPC 3 
********************************************************************
*                                                                  *
*     BUILD THE DATA HEADER AND READ THE DATA SET INTO MEMORY      *
*                                                                  *
********************************************************************
      CLB 
      LDA D1300     COMPUTE 
      DIV RLGTH       NUMBER OF RECORDS/BLOCK 
      STA R/BLK 
      CMA,INA 
      STA RINX      SET UP INDEX
      ADA FLGTH     IS THIS 
      SSA,RSS         A SHORT BLOCK?
      JMP SHTBL     NO! 
      LDA FLGTH     YES!
      STA R/BLK     USE 
      CMA,INA         ACTUAL
      STA RINX          LENGTH
SHTBL LDA FLGTH 
      CMA,INA 
SBST2 STA FINX      SET UP FILE CTR INDEX 
      LDA AHDR
      STA DBUF
SBST1 JSB READF     READ
      DEF *+4 
      DEF DCB         A 
      DEF IERR
DBUF  BSS 1             RECORD
      CPA MD12      EOF?
      JMP WDHDR     YES 
      SSA           ERROR?
      JMP FILER     YES!
      LDA DBUF      COMPUTE 
      ADA RLGTH       NEXT
      STA DBUF          ADDRESS 
      ISZ RINX      END OF BLOCK? 
      JMP SBST1     NO! 
WDHDR EQU * 
      LDA D1300     RCD. LENGTH TO WRITE
      LDB AHDR      ADDR OF BUFFER TO WRITE 
      JSB TAPEW     WRITE TAPE RECORD 
      JSB TSTAT     CHECK TAPE I/O STATUS 
      LDA STATS 
      AND MASK5     END OF TAPE ? 
      SZA,RSS 
      JMP PROC
      JSB EOT       END OF TAPE 
      JMP WDHDR     TRY AGAIN 
PROC  EQU * 
      LDA FINX      END 
      ADA R/BLK 
      SSA,RSS         OF FILE?
      JMP SBST3     YES!
      LDA R/BLK     NO! 
      CMA,INA 
      STA RINX
      LDA R/BLK 
      ADA FINX
      JMP SBST2 
SBST3 ISZ DINX      INCR, THE FILE COUNT
      JMP NEXST     MORE DATA SETS! 
      SPC 3 
                                                                                                                      