ASMB,Q,C,N
*USE 'ASMB,R,N' FOR DS/1000 ONLY, AND 'ASMB,R,Z' FOR DS/1000 & DS/3000
      IFN 
      NAM POPEN,7 91740-16042 REV 1740 770714 
      XIF 
      IFZ 
      NAM POPEN,7 91741-16016 REV 2013 790731 
      XIF 
      UNL 
      IFN 
      HED POPEN (DS/1000) 91740-16042 * (C) HEWLETT-PACKARD CO 1980 
      XIF 
      IFZ 
      HED POPEN (DS/1000 & DS/3000) 91741-16016 * (C) HEWLETT-PACKARD CO 1980 
      XIF 
      LST 
* 
*     IFN OPTION
*     NAME:   POPEN 
*     SOURCE: 91740-18042 
*     RELOC:  91740-16042 
*     PRGMR:  CHUCK WHELAN
* 
*     IFZ OPTION
*     NAME:   POPEN 
*     SOURCE: 91741-18016 
*     RELOC:  91741-16016 
*     PRGMR:  CHUCK WHELAN & JIM HARTSELL 
* 
*     MODIFIED QCLOS RETURN FOR 2013 PCO.  [DMT]
* 
      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 POPEN,PREAD,PWRIT,PCONT,PCLOS 
      EXT D65MS 
      EXT .ENTR 
      IFZ 
      EXT #LU3K 
      EXT D3KMS,D$INI,D$STW,D$ASC 
      EXT D$RQB,D$NWD,D$ZRO,D$WDC,D$SMP 
* 
D     EQU 256       MAX # DATA WORDS/BLOCK (DS/3000). 
      XIF 
      SUP 
* 
      SPC 3 
*   THIS PROGRAM PERFORMS ALL MASTER PROGRAM TO PROGRAM FUNCTOIONS
*   IN THE DISTRIBUTED SYSTEM.  ON EACH REQUEST IT DOES THE FOLLOWING:
* 
*      1.  MOVES PCB FROM USER AREA TO REQUEST (EXCEPT POPEN) 
*      2.  VERIFIES SUFFICIENT PARAMETERS PASSED IN CALL
*      3.  MOVES 20 WORD TAG FIELD INTO REQUEST (EXCEPT PCLOS)
*      4.  SETS STREAM, FUNCTION, AND ORIGINATOR NODE INTO REQUEST
*      5.  CALLS "D65MS" TO SEND REQUEST (& DATA) AND GET REPLY 
*      6.  IF NO SYSTEM ERROR, MOVES TAG FIELD INTO USER AREA (EXCEPT PCLOS)
*      7.  EXAMINES STATUS & GIVES "ACEPT", "REJCT", OR ERROR CODE BACK TO CALLER 
      SKP 
IPCB  NOP 
IERR  NOP 
INAM  NOP 
INODE NOP 
ITAG  NOP 
      IFZ 
ENAM  NOP           DS/3000: ENTRY NAME 
      NOP                    CONTROL INFORMATION. 
      NOP                    LOADING OPTIONS. 
BUFSZ NOP                    MAX DATA RECORD LENGTH 
      XIF 
      SPC 3 
POPEN NOP 
* 
* MASTER REQUESTS FOR POPEN COME HERE 
* 
      JSB .ENTR     PICK UP THE USER PARAMETERS 
      DEF IPCB
* 
      LDB IPCB      USER'S PCB ADDRESS
      LDA INODE,I   DESTINATION NODE
      ADB K3        4TH WORD OF PCB HAS NODE
      STA 1,I       PUT IT THERE
      STA $DEST     SAVE IT 
* 
      LDB POPEN     SET UP ERROR RETURN 
      LDA IERR
      JSB BLDRQ     SET UP BASIC REQST
      DEF ITAG
      DEC 1         FCN = 1 
      IFZ 
      JMP QOPEN     DO POPEN TO 3000
      XIF 
* 
      LDA INAM      ADDR OF NAME FIELD
      LDB RPCBA     ADDR OF PCB IN REQ BUFFER 
      MVW K3        MOVE NAME INTO PCB FIELD
* 
      LDA IPCB
* 
NODAT LDB DUMAD     USE DUMMY AS DATA POINTER 
      STB DBUF
      CLB 
      STB WRLEN     SET WRITE DATA LENGTH = 0 
* 
* 
*  THIS CODE IS USED IN COMMON BY ALL P TO P CALLS
* 
MAIN  STB RDLEN     SET READ DATA LENGTH
      STA PCBAD     SAVE PCB ADDRESS
* 
      LDA K4
      STA $STRM     SET P TO P STREAM IN REQ
