ASMB,L,C,R
      HED RDBAP - REMOTE DATA BASE ACCESS PROGRAM MAIN
      NAM RDBAP,20,40 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-18260
*     RELOC:     92069-16259
* 
*     PRGMR:     CEJ
* 
* 
******************************************************************* 
* 
* 
* 
* 
      COM DABUF(2174),RQBUF(21) 
      COM RECRQ,RECDA,SEGNM,DBCNT,CLASS(5)
* 
*  This is the main of the Remote Data Base Access Program for Remote 
*  IMAGE/1000.  It performs the following sequence of operations. 
* 
*  1)  Retrieve scheduling parameters.  These are our class number, our 
*      index in the RDBAP copy scheduling table, and RDBAM's class number,
*      in that order. 
* 
*  2)  Ask D65GT to get the request and data off of our class.  If there
*      is any error:
* 
*      A)  Send a reply with proper DS error code.
* 
*      B)  If we do not have a data base open (DBCNT is zero) then send 
*          RDBAM a request to remove us from the system (RDBA Index is -2 
*          and Mode is our index in RDBAP copy scheduling table) and termi- 
*          nate normally. 
* 
*      C)  Return to class GET. 
* 
*  3)  Get RDBA Index from 5th word of request buffer.  If it is a negative 
*      one (-1), this is a clean-up request.  Schedule the 4th segment of 
*      this program.  If any error, set DBCNT to zero and go to 2-B.
* 
*  4)  Get RDBA Index from 5th word of request buffer and bound check for 
*      validity.  Index must be within [36,45].  If bound check fails, go 
*      to 2-A.
* 
*  5)  Determine the segment of our program which is to service this re-
*      quest as follows:
*          DBOPN, DBINF, DBLCK, DBUNL, DBCLS serviced by segment 1
*          DBFND, DBGET, DBUPD serviced by segment 2
*          DBPUT, DBDEL serviced by segment 3 
* 
*  6)  Load and execute the appropriate segment.  If any error go to 2-A. 
* 
      ENT RDBAP,BP.GT 
      EXT BAPS1,BAPS2,BAPS3 
      EXT D65GT,DBBUF,EXEC,RDEXT,RMPAR,SEGLD
      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, max. returned RT size
RBLEN EQU #RDB+6    Word size of ibase parameter
RBBAS EQU #RDB+7    Ibase parameter 
***                                                                ***
***                                                                ***
*                                                                    *
*  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 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 17        Standard reply buffer length
*                                  18 for DBOPN 
***                                                                ***
**********************************************************************
* 
*  Maximum request and data buffers.
* 
MAXRQ DEC 21
MAXDA DEC 2174
* 
A     EQU 0 
B     EQU 1 
      SKP 
* 
*  Retrieve scheduling parameters 
* 
RDBAP JSB RMPAR 
       DEF *+2
       DEF CLASS
* 
*  Ask D65GT to get the data and request off of our class number for us.
* 
BP.GT JSB D65GT 
       DEF *+6
       DEF CLASS    D65GT needs: class number 
       DEF RQBUF                 request buffer 
       DEF MAXRQ                 max. request length
       DEF DABUF                 data buffer
       DEF MAXDA                 max. data length 
      JMP E153      error return point
* 
      STA RECRQ          returns: request length in 
      STB RECDA            A reg., data length in B.
* 
*  Get the RDBA Index from the request buffer (5th word) and check if this
*  is a special clean-up request from the DS software.  If so, the Index
*  will be -1, bring up the 4th segment to perform the clean-up.
* 
      LDA RQBUF+RBIDX 
      INA,SZA 
      JMP BAP       No - a normal request.
* 
      JSB SEGLD 
       DEF *+3
       DEF SEG4,I 
       DEF IERR 
* 
*  If we returned from the SEGLD call, we got an error.  One of our seg-
*  ments is missing.  Set data base count (DBCNT) to zero, and terminate
*  permanently. 
* 
      CLB 
      STB DBCNT 
      JMP EREXT 
      SKP 
* 
*  Get the RDBA index from the request buffer (5th word) and make sure it 
*  falls within the bounds of an IMAGE/1000 call, i.e. Index within [36..45]. 
*  The bound check effectively maps [36..45] onto [0..9] in a one-to-one
*  fashion. 
* 
BAP   LDB RQBUF+RBIDX 
      CMB,INB 
      ADB D35       Is index > 35?
      SSB,RSS 
      JMP E159        No - error
      ADB D10         Yes - is index < 46?
      SSB 
      JMP E159          No - error
      STB RQBUF+RBIDX   Yes - save this result
* 
*  The base parameter for the IMAGE call starts in the 12th word of the 
*  request buffer.  Its first word contains the index for our program in the
*  high byte and the data base number in the low byte.  Remove our index
*  from this word (unless this happens to be a DBOPN call in which case it
*  is two blanks and is left the same). 
* 
      CPB D9        B = 9 if a DBOPN request. 
      JMP BAP0
      LDA RQBUF+RBBAS 
      AND LOBYT 
      STA RQBUF+RBBAS 
