ASMB
      HED BAPS1 - REMOTE DATA BASE ACCESS PROGRAM SEGMENT 1 
      NAM BAPS1,5 91750-1X183 REV.2013 800523 
* 
* 
******************************************************************* 
* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979. ALL RIGHTS RESERVED.
* NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, REPRODUCED, OR
* TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN
* CONSENT OF HEWLETT-PACKARD COMPANY. 
******************************************************************* 
* 
* 
*     SOURCE:    91750-18183
*     RELOC:     91750-1X183
* 
* 
* 
******************************************************************* 
* 
* 
* 
      COM DABUF(2174),RQBUF(30) 
      COM RECRQ,RECDA,SEGNM,DBCNT,CLASS(5)
* 
*  Segment 1 of the Remote Data Base Access Program.  This segment has the
*  following sequence of operations.
* 
*  1)  Determine the type of IMAGE call and branch to the appropriate 
*      call handler.
* 
*      A) DBOPN 
* 
*         I  )  Perform the DBOPN call.  If any error, go to 2. 
* 
*         II )  Increment data base count.
* 
*         III)  Build compacted Run Table for the source node in the data 
*               buffer. 
* 
*         IV )  Go to 2.
* 
*      B) DBINF 
* 
*         I )  Perform DBINF call.
* 
*         II)  Go to 2. 
* 
*      C) DBCLS 
* 
*         I )  Perform DBCLS call.  If DBCLS successful and this was a
*              mode 1 DBCLS, then decrement the data base count (DBCNT).
* 
*         II)  Go to 2. 
* 
*      D) DBLCK 
* 
*         I )  Perform DBLCK call.
* 
*         II)  Go to 2. 
* 
*      E) DBUNL 
* 
*         I )  Perform DBUNL call.
* 
*         II)  Go to 2. 
* 
*  2)  Send the RDBA reply and any data associated with it. 
* 
*  3)  If data base count (DBCNT) is zero, then send a request to RDBAM to
*      remove us from the system and terminate normally.
* 
*  4)  Return to class get in main. 
      SKP 
