ASMB,Q,C
      HED D3KMS * (C) HEWLETT-PACKARD CO. 
      NAM D3KMS,7 91750-1X064 REV.2013 800408 MEF 
      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 
*  PRIMARY ENTRY POINTS:
      ENT D3KMS,PRCNM,ICC,D$ABT 
*  SUBROUTINES TO MANAGE APPENDAGE: 
      ENT D$INI,D$STW,D$PRM,D$NWD,D$ASC,D$ZRO 
      ENT D$IPM,D$NPM,D$SPM 
*  GLOBAL DATA WORDS: 
      ENT D$SMP,D$LOG,D$INP,D$BRK,D$CTY,D$ECH,D$ERR,D$TAG 
      SPC 1 
      EXT .ENTR,.DFER,.MVW,$OPSY
      EXT EXEC,REIO,IFBRK,IFTTY,LUTRU,LOGLU,RNRQ,CNUMO
      EXT #LDEF,#QRN,#TBRN,#RSAX,#QXCL,#MSTO
      EXT D$3BF,D$RQB,D$BSZ,D$MXR 
      SPC 2 
      UNL           NEXT 5 LINES ARE FOR PRODUCTION ENGINEERING 
*  NAME: D3KMS
*SOURCE: 91750-18064
* RELOC: 91750-1X064
*  PGMR: DMT
      LST 
**************************     D3KMS    ************************* 
*                                                               * 
*     SOURCE: 91750-18064                                       * 
*                                                               * 
*     BINARY: 91750-1X064                                       * 
*                                                               * 
*     PROGRAMMER: JIM HARTSELL                                  * 
*                                                               * 
*     AUGUST 11, 1975                                           * 
*                                                               * 
*---------------------------------------------------------------* 
*                                                               * 
*        MODIFIED BY DMT BEGINNING OCTOBER 30, 1978             * 
*        FOR DS/1000 ENHANCEMENTS AND SESSION COMPATIBILITY     * 
*                                                               * 
***************************************************************** 
      SPC 3 
A     EQU 0 
B     EQU 1 
XEQT  EQU 1717B 
      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 #MAST SUBROUTINE. 
* 
* D3KMS BLOCKS THE REQUESTS AND DATA INTO PROPERLY SIZED CHUNKS FOR 
* TRANSMISSION TO QUEX. D3KMS'S BUFFER AND THE BUFFER SIZE ARE DEFINED
* IN THE APPENDED MODULE D3KBF. 
* 
* IT IS THE RESPONSIBILITY OF THE ROUTINE CALLING D3KMS TO SET
*     D$3BF         TO THE DS/3000 CLASS
*     D$3BF+2       TO THE DS/3000 STREAM 
* AND ALL PARAMETERS THAT ARE PASSED IN THE APPENDAGE. THE APPENDAGE
* PARAMETERS AND BYTE COUNT WORD (HEADER WORD 7) ARE SET UP BY THE
* CALLER USING THE FOLLOWING SUBROUTINES: 
*         D$INI  D$STW  D$PRM  D$NWD  D$ALC  D$ZRO
*  (THESE ARE EXPLAINED IN THE LISTING).
* 
* D3KMS CALLING SEQUENCE: 
*       JSB D3KMS 
*       DEF <RETURN>
*       DEF CONWD          CONTROL WORD (SEE BELOW).
*       DEF SNDBF          "SEND" BUFFER [OPTIONAL] 
*       DEF SNDLN          "SEND" LENGTH [OPTIONAL] 
*       DEF RCVBF          "RECEIVE" BUFFER [OPTIONAL]
*       DEF RCVLN          "RECEIVE" LENGTH [OPTIONAL]
*     <ERROR RETURN>       RETURN HERE UPON ERROR DETECTION.
*     <NORMAL RETURN>      NORMAL RETURN. 
* 
*  IF NEITHER SEND NOR RECEIVE DATA IS EXPECTED, CALL WITH
*       JSB D3KMS 
*       DEF *+2 
*       DEF CONWD 
* 
*  IF SEND BUT NOT RECEIVE DATA IS EXPECTED, CALL WITH
*       JSB D3KMS 
*       DEF *+4 
*       DEF CONWD 
*       DEF SNDBF 
*       DEF SNDLN     <+WORDS OR -BYTES>
*    (SNDBF AND SNDLN WILL GENERALLY BE USER PARAMETERS, INDIRECT.) 
* 
*  IF RECEIVE BUT NOT SEND DATA IS EXPECTED, CALL WITH
*       JSB D3KMS 
*       DEF *+6 
*       DEF CONWD 
*       DEF 0 
*       DEF 0 
*       DEF RCVBF 
*       DEF RCVLN     <+WORDS OR -BYTES>
* 
      SPC 2 
* IN CONWD
*   BIT 15    - ERROR-RETURN FLAG (NO-ABORT BIT). 
*   BIT 14    - LONG 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. 
*   "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.
*                   B-REG = NUMBER OF BYTES READ. 
      SPC 3 
