ASMB,R,L,C
      HED D3KMS 91741-16018 * (C) HEWLETT-PACKARD CO. 
      NAM D3KMS,7 91741-16018 REV 2026 800502 
      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 THE HEWLETT-PACKARD COMPANY.   *
******************************************************************
      SPC 1 
      ENT D3KMS,PRCNM,D$INI,D$STW,D$PRM,D$ABT 
      ENT D$NWD,D$ASC,D$RQB,ICC,D$ZRO,D$WDC 
      ENT D$ERR,D$INP 
      ENT D$IPM,D$APM,D$NPM,D$SPM,D$SMP,D$LOG 
      SPC 1 
      EXT .ENTR,EXEC,REIO,IFBRK,IFTTY,#LDEF,LUTRU,LOGLU 
      EXT #QRN,RNRQ,#TBRN,#RSAX,#QXCL 
      EXT CNUMO,.DFER,$LIBR,$LIBX,$OPSY 
      SPC 2 
L     EQU 304       MAXIMUM LINE BUFFER SIZE. 
      SPC 2 
**************************     D3KMS    ************************* 
*                                                               * 
*     SOURCE: 91741-18018                                       * 
*                                                               * 
*     BINARY: 91741-16018                                       * 
*                                                               * 
*     PROGRAMMER: JIM HARTSELL                                  * 
*                                                               * 
*     AUGUST 11, 1975                                           * 
*                                                               * 
*---------------------------------------------------------------* 
*                                                               * 
*        MODIFIED BY DMT BEGINNING OCTOBER 30, 1978             * 
*                                                               * 
***************************************************************** 
      SPC 3 
A     EQU 0 
B     EQU 1 
      SUP 
      SKP 
* D3KMS PROVIDES THE MASTER REQUESTOR WITH AN INTERFACE TO AN 
* HP3000 REMOTE COMPUTER.  ALL REQUESTS ARE SENT TO THE 3000
* LU, AND MPE PROCESS NUMBER, WHICH WERE DEFINED IN THE PREVIOUS
* CALL TO HELLO.  D3KMS WRITES THE REQUESTS TO THE QUEX I-O CLASS,
* WHICH QUEX RETRIEVES VIA CLASS I/O GET CALLS PRIOR TO TRANSMISSION. 
* D3KMS IS THE COUNTERPART OF THE DS/1000 D65MS SUBROUTINE. 
* 
* D3KMS CALLING SEQUENCE: 
* 
*       JSB D3KMS 
*       DEF *+2 
*       DEF CONWD          CONTROL WORD (SEE BELOW).
*     <ERROR RETURN>       RETURN HERE UPON ERROR DETECTION.
*     <NORMAL RETURN>      NORMAL RETURN. 
* 
* ENTRY CONDITIONS: 
* 
*   CONWD  ASSIGN  SEND     GET   DEALLOC 
* BITS 0-7 CLASS    REQ    REPLY   CLASS
* 
*     0     YES     YES     YES     YES 
*     1     YES     YES     YES     NO
*     2     NO      YES     YES     NO
*     3     NO      YES     YES     YES 
*     4     NO      NO      NO      YES 
* 
*   BIT 15    - ERROR-RETURN FLAG (NO-ABORT BIT). 
*   BIT 14    - NO TIMEOUT. 
      SPC 1 
* 
*  D3KMS ERROR PROCESSING:
* 
*  1. IF SIGN BIT (15) OF CONTROL WORD IS SET, ASCII ERROR CODES
*     ARE SUPPLIED TO THE CALLER IN THE A & B REGISTERS, UPON 
*     RETURN TO THE <ERROR RETURN> POINT IN THE CALLING SEQUENCE. 
* 
*  2. IF THE SIGN BIT IS NOT SET, THEN THE CALLER'S PROGRAM IS
*     ABORTED, AFTER PRINTING AN ERROR MESSAGE ON THE SYSTEM
*     CONSOLE.  THE MESSAGE PRINTED WILL CONTAIN THE ADDRESS OF THE 
*     USER"S RETURN FROM "D3KMS". 
* 
* D3KMS ERROR MESSAGES: 
* 
*   "DS00" - LOCAL SYSTEM IS NOT INITIALIZED SHUT DOWN
*   "DS01" - DS/3000 LINK NOT INITIALIZED OR SHUT DOWN. 
*   "DS05" - TIMEOUT. 
*   "DS06" - ILLEGAL REQUEST. 
*   "DS07" - "RES" LIST ACCESS ERROR. 
* 
* 
* EXIT CONDITIONS:  A-REG = STATUS WORD.
* 
*   ICC = -1 IF CCL (01) CONDITION CODE (A LA HP3000) FOR EVERY REPLY.
*       =  0 IF CCE (10)  " 
*       =  1 IF CCG (00)  " 
      SKP 
CONWD NOP           CONTROL WORD ADDRESS. 
* 
D3KMS NOP           ENTRY POINT.
      JSB .ENTR     OBTAIN DIRECT ADDRESSES 
      DEF CONWD      FOR PARAMETERS & RETURN POINT. 
* 
      CLB           CLEAR 
      STB BRFLG      BREAK FLAG AND 
      STB OEFLG       OUTPUT ERROR FLAG 
      STB PRFLG        AND PROMPT FLAG. 
* 
      LDA $OPSY     IS THIS AN RTE-III OR IV? 
      RAR,SLA 
RSSI  RSS           YES.
      JMP CECND     NO. 
      LDB RSSI      GET "RSS" INSTRUCTION.
      STB MODI2     MODIFY TO DO CROSS-MAP LOAD.
      STB MODI3     MODIFY TO DO CROSS-MAP STORE. 
* 
CECND LDA CONWD,I   GET CONTROL WORD. 
      AND B377      ISOLATE REQUEST CODE. 
      STA RCODE 
      SZA 
      CPA D1        CHECK ENTRY CONDITIONS. 
      JMP NEWRQ      NEW REQUEST: ASSIGN MASTER CLASS #.
      CPA D4
      RSS 
      JMP FRMTO      USE CURRENT MASTER CLASS #.
* 
      JSB CLNUP      RELEASE CLASS # ONLY.
      CLA 
      JMP NEXIT 
* 
* A NEW REQUEST IS READY TO GO TO THE HP3000. CHECK FOR 
* LOCAL SYSTEM SHUT-DOWN OR QUIESCENT STATUS. 
* (CONTINUATION REQUESTS WILL NOT COME THRU HERE.)
* 
NEWRQ LDA #QRN      GET THE QUIESCENT/SHUTDOWN RN.
      SZA,RSS       IS THE SYSTEM SHUT DOWN?
      JMP DOWN      YES. GO TELL CALLER.
* 
* NEW REQUESTS WILL BE FORCED TO WAIT HERE
* IF LOCAL SYSTEM HAS BEEN QUIESCED.
* 
      JSB RNRQ      GO TO RTE TO CHECK FOR QUIESCENCE.
      DEF *+4 
      DEF LCGW      LOCK/CLEAR/WAIT/NO-ABORT. 
      DEF #QRN      SYSTEM-QUIESCENCE RESOURCE NUMBER.
      DEF TEMP      DUMMY PARAMETER.
      JMP PASER     * RTE ERROR - PASS CODE TO CALLER * 