* 
* THE CALL TO D65MS WILL: 
*  1) GET AN I/O CLASS
*  2) INSERT SEQ # & ORIGIN NODE
*  3) BUILD MASTER TCB
*  4) SEND REQUEST (& DATA) 
*  5) CALL "D65GT" TO AWAIT AND GET REPLY 
*  6) RETURN REPLY (& DATA) 
*  7) RETURN CONTROL
      JSB D65MS     ISSUE REQUEST CALL
      DEF *+8 
      DEF CONWD 
      DEF IRBUF     REQUEST BUFFER
      DEF IRBFL     REQUEST LENGTH
DBUF  NOP           DATA BUFFER ADDRESS 
      DEF WRLEN     DATA WRITE LENGTH 
      DEF RDLEN     DATA READ LENGTH
      DEF IRBFL     MAX EXPECTED REPLY LENGTH 
* 
      JMP ERR       ERROR DETECTED
      LDA $FUNC     FUNCTION CODE 
      CPA K5        IS THIS A PCLOS?
      JMP NOMOV     YES, WE'RE DONE 
* 
RPCBA EQU *+1 
      DLD $PCB      GET PCB 
PCBAD EQU *+1 
      DST *         SAVE 1ST 2 PCB WORDS IN USER AREA 
* 
      LDA RTAGA     ADDR OF TAG FIELD IN REQUEST
      LDB TAGAD     ADDR OF TAG FIELD IN USER AREA
      MVW K20       MOVE 20 WORDS TO USER TAG FIELD 
* 
NOMOV LDA $ERR
      SZA           WAS ERROR DETECTED? 
      JMP EXIT      YES, IERR SET 
      LDB $FUNC 
      SSB           WAS REQUEST REJECTED? 
      CLA,INA       YES, SET REJECT IERR
EXIT  STA ERRAD,I   RETURN IT TO CALLER 
      CLB 
      STB CLEAR,I   CLEAR PARAM CHECK LOC 
      JMP RTRN,I    RETURN
      SKP 
* 
*  MOVE PCB INTO REQUEST BUFFER 
MVPCB NOP 
      LDB N2
      ADB MVPCB     POINT TO ADDR OF PCB ADDR 
      LDB 1,I       GET ADDR OF PCB ADDR
      LDA 1,I       GET PCB ADDR
      LDB RPCBA     GET ADDR OF PCB IN BUFFER 
      MVW K2        MOVE 1ST TWO WORDS TO REQUEST 
      INA           POINT TO 4TH DCB WORD 
      LDB 0,I       GET DESTINATION NODE
      STB $DEST     SAVE IT 
      JMP MVPCB,I   RETURN
      SPC 2 
* 
*  COMMON PARAMETER SET-UP AND TAG FIELD MOVE FOR ALL BUT "PCLOS" 
BLDRQ NOP 
      STB RTRN      RETURN ADDRESS FOR ALL
      STA ERRAD     ADDR OF ERROR PARAMETER 
* 
      DLD BLDRQ,I   GET TAG ADDR ADDR, AND FUNC CODE
      STA CLEAR     SAVE LAST PARAM ADDR
      LDA 0,I       GET ADDR OF USER'S TAG FIELD
      SZA,RSS       WAS LAST PARAM SPECIFIED
      JMP ERR2      TOO FEW PARAMETERS IN CALL
      STB $FUNC     SET FUNCTION CODE 
      IFZ 
      LDB #LU3K     GET DS/3000 LU
      CMB,INB,SZB,RSS NEGATE
      JMP *+3       NO 3000 
      CPB $DEST     IS IT NEGATIVE LU OF 3000?
      JMP RQEX      YES, PERFORM DS/3000 P-TO-P 
      XIF 
      LDB K31       REQUEST LENGTH
      STB IRBFL 
* 
      STA TAGAD 
      LDB RTAGA     ADDR OF TAG FIELD IN REQUEST
      MVW K20       MOVE TAG FIELD INTO REQ 
      IFZ 
      ISZ BLDRQ 
      XIF 
RQEX  ISZ BLDRQ 
      ISZ BLDRQ 
      JMP BLDRQ,I   RETURN
      SPC 3 
*  ERROR PROCESSING SECTION 
ERR   ADB NEG00     SUBTRACT ASCII "00" 
      CPA "DS"      IS IT A "DSXX" ERROR? 
      SSB            AND >= "00"? 
      JMP ERR47     NO, GIVE -47
      LDA 1 
      ADA N9        NUMERIC PART - 9
      CMA,SSA       SKIP IF DS00 - DS08 
ERR47 LDA K11       MAKE A -47 ERROR
      ADA N58       A = -47 OR -50 THRU -58 
      JMP EXIT
ERR2  LDA N40 
      JMP EXIT      RETURN WITH IERR
      SKP 
