ASMB,L,R,C
      HED QCLM 91700-16157 REV A * (C) HEWLETT-PACKARD CO. 1976 
      NAM QCLM,2,28 91700-16157 REV A 760101
      SPC 2 
******************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. 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 
      SPC 2 
****************************************************************
* 
*     QCLM  COMMUNICATION MANAGMENT CLEANING MODULE 
* 
*     SOURCE PART # 91700-18157 REV A 
* 
*     REL PART #    91700-16157 REV A 
* 
*     WRITTEN BY    JEAN-PIERRE BAUDOUIN
* 
*     DATE WRITTEN  DEC 1975
* 
*     MODIFIED BY   BOB SHATZER 
* 
*     DATE MODIFIED 01 JAN 76 
* 
*************************************************************** 
      SPC 2 
      EXT EXEC,#QCLM
      EXT D65CL,D65SV,#RSAX 
      EXT $LIBR,$LIBX,$CVT3,#PLOG,#QLOG 
      IFZ 
      EXT DBUG
      XIF 
      SUP 
      SPC 3 
QCLM  LDA B,I       GET 1ST PARAMETER 
      IFZ 
      CPA D99       DO WE WANT DBUG ? 
      RSS           YES 
      JMP START     NO
      JSB DBUG      YES, CALL IT
      DEF *+1 
* 
      JSB EXEC      TERMINATE AND SAVE RESOURCES
      DEF *+4 
      DEF D6
      DEF D0
      DEF D1
      XIF 
      SPC 3 
* 
*     FIRST WE CLEAN THE BUFFER 
* 
START LDA BUFI      SET THE POINTER TO 1ST WORD 
      LDB DM42      SET THE COUNTER 
      STB CNTR1 
      CLB 
      STB A,I       CLEAR A WORD
      INA           STEP TO NEXT WORD 
      ISZ CNTR1     DONE ?
      JMP *-3       NO, CONTINUE
* 
      JSB EXEC      YES, HANG ON OUR CLASS
      DEF *+6 
      DEF D21I      CLASS GET-NO ABORT
      DEF #QCLM     OUR CLASS IS IN RES 
BUFI  DEF IBUF      BUFFER ADDRESS
      DEF D42       MAX BUFFER LENGTH (QCB+PARMB) 
      DEF XEQT      ADDRESS OF ID SEG OF CALLER 
      JMP QUIT      ERROR RETURN
* 
      LDA #PLOG     GET GENERAL PARMB LOGGING FLAG
      STA LOGCL     SAVE IT AS PLOG CLASS JUST IN CASE
      SZA           IS LOGGING TO BE DONE?
      JMP LOGIT     YES - WRITE QCB AND PARMB TO PLOG 
      LDA #QLOG     GET QUEUEING LOG FLAG 
      STA LOGCL     SAVE THAT JUST IN CASE
      SZA,RSS       IS SPECIAL LOGGING DESIRED? 
      JMP NOLOG     NO - DON'T LOG ANYTHING 
* 
LOGIT JSB EXEC      FOR EITHER CASE, WRITE TO PLOG
      DEF *+8 
      DEF D20I
      DEF D0
      DEF IBUF
      DEF D42 
      DEF XEQT
      DEF "QC"
      DEF LOGCL 
      NOP           IGNORE THE ERROR RETURN 
* 
NOLOG LDA IBUF      GET QCB CONTROL WORD
      SZA,RSS       ARE ANY BITS SET? 
      JMP START     NO - GET NEXT COMPLAINT 
      SSA,RSS       IS BIT 15 SET? (CATASTROPHIC ERROR) 
      JMP TEST      NO - GO TEST OTHER BITS 
* 
      LDB XEQT      WE WILL TRANSFER THE NAME OF
      ADB D12         THE PROGRAM WHICH CALLED US 
      LDA B,I           INTO AN INTERNAL BUFFER 
      STA ORIGN           FOR OUR MESSAGE.
      INB           STEP TO SECOND WORD 
      LDA B,I       GET IT
      STA ORIGN+1   SAVE
      INB           STEP TO LAST
      LDA B,I       GET IT
      AND B174K     SAVE THE UPPER BYTE 
      IOR B72       MERGE A ":" FOR THE MESSAGE 
      STA ORIGN+2   SAVE