* 
      LDA #QRN      IF QUIESCENT STATE HAS BEEN CHANGED 
      SZA,RSS       TO SYSTEM SHUT-DOWN STATE,
      JMP DOWN      THEN TELL THE CALLER. 
* 
* 
* GET A CLASS NUMBER FOR THIS REQUEST.
* 
      LDA BIT13     CLEAR CLASS # AND SET BIT 13
      STA CLASN      FOR NON-RELEASE USAGE. 
* 
      JSB EXEC      GO TO RTE FOR A CLASS NO.---WAIT FOR IT.
      DEF *+5 
      DEF CLS19     CLASS CONTROL(QUICK ALLOCATE)- NO ABORT.
      DEF D0        LU = "BIT BUCKET" FOR ALLOCATION. 
      DEF D0        DUMMY PARAMETER.
      DEF CLASN     CLASS NUMBER STORAGE ADDRESS. 
      JMP PASER     * RTE ERROR: MESSAGE IN A & B * 
* 
      JSB EXEC      GO TO RTE TO COMPLETE 
      DEF *+5        PREVIOUS ALLOCATION REQUEST. 
      DEF CLS21      CLASS GET - NO ABORT.
      DEF CLASN     CLASS NUMBER STORAGE ADDRESS. 
      DEF D0        DUMMY.
      DEF D0        DUMMY.
      JMP PASER     * RTE ERROR: MESSAGE IN A & B * 
* 
* ADD LOG LU TO REQUEST.
* 
FRMTO JSB LUTRU     GET "REAL" LOG
      DEF *+3        LU NUMBER. 
      DEF D$LOG 
      DEF TEMP
      LDA TEMP      STORE LOG LU IN 
      AND B377       "FROM PROCESS #".
      ALF,ALF 
      STA RQBUF+4 
* 
* USE MPE PROCESS NUMBER RETRIEVED FROM "HELLO" 
* AS THE "TO PROCESS #". IF ZERO, THIS MUST BE A HELLO COMMAND. 
* 
      LDA RQBUF     ISOLATE MESSAGE CLASS.
      AND B377
      STA B         HOLD IT IN B-REG. 
      LDA D$SMP     GET SESSION NUMBER. 
      AND B377
      IOR RQBUF+4 
      STA RQBUF+4 
      CPB D6        IF NOT HELLO, 
      JMP SEND
      AND B377
      SZA,RSS         AND SESSION # IS ZERO,
      JMP ILRQ          IT IS AN ILLEGAL REQUEST. 
* 
*  VERIFY THAT SMP # IS GOOD BY SEARCHING PNL.
      CCB           ADDR OF PNL HEADER ADDRESS. 
      ADB #LDEF 
      LDB B,I       GET ADDR OF FIRST ENTRY.
STLST SZB,RSS       END OF LIST?
      JMP NTFND     YES. SMP # NOT FOUND. 
      JSB LODWD     GET NEXT ADDR.
      STA NXTAD     SAVE NEXT ADDRESS.
      ADB D2        POINT TO SMP WORD.
      JSB LODWD     LOAD. 
      CPA D$SMP     OURS? 
      JMP SEND        YES! OK TO SEND.
      LDB NXTAD     GET NEXT ADDR.
      JMP STLST     GO CHECK NEXT ENTRY.
* 
*  SMP NOT FOUND IN LIST. (LINE WAS PROBABLY RE-ENABLED.) 
NTFND STB D$SMP     SET SMP # TO 0. 
      JMP ILRQ      REPORT ILLEGAL REQUEST. 
* 
NXTAD NOP 
* 
* WAIT FOR AVAILABILITY OF LIST-ENTRY SPACE IN "RES"; ADD NEW ENTRY.
* 
SEND  LDA RQBUF+7   GET BYTE COUNTER. 
      INA 
      CLE,ERA       MAKE WORD COUNT.
      ADA D8        ADD FIXED FORMAT LENGTH.
      STA BUFL      STORE REQUEST LENGTH. 
* 
SEND1 JSB RNRQ      CHECK TABLE-ACCESS RN.
      DEF *+4 
      DEF LGW       LOCK GLOBAL RN/WAIT/NO ABORT. 
      DEF #TBRN     TABLE-ACCESS SPACE-AVAILABLE RN.
      DEF TEMP      DUMMY.
      JMP PASER     * RTE ERROR - PASS ERROR CODE TO USER * 
* 
      LDA CONWD,I 
      RAL,ELA       BIT 14 HAS TIMEOUT SUPPRESS FLAG. 
      LDA CLASN 
      RAL,ERA       MOVE FLAG TO BIT 15 OF CLASS WORD.
      STA TEMP
* 
      JSB #RSAX     GO TO "RES" ACCESS ROUTINE. 
      DEF *+5 
      DEF D2        ADD A MASTER ENTRY. 
      DEF TEMP      CLASS # AND TIMEOUT FLAG. 
      DEF XEQT      ID SEGMENT ADDRESS OF USER. 
      DEF D0        DUMMY DESTINATION NODE. 
      SSB           ANY ERRORS? 
      JMP RESER     * ERROR: "DS07" (NOT LIKELY) *
* 
      STA RQBUF+5   STORE SEQ # IN REQUEST. 
      STA SEQ#      SAVE LOCALLY. 
* 
      INB           SET "3K" BIT IN MASTER TCB. 
      JSB LODWD 
      IOR BIT14 
      JSB STRWD 
* 
      LDA BRFLG     IF CONTROL-Y
      SZA,RSS        BREAK IS 
      JMP CLSWR       BEING SENT, 
      LDA SEQ#          STORE SEQ # IN
      STA YSEQ#,I        CONTROL-Y REQUEST. 
      CLA               CLEAR 
      STA BRFLG          BREAK FLAG.
* 
* SEND REQUEST TO THE 3000 BY WRITING IT
* TO THE I/O CLASS FOR QUEX.
* 
CLSWR LDA #QXCL     GET QUEX I/O CLASS. 
      SZA,RSS 
      JMP NINIT     DS/3000 NOT INITIALIZED.
      SSA 
      JMP NINIT     DS/3000 DISCONNECTED. 
* 
      JSB EXEC      CLASS WRITE TO QUEX.
      DEF *+8 
      DEF CLS20 
      DEF D0
      DEF RQBUF 
      DEF BUFL
      DEF BUFL      PASS LENGTH FOR "GET" (WORDS).
      DEF D0
      DEF #QXCL     QUEX I/O CLASS. 
      JMP PASER     * RTE ERROR - PASS CODE TO CALLER * 
* 
      LDA BRFLG     WAS A "BREAK" SENT? 
      SZA,RSS 
      JMP WAIT      NO. 
      LDA D4        YES. EXIT WITH CLEAN-UP.
      STA RCODE 
      JMP EXIT
* 
* ISSUE A CLASS GET TO USER'S CLASS TO WAIT FOR A REPLY.
* USER WILL BE SUSPENDED UNTIL REPLY ARRIVES. 
* 
WAIT  LDA RQSIZ 
      CMA,INA 
      STA BUFL
* 
      JSB EXEC      GO TO RTE TO GET THE REPLY. 
      DEF *+5 
      DEF CLS21     CLASS GET - NO ABORT. 
      DEF CLASN     MASTER CLASS NO. -- NO RELEASE. 
      DEF RQBUF     REPLY ADDRESS.
      DEF BUFL      REPLY LENGTH. 
      JMP PASER     * RTE ERROR: MESSAGE IN A & B * 