* 
*  READ REQUESTS
* 
RIPCB NOP 
RIERR NOP 
RIBUF NOP 
RIL   NOP 
RITAG NOP 
* 
PREAD NOP 
      JSB .ENTR     GET USER PARAMETERS 
      DEF RIPCB 
      JSB MVPCB     MOVE 2 WORD PCB INTO REQUEST
* 
      LDB PREAD     RETURN ADDRESS
      LDA RIERR 
      JSB BLDRQ     BASIC REQUEST PROCESSING
      DEF RITAG 
K2    DEC 2 
      IFZ 
      JMP QREAD     PERFORM PREAD TO 3000 
      XIF 
* 
      LDA RIBUF     SAVE BUFFER ADDRESS 
      STA DBUF
      LDB RIL,I     SAVE DATA LENGTH
      STB $DLEN 
* 
      CLA 
      STA WRLEN     CLEAR WRITE DATA LENGTH 
      LDA RIPCB     PCB ADDRESS 
      JMP MAIN      NOW DO LINE COMM & RETURN 
      SKP 
* 
*  WRITE REQUESTS 
* 
PIPCB NOP 
PIERR NOP 
PIBUF NOP 
PIL   NOP 
PITAG NOP 
* 
* 
PWRIT NOP           PWRITE REQUESTS HERE
      JSB .ENTR     PICK UP PARAMETERS
      DEF PIPCB 
      JSB MVPCB     MOVE 2 WORD PCB INTO REQUEST BUFR 
* 
      LDB PWRIT     SET UP ERROR RETURN 
      LDA PIERR 
      JSB BLDRQ     BUILD BASIC REQST 
      DEF PITAG 
K3    DEC 3 
      IFZ 
      JMP QWRIT     PERFORM PWRIT TO 3000 
      XIF 
* 
      LDA PIBUF     GET DATA ADDRESS
      STA DBUF
      LDA PIL,I     GET DATA LENGTH 
      STA $DLEN 
      STA WRLEN 
* 
      LDA PIPCB 
      CLB 
      JMP MAIN      NOW DO LINE COMM & RETURN 
      SKP 
* 
*  CONTROL REQUESTS 
* 
CIPCB NOP 
CIERR NOP 
CITAG NOP 
* 
* 
PCONT NOP 
      JSB .ENTR     GET PARAMETERS
      DEF CIPCB 
      JSB MVPCB     MOVE 2 WORD PCB INTO REQUEST BUFR 
* 
      LDB PCONT     SET UP RETURN ADDR
      LDA CIERR 
      JSB BLDRQ     BUILD BASIC REQST 
      DEF CITAG 
K4    DEC 4 
      IFZ 
      JMP QCONT     PERFORM PCONT TO 3000 
      XIF 
* 
      LDA CIPCB     PCB ADDRESS 
      JMP NODAT     DO LINE COMM & RETURN 
      SKP 
* 
*  CLOSE REQUESTS 
* 
FIPCB NOP 
FIERR NOP 
* 
* 
RTRN  EQU * 
PCLOS NOP 
      JSB .ENTR     GET PARAMETERS
      DEF FIPCB 
      JSB MVPCB     MOVE 2 WORD PCB INTO REQUEST BUFR 
* 
      LDA DFIEA 
      STA CLEAR     SAVE LAST PARAM ADDR
      LDA FIERR 
      SZA,RSS       ERROR ADDR SPECIFIED? 
      JMP ERR2      NO, GIVE ERROR
      STA ERRAD     SET ERROR ADDRESS 
      IFZ 
      LDA #LU3K     GET 3000 LU 
      CMA,INA,SZA,RSS NEGATE IT 
      JMP *+3       JUMP IF NO 3000 LINK
      CPA $DEST     WAS NEGATIVE LU OF 3000 SPECIFIED?
      JMP QCLOS     YES, DO PCLOS TO 3000 
      XIF 
* 
      LDA K11 
      STA IRBFL     11 WORD REQUEST 
      LDA K5
      STA $FUNC     FUNCTION CODE = 5 
* 
      LDA FIPCB     PCB ADDRESS 
      JMP NODAT     DO COMMUNICATION & RETURN 
      SKP 
* 
*  DATA AREA
* 
IRBFL NOP 
WRLEN NOP 
RDLEN NOP 
K5    DEC 5 
K11   DEC 11
K20   DEC 20
K31   DEC 31
N2    DEC -2
N9    DEC -9
N40   DEC -40 
N58   DEC -58 
NEG00 OCT 147720
"DS"  ASC 1,DS
CONWD OCT 100000
ERRAD NOP 
TAGAD NOP 
CLEAR NOP 
DFIEA DEF FIERR 
RTAGA DEF $TAG      ADDR OF REQ TAG FIELD 
DUMAD DEF * 
* 
*  DEFINE REQUEST 
IRBUF BSS 31
      IFZ 
      BSS 4 
      XIF 
