ASMB,R,Q,C
      HED GET   91700-16126 * (C) HEWLETT-PACKARD CO 1977 
      NAM GET,7 91740-16026 REV 2026 800418 
      SPC 1 
******************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977.  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,$OPSY
      EXT .ENTR,CNUMO 
      EXT D65SV,#LDEF,#REQU,#PLOG 
      SUP 
      SPC 5 
* 
* GETS
* SOURCE:91740-18026
* BINARY:91740-16026
* PGMR  :CHUCK WHELAN 
* DATE  :DEC 22,1976
* 
      SPC 5 
* THESE LIBRARY SUBROUTINES ARE USED IN CONJUNCTION 
* WITH THE PROGRAM TO PROGRAM COMMUNICATION MONITOR 
* PTOPM TO AFFECT COMMUNICATION WITH SATELLITE PROGRAMS 
* THEY CONTAIN THE FOUR  SLAVE ENTRY POINTS (GET
* ACCEPT,AND REJECT AND FINIS) THAT MAY BE ENTERED
* BY A PROGRAM IN SLAVE MODE WHICH IS COMMUNICATING 
* WITH A PROGRAM IN MASTER MODE.
      HED "GET" PROCESSING               * (C) HEWLETT-PACKARD CO 1977
ICLAS NOP 
IERR  NOP 
IFUN  NOP 
ITAG  NOP 
IL    NOP 
      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 
      LDA $OPSY 
      CLB 
      RAR,SLA       SKIP IF NON-DMS 
      STB MODX      INITIALIZE FOR DMS SYSTEM 
      LDB GET       RETURN ADDR 
      STB EXIT
      LDB IERR      SET UP ERROR PRAM ADDR
      STB ERRM1 
      LDA IL        ADDRESS 
      SZA,RSS       LAST ONE REQ. THERE?
      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 EXEC      ISSUE GET ON I/O CLASS
      DEF *+7 
      DEF K21N  
      DEF CLASS 
IRBFA DEF IRBUF 
      DEF ZERO      ZERO LENGTH GET 
      DEF BFADR     ADDR OF REQUEST IN SAM
      DEF RQLEN     REQUEST LENGTH
       JMP ERRAC      - ERROR: BAD CLASS NUMBER 
* 
      STB DLEN      SAVE DATA LENGTH
      CMB,INB 
      ADB BFADR     COMPUTE DATA ADDR IN SAM
      STB DSAMA 
      LDA BFADR 
      LDB IRBFA 
      JSB MOVER     MOVE REQUEST INTO LOCAL BUFFER
RQLEN NOP 
* 
      LDA RTAGA     ADDR OF TAGS IN REQUEST 
      LDB ITAG      ADDR OF USER TAG AREA 
      MVW K20       MOVE TAG FIELD TO USER AREA 
* 
* PASS FUNCTION CODE BACK TO "GET" CALLER 
      LDA $FUNC     GET FUNCTION CODE 
      STA IFUN,I    RETURN RECEIVED FUNCTION CODE 
* 
      LDB $DLEN     DATA BUFFER LENGTH
      RAR,SLA,RAL   SKIP UNLESS READ OR WRITE 
      STB IL,I      RETURN LENGTH TO CALLER 
* 
      CPA K3        IS THIS A "PWRIT"?
      RSS           YES 
      JSB CLSAM     NO, CLEAR CLASS BUFFER
* 
      ISZ NEXT      SET SEQ INDICATOR 
      CLB           RETURN "NO ERROR" FLAG
      STB IERR,I    TO THE USER 
      JMP DONE      RETURN TO USER
      HED "ACCEPT" PROCESSING            * (C) HEWLETT-PACKARD CO 1977
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 $FUNC     FUNCTION CODE FROM REQUEST
      RAR,SLA,RAL   SKIP IF OPEN OR CONTROL(DO REQ ONLY)
      RSS 
      JMP ACPFG 
      LDB AIBUF 
      SZB,RSS       WAS DATA BUFFER SPECIFIED 
      JMP ERPAR     NO, INSUFFICIENT PARAMS 
      STB DATAD     SET DATA ADDRESS IN SV 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
      LDA $DLEN 
      STA *+3       SET DATA LENGTH FOR MOVE
      LDA DSAMA     ADDR OF DATA IN SAM 
      JSB MOVER     MOVE IT 
      NOP 
      JMP ACPFG 
* 
AREAD LDA $DLEN     DOING "PREAD", SEND 
      STA DLEN        DATA WITH THE REPLY.
* 
ACPFG LDA BIT14     SET ACCEPT FLAG IN PARMB
DVR   IOR $FUNC 
      STA $FUNC     SAVE FUNC CODE WITH ACEPT OR REJCT SET
      AND K7        ISOLATE FUNCTION CODE 
      CPA K3        WAS IT A "PWRIT"
      JSB CLSAM     YES, CLASS BUFFER STILL MUST BE CLEARED 
* 
      LDA $STRM     REQUEST STREAM WORD 
      IOR BIT14     SET REPLY BIT 
      STA $STRM 
* 
      CLA 
      STA $ERR+1
      STA $ERR+2
* 
      JSB D65SV     DO CALL TO DRIVER THRU D65SV
      DEF *+5 
      DEF IRBUF 
      DEF K31 
