ASMB,Q,C
      HED QUEX: HP 3000 MODEM COMM. MONITOR * (C) HEWLETT-PACKARD CO. 
      NAM QUEX,19,4 91750-16155 REV.2013 800423 MEF: 3000 MODEM LINK
      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 2 
* Z OPTION INCLUDES DEBUG.
* 
      EXT RNRQ,EXEC,XLUEX,$OPSY,.MVW,DTACH,IFBRK
      EXT #LU3K,#LDEF,#QXCL,#CL3K,#CLRN 
      EXT D$XS5,D$LID,D$RID 
      EXT D$MXR,D$RQB,D$3BF,D$BSZ 
      SPC 1 
      UNL           NEXT 5 LINES ARE FOR PRODUCTION ENGINEERING 
*  NAME: QUEX 
*SOURCE: 91750-18155
* RELOC: 91750-16155
*  PGMR: DMT
      LST 
*********************** QUEX - MODEM VERSION *********************
*                                                                *
*      SOURCE: 91750-18155                                       *
*                                                                *
*      BINARY: 91750-16155                                       *
*                                                                *
*      DMT                                                       *
*                                                                *
*      MAY 2, 1979                                               *
*                                                                *
******************************************************************
      SPC 1 
* 
* QUEX PERFORMS MODEM COMMUNICATION WITH A REMOTE HP3000 COMPUTER.
* ALL MASTER REQUESTORS AND SLAVE MONITORS WISHING TO TRANSMIT
* TO AN HP3000 DO SO BY WRITING THEIR BUFFERS TO THE
* QUEX I/O CLASS. QUEX HANGS ON A CLASS GET CALL
* AND THEN  BLOCKS AS MANY REQUESTS/REPLIES AS WILL FIT INTO THE
* SEND BUFFER.  A WRITE CALL TO THE PSI BSC DRIVER AND CARD 
* TRANSMITS THE SEND BUFFER. REPLY BUFFERS ARE READ BY PROGRAM QUEZ.
      SPC 1 
      SUP 
A     EQU 0 
B     EQU 1 
      SKP 
QUEX  LDA $OPSY     CHECK FOR OPERATING 
      RAR,SLA        SYSTEM TYPE. 
RSS   RSS           IF MAPPED SYSTEM, 
      JMP INITL 
      LDA RSS         CONFIGURE CROSS-MAP 
      STA MODI2        LOAD 
* 
      JSB DTACH     DETACH FROM POSSIBLE SESSION. 
      DEF *+1 
* 
      LDA D$XS5     CHECK FOR 
      AND D2         HSI LINK.
      SZA,RSS       0 = HSI, 2 = MODEM
      JMP WRDVR     ERROR--WRONG QUEX.
      SPC 1 
* 
* FIRST ENTRY INTO QUEX (SCHEDULED BY UPLIN): 
* INITIALIZE THE HP3000 COMMUNICATION LINK. 
* 
INITL LDA #QXCL     SAVE QUEX CLASS NUMBER. 
      IOR BIT15     MAKE SURE "DOWN" BIT
      STA #QXCL      IS SET IN SSGA.
      ELA,CLE,ERA   CLEAR "DISCONNECT" BIT. 
      STA QXCLS 
      IOR B140K     ADD NO-WAIT & BUFFER-SAVE BITS. 
      STA QCLAS 
* 
*  CONFIGURE THE CONTROL WORDS. 
      LDA #LU3K     GET 3000 WRITE LU NUMBER. 
      STA DISWD     STORE IN
      STA CNCWD      XLUEX
      STA WRTWD       WORDS.
      STA DEFWD 
      STA PRMWD 
* 
      IOR LB4       CONFIGURE "PRIMARY
      STA CNPWD      CONNECT" WORD
      LDA #LU3K       AND "SECONDARY
      IOR LB5          CONNECT" WORD. 
      STA CNSWD 
      SPC 3 
* 
*  READY TO RESTART FOR A FRESH START. DISCONNECT LINE, SET DEFAULTS
*  ON BOARD, THEN TRY TO CONNECT (FIRST AS PRIMARY, THEN AS SECONDARY). 
* 
INIT  JSB CLNUP     CLEAN OUT PREVIOUS ACTIVITY.
      LDA !DISC 
      STA CLTYP 
      JSB XLUEX     PERFORM LINE DISCONNECT.
      DEF *+3 
      DEF D3
      DEF DISWD 
      JSB CKDVR     CHECK FOR ERROR.
* 
*  SET UP "DEFAULT PARAMETER" BUFFER. 
* 
      LDA MINLN 
      STA DEFLN      DEFAULT BUFFER.
      SPC 2 
      LDA D$MXR     SET BLOCK 
      STA BLKSZ      SIZE.
* 
      LDA @ID       INITIALIZE
      STA IDPNT      ID POINTER.
      LDA D$LID     GET LOCAL 
      LDB A,I        ID SEQUENCE. 
      SZB,RSS       IF CHAR COUNT IS ZERO,
      JMP RMID       GO DO REMOTE ID. 
* 
      STB IDPNT,I   SAVE LENGTH 
      ISZ IDPNT      IN BUFFER. 
      ISZ DEFLN 
      INB           CHANGE BYTE COUNT 
      CLE,ERB        TO WORD COUNT. 
      STB TEMP
      ADB DEFLN     ADD TO BUFFER LENGTH. 
      STB DEFLN 
      INA           SOURCE. 
      LDB IDPNT     DESTINATION.
      MVW TEMP      MOVE LOCAL ID.
      STB IDPNT     UPDATE POINTER. 
* 
RMID  LDB D$RID     GET REMOTE
      INB            ID SEQUENCE. 
      LDA B,I 
      SZA,RSS       IF CHAR COUNT IS ZERO,
      JMP S2BRD      ALL DONE WITH IDS. 
