ASMB HED RBMST UTILITY SUBROUTINE OF RDBA-IMAGE/1000 NAM RBMST,7 91750-1X187 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-18187 * RELOC: 91750-1X187 * * * ******************************************************************* * * * * Remote data Base MaSTer is a utility subroutine for the RDBA subrou- * tines whose function it is to take the RDBA parameters and build the * DS/1000 or request buffer, send the request to the remote node and * await the reply. When the reply is received, RBMST breaks the reply * buffer into the RDBA reply parameters. If a DS error occurs, it puts the * error code in the status array and takes the error exit, else it takes * the normal return. * * The calling sequence for RBMST is: * * JSB RBMST * DEF *+11 return address * DEF INDEX RDBA index * DEF MODE IMAGE call mode * DEF INFO1 - for DBOPN this is a 3 word level code word * - for all other calls, this is a data set or * data item number. * DEF INFO2 - for a DBFND this is a data item number * - for a DBGET this is the word length of the * data expected * - for a DBOPN the remote data base number * - for all other calls this parameter is a dummy * DEF BASE IMAGE call base parameter * DEF STAT IMAGE call status array. * DEF OUTDA outgoing data buffer * DEF OUTLN outgoing data length * DEF INDA incoming data buffer * DEF INLN incoming data length * < error return > * < normal return > * SKP ********************************************************************** * * * Run Table for local machine in Remote Data Base Access * * * * The local copy of the Run Table used by the RDBA master subrou- * * tines consists of the following sections: * * * * 1) Data Base Control Block * * 2) Data Item Table * * 3) Data Set Table * * 4) Sort Table * * * * These sections are in the order stated. Details of each section * * follow. * * * ********************************************************************** *** *** * * * Data Base Control Block - one 17 word entry per data base * * * *** *** * * * RDCBS DEC 17 DCB size * * RDNAM DEC 0 data base name - three words RDRBN DEC 3 remote data base number RDDSN DEC 5 DS node number * RDITC DEC 7 data item count * RDITP DEC 8 data item table pointer * RDDSC DEC 9 data set count * RDDSP DEC 10 data set table pointer * RDSOP DEC 11 sort table pointer * RDLMD DEC 13 lock flag/open mode * RDLFG DEC RDLMD 1st byte: lock flag * RDMOD DEC RDLMD 2nd byte: open mode * RDCBC DEC 15 # of DCBs desired = 0 * RDMDL DEC 16 maximum data length * *** * * 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 request buffer for RDBA. * * * * The request buffer is comprised of the following sections: * * * * 1) standard DS/1000 header * * 2) apppendage * * * * These section appear in the order stated. Details of each * * section follow. * * * ********************************************************************** *** *** * * * DS/1000 header - one 13 word entry per request * * * *** *** DS1HL EQU #MHD header length * DS1ST EQU #STR stream word, stream # = 10 DS1SQ EQU #SEQ RTE sequence number DS1DN EQU #DST destination node number DS1RQ EQU #REQ start of request specific buffer * *** *** * * * Appendage - from 9 to 27 words per request * * * *** *** RBIDX EQU #REQ RDBA index RBMOD EQU RBIDX+1 IMAGE call mode RBIN1 EQU RBMOD+1 IMAGE call info RBLEV EQU RBIN1 - for DBOPN level code word RBID EQU RBIN1 - for other calls, set or item # RBIN2 EQU RBIN1+1 IMAGE call info RBITM EQU RBIN2 - for DBFND item number RBDLN EQU RBIN2 - for DBGET expected data length RBMRT EQU RBIN2+2 for DBOPN, the max. returned RT size RBBLN EQU RBMRT+1 word size of base parameter RBBAS EQU RBBLN+1 base parameter RBRBN EQU RBBAS 1st word: remote base number RBBNR EQU RBBAS+1 remainder of base parameter * RBLVL DEF #RQB+RBLEV RBNAM DEF #RQB+RBBNR RBASE DEF RBBAS SKP ********************************************************************** * * * DS reply buffer for RDBA. * * * * The reply buffer is comprised of the following sections: * * * * 1) standard DS/1000 header * * 2) appendage * * * * These section appear in the order stated. Details of each * * section follow. * * * ********************************************************************** *** *** * * * DS/13000 header - one 13 word entry per reply * * * * * *** *** DS1RL EQU #MHD header length * DS1E1 EQU #EC1 DS error code word 1 DS1E2 EQU #EC2 DS error code word 2 DS1EN EQU #ENO node # at which error occurred * DSRL DEF DS1RL length of header DSTAT DEF #RQB+#REP address of returned 10 word status *** *** * * * Maximum reply length is 24 words. * * * *** *** RPMAX DEC 24 SKP A EQU 0 B EQU 1 * ENT RBMST EXT .ENTR,.MVW,AIRUN,#MAST,#RQB * INDEX NOP MODE NOP INFO1 NOP INFO2 NOP BASE NOP STAT NOP OUTDA NOP OUTLN NOP INDA NOP INLN NOP * * Get true parameter and return point addresses. * RBMST NOP JSB .ENTR DEF INDEX * * Build the appendage: * * 1) RDBA index * LDA INDEX,I STA #RQB+RBIDX * * 2) IMAGE call mode * LDA MODE,I STA #RQB+RBMOD * * 3) INFO1 and INFO2 * A) If INDEX NE 36 (i.e. request not a DBOPN) INFO1 and INFO2 are * both only 1 word long. Move them into the appendage and update * the appendage address to the word to contain the base parameter * size. * LDA INDEX,I CPA D36 JMP MST1 * LDA INFO1,I STA #RQB+RBIN1 LDA INFO2,I STA #RQB+RBIN2 JMP MST2 * * B) If INDEX = 36, INFO1 is a level code word (3 words long) * and INFO2 is ignored. Immediately following the level code * word in the appendage is the maximum Run Table size expected. * This is found in INLN. * MST1 LDA INFO1 Move level code word LDB RBLVL to the appendage. JSB .MVW into appendage. DEF D3 DEC 0 * LDA INLN,I Move max. RT length STA #RQB+RBMRT into appendage. * * * 4) Word size of base parameter. We don't know this yet. * * * 5) Base parameter * A) Get remote data base number from the DBCB (4th word). This * is the first word of the parameter, for DBOPN this has been * set to two blanks. * MST2 LDA AIRUN ADA RDRBN LDA A,I STA #RQB+RBBAS * * B) Move the 2nd through ?th words of the base parameter into the * appendage word by word. We do this to keep a count of each * word we move and terminate the process with the first blank * or semi-colon encountered. However, in case the parameter is * incorrect, we allow no more than 10 words. * LDA M10 Set up maximum count. STA CNTR * CLA,INA A one to word count STA #RQB+RBBLN (for RDB number). LDB RBNAM * MST3 ISZ BASE Get next word in param. LDA BASE,I STA B,I and put it into appendage. INB * ISZ #RQB+RBBLN Bump word count CCA Set processing 1st byte flag. STA FIRST * LDA BASE,I Get first byte. ALF,ALF MST4 AND LOBYT * CPA BLANK Is it a blank? JMP MST6 Yes - end of base param. CPA SEMI No - is it a semi-colon? JMP MST6 Yes - end of base param. * ISZ FIRST Neither - was this the 1st byte? JMP MST5 No LDA BASE,I Yes - get 2nd JMP MST4 and check it. * MST5 ISZ CNTR Done with word, JMP MST3 is param too long? JMP E103 Yes - error * * Note that the length of the base parameter was set in the appendage * by the above loop, so it is complete. Set up the control word for the * DS master subroutine. This includes the no abort bit (bit 15) and * for DBOPN the long timeout bit (bit 14). * MST6 CLA,CCE,INA ERA LDB INDEX,I CPB D36 Index for DBOPN = 36. ERA STA CONWD SKP * * Build the standard four word header on the request. * * 1) stream word = 10 * LDA D10 STA #RQB * * 2) Destination node number = data base's node number which is found * in 6th word of DBCB. * LDA AIRUN ADA RDDSN LDA A,I STA #RQB+DS1DN * * Determine the length of the request = length of DS/1000 request header * + length of fixed part of appendage, (for index through * base length words) + length of base. * LDA RBASE ADA #RQB+RBBLN STA RQLEN * * Send request through #MAST, it also waits for the reply for us and re- * turns it in the request buffer and any associated data is returned in the * INDA buffer. * JSB #MAST DEF *+8 DEF CONWD D65MS needs: control word DEF RQLEN request length DEF OUTDA,I outgoing data buffer DEF OUTLN,I outgoing data length DEF INLN,I incoming data length DEF RPMAX maximum reply length DEF INDA,I incoming data buffer JMP DSERR error return point * STA RQLEN normal return, save reply length STB INLN and data returned length SKP * * Unbuffer the reply parameters. First we need to determine the length * and address of the appendage in the reply buffer. Length of appendage = * length of reply - length of DS standard reply header. Address of ap- * pendage = address of request reply buffer + length of DS standard reply * header. * LDB DSRL CMB,INB B = -(header length) ADB RQLEN B = length of appendage, STB APPLN save it. * * Move status array from reply into user's status array. Status in first * 10 words of appendage. * LDA DSTAT LDB STAT JSB .MVW DEF D10 DEC 0 * * If appendage length > 10, this was a successful DBOPN. Put Remote * Data base number from 11th word of appendage into INFO2 parameter. * LDB APPLN CMB,INB ADB D10 SSB,RSS JMP MST8 * LDA A,I A -> RDB # thanks to MVW, STA INFO2,I LDA RQLEN Get reply and data lengths again. LDB INLN * * Return to user. * MST8 ISZ RBMST Normal return point MST9 JMP RBMST,I * * Error return points. * * DS error. Set up status array as follows: * word +------------------------------------+ * 1 | -1 | * +------------------------------------+ * 2 | two word error | * -- -- * 3 | code from A & B regs. | * +------------------------------------+ * DSERR STA SAVE Save 1st word of error code. CCA STA STAT,I ISZ STAT * LDA SAVE Pick up entire error code again DST STAT,I and put it in status array. JMP MST9 Take error return point. * * Illegal base parameter error. * E103 LDA D103 Error code = 103. STA STAT,I JMP MST8 Take normal return point. * * Constants and variables. * M10 DEC -10 D3 DEC 3 D10 DEC 10 D36 DEC 36 D44 DEC 44 D103 DEC 103 * LOBYT OCT 377 BLANK OCT 040 SEMI OCT 073 * SAVE NOP MVLEN NOP FIRST NOP CNTR EQU MVLEN APPLN EQU FIRST CONWD NOP * RQLEN NOP END $END