$STRM EQU IRBUF 
$DEST EQU IRBUF+3 
$ERR  EQU IRBUF+5 
$FUNC EQU IRBUF+7 
$PCB  EQU IRBUF+8 
$DLEN EQU IRBUF+10
$TAG  EQU IRBUF+11
      IFN 
      UNL 
      XIF 
      IFZ 
      SKP 
* 
* GENERATE POPEN REQUEST FOR REMOTE DS/3000 COMPUTER. 
* 
QOPEN LDA ITAG
      STA TAGAD 
* 
      LDA ITAG
      SZA,RSS 
      JMP ERR2      ILLEGAL NUMBER OF PARAMETERS. 
* 
* BEGIN THE REQUEST BUFFER WITH SETUP OF 8-WORD FIXED 
* FORMAT FOR PTOPC, THEN "RFA " IN NEXT 2 WORDS.
* 
      LDA IPRAM     POINT TO ADDR OF FIRST PARAM. 
      JSB D$INI     INITIALIZE BUFFER STUFFERS. 
* 
      LDB B21       POPEN STREAM = 21 OCTAL.
      JSB D$PTP     SET UP 8 WORD FIXED FORMAT AREA.
      LDB D$RQB 
      LDA B7        CHANGE POPEN MSG CLASS TO 7.
      STA B,I 
* 
      LDA "RF"
      JSB D$STW     STORE "RFA ". 
      LDA "A" 
      JSB D$STW 
* 
      LDA B25 
      JSB D$STW     FUNCTION CODE = 25 OCTAL. 
* 
      LDA INAM      MOVE PROGRAM NAME (UP TO 28 BYTES). 
      LDB N14       (DELIMITER = BLANK) 
      JSB D$ASC 
* 
      INA           (A) = TOTAL BYTES IN REQUEST. 
      ARS           NEED TO INSERT TRAILING BLANKS
      ADA N17        IN PROGRAM NAME FIELD? 
      STA TEMP
      SSA,RSS 
      JMP MVENT     NO. 
* 
LOOP2 LDA BLNKS     YES. ADD TRAILING BLANKS
      JSB D$STW          TO FILL OUT 14-WORD FIELD. 
      ISZ TEMP
      JMP LOOP2 
* 
MVENT LDA ENAM      MOVE ENTRY NAME (UP TO 8 BYTES).
      LDB N4        DELIMITER = BLANK.
      JSB D$ASC 
* 
      INA           (A) = TOTAL BYTES IN REQUEST. 
      ARS 
      ADA N21       NEED TO INSERT TRAILING BLANKS
      STA TEMP      IN ENTRY NAME FIELD?
      SSA,RSS 
      JMP MVTAG     NO. 
* 
LOOP3 LDA BLNKS     YES. ADD TRAILING BLANKS TO FILL
      JSB D$STW      OUT 4-WORD FIELD.
      ISZ TEMP
      JMP LOOP3 
* 
MVTAG LDA N20       MOVE TAG FIELD. 
      JSB D$NWD 
* 
      CLA           MOVE 2 PARAMETERS.
      LDA ENAM+1,I
      JSB D$STW 
      CLA 
      LDA ENAM+2,I
      JSB D$STW 
      CLA           ZERO 3 WORDS. 
      JSB D$STW 
      CLA 
      JSB D$STW 
      CLA 
      JSB D$STW 
      LDA MAXSZ     STORE MAX BLOCK SIZE (+WORDS).
      LDB BUFSZ     GET USER'S VALUE IF 
      SZB             IT WAS SPECIFIED. 
      LDA BUFSZ,I 
      SZA 
      SSA 
      LDA MAXSZ 
      JSB D$STW 
* 
* SET UP PARAMETER MASK AS FOLLOWS: 
*       BIT 9 = PROGRAM NAME
*       BIT 8 = ENTRY NAME
*       BIT 7 = 0 
*       BIT 6 = CONTROL INFO
*       BIT 5 = LOADING OPTIONS 
*       BIT 4 = 0 
*       BIT 3 = 0 
*       BIT 2 = 0 
*       BIT 1 = 0 
*       BIT 0 = 0 
* 
      LDA DPARM     FWA PARAM ADDR LIST.
      STA TEMP
      LDA N5        COUNTER.
      STA CONTR 
      CLA           INITIALIZE PARAMETER MASK.
* 
LOOP4 LDB TEMP,I    GET ADDR OF NEXT PARAM. 
      LDB B,I 
      SZB 
      IOR B1        SET BIT IF PARAM SPECIFIED. 
      RAL           MOVE IT OVER. 
      ISZ TEMP
      ISZ CONTR 
      JMP LOOP4     LOOP TILL DONE. 
      ALF           BITS 0-4 = 0. 
      JSB D$STW 