* 
*  USER-CALLABLE ENTRY POINTS:
* 
      SPC 1 
*  INTEGER FUNCTION ICC: RETURNS CONDITION CODE FROM LAST 3000 CALL.
* 
*   ICC = -1 IF CCL (01) CONDITION CODE (A LA HP3000) FOR EVERY REPLY.
*       =  0 IF CCE (10)  " 
*       =  1 IF CCG (00)  " 
      SPC 1 
*  SUBROUTINE PRCNM: SET SESSION NUMBER FROM "FATHER."
* 
*      CALL PRCNM(SESNO)
*  WHERE SESNO IS THE NEGATIVE SESSION NUMBER FROM FATHER'S HELLO.
      SKP 
*** OFFSETS INTO DS/3000 BUFFER *** 
BUF   EQU D$3BF 
CLS   EQU 0         CLASS WORD
STR   EQU 2         STREAM WORD 
PRC   EQU 4         PROCESS # WORD
SEQ   EQU 5         RTE SEQ # WORD
BYT   EQU 7         BYTE COUNT WORD 
APN   EQU 8         FIRST WORD OF APENDAGE
      SPC 2 
* FIRST ENTRY. CLEAR PARAMETERS IN CASE SOME ARE NOT PROVIDED, THEN 
*  MAKE "DUMMY" ENTRY TO PICK THEM UP AT "BEGIN." 
D3KMS NOP 
      CLA           CLEAR ADDRESSES.
      STA CONWD 
      STA SNDBF 
      STA SNDLN 
      STA RCVBF 
      STA RCVLN 
      LDA D3KMS     SET ADDRESS 
      STA RETRN      FOR .ENTR
      JMP BEGIN       THEN CALL.
      SPC 1 
CONWD NOP           CONTROL WORD ADDRESS. 
SNDBF NOP           SEND BUFFER 
SNDLN NOP           SEND LENGTH 
RCVBF NOP           RECEIVE BUFFER
RCVLN NOP           RECEIVE LENGTH
RETRN NOP 
* 
BEGIN JSB .ENTR     OBTAIN DIRECT ADDRESSES 
      DEF CONWD      FOR PARAMETERS & RETURN POINT. 
* 
      CLA 
      LDA SNDLN,I   GET SEND LENGTH.
      SSA           CHECK SIGN--
      CMA,INA,RSS     NEG: MAKE POSITIVE
      CLE,ELA         POS: DOUBLE 
      STA SNDLN     SAVE BYTE LENGTH AS LOCAL VAR.
* 
      CLA 
      LDA RCVLN,I   GET MAX RECEIVE LENGTH. 
      SSA,RSS       CHECK SIGN--
      JMP COMPL 
      CMA,INA         NEG: MAKE POS 
      INA                  WORD COUNT.
      CLE,ERA 
COMPL CMA,INA       MAKE NEGATIVE WORD COUNT
      STA RCVLN      AND SAVE AS LOCAL VARIABLE.
* 
      CLB           CLEAR 
      STB BRFLG      BREAK FLAG AND 
      STB OEFLG       OUTPUT ERROR FLAG 
      STB PRFLG        AND PROMPT FLAG
      STB RTNLN         AND # BYTES RETURNED
      STB BLK#1          AND FIRST BLOCK FLAG 
      STB PCLSF           AND PCLOSE FLAG.
* 
      LDA BUF+CLS   SAVE THE
      ALF,ALF        CLASS &
      IOR BUF+STR     STREAM. 
      STA OCLST 
      CPA C7S21     IF CLASS 7 & STREAM 21, 
      RSS            CHECK FOR PCLOSE.
      JMP LDSZ
      LDA BUF+BYT      IF BYTE COUNT
      CPA D12           IS 12, SET
      STA PCLSF          PCLOSE FLAG. 
* 
*  USE MINIMUM OF D$BSZ (CONFIGURED LINE SIZE, SET BY QUEX) AND 
*  D$MXR (ACTUAL BUFFER SIZE APPENDED) FOR SENDING/RECEIVING DATA.
*  IF D$BSZ > D$MXR, THE 3000 MAY SEND TOO MUCH ON A READ REQUEST.
* 
LDSZ  LDA D$BSZ     SUBTRACT D$BSZ
      CMA,INA        FROM D$MXR. IF 
      ADA D$MXR       RESULT > 0 USE D$BSZ. 
      LDB D$BSZ        IF < 0, USE D$MXR. 
      SSA 
      LDB D$MXR 
      STB BUFSZ     SAVE BUFFER SIZE LOCALLY. 
      CMB,INB       CALCULATE NEGATIVE
      STB NBFSZ      FOR FUTURE USE.
* 
      LDA $OPSY     IS THIS A MAPPED SYSTEM?
      RAR,SLA 
