ASMB,L,C,R
      HED BAPS4 - REMOTE DATA BASE ACCESS PROGRAM SEGMENT 4 
      NAM BAPS4,5 92069-16259 REV.1912 790130 
* 
* 
******************************************************************* 
* (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:    92069-18264
*     RELOC:     92069-16259
* 
*     PRGMR:     CEJ
* 
* 
******************************************************************* 
* 
* 
* 
* 
      COM DABUF(2174),RQBUF(21) 
      COM RECRQ,RECDA,SEGNM,DBCNT,CLASS(5)
* 
*  Segment 4 of the Remote Data Base Access Program.  This segment is the 
*  special clean-up segment and has the following sequence of operations: 
* 
*  1)  For each entry in data base pointer table: 
* 
*      A)  If entry not empty, call DBCLS to release the data base to 
*          whose Run Table it points. 
* 
*  2)  Send a request to RDBAM to remove us from the system and terminate 
*      normally.
      SKP 
**********************************************************************
***                                                                ***
*                  Standard DS/1000 equates                          *
***                                                                ***
#STR  EQU 0 
#SEQ  EQU 1 
#SRC  EQU 2 
#DST  EQU 3 
#RDB  EQU 4 
#EC1  EQU 4 
#EC2  EQU 5 
#ENO  EQU 6 
#REP  EQU 7 
***                                                                ***
**********************************************************************
**********************************************************************
*                                                                    *
*  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 #RDB      RDBA call Index 
RBMOD EQU #RDB+1    RDBA call mode
RBID  EQU #RDB+2    RDBA call item or set number
*                              or for a DBOPN, the level code word
RBITM EQU #RDB+3    search item number for DBFND
RBMRT EQU #RDB+5    For DBOPN, the max. returned RT size
RBLEN EQU #RDB+6    word size of ibase parameter
RBBAS EQU #RDB+7    ibase parameter 
* 
MAXRQ DEC 21        maximum request buffer length 
***                                                                ***
***                                                                ***
*                                                                    *
*  Reply buffer - one buffer of either 17 or 18 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 3rd error code word 
RBSTA EQU #REP      RDBA call status array
RBNUM EQU #REP+10   RDBA data base number for DBOPN 
* 
RPLEN DEC 17        standard reply buffer length
*                              18 for DBOPN 
***                                                                ***
**********************************************************************
      EXT DBCLS,DBRTP,DBRTM,EXEC,RDEXT
* 
A     EQU 0 
B     EQU 1 
* 
*  Get the -(maximum number of entries in data base pointer table) as a 
*  loop counter, get a copy of the address of this table, and set the data
*  base index to 1. 
* 
BAPS4 LDA DBRTM 
      CMA,INA 
      STA CNTR
* 
      LDA DBRTP 
      STA ADDRS 
      CLB,INB 
      STB INDEX 
* 
*  For each entry in the table: 
*    1)  If entry not empty, call DBCLS to release data base. 
* 
LOOP  LDB ADDRS,I 
      SZB,RSS 
      JMP EMPTY     Entry is empty. 
* 
      JSB DBCLS 
       DEF *+5
       DEF INDEX    Only the d.b. index is needed by DBCLS. 
       DEF D0 
       DEF D1       Close mode 1. 
       DEF STAT 
* 
EMPTY ISZ INDEX     Bump d.b. index,
      ISZ ADDRS       and R.T. pointer table address. 
      ISZ CNTR      Done with all entries?
      JMP LOOP        No - continue.
* 
*  When done, send the requestor a successful reply.
* 
      CLA 
      CLB 
      DST ERROR 
* 
      JSB RDEXT 
       DEF *+6
       DEF RQBUF    reply buffer
       DEF D7       reply length
       DEF DABUF
       DEF D0       no data 
       DEF ERROR
      NOP           ignore errors.
* 
*  Send RDBAM a special "remove me" request to purge this copy from the 
*  system.
* 
      LDA M2        RDBA Index for such a 
      STA RQBUF+RBIDX   request is -2.
      LDA CLASS+1   Mode for the request is 
      STA RQBUF+RBMOD   our index into scheduling table.
* 
      JSB EXEC
       DEF *+8
       DEF WT/RD    Class write/read w/no abort 
       DEF CONTR    double buffer, lu 0 
       DEF DABUF
       DEF D0       no data 
       DEF RQBUF    request buffer
       DEF D7         and its length
       DEF CLASS+2  RDBAM's class number
      NOP           Ignore any errors.
* 
*  Terminate, normal completion.
* 
      JSB EXEC
       DEF *+4
       DEF D6 
       DEF D0 
       DEF D0 
* 
*  Constants and variables. 
* 
M2    DEC -2
D0    DEC 0 
D1    DEC 1 
D6    DEC 6 
D7    DEC 7 
* 
WT/RD OCT 100024
CONTR OCT 010000
* 
CNTR  NOP 
ADDRS NOP 
INDEX NOP 
ERROR BSS 2 
STAT  EQU ERROR 
      END BAPS4 
      END$
                                                                                                                                                                                                                                                              