* 
*  We will allow each segment to do its own parse of the request (and data) 
*  buffer(s) because it varies from call to call.  Now, all we need to do 
*  is determine which segment to load (based on the index we resulted in
*  from our subtractions and additions above and jumping into the table 
*  below), then we load it. 
* 
BAP0  BLS           Multiply index by two 
      ADB TABAD       (2 words/entry in table)
      JMP B,I         then index into the table.
* 
TABAD DEF *+1 
      LDA SEG1      Index = 45, DBUNL 
      JMP BAP1
      LDA SEG1      Index = 44, DBLCK 
      JMP BAP1
      LDA SEG3      Index = 43, DBDEL 
      JMP BAP1
      LDA SEG3      Index = 42, DBPUT 
      JMP BAP1
      LDA SEG2      Index = 41, DBUPD 
      JMP BAP1
      LDA SEG2      Index = 40, DBGET 
      JMP BAP1
      LDA SEG2      Index = 39, DBFND 
      JMP BAP1
      LDA SEG1      Index = 38, DBCLS 
      JMP BAP1
      LDA SEG1      Index = 37, DBINF 
      JMP BAP1
      LDA SEG1      Index = 36, DBOPN 
* 
BAP1  STA SEGAD 
* 
*  Check to see if this segment is already in memory.  If so, no need to
*  call SEGLD to bring it in again.  The current segment's name suffix
*  is in SEGNM in common. 
* 
      ADA D2
      LDA A,I 
      CPA SEGNM 
      RSS 
      JMP BAP2      Not there, load it. 
* 
*  Segment is already in memory.  Determine which entry point to take by
*  putting the number suffix in the low order byte of the A register and
*  subtracting 61B to get a number within [0..2].  Then use this number 
*  as an index into the following JMP table.
* 
      ALF,ALF 
      AND LOBYT 
      ADA M61B
      ADA JMPTB 
      JMP A,I 
* 
JMPTB DEF *+1 
      JMP BAPS1     Segment one.
      JMP BAPS2     Segment two.
      JMP BAPS3     Segment three.
* 
*  Segment not already in memory.  Load it and give it control. 
* 
BAP2  JSB SEGLD 
       DEF *+3
SEGAD  ABS *-*
       DEF IERR 
* 
*  If we returned from the SEGLD call, we got an error.  One of our seg-
*  ments is missing.
* 
      LDB M156      Segment error 
      RSS 
E159  LDB M159      Illegal index 
      RSS 
E153  LDB M153      Illegal request or data size
EREXT CLA 
      DST ERROR 
* 
      CLB 
      STB RECDA     Set returned data length to zero. 
      JSB RDEXT     Send DS reply.
       DEF *+6
       DEF RQBUF    RDEXT needs: reply buffer 
       DEF RPLEN                 reply length 
       DEF DABUF                 data buffer
       DEF RECDA                 data length
       DEF ERROR                 error code.
      NOP 
* 
      LDA DBCNT     If we have no open data base, 
      SZA 
      JMP BP.GT 
* 
      LDA M2        Send RDBAM a "remove me" request. 
      STA RQBUF+RBIDX RDBA Index is -2 for this request 
      LDA CLASS+1     and the mode is our index 
      STA RQBUF+RBMOD   into the RDBAP copy scheduling table. 
* 
      JSB EXEC
       DEF *+8
       DEF WT/RD    write/read w/no abort 
       DEF CONTR    double buffer, lu zero
       DEF DABUF
       DEF D0       no data 
       DEF RQBUF    OFf request buffer
       DEF D7       request length
       DEF CLASS+2  RDBAM's class number
      NOP           ignore errors 
* 
      JSB EXEC      End of run. 
       DEF *+4
       DEF D6 
       DEF D0 
       DEF D0       Normal completion.
* 
*  Constants and variables. 
* 
M159  DEC -159
M156  DEC -156
M153  DEC -153
M61B  OCT -61 
M2    DEC -2
D0    DEC 0 
D2    DEC 2 
D6    DEC 6 
D7    DEC 7 
D9    DEC 9 
D10   DEC 10
D35   DEC 35
* 
WT/RD OCT 100024
CONTR OCT 010000
LOBYT OCT 377 
* 
ERROR BSS 2 
IERR  EQU ERROR 
* 
SEG1  DEF *+1 
      ASC 3,BAPS1 
SEG2  DEF *+1 
      ASC 3,BAPS2 
SEG3  DEF *+1 
      ASC 3,BAPS3 
SEG4  DEF *+1 
      ASC 3,BAPS4 
      END RDBAP 
                                                                                                                                                                                              