* 
* CHECK FOR PROPER REPLY. 
* 
      SZB,RSS       CHECK FOR ZERO REPLY LENGTH.
      JMP MTOER     YES. GO PROCESS TIMEOUT ERROR.
* 
      LDA RQBUF+2   CHECK REJECT BIT. 
      RAL 
      SSA 
      JMP ILRQ      REQUEST REJECTED. 
* 
* GO CHECK IF A $STDLIST OR $STDIN WAS RECEIVED.  IF NOT, 
* CONTROL WILL BE RETURNED.  IF YES, THE MASTER-LIST ENTRY WILL 
* BE CLEARED, THE PRINT OR READ WILL BE PROCESSED, A REPLY WILL BE
* BUILT, AND CONTROL WILL GO TO "SEND". 
* 
      JSB PRTRD     GO CHECK FOR PRINT/READ REQUEST.
* 
* DE-ALLOCATE THE USER'S CLASS NUMBER IF RCODE = 0 OR 3 OR 4, 
* AND RELEASE MASTER LIST ENTRY IN "RES". 
* 
EXIT  JSB CLNUP     GO CLEAN UP BEFORE EXIT.
* 
* STORE CONDITION CODE IN ICC AND RETURN TO 
* CALLER WITH (A) = STATUS WORD.
* 
      LDB OEFLG     WAS THERE AN OUTPUT ERROR?
      SZB 
      JMP PSER1      YES! 
      LDA RQBUF+8 
      ALF,ALF 
      AND D3        IF CC IS:   SET ICC TO: 
      CPA D1
      CCB              01  (CCL)   -1 
      CPA D2
      CLB              10  (CCE)    0 
      CPA D0
      CLB,INB          00  (CCG)   +1 
      LDA RCODE     DON'T CHANGE ICCC IF RCODE = 2. 
      CPA D2
      RSS 
      STB ICCC
* 
      LDA RQBUF+8 
NEXIT ISZ D3KMS     SET EXIT POINTER FOR NORMAL RETURN. 
      JMP D3KMS,I   RETURN. (A) = STATUS WORD.
      SKP 
* 
* SUBROUTINE TO PROCESS $STDLIST OR $STDIN "REQUESTS" THAT
* MAY HAVE BEEN RECEIVED AS A "REPLY" FROM THE 3000.
* 
PRTRD NOP 
      LDA RQBUF 
      AND B377      CHECK FOR MESSAGE CLASS 5 
      CPA D5         ($STDLIST, $STDIN, OR $STDIX). 
      RSS 
      JMP PRTRD,I   NOT PRINT/READ. RETURN. 
      LDA RQBUF+2 
      SSA           CHECK IF IT IS A REQUEST. 
      JMP PRTRD,I   NO... REPLY, SO LET IT THROUGH. 
* 
      LDA RQBUF+2   GET STREAM WORD.
      AND B77       ISOLATE STREAM TYPE.
      CPA B20 
      JMP MESG      STREAM 20 IS $STDLIST "REPLY".
      CPA B21       STREAM 21 IS $STDIN "REQUEST".
      JMP STDIN 
      CPA B23       IF NOT FCONTROL,
      RSS 
      JMP PRTRD,I     JUST IGNORE.
      SPC 2 
* 
* FCONTROL REQUEST. SEE IF IT'S ONE WE CAN REALLY ACT UPON. 
* 
      LDA RQBUF+9   CHECK FOR VALID FUNCTIONS.
      CPA D39        FCONTROL 39--
      JMP SETYP        SET TERMINAL TYPE. 
      CPA D41        FCONTROL 41--
      JMP RDSTP        READ STRAPS. 
* 
SETPR LDA RQBUF+10  MOVE PARAM
STAPN STA RQBUF+9    WORD.
      LDA D4        SET BYTE
      STA RQBUF+7    LEN WORD.
      JMP NEXT1 
* 
* 
*   FUNCTION 39 
* 
SETYP JSB IFTTY     SET TERMINAL TYPE BY
      DEF *+2        CHECKING RTE DRIVER
      DEF D$LOG       TYPE. 
      SZA,RSS       NON-INTERACTIVE.
      JMP STAPN      RETURN TYPE=0. 
      LDA B         IF DRIVER 
      ALF,ALF        IS 5 
      AND B77 
      CLB 
      CPA D5
      LDB D10          USE 10.
      CPA D7        IF 7 (MULTIPOINT),
      LDB D14          USE 14.
      LDA B         (OTHERWISE USE 0.)
      JMP STAPN     STORE IN APPENDAGE. 
* 
*   FUNCTION 41 
*     ON MPE THIS SETS UNEDITED TERMINAL MODE.
*     FOR RTE, TELL DRIVER TO CHECK TERMINAL STRAPS.
* 
RDSTP JSB IFTTY     IF INPUT
      DEF *+2        LU IS NOT
      DEF D$INP       INTERACTIVE,
      SSA,RSS 
      JMP SETPR         JUST REPLY. 
* 
      LDA B         ISOLATE 
      ALF,ALF        TERMINAL 
      AND B377        TYPE. 
      CPA D5        IF NOT TYPE 5,
      RSS 
      JMP SETPR       JUST REPLY. 
* 
      LDA D$INP     MAKE I/O CONTROL
      AND B77 
      IOR B700       REQUEST 7, 
      STA CNWRD       WHICH CLEARS STATUS 
      JSB EXEC         BIT 3 FOR A NORMAL 
      DEF *+3           DV.05 TERMINAL, 
      DEF SD3            BUT SETS IT FOR MUX. 
      DEF CNWRD 
      NOP 
      JSB EXEC      GET STATUS WORD.
      DEF *+4 
      DEF D13 
      DEF D$INP 
      DEF TEMP
      LDB B2500     ASSUME IT'S NORMAL. 
      LDA TEMP      ISOLATE BIT 
      AND B40        3 OF STATUS. 
      SZA           IF IT'S SET 
      LDB B3200      TERMINAL IS A MUX. 
      LDA D$INP     SET UP CONTROL WORD 
      AND B77 
      IOR B          TO READ STRAPS.
      STA CNWRD 
      JSB EXEC      TELL DRIVER 
      DEF *+3        TO CHECK 
      DEF SD3         THE STRAPS. 
      DEF CNWRD 
      JSB OERR      (ABORT RETURN.) 
      JMP SETPR     SEND REPLY. 
      SKP 
* 
* WE HAVE A REQUEST FROM THE HP3000 FOR INPUT FROM A
* USER TERMINAL (PREVIOUS $STDLIST SHOULD HAVE
* PROVIDED A PROMPT MESSAGE OR CHARACTER).
* 
STDIN JSB #RSAX     CLEAR CURRENT MASTER LIST ENTRY.
      DEF *+3 
      DEF D6
      DEF SEQ#
* 
*  CHECK WHETHER WE NEED TO REWRITE PREVIOUS $SDTLIST BY CHECKING:
*    D$INP <> D$LOG  AND  PROPMT FLAG = TRUE  AND  D$INP IS INTERACTIVE.
      LDA D$INP     IF D$INP =
      XOR D$LOG      D$LOG, 
      AND B77 
      JMP RDLIN         GO READ.
      LDA PRFLG     IF PROMPT 
      SZA,RSS        IS ZERO, 
      JMP RDLIN         GO READ.
      JSB IFTTY     IF D$INP
      DEF *+2        IS NOT 
      DEF D$INP       INTERACTIVE,
      SZA,RSS 
      JMP RDLIN         GO READ.