**********************************************************************
***                                                                ***
*                  Standard DS/1000 equates                          *
***                                                                ***
*$
* 
******************************************************************
*                                                                *
*     G L O B A L   B L O C K               REV XXXX 790531      *
*                                                                *
*     GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY:      *
*                                                                *
*         REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST        *
*         GET,   #SLAV, RQCNV, RPCNV, GRPM,  LSTEN, PTOPM        *
*         EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3        *
*                                                                *
******************************************************************
* 
***!!!!! THE FIRST 7 WORDS (#STR THRU #ENO) MUST BE FIXED !!!!!***
#STR  EQU 0         STREAM WORD.
#SEQ  EQU #STR+1    SEQUENCE NUMBER.
#SRC  EQU #SEQ+1    SOURCE NODE #.
#DST  EQU #SRC+1    DEST. NODE #. 
#EC1  EQU #DST+1    REPLY ECOD1.
#EC2  EQU #EC1+1    REPLY ECOD2.
#ENO  EQU #EC2+1    NUMBER OF NODE REPORTING ERROR. 
* 
#ECQ  EQU #ENO+1    ERROR CODE QUALIFIER (BITS 4 TO 7)
#LVL  EQU #ECQ      MESSAGE FORMAT LEVEL (BITS 0 TO 3)
#MAS  EQU #LVL+1    MA "SEND" SEQ. #
#MAR  EQU #MAS+1    MA "RECV" SEQ. #
#MAC  EQU #MAR+1    MA "CANCEL" FLAGS 
#HCT  EQU #MAC+1    HOP COUNT 
#SID  EQU #HCT+1    SESSION ID WORD 
* 
#EHD  EQU #SID      LAST ITEM OF HEADER 
#MHD  EQU #EHD+1    MINIMUM HEADER SIZE 
#REQ  EQU #MHD      START OF REQUEST SPECIFIC AREA
#REP  EQU #MHD      START OF REPLY SPECIFIC AREA
* 
#MXR  EQU #MHD+24   <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>>
#LSZ  EQU 2         <<< SIZE OF LOCAL APPENDAGE AREA >>>
* 
*$
******************************************************************
* 
***                                                                ***
**********************************************************************
**********************************************************************
*                                                                    *
*  DS/1000 RDBA Communications consist of two descriptive buffers:   *
*          1) Request buffer                                         *
*          2) Reply buffer                                           *
*  These two static buffers are as described below.                  *
*                                                                    *
**********************************************************************
***                                                                ***
*                                                                    *
*  Request buffer - one buffer of from 12 to 21 words per RDBA call  *
*                                                                    *
***                                                                ***
RBSTR EQU #STR      DS/1000 stream word 
RBSEQ EQU #SEQ      DS/1000 sequence number 
RBSRC EQU #SRC      DS/1000 source node number
RBDST EQU #DST      DS/1000 destination node number 
RBIDX EQU #REQ      RDBA call Index 
RBMOD EQU #REQ+1    RDBA call mode
RBID  EQU #REQ+2    RDBA call item or set number
*                                  or for a DBOPN, the level code word
RBITM EQU #REQ+3    Search item number for DBFND
RBMRT EQU #REQ+5    For DBOPN, max. returned RT size
RBLEN EQU #REQ+6    Word size of ibase parameter
RBBAS EQU #REQ+7    Ibase parameter 
* 
MAXRQ DEC 30        Maximum request buffer length 
***                                                                ***
***                                                                ***
*                                                                    *
*  Reply buffer - one buffer of either 23 or 24 words per RDBA call  *
*                                                                    *
***                                                                  *
* RBSTR EQU #STR    DS 1000 stream word 
* RBSEQ EQU #SEQ    DS/1000 sequence number 
* RBSRC EQU #SRC    DS/1000 source node number
* RBDST EQU #DST    DS/1000 destination node number 
RBEC1 EQU #EC1      DS/1000 1st error code word 
RBEC2 EQU #EC2      DS/1000 2nd error code word 
RBEC3 EQU #ENO      DS/1000 error node number upon an error 
RBSTA EQU #REP      RDBA call status array
RBNUM EQU #REP+10   RDBA data base number for DBOPN 
* 
RPLEN DEC 23        Standard reply buffer length
OLEN  DEC 24          DBOPN is 1 more 
*                                  24 for DBOPN 
***                                                                ***
**********************************************************************
* 
      ENT BAPS1 
      EXT BP.GT,DBCLS,DBINF,DBLCK,DBOPN,DBUNL 
      EXT EXEC,GETKY,RDEXT
* 
A     EQU 0 
B     EQU 1 
DAADR DEF DABUF 
BFLEN DEC 2174
* 
*  Set the reply length to the standard reply length. 
* 
BAPS1 LDA RPLEN 
      STA LENTH 
* 
*  Put our name suffix into SEGNM in common.  That way, RDBAP (the main)
*  will not reload us if another request comes through for us to handle.
* 
      LDA SUFIX 
      STA SEGNM 
* 
*  Determine the type of IMAGE call being made by the index calculated in 
*  the main and jump to the proper handling routine.  Remember that this
*  index is: 45 - (RDBA Index). 
* 
      LDA RQBUF+RBIDX 
      ADA JMPTB 
      JMP A,I 
* 
JMPTB DEF *+1 
      JMP UNL       RDBA Index = 45, DBUNL
      JMP LCK       RDBA Index = 44, DBLCK
      JMP E159
      JMP E159        RDBA Index within [43,39] 
      JMP E159          should not happen.
      JMP E159
      JMP E159
      JMP CLS       RDBA Index = 38, DBCLS
      JMP INF       RDBA Index = 37, DBINF
      JMP OPN       RDBA Index = 36, DBOPN
      SKP 