* 
* REQUEST BUFFER READY. D3KMS WILL WRITE IT TO QUEX'S I/O 
* CLASS. USER WILL BE SUSPENDED UNTIL D3KMS'S CLASS GET 
* IS COMPLETED WHEN THE REPLY ARRIVES.
* 
      JSB D$WDC     STORE WORD COUNT. 
      CLA           POPEN HAS A SINGLE REPLY. 
      LDB BIT15     SET NO-ABORT BIT IN FLAG WORD.
* 
      JSB REMIO     SEND REQUEST AND WAIT FOR REPLY.
* 
      JSB PASSP     RETURN ERROR CODE AND TAG FIELD.
* 
      LDA D$RQB     RETURN PCB FROM REPLY.
      ADA K10        (CURRENTLY NOT USED - ALL ZEROES)
      STA TAGPR 
      LDA N3
      LDB IPCB
      JSB MOVE
* 
      LDA ERRAD,I 
      JMP RTRN,I    RETURN TO CALLER. 
* 
* 
DPARM DEF *+1       TABLE OF POPEN PARAMETER
      DEF INAM       ADDRESSES FOR BIT MASK.
      DEF ENAM
      DEF B0
      DEF ENAM+1
      DEF ENAM+2
* 
      SKP 
* 
* SUBROUTINE TO SEND AND/OR RECEIVE BUFFERS TO/FROM THE HP3000. 
* 
REMIO NOP 
      IOR 1 
      STA CNWRD 
* 
      JSB D3KMS 
      DEF *+2 
      DEF CNWRD 
      JMP ERR       ERROR RETURN. 
* 
      LDA D$RQB     SAVE "FROM PROCESS #" AS
      ADA K4        "TO PROCESS #" FOR NEXT REQUEST.
      LDA A,I 
      ALF,ALF 
      AND B377
      STA D$SMP 
* 
      ISZ BLKCT     BUMP PREAD/PWRIT BLOCK COUNTER. 
      JMP REMIO,I   EXIT. 
* 
* SUBROUTINE TO BUILD 8-WORD FIXED FORMAT AREA OF REQUEST.
* 
*  (A) = 1ST BYTE RIGHT JUSTIFED
*  (B) = STREAM TYPE. 
* 
D$PTP NOP 
      STB TEMP      SAVE STREAM TYPE. 
      LDA K4        STORE MESSAGE CLASS = 4.
      JSB D$STW     STORE 1ST WORD IN REQUEST BUFFER. 
      CLA           CLEAR COMPUTER ID.
      JSB D$STW 
      LDA TEMP      STORE STREAM TYPE.
      JSB D$STW 
      LDA N4        CLEAR NEXT 4 WORDS. 
      JSB D$ZRO 
      LDA N2        FORCE BYTE COUNTER TO CLEAR.
      JSB D$STW 
      JMP D$PTP,I 
* 
* SUBROUTINE TO PASS RETURNED ERROR CODE AND TAG
* FIELD TO THE USER PROGRAM.
* 
PASSP NOP 
      LDB D$RQB     RETURN ERROR CODE.
      ADB K8
      LDB B,I 
      CLA           MAP DS/3000 TO DS/1 ERROR CODES.
      CPB CG211 
      INA           CCG & 211 = 1 (REJECT). 
      CPB CL209 
      LDA N41       CCL & 209 = -41.
      CPB CL205 
      LDA N42       CCL & 205 = -42.
      CPB CG210 
      LDA N44       CCG & 210 = -44.
      CPB CL213 
      LDA N44       CCL & 213 = -44.
      STA ERRAD,I 
* 
      LDB D$RQB 
      ADB K13       RETURN TAG FIELD. 
      STB TAGPR 
      LDA N20       20 WORDS. 
      LDB TAGAD 
      JSB MOVE
      JMP PASSP,I 
      SKP 
* 
* GENERATE PREAD REQUEST FOR REMOTE DS/3000 COMPUTER. 
* 
QREAD CLA           CLEAR BLOCK COUNTER.
      STA BLKCT 
      LDA RITAG 
      STA TAGAD 
      SZA,RSS 
      JMP ERR2      ILLEGAL # PARAMETERS. 
* 
      LDA RPRAM     POINT TO ADDR OF 1ST PARAM (TAG). 
      JSB D$INI     INITIALIZE BUFFER STUFFERS. 
* 
      LDB B22       SET UP 8-WORD FIXED FORMAT AREA.
      JSB D$PTP 
* 
      CLA 
      JSB D$STW 
* 
      LDA RIL,I     GET USER BUFFER LENGTH. 
      SSA,RSS 
      JMP *+4 
      CMA,INA 
      INA 
      CLE,ERA 
      JSB D$STW     STORE IN REQUEST BUFFER.