* 
      IOR B20       SET ID NUMBER/
      STA IDPNT,I    LENGTH WORD. 
      ISZ IDPNT 
      ISZ DEFLN 
      XOR B20 
      INA           CHANGE BYTE COUNT 
      CLE,ERA        TO WORD COUNT. 
      STA TEMP
      ADA DEFLN     ADD TO BUFFER LENGTH. 
      STA DEFLN 
      INB 
      LDA B         SOURCE. 
      LDB IDPNT     DESTINATION.
      MVW TEMP      MOVE REMOTE ID. 
* 
* 
*  SEND DEFAULT PARAMETERS TO BOARD.
* 
S2BRD LDA !INTL 
      STA CLTYP 
      JSB XLUEX     INITIALIZE BOARD. 
      DEF *+6 
      DEF D2
      DEF DEFWD 
      DEF DEFBF 
      DEF DEFLN 
      DEF D1
      JSB CKDVR     CHECK FOR ERROR.
* 
      JSB EXEC      WRITE MESSAGE:
      DEF *+5        >> HP 3000 LINK READY
      DEF D2          FOR DIALING 
      DEF D1
      DEF DLMSG 
      DEF D17 
* 
      LDA !GTPR 
      STA CLTYP 
      JSB XLUEX     GET PARAMETERS. 
      DEF *+6 
      DEF D1
      DEF PRMWD 
      DEF PRAMS 
      DEF D7
      DEF D1
      JSB CKDVR 
* 
      LDA PRAMS+6   GET THE PARAMETER 
      ALF,ALF        WHICH INDICATES BUFFER 
      CLE,ERA         SIZE. CONVERT TO WORDS. 
      STA D$BSZ     STORE IN SSGA.
* 
      JSB STBFL     STORE BUFFER SIZE.
* 
      LDA !PCNT 
      STA CLTYP 
      JSB XLUEX     CONNECT AS PRIMARY. 
      DEF *+4 
      DEF D3
      DEF CNCWD 
      DEF CNPWD 
      JSB CKDVR     CHECK FOR ERROR.
* 
      SPC 3 
* 
*  TRY TO CONNECT AS PRIMARY. WRITE DS/3000 INITIALIZATION REQUEST. 
* 
      LDA STRTM     ADDR OF INIT. REQUEST.
      JSB TOBUF     SET UP BUFFER FOR TRANSMISSION. 
* 
SNDIN JSB XLUEX     WRITE THE 
      DEF *+5        INITIALIZATION 
      DEF D2          REQUEST.
      DEF WRTWD 
      DEF D$3BF 
      DEF WRTLN 
      RAR 
      SLA,RSS       IF NO ERROR,
      JMP QZON        SCHEDULE QUEZ AND GET BLOCK.
* 
      AND B170        ISOLATE STATUS. 
      CPA B100      IF BOARD INDICATED TIMEOUT, 
      JMP PRTMO       CONNECT AS SECONDARY. 
* 
*  USER MAY WANT TO IMMEDIATELY WAIT FOR INCOMING CALL. 
* 
      JSB IFBRK     CHECK RTE 
      DEF *+1        BREAK FLAG.
      SZA           IF SET, 
      JMP PRTMO      GO TO SECONDARY. 
* 
      CCA           OTHERWISE, GO TO
      JSB SLEEP      SLEEP FOR FIVE SECONDS.
      JMP SNDIN     TRY TO CONNECT AGAIN. 
      SPC 2 
*   SUBROUTINE TO PUT BUFFER SIZE IN INITIALIZATION 
STBFL NOP           ENTRY.
      LDA D$BSZ 
      CLB           STORE BUFFER SIZE 
      DIV D16        (DIVIDED BY 16,
      ADA N1          MINUS 1)
      STA B 
      STA INTRP+4 
      ALF,ALF 
      IOR B          AND CURRENT SIZE.
      STA STRTM+4 
      JMP STBFL,I   RETURN. 
      SPC 2 
*   SUBROUTINE TO SET UP BUFFER FOR SEND. 
TOBUF NOP 
      LDB D$RQB     ADDR OF SEND BUFFER.
      STB BPNTR 
      JSB .MVW      MOVE REQUEST TO "SEND"
      DEF D8
      NOP 
* 
      LDA D8        SET BLOCK LENGTH
      STA LOG        TO EIGHT.
      CLA           GO TO VERIF IN CASE 
      JSB VERIF      TRACE WAS SPECIFIED. 
      NOP           IGNORE ERROR. **SHOULDN'T HAPPEN**
* 
      LDA D8        SET WRITE LENGTH TO 8 WORDS.
      STA WRTLN 
* 
      JMP TOBUF,I   RETURN. 
      SPC 2 
* 
*  WE HAVE TIMED OUT AS PRIMARY STATION. TRY TO CONNECT AS SECONDARY. 
* 
PRTMO JSB EXEC      PRINT TIMEOUT MESSAGE.
      DEF *+5 
      DEF D2
      DEF D1
      DEF TOMSG 
      DEF D26 
* 
      LDA !DISC 
      STA CLTYP 
      JSB XLUEX     DISCONNECT LINE.
      DEF *+3 
      DEF D3
      DEF DISWD 
      JSB CKDVR     CHECK FOR ERROR.
* 
      LDA !SCNT 
      STA CLTYP 
      JSB XLUEX     CONNECT AS SECONDARY. 
      DEF *+4 
      DEF D3
      DEF CNCWD 
      DEF CNSWD 
      JSB CKDVR     CHECK FOR ERROR.
* 
QZON  JSB EXEC      MAKE SURE 
      DEF *+3        QUEZ IS
      DEF D10         SCHEDULED.
      DEF QUEZ
* 
*  QUEZ WILL GET INITIALIZATION REQUEST AND PASS IT TO US.
* 
      SKP 
