ASMB,R,L,C
      HED 'DBLOD' ROUTINE OF 'DBUS' 
      NAM DBLOD,3 92063-16007 REV. 1940 790621
* 
* 
**************************************************************
* (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-19007
*     SOURCE:    92063-18007
*     RELOC:     92063-16007
* 
* 
************************************************************* 
* 
*                                                                  *
*                                                                  *
********************************************************************
*                                                                  *
*                                                                  *
*     DBLOD ROUTINE OF DBUS                                        *
*                                                                  *
*         TURN ON SEQUENCE:                                        *
*           :RU,DBLOD,CONSOLE LU,MAG TAPE LU                       *
*              CONSOLE LU DEFAULTS TO LU1                          *
*              MAG TAPE LU DEFAULTS TO LU8                         *
*                                                                  *
*         OUTPUT:                                                  *
*                   NO ERROR - 1) SPECIFIED DATA BASE LOADED FROM  *
*                                 THE MAGNETIC TAPE                *
*                              2) COMPLETION MESSAGE WRITTEN TO    *
*                                 SYSTEM CONSOLE                   *
*                                                                  *
*                   ERROR    - ERROR NUMBER WRITTEN TO SYSTEM      *
*                              CONSOLE                             *
*                                                                  *
*                                                                  *
*         FUNCTION:                                                *
*                   'DBLOD' PROMPTS THE USER FOR INFORMATION       *
*                   ABOUT THE DATA BASE TO LOAD.  IF THE           *
*                   INFORMATION AND MAGNETIC TAPE ARE VALID        *
*                   'DBLOD' LOADS THE DATA BASE IN THE ORDER       *
*                   THE DATA SETS OCCUR ON THE MAGNETIC TAPE       *
*                   IF A DATA SET NAME ON TAPE DOES NOT OCCUR      *
*                   IN THE DATA BASE TO BE LOADED INTO THE         *
*                   DATA ON TAPE IS SKIPPED(I.E. NOT LOADED).      *
*                                                                  *
********************************************************************
*                                                                  *
*                                                                  *
      ENT DBLOD 
      EXT EXEC,DBOPN,DBINF,DBPUT,DBCLS
      EXT PURGE,AIRUN,DBINT,RMPAR,DBCRT 
      EXT PHIS1,PHICM,CMPCT,PHIMC,PHIMV 
      SPC 3 
      SUP PRESS 
********************************************************************
*                                                                  *
*     EQUATES                                                      *
*                                                                  *
********************************************************************
A     EQU 0         A REGISTER
B     EQU 1         B REGISTER
H8BTA OCT 17        MASK
H8BT  OCT 377 
L8BT  OCT 177400
WCODE DEC 2         WRITE CODE = 2
RCODE DEC 1         READ CODE = 1 
QCODE DEC 6 
ERRML DEC 7         LENGTH OF ERROR MESSAGE 
MODE  DEC 3         OPEN MODE 
CMOD1 DEC 0         CLOSE MODE
CMOD2 EQU RCODE     CLOSE MODE
DBNML DEC 8         NAME MSG. LENGTH
MD4   DEC -4
MD1   DEC -1
D4    DEC 4 
D5    DEC 5 
D7    DEC 7 
D10   DEC 10
      SKP 
********************************************************************
*                                                                  *
*     VERIFY THAT THE LOGICAL UNIT IS VALID, GET THE DATA BASE     *
*     NAME, SECURITY CODE, AND LEVEL 15 WORD, AND OPEN THE         *
*     DATA BASE.                                                   *
*                                                                  *
********************************************************************
DBLOD NOP 
      JSB RMPAR     GET PARAMETERS
      DEF *+2 
      DEF CONSL 
* 
      CLA 
      STA IMODE     SET FOR NOT PURGE OF DATA SETS
      STA CLFLG     CLEAR CLOSE FLAG
* 
      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 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 CONTROL WORD
      IOR DYMSK 
      STA DYCNW 
      ISZ TSEQ     INCREMENT TAPE SEQUENCE
      JSB BLNKB 
      LDA D20       READ LENGTH 
      JSB TAPER     READ TAPE HEADER
      LDA D4
      STA CMPCT     STORE COMPARE LENGTH
      LDA AHDR      ADDR OF BUFFER FOR HEADER 
      LDB ATPID     ADDR OF TAPE ID 
      JSB PHICM     VALID TAPE ?
      JSB ER2       NO
      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 
      LDA AHDR      GET COUNT OF DATA SETS ON TAPE
      ADA D12 
      LDB A,I 
      STB DSET#     SAVE DATA SET COUNT 
      CLA,INA 
      STA CDSCT     INIT. TAPE DATA SET COUNT TO 1