* 
      LDA D$INP     SET "ECHO INPUT" &
      IOR B600       "PRINT COL 1" BITS.
      STA CNWRD 
      JSB REIO      REPEAT
      DEF *+5        PROMPT 
      DEF SD2         ON
      DEF CNWRD        INPUT
      DEF ORCRD         DEVICE. 
      DEF OLDLN 
      NOP           IGNORE ERRORS.
      CLA           CLEAR PROMPT
      STA PRFLG      FLAG.
* 
RDLIN LDA RQBUF+10  GET PARAMETER WORD. 
      AND B100      IF "SPECIAL READ" 
      SZA,RSS        BIT ISN'T SET, 
      JMP DOREA       GO DO THE READ. 
* 
*  FOR SPECIAL BLOCK MODE READ, DO A DUMMY READ AND HOME THE CURSOR.
* 
      LDA D$INP     STORE LU IN CNWRD 
      AND B77 
      STA CNWRD      WITHOUT FUNCTION BITS. 
      STA RQBUF+10  INSURE 1ST CHAR ISN'T ESC.
      JSB EXEC      DUMMY READ. 
      DEF *+5 
      DEF SD1 
      DEF CNWRD 
      DEF RQBUF+10
      DEF RQBUF+8 
      CLB 
* 
      LDA RQBUF+10  IF 1ST CHAR IS
      AND UP377      ESCAPE, ASSUME 
      CPA ESC         BUFFER IS FROM SOFT 
      JMP GTRLN        KEY. USE IT! 
* 
      JSB EXEC      HOME CURSOR 
      DEF *+5        AND RE-READ
      DEF SD2         THE SCREEN. 
      DEF CNWRD 
      DEF HCENT 
      DEF N5
      NOP 
* 
DOREA JSB REIO      READ FROM USER TERMINAL.
      DEF *+5 
      DEF SD1 
      DEF CNWRD 
      DEF RQBUF+10
      DEF RQBUF+8   (+ = WORDS, - = BYTES)
      CLB           INPUT ERROR: SET B:=0.
* 
GTRLN LDA RQBUF+8   (B) = POS. BYTES OR POS. WORDS INPUT. 
      SSA,RSS       IF $STDIN SPECIFIED POS. WORDS, 
      BLS            MAKE (B) = POS. BYTES. 
* 
      LDA B         IF # BYTES IS 
      ADA N3
      SSA,RSS         ONE OR TWO, 
      JMP REPLY 
      LDA RQBUF+10    AND INPUT WORD = BLANKS,
      CPA BLNKS 
      CLB               SET 0-LEN REPLY MESSAGE.
* 
REPLY ADB D4         COUNT CONTROL & LENGTH WORDS.
      STB RQBUF+7   STORE TOTAL REPLY BYTE LENGTH.
* 
      ADB N4         RESTORE POS. BYTE LEN OF INPUT.
      LDA RQBUF+8 
      SSA            IF $STDIN SPECIFIED NEG. BYTES,
      CMB,INB,RSS     MAKE (B) = NEG. BYTES,
      BRS             ELSE MAKE (B) = POS. WORDS. 
      STB RQBUF+9    STORE NEG. BYTE OR POS. WORD COUNT.
* 
      CLB,INB       STORE STATUS WORD.
      STB RQBUF+8 
* 
      JSB D$WDC     STORE WORD COUNT IN REPLY.
* 
      LDA RQBUF+2   SET REPLY BIT IN STREAM WORD. 
      IOR BIT15 
      STA RQBUF+2 
* 
      LDA RQBUF+4   REVERSE "FROM & TO" PROCESS #'S.
      ALF,ALF 
      STA RQBUF+4 
* 
      JSB BRKCK     CHECK FOR OPERATOR BREAK. 
      JMP BREAK     YES. GO BUILD BREAK REQUEST.
      JMP SEND      NONE. SEND $STDIN REPLY.
* 
* WE HAVE A REPLY MESSAGE FROM THE HP3000.
* DISPLAY ON USER-SPECIFIED LOG DEVICE. 
* 
MESG  LDA OEFLG     SKIP OUTPUT 
      SZA            IF OUTPUT ERROR
      JMP NEXT        FLAG IS SET.
      STA SKIP      CLEAR SKIP FLAG.
      LDA RQBUF+7   GET BYTE LENGTH.
      ADA N4        OMIT CONTROL WORDS FROM COUNT.
      CMA,INA       NEGATE MESSAGE BYTE LENGTH. 
      STA BUFL      SAVE NEGATIVE LENGTH. 
* 
*  CHECK FOR SPECIAL BLOCK MODE FOR MULTIPOINT. 
      LDA RQBUF+9   ISOLATE "SPECIAL BLOCK
      AND B100       MODE" INDICATION BIT.
      SZA,RSS       IF NOT SET, 
      JMP REGWR      IT'S A REGULAR WRITE.
* 
      JSB IFTTY     GET TERMINAL
      DEF *+2        TYPE.
      DEF D$LOG 
      LDA B 
      ALF,ALF 
      AND B377      IF IT'S TYPE
      CPA D7         7 (MULTIPOINT),
      RSS 
      JMP REGWR 
      LDA B100         SET 100B BIT 
      JMP DOWRT         IN CONTROL WORD.
* 
REGWR LDA RQBUF+8   GET FORMS CONTROL WORD. 
      AND B377
      JSB CNTRL     PROCESS FORMS CONTROL.
* 
      LDA B600      SET "ECHO INPUT" &
DOWRT IOR D$LOG      "PRINT COL 1" BITS.
      STA CNWRD 
      JSB REIO      DISPLAY THE MESSAGE.
      DEF *+5 
      DEF SD2 
      DEF CNWRD 
BUFA  DEF RQBUF+10
      DEF BUFL
      JSB OERR      OUTPUT ERROR. 
* 
* SAVE OUTPUT LINE FOR POSSIBLE RE-PROMPT.
* 
      LDA BUFL      IGNORE
      SZA,RSS        WRITES WITH
      JMP NEXT        NO DATA.
      STA OLDLN     SAVE LENGTH.
      CMA,INA       GET 
      INA            POSITIVE 
      CLE,ERA         NUMBER
      STA TEMP         OF WORDS.
      ADA N40       DON'T 
      SSA            LET
      JMP MVBUF       LENGTH
      LDA N80          GO 
      STA OLDLN         OVER
      CMA,INA            40.
      CLE,ERA 
      STA TEMP
MVBUF LDA BUFA      MOVE
      LDB @ORCD      THE
      MVW TEMP        BUFFER. 
      CCA           PROMPT FLAG 
      STA PRFLG      := TRUE. 
* 
      LDA SKIP      IF SKIP-LINE-AFTER-PRINT
      SZA,RSS        FLAG IS SET, 
      JMP NEXT
* 
      JSB REIO      PRINT A BLANK 
      DEF *+5        LINE.
      DEF SD2 
      DEF D$LOG 
      DEF BLNKS 
      DEF N1
      JSB OERR      OUTPUT ERROR. 
      CLA           CLEAR SKIP FLAG.
      STA SKIP