* 
      LDA RIPCB     MOVE PCB TO REQUEST.
      JSB MVPC       (EMPTY AT PRESENT) 
      LDA N20       MOVE TAG FIELD. 
      JSB D$NWD 
* 
      JSB D$WDC      SET WORD COUNT.
* 
* SEND REQUEST TO THE 3000 AND WAIT FOR REPLIES.
* 
      LDA RIBUF     SET ADDR OF USER DATA BUFFER. 
      STA TBUF
      CLA 
      STA TCNT       CLEAR RECEIVED BYTE COUNTER. 
      INA           SIGNAL FOR MULTIPLE REPLIES.
* 
SN/RC LDB BIT15     SET NO-ABORT BIT IN FLAG WORD.
* 
      JSB REMIO     SEND REQUEST AND GET REPLIES. 
* 
      LDA CNWRD     WAS LAST CALL TO RELEASE CLASS ONLY?
      AND B377
      CPA K4
      JMP DONE      YES.
* 
      LDA BLKCT     IF FIRST REPLY, PASS ERROR
      CPA B1         CODE AND TAG TO USER.
      JSB PASSP 
* 
      LDA D$RQB     CHECK IF ANY DATA WAS RECEIVED. 
      ADA B7
      LDA A,I       (A) = + BYTES.
      ADA N10       ADJUST FOR IERR & PCB.
      LDB BLKCT 
      CPB B1        IF FIRST REPLY, ADJUST FOR TAG. 
      ADA N40 
      SZA,RSS 
      JMP DEALC     NO DATA (COULD BE REJECT).
* 
      JSB RDMOV     MOVE DATA TO USER BUFFER. 
* 
      LDA D$RQB     IS CONTINUATION BIT SET?
      ADA K2
      LDA A,I 
      RAL,RAL 
      SSA 
      JMP DMREP      YES. 
DEALC LDA K4         NO. DE-ALLOCATE CLASS. 
      JMP SN/RC 
* 
DMREP LDB D$RQB     NO. SET UP "REPLY". 
      LDA B,I       STORE COUNT AND MSG CLASS.
      AND B377
      IOR LB10
      STA B,I 
      ADB K2
      LDA B,I       CLEAR REPLY BIT.
      ELA,CLE,ERA 
      STA B,I 
      ADB K2
      LDA B,I       REVERSE PROCESS NUMBERS.
      ALF,ALF 
      STA B,I 
      ADB K3
      CLA           CLEAR BYTE COUNT. 
      STA B,I 
* 
      LDA K2        TELL D3KMS TO LOOK FOR MORE.
      JMP SN/RC     GO GET NEXT DATA BLOCK. 
* 
DONE  LDA ERRAD,I 
      JMP RTRN,I    RETURN TO USER. 
      SPC 2 
* 
*     MOVE SUBROUTINE 
* 
MOVE  NOP 
      STA CONTR 
MOVE1 LDA TAGPR,I   PICK UP NEXT WORD 
      STA 1,I        AND PUT IT AWAY
      INB 
      ISZ TAGPR     INCREMENT POINTERS
      ISZ CONTR 
      JMP MOVE1     UNTIL DONE
      JMP MOVE,I
      SKP 
* 
* SUBROUTINE TO MOVE A BLOCK OF DATA FROM REPLY 
* BUFFER TO USER BUFFER (REMAINING BYTES UP TO MAX LEN).
* EXIT WITH TCNT = TOTAL BYTES REMAINING. 
* 
RDMOV NOP           (A) = + BYTES.
      SZA,RSS       EXIT FOR
      JMP RDMOV,I    0-LEN DATA.
      LDB A         ACCUMULATE LOG. 
      ADB TCNT
      STB TCNT
      INA 
      CLE,ERA       (A) = + WORDS.
      CMA,INA 
      STA TEMP      NEG. # WORDS TO MOVE. 
      LDB D$RQB 
      ADB K13       GET PAST 3-WORD "PCB" AREA. 
      LDA BLKCT     IF THIS IS FIRST REPLY, 
      CPA B1
      ADB K20        ADJUST FOR TAG FIELD.
      STB RQPTR     ADDR OF REPLY DATA. 
* 
LOOP  LDA RQPTR,I   MOVE WORD FROM REPLY
      STA TBUF,I     TO USER BUFFER.
      ISZ RQPTR     BUMP POINTERS.
      ISZ TBUF
* 
      ISZ TEMP
      JMP LOOP       ELSE LOOP TILL DONE. 
      JMP RDMOV,I   REACHED LIMIT OF MAX WORDS. 
      SKP 
* 
* GENERATE PWRIT REQUEST FOR REMOTE DS/3000 COMPUTER. 
* 
QWRIT CLA           CLEAR BLOCK COUNTER.
      STA BLKCT 
      LDA PITAG 
      STA TAGAD 