* 
*  A remote DBOPN.
*  The RDBA request buffer contains the following information.
* 
OPMOD EQU RQBUF+RBMOD   open mode 
LEVEL EQU RQBUF+RBID    level code word (3 words) 
OPBAS EQU RQBUF+RBBAS  data base namr 
* 
*  The status array is directly following the DS reply buffer heading.
*  In the 24th word of the reply buffer, we return our suffix.
* 
OPSTA EQU RQBUF+RBSTA   status array
OPSUF EQU RQBUF+RBNUM   remote data base number.
* 
*  Save off maximum acceptable Run Table size for later.
* 
OPN   LDA RQBUF+RBMRT 
      STA MAXRT 
* 
*  Perform the DBOPN call.
* 
      JSB DBOPN 
       DEF *+5
       DEF OPBAS
       DEF LEVEL
       DEF OPMOD
       DEF OPSTA
* 
*  If DBOPN succeeded, we need to build the source node's compacted Run 
*  Table and increment the data base count.  Else, we can just return the 
*  error to the source node.
* 
      CLB           Set length of reply data to zero. 
      LDA OPSTA 
      SZA 
      JMP EXIT
* 
*  Since DBOPN succeeded, put our index into first byte of OPSUF, then
*  set the reply length to one more than the standard reply length. 
* 
      ISZ DBCNT     Increment data base count.
      LDA CLASS+1 
      ALF,ALF 
      IOR OPBAS 
      STA OPSUF 
      ISZ LENTH 
* 
*  Initialize the parameters for the Run Table build. 
* 
* 
*  Get the address of the data buffer from common.
* 
      LDA DAADR 
      STA ADDRS 
* 
*  Determine the address for the item number buffer.  We will use this for
*  a call to DBINF in mode 103.  This returns the number of accesible items 
*  in the data base and their respective item numbers (negative if write- 
*  able). 
* 
      ADA BFLEN     Use the last 256 words of the 
      ADA M256        data buffer.  Maximum of
      STA ITADR       255 items.
* 
*  Call DBINF to return us the item count and numbers.
* 
      JSB DBINF 
       DEF *+6
       DEF OPBAS
       DEF DUMMY    This param ignored. 
       DEF D103 
       DEF DUMMY    We need only 2 words for status.
       DEF ITADR,I
* 
*  Now, our data buffer looks like this:
* 
*               word       +------------------------------+ 
*           DABUF -> 1     |                              | 
*                          |           unused             | 
*                          |             as               | 
*                          |             of               | 
*                          |             yet              | 
*                          |                              | 
*                          -------------------------------- 
*   DABUF + BFLEN - 256    |          item count          | 
*                          |     followed by count        | 
*                          |     number of item numbers   | 
*         DABUF + BFLEN    +------------------------------+ 
* 
*  We want to build the item table for the remote machine at the begin- 
*  ning + 1 word of the data buffer as follows: 
*    For each item number returned to us through the DBINF 103 call, call 
*    DBINF in mode 102 to get the item's name, element count and element
*    length.  (DBINF actually returns us 13 words of info but only these
*    9 words are of interest to us.)  These 13 words of info are put into 
*    the first 13 words of the data buffer which, as of yet, have not been
*    used.  To get an idea of what this does, the data buffer with look 
*    like this after the first mode 102 call: 
* 
*               word       +------------------------------+ 
*             DABUF + 2    |   16 character               | 
*                          |       data item name         | 
*                          |           (8 words)          | 
*                          -------------------------------- 
*            DABUF + 10    |   item type   |     blank    | 
*                          -------------------------------- 
*            DABUF + 11    |        element length        | 
*                          -------------------------------- 
*            DABUF + 12    |        element count         | 
*                          -------------------------------- 
*            DABUF + 13    |       doubleword             | 
*                          |                zero          | 
*                          -------------------------------- 
*            DABUF + 15    |                              | 
*                          |            unused            | 
*                          |              as              | 
*                          |              of              | 
*                          |              yet             | 
*                          |                              | 
*                          -------------------------------- 
*   DABUF + BFLEN - 256    |          item count          | 
*                          |    followed by count num-    | 
*                          |    ber of item numbers       | 
*         DABUF + BFLEN    +------------------------------+ 
* 
*    We then condense these 13 words into the 5 words needed by a remote
*    1000 node.  The result takes the form: 
* 
*              word        +------------------------------+ 
*             DABUF + 2    |        item name             | 
*                          |        (3 words)             | 
*                          |                              | 
*                          -------------------------------- 
*             DABUF + 5    |        item number           | 
*                          -------------------------------- 
*             DABUF + 6    | item length = element count *| element length
*                          -------------------------------- 
*             DABUF + 7    |                              | 
*                          |           unused             | 
*                          |             as               | 
*                          |             of               | 
*                          |             yet              | 
*                          |                              | 
*                          -------------------------------- 
*   DABUF + BFLEN - 256    |           item count         | 
*                          |     followed by count num-   | 
*                          |    ber of item numbers       | 
*         DABUF + BFLEN    +------------------------------+ 
* 
*  The first word of the data buffer contains the item count which is taken 
*  from the first word of the item number buffer at the end.  The buffer
*  for the next DBINF call then starts at the first word following the 5
*  words of information for the first item.  This process is repeated for 
*  each item in the item number list. 
* 
      LDA ITADR,I   Use negative number of items
      STA ADDRS,I     as a loop counter.
      ISZ ADDRS 
      SZA,RSS 
      JMP OPN2      No items accessible.
      CMA,INA 
      STA CNTR