RSSI  RSS           YES.
      JMP NEWRQ     NO. 
      LDB RSSI      GET "RSS" INSTRUCTION.
      STB MODI2     MODIFY TO DO CROSS-MAP LOAD.
* 
* 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 * 
* 
*  CLEAR WORDS 1, 3, AND 6 OF HEADER. 
      CLA 
      STA D$3BF+1 
      STA D$3BF+3 
      STA D$3BF+6 
* 
* ADD INPUT LU TO REQUEST AS "FROM PROCESS #."
* 
      JSB LUTRU     GET "REAL" INPUT
      DEF *+3        LU NUMBER. 
      DEF D$INP 
      DEF TEMP
      LDA TEMP      STORE INPUT LU IN 
      AND B377       "FROM PROCESS #".
      ALF,ALF 
      STA BUF+PRC 
* 
* USE MPE PROCESS NUMBER RETRIEVED FROM "HELLO" AS THE
* "TO PROCESS #". IF ZERO, THIS MUST BE A HELLO COMMAND.
* 
      LDA D$SMP     GET SESSION NUMBER. 
      AND B377
      IOR BUF+PRC 
      STA BUF+PRC 
      LDB OCLST 
      CPB C6S20     IF NOT HELLO, 
      JMP SETWD 
      AND B377
      SZA,RSS         AND SESSION # IS ZERO,
      JMP ILRQ          IT IS AN ILLEGAL REQUEST. 
* 
*  VERIFY THAT SMP # IS GOOD BY SEARCHING PNL.
SEND  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 D5        POINT TO SMP WORD.
      JSB LODWD     LOAD. 
      CPA D$SMP     OURS? 
      JMP SETWD       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 
      SPC 1 
* 
SETWD JSB STWDC     SET WORD COUNT IN CLASS WORD. 
* 
*  MOVE "SEND" DATA, IF NECESSARY.
* 
      CLA           CLEAR MOVE
      STA MVLEN      LENGTH.
      LDA BUF+CLS   CALCULATE NUMBER
      ALF,ALF        OF WORDS IN
      AND B377        HEADER & APPENDAGE. 
      STA H&ALN 
      LDB SNDLN     IF NO DATA
      SZB,RSS        TO SEND, 
      JMP STBLN        SKIP THE MOVE. 
      ADA NBFSZ     CALCULATE NEG NUMBER
      STA SPCAV      WORDS LEFT IN BUFFER.
      INB           SUBTRACT FROM NUM OF
      CLE,ERB        WORDS TO SEND. 
      ADA B 
      SZA 
      SSA           IF A-REG NEGATIVE,
      JMP LENOK      ENTIRE BUFFER WILL FIT.
* 
*  SET UP FOR CONTINUATION WRITE. 
* 
      LDA SPCAV     SET THE MOVE
      CMA,INA        LENGTH TO
      STA MVLEN       SPACE AVAILABLE.
      CLE,ELA       ADD # BYTES 
      STA TEMP       TO BYTE COUNT. 
      ADA BUF+BYT 
      STA BUF+BYT 
      LDA TEMP      SUBTRACE # OF 
      CMA,INA        BYTES MOVED
      ADA SNDLN       FROM TOTAL
      STA SNDLN        LENGTH.
      LDA BUF+STR   SET CONTINUATION
      AND B377       BIT IN STREAM
      IOR BIT13       WORD. MAKE SURE 
      STA BUF+STR      OTHERS AREN'T. 
      JMP MVDAT     GO MOVE DATA. 
* 
*  ENTIRE BUFFER FITS--NO CONTINUATION. 
* 
LENOK STB MVLEN     SET MOVE LENGTH.
      LDA BUF+BYT   ADD # BYTES 
      ADA SNDLN      TO BYTE COUNT
      STA BUF+BYT     IN HEADER.
      CLA           SET REMAINING 
      STA SNDLN      LENGTH TO 0. 
      LDA BUF+STR   INSURE
      AND B377       UNWANTED BITS
      STA BUF+STR     ARE NOT SET.
* 
*  ALL SET TO MOVE "SEND" DATA. 
* 
MVDAT LDA SNDBF     SOURCE ADDR.
      LDB D$RQB 
      ADB H&ALN     DESTINATION.
      JSB .MVW      MOVE THE
      DEF MVLEN      WORDS. 
      NOP 
      STA SNDBF     UPDATE SOURCE PNTR. 
* 
*  SET WORD LENGTH OF CLASS I/O WRITE TO QUEX.
* 
STBLN LDA BUF+BYT   GET BYTE COUNTER. 
      INA 
      CLE,ERA       MAKE WORD COUNT.
      ADA D8        ADD FIXED FORMAT LENGTH.
      STA BUFL      STORE REQUEST LENGTH. 