* 
* WAIT FOR SOMETHING TO SEND TO THE HP 3000 BY HANGING ON 
* A CLASS I/O GET WITH WAIT TO QUEX'S I/O CLASS.
* BLOCK AS MANY REQUESTS/REPLIES FROM QUEX'S I/O CLASS
* BUFFER AS WILL FIT IN THE TRANSMIT BUFFER.
* 
NEWGT CLA           INITIALIZE LENGTH (BYTES) 
      STA WRTLN      OF TRANSMIT BUFFER.
      LDA D$RQB     INITIALIZE BUFFER POINTER TO
      STA BPNTR      START OF SEND AREA.
* 
GET   JSB EXEC      CLASS I/O GET TO LOOK FOR 
      DEF *+6        MASTER REQUESTS FROM RTE USERS.
      DEF CLS21     NO ABORT. 
      DEF QXCLS     QUEX I/O CLASS. 
BPNTR NOP 
      DEF D$MXR     BUFFER LENGTH.
      DEF LOG       RETURNED BLOCK LENGTH (WORDS).
      NOP           IGNORE ERROR RETURN.
* 
* THE CLASS GET HAS COMPLETED. RTE IS SENDING A MASTER REQUEST OR A 
* SLAVE REPLY, OR QUEZ MIGHT BE PASSING ALONG A SPECIAL REQUEST.
* 
      LDA TRMRQ     LOAD TERMINATION ADDRESS. 
      LDB LOG       CHECK FOR QUEZ'S
      SZB,RSS        "LAST BYE" SIGNAL. 
      JMP DOBUF       GOT IT. SEND TERMINATION REQUEST. 
* 
      CPB D1        1-WORD MESSAGE INDICATES
      JMP RDERR      QUEZ REPORTED READ ERROR.
* 
      LDA BPNTR,I   GET FIRST WORD AND
      AND B377       ISOLATE DS/3000 CLASS. 
      SZA,RSS       IF ZERO,
      JMP MZERO        GO TO SPECIAL HANDLER. 
* 
* ADD BLOCK TO TRANSMIT BUFFER, THEN ADVANCE POINTER. 
* 
      LDA SGNOF     INIT. REQ. EXCHANGED YET? 
      SZA 
      JMP NULGT     NO. IGNORE. **SHOULDN'T HAPPEN**
ADDBU CLA           MESSAGE IS FROM 1000. 
      JSB VERIF     CHECK VALIDITY. 
      JMP NULGT     INVALID: IGNORE.
* 
      LDA BUFL      ADD LEN OF BLOCK
      ADA WRTLN      TO TOTAL TRANSMIT
      STA WRTLN       LENGTH. 
* 
      LDA BPNTR     ADVANCE BUFFER POINTER. 
      ADA BUFL
      STA BPNTR 
* 
      LDA BUFL      SUBTRACT THE LENGTH 
      CMA,INA        OF PROCESSED BUFFERS 
      ADA LOG         FROM BLOCK LENGTH.
      STA LOG       SAVE REMAINING LENGTH.
      SZA           IF ANOTHER BUFFER,
      JMP ADDBU      GO ADD IT. 
* 
* ISSUE A NULL  GET CALL TO QUEX'S I/O CLASS TO SEE 
* IF THERE IS ANOTHER PENDING REQUEST AND TO SEE WHETHER
* THERE IS ROOM IN THE TRANSMIT BUFFER. ISSUE THE GET 
* WITHOUT WAIT, SAVE CLASS BUFFER, AND BUF LEN = 0. 
* 
NULGT JSB EXEC      CLASS GET (DUMMY).
      DEF *+6 
      DEF CLS21     NO ABORT. 
      DEF QCLAS     QUEX I/O CLASS. 
      DEF D0        DUMMY BUFFER. 
      DEF D0        ZERO LENGTH BUFFER. 
      DEF LOG       RETURNED BLOCK LENGTH (WORDS).
      NOP           IGNORE ERROR RETURN.
* 
      SSA           WAS THERE ANYTHING THERE? 
      JMP REMIO     NO. GO SEND WHAT WE HAVE. 
* 
* A REQUEST IS IN THE CLASS BUFFER. SEE IF THERE
* IS ROOM TO BLOCK IT INTO THE TRANSMIT BUFFER. 
* 
      LDA D$BSZ 
      CMA,INA       CALCULATE NEG. NUMBER 
      ADA WRTLN      OF WORDS LEFT. 
      ADA LOG       ADD LENGTH OF BLOCK (WORDS).
      SSA 
      JMP GET       FITS. GO READ IT. 
* 
* IF THERE WAS NO ROOM FOR THE LAST BLOCK, IT IS STILL IN 
* THE CLASS BUFFER AND WILL BE PICKED UP NEXT TIME AROUND.
* 
* SEND THE BLOCKS TO THE HP 3000. 
* 
REMIO LDA !WRIT 
      STA CLTYP 
      JSB XLUEX 
      DEF *+5 
      DEF D2
      DEF WRTWD 
      DEF D$3BF 
      DEF WRTLN 
      JSB CKDVR     CHECK FOR ERROR.
* 
      JMP QZON      GET NEXT BLOCK. 
      SKP 
* 
*  CLASS 0 REQUEST OR REPLY RECEIVED FROM 3000. 
* 
MZERO CLA,INA       MESSAGE FROM 3000.
      JSB VERIF     VERIFY IT'S GOOD. 
      JMP BADRT       BAD--IGNORE.
* 
      LDA STMWD     ISOLATE REPLY & 
      AND B140K      REJECT BITS. 
      CPA B140K     BOTH SET? 
      JMP BADRT       YES--IGNORE.
      SZA           IF EITHER IS SET, 
      JMP REPL0      IT'S A REPLY.
      SPC 1 
