ASMB,R,L,C
      HED 'DBULD' ROUTINE OF 'DBUS' 
      NAM DBULD,3 92063-16006 REV. 1805 771101
* 
* 
**************************************************************
* (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-19006
*     SOURCE:    92063-18006
*     RELOC:     92063-16006
* 
* 
************************************************************* 
* 
*                                                                  *
*                                                                  *
********************************************************************
*                                                                  *
*     DBULD ROUTINE OF DBUS                                        *
*                                                                  *
*         TURN ON SEQUENCE:                                        *
*             :RU,DBULD,CONSOLE LU,MAG TAPE LU                     *
*                 CONSOLE LU DEFAULTS TO LU1                       *
*                 MAG TAPE LU DEFAULTS TO LU 8                     *
*                                                                  *
*         OUTPUT:                                                  *
*                   NO ERROR - 1) SPECIFIED DATA BASE UNLOADED TO  *
*                                 MAGNETIC TAPE                    *
*                              2) COMPLETION MESSAGE WRITTEN TO    *
*                                 SYSTEM CONSOLE                   *
*                                                                  *
*                   ERROR    - ERROR NUMBER WRITTEN TO SYSTEM      *
*                              CONSOLE                             *
*                                                                  *
*                                                                  *
*         FUNCTION:                                                *
*                   'DBULD' PROMPTS THE USER FOR INFORMATION       *
*                   ABOUT THE DATA BASE TO UNLOAD.  IF THE         *
*                   INFORMATION IS VALID 'DBULD' UNLOADS           *
*                   THE MANUAL MASTER AND DETAIL DATA SET(S)       *
*                   OF THE DATA BASE TO THE MAGNETIC TAPE.  THE    *
*                   MANUAL MASTERS ARE UNLOADED FIRST.  THE MEDIA  *
*                   RECORDS OF THE DATA ENTRIES ARE NOT WRITTEN.   *
*                   THE DATA SET NAMES ARE ASSOCIATED WITH THEIR   *
*                   RESPECTIVE DATA ENTRIES ON THE TAPE.  THE      *
*                   MAGNETIC TAPE IS FORMATTED WITH A TAPE HEADER. *
*                   EACH DATA SET ON TAPE IS IDENTIFIED BY A       *
*                   FILE HEADER WHICH PRECEDES THE DATA HEADER(S)  *
*                   WHICH CONTAIN THE ACTUAL DATA ENTRIES.         *
*                                                                  *
********************************************************************
*                                                                  *
*                                                                  *
      ENT DBULD 
      EXT EXEC,DBOPN,DBGET,PHIS1,PHIMV,PHIMC,PHIZR,PHICM,CMPCT
      EXT DBINT,RMPAR,AIRUN,DBCLS 
      SPC 3 
      SUP PRESS 
********************************************************************
*                                                                  *
*                                                                  *
*     EQUATES                                                      *
*                                                                  *
********************************************************************
A     EQU 0         A REGISTER
B     EQU 1         B REGISTER
H8BT  OCT 377 
D6    DEC 6 
D9    DEC 9 
D10   DEC 10
WCODE DEC 2         WRITE CODE = 2
RCODE DEC 1         READ CODE = 1 
L8BT  OCT 177400
MD3   DEC -3
MD1   DEC -1
D2    EQU WCODE 
D3    DEC 3 
D4    DEC 4 
MODE  EQU RCODE     OPEN MODE 
GMODE EQU D2        SERIAL GET
QCODE EQU D6
EFCDE EQU D3
DBNML DEC 8         NAME MSG. LENGTH
ERRML DEC 7         LENGTH OF ERROR MESSAGE 
H8BTA OCT 17        MASK
      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        BASE OF ZERO FOR EQUATES 
D1    DEC 1 
ACSUB DEC 2        1ST BYTE : ACTIVITY FLAG 
*                   2ND BYTE : SUBCHANNEL # 
DBSTA DEC 3        DATA BASE STATUS 
DBSCD DEC 4        DATA BASE SECURITY CODE(FMP) 
DBICT DEC 5        DATA BASE ITEM COUNT 
DBSCT DEC 6        DATA BASE DATA SET COUNT 
DBITB DEC 7        ADDRESS OF ITEM TABLE
DBSTB DEC 8        ADDRESS OF DATA SET TABLE
DBLMD DEC 9        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 DEC 10       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.    *
*                                                                  *
********************************************************************
DBULD NOP 
      JSB RMPAR     GET PARAMETERS
      DEF *+2 
      DEF CONSL 
* 
* 
      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 UP LU OCNTROL 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 CONTROL WORD
      IOR DYMSK 
      STA DYCNW 
      ISZ TSEQ      INCREMENT TAPE SEQUENCE 
      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 