* 
* WAIT FOR AVAILABILITY OF LIST-ENTRY SPACE IN "RES"; ADD NEW ENTRY.
* 
SEND1 LDA #QXCL     GET QUEX I/O CLASS. 
      SZA,RSS 
      JMP NINIT     DS/3000 NOT INITIALIZED.
      SSA 
      JMP NINIT     DS/3000 DISCONNECTED. 
* 
      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
* 
      LDA #MSTO     SET UP
      IOR BIT14      TIMEOUT
      STA TEMP1       WORD. 
* 
      JSB #RSAX     GO TO "RES" ACCESS ROUTINE. 
      DEF *+6 
      DEF D2        ADD A MASTER ENTRY. 
      DEF TEMP      CLASS # AND TIMEOUT FLAG. 
      DEF D0        DUMMY M.A. SEQ #. 
      DEF D0        DUMMY DESTINATION NODE. 
      DEF TEMP1     TIMEOUT WORD. 
      SSB           ANY ERRORS? 
      JMP RESER     * ERROR: "DS07" (NOT LIKELY) *
* 
      STA BUF+SEQ   STORE SEQ # IN REQUEST. 
      STA SEQ#      SAVE LOCALLY. 
* 
      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 HP 3000 BY WRITING IT TO THE QUEX I/O CLASS 
* 
CLSWR JSB EXEC
      DEF *+8 
      DEF CLS20 
      DEF D0
      DEF D$3BF 
      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 * 
* 
      JMP WAIT      NO. 
* 
* ISSUE A CLASS GET TO USER'S CLASS TO WAIT FOR A REPLY.
* USER WILL BE SUSPENDED UNTIL REPLY ARRIVES. 
* 
WAIT  LDA BUFSZ 
      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 D$3BF     REPLY ADDRESS.
      DEF BUFL      REPLY LENGTH. 
      JMP PASER     * RTE ERROR: MESSAGE IN A & B * 
      STB TEMP      SAVE T/O INDICATOR. 
* 
      JSB #RSAX     RELEASE 
      DEF *+3        MASTER 
      DEF D6          T.C.B.
      DEF SEQ#
* 
* CHECK FOR PROPER REPLY. 
* 
      LDB TEMP
      SZB,RSS       CHECK FOR ZERO REPLY LENGTH.
      JMP MTOER     YES. GO PROCESS TIMEOUT ERROR.
* 
      LDA BUF+STR   CHECK REJECT BIT. 
      RAL 
      SSA 
      JMP ILRQ      REQUEST REJECTED. 
* 
      SPC 1 
* GO CHECK IF A $STDLIST OR $STDIN WAS RECEIVED.  IF NOT, 
* CONTROL WILL BE RETURNED.  IF YES, 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.
* 
      LDA BLK#1     IF FIRST BLOCK IN RETURN, 
      SZA 
      JMP CKNOR 
      ISZ BLK#1       SET THE FLAG. 
      LDA BUF+APN     SAVE STATUS WORD
      STA STATS        FROM APPENDAGE.
* 
      LDA OCLST     IF IT'S THE 
      CPA C4S22      FIRST PREAD
      RSS             REPLY,
      JMP CKNOR 
      LDA D$RQB        SAVE TAG 
      ADA D13           WORDS IN
      LDB D$TAG          TEMPORARY
      JSB .MVW            AREA. 
      DEF D20 
      NOP 
* 
*  MOVE "RECEIVE" DATA, IF NECESSARY. 
* 
CKNOR LDB RCVBF     IF NO RETURN
      SZB,RSS        DATA EXPECTED, 
      JMP CKCNT        SKIP THE MOVE. 
**** NOTE: B-REG CONTAINS DESTINATION ADDRESS FOR MOVE! *** 
      LDA BUF+CLS   CALCULATE NUM 
      ALF,ALF        OF WORDS IN
      AND B377        HEADER &
      STA H&ALN        APPENDAGE. 
      ADA N8        CALCULATE 
      CLE,ELA        NUMBER OF
      CMA,INA         DATA BYTES
      ADA BUF+BYT      RETURNED.
      STA TEMP
      INA           CONVERT TO
      CLE,ERA        WORDS. 
      SZA,RSS       IF ZERO,
      JMP CKCNT      SKIP MOVE. 
      STA MVLEN     SAVE MOVE LENGTH. 
      ADA RCVLN     IF MOVE WOULD 
      SZA            STAY WITHIN
      SSA             LIMIT,
      JMP UPRTN         READY TO DO IT. 
* 
*  MORE DATA RETURNED BY 3000 THAN REQUESTED
* 
      LDA RCVLN     IF NO ROOM LEFT 
      SZA,RSS        IN USER'S BUFFER,
      JMP CKCNT        SKIP THE MOVE. 
      CMA,INA       MAKE POSITIVE WORDS.
      STA MVLEN     SET MOVE LENGTH.
      CLE,ELA       CONVERT TO
      STA TEMP       BYTES & SAVE.
      CLA 