* 
*  REQUEST RECEIVED ON CLASS 0. 
*     CLASS 0, STREAM 20: INITIALIZATION
*     CLASS 0, STREAM 21: TERMINATION 
* 
      LDA STREM     STREAM =
      CPA B20        OCTAL 20?
      JMP INOK      YES. ACCEPT INITIALIZATION. 
      CPA B21       STREAM =
      RSS            OCTAL 21?
      JMP REJCT     NO--UNKNOWN. REJECT. **SHOULDN'T HAPPEN** 
* 
*  HP 3000 REQUESTS TERMINATION ONLY WHEN IT THINKS NEITHER 
*  SIDE HAS ANYTHING GOING. MAKE SURE PNL IS EMPTY. 
* 
      CCB           GET ADDRESS OF
      ADB #LDEF      PNL HEADER ADDR. 
      LDB B,I       GET ADDR OF 
      LDB B,I        PNL HEADER.
      JSB CKLST     IF ANYONE IS IN LIST, 
      RSS 
      JMP REJCT      REJECT. **SHOULDN'T HAPPEN** 
      LDB #LDEF     GET ADDRESS 
      INB            OF FIRST 
      LDB B,I         MASTER
      LDB B,I          REQUEST. 
      JSB CKLST     IF ANYONE IS IN LIST, 
      RSS 
      JMP REJCT      REJECT. **SHOULDN'T HAPPEN** 
      JMP INIT      GO CLEAR THE LINE.
* 
* 
*  ACCEPT 3000'S INITIALIZATION.
* 
INOK  JSB GTBSZ     GET 3000 BUFFER SIZE. 
      STA TEMP      SAVE. 
      CMA,INA       SUBTRACT FROM 
      ADA D$BSZ      1000 BUFFER SIZE.  
      CMA,SSA,RSS   IF 3000 SIZE IS SMALLER,  
      JMP UPOK
      LDA TEMP        SET 1000 SIZE TO
      STA D$BSZ        3000 SIZE. 
      JSB STBFL       STORE IN INITIALIZATION BUF.
UPOK  JSB UP        LET WORLD KNOW WE ARE UP. 
      LDA INTRP     SEND INITIALIZATION 
DOBUF JSB TOBUF      REPLY. 
      JMP REMIO 
      SPC 4 
* 
*  SUBROUTINE TO CHECK IF A TCB LIST HAS ANY HP3000 ENTRIES.
*  CALLING SEQUENCE: LDB <FIRST TCB ADDR> 
*                    JSB CKLST
*                    <NO-ENTRY RETURN>
*                    <ENTRY RETURN> 
* 
CKLST NOP 
CKLOP SZB,RSS       END OF LIST?
      JMP CKLST,I    YES--TAKE NO-ENTRY RETURN. 
      JSB LODWD 
      STA TEMP      SAVE LINK.
      INB           GET SECOND
      JSB LODWD      TCB WORD.
      LDB TEMP      SET UP POINTER FOR NEXT LOOP. 
      AND BIT14     ISOLATE "3000" BIT. 
      SZA,RSS       IF NOT SET, 
      JMP CKLOP      STAY IN LOOP.
* 
      ISZ CKLST     ENTRY FOUND!
      JMP CKLST,I    TAKE 2ND RETURN. 
* 
      SPC 1 
* 
*  REPLY RECEIVED ON CLASS 0. 
* 
REPL0 LDB STMWD     GET STREAM WORD 
      RBL            AND POSITION REJECT BIT. 
      LDA STREM     IF STREAM = 
      CPA B20        OCTAL 20,
      JMP INIRP        IT'S AN INITIALIZATION REPLY.
      CPA B21       IF STREAM NOT = 
      RSS            OCTAL 21,
      JMP REJCT        UNKNOWN. REJECT. **SHOULDN'T HAPPEN**
* 
*  HP 3000 IS REPLYING TO OUR TERMINATION REQUEST.
* 
      SSB           REJECT BIT SET? 
      JMP NEWGT        YES--DON'T DISCONNECT. 
      JMP INIT        NO--GO AHEAD AND CLEAR LINE.
* 
*  HP 3000 IS REPLYING TO OUR INITIALIZATION REQUEST. 
* 
INIRP SSB           REJECT BIT SET? 
      JMP INIT        YES--RETRY. 
      JSB GTBSZ     SET 1000 BLOCK SIZE.
      STA D$BSZ 
      JSB UP          NO--LET WORLD KNOW WE ARE UP. 
* 
      JMP NEWGT      PROCESS NEXT BLOCK.
* 
UPMSG ASC 11,>> HP 3000 LINK * UP * 
      SPC 3 
* 
*  SUBROUTINE TO GET BLOCK SIZE FROM INITIALIZATION REQUEST/REPLY.
* 
GTBSZ NOP           ENTRY.
      LDA BPNTR     ISOLATE RIGHT 
      ADA D3         HALF OF
      LDA A,I         WORD 4 IN 
      AND B377         BUFFER.
      INA           INCREMENT AND MULTIPLY
      MPY D16        BY 16 TO GET BUFFER SIZE.
      JMP GTBSZ,I   RETURN. 
      SPC 2 
* 
*  SUBROUTINE TO ESTABLISH CONNECT STATUS AND REPORT ON SYSTEM CONSOLE. 
* 
UP    NOP           ENTRY.
      CLA           CLEAR SIGN-OFF FLAG.
      STA SGNOF 
      LDA #QXCL     CLEAR DISCONNECT FLAG 
      ELA,CLE,ERA    IN #QXCL TO INTICATE 
      STA #QXCL       CONNECT STATUS. 
* 
      JSB EXEC      DISPLAY "UP" MESSAGE ON LU 1. 
      DEF *+5 
      DEF D2
      DEF D1
      DEF UPMSG 
      DEF D11 