* 
      LDA ADPUM     GET PURGE DATA SET REQUEST
      LDB D10 
      JSB TERMW 
      JSB TERMR 
      LDA YESML     PURGE?
      STA CMPCT 
      LDB YESRA 
      LDA YESA
      JSB PHICM 
      JMP NOPUR 
      CLA,INA 
      STA IMODE     SET PURGE FLAG
* 
NOPUR JSB DBINT     GET FREE SPACE
      DEF *+5 
      DEF NAME
      DEF SCODE 
      DEF PNAME 
      DEF STAT
      LDB STAT
      SZB           ERROR?
      JSB ERRTN     YES!
* 
      JSB DBOPN     OPEN THE DATA BASE
      DEF *+6 
ANAME DEF NAME
ALEVL DEF LEVEL 
      DEF SCODE 
      DEF MODE
      DEF STAT
      LDB STAT      GET STATUS CODE 
      SZB           OPEN ERROR ?
      JSB ERRTN     YES 
* 
      JSB DBCRT     CREATE DATA SET FILES 
      DEF *+5 
      DEF AIRUN 
      DEF HDR 
      DEF IMODE 
      DEF STAT
      LDB STAT
      SZB           ERROR?
      JMP ERRTN     YES!
      ISZ CLFLG     SET CLOSE FLAG
      SPC 3 
********************************************************************
*                                                                  *
*     VERIFY THAT THE NEXT RECORD ON TAPE IS A FILE HEADER WITH    *
*     THE CORRECT DATA SET NUMBER, DETERMINE IF DATA SET IS TO BE   * 
*     LOADED INTO THE NEW DATA BASE, AND BUILD THE LIST OF ITEM    *
*     NUMBERS FOR 'DBPUT'.                                         *
*                                                                  *
********************************************************************
NXTDS EQU * 
      LDA D20       READ LENGTH 
      JSB TAPER     READ FILE HEADER
      JSB TSTAT     CHECK TAPE I/O STATUS 
      LDA STATS 
      AND MASK5     END OF TAPE ? 
      SZA,RSS 
      JMP GO
      JSB EOT       END OF TAPE 
      JMP NXTDS 
GO    EQU * 
      LDA D4
      STA CMPCT     STORE COMPARE LENGTH
      LDA AHDR      BUFFER ADDR 
      LDB AFHNM     ADDR OF FILE ID 
      JSB PHICM     IS THIS A FILE HDR ?
      JSB ER2       NO
      LDA AHDR      GET TAPE DATA SET NO. 
      ADA D7
      LDB A,I 
      CPB CDSCT     TAPE D.S. #  = CURR. D.S. # ? 
      RSS           YES 
      JSB ER2       NO
      INA           GET DATA ENTRY LENGTH 
      LDB A,I 
      STB DATAL     SAVE DATA ENTRY LENGTH
      ADA MD4       GET ADDR OF DATA SET NAME 
      JSB PHIS1     IS DATA SET IN DATA BASE ?
      JMP SKPDS     NO
      STA RDST#     YES, STORE ACTUAL DATA SET NO.
      CLB 
      STB SKPFL     SKIP FLAG IS 0
      JSB DBINF     GET 'INBR' LIST FOR THE DATA SET
      DEF *+5 
      DEF TYPE
      DEF RCODE 
      DEF RDST# 
      DEF INFBF 
      LDB INFBF     GET STATUS CODE 
      SZB           ERROR ? 
      JSB ERRTN     YES 
      LDA INBRC     GET ITEM COUNT
      LDB AINBR     GET ADDR OF 1ST ITEM NO.
      STB TEMP      INIT. ADDR OF CURR. ITEM NO.
CKNIT EQU * 
      LDB TEMP,I    GET CURR. ITEM NO.
      CMB,INB       MAKE ITEM NO. POSITIVE
      STB TEMP,I    STORE POSITIVE ITEM NO. 
      ADA MD1       DECR ITEM COUNT 
      ISZ TEMP      INCR TO NEXT ITEM NO. 
      SZA           END OF ITEM NO'S
      JMP CKNIT     NO
      CLA,INA 
      STA RCDCT     INIT RECORD COUNT TO 1
      JMP IBLKC 
SKPDS EQU * 
      CLA,INA 
      STA SKPFL     SET SKIP FLAG TO 1
IBLKC EQU * 
      STA BLKCT     INIT BLOCK COUNT TO 1 
      SPC 3 
********************************************************************
*                                                                  *
*     LOAD THE DATA SET OR SKIP TO THE NEXT DATA SET ON THE TAPE.  *
*                                                                  *
********************************************************************
GTNXB EQU * 
      LDA D1024     LENGTH OF DATA TO READ
      JSB TAPER     READ DATA 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 GTNXB 
