ASMB
      HED RDEXT UTILITY SUBROUTINE FOR RDBAM & RDBAP
      NAM RDEXT,7 91750-1X188 REV.2013 791029 
* 
* 
******************************************************************* 
* (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-18188
*     RELOC:     91750-1X188
* 
* 
* 
******************************************************************* 
* 
* 
* 
*  RD EXiT is a utility subroutine for the Remote Data Base Access Program
*  and Monitor.  Its function is to build the DS/1000 header for the reply
*  buffer then call #SLAV to send the reply.
* 
*  The calling sequence for RDEXT is: 
* 
*         JSB RDEXT 
*          DEF *+6       return point 
*          DEF RPBUF     reply buffer 
*          DEF RPLEN     reply length 
*          DEF DABUF     data buffer
*          DEF DALEN     data length
*          DEF ERROR     DS error code (2 words) to put in reply
*         <error return>
*         <normal return> 
* 
      SKP 
**********************************************************************
***                                                                ***
*                  Standard DS/1000 equates                          *
***                                                                ***
*$
* 
******************************************************************
*                                                                *
*                                                                *
*     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                                           *
*  The reply buffer we are concerned with is as described below.     *
*                                                                    *
**********************************************************************
***                                                                ***
*                                                                    *
*  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 DEF #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 #REQ      RDBA call status array
RBNUM EQU #REQ+10   RDBA data base number for DBOPN 
***                                                                ***
**********************************************************************
* 
*  DS reply buffer which is in #SLAV
* 
*********************************************************************** 
REBUF DEF #RPB+0
      ENT RDEXT 
      EXT #NODE,.ENTR,#SLAV,.MVW,#RPB 
* 
A     EQU 0 
B     EQU 1 
* 
RPBUF NOP 
RPLEN NOP 
DABUF NOP 
DALEN NOP 
ERROR NOP 
* 
*  Get true parameter and return point addresses. 
* 
RDEXT NOP 
      JSB .ENTR 
       DEF RPBUF
* 
*  Bump B register to the error code words  of the reply and
*  put the 2 words passed to us in ERROR into the first two words of the
*  ECOD space in the reply buffer.
* 
      LDB RPBUF 
      ADB RBEC1 
      LDA ERROR,I 
      STA B,I 
      INB 
      LDA ERROR 
      INA 
      LDA A,I 
      STA B,I 
* 
*  If there was an error, the A register is now non-zero.  Set the node 
*  number in the 3rd error code word
*  and if the error code is ASCII, i.e. first word of ERROR is non-zero,
*  we need to set bit 15 of the 3rd error word also.
* 
      INB 
      SZA,RSS 
      JMP EXT1      No error - set ECOD3 to zero. 
* 
      LDA ERROR 
      SZA 
      LDA BIT15 
      IOR #NODE 
EXT1  STA B,I 
* 
*  Call #SLAV to send the reply.
* 
* 
*  Move the request buffer into #SLAV's request buffer
* 
      LDA RPBUF 
      LDB REBUF 
      JSB .MVW
       DEF RPLEN,I
       NOP
* 
* 
      JSB #SLAV 
       DEF *+4
       DEF RPLEN,I
       DEF DABUF,I
       DEF DALEN,I
      RSS           Error return, skip bump of return point.
* 
      ISZ RDEXT 
      JMP RDEXT,I 
* 
*  Constants and variables. 
* 
BIT15 OCT 100000
      END RDEXT 
                                                                                                          