* 
      JMP UP,I      RETURN. 
      SKP 
* 
* SEND "REJECT" REPLY FOR ILLEGAL REQUESTS. 
* 
REJCT LDA STMWD     MAKE SURE 
      AND BIT14      WE AREN'T
      SZA             REJECTING 
      JMP NEWGT        A REJECT!
      LDA BPNTR,I   APPENDAGE 
      AND B377       LENGTH 
      IOR LB8         IS 8. 
      STA BPNTR,I 
      LDA STMWD     SET REJECT BIT. 
      IOR BIT14 
      AND NBT13     CLEAR CONTINUATION BIT. 
      LDB BPNTR 
      ADB D2
      STA B,I 
      ADB D2        REVERSE PROCESS NUMBERS.
      LDA B,I 
      ALF,ALF 
      STA B,I 
      ADB D3        DATA LENGTH = 0.
      CLA 
      STA B,I 
* 
      LDA QXCLS 
      IOR BIT15     SET NO-WAIT BIT.
      STA CLASN     SAVE I/O CLASS #. 
* 
      LDA !WRIT 
      STA CLTYP 
      JSB XLUEX     WRITE 
      DEF *+5        TO 
      DEF D2          DRIVER. 
      DEF WRTWD 
      DEF BPNTR,I 
      DEF D8
      JSB CKDVR     CHECK FOR ERROR.
* 
BADRT LDA WRTLN     IF SOMETHING
      SZA            IS IN BUFFER,
      JMP NULGT       GO TO NULL GET. 
      JMP NEWGT        OTHERWISE, DO NEW GET. 
* 
LB4   BYT 4,0       LEFT BYTE 4 
LB5   BYT 5,0       LEFT BYTE 5 
LB8   BYT 10,0      LEFT BYTE 8.
      SKP 
* 
* SUBROUTINE TO VERIFY AUTHENTICITY OF REQUESTS AND REPLIES 
* BEING SENT OR RECEIVED. ALSO SETS <CLASS>, <STMWD>, <STREM>,
* AND <BUFL> AND PERFORMS TRACE (IF REQUESTED). 
* 
*   ON ENTRY, (A) = 0 IF OUTGOING REQ/REPLY,
*                 = 1 IF INCOMING REQ/REPLY.
*           BPNTR = BUFFER ADDRESS OF REQ/REPLY.
* 
VERIF NOP 
      STA TEMP      SAVE DIRECTION CODE.
      LDB BPNTR     LOAD ADDRESS OF MESSAGE.
* 
      LDA B,I       CHECK WORD 1: 
      SZA,RSS 
      JMP BADBF       ERROR IF ZERO.
      AND B377        ISOLATE MESSAGE CLASS.
      STA CLASS       SAVE IT.
      ADA N9
      SSA,RSS 
      JMP BADBF       ERROR IF MESSAGE CLASS > 8. 
* 
      ADB D2        CHECK WORD 3: 
      LDA B,I 
      STA STMWD       SAVE IT.
      AND B377        ISOLATE STREAM TYPE.
      STA STREM       SAVE IT.
      ADA NB20
      SSA 
      JMP BADBF       ERROR IF < OCTAL 20.
      ADA NB10
      SSA,RSS 
      JMP BADBF       ERROR IF > OCTAL 27.
* 
      ADB D5        CHECK WORD 8: 
      LDA B,I 
      SSA 
      JMP BADBF       ERROR IF NEGATIVE.
* 
      LDB BPNTR     VERIFY THAT 
      ADB D7         WDCNT <= N(WORDS) + 8. 
      LDB B,I 
      INB 
      CLE,ERB 
      ADB D8
      STB BUFL      SAVE WORD COUNT.
      INB 
      CMB,INB 
      LDA BPNTR,I 
      ALF,ALF 
      AND B377
      ADA B 
      SSA,RSS 
      JMP BADBF     ERROR.
      ISZ VERIF     NO ERROR, TAKE NORMAL RETURN. 
* 
      LDA TEMP      IF INCOMING REQ/REPLY,
      SZA            QUEZ HAS ALREADY 
      JMP VERIF,I     TRACED IT.
* 
      LDA #CL3K     TRACE OPTION REQUESTED? 
      SZA            (LU NOT SET.)
      SSA            (BAD LOG LU.)
      JMP VERIF,I   NO. 
* 
      LDA #CL3K+1   BUFFERS TO BE TRACED? 
      SSA,RSS       IF BIT 15 NOT SET,
      JMP VERIF,I    RETURN.
* 
      LDA D8        INITIALIZE TRACE
      STA TRLEN      LENGTH TO 8. 
* 
      LDA #CL3K+1   APPENDAGE BIT SET?
      AND BIT14 
      SZA,RSS 
      JMP WRTRC       NO. GO WRITE. 
* 
      LDA BPNTR,I   GET LENGTH OF 
      ALF,ALF        APPENDAGE AND
      AND B377        HEADER FROM 
      STA TRLEN        WORD 1.
* 
      LDA #CL3K+1   GET MAX DATA LENGTH 
      AND LENBT      FROM BITS 0-12.
      ADA TRLEN     ADD HEADER/APPEND LENGTH. 
      STA B         HOLD IN B-REG.
      CMA,INA       IF GREATER THAN ACTUAL
      ADA BUFL       BUFFER LENGTH, 
      SSA 
      LDB BUFL        USE BUFFER LENGTH.
      STB TRLEN     STORE TRACE LENGTH. 
* 
WRTRC CCA 
      ADA BPNTR     SET TRACE 
      STA TPNTR      POINTER. 
      LDB TPNTR,I   SET FIRST WORD
      STB HOLD       TO INDICATE
      LDB TEMP        DIRECTION.
      STB TPNTR,I 
      ISZ TRLEN     ADD 1 TO LENGTH.
      JSB TRCOT     WRITE TRACE.
      LDA HOLD      RESTORE FIRST 
      STA TPNTR,I    BUFFER WORD. 
      JMP VERIF,I   RETURN. 