* 
* BUILD A REPLY FOR THE $STDLIST REQUEST. 
* 
NEXT  LDA D2        SET BYTE COUNT = 2. 
      STA RQBUF+7 
NEXT1 LDA RQBUF+2   SET REPLY BIT.
      IOR BIT15 
      STA RQBUF+2 
      LDA RQBUF+4   REVERSE PROCESS NUMBERS.
      ALF,ALF 
      STA RQBUF+4 
      AND B377      IF NO REPLY TO BE SENT, 
      SZA,RSS 
      JMP WAIT      GO WAIT FOR REAL REPLY. 
* 
      JSB #RSAX     CLEAR CURRENT MASTER LIST ENTRY.
      DEF *+3 
      DEF D6
      DEF SEQ#
* 
      LDA CCE       STORE STATUS WORD.
      STA RQBUF+8 
      JSB D$WDC     STORE WORD COUNT. 
      CLA 
      STA APEND 
* 
      JSB BRKCK     CHECK FOR OPERATOR BREAK. 
      JMP BREAK     YES. GO BUILD BREAK REQUEST.
      JMP SEND      NONE. SEND $STDLIST REPLY.
* 
SKIP  NOP           SKIP-AFTER-PRINT FLAG.
B23   OCT 23
B100  OCT 100 
B700  OCT 700 
B2500 OCT 2500
B3200 OCT 3200
D10   DEC 10
D14   DEC 14
D39   DEC 39
D41   DEC 41
N5    DEC -5
ESC   BYT 33,0      ESCAPE CHARACTER. 
* ESCAPE CODES TO HOME CURSOR AND ENTER DATA (WITHOUT CARRIAGE RETURN)
HCENT BYT 33,110,33,144,137 
      SKP 
* 
* ADD BREAK OR CONTROL Y REQUEST TO END OF $STDLIST/$STDIN
* REPLY BEFORE SENDING TO QUEX. (P.PTR POINTS TO WHERE TO 
* START BUILDING THIS ADDITIONAL REQUEST.)
* 
BREAK STB BRFLG     SAVE STREAM TYPE FROM "BRKCK".
      LDA RQBUF+7   SAVE BYTE COUNT FROM 1ST BLOCK. 
      STA TEMP2 
      INA           SET P.PTR TO END OF REPLY.
      CLE,ERA 
      ADA D8
      ADA D$RQB 
      STA P.PTR 
      LDA MSGCL     STORE WDCNT/MESSAGE CLASS.
      JSB D$STW 
      CLA 
      JSB D$STW 
      LDA BRFLG     STORE STREAM TYPE.
      JSB D$STW 
      CLA 
      JSB D$STW 
      LDA RQBUF+4   STEAL "FROM/TO" FROM 1ST BLOCK. 
      JSB D$STW 
      LDA P.PTR     SAVE CONTROL-Y
      STA YSEQ#      SEQ # ADDR.
      JSB D$STW 
      CLA 
      JSB D$STW 
      CLA 
      STA P.PTR,I   CLEAR BYTE COUNT WORD.
      LDA TEMP2     RESTORE BLOCK 1 BYTE COUNT. 
      STA RQBUF+7 
* 
      ISZ P.PTR     SET UP BUFL FOR CLASS WRITE.
      LDA D$RQB 
      CMA,INA 
      ADA P.PTR 
      STA BUFL
* 
      LDA BRFLG 
      CPA B25       GO WRITE TO QUEX: 
      JMP SEND1      CONTROL-Y INCLUDES MASTER TCB. 
      JMP CLSWR      BREAK DOESN'T. 
* 
MSGCL OCT 4006
YSEQ# NOP 
      SKP 
* 
* SUBR. TO MAP HP3000 MPE FORMS CONTROL TO RTE. 
*  (A) = FORMS CONTROL WORD.
* 
CNTRL NOP 
      STA TEMP      FORMS CONTROL WORD. 
      CPA B60       IF OCTAL 60,
      JMP DBLSP      GO SET DOUBLE SPACE. 
      AND B300      SKIP N
      CPA B200       LINES? 
      JMP SKIPN         YES.
      JSB IFTTY     IF LU 
      DEF *+2        TYPE IS
      DEF D$LOG       NON-INTERACTIVE,
      SZA,RSS 
      JMP CNTRL,I     DON'T TRY OTHER CONTROLS. 
      LDA TEMP      GET CONTROL WORD. 
      CPA B320      IF OCTAL 320, 
      JMP BKARR      GO DO BACK-ARROW THING.
      JMP CNTRL,I   NEITHER. RETURN.
