ASMB,R,L,C
      HED GET   91750-16122 * (C) HEWLETT-PACKARD CO 1980 
      NAM GET,7 91750-1X122 REV.2013 800805 ALL 
      SPC 1 
******************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980.  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.       *
******************************************************************
      SPC 2 
      ENT GET,ACEPT,REJCT,FINIS 
      EXT EXEC
      EXT .ENTR,PGMAD 
      EXT #SLAV,#LDEF,#PLOG 
      EXT .MVW
      EXT #LOGR,#GETR 
      EXT #RPB
RQB   EQU #RPB
      SPC 5 
* 
* NAME:  GET
* SOURCE:91750-18122
* RELOC: 91750-1X122
* PGMR:  CHUCK WHELAN 
* DATE:  DEC 22,1976
* 
* MODIFICATION FOR 91750: 
* MODIFIED 790206 BY GAB, JSB'S REPLACE EXTENDED INSTR'S. 
* MODIFIED 790220 BY JDH, DS REQUEST EQUATED OFFSETS. 
* MODIFIED 790531 BY DWT FOR PHASE FOUR (RELOCATION OF RQB).
* MODIFIED 790609 BY DWT FOR PHASE FIVE (REMOVE O/S DEPENDENCE).
* MODIFIED 800805 BY DMT TO INCREASE LENGTH OF FINIS WRITE TO PTOPM.
* 
      SPC 5 
* PROGRAM-TO-PROGRAM SLAVE-SIDE SUBROUTINES 
* 
* THESE LIBRARY SUBROUTINES CONTAIN THE FOUR ENTRY POINTS (GET, 
* ACEPT, REJCT, AND FINIS) THAT MAY BE CALLED BY SLAVE PROGRAM
* COMMUNICATING WITH A MASTER PROGRAM.
      SKP 