* 
BADBF LDB TEMP      CHECK DIRECTION FLAG. 
      SZB,RSS 
      JMP VERIF,I   INCOMING--QUEZ ALREADY REPORTED IT. 
* 
      LDA LOG       SET BUFFER LENGTH 
      STA BUFL       TO REMAINING BLOCK 
      STA TRLEN       LENGTH & SET TRACE LEN. 
* 
      JSB EXEC      DISPLAY 
      DEF *+5        ">> HP 3000: BAD BUFFER OUTGOING". 
      DEF D2
      DEF D1
      DEF BDBUF 
      DEF D16 
* 
      LDA #CL3K     TRACE OPTION REQUESTED? 
      SZA            (LU NOT SET.)
      SSA            (BAD LOG LU.)
      JMP VERIF,I   NO. 
      JMP WRTRC     YES.
      SPC 1 
*  VALUES SET BY VERIF: 
CLASS NOP           DS/3000 MESSAGE CLASS.
STMWD NOP           DS/3000 STREAM WORD.
STREM NOP           DS/3000 MESSAGE STREAM. 
BUFL  NOP           WORD COUNT OF BUFFER. 
HOLD  NOP 
      SPC 5 
* 
* SUBROUTINE TO WRITE A RECORD TO TRACE LU. 
*  CALLING SEQUENCE: <SET UP TPNTR AND TRLEN> 
*                    JSB TRCOT
* 
TRCOT NOP           ENTRY POINT.
* 
      LDA #CL3K     CHECK 
      STA TRCST      BIT
      STA TRCIO       13 OF 
      AND BIT13        LOG WORD.
      SZA 
      JMP CLIO      SET--DO CLASS I/O.
* 
      JSB XLUEX     CHECK OUT 
      DEF *+3        DYNAMIC
      DEF SD3         STATUS. 
      DEF TRCST 
      JMP WRERR     ERROR RETURN. 
      AND B277      IF ANY "BAD" BITS 
      SZA            ARE SET, 
      JMP TRCDN        SET TRACE DOWN.
* 
      JSB XLUEX     WRITE ENTIRE
      DEF *+5        MESSAGE TO 
      DEF SD2         TRACING LU. 
      DEF TRCIO 
      DEF TPNTR,I 
      DEF TRLEN 
      RSS           ERROR RETURN. 
      JMP TRCOT,I   NO ERROR. RETURN. 
* 
WRERR DST ABREG     PRINT 
      JSB EXEC       ERROR
      DEF *+5         MESSAGE.
      DEF SD2 
      DEF D1
      DEF IOERR 
      DEF D13 
      NOP 
* 
TRCDN LDA #CL3K     SET "BAD" BIT 
      IOR BIT15      IN TRACE LU. 
      STA #CL3K 
      JMP TRCOT,I   RETURN. 
* 
CLIO  LDA #CL3K     SET NO-WAIT BIT 
      IOR BIT15      IN CLASS NUMBER. 
      STA CLASN 
      JSB EXEC      WRITE TO I/O CLASS. 
      DEF *+8 
      DEF CLS20 
      DEF D0
      DEF TPNTR,I 
      DEF TRLEN 
      DEF TRLEN 
      DEF D0
      DEF CLASN 
      JMP WRERR     (ERROR RETURN.) 
      SZA,RSS       CHECK FOR NO S.A.M. 
      JMP TRCOT,I   NO ERROR...RETURN.
      DLD "SAM"     REPORT SAM ERROR. 
      JMP WRERR 
* 
"SAM" ASC 2,SAM 
IOERR ASC 11,/QUEX: TRACING ERROR 
ABREG BSS 2 
TRLEN NOP           TRACE OUTPUT LENGTH.
TPNTR NOP           TRACE OUTPUT POINTER. 
TRCIO OCT 0,100     TRACE LU/BINARY BIT 
TRCST OCT 0,600     TRACE LU/STATUS FUNCTION
SD3   DEF 3,I 
B277  OCT 277 
      SPC 4 
* 
* SUBROUTINE TO LOAD WORD FROM ALTERNATE MAP (IF RTE-III OR IV).
* 
LODWD NOP 
MODI2 LDA B,I       GET WORD FROM TCB (RSS IF DMS SYSTEM).
      JMP LODWD,I   RETURN IF RTE-II. 
      XLA B,I       LOAD WORD FROM ALTERNATE MAP. 
      JMP LODWD,I   RETURN. 
      SKP 
* 
*  SUBROUTINE TO CLEAN UP FOR FRESH START:
*  TELL UPLIN TO TIMEOUT ALL MASTER REQUESTS TO 3000 AND ZERO PNL LIST. 
*  NEW REQUESTS ARE BLOCKED SINCE HP 3000 IS IN "DISCONNECT" STATUS.
* 
CLNUP NOP 
      CLA,INA       SET SIGN OFF FLAG.
      STA SGNOF 
      LDA #QXCL     SET DISCONNECT FLAG IN #QXCL
      IOR BIT15      TO INDICATE DISCONNECT STATUS. 
      STA #QXCL 
* 
      JSB EXEC      TERMINATE 
      DEF *+4        QUEZ.
      DEF SD6 
      DEF QUEZ
      DEF D3
      NOP           (ERR RETRN IF QUEZ ALREADY DORMNT)
* 
*  LOCK "QUEX ABORT" RN (GLOBALLY) SO UPLIN WILL CLEAN UP.
* 
      JSB RNRQ
      DEF *+4 
      DEF GLOCK 
      DEF #CLRN 
      DEF TEMP
      NOP           ERROR RETURN. 