* 
UPRTN STA RCVLN     UPDATE # WORDS IN USER BUF. 
      LDA RTNLN     UPDATE
      ADA TEMP       RETURN LENGTH
      STA RTNLN       COUNTER.
* 
      LDA D$RQB 
      ADA H&ALN     SOURCE ADDRESS. 
**** NOTE: B-REG ALREADY LOADED WITH DESTINATION ADDR. ***
      JSB .MVW      MOVE DATA 
      DEF MVLEN      TO USER. 
      NOP 
      STB RCVBF     UPDATE RECEIVE POINTER. 
* 
CKCNT LDA BUF+STR   IF CONTINUATION 
      AND BIT13      BIT NOT SET, 
      SZA,RSS 
      JMP EXIT         NO MORE DATA.
* 
      LDA BUF+STR 
      ELA,CLE,ERA   CLEAR REPLY BIT.
      STA BUF+STR 
      LDA BUF+PRC  REVERSE
      ALF,ALF       PROCESS 
      STA BUF+PRC    NUMBERS. 
      LDA OCLST 
      CLB           APPENDAGE LENGTH IS 
      CPA C4S23      0 FOR ALL EXCEPT 
      LDB D10         PWRITE (THEN 10 BYTES). 
      STB BUF+BYT 
      JMP SEND      SEND NEXT BLOCK.
      SPC 1 
* 
* DE-ALLOCATE THE USER'S CLASS NUMBER.
* 
EXIT  JSB CLNUP     GO CLEAN UP BEFORE EXIT.
* 
* STORE CONDITION CODE IN ICC AND RETURN TO 
* CALLER WITH (A) = STATUS WORD.
*             (B) = NO BYTES RETURNED.
* 
      LDB OEFLG     WAS THERE AN OUTPUT ERROR?
      SZB 
      JMP PSER1      YES! 
      LDA BUF+APN   GET STATUS WORD.
      LDB RCVBF     IF RECEIVE BUFFER WAS 
      SZB,RSS        EXPECTED, STATS HAS
      STA STATS       ALREADY BEEN SET. 
      LDA STATS 
      ALF,ALF 
      AND D3        IF CC IS:   SET ICC TO: 
      CPA D1
      CCB              01  (CCL)   -1 
      CPA D2
      CLB              10  (CCE)    0 
      SZA,RSS 
      CLB,INB          00  (CCG)   +1 
      STB ICCC
* 
      LDA STATS     GET RETURN STATUS WORD. 
      LDB RTNLN     GET TOTAL NUMBER OF BYTES RETURNED. 
      ISZ RETRN     SET EXIT POINTER FOR NORMAL RETURN. 
      JMP RETRN,I   RETURN. 
      SPC 3 
BUFSZ NOP           BUFFER SIZE 
NBFSZ NOP           NEGATIVE OF BUFSZ 
      SKP 
* 
* SUBROUTINE TO PROCESS $STDLIST OR $STDIN "REQUESTS" THAT
* MAY HAVE BEEN RECEIVED AS A "REPLY" FROM THE 3000.
* 
PRTRD NOP 
      LDA BUF+CLS 
      AND B377      CHECK FOR MESSAGE CLASS 5 
      CPA D5         ($STDLIST, $STDIN, OR FCONTROL). 
      RSS 
      JMP PRTRD,I   NOT PRINT/READ. RETURN. 
      LDA BUF+STR 
      SSA           CHECK IF IT IS A REQUEST. 
      JMP PRTRD,I   NO... REPLY, SO LET IT THROUGH. 
* 
      LDA BUF+STR   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 BUF+APN+1 CHECK FOR UNRECOGNIZED CONTROL CHAR:
      ADA N12 
      SSA 
      JMP SETPR        < 12: NO GOOD. 
      STA TEMP
      ADA N6
      SSA 
      JMP USTBL        12 TO 17: USE TABLE. 
* 
      LDA BUF+APN+1 CHECK FOR VALID FUNCTIONS > 17. 
      CPA D39        FCONTROL 39--
      JMP SETYP        SET TERMINAL TYPE. 
      CPA D41        FCONTROL 41--
      JMP RDSTP        READ STRAPS. 
      JMP SETPR     NOT VALID. JUST REPLY.
* 
USTBL LDA CTABL     GET ADDRESS 
      ADA TEMP       OF ACTION SUBROUTINE.
      JMP A,I       GO DO IT. 
* 
CTABL DEF *+1       TABLE FOR FCONTROL SUBROUTINES. 
      JMP ECHON      12: SET $STDIN ECHO ON 
      JMP ECHOF      13: SET $STDIN ECHO OFF
      JMP DSBRK      14: DISABLE "BREAK"
      JMP ENBRK      15: ENABLE "BREAK" 
      JMP DSCTY      16: DISABLE "CONTROL-Y"
      JMP ENCTY      17: ENABLE "CONTROL-Y" 