FWD   EQU * 
      LDA D4
      STA CMPCT     COMPARE COUNT IS 4
      LDA AHDR      ADDR OF BUFFER
      LDB ADHNM     ADDR OF DATA ID 
      JSB PHICM     VALID TAPE ?
      JSB ER2       NO
      LDA AHDR      GET BLOCK NO. 
      ADA D4
      LDB A,I 
      CPB BLKCT     CORRECT BLOCK NO. ? 
      RSS           YES 
      JSB ER2       NO
      LDA SKPFL     GET SKIP FLAG 
      SZA,RSS       DATA SET TO BE SKIPPED ?
      JMP GTRCA     NO
      ISZ BLKCT     INCR. CURRENT BLOCK NO. 
      LDA AHDR      GET EOF FLAG FOR TAPE DATA SET
      ADA D5
      LDB A,I 
      SSB           END OF DATA SET ON TAPE ? 
      JMP CKDSE     YES 
      JMP GTNXB     NO
GTRCA EQU * 
      LDA AHDR      GET ADDR OF 1ST DATA ENTRY
      ADA D20 
      STA CHDRA 
PUTRC EQU * 
      JSB DBPUT     PUT THE CURRENT DATA ENTRY
      DEF *+6 
      DEF RDST# 
      DEF STAT
      DEF INBRC 
CHDRA BSS 1 
ADBUF DEF DBUFF 
      LDB STAT      GET STATUS CODE 
      SZB           ERROR ? 
      JSB ERRTN     YES 
      LDA AHDR      GET EOF FLAG
      ADA D5
      LDB A,I 
      SSB,RSS       END OF CURR. TAPE DATA SET
      JMP INRCT     NO
      INA           GET RECORD COUNT OF DATA SET
      LDB A,I 
      CPB RCDCT     ALL RCD'S BEEN 'PUT' ?
      JMP CKDSE     YES 
INRCT EQU * 
      ISZ RCDCT     INCR. RECORD COUNT
      LDA CHDRA     CALC. ADDR OF NEXT DATA ENTRY 
      ADA DATAL 
      STA CHDRA     STORE ADDR OF NEXT DATA ENTRY 
      ADA DATAL 
      CMA,INA 
      ADA AHEND 
      SSA,RSS       END OF CURR. DATA HDR ? 
      JMP PUTRC     NO
      ISZ BLKCT     INCR. CURRENT BLOCK NO. 
      JMP GTNXB     GET NEXT BLOCK
      SPC 3 
********************************************************************
*                                                                  *
*     CHECK FOR MORE DATA SETS TO LOAD, CLOSE THE DATA BASE, PRINT *
*     THE TERMINATION MESSAGE, AND RETURN TO SYSTEM                *
*                                                                  *
********************************************************************
CKDSE EQU * 
      LDA CDSCT     GET DATA SET COUNT
      ISZ CDSCT     INCR DATA SET COUNT 
      CPA DSET#     ALL DATA SETS LOADED ?
      RSS           YES 
      JMP NXTDS     NO
      JSB EXEC      TAPE REWIND EXEC
      DEF *+3 
      DEF RWIND 
      DEF RWCNW 
      LDA TSEQ
      JSB IACVT     CONVERT TAPE SEQUENCE NO. TO ASCII
      LDA CELL
      STA ASQ       INSERT TAPE SEQUENCE NO.
      LDA RM2 
      LDB D7
      JSB TERMW     GENERATE EOT MESSAGE
      CLA 
      STA CLFLG     CLEAR CLOSE FLAG
      JSB DBCLS     CLOSE DATA BASE 
      DEF *+3 
      DEF CMOD1 
      DEF STAT
      LDB STAT      GET CLOSE STATUS
      SZB           ERROR ? 
      JSB ERRTN     YES 
      LDA AENDM     ADDR OF END MESSAGE 
      LDB ENDML     LENGTH OF END MESSAGE 
      JSB TERMW     WRITE END MESSAGE 
RETRN EQU * 
      JSB EXEC      RETURN TO SYSTEM
      DEF *+2 
      DEF QCODE 
      SKP 
********************************************************************
*                                                                  *
*     COMPUTE THE SECURITY CODE.                                   *
*                                                                  *
********************************************************************
COMP  NOP 
      AND H8BT      CLEAR HI BYTE 
      CPA BLNK      END OF SECURITY CODE ?
      JMP COMP,I    YES, P+1
      AND H8BTA     CONVERT TO DECIMAL
      STA TEMP      SAVE VALUE
      LDA D10       COMPUTE SECURITY CODE 
      MPY SCODE 
      ADA TEMP
      STA SCODE     SAVE SECURITY CODE
      ISZ COMP      P+2 
      JMP COMP,I    RETURN
      SPC 3 
                                                                                                                                                