********************************************************************
*                                                                  *
*     OPEN THE DATA BASE, VERIFY THAT LEVEL 15 ACCESS IS GRANTED,  *
*     AND BUILD A LIST OF DSCB ADDRESSES OF DATA SETS TO UNLOAD.   *
*                                                                  *
********************************************************************
      JSB DBINT     INITIALIZE FOR FREE SPACE USAGE 
      DEF *+5 
      DEF NAME
      DEF SCODE 
      DEF PNAME 
      DEF STAT
      LDB STAT
      SZB           ERROR?
      JSB ERRTN     YES!
      JSB DBOPN     OPEN DATA BASE TO UNLOAD
      DEF *+6 
ANAME DEF NAME
ALEVL DEF LEVEL 
      DEF SCODE 
      DEF MODE
      DEF STAT
      LDB STAT      GET STATUS OF OPEN
      SZB           OPEN ERROR ?
      JSB ERRTN     YES 
      LDB AIRUN     GET LEVEL GRANTED BY OPEN 
      ADB DBLVL 
      LDA B,I 
      ALF,ALF 
      AND H8BT
      CPA D15       IS LEVEL = 15 ? 
      RSS           YES 
      JSB ER2       NO
      ADB MD3       GET DATA BASE DATA SET COUNT
      LDA B,I 
      STA DSET#     SAVE DATA SET COUNT 
      CLA 
      STA CDSCT     INIT. UNLOAD COUNT TO 0 
      INA 
      STA CDST#     INIT. CURR. DATA SET NO. TO 1 
      LDB MANUL 
      STB DFLAG     INIT. FLAG TO MANUAL - 'M'
      LDA ADSCL 
      STA CDSCB     INIT. ADDR OF LIST OF DSCB'S
GNXDS EQU * 
      LDA ADST#     GET ADDR OF CURR. DATA SET NO.
      JSB PHIS1     CALC. DSCB ADDR 
      JSB ERRTN     BRANCH DOES NOT OCCUR 
      LDA DFLAG 
      CPA B,I       DOES DATA SET TYPE = FLAG TYPE ?
      RSS           YES 
      JMP NXTDS     NO
      STB CDSCB,I   STORE DSCB ADDR IN UNLOAD LIST
      ADB DSFRC     GET THE FREE COUNT
      LDA B,I 
      ADB DSPAL     GET THE DATA SET CAPACITY 
      CPA B,I       IS THE DATA SET EMPTY ? 
      JMP NXTDS     YES 
      ISZ CDSCB     INCR. TO NEXT DSCB LIST ADDR
      ISZ CDSCT     INCR. UNLOAD COUNT
NXTDS EQU * 
      LDA CDST#     GET CURR. DATA SET NO.
      ISZ CDST#     INCR. CURR. DATA SET NO.
      CPA DSET#     LAST DATA SET ? 
      RSS           YES 
      JMP GNXDS     NO
      LDA DETAL 
      CPA DFLAG     SCAN FOR DETAIL'S COMPLETED ? 
      JMP BLDTP     YES 
      STA DFLAG     INIT. FLAG TO DETAIL - 'D'
      CLA,INA 
      STA CDST#     INIT. CURR. DATA SET NO. TO 1 
      JMP GNXDS     CONTINUE
      SPC 3 
********************************************************************
*                                                                  *
*     BUILD THE TAPE HEADER.                                       *
*                                                                  *
********************************************************************
BLDTP EQU * 
      LDA CDSCT     GET NO. OF DATA SETS TO UNLOAD
      SZA,RSS       ANY DATA SETS TO UNLOAD ? 
      JSB ER3       NO
      CLA,INA 
      STA CDST#     INIT. TAPE DATA SET COUNT TO 1
      LDA ADSCL 
      STA CDSCB     START AT TOP OF DSCB LIST 
      LDB D3
      STB PHIMC     MOVE LENGTH 
      ADB AHDR
      ADB D2
      STB CHDRA     INCR. PAST 'DBLOAD' 
      LDA ANAME     ADDR OF DATA BASE NAME
      JSB PHIMV     MOVE DATA BASE NAME TO HDR
      LDB D3
      STB PHIMC     MOVE LENGTH 
      ADB CHDRA 
      STB CHDRA     INCR. PAST DATA BASE NAME 
      LDA AIRUN     ADDR OF PACK NO.
      JSB PHIMV     MOVE PACK NO. TO HDR
      LDA D3
      ADA CHDRA     INCR. PAST PACK NO. 
      LDB SCODE 
      STB A,I       STORE SECURITY CODE IN HDR
      INA           INCR. PAST SECURITY CODE
      LDB CDSCT     GET DATA SET NO. TOTAL
      STB A,I       STORE DATA SET NO. IN HDR 
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 HDRLG     LENGTH OF HDR 
      JSB TAPEW     WRITE TAPE HDR
      SPC 3 