* 
*     WE NOW CODE THE QCB IN ASCII (ALL OF IT IS OCTAL) 
*     AND WE FORMAT IT IN A SECOND LINE OF MESSAGE
*     THIS IS TO HELP THE RECOVERY
* 
      LDA W1A       GET THE ADDRESS OF THE 1ST WORD 
      STA PNTR1       USE AS DESTINATION POINTER
      LDA BUFI      GET ADDRESS OF QCB
      STA PNTR2       USE AS ORIGIN POINTER 
      LDA DM7       SET A COUNTER 
      STA CNTR1 
* 
OUTLP CLE           SET FOR OCTAL CONVERSION
      LDA PNTR2,I   GET A WORD
      JSB $LIBR     FENCE OFF 
      NOP 
      JSB $CVT3     CODE
      LDB A,I       MOVE THE ASCII INTO ITS 
      STB PNTR1,I     BUFFER. 
      INA           STEP TO SECOND WORD 
      ISZ PNTR1     STEP THE DESTINATION POINTER
      DLD A,I       GET LAST 2 WORDS
      DST PNTR1,I   SAVE
      JSB $LIBX     FENCE BACK ON 
      DEF *+1 
      DEF *+1 
      LDA PNTR1     GET THE DESTINATION POINTER 
      ADA D4        PUSH IT 
      STA PNTR1       AND RESTORE IT
      ISZ PNTR2     STEP TO NEXT QCB WORD 
      ISZ CNTR1     ALL DONE ?
      JMP OUTLP     NO, CONTINUE
* 
      JSB EXEC      OUTPUT THE CATASTROPHIC ERROR MESSAGE 
      DEF *+5 
      DEF D2        WRITE 
      DEF D1        CRT 
      DEF MSG       MESSAGE ADDRESS 
      DEF MSGL      MESSAGE LENGTH
* 
      JMP START     GO, GET NEXT COMPLAINT
      SPC 3 
* 
*     IN THIS AREA WE TREAT THE NON CATASTROPHIC ERRORS 
* 
TEST  LDA TBTOP     GET ADDRESS OF TABLE TOP
      STA TPNTR     SET TABLE POINTER 
      LDA DM16      SET UP COUNTER TO CHECK LOW 14 BITS 
      STA BTCNT       OF CONTROL WORD 
* 
LOOP2 LDA IBUF      GET THE CODE WORD 
LOOP1 ISZ TPNTR     STEP TO NEXT ROUTINE
      ISZ BTCNT     ALL BITS CHECKED? 
      RSS           NO
      JMP START     YES - GO BACK TO GET
      SLA,RAR       DO WE WANT IT ? 
      RSS           YES 
      JMP LOOP1     NO
* 
      LDB TPNTR     GET THE ADDRESS OF THE ROUTINE
      SZB,RSS       IS THERE A ROUTINE ?
      JMP LOOP1     NO, FORGET IT 
      INB,SZB,RSS   END OF TABLE ?
      JMP START     YES, GET NEXT COMPLAINT 
* 
      STA IBUF      SAVE THE CODE WORD
      LDB TPNTR,I   GET THE ROUTINE POINTER 
      JMP B,I       GO EXECUTE THE ROUTINE
      SPC 3 
      HED QCLM: ROUTINES * (C) HEWLETT-PACKARD CO. 1976 
* 
*     HERE FOR "SEND STOP"
* 
BIT0  CLB 
      JSB CNTRL     SEND CONTROL REQUEST
      JMP LOOP2     RETURN
* 
*     HERE FOR "SEND REMOTE BUSY" 
* 
BIT1  LDA PARMB     GET 1ST WORD
      IOR BZYBT     INSERT THE BUSY BIT 
      STA PARMB     REPLACE THE WORD
      JSB SEND      SHIP THE PARMB
      JMP LOOP2     RETURN
* 
*     HERE FOR "SEND ILRQ"
* 
BIT2  LDA ILRQ      SET 
      STA PARMB+2     "ILRQ"
      LDA ILRQ+1        INTO THE
      STA PARMB+3         PARMB 
      JSB SEND      SHIP IT 
      JMP LOOP2     RETURN
* 
*     HERE FOR "CLEAR DRIVER" 
* 
BIT3  LDB B200      SET FOR CLEAR 
      JSB CNTRL     SEND CONTROL REQUEST
      JMP LOOP2     RETURN