* 
      SZA,RSS 
      JMP ERR2      ILLEGAL # PARAMETERS. 
* 
      LDA PPRAM     POINT TO ADDR OF 1ST PARAM (TAG). 
      JSB D$INI     INITIALIZE BUFFER STUFFERS. 
* 
      LDB B23       SET UP 8-WORD FIXED FORMAT AREA.
      JSB D$PTP 
* 
      CLA 
      JSB D$STW 
* 
      LDA PIBUF     SET POINTER TO USER DATA. 
      STA TBUF
* 
      LDA PIL,I     GET USER BUFFER LENGTH. 
      SSA,RSS 
      JMP *+5 
      CMA,INA 
      SLA 
      INA 
      RSS 
      CLE,ELA       BYTES (POSITIVE). 
      STA TCNT      TOTAL DATA BYTES TO SEND. 
      CLE,ERA 
      JSB D$STW     STORE IN REQUEST BUFFER (TCOUNT). 
* 
      LDA PIPCB     MOVE PCB TO REQUEST.
      JSB MVPC       (EMPTY AT PRESENT) 
      LDA N20       MOVE TAG FIELD. 
      JSB D$NWD 
* 
      JSB D$WDC     SET WORD COUNT. 
* 
      JSB WRMOV     MOVE 1ST BLOCK TO REQUEST BUFFER. 
      LDA TCNT
      SZA,RSS       IF ALL DATA MOVED,
      JMP SEND      TELL D3KMS THERE IS A SINGLE REPLY. 
* 
      LDB D$RQB     CONTINUATION BLOCKS REQUIRED. 
      ADB K2
      LDA B,I 
      IOR BIT13     SET CONTINUATION BIT IN STREAM WORD.
      STA B,I 
      CLA,INA       TELL D3KMS THERE ARE MULT. BLOCKS.
* 
* SEND REQUESTS TO THE 3000 AND GET THE REPLY.
* 
SEND  LDB BIT15     SET NO-ABORT BIT IN FLAG WORD.
* 
      JSB REMIO     SEND REQUESTS AND/OR GET REPLY. 
* 
      LDB TCNT      IF ALL DATA OUT, WE HAVE RECEIVED 
      SZB            THE REPLY. 
      JMP MORE
      JSB PASSP      RETURN ERROR CODE & TAG TO USER. 
      LDA ERRAD,I 
      JMP RTRN,I     RETURN TO CALLER.
* 
* MORE DATA... SHIP OUT THE NEXT BLOCK. 
* 
MORE  LDB D$RQB     CLEAR REPLY BIT.
      ADB K2
      LDA B,I 
      ELA,CLE,ERA 
      STA B,I 
* 
      JSB WRMOV     MOVE NEXT CHUNK OF DATA.
      LDA K2
      LDB TCNT
      SZB           IF MORE DATA, KEEP CONT. BIT. 
      JMP SEND      CALL D3KMS WITH RCODE = 2.
* 
      LDB D$RQB     THIS IS LAST BLOCK. 
      ADB K2
      LDA B,I 
      AND NOT13     CLEAR CONTINUATION BIT. 
      STA B,I 
      LDA K3        TELL K3KMS THIS IS LAST BLOCK.
      JMP SEND
      SKP 
* SUBROUTINE TO STORE # BYTES LEFT TO SEND IN REQ 
* BUFFER AND MOVE NEXT BLOCK OF USER DATA (REMAINING
* BYTES UP TO MAX). STORE ADJUSTED BYTE COUNTER (N) 
* IN REQUEST. ON EXIT, TCNT IS REMAINING # DATA 
* BYTES OR ZERO.
* 
WRMOV NOP 
      LDB D$RQB 
      ADB B7
      LDA B,I       INITIALIZE BYTE COUNTER (N).
      STA BYTCT 
      LDA TCNT      # REMAINING DATA BYTES. 
      SZA,RSS       EXIT FOR
      JMP WRMOV,I    0-LEN DATA.
      LDB D$RQB 
* 
      ADB K13       SET ADDR OF DATA IN RQBUF.
      LDA BLKCT 
      SZA,RSS       ADJUST FOR TAG FIELD
      ADB K20        IN FIRST REQUEST.
      STB RQPTR 
      LDA RLSIZ 
      STA TEMP      SET MAX # DATA WORDS (NEG). 
* 
LOOP1 LDA TBUF,I    MOVE DATA FROM USER TO REQUEST. 
      STA RQPTR,I 
      ISZ TBUF
      ISZ RQPTR 
      ISZ BYTCT     ADD 2 TO BYTE COUNTER (N).
      ISZ BYTCT 
      LDA TCNT      DECREMENT TOTAL DATA BYTES LEFT.
      ADA N2
      STA TCNT
      CMA,INA       NEGATE. 
      SSA,RSS       IF 0 OR 1,
      JMP ADJ1       ALL USER DATA MOVED, 
      ISZ TEMP
      JMP LOOP1      ELSE LOOP TILL DONE. 
      JMP STBYT     REACHED LIMIT OF MAX WORDS. 