* 
OPN1  ISZ ITADR     If item number is negative, 
      LDA ITADR,I     make it positive. 
      SSA 
      CMA,INA 
      STA ITADR,I 
* 
      JSB DBINF     Get the item's info.
       DEF *+6
       DEF OPBAS
       DEF ITADR,I
       DEF D102 
       DEF DUMMY
       DEF ADDRS,I
* 
      LDB ADDRS     Get item type from
      ADB D8          returned info 
      STB TEMP             and save.
      INB           Get element length
      LDA B,I 
      INB             and element count 
      STB DUMMY 
      CLB             and multiply to get item
      MPY DUMMY,I     length in a register. 
      LDB TEMP,I    If item type is X 
      CPB /X          this length is now in bytes.
      ARS             get it in words.
* 
      LDB ADDRS     Compact the info. 
      ADB D3
      STB ADDRS 
      LDB ITADR,I 
      STB ADDRS,I 
      ISZ ADDRS 
      STA ADDRS,I 
      ISZ ADDRS 
* 
      ISZ CNTR
      JMP OPN1
* 
*  Now that we've built the item table for the remote machine, we need to 
*  build its set table.  The set table is built basically the same as the 
*  item table.  First we do a mode 203 DBINF call to get the count and
*  numbers of all available sets.  Then, for each set we do a mode 202 call 
*  to get the set name, entry length and set type.  Although DBINF returns
*  17 words of information only these five words are of interest.  We then
*  compact the 17 words into 5 words for the remote 1000.  After this com-
*  paction, we check the type of the data set.  If it is a master, we need
*  to determine the length of its key item.  GETKY performs this service
*  for us.  Then, the key item length is appended to the compacted informa- 
*  tion.  If the set is a detail, a zero is appended.  Each entry, then,
*  appears as:
* 
*                          +------------------------------+ 
*                          |        set name              | 
*                          |        (3 words)             | 
*                          |                              | 
*                          -------------------------------- 
*                          |        set number            | 
*                          -------------------------------- 
*                          |        length of entry       | 
*                          -------------------------------- 
*                          |   key item length, or zero   | 
*                          +------------------------------+ 
* 
*  Preceding the set table, and in the first word after the item table, is
*  stored the set count.  The final remote Run Table then looks like: 
* 
*                          +------------------------------+ 
*                          |         item count           | 
*                          -------------------------------- 
*                          |       item table             | }    5
*                          |           entry # 1          | }   words 
*                          -------------------------------- 
*                          .                              . 
*                          .                              . 
*                          .                              . 
*                          -------------------------------- 
*                          |        item table            | 
*                          |           entry # count      | 
*                          -------------------------------- 
*                          |          set count           | 
*                          -------------------------------- 
*                          |         set table            | }    6
*                          |            entry # 1         | }   words 
*                          -------------------------------- 
*                          .                              . 
*                          .                              . 
*                          .                              . 
*                          -------------------------------- 
*                          |         set table            | 
*                          |            entry # count     | 
*                          +------------------------------+ 
* 
* 
*  First, determine the address for the set number buffer.  We will use the 
*  last 51 words of the data buffer for this purpose. 
* 
OPN2  LDA DAADR 
      ADA BFLEN 
      ADA M51 
      STA STADR 