* 
* SKIP N LINES VIA I-O CONTROL CALL.
* 
SKIPN LDA TEMP
      AND B77 
      SZA 
      ADA N1        RTE WILL SKIP 1 LINE DURING WRITE.
      SZA,RSS       IF N WAS 0 OR 1,
      JMP CNTRL,I     EXIT! 
      STA TEMP      IPRAM FOR I/O CONTROL (# OF LINES)
* 
      LDA D$LOG 
      IOR FCN11 
      STA CNWRD     CONTROL WORD WITH FUNCTION CODE.
* 
      JSB EXEC      I/O CONTROL CALL. 
      DEF *+4 
      DEF SD3 
      DEF CNWRD      CONTROL WORD.
      DEF TEMP       IPRAM. 
      JSB OERR      OUTPUT ERROR. 
* 
      JMP CNTRL,I   RETURN. 
* 
* INSERT A BACK-ARROW AS LAST CHAR. IN MESSAGE. 
* 
BKARR LDB BUFL
      CMB,INB       POSITIVE # MESSAGE BYTES. 
      CLE,ERB       E SET IF ODD # BYTES. 
      ADB BUFA      ADDR OF WORD FOR BACK-ARROW.
* 
      LDA B,I       CLEAR DESTINATION BYTE. 
      SEZ,RSS 
      ALF,ALF 
      AND HB377 
* 
      IOR "_"       INSERT BACK ARROW.
      SEZ,RSS 
      ALF,ALF 
      STA B,I 
* 
      LDA BUFL      INCR NEG. BYTE COUNT BY 1.
      ADA N1
      STA BUFL
* 
      JMP CNTRL,I   RETURN TO DISPLAY SECTION.
* 
* SET FOR DOUBLE SPACE AFTER PRINT. 
* 
DBLSP STA SKIP      SET SKIP-LINE-AFTER-PRINT FLAG. 
      JMP CNTRL,I   RETURN. 
* 
B60   OCT 60
B600  OCT 600 
B320  OCT 320 
B300  OCT 300 
B200  OCT 200 
CNWRD NOP 
FCN11 OCT 1100
"_"   OCT 137 
      SKP 
* 
* SUBROUTINE TO TEST AND SERVICE OPERATOR BREAK.
* 
BRKCK NOP 
      LDA OEFLG     OUTPUT ERROR
      SZA            FLAG SET?
      JMP BRK1         YES--IGNORE BREAK CHECK. 
      JSB IFBRK 
      DEF *+1 
      SZA,RSS       HAS THERE BEEN A BREAK? 
      JMP BRK1      NO. TAKE "NO-BREAK" RETURN. 
* 
      LDA D$INP     SET "ECHO INPUT" &
      IOR B600       "PRINT COL 1" BITS.
      STA CNWRD 
      JSB REIO      DISPLAY 
      DEF *+5        "ENTER CONTROL REQ. (B OR Y)". 
      DEF SD2 
      DEF CNWRD 
      DEF CMSG
      DEF D13 
      JMP BRK1      OUTPUT ERROR. 
* 
      JSB REIO      READ OPERATOR RESPONSE. 
      DEF *+5 
      DEF SD1 
      DEF CNWRD 
      DEF INBUF 
      DEF D2
      JMP BRK1      INPUT ERROR.
* 
      LDA INBUF     TEST RESPONSE.
      AND HB377 
      ALF,ALF 
      LDB B22 
      CPA "B" 
      JMP BRKCK,I   BREAK.
      LDB B25 
      CPA "Y" 
      JMP BRKCK,I   CONTROL Y.
* 
      JSB REIO      NEITHER:
      DEF *+5        DISPLAY "INVALID INPUT"
      DEF D2
      DEF CNWRD 
      DEF ILMSG 
      DEF D7
* 
BRK1  ISZ BRKCK     SET "NO-BREAK" RETURN.
      JMP BRKCK,I 
* 
CMSG  ASC 13,ENTER CONTROL REQ (B OR Y) 
ILMSG ASC 7,INVALID INPUT 
"B"   OCT 102 
"Y"   OCT 131 
      SKP 
* SUBROUTINE TO RELEASE THE MASTER CLASS AND CLEAR MASTER-LIST ENTRY. 
* 
CLNUP NOP           ENTRY/EXIT. 
      CPA "DS"
      JMP CLASS     CLEAR ALL FOR ABORTIVE ERROR. 
      LDA RCODE 
      CPA D1
      JMP CLRES     KEEP CLASS #. 
      CPA D2
      JMP CLRES     KEEP CLASS #. 
* 
CLASS LDA CLASN     GET THE CLASS NUMBER. 
      CCE,SZA,RSS   IF CLASS NUMBER NEVER ASSIGNED, 
      JMP CLNUP,I    RETURN NOW.
* 
      RAL,ERA       INCLUDE THE NO-WAIT BIT (#15),
      STA CLASN      AND SAVE FOR RELEASE.
CREPT CCA           SET THE RELEASE RE-TRY SWITCH 
      STA TEMP       TO -1. 
* 
CLRTN JSB EXEC      GO TO RT TO RELEASE CLASS NUMBER. 
      DEF *+5 
      DEF CLS21     SPECIFY CLASS GET - NO ABORT. 
      DEF CLASN     MASTER CLASS/RELEASE/NO WAIT. 
      DEF D0        DUMMY BUFFER ADDRESS. 
      DEF D0        DUMMY BUFFER LENGTH.
      RSS           IGNORE ERRORS.
* 
      ISZ TEMP      RELEASE PROCESSING COMPLETED? 
      JMP CLRES      YES. GO TO CLEAR THE "RES" ENTRY.
      INA,SZA        NO. ARE ALL PENDING REQUESTS CLEARED?
      JMP CREPT       NO. CONTINUE TO CLEAR REQUESTS. 
* 
      LDA CLASN     GET THE CLASS NUMBER AGAIN. 
      AND CLMSK     EXCLUDE THE NO-DE-ALLOCATION BIT (13).
      STA CLASN     RESTORE THE MODIFIED CLASS WORD.
      JMP CLRTN     RETURN FOR FINAL DE-ALLOCATION. 
* 
CLRES JSB #RSAX     GO TO "RES" ACCESS ROUTINE. 
      DEF *+3 
      DEF D6        CLEAR A LIST ENTRY. 
      DEF SEQ#      SEARCH, USING SEQUENCE NUMBER.
* 
      LDB RCODE     IF RCODE = 1 OR 2, KEEP CLASS #.
      CPB D1
      JMP CLNUP,I 
      CPB D2
      JMP CLNUP,I 
* 
      CLA 
      STA CLASN 
      JMP CLNUP,I   RETURN. 
* 
CLMSK OCT 117777    CLASS NUMBER MASK.
      SKP 
* 
* ERROR PROCESSING SECTION. 
* 
DOWN  LDB "00"      SYSTEM IS SHUT-DOWN: "DS00".
      JMP GETDS 
NINIT LDB "01"      DS/3000 LINK NOT INITIALIZED. 
      JMP GETDS 
MTOER LDB "05"      MASTER REQUEST TIMEOUT: "DS05". 
      JMP GETDS 
ILRQ  LDB "06"      ILLEGAL REQUEST.
      JMP GETDS 
RESER LDB "07"      "RES" LIST-ACCESS ERROR: "DS07".
      JMP GETDS 
* 
GETDS LDA "DS"      GET FIRST HALF OF ERROR MESSAGE: "DS".
* 
PASER DST MSGBF     SAVE TOTAL ERROR MESSAGE. 
* 
      JSB CLNUP     GO TO CLEAN UP BEFORE EXITING. (A)="DS".
* 
PSER1 LDB MSGAD     <B> POINTS TO ERROR MESSAGE ADDRESS.
      LDA CONWD     GET ERROR-RETURN FLAG.
      ELA           POSITION TO <E> FOR TESTING.
      LDA D3KMS     GET ERROR ADDRESS 
      SEZ           ABORT OR RETURN TO CALLER?
      JSB D$ABT       ABORT! - NO RETURN. 
      LDA N1          SET CONDITION CODE TO CCL.
      STA ICCC
      DLD MSGBF       GET ERROR CODES AND RETURN TO 
      JMP D3KMS,I      THE CALLER AT ERROR-RETURN POINT.
      SPC 3 
* 
* OUTPUT ERROR WAS DETECTED 
* 
OERR  NOP 
      DST MSGBF     SAVE ERROR MESSAGE. 
      STA OEFLG     SET OUTPUT ERROR FLAG.
      JMP OERR,I    RETURN. 
      SKP 
*    SUBROUTINE TO HANDLE ABORT MESSAGES. 
* 
*    A REG = SUSPEND OR ABORT ADDRESS.
*    B REG = ADDRESS OF 4 CHAR ERROR MESSAGE. 
*    JSB D$ABT     (DOES NOT RETURN TO CALLER)
* 
D$ABT NOP 
      STA ERCD      SAVE ABORT ADDRESS. 
      DLD B,I       GET ERROR MESSAGE.
      DST MSG       SAVE ERROR MESSAGE. 
* 
      JSB CNUMO     CONVERT ERROR ADDRESS TO OCTAL. 
      DEF *+3 
      DEF ERCD
      DEF ERCD
* 
      LDA 1717B     GET ADDRESS OF ID SEGMENT.
      ADA D12       GET TO NAME ADDRESS.
      STA TEMP      SAVE ADDRESS FOR XFER.
      JSB .DFER     MOVE NAME INTO AREA.
MSGA  DEF AMSG      DESTINATION ADDRESS.
      DEF TEMP,I    SOURCE ADDRESS. 
* 
      JSB .DFER     MOVE NAME FOR DS ERROR MESSAGE. 
      DEF PNAM1     DESTINATION ADDRESS.
      DEF TEMP,I    SOURCE ADDRESS. 
      LDB MSGA      MOVE A SPACE LAST CHAR OF NAME. 
      ADB D2
      LDA B,I 
      AND UP377 
      IOR B40 
      STA B,I       SAVE IT AGAIN.
      STA LNAM      SAVE FOR LINE 1 ERROR.
* 
      LDA D$LOG     SET "ECHO INPUT" &
      IOR B600       "PRINT COL 1" BITS.
      STA CNWRD 
      JSB EXEC      SEND 2-LINE ERROR/ABORT MESSAGE.
      DEF *+5 
      DEF D2
      DEF CNWRD     LOG DEVICE GIVEN FOR HELLO CALL.
      DEF MSG 
      DEF D18 
* 
      JSB EXEC      TERMINATION REQUEST.
      DEF *+2       NO RETURN.
      DEF D6
      SPC 1 
MSG   ASC 3,DS
PNAM1 ASC 2,
LNAM  ASC 1,
ERCD  ASC 3,
      BYT 15,12     CR/LF 
AMSG  ASC 8,      ABORTED 
D6    DEC 6 
B40   OCT 40
D12   DEC 12
D18   DEC 18
UP377 OCT 177400
      SPC 3 
* 
* FUNCTION FOR RETRIEVAL OF CONDITION CODE. 
* 
ICC   NOP 
      LDA ICC,I     SET RETURN ADDRESS. 
      STA ICC 
      LDA ICCC      FETCH CONDITION CODE. 
      JMP ICC,I     RETURN. 
      SPC 3 
* 
* SUBROUTINE TO STORE CURRENT PROCESS NUMBER. 
* 
*      JSB PRCNM
*      DEF *+2
*      DEF ISMP     NEGATIVE PROCESS NUMBER.
* 
ISMP  NOP 
PRCNM NOP 
      JSB .ENTR     GET ADDRESS OF PROCESS NUMBER.
      DEF ISMP
* 
      LDA ISMP,I    GET NEGATIVE PROCESS NUMBER.
      CMA,INA       MAKE POSITIVE.
      STA D$SMP     STORE AS CURRENT PROCESS #. 
* 
      JSB LOGLU     GET TERMINAL'S LU.
      DEF *+2 
      DEF TEMP
      STA D$LOG     SAVE AS $STDLIST AND
      STA D$INP      $STDIN DEVICES.
* 
      JMP PRCNM,I   RETURN. 
      SPC 3 
* 
* SUBROUTINE TO LOAD FROM ALTERNATE MAP.
* 
LODWD NOP 
MODI2 LDA B,I       (RSS IF DMS SYSTEM) 
      JMP LODWD,I 
      XLA B,I       LOAD WORD FROM ALTERNATE MAP. 
      JMP LODWD,I 
* 
* SUBROUTINE TO STORE INTO ALTERNATE MAP. 
* 
STRWD NOP 
      JSB $LIBR 
      NOP 
MODI3 STA B,I       (RSS IF DMS SYSTEM) 
      JMP OUT 
      XSA B,I       STORE WORD INTO ALTERNATE MAP.
OUT   JSB $LIBX 
      DEF STRWD 
      SKP 
* 
* INITIALIZE BUFFER STUFFING ROUTINES.
*  CALLING SEQUENCE: LDA <ADDRESS OF 1ST PARAM> 
*                    JSB D$INI
* 
D$INI NOP 
      STA U.PTR     PTR TO 1ST USER PARAM ADDR. 
      LDA D$RQB 
      STA P.PTR     PTR TO REQUEST BUFFER.
* 
      STA TEMP      CLEAR REQUEST BUFFER. 
      LDB RQSIZ 
      CLA 
      STA TEMP,I
      ISZ TEMP
      INB,SZB 
      JMP *-3 
      JMP D$INI,I   RETURN. 
* 
* STORE A-REG IN REQUEST BUFFER.
* 
D$STW NOP 
      LDB RQSIZ     CHECK IF STILL ROOM IN BUFFER.
      CMB,INB 
      ADB D$RQB 
      CPB P.PTR 
      JMP D$STW,I   REQUEST BUFFER OVERFLOW!
* 
      STA P.PTR,I   STORE WORD. 
      ISZ P.PTR     BUMP BUFFER POINTER.
      LDA BYTCT 
      ADA D2        INCREMENT BYTE COUNTER. 
      STA BYTCT 
      JMP D$STW,I   RETURN. (A) = BYTE COUNT. 
* 
* STORE N PARAMETERS IN REQUEST BUFFER: (A) = -N. 
* 
D$PRM NOP 
      STA TEMP      SAVE NEG. # PARAMS. 
NPM   LDA U.PTR,I   GET ADDR OF NEXT PARAM. 
      SZA           IF NOT SPECIFIED, STORE ZERO. 
      LDA A,I 
      JSB D$STW     STORE VALUE IN REQ BUFFER.
      ISZ U.PTR 
      ISZ TEMP
      JMP NPM       LOOP TILL DONE. 
      JMP D$PRM,I   RETURN. (A) = BYTE COUNT. 
* 
* STORE N-WORD PARAM IN REQUEST BUFFER: (A) = -N. 
* 
D$NWD NOP 
      STA TEMP      SAVE NEG. WORD COUNT. 
      LDB U.PTR,I   GET ADDR OF PARAM.
      STB TEMP1 
* 
NWD   LDA TEMP1     IF PARAM NOT SPECIFIED, 
      SZA            STORE ZERO.
      LDA TEMP1,I   GET NEXT WORD OF PARAM. 
      JSB D$STW     STORE IN REQ BUFFER.
      LDA TEMP1 
      SZA 
      ISZ TEMP1 
      ISZ TEMP
      JMP NWD 
      ISZ U.PTR 
      JMP D$NWD,I   RETURN. (A) = BYTE COUNT. 
* 
* STORE ASCII STRING IN REQUEST BUFFER. 
* 
D$ASC NOP 
      STA ADDR      SAVE ADDR OF STRING.
      STB TEMP      SAVE MAX # WORDS (NEG.).
      SZA,RSS 
      JMP ASC2      QUIT IF NOT SPECIFIED.
* 
      CLA 
      CPB N25       SET FLAG IF ONLY DELIMITER
      CCA            IS A PERIOD (FORMMSG). 
      STA DMFLG 
* 
ASC1  LDA ADDR,I    GET NEXT 2 CHARACTERS.
      SZA,RSS 
      JMP ASC2      GET OUT IF ZERO WORD. 
      JSB D$STW     STORE IN REQUEST BUFFER.
      LDA ADDR,I
      ALF,ALF       LOOK FOR DELIMITER. 
      AND B377
      JSB DELIM 
      JMP ASC2      LEFT BYTE WAS DELIMITER.
      LDA ADDR,I
      AND B377
      JSB DELIM 
      JMP ASC2      RIGHT BYTE WAS DELIMITER. 
* 
      ISZ ADDR      NO DELIMITER ENCOUNTERED. 
      ISZ TEMP
      JMP ASC1      LOOP TILL MAXIMUM REACHED.
* 
      LDA BLNKS     LIMIT REACHED. STORE BLANKS.
      JSB D$STW 
      JMP D$ASC,I   RETURN. (A) = BYTE COUNT. 
* 
ASC2  LDA BYTCT 
      JMP D$ASC,I   RETURN. (A) = BYTE COUNT. 
* 
* 
DELIM NOP           CHECK IF (A) = DELIMITER. 
      STA TEMP1 
      LDB DMFLG 
      INB,SZB 
      JMP DLM1
      CPA PEROD     STRING IS FORMS MESSAGE.
      JMP DELIM,I    CHARACTER IS A PERIOD. 
      JMP NODLM      LET ANYTHING ELSE THROUGH. 
* 
DLM1  CPA SLASH     NOT FORMMSG STRING. 
      JMP NODLM      LET SLASH THROUGH. 
      CPA PEROD 
      JMP NODLM      LET PERIOD THROUGH.
* 
      ADA NB60       LET 0-9 THROUGH. 
      SSA 
      JMP DELIM,I 
      ADA NB12
      SSA 
      JMP NODLM 
      ADA B72 
* 
      ADA NEGA       LET A-Z THROUGH. 
      SSA            ANYTHING ELSE IS A DELIMITER.
      JMP DELIM,I 
      ADA NGMAX 
      SSA,RSS 
      JMP DELIM,I 
* 
NODLM ISZ DELIM     DELIMITER NOT REACHED.
      JMP DELIM,I 
* 
* STORE ZERO IN NEXT N WORDS OF REQUEST BUFFER. 
*  (A) = NEGATIVE # WORDS.
* 
D$ZRO NOP 
      STA TEMP
ZRO   CLA 
      JSB D$STW 
      ISZ TEMP
      JMP ZRO 
      JMP D$ZRO,I 
* 
* COMPUTE AND STORE REQUEST WORD COUNT IN FIRST BYTE OF REQUEST.
* 
D$WDC NOP 
      LDA RQBUF     FIRST WORD OF REQUEST BUFFER. 
      AND B377      CLEAR WORD COUNT BYTE.
      LDB BYTCT     BYTE COUNT FROM REQUEST.
      INB 
      CLE,ERB       MAKE WORD COUNT.
      ADB D8        ADD FIXED FORMAT LENGTH.
      BLF,BLF       MOVE TO LEFT BYTE.
      IOR B         MERGE WITH MESSAGE CLASS. 
      STA RQBUF     STORE FIRST WORD. 
      JMP D$WDC,I   RETURN. 
      SKP 
* 
* INITIALIZE REPLY VALUE PASSAGE SUBROUTINES. 
* 
D$IPM NOP 
      STA U.PTR     1ST RETURN PARAM ADDR IN CALL.
      STB P.PTR     1ST RETURN VALUE IN REPLY BUFFER. 
      JMP D$IPM,I 
* 
* STORE A-REG IN NEXT USER PARAMETER. 
* 
D$APM NOP 
      LDB U.PTR,I   GET PARAM ADDRESS.
      SZB           SKIP STORE IF PARAM NOT SPECIFIED.
      STA B,I       RETURN THE PARAM VALUE. 
      ISZ U.PTR     BUMP TO NEXT PARAM ADDRESS. 
      JMP D$APM,I 
* 
* PASS N M-WORD RETURN PARAMS TO CALLER.
*  (A) = -N, (B) = -M 
* 
D$NPM NOP 
      STA TEMP      SAVE NEG. # PARAMS. 
      STB TEMP2     SAVE NEG. # WORDS PER PARAM.
NPM1  LDB U.PTR,I   GET ADDR OF NEXT PARAM. 
      SZB,RSS 
      JMP NPM3      IGNORE OF PARAM NOT SPECIFIED.
* 
      LDA TEMP2 
      STA TEMP1 
NPM2  LDA P.PTR,I   GET NEXT WORD OF PARAM VALUE. 
      STA B,I       PASS TO CALLER. 
      INB           BUMP TO NEXT WORD OF PARAMETER. 
      ISZ P.PTR     BUMP TO NEXT WORD IN REPLY BUFFER.
      ISZ TEMP1     BUMP PARAM SIZE COUNTER.
      JMP NPM2      LOOP FOR M WORDS. 
* 
NPM3  ISZ U.PTR     BUMP TO NEXT PARAM ADDRESS. 
      ISZ TEMP      BUMP # PARAMS COUNTER.
      JMP NPM1      LOOP FOR N PARAMS.
      JMP D$NPM,I 
* 
* PASS SINGLE N-WORD PARAM TO USER. 
* 
D$SPM NOP 
      STA B         B = NEG WORD COUNT. 
      CCA           A = ONE PARAM.
      JSB D$NPM     PASS THE N-WORD PARAM.
      JMP D$SPM,I 
      SKP 
* 
* CONSTANTS AND WORKING STORAGE.
* 
B20   OCT 20
B21   OCT 21
B22   EQU D18 
B25   OCT 25
B72   OCT 72
B77   OCT 77
B377  OCT 377 
HB377 BYT 377,0 
D0    DEC 0 
D1    DEC 1 
D2    DEC 2 
D3    DEC 3 
D4    DEC 4 
D5    DEC 5 
D7    DEC 7 
D8    DEC 8 
D13   DEC 13
N1    DEC -1
N3    DEC -3
N4    DEC -4
NB12  OCT -12 
N25   DEC -25 
N40   DEC -40 
NB60  OCT -60 
N80   DEC -80 
SD1   DEF 1,I 
SD2   DEF 2,I 
SD3   DEF 3,I 
RCODE NOP 
D$SMP OCT 0         SESSION MAIN PROCESS NUMBER.
D$LOG OCT 1         LU OF LOG DEVICE. 
D$INP OCT 401       LU OF INPUT DEVICE. 
CCE   OCT 1000
D$ERR BSS 2 
BLNKS ASC 1,
PEROD OCT 56
SLASH OCT 57
NEGA  OCT -101
NGMAX OCT -33 
XEQT  EQU 1717B 
MSGAD DEF MSGBF 
MSGBF ASC 2,DS00    ERROR MESSAGE BUFFER. 
"00"  ASC 1,00
"01"  ASC 1,01
"05"  ASC 1,05
"06"  ASC 1,06
"07"  ASC 1,07
"DS"  ASC 1,DS
* 
INBUF NOP 
APEND NOP 
U.PTR NOP 
P.PTR NOP 
TEMP  NOP 
TEMP1 NOP 
TEMP2 NOP 
ADDR  NOP 
BRFLG NOP           BREAK FLAG
DMFLG NOP 
OEFLG NOP           OUTPUT ERROR FLAG 
BIT13 OCT 20000 
BIT14 OCT 40000 
BIT15 OCT 100000
CLASN NOP 
BUFL  NOP 
ICCC  NOP 
LCGW  OCT 40006     GLOBAL RN LOCK/CLEAR/WAIT/NO-ABORT. 
LGW   OCT 40002     GLOBAL RN LOCK/WAIT/NO ABORT. 
CLS20 DEF 20,I      CLASS READ-WRITE (NO ABORT).
CLS19 DEF 19,I      CLASS CONTROL - NO ABORT. 
CLS21 DEF 21,I      CLASS GET - NO ABORT. 
* 
PRFLG NOP           PROMPT FLAG.
OLDLN NOP           LENGTH OF LAST WRITE. 
ORCRD BSS 40        LAST WRITTEN BUFFER.
@ORCD DEF ORCRD 
* 
SEQ#  NOP           SEQ # STORAGE FOR REPLY VALIDATION. 
* 
D$RQB DEF RQBUF 
RQSIZ ABS -L        SIZE OF REQ BUFFER (NEG WORDS). 
RQBUF BSS L         REQUEST BUFFER. 
BYTCT EQU RQBUF+7   BYTE COUNT WORD (N).
* 
      BSS 0          ****** SIZE OF D3KMS ******
* 
      END