* 
ADJ1  CMA,INA       ADJUST BYTE COUNTER (N) 
      ADA BYTCT 
      STA BYTCT 
* 
STBYT LDA D$RQB     STORE BYTE COUNT (N). 
      ADA B7
      LDB BYTCT 
      STB A,I 
      LDA TCNT      IF TCNT = -1, MAKE IT 0.
      CPA N1
      CLA 
      STA TCNT
      JMP WRMOV,I   RETURN. 
      SKP 
* 
* GENERATE PCONT REQUEST FOR REMOTE DS/3000 COMPUTER. 
* 
QCONT LDA CITAG 
      STA TAGAD 
* 
      SZA,RSS 
      JMP ERR2      ILLEGAL # PARAMETERS. 
* 
      LDA CPRAM     ADDR OF 1ST PARAM (TAG).
      JSB D$INI     INITIALIZE BUFFER STUFFERS. 
* 
      LDB B24       SET UP 8-WORD FIXED FORMAT AREA.
      JSB D$PTP 
      LDA N2        CLEAR NEXT 2 WORDS. 
      JSB D$ZRO 
* 
      LDA CIPCB     MOVE PCB TO REQUEST.
      JSB MVPC       (EMPTY AT PRESENT) 
      LDA N20       MOVE TAG FIELD. 
      JSB D$NWD 
* 
      JSB D$WDC     SET WORD COUNT. 
* 
* SEND REQUEST TO THE 3000 AND WAIT FOR THE REPLY.
* 
      CLA           SINGLE BLOCK. 
      LDB BIT15     SET NO-ABORT BIT IN FLAG WORD.
* 
      JSB REMIO     SEND REQUEST AND GET REPLY. 
* 
      JSB PASSP     RETURN ERROR CODE & TAG FIELD.
* 
      LDA ERRAD,I 
      JMP RTRN,I    RETURN. 
      SKP 
* 
* GENERATE PCLOS REQUEST FOR REMOTE DS/3000 COMPUTER. 
* 
QCLOS LDB D$RQB     MOVE REQUEST TO D3KMS BUFFER. 
      LDA BRKBF 
      MVW K8        MOVE 8 WORDS
* 
      JSB D3KMS     SEND BREAK REQ TO 3000, 
      DEF *+2        AND GET THE REPLY. 
      DEF BIT15 
      NOP 
* 
      LDA FIERR     ADDR OF 1ST PARAM (DUMMY).
      JSB D$INI     INITIALIZE BUFFER STUFFERS. 
* 
      LDB B21       SET UP 8-WORD FIXED FORMAT AREA.
      JSB D$PTP 
* 
      LDB D$RQB     CHANGE PCLOS MSG CLASS TO 7.
      LDA B7
      STA B,I 
* 
      LDA "RF"      STORE "RFA ". 
      JSB D$STW 
      LDA "A" 
      JSB D$STW 
      LDA B26       STORE FCN CODE = 26 OCTAL.
      JSB D$STW 
* 
      LDA FIPCB     MOVE PCB TO REQUEST.
      JSB MVPC       (EMPTY AT PRESENT) 
* 
      JSB D$WDC     SET WORD COUNT. 
* 
* SEND REQUEST TO THE 3000 AND WAIT FOR THE REPLY.
* 
      CLA           SINGLE BLOCK. 
      LDB BIT15     SET NO-ABORT BIT IN FLAG WORD.
* 
      JSB REMIO     SEND REQUEST AND GET REPLY. 
* 
      CLA           RETURN ERROR CODE OF 0. 
* 
      STA ERRAD,I 
      JMP RTRN,I    RETURN. 
      SKP 
* 
* MOVE PCB FROM USER ARRAY TO REQUEST BUFFER. 
* 
MVPC  NOP 
      STA TAGPR     POINTER TO PCB. 
      LDA N3
      STA CONTR 
MVP1  LDA TAGPR,I 
      JSB D$STW 
      ISZ TAGPR 
      ISZ CONTR 
      JMP MVP1
      JMP MVPC,I
* 
* TEST WHETHER REQUEST FOR 3000 OR REMOTE RTE.
* 
DS3K  NOP           (A) = ADDR OF USER PCB. 
      ADA K3        BUMP TO LU WORD.
      STA TEMP
      LDA #LU3K     GET LU OF 3000. 
      INA 
      LDB A,I 
      CPB TEMP,I    SAME AS LU IN USER PCB? 
      RSS           YES. EXIT VIA P+1.
      ISZ DS3K      NO.  EXIT VIA P+2.
      JMP DS3K,I