* 
      LDA QXCLS     QUEX CLASS # /NO DE-ALLOC (BIT13).
      IOR BIT15     SET NO-WAIT BIT (#15).
      STA CLASN     RELEASE BUFFER. 
* 
FLUSH JSB EXEC      FLUSH QUEX'S I/O CLASS. 
      DEF *+5 
      DEF CLS21 
      DEF CLASN 
      DEF D0
      DEF D0
      RSS           IGNORE ERRORS.
* 
      SSA,RSS       ANYTHING THERE? 
      JMP FLUSH     YES. KEEP FLUSHING. 
* 
*  HANG ON "QUEX ABORT" RN UNTIL UPLIN FINISHES CLEANUP.
      JSB RNRQ
      DEF *+4 
      DEF LKCLR 
      DEF #CLRN 
      DEF TEMP
      NOP           ERROR RETURN. 
* 
      JMP CLNUP,I   RETURN TO CALLER. 
      SPC 2 
GLOCK OCT 40002 
LKCLR OCT 40006 
SD2   DEF 2,I 
SD6   DEF 6,I 
      SPC 5 
* 
*  WRONG DRIVER FOR THIS QUEX. REPORT THE ERROR.
* 
WRDVR JSB EXEC      REPORT ERROR
      DEF *+5        ON SYS CONSOLE.
      DEF D2
      DEF D1
      DEF WRMSG 
      DEF D13 
* 
      JSB EXEC      SUSPEND.
      DEF *+2 
      DEF D7
* 
      JMP WRDVR     STAY IN LOOP IN CASE OF "GO". 
* 
WRMSG ASC 13,>> QUEX EXPECTS MODEM LINK 
      SPC 3 
* 
*  READ ERROR REPORTED BY QUEZ. 
* 
RDERR LDA !READ     SET I/O OPERATION 
      STA CLTYP      INDICATOR TO READ. 
      LDA BPNTR,I   LOAD STATUS.
      JSB CKDVR     REPORT ERROR. 
      JMP INIT      (SHOULDN'T RETURN!) 
      SPC 3 
* 
*  SUBROUTINE TO CHECK FOR DRIVER ERRORS. 
* 
CKDVR NOP           ENTRY.
      RAR 
      SLA,RSS       IF NO ERROR,
      JMP CKDVR,I     RETURN. 
      AND B170      ISOLATE STATUS. 
      LDB @DERR 
      JSB SERCH     GET ERROR DESCRIPTION.
      LDB @STAT     MOVE TO 
      JSB .MVW       OUTPUT 
      DEF D7          AREA. 
      NOP 
      LDB @DCLL 
      LDA CLTYP     GET CALL TYPE 
      JSB SERCH      DESCRIPTION. 
      LDB @CALL     MOVE TO 
      JSB .MVW       OUTPUT 
      DEF D7          AREA. 
      NOP 
      JSB EXEC      PRINT 
      DEF *+5        "DOWN" 
      DEF D2          MESSAGE.
      DEF D1
      DEF STMSG 
      DEF D30 
* 
      JSB CLNUP     CLEAN UP. 
* 
      LDA NB20
      JSB SLEEP     WAIT 80 SECONDS.
* 
      JMP INIT      CLOSE LINE. 
      SPC 2 
*  SUBROUTINE USED BY CKDVR TO FIND ENTRY IN TABLE. 
SERCH NOP           ENTRY 
      STA TEMP      SAVE VALUE. 
* 
SLOOP LDA B,I       GET TABLE VALUE.
      SZA           IF ZERO (EOT) 
      CPA TEMP       OR EQUAL TO VALUE, 
      JMP FOUND        WE'VE FOUND IT.
      ADB D8        OTHERWISE BUMP POINTER
      JMP SLOOP      AND STAY IN LOOP.
* 
FOUND LDA B         POINT TO ADDRESS
      INA            OF ASCII MESSAGE.
      JMP SERCH,I   RETURN. 
      SPC 2 
* 
*  SUBROUTINE TO GO DORMANT (UPLIN WILL RESTART). 
* 
SLEEP NOP           ENTRY 
      STA TEMP      SAVE COUNTER. 
* 
CYCLE JSB EXEC      TERMINATE,
      DEF *+4        SAVING 
      DEF D6          RESOURCES.
      DEF D0
      DEF D1
* 
      ISZ TEMP      IF MORE IN COUNTER, 
      JMP CYCLE      STAY IN LOOP.
* 
      JMP SLEEP,I   RETURN. 
      SPC 2 
* 
STMSG BYT 15,12     <CR>,<LF> 
      ASC 11,>> HP 3000 LINK *DOWN* 
      BYT 15,12     <CR>,<LF> 
EMSG  ASC 16,>> ************* @ ************* 
      BYT 15,12     <CR>,<LF> 
@STAT DEF EMSG+1
@CALL DEF EMSG+9
BDBUF ASC 16,>> HP 3000: BAD BUFFER RECEIVED
      SKP 
* 
* CONSTANTS AND WORKING STORAGE.
* 
* 
NB10  OCT -10 
NB20  OCT -20 
B170  OCT 170 
B377  OCT 377 
B140K OCT 140000
BIT15 OCT 100000
BIT14 OCT 40000 
BIT13 OCT 20000 
NBT13 OCT 157777
LENBT OCT 17777     BITS 0-12 
CLS20 DEF 20,I
CLS21 DEF 21,I
D7    DEC 7 
D8    DEC 8 
D10   DEC 10
D11   DEC 11
D13   DEC 13
D26   DEC 26
D30   DEC 30
N1    DEC -1
N9    DEC -9
QXCLS NOP           QUEX CLASS NUMBER.
QCLAS NOP           (WITH NO-WAIT & SAVE-BUFFER BITS SET.)
LOG   NOP           WORDS TO PROCESS IN CURRENT BUFFER
SGNOF OCT 0 
QUEZ  ASC 3,QUEZ
* 
* TABLE OF CONTROL WORDS. 
DISWD OCT 0,3100      DISCONNECT
CNCWD OCT 0,3000      CONNECT 
WRTWD OCT 0,1100      WRITE DS2 MESSAGE 
DEFWD OCT 0,3700      SET DEFAULTS
PRMWD OCT 0,3600      GET PARAMETERS
* 
CNPWD NOP 
CNSWD NOP 
* 
CLASN NOP 
WRTLN NOP 
TEMP  NOP 
PRAMS BSS 7 
* 
STRTM DEF *+1 
      BYT 10,0      INITIALIZATION REQUEST. 
      DEC 0 
B20   OCT 20
      OCT 0,0,0,0,0 
D16   EQU B20 
* 
INTRP DEF *+1 
      BYT 10,0
      DEC 0         INITIALIZATION REPLY. 
      OCT 100020
      OCT 0,0,0,0,0 
* 
TRMRQ DEF *+1 
      BYT 10,0      TERMINATION REQUEST.
      DEC 0 
B21   OCT 21
      OCT 0,0,0,0,0 
D17   EQU B21 
      SPC 2 
* BSC BOARD DEFAULT BUFFER
DEFBF BYT 377,2 
BLKSZ NOP           DATA BLOCK SIZE 
D0    DEC 0         INTERMEDIATE BLOCK SIZE 
      DEC 0         HEADER BLOCK SIZE 
      BYT 10,377    MAX TRY COUNT/CONNECT TIMERS
IDSEQ BSS 129       ROOM FOR ID SEQUENCES 
* 
DEFLN NOP           LENGTH OF DEFAULT BUFFER
MINLN ABS IDSEQ-DEFBF  MINIMUL LENGTH OF BUFFER.
@ID   DEF IDSEQ 
IDPNT NOP           POINTER INTO BUFFER.
      SPC 2 
*** TABLES FOR ERROR MESSAGES *** 
* 
CLTYP NOP 
@DCLL DEF *+1 
!DISC DEC 1 
D1    EQU !DISC 
      ASC 7, DISCONNECT 
!PCNT DEC 2 
D2    EQU !PCNT 
      ASC 7, PRIMARY CONCT
!SCNT DEC 3 
D3    EQU !SCNT 
      ASC 7, SECNDRY CONCT
!INTL DEC 4 
      ASC 7, INITIALIZE 
!READ DEC 5 
D5    EQU !READ 
      ASC 7, READ 
!GTPR DEC 6           
D6    EQU !GTPR 
      ASC 7, GET PARAMS 
!WRIT DEC 0 
      ASC 7, WRITE
* 
@DERR DEF *+1 
      OCT 10
      ASC 7, LINE FAILURE 
      OCT 20
      ASC 7, TIMEOUT
      OCT 40
      ASC 7, OVERRUN
      OCT 50
      ASC 7, REMOTE BUSY
B100  OCT 100 
      ASC 7, UNINITIALIZED
      OCT 110 
      ASC 7, WRONG TYPE 
      OCT 130 
      ASC 7, CARD FAILURE 
      OCT 0 
      ASC 7, ILLEGAL REQST
      SPC 1 
DLMSG ASC 17,>> HP 3000 LINK READY FOR DIALING
TOMSG ASC 26,>> HP 3000 LINK DIALING TIMEOUT. NOW AWAITING CALL.
* 
      BSS 0        ***   SIZE OF QUEX ****
* 
      SKP 
      IFZ           *** DEBUG OPTION ***
***** SPECIAL DEBUG SECTION: TRACE
*  INSERT A "JSB TRACE" IN PROGRAM. QUEX WILL PRINT CALL LOCATION 
*  AND CONTENTS OF A- & B-REGISTERS ON LU SPECIFIED IN #CL3K+6. 
* 
      EXT CNUMO 
TRACE NOP           ENTRY 
      DST ABREG     STORE REGISTERS 
      LDA #CL3K+6 
      SZA,RSS       IF TRACE LU ISN'T SPECIFIED,
      JMP TRTRN      RETURN FROM TRACE. 
* 
      STA TRLU      SAVE LU NUMBER. 
* 
      LDB 1727B     GET POINTER TO STARTING ADDR FROM BASE PG.
      JSB LODWD     GET STARTING ADDR FROM ID SEG.
      CMA,INA       NEGATE. 
      ADA TRACE     ADD CALLING ADDRESS 
      STA TOFST      TO GET OFFSET. 
* 
      JSB CNUMO     CONVERT 
      DEF *+3        ADDRESS OFFSET 
      DEF TOFST       TO
      DEF TADDR        OCTAL. 
* 
      JSB CNUMO     CONVERT 
      DEF *+3        A-REG
      DEF ABREG       TO
      DEF TAREG        OCTAL. 
* 
      JSB CNUMO     CONVERT 
      DEF *+3        B-REG
      DEF ABREG+1     TO
      DEF TBREG        OCTAL. 
* 
      JSB XLUEX     PRINT 
      DEF *+5        INFORMATION. 
      DEF SD2 
      DEF TRLU
      DEF TINFO 
      DEF D20 
      NOP 
TRTRN DLD ABREG     RESTORE REGISTERS.
      JMP TRACE,I   RETURN. 
* 
D20   DEC 20
TOFST NOP 
TINFO ASC 7,/QUEX TRACE @ 
TADDR ASC 3,
      ASC 2,: A=
TAREG ASC 3,
      ASC 2,, B=
TBREG ASC 3 
TRLU  OCT 0,0       TRACE LU. 
      XIF           ***** END OF DEBUG *****
      END  QUEX