* 
*   FUNCTIONS 12 & 13 
* 
ECHON LDA B600      SET "ECHO INPUT"
      RSS            IN CONTROL WORD. 
ECHOF CLA           CLEAR "ECHO INPUT"
      STA D$ECH      IN CONTROL WORD. 
      JMP SETPR 
* 
*   FUNCTIONS 14 & 15 
* 
DSBRK CLA           DISABLE "BREAK" 
      RSS            CHECK FLAG.
ENBRK CCA           ENABLE "BREAK"
      STA D$BRK      CHECK FLAG.
      JMP SETPR 
* 
*   FUNCTIONS 16 & 17 
* 
DSCTY CLA           DISABLE "CONTROL-Y" 
      RSS            CHECK FLAG.
ENCTY CCA           ENABLE "CONTROL-Y"
      STA D$CTY      CHECK FLAG.
      JMP SETPR 
* 
* 
*   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
      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 
      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. 
* 
SETPR LDA BUF+APN+2 MOVE PARAM
STAPN STA BUF+APN+1  WORD.
      LDA D4        SET BYTE
      STA BUF+BYT    LEN WORD.
      JMP NEXT1 
      SPC 1 
N12   DEC -12 
N6    DEC -6
D39   DEC 39
D41   DEC 41
      SKP 
* 
* WE HAVE A REQUEST FROM THE HP 3000 FOR INPUT FROM A 
* USER TERMINAL (PREVIOUS $STDLIST SHOULD HAVE
* PROVIDED A PROMPT MESSAGE OR CHARACTER).
* 
STDIN LDA BUF+PRC   CHECK FOR SPECIAL "FEATURE" ON
      AND UP377      MPE-III. A $STDIN REQUEST FROM 
      SZA,RSS         SESSION 0 OCCURS WHEN A BAD 
      JMP EXIT         ACCOUNT IS USED FOR HELLO. 
* 
      LDA D$INP     SET "ECHO INPUT" BIT
      IOR D$ECH      IF FLAG IS SET.
      STA CNWRD 
* 
*  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 =
      CPA D$LOG      D$LOG, 
      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.
* 
      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 BUF+APN+2 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 
      STA CNWRD      WITHOUT FUNCTION BITS. 
      JSB REIO      DUMMY READ. 
      DEF *+5 
      DEF SD1 
      DEF CNWRD 
      DEF BUF+APN+2 
      DEF BUF+APN 
      CLB 
      SZB,RSS       IF 1ST CHAR IS
      JMP HOCUR      ESCAPE (AND DATA 
      LDA BUF+APN+2   WAS ACTUALLY READ)
      AND UP377        ASSUME IT'S FROM A 
      CPA ESC           SOFT KEY & USE IT.
      JMP GTRLN 
HOCUR JSB REIO      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 BUF+APN+2 
      DEF BUF+APN   (+ = WORDS, - = BYTES)
      CLB           INPUT ERROR: SET B:=0.
