ASMB
      HED BAPS4 - REMOTE DATA BASE ACCESS PROGRAM SEGMENT 4 
      NAM BAPS4,5 91750-1X186 REV.2013 790812 
* 
* 
******************************************************************* 
* (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-18186
*     RELOC:     91750-1X186
* 
* 
* 
******************************************************************* 
* 
* 
* 
* 
      COM DABUF(2174),RQBUF(30) 
      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                          *
***                                                                ***
*$
* 
******************************************************************
*                                                                *
*     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, the 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 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 23        standard reply buffer length
*                              one more 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 RPLEN    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 RPLEN      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 
* 
WT/RD OCT 100024
CONTR OCT 010000
* 
CNTR  NOP 
ADDRS NOP 
INDEX NOP 
ERROR BSS 2 
STAT  EQU ERROR 
      END BAPS4 
      END$
                                                                                                                                                                  