* 
*  Call DBINF to return us the set count and numbers. 
* 
      JSB DBINF 
       DEF *+6
       DEF OPBAS
       DEF DUMMY    This param. ignored 
       DEF D203 
       DEF DUMMY    Two words of status only
       DEF STADR,I
* 
*  Put the set count in the data buffer, and negate it for a loop counter.
* 
      LDA STADR,I 
      STA ADDRS,I 
      ISZ ADDRS 
      SZA,RSS 
      JMP OPN5      No sets accessible
      CMA,INA 
      STA CNTR
* 
*  For each set number in the buffer get the necessary information. 
* 
OPN3  ISZ STADR 
      LDA STADR,I   If the set number is negative,
      SSA 
      CMA,INA         make it positive. 
      STA STADR,I 
* 
      JSB DBINF 
       DEF *+6
       DEF OPBAS
       DEF STADR,I
       DEF D202 
       DEF DUMMY
       DEF ADDRS,I
* 
*  Compact the information we already have. 
* 
      LDB ADDRS 
      ADB D8        But first get and save the
      LDA B,I         set type in word 8
      STA TEMP
      INB             and the entry length
      LDA B,I         in word 9.
      STA DUMMY 
* 
      LDB ADDRS 
      ADB D3
      LDA STADR,I   Set number
      STA B,I 
      INB 
      LDA DUMMY     Entry length
      STA B,I 
      INB 
      STB ADDRS     Save place in entry.
* 
*  If set a master, get its key item length through GETKY.
* 
      LDA TEMP
      CPA /D
      JMP OPN4
* 
      JSB GETKY     Returns length
       DEF *+2        in A register.
       DEF STADR,I
      RSS 
* 
OPN4  CLA           Length = 0 for a detail 
      STA ADDRS,I 
      ISZ ADDRS 
      ISZ CNTR
      JMP OPN3