* GLBLK-START 
* 
******************************************************************
*                                                                *
*     G L O B A L   B L O C K               REV 2013 791213      *
*                                                                *
*     GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY:      *
*                                                                *
*         REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST        *
*         GET,   #SLAV, RQCNV, RPCNV, GRPM,  DINIT, PTOPM        *
*         EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3        *
*         DSTIO, LUMAP, #CMGT, INCNV, OTCNV, RMTIO               *
*         RSM,   DLGON, #DISM, #DSSM, #MSSM, #SCSM, #UPSM        *
******************************************************************
* 
***!!!!! THE ORDER OF THE FIRST 8 WORDS (#STR THRU #LVL) IS      *
***!!!!!     FIXED BY THE REQUIREMENT THAT THE STREAM, ADDRESSES *
***!!!!!     ERROR CODES & LEVEL # ALWAYS BE IN THE SAME PLACE,  *
***!!!!!     REGARDLESS OF MESSAGE FORMAT.  THIS ALSO MAKES      *
***!!!!!     STORE-AND-FORWARD CODE MUCH SIMPLER.                *
#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 >>>
* 
******************************************************************
* 
* GLBLK-END 
      SKP 
* PPBLK-START 
* 
******************************************************************
*                                                                *
*      P T O P   B L O C K                 REV 2013 791119       *
*                                                                *
*      OFFSETS INTO DS/1000 PTOP MESSAGE BUFFERS, USED BY:       *
*                                                                *
*   POPEN, PTOPM, GET/ACEPT/REJCT, RQCNV, RPCNV, DINIT, REMAT    *
*   #SCSM                                                        *
******************************************************************
* 
* OFFSETS INTO PTOP REQUEST AND REPLY BUFFERS.
* 
#FCD  EQU #REP      FUNCTION CODE.
#PCB  EQU #FCD+1    PCB AREA (3 WORDS). 
#TAG  EQU #PCB+3    TAG AREA (20 WORDS).
* 
* MAXIMUM SIZE OF PTOP REQUEST/REPLY BUFFER.
* 
#PLW  EQU #MXR      M A X I M U M   S I Z E    ! ! !
* 
* PPBLK-END 
      HED "GET" PROCESSING               * (C) HEWLETT-PACKARD CO 
ICLAS NOP 
IERR  NOP 
IFUN  NOP 
ITAG  NOP 
IL    NOP 
DBUFR DEF ZERO      OPTIONAL DATA BUFFER
DBUFL DEF ZERO      OPTIONAL DATA LENGTH
      SPC 3 
* ENTRY HERE SIGNIFIES THAT THE USER SUBROUTINE HAS COMPLETED THE 
* PROCESSING OF THE LAST CALL AND WISHES TO INTERROGATE HIS I/O 
* CLASS TO DETERMINE IF THERE ARE ANY MORE REQUESTS 
* TO BE PROCESSED. IF MORE REQUESTS HAVE BEEN QUEUED ON THE 
* CLASS THE ONE ON THE TOP OF THE STACK WILL BE PASSED TO THE 
* USER.IF THERE ARE NO OUTSTANDING REQUESTS THE USER
* WILL BE I/O SUSPENDED UNTIL A REQUEST IS RECEIVED 
* BY THE MONITOR AND PLACED IN THE USER'S I/O CLASS.
* 
GET   NOP 
* SAVE INPUT PARAMETERS 
      JSB .ENTR     PICK UP THE PARAMETERS PASSED 
      DEF ICLAS 
      LDB GET       RETURN ADDR 
      STB EXIT
      LDB IERR      SET UP ERROR PRAM ADDR
      STB ERRM1 
      CLA           CLEAR "DATA TRANSFERRED" FLAG 
      STA DTRFL 
* 
      LDA IL        WAS LAST REQUIRED 
      SZA,RSS         PARAMETER SUPPLIED? 
      JMP ERPAR     NO--ERROR 
      CLA,INA 
      LDB ERCOM 
      CPB M47       COMM ERROR OCCURRED LAST XACTION? 
      STA NEXT      YES, RESET SEQ INDICATOR
      CPA NEXT      CHECK FOR LEGAL SEQUENCE
      RSS 
      JMP ERSEQ     TAKE ERROR EXIT IF SEQUENCE ERR 
      STA ERCOM 
* 
      LDA ICLAS,I   SET UP THIS USER'S I/O CLASS
      STA CLASX 
      IOR B6000     SAVE BUFFER 
      STA CLASS 
* 
      JSB #GETR     ISSUE GET ON I/O CLASS
       DEF *+6
       DEF CLASS
       DEF RQB
       DEF C#PLW
       DEF DBUFR,I   (OPTIONAL) DATA BUFFER ADDRESS 
       DEF DBUFL,I   (OPTIONAL) DATA BUFFER LENGTH
       JMP ERRAC    ERROR RETURN
* 
      LDA RTAGA     ADDR OF TAGS IN REQUEST 
      LDB ITAG      ADDR OF USER TAG AREA 
      JSB .MVW      MOVE TAG FIELD TO USER AREA 
      DEF K20 
      NOP 
* 
* PASS FUNCTION CODE BACK TO "GET" CALLER 
      LDA RQB+#FCD  GET FUNCTION CODE 
      AND =B377 
      STA IFUN,I    RETURN RECEIVED FUNCTION CODE 
* 
      LDB RQB+#PCB+2  DATA BUFFER LENGTH
      RAR,SLA,RAL   SKIP UNLESS READ OR WRITE 
      STB IL,I      RETURN LENGTH TO CALLER 
* 
      CPA K3        IS THIS A "PWRIT"?
      JSB GETW      YES, CHECK IF USER WANTS DATA NOW.
      JSB CLSAM     YES, CLEAR CLASS BUFFER 
* 
      ISZ NEXT      SET SEQ INDICATOR 
      CLB           RETURN "NO ERROR" FLAG
      STB IERR,I    TO THE USER 
      JMP DONE      RETURN TO USER
      SPC 2 
*     THIS LITTLE SUBROUTINE IS CALLED BY THE "GET" ROUTINE 
*     ONLY WHEN A "PWRIT" REQUEST HAS BEEN RECEIVED.  IT
*     SETS A FLAG INDICATING THAT DATA HAS ALREADY BEEN 
*     TRANSFERRED AT THE "GET" ROUTINE CALL, WHICH IS USED BY 
*     THE "ACEPT" ROUTINE.  IF NO DATA WAS TRANSFERRED, THE FLAG
*     WILL CONTAIN A ZERO, OTHERWISE THE LENGTH OF THE DATA 
*     TRANSFERRED, AND THE CLASS BUFFER IS RELEASED.
GETW  NOP           CHECK IF USER WANTS DATA TRANSFERRED NOW
      LDA DBUFL,I   IF DATA TRANSFER LENGTH > 0,
      STA DTRFL       SET "DATA TRANSFERRED AT GET" FLAG
      SZA,RSS       WAS DATA TRANSFERRED? 
      ISZ GETW        NO, SO DON'T RELEASE THE SAM BUFFER 
      JMP GETW,I    RETURN
      HED "ACCEPT" PROCESSING            * (C) HEWLETT-PACKARD CO 
AITAG NOP 
AIERR NOP 
AIBUF NOP 
* 
* ENTRY HERE SIGNIFIES THAT THE LAST REQUEST EXAMINED 
* WAS AN ACCEPTABLE ONE AND THE REQUEST WAS TO BE HONORED 
* 
* THE ACTION TO BE ACCOMPLISHED FOR AN ACCEPT REQUEST 
* VARIES AS TO THE TYPE OF REQUEST WHICH WAS LAST RECEIVED
* ACCEPT REQUESTS ARE PERFORMED FOR ALL FOUR MASTER REQUESTS
* 
EXIT  EQU * 
ACEPT NOP 
      JSB .ENTR     PICK UP CALLING PARAMETERS FROM 
      DEF AITAG     THE USER
* 
* 
*  CHECK FOR ERRORS & MOVE TAG FIELD TO PARMB 
* 
      LDA AITAG 
      LDB AIERR 
      JSB PUTAG 
* 
      LDA RQB+#FCD  FUNCTION CODE FROM REQUEST
      RAR,SLA,RAL   SKIP IF OPEN OR CONTROL(DO REQ ONLY)
      RSS 
      JMP ACPFG 
* 
      LDB DTRFL     WAS DATA ALREADY TRANSMITTED
      SZB             AT THE "GET" ?
      JMP ACPFG     YES, JUST SEND HEADER IN REPLY
      LDB AIBUF 
      SZB,RSS       WAS DATA BUFFER SPECIFIED 
      JMP ERPAR     NO, INSUFFICIENT PARAMS 
      STB SLADR     SET DATA ADDRESS IN SV CALL 
      STB GTADR     ALSO IN GET CALL
      CPA K2        IS THIS A "PREAD" 
      JMP AREAD     YES, JUMP 
* 
*  REQUEST IS A "PWRIT", DATA IS ALREADY IN SYSTEM AVAILABLE MEMORY,
*  SIMPLY MOVE DATA TO USERS BUFFER & CLEAR CLASS BUFFER
* 
      JSB #GETR     JSB #GETR TO DO THE MOVE
       DEF *+6
       DEF CLASS
       DEF RQB
       DEF K1       MIN HEADER LENGTH 
GTADR  DEF DUMMY    DATA AREA ADDRESS 
       DEF RQB+#PCB+2   DATA LEN TO GET 
       JMP ERRAC    ERROR RETURN
      JMP ACPFG 
* 
AREAD LDA RQB+#PCB+2  DOING "PREAD", SEND 
      STA DLEN        DATA WITH THE REPLY.
* 
ACPFG LDA BIT14     SET ACCEPT FLAG IN PARMB
DVR   IOR RQB+#FCD
      STA RQB+#FCD  SAVE FUNC CODE WITH ACEPT OR REJCT SET
* 
      LDB DTRFL     WAS DATA BUFFER 
      SZB             ALREADY TRANSFERRED?
      JMP ACPFF       --YES:  SAM BUFFER ALREADY RELEASED 
      AND K7        ISOLATE FUNCTION CODE 
      CPA K3        WAS IT A "PWRIT"
      JSB CLSAM     YES, CLASS BUFFER STILL MUST BE CLEARED 
* 
ACPFF EQU * 
      LDA RQB+#STR  REQUEST STREAM WORD 
      IOR BIT14     SET REPLY BIT 
      STA RQB+#STR
* 
      CLA 
      STA RQB+#EC2
      STA RQB+#ENO
* 
      JSB #SLAV     DO CALL TO DRIVER THRU #SLAV
      DEF *+4 
      DEF C#PLW 
SLADR DEF DUMMY 
      DEF DLEN
      JMP ERRAC     COMMUNICATION ERROR 
* 
      LDA ERRM1,I 
RETRN STA ERCOM     SAVE RETURN STATUS
      CLB,INB 
      STB NEXT      SET SEQUENCE IND. FOR "GET" NEXT
* 
DONE  EQU * 
      LDB @ZERO 
      STB DBUFR 
      STB DBUFL 
      CLB 
      STB IL        INITIALIZE FOR PARAM CK NEXT TIME 
      STB AIERR 
      STB JIERR 
      JMP EXIT,I    RETURN FROM ACEPT/REJCT TO CALLER 
* 
ERRAC LDA M47       ERROR STATUS= -47 
      STA ERRM1,I 
      JMP RETRN 
      HED "REJECT" PROCESSING            * (C) HEWLETT-PACKARD CO 
JITAG NOP 
JIERR NOP 
* 
* ENTRY HERE IS SIMILAR TO THAT FOR THE ACCEPT OPTION 
* EXCEPT THE REQUEST HAS BEEN DETERMINED NOT TO BE VALID (FOR 
* SOME USER-DEFINED REASON) AND MUST BE REJECTED. AGAIN THE LOGIC 
* IS BROKEN UP INTO FOUR SUBCLASSES ACCORDING TO THE TYPE 
* OF REQUEST BEING REJECTED 
* 
REJCT NOP 
      JSB .ENTR     PICK UP USER PARAMETERS 
      DEF JITAG 
      LDB REJCT     PICK UP RETURN ADDR 
      STB EXIT
* 
*  CHECK FOR ERRORS & MOVE TAG FIELD TO PARMB 
* 
      LDA JITAG 
      LDB JIERR 
      JSB PUTAG 
* 
      CLA           SET #SLAV CALL FOR
      STA DLEN       "NO DATA"
      LDA BIT15     GET "REJCT" BIT 
      JMP DVR       NOW SEND REPLY & EXIT 
      HED "FINISH" PROCESSING            * (C) HEWLETT-PACKARD CO 
FINIS NOP 
      LDA ZERO
      STA NAME
      JSB PGMAD     GET THIS PGMS ID SEGMENT ADDR 
       DEF *+2
       DEF NAME 
      STA RQB+#PCB  & STORE IN REQUEST
* 
      CLA,INA 
      STA NEXT      RESET SEQUENCE INDICATOR
* 
* SET FUNCTION CODE REPLY FLAG & ACCEPT/REJECT FLAG 
      LDA HCODE 
      STA RQB+#FCD  SET "FINIS" FUNCTION CODE 
* 
* SEND IT TO THE MONITOR
* SO THIS PROGRAM CAN BE REMOVED FROM THE ACTIVE LIST 
* 
      LDB #LDEF 
      ADB K6        POINT TO P TO P HEADER ADDR 
      LDB 1,I       GET HEADER ADDR 
      INB           POINT TO CLASS WORD 
      LDA 1,I       GET "PTOPM" CLASS 
      RAL,CLE,ERA   CLEAR OFF SIGN BIT
      STA PTOP
* 
      JSB EXEC      SEND THE REQUEST TO PTOPM 
      DEF *+8 
      DEF K20 
      DEF CONWD     Z BIT, LU=0 
      DEF DUMMY 
      DEF ZERO      NO DATA 
      DEF RQB 
      DEF L#PCB     LENGTH OF "FINIS" REQUEST 
      DEF PTOP
* 
      ISZ FINIS 
      JMP FINIS,I   RETURN
      HED UTILITY SUBROUTINES/DATA AREA  * (C) HEWLETT-PACKARD CO 
* 
* THIS SUBROUTINE CHECKS FOR CALL ERRORS & RETURNS A MODIFIED 
* REQUEST TO THE MASTER PROGRAM 
* 
PUTAG NOP 
      STB ERRM1     SAVE ERROR FLAG ADDR
      SZB,RSS       SKIP IF ERROR DEF WAS PASSED
      JMP ERPAR     OTHERWISE ERROR IN CALL 
      LDB NEXT      CHECK SEQUENCE
      CPB K2
      CLB,RSS       OK
      JMP ERSEQ     ERROR, NOT TIME FOR ACEPT/REJCT 
      STB ERRM1,I   CLEAR ERROR FLAG
      LDB RTAGA     ADDR OF TAG FIELD IN REQUEST
      JSB .MVW      MOVE TAG FIELD INTO REQUEST 
      DEF K20 
      NOP 
      LDA ZERO
      STA NAME
      JSB PGMAD     SET ID SEGMENT ADDR OF THIS SLAVE PGM 
       DEF *+2
       DEF NAME 
      STA RQB+#PCB    INTO 1ST WORD OF PCB
      LDA CLASX     SET SLAVE PGMS CLASS #
      STA RQB+#PCB+1  INTO 2ND WORD OF PCB
      CLB           SET #SLAV CALL FOR
      STB DLEN       "NO DATA"
      JMP PUTAG,I   RETURN
      SPC 3 
* 
*  SUBROUTINE TO DO A DUMMY GET TO CLEAR THE CLASS BUFFER 
CLSAM NOP 
      LDA #PLOG 
      SZA,RSS       DOING REQUEST LOGGING?
      JMP CLAR       NO 
      LDB CLASS 
      JSB #LOGR 
       JMP CLAR     ERROR RETURN
      JMP CLSAM,I 
* 
CLAR  LDA CLASS     GET SLAVE PGMS CLASS NO 
      ALR,RAR       CLEAR "SAVE BUFFER" FLAG
      STA CLASS 
* 
      JSB EXEC      DO DUMMY GET TO CLEAR THE BUFFER
      DEF *+5 
      DEF K21 
      DEF CLASS 
      DEF DUMMY 
      DEF ZERO
      JMP CLSAM,I   RETURN
* 
      SPC 3 
ERSEQ LDA M46       -46 = SEQUENCE ERROR
      RSS 
ERPAR LDA M40       -40 = INSUFFICIENT PARAMETERS 
      STA ERRM1,I   RETURN ERROR TO USER
      JMP DONE
      SPC 3 
* 
*  DATA AREA
* 
DTRFL NOP           "DATA TRANSFERRED AT 'GET'" FLAG
CLASS NOP 
CLASX NOP 
DLEN  NOP 
NEXT  DEC 1 
ERCOM NOP 
ERRM1 NOP 
CONWD OCT 10000 
BIT14 OCT 40000 
BIT15 OCT 100000
B6000 OCT 60000 
@ZERO DEF ZERO
ZERO  OCT 0 
K1    DEC 1 
K2    DEC 2 
K3    DEC 3 
K6    DEC 6 
K7    DEC 7 
K20   DEC 20
K21   DEC 21
HCODE OCT 205       "FINIS" GENERATES A "PCLOS" 
PTOP  OCT 100004
M46   DEC -46 
M47   DEC -47 
M40   DEC -40 
RTAGA DEF RQB+#TAG
* 
DUMMY NOP 
NAME  ASC 3,
* 
*  DEFINE REQUEST BUFFER
C#PLW ABS #PLW
L#PCB ABS #TAG
      END 
                                                                                                                                                                                                                                          