********************************************************************
*                                                                  *
*     BUILD THE FILE HEADER.                                       *
*                                                                  *
********************************************************************
CFHDR EQU * 
      LDB AHDR
      LDA HDRLG 
      JSB PHIZR     CLEAR HDR BUFFER
      LDA D4
      STA PHIMC     MOVE LENGTH 
      LDA AFHNM     SOURCE ADDR 
      LDB AHDR      DEST. ADDR
      JSB PHIMV     MOVE 'FILEHEAD' TO HDR
      LDB D4
      ADB AHDR
      STB CHDRA     INCR. PAST 'FILEHEAD' 
      LDA D3
      STA PHIMC     MOVE LENGTH 
      LDA CDSCB,I 
      ADA DSNME     SOURCE ADDR 
      STA GNAME     DATA SET ADDR FOR GET 
      JSB PHIMV     MOVE DATA SET NAME TO HDR 
      LDA D3
      ADA CHDRA     INCR PAST DATA SET NAME 
      LDB CDST# 
      STB A,I       STORE TAPE DATA SET NO. IN HDR
      INA           INCR. PAST DATA SET NO. 
      LDB CDSCB,I   GET MEDIA RECORD LENGTH 
      ADB DSMDL 
      LDB B,I 
      STB MEDAL     SAVE MEDIA RECORD LENGTH
      LDB CDSCB,I   GET DATA ENTRY LENGTH 
      ADB DSENL 
      LDB B,I 
      STB A,I       STORE DATA ENTRY LENGTH IN HDR
      STB DATAL     SAVE ENTRY LENGTH 
WFHDR EQU * 
      LDB HDRLG     LENGTH OF HDR 
      JSB TAPEW     WRITE FILE HDR
      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 
********************************************************************
*                                                                  *
*     INITIALIZE THE DATA HEADER AND UNLOAD THE CURRENT DATA SET.  *
*                                                                  *
********************************************************************
      CLA,INA 
      STA RCDCT     RECORD COUNT = 1
      LDA HDRLG 
      LDB AHDR
      JSB PHIZR     CLEAR HDR 
      LDA D4
      STA PHIMC     MOVE LENGTH 
      LDA ADHNM     SOURCE ADDR 
      LDB AHDR      DEST. ADDR
      JSB PHIMV     MOVE 'DATAHEAD' TO HDR
      LDA AHDR
      ADA D4        INCR. PAST 'DATAHEAD' 
      CLB,INB       START BLOCK COUNT AT 1
      STB BLKCT     STORE BLOCK COUNT IN HDR
      LDB AHDR
      ADB HDRLG     INCR. TO DATA PORTION OF HDR
      STB CHDRA     STORE CURR. HDR ADDR
GETNX EQU * 
      JSB DBGET     READ NEXT RECORD
      DEF *+6 
GNAME BSS 1 
      DEF GMODE 
      DEF STAT
ADBUF DEF DBUFF 
      BSS 1 
      LDB STAT      GET ERROR STATUS
      SZB           ERROR ? 
      JSB ERRTN     YES 
      LDB STAT1     GET EOF STATUS
      SZB,RSS       EOF ? 
      JMP EOFIL     YES 
      ISZ RCDCT     INCR. RCD COUNT 
      LDA DATAL     GET MOVE LENGTH 
      STA PHIMC     MOVE LENGTH 
      ADA CHDRA      INCR. TO NEXT DATA BUFFER ADDR 
      LDB CHDRA     GET START OF CURR. DATA ADDR
      STA CHDRA     STORE NEXT DATA BUFFER ADDR 
      CMA,INA 
      ADA AHEND 
      SZA,RSS       ROOM IN BUFFER FOR NEXT RCD ? 
      JMP MOVDE     YES 
      SSA           ROOM IN BUFFER FOR NEXT RCD ? 
      JMP WRITE     NO
MOVDE EQU * 
      LDA ADBUF     ADDR OF SOURCE
      ADA MEDAL     INCR. PAST MEDIA RECORD 
      JSB PHIMV     MOVE DATA RCD TO TAPE BUFFER
      JMP GETNX     GET NEXT RECORD 
WRITE EQU * 
      LDB DLNG      BUFFER LENGTH 
      JSB TAPEW     WRITE DATA TO TAPE
      JSB TSTAT     CHECK TAPE I/O STATUS 
      LDA STATS 
      AND MASK5    END OF TAPE ?
      SZA,RSS 
      JMP PROC
      JSB EOT       END OF TAPE 
      JMP WRITE     TRY AGAIN 
PROC  EQU * 
      ISZ BLKCT     INCR. BLOCK COUNT 
      LDB AHDR      CALC. START OF DATA BUFFER
      ADB HDRLG 
      LDA DATAL 
      STA PHIMC     RESTORE COUNT LOST IN EOT ROUTINE 
      ADA B 
      STA CHDRA 
      JMP MOVDE     GO MOVE RECORD
      SPC 3 
                                                                                                          