* 
GTRLN LDA BUF+APN   (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 BUF+APN+2    AND INPUT WORD = BLANKS, 
      CPA BLNKS 
      CLB               SET 0-LEN REPLY MESSAGE.
* 
REPLY ADB D4         COUNT CONTROL & LENGTH WORDS.
      STB BUF+BYT   STORE TOTAL REPLY BYTE LENGTH.
* 
      ADB N4         RESTORE POS. BYTE LEN OF INPUT.
      LDA BUF+APN 
      SSA            IF $STDIN SPECIFIED NEG. BYTES,
      CMB,INB,RSS     MAKE (B) = NEG. BYTES,
      BRS             ELSE MAKE (B) = POS. WORDS. 
      STB BUF+APN+1 STORE NEG. BYTE OR POS. WORD COUNT. 
* 
      CLA,INA       SET STATUS WORD.
      JMP NEXT2 
      SKP 
* 
* WE HAVE A $STDLIST MESSAGE FROM THE HP3000. 
* DISPLAY ON USER-SPECIFIED LOG DEVICE. 
* 
MESG  LDA PCLSF     IF WITHIN PCLOSE, 
      SZA            DON'T PRINT MESSAGE: 
      JMP NEXT        "END OF REMOTE PROGRAM."
      LDA OEFLG     SKIP OUTPUT 
      SZA            IF OUTPUT ERROR
      JMP NEXT        FLAG IS SET.
      STA SKIP      CLEAR SKIP FLAG.
      LDA BUF+BYT   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 BUF+APN+1 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 BUF+APN   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 BUF+APN+2 
      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
      JSB .MVW        BUFFER. 
      DEF TEMP
      NOP 
      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/$STDIN/FCONTROL REQUEST. 
* 
NEXT  LDA D2        SET BYTE COUNT TO 2 
      STA BUF+BYT    FOR $STDLIST.
NEXT1 LDA CCE 
NEXT2 STA BUF+APN   STORE STATUS WORD.
      LDA BUF+STR   SET REPLY BIT.
      IOR BIT15 
      STA BUF+STR 
      LDA BUF+PRC  REVERSE PROCESS NUMBERS. 
      ALF,ALF 
      STA BUF+PRC 
      JSB STWDC     STORE WORD COUNT. 
* 
      JSB BRKCK     CHECK FOR OPERATOR BREAK. 
      JMP BREAK     YES. GO BUILD BREAK REQUEST.
      JMP STBLN     SEND REPLY. 
* 
SKIP  NOP           SKIP-AFTER-PRINT FLAG.
      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 BUF+BYT   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 BUF+PRC  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 BUF+BYT 
* 
      ISZ P.PTR     SET UP BUFL FOR CLASS WRITE.
      LDA D$RQB 
      CMA,INA 
      ADA P.PTR 
      STA BUFL
* 
      JMP SEND1     WRITE TO QUEX (INCLUDE MASTER TCB). 
* 
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 UNDSC      GO DO UNDERSCORE 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 AN UNDERSCORE AS LAST CHAR. IN MESSAGE.
* 
UNDSC LDB BUFL
      CMB,INB       POSITIVE # MESSAGE BYTES. 
      CLE,ERB       E SET IF ODD # BYTES. 
      ADB BUFA      ADDR OF WORD FOR UNDERSCORE.
* 
      LDA B,I       CLEAR DESTINATION BYTE. 
      SEZ,RSS 
      ALF,ALF 
      AND UP377 
* 
      IOR "_"       INSERT UNDERSCORE.
      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
B700  OCT 700 
B600  OCT 600 
B320  OCT 320 
B300  OCT 300 
B200  OCT 200 
B100  OCT 100 
B2500 OCT 2500
B3200 OCT 3200
N5    DEC -5
CNWRD NOP 
FCN11 OCT 1100
"_"   OCT 137 
ESC   BYT 33,0      ESCAPE CHARACTER. 
* ESCAPE CODES TO HOME CURSOR AND ENTER (WITHOUT CARRIAGE RETURN) 
HCENT BYT 33,110,33,144,137 
      SKP 
* 
* SUBROUTINE TO TEST AND SERVICE OPERATOR BREAK.
* 
BRKCK NOP 
      LDA OEFLG     OUTPUT ERROR
      SZA            FLAG SET?
      JMP BRK1         YES--IGNORE BREAK CHECK. 
      LDA D$BRK     IF NEITHER
      IOR D$CTY      BREAK FLAG 
      SZA,RSS         IS SET, 
      JMP BRK1          RETURN. 
      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 UP377 
      ALF,ALF 
      LDB B22 
      CPA "B" 
      JMP BRK2      BREAK.
      LDB B25 
      CPA "Y" 
      JMP BRK2      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 
* 
BRK2  LDA D$BRK     LOAD PROPER 
      CPB B25        FLAG INTO
      LDA D$CTY       A-REG.
      SZA           IF SET, 
      JMP BRKCK,I    GO DO IT.
      JSB REIO      OTHERWISE,
      DEF *+5        DISPLAY
      DEF D2          "DISABLED". 
      DEF CNWRD 
      DEF DISAB 
      DEF D4
      JMP BRK1
* 
CMSG  ASC 13,ENTER CONTROL REQ (B OR Y) 
ILMSG ASC 7,INVALID INPUT 
DISAB ASC 4,DISABLED
"B"   OCT 102 
"Y"   OCT 131 
      SKP 
* SUBROUTINE TO RELEASE THE MASTER CLASS. 
* 
CLNUP NOP           ENTRY/EXIT. 
      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 RTE 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 ZRCLS      YES. GO CLEAR THE CLASS NUMBER.
      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. 
* 
ZRCLS 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".
* 
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 RETRN     GET ERROR ADDRESS 
      SEZ           ABORT OR RETURN TO CALLER?
      JMP D$ABT       ABORT! - NO RETURN. 
      CCA             SET CONDITION CODE TO CCL.
      STA ICCC
      DLD MSGBF       GET ERROR CODES AND RETURN TO 
      JMP RETRN,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 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 XEQT      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 
      SZA,RSS       IF LOG LU IS ZERO,
      CLA,INA        USE 1. 
      IOR B600      SET "ECHO INPUT" &
      STA CNWRD      "PRINT COL 1" BITS.
      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
D14   DEC 14
D18   DEC 18
      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 
      SKP 
* 
* COMPUTE AND STORE REQUEST WORD COUNT IN FIRST BYTE OF REQUEST.
* 
STWDC NOP 
      LDA BUF+CLS   FIRST WORD OF REQUEST BUFFER. 
      AND B377      CLEAR WORD COUNT BYTE.
      LDB BUF+BYT   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 BUF+CLS   STORE FIRST WORD. 
      JMP STWDC,I   RETURN. 
      SKP 
**************************************************************
* SUBROUTINES USED TO SET APPENDAGE AND RETRIEVE PARAMETERS  *
**************************************************************
      SPC 2 
*** D$INI: INITIALIZE PARAMETER AND DESTINATION POINTERS. 
*          (USED WITH APPENDAGE-BUILDING SUBROUTINES.)
*  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 
      ADA D8
      STA P.PTR     PTR TO APPENDAGE. 
      CLA           SET BYTE COUNT WORD 
      STA BUF+BYT    IN HEADER TO ZERO. 
      JMP D$INI,I   RETURN. 
      SPC 2 
* STORE A-REG IN REQUEST BUFFER.
*** D$STW: STORE A-REG IN APPENDAGE AND INCREMENT BYTE COUNT WORD.
*  CALLING SEQUENCE: LDA <VALUE>
*                    JSB D$STW
* 
D$STW NOP 
      LDB BUFSZ     CHECK IF STILL ROOM IN BUFFER.
      ADB D$RQB     (IS POINTER AT END OF BUFFER?)
      CPB P.PTR 
      JMP D$STW,I   REQUEST BUFFER OVERFLOW!
* 
      STA P.PTR,I   STORE WORD. 
      ISZ P.PTR     BUMP BUFFER POINTER.
      LDA BUF+BYT 
      ADA D2        INCREMENT BYTE COUNTER. 
      STA BUF+BYT 
      JMP D$STW,I   RETURN. (A) = BYTE COUNT. 
      SPC 2 
*** D$PRM: STORE N PARAMETERS IN APPENDAGE. 
*  CALLING SEQUENCE: LDA <-N> 
*                    JSB D$PRM
* 
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. 
      SPC 2 
*** D$NWD: STORE N-WORD PARAM IN APPENDAGE. 
*  CALLING SEQUENCE: LDA <-N> 
*                    JSB D$NWD
* 
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. 
      SPC 2 
*** D$ASC: STORE ASCII STRING IN APPENDAGE. 
*  CALLING SEQUENCE: LDA <ADDRESS OF STRING>
*                    LDB <- MAX # WORDS>
*                    JSB D$ASC
* 
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 BUF+BYT 
      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 
      SPC 2 
*** D$ZRO: STORE ZERO IN NEXT N WORDS OF APPENDAGE. 
*  CALLING SEQUENCE: LDA <-N> 
*                    JSB D$ZRO
* 
D$ZRO NOP 
      STA TEMP
ZRO   CLA 
      JSB D$STW 
      ISZ TEMP
      JMP ZRO 
      JMP D$ZRO,I 
      SPC 3 
*** D$IPM: INITIALIZE REPLY POINTERS. 
*          (CALLED BEFORE PICKING UP RETURN PARAMETERS.)
*  CALLING SEQUENCE: LDA <1ST RETURN PARAM ADDR>
*                    LDB <1ST WORD IN APPENDAGE>
* 
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 
      SPC 2 
*** D$NPM: PASS N M-WORD RETURN PARAMS TO CALLER. 
*  CALLING SEQUENCE: LDA <-N> 
*                    LDB <-M> 
*                    JSB D$NPM
* 
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 
      SPC 2 
*** D$SPM: PASS SINGLE N-WORD PARAM TO USER.
*  CALLING SEQUENCE: LDA <-N> 
*                    JSB D$SPM
* 
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 
B23   OCT 23
B25   OCT 25
B72   OCT 72
B77   OCT 77
B377  OCT 377 
UP377 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 
D10   DEC 10
D13   DEC 13
D20   DEC 20
N1    DEC -1
N3    DEC -3
N4    DEC -4
N8    DEC -8
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 
C4S22 BYT 4,22      PREAD 
C4S23 BYT 4,23      PWRITE
C6S20 BYT 6,20      HELLO 
C7S21 BYT 7,21      PCLOSE
D$SMP OCT 0         SESSION MAIN PROCESS NUMBER.
D$LOG NOP           LU OF LOG DEVICE. 
D$INP NOP           LU OF INPUT DEVICE. 
D$BRK NOP           "BREAK" CHECK FLAG. 
D$CTY NOP           "CONTROL-Y" CHECK FLAG. 
D$ECH OCT 400       ECHO BIT FOR D$INP. 
CCE   OCT 1000
D$ERR BSS 2 
BLNKS ASC 1,
PEROD OCT 56
SLASH OCT 57
NEGA  OCT -101
NGMAX OCT -33 
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
* 
BLK#1 NOP 
PCLSF NOP 
STATS NOP 
OCLST NOP 
INBUF NOP 
RTNLN NOP 
MVLEN NOP 
H&ALN NOP 
SPCAV 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$TAG DEF *+1       TEMPORARY TAG STORAGE.
      BSS 20
* 
      BSS 0          ****** SIZE OF D3KMS ******
* 
      END