* 
*  Run Table complete.  Calculate the length of the returned data as fol- 
*  lows:
*          length = (# of items) * 5
*                 + (# of sets) * 6 
*                 + 2 <<for counts>>. 
*  Make sure that the Run Table built is no longer than the maximum allow-
*  able, then jump with the data length in the B register to the exit 
*  routine.  If the resulting Run Table is longer than maximum, then clean- 
*  up open and return an IMAGE size error.
* 
OPN5  LDA DABUF 
      CLB 
      MPY D5
      STA TEMP
      ADA DAADR 
      INA 
      LDA A,I 
      CLB 
      MPY D6
      LDB D2
      ADB A 
      ADB TEMP
* 
      STB A         A = B = length of built Run Table.
      CMA,INA 
      ADA MAXRT 
      SSA,RSS       A > max. allowed? 
      JMP EXIT        No
* 
      LDA OPSUF       Yes - get data base number
      AND LOBYT         from reply buffer.
      STA TEMP
* 
      JSB DBCLS     Close newly opened data base. 
       DEF *+5
       DEF TEMP 
       DEF D0 
       DEF D1 
       DEF DUMMY
* 
      CCA           Decrement data base count.
      ADA DBCNT 
      STA DBCNT 
* 
      LDA D128      Set error code to 128 
      STA OPSTA 
      LDA RPLEN       reply length to 23
      STA LENTH 
      CLB             and data length to zero.
      JMP EXIT      Then return.
* 
*  Constants and variables. 
* 
M256  DEC -256
M51   DEC -51 
D3    DEC 3 
D5    DEC 5 
D8    DEC 8 
D102  DEC 102 
D103  DEC 103 
D128  DEC 128 
D202  DEC 202 
D203  DEC 203 
* 
/D    ASC 1,D 
/X    ASC 1,X 
* 
CNTR  NOP 
ADDRS NOP 
ITADR NOP 
STADR EQU ITADR 
DUMMY BSS 2 
TEMP  NOP 
MAXRT NOP 
      SKP 
* 
*  A remote DBINF.
*  The RDBA request buffer contains the following information:
* 
IFMOD EQU RQBUF+RBMOD   Info mode 
IFID  EQU RQBUF+RBID    Data set or item number 
IFBAS EQU RQBUF+RBBAS   Data base parameter 
* 
*  The status array is directly following the DS reply header.
* 
IFSTA EQU RQBUF+RBSTA 
* 
*  The ibuf parameter is the data buffer. 
* 
IFBUF EQU DABUF 
* 
*  Perform the DBINF call.
* 
INF   LDA IFMOD         Save the MODE for later.
      STA TEMP2 
* 
      JSB DBINF 
       DEF *+6
       DEF IFBAS
       DEF IFID 
       DEF IFMOD
       DEF IFSTA
       DEF IFBUF
* 
*  If DBINF returned an error code or this was a mode 402 request, there
*  is no data to return.  Else, get the length of the data to return from 
*  the second word of istat and jump to the EXIT routine. 
* 
      CLB 
      LDA TEMP2 
      CPA D402
      RSS 
      LDA IFSTA 
      SZA,RSS 
      LDB IFSTA+1 
      JMP EXIT
TEMP2 NOP 
      SKP 
* 
*  A remote DBCLS.
*  The RDBA request buffer contains the following information:
* 
CLMOD EQU RQBUF+RBMOD   Close mode
CLID  EQU RQBUF+RBID    Data set number 
CLBAS EQU RQBUF+RBBAS   Data base parameter 
* 
*  The status array is directly following the DS reply header.
* 
CLSTA EQU RQBUF+RBSTA 
* 
*  There is no data associated with the request or reply. 
* 
*  Perform the DBCLS call.
* 
CLS   LDA CLMOD         Save the close mode.
      STA TEMP2 
* 
      JSB DBCLS 
       DEF *+5
       DEF CLBAS
       DEF CLID 
       DEF CLMOD
       DEF CLSTA
* 
*  Set the returned data langth to zero.  Then, if the close mode was 1 
*  and the DBCLS call succeeded, decrement the data base count. 
* 
      CLB 
      LDA TEMP2 
      CPA D1
      RSS 
      JMP EXIT
* 
      CCB 
      ADB DBCNT 
      LDA CLSTA     1st word of CLSTA is zero 
      SZA,RSS         if DBCLS succeeded. 
      STB DBCNT 
      CLB 
      JMP EXIT
      SKP 
* 
*  A remote DBLCK.
*  The RDBA buffer contains the following information:
* 
LKMOD EQU RQBUF+RBMOD   Lock mode 
LKID  EQU RQBUF+RBID    Unused data set number
LKBAS EQU RQBUF+RBBAS   Data base parameter 
* 
*  The status array is the directly following the DS reply buffer.
* 
LKSTA EQU RQBUF+RBSTA 
* 
*  There is no data associated with the request or reply. 
* 
*  Perform the DBLCK call.
* 
LCK   JSB DBLCK 
       DEF *+5
       DEF LKBAS
       DEF LKID 
       DEF LKMOD
       DEF LKSTA
* 
*  Set the returned data length to zero and jump to the exit routine. 
* 
      CLB 
      JMP EXIT
      SKP 
* 
*  A remote DBUNL.
*  The RDBA request buffer contains the following information:
* 
ULMOD EQU RQBUF+RBMOD   Unlock mode 
ULID  EQU RQBUF+RBID    Unused data set number
ULBAS EQU RQBUF+RBBAS   Data base parameter 
* 
*  The status array is the directly following the DS reply buffer.
* 
ULSTA EQU RQBUF+RBSTA 
* 
*  There is no data associated with the request or reply. 
* 
*  Perform the DBUNL call.
* 
UNL   JSB DBUNL 
       DEF *+5
       DEF ULBAS
       DEF ULID 
       DEF ULMOD
       DEF ULSTA
* 
*  Set the returned data length to zero and continue into the exit routine. 
* 
      CLB 
      JMP EXIT
      SKP 
* 
*  This is the only DS error return point.  A bad RDBA index found. 
* 
E159  LDB M159      Get error code and set
      CLA             returned data length to zero. 
      STA RECDA 
      JMP EXIT2 
* 
*  This is the exit routine for segment 1 of RDBAP.  Its purpose is to
*  call the necessary subroutines in order to send the RDBA reply to the
*  orginating node and to terminate this operation.  All replies are sent 
*  through RDEXT. 
* 
EXIT  STB RECDA     Set returned data length in common. 
      CLA           Set error code to zero
      CLB             i.e. no error.
EXIT2 DST ERROR 
* 
      JSB RDEXT     RDEXT builds the reply buffer 
       DEF *+6        and then sends it to the
       DEF RQBUF      originator through #SLAV. 
       DEF LENTH
       DEF DABUF
       DEF RECDA
       DEF ERROR
      RSS           Error on sending reply. 
      JMP EXIT3     Normal return.
* 
*  On error from RDEXT, check to see if this was a successful DBOPN re- 
*  quest.  (The reply length will be 24 in this case.)  If so, close the
*  newly opened data base and decrement the data base count.
* 
      LDA LENTH 
      CPA OLEN
      RSS 
      JMP EXIT3     Not a DBOPN.
* 
      LDA OPSUF     Get data base number
      AND LOBYT       from reply buffer.
      STA TEMP      This is all we need for DBCLS.
* 
      JSB DBCLS 
       DEF *+5
       DEF TEMP 
       DEF D0 
       DEF D1       Close mode 1. 
       DEF DUMMY    Dummy status array. 
* 
      CCA           Decrement data base count.
      ADA DBCNT 
      STA DBCNT 
* 
*  If the data base count is now zero, we want to terminate ourselves.
* 
EXIT3 LDA DBCNT     If data base count is not zero, 
      SZA 
      JMP BP.GT       return to class get in main.
* 
      LDA M2        Else, tell RDBAM to OFf us. 
      STA RQBUF+RBIDX RDBA Index = -2 for such a request. 
      LDA CLASS+1   Mode is our index into
      STA RQBUF+RBMOD   the RDBAP copy scheduling table.
      JSB EXEC
       DEF *+8
       DEF WT/RD    write/read w/no abort 
       DEF CONTR    double buffer, lu 0 
       DEF DABUF
       DEF D0       no data 
       DEF RQBUF    OFf request buffer
       DEF RPLEN      and length
       DEF CLASS+2  RDBAM's class number
      NOP           ignore abortion return
* 
      JSB EXEC      Then terminate. 
       DEF *+4
       DEF D6 
       DEF D0 
       DEF D0       Normal completion.
* 
*  Constants and variables. 
* 
M159  DEC -159
M2    DEC -2
D0    DEC 0 
D1    DEC 1 
D2    DEC 2 
D6    DEC 6 
D402  DEC 402 
* 
WT/RD OCT 100024
CONTR OCT 010000
LOBYT OCT 377 
SUFIX ASC 1,1 
* 
ERROR BSS 2 
LENTH NOP 
      END BAPS1 
                                                                                                