* 
*     HERE FOR "DOWN THE EQT" 
* 
BIT4  LDB B400      SET FOR DOWN EQT
      JSB CNTRL     SEND CONTROL REQUEST
      JMP LOOP2     RETURN
* 
*     HERE FOR "DEALLOCATE ENTRY" 
* 
BIT5  JSB #RSAX     CALL THE ENTRY MANIPULATOR
      DEF *+5 
      DEF D3        DEALLOCATE ONE ENTRY
      DEF IBUF+2    ST-LS POINTER 
      DEF IBUF+4    SELECT CODE 
      DEF PARMB+33  TIME TAGS 
      NOP           ERROR RETURN
      JMP LOOP2     RETURN
      SPC 3 
* 
* 
*     THIS ROUTINE WILL DO A CONTROL REQUEST ON THE LINE. 
*     THE MODE FIELD OF THE CONTROL WORD IS PASSED IN B 
*     REGISTER
* 
CNTRL NOP 
      LDA IBUF+3    GET LU WORD 
      AND B77       MAKE SURE THE REST IS CLEAN 
      IOR B         INCLUDE THE MODE
      STA CNWD      SAVE AS CONTROL WORD
* 
      JSB D65CL 
      DEF *+7 
      DEF D3        CONTROL REQUEST 
      DEF CNWD
      DEF DUMMY 
      DEF DUMMY 
      DEF DUMMY 
      DEF DUMMY 
      NOP           ERROR RETURN (IGNORED)
      JMP CNTRL,I   RETURN
      SPC 3 
* 
*     THIS ROUTINE WILL SEND A REPLY PARMB
* 
SEND  NOP 
      LDA IBUF+3    GET LU
      AND B77       CLEAN IT
      STA IBUF+3    SAVE
* 
      JSB D65SV 
      DEF *+7 
      DEF D2        WRITE 
      DEF IBUF+3    REQUEST ONLY
      DEF PARMB     BUFFER ADDRESS
      DEF D35       LENGTH
      DEF DUMMY 
      DEF DUMMY 
* 
      NOP           ERROR RETURN ( IGNORED )
      JMP SEND,I
      SPC 3 
QUIT  JSB EXEC      GIVE UP AND TERMINATE 
      DEF *+2 
      DEF D6
      SPC 3 
      HED QCLM: DECLARATIONS * (C) HEWLETT-PACKARD CO. 1976 
A     EQU 0 
B     EQU 1 
IBUF  BSS 7         THESE 2 BUFFERS  M U S T  STAY TOGETHER 
PARMB BSS 35          **  QCB + PARMB  ** 
BZYBT OCT 20000     BUSY BIT
DM42  DEC -42 
DM16  DEC -16 
BTCNT NOP 
DM7   DEC -7
D0    DEC 0 
D1    DEC 1 
D2    DEC 2 
D3    DEC 3 
D4    DEC 4 
D6    DEC 6 
D12   DEC 12
D20I  ABS 100000B+20
D35   DEC 35
D42   DEC 42
D99   DEC 99
D21I  OCT 100025
B77   OCT 77
B200  OCT 200 
B400  OCT 400 
B174K OCT 177400
B72   OCT 72
CNWD  NOP 
DUMMY NOP 
ILRQ  ASC 2,ILRQ
"QC"  ASC 1,QC
LOGCL NOP 
XEQT  NOP 
TPNTR NOP 
PNTR1 NOP 
PNTR2 NOP 
CNTR1 NOP 
MSG   OCT 6412
      ASC 1, /
ORIGN BSS 3 
      ASC 15, CATASTROPHIC NETWORK FAILURE
      OCT 6412
      ASC 3, QCB: 
W1    BSS 3 
      ASC 2,  / 
      BSS 3 
      ASC 2,  / 
      BSS 3 
      ASC 2,  / 
      BSS 3 
      ASC 2,  / 
      BSS 3 
      ASC 2,  / 
      BSS 3 
      ASC 2,  / 
      BSS 3 
      OCT 6412
MSGL  DEC 58
W1A   DEF W1
      SPC 3 
* 
*     TABLE FOR THE ROUTINES
* 
TBTOP DEF * 
      DEF BIT0
      DEF BIT1
      DEF BIT2
      DEF BIT3
      DEF BIT4
      DEF BIT5
      DEC -1        END OF TABLE MARK 
      SPC 3 
      END QCLM
                                                                                                                                                          