DATAD 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  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 1977P 
JITAG NOP 
JIERR NOP 
* 
* ENTRY HERE IS SIMILAR TO THAT FOR THE ACCEPT OPTION 
* EXCEPT THE REQUEST HAS BEEN DETERMINED NOT TO BE FROM A VALID 
* SATELLITE 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 
* 
      LDA BIT15     GET "REJCT" BIT 
      JMP DVR       NOW SEND REPLY & EXIT 
      HED "FINISH" PROCESSING            * (C) HEWLETT-PACKARD CO 1977
FINIS NOP 
      LDA XEQT      GET THIS PGMS ID SEGMENT ADDR 
      STA $PCB      & STORE IN REQUEST
* 
      CLA,INA 
      STA NEXT      RESET SEQUENCE INDICATOR
* 
* SET FUNCTION CODE REPLY FLAG & ACCEPT/REJECT FLAG 
      LDA HCODE 
      STA $FUNC     SET "PCLOS" 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 IRBUF 
      DEF K11       11 WORD "FINIS" REQUEST 
      DEF PTOP
* 
      ISZ FINIS 
      JMP FINIS,I   RETURN
      HED UTILITY SUBROUTINES/DATA AREA  * (C) HEWLETT-PACKARD CO 1977
* 
* THIS SUBROUTINE CHECKS FOR CALL ERRORS & RETURNS A MODIFIED 
* REQUEST TO THE SATELLITE 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
      MVW K20       MOVE TAG FIELD INTO REQUEST 
      LDA XEQT      SET ID SEGMENT ADDR OF SLAVE PGM
      STA $PCB        INTO 1ST WORD OF PCB
      LDA CLASX     SET SLAVE PGMS CLASS #
      STA $PCB+1      INTO 2ND WORD OF PCB
      CLB 
      STB DLEN      SET D65SV CALL FOR "NO DATA"
      JMP PUTAG,I   RETURN
      SPC 3 
* 
*  SUBROUTINE TO MOVE BLOCK FROM SAM
MOVER NOP 
MODX  JMP NODMS     "NOP" HERE IF DMS SYSTEM
      LDX MOVER,I   GET # TO MOVE 
      MWF           MOVE WORDS FROM ALTERNATE MAP 
      JMP MEXIT 
* 
NODMS MVW MOVER,I   MOVE WORDS
MEXIT ISZ MOVER 
      JMP MOVER,I   RETURN
      SPC 3 
* 
*  SUBROUTINE TO DO A DUMMY GET TO CLEAR THE CLASS BUFFER 
CLSAM NOP 
      LDA #PLOG 
      SZA           DOING REQUEST LOGGING?
      JMP LOGIT     YES, PASS BUFFER ALONG TO "PLOG"
* 
      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
* 
LOGIT STA CLAS2     SAVE "PLOG"S CLASS
      JSB #REQU     DO RETHREAD TO PLOG 
      DEF *+3 
      DEF CLASS     FROM SLAVE PGM'S CLASS
      DEF CLAS2       TO PLOG'S CLASS 
      JMP CLSAM,I 
* 
      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 4 
ERR1  NOP 
      STA SSA       SAVE DRIVER STATUS
      LDA XEQT      GET THE NAME OF THE PROGRAM 
      ADA K12       THIS S/R IS APPENDED TO 
      LDB 0,I       FROM THE ID SEGMENT 
      STB COMER+6   & SAVE IN THE OUTPUT
* 
      INA           BUFFER
      LDB 0,I 
      STB COMER+7 
* 
      INA 
      LDB 0,I 
      LDA 1 
      AND MSK1      STRIP OFF STATUS BITS 
      STA COMER+8 
* 
      JSB CNUMO     CONVERT STATUS WORD TO ASCII
      DEF *+3 
      DEF SSA 
      DEF CNBUF     RESULTING ASCII 
* 
      JSB EXEC      OUTPUT DRIVER ERROR 
      DEF *+5       MESSAGE 
      DEF K2
      DEF K1
      DEF COMER 
      DEF COMEL 
      JMP ERR1,I    & RETURN
* 
*  DATA AREA
* 
CLASS NOP 
CLASX NOP 
CLAS2 NOP 
DSAMA NOP 
BFADR NOP 
DLEN  NOP 
NEXT  DEC 1 
ERCOM NOP 
ERRM1 NOP 
CONWD OCT 10000 
BIT14 OCT 40000 
BIT15 OCT 100000
B6000 OCT 60000 
K21N  DEF 21,I      CLASS "GET" CODE, "NO-ABORT" BIT SET
ZERO  OCT 0 
K1    DEC 1 
K2    DEC 2 
K3    DEC 3 
K6    DEC 6 
K7    DEC 7 
K11   DEC 11
K12   DEC 12
K20   DEC 20
K21   DEC 21
K31   DEC 31        MAX REQUEST LENGTH
MSK1  OCT 177400
HCODE OCT 205       "FINIS" GENERATES A "PCLOS" 
PTOP  OCT 100004
M46   DEC -46 
M47   DEC -47 
M40   DEC -40 
RTAGA DEF $TAG
CNBUF BSS 3 
COMER ASC 7,COMM ERROR -
SSA   NOP 
COMEL DEC -16 
* 
DUMMY NOP 
* 
*  DEFINE REQUEST BUFFER
IRBUF BSS 31
$STRM EQU IRBUF 
$ERR  EQU IRBUF+4 
$FUNC EQU IRBUF+7 
$PCB  EQU IRBUF+8 
$DLEN EQU IRBUF+10
$TAG  EQU IRBUF+11
* 
XEQT  EQU 1717B 
* 
      END 
                                                                                                                                                                                                                      