ASMB,R,Q,C
      HED QCLM 91750-16216 REV 2013 * (C) HEWLETT-PACKARD CO. 1979
      NAM QCLM,19,28 91750-16152 REV 2013 800126 ALL
      SPC 2 
******************************************************************
*  * (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 
* 
*     NAME:   QCLM
*     SOURCE: 91750-18152 
*     RELOC:  91750-16152 
*     PGMR:   CHUCK WHELAN
*     DATE WRITTEN  DEC 1976
* 
*     MODIFICATION FOR 91750: 
*     ----------------------- 
*     MODIFIED BY GAB [790206] TO REPLACE EXTENDED INSTR'S W/JSB'S
*     MODIFIED BY DWT [790606] FOR PHASE FIVE (REMOVE O/S DEPENDENCE) 
*     MODIFIED BY DWT [790813] TO SUPPORT MORE MESSAGES 
*     MODIFIED BY TKM [791212] TO SUPPORT 'MA REMOVED' MSG
* 
      SPC 2 
      EXT EXEC,#QCLM,DTACH,TMVAL,.MVW 
      SUP 
      SPC 3 
* 
QCLM  EQU * 
      JSB DTACH 
       DEF *+1
      LDA #QCLM     GET QCLM CLASS NUMBER 
      ALR,RAR         AND REMOVE NO WAIT BIT
      STA QCLS
QCLM2 JSB EXEC      AWAIT WRITES TO QCLM CLASS
       DEF *+6
       DEF K21
       DEF QCLS      CLASS WORD IN STORAGE
       DEF IBUF      BUFFER ADDRESS 
       DEF K12
       DEF MTYPE     MESSAGE TYPE 
* 
* 
*     DETERMINE THE MESSAGE TYPE
* 
      LDA MTYPE     GET MESSAGE TYPE
      CPA K1
      JMP TYPE1 
      CPA K2
      JMP TYPE2 
      CPA K3
      JMP TYPE3 
      CPA K4
      JMP TYPE4 
      CPA K5
      JMP TYPE5 
      CPA K6
      JMP TYPE6 
      CPA K7
      JMP TYPE7 
      CPA K8
      JMP TYPE8 
      CPA K9
      JMP TYPE9 
      SPC 3 
* 
*     HERE FOR UNEXPECTED ERRORS (I.E., CATASTROPHIC) 
* 
      LDA PGM       MOVE PROGRAM
      STA ORIGN      NAME TO
      DLD PGM+1      OUTPUT 
      DST ORIGN+1    BUFFER 
*                   CONVERT REGISTER VALUES TO OCTAL
      LDA SEQ#
      JSB DEC6
       DEF .SEQ.
      LDA STREM 
      JSB OCTAL 
       DEF .STR.
      LDA @CVFD     GET THE ADDRESS OF THE 1ST WORD 
      STA PNTR1       USE AS DESTINATION POINTER
      LDA @PREG     GET ADDRESS WHERE P, A AND B REGISTER CONTENTS ARE STORED 
      STA PNTR2       USE AS ORIGIN POINTER 
      LDA N3        SET TO CONVERT 3 WORDS
      STA CNTR1 
* 
OUTLP EQU *         SET FOR OCTAL CONVERSION
      LDA PNTR2,I   GET VALUE 
      ISZ PNTR2 
      JSB OCTAL 
PNTR1 NOP           STORE ASCII HERE. 
* 
      LDA PNTR1     GET THE DESTINATION POINTER 
      ADA K5         MOVE IT TO 
      STA PNTR1       THE NEXT ENTRY. 
      ISZ CNTR1     ALL DONE ?
      JMP OUTLP     NO, CONTINUE
* 
      JSB EXEC      OUTPUT THE CATASTROPHIC ERROR MESSAGE 
       DEF *+5
       DEF K2        WRITE
       DEF K1        CRT
       DEF MSG       MESSAGE ADDRESS
       DEF MSGL      MESSAGE LENGTH 
* 
      JMP QCLM2     GO, GET NEXT COMPLAINT
* 
*      HERE FOR "REPLY FLUSHED" ERROR 
* 
* 
TYPE1 DLD AREG      A&B HAVE ASCII ERROR CODE 
      DST .DSXX 
      DLD @MSG1     GET ADDR OF MESG AND LENGTH 
      DST @OUT1 
      JMP TYPEX     JUMP TO TYPEX PRINT 
* 
*     HERE FOR "TCB NOT FOUND, POSSIBLE TIMEOUT"
* 
TYPE2 DLD @MSG2 
      DST @OUT1 
      JMP TYPEX 
* 
*     HERE FOR "COMMUNICATIONS READ" ERROR
* 
TYPE3 EQU * 
      LDA IBUF
      JSB DEC4      CONVERT LU TO DECIMAL 
       DEF .LU3 
      LDA IBUF+1    CONVERT I/O STATUS TO OCTAL 
      JSB OCTAL 
       DEF .STAT
      DLD @MSG3 
      DST @OUT2 
      JMP OUTMS 
* 
*   MA REMOVED FROM NODE
* 
TYPE4 EQU * 
      LDA IBUF
      JSB DEC6      CONVERT NODE NUMBER 
       DEF .N4
      DLD @MSG4 
      DST @OUT2 
      JMP OUTMS 
* 
*   HERE FOR "UP/DOWN COUNTER EXCEEDED" ERROR 
* 
TYPE5 EQU * 
      LDA IBUF
      JSB DEC4      CONVERT DISABLED LU TO DECIMAL
       DEF .LU5 
      DLD @MSG5 
      DST @OUT2 
      JMP OUTMS 
* 
*   HERE FOR "LINK JUST CAME UP" MESSAGE
* 
TYPE6 EQU * 
      LDA IBUF
      JSB DEC4
       DEF .LU6 
      DLD @MSG6     GET ADDR OF MESG & LENGTH 
      DST @OUT2 
      JMP OUTMS 
* 
*   HERE FOR "LINK JUST WENT DOWN" MESSAGE
* 
TYPE7 EQU * 
      LDA IBUF
      JSB DEC4
       DEF .LU7 
      DLD @MSG7 
      DST @OUT2 
      JMP OUTMS 
* 
*   HERE FOR "SELF-CHECK ERROR" 
* 
TYPE8 EQU * 
      LDA PGM 
      STA .PGM8 
      DLD PGM+1 
      DST .PGM8+1 
      LDA PREG
      JSB OCTAL 
       DEF .P8
      LDA AREG
      JSB OCTAL 
       DEF .A8
      LDA BREG
      JSB OCTAL 
       DEF .B8
      DLD @MSG8 
      DST @OUT2 
      JMP OUTMS 
* 
*     INTERNAL MESSAGE ACCOUNTING ERROR 
* 
TYPE9 EQU * 
      LDA IBUF
      JSB DEC6      GET NODE NUMBER 
       DEF .N9
      LDA IBUF+1    GET MA FLAGS
      JSB OCTAL 
       DEF .F9
      LDA IBUF+2    <A> REGISTER
      JSB OCTAL 
       DEF .A9
      LDA IBUF+3    <B> REGISTER
      JSB OCTAL 
       DEF .B9
      DLD @MSG9 
      DST @OUT2 
      JMP OUTMS 
* 
TYPEX JSB EXEC      OUTPUT MESSAGE
       DEF *+5
       DEF K2 
       DEF K1 
@OUT1  NOP          MESSAGE ADDRESS 
       NOP          MESSAGE LENGTH ADDR 
      LDA STREM     CONVERT STREAM WORD TO OCTAL
      JSB OCTAL 
       DEF MSGX+4 
      LDA SRC#
      JSB DEC6      CONVERT ORIGINATION NODE #
       DEF .OX+6
      LDA DESTN     CHECK DESTINATION NODE
      LDB @DLUX        FOR (-) INDICATING 
      SSA                 LU # NOT NODE # 
      JMP LUX 
      LDA @DX       <A> --> NODE MSG
      JSB .MVW      MOVE IN MSG 
       DEF K9 
       NOP
      LDA DESTN     CONVERT NODE #
      JSB DEC6
       DEF .DLUX+6
      JMP ENDX
* 
LUX   LDA @LUX      <A> --> LU MSG
      JSB .MVW      MOVE IN MSG 
       DEF K9 
       NOP
      LDA DESTN     CONVERT LU #
      CMA,INA          TO (POSITIVE) DECIMAL
      JSB DEC4
       DEF .DLUX+2
ENDX  DLD @MSGX 
      DST @OUT2 
* 
OUTMS JSB EXEC      OUTPUT MESSAGE
       DEF *+5
       DEF K2 
       DEF K1 
@OUT2  NOP
       NOP
* 
      JSB CVTIM     CONVERT TIME-OF-DAY TO ASCII
      JSB EXEC      OUTPUT TIME 
       DEF *+5
       DEF K2 
       DEF K1 
       DEF TIME 
       DEF TIMEL
      JMP QCLM2     GO BACK TO CLASS "GET"
      SKP 
* 
*     SUBROUTINE TO OBTAIN TIME-OF-DAY AND CONVERT IT TO
*     ASCII.  RESULTS RETURNED IN BUFFER ".TIME"
* 
CVTIM NOP 
      JSB TMVAL     CONVERT TIME-OF-DAY TO HOURS,MINUTES, SECONDS 
       DEF *+3
       DEF TOD
       DEF TMAR 
      LDA TMAR+3
      JSB DEC2      CONVERT HOUR NUMBER TO ASCII
       DEF .HR
      LDA TMAR+2
      JSB DEC2      CONVERT MINUTES TO ASCII
       DEF .MIN 
      LDA TMAR+1
      JSB DEC2      CONVERT SECONDS 
       DEF .SEC 
      JSB EXEC      GET ACTUAL DAY NUMBER 
       DEF *+3
       DEF K11
       DEF TMAR 
       LDA TMAR+4 
      JSB DEC4      CONVERT DAY NUMBER
       DEF .DAY 
      JMP CVTIM,I   RETURN
      SKP 
* OCTAL-  (OBVIOUSLY) BINARY TO OCTAL ASCII 
*     <A> = BINARY  FOLLOWED BY DEF TO OUTPUT 
OCTAL NOP 
      LDB OCTAL,I 
      STB PTR 
      ISZ OCTAL 
      LDB DM3 
      STB CTRO  
      LSL 16        <B>:=<A>, <A>:=0
      RRR 2         1ST TIME ONLY GET BIT15 
OCT1  RRL 3 
      ALF,RAL 
      RRL 3         NET SHIFT = 8 
      IOR "00"
      STA PTR,I 
      CLA 
      ISZ PTR 
      ISZ CTRO  
      JMP OCT1
      JMP OCTAL,I 
* 
DM3   DEC -3
"00"  ASC 1,00
CTRO  BSS 1 
PTR   BSS 1 
      SKP 
* 
* DEC[N]- CONVERTS BINARY TO DECIMAL (LEFT JUSTIFIED) 
*     <A> = BINARY
*     JSB DEC[N]
*      DEF WHERE TO PUT [N] CHARACTERS
* 
      EXT .MBT,.SBT 
* 
DEC2  NOP 
      LDB D2
      JSB DECML 
DEC4  NOP 
      LDB D4
      JSB DECML 
DEC6  NOP 
      LDB D6
      JSB DECML 
DECML NOP 
      STA NBR       SAVE <A>
      STB D         NUMBER OF BYTES TO MOVE 
      LDA DECML     CORRECT RETURN ADDRESS
      ADA DM3 
      LDA 0,I 
      STA DECML 
      LDB DECML,I 
      ISZ DECML 
      CLE,ELB       CONVERT TO BYTE ADDRESS 
      STB ADR 
      LDA @SPAC 
      JSB .MBT      MOVE IN SPACES
       DEF D
       NOP
      LDA NBR 
      LDB ADR 
      SSA,RSS       NEGATIVE NUMBER?
      JMP DEC1.     . NO
      CMA,INA 
      STA NBR 
      SSA           SPECIAL LOW NUMBER (-32768)?
      JMP DEC4.     . YES 
      LDA DASH
      JSB .SBT
DEC1. STB ADR       SAVE OUTPUT POINTER 
      LDA DTBL
      STA D         D --> DIVISOR TABLE 
      LDA DM4 
      STA CTR 
      STA FLAG      CLEAR OUTPUT FLAG (SET TO 1)
* 
DEC2. LDB NBR 
      LSR 16
      DIV D,I 
      ISZ D 
      STB NBR       REMAINDER 
      SZA           OUTPUT OTHER THAN ZERO? 
      JMP *+4       . YES OUTPUT IT 
      LDB FLAG
      SSB           OK TO OUTPUT? 
      JMP DEC3.     . NO FINISH LOOP
      IOR "0" 
      STA FLAG      SET OUTPUT FLAG (BIT15=0) 
      LDB ADR       <B> --> OUTPUT FIELD
      JSB .SBT
      STB ADR       SAVE OUTPUT FIELD 
DEC3. ISZ CTR 
      JMP DEC2. 
* 
      LDA NBR       <A> := ONES DIGIT 
      LDB ADR       <B> --> OUTPUT
      IOR "0" 
      JSB .SBT
      JMP DECML,I   AND RETURN
* 
DEC4. LDA @32K      MOVE IN -32768
      JSB .MBT
       DEF D6 
       NOP
      JMP DECML,I   RETURN
      SPC 2 
@32K  DBL *+1 
      ASC 3,-32768
@SPAC DBL *+1 
      ASC 3,
DTBL  DEF *+1 
      DEC 10000 
      DEC 1000
      DEC 100 
      DEC 10
* 
D2    DEC 2 
D4    DEC 4 
DM4   DEC -4
D6    DEC 6 
"0"   OCT 60
DASH  ASC 1,--
* 
CTR   BSS 1 
FLAG  BSS 1         BIT15=1 NO OUTPUT; BIT15=0 OUTPUT 
D     BSS 1 
ADR   BSS 1 
NBR   BSS 1 
      SKP 
* 
*  DATA AREA
* 
*     FORMAT OF BUFFER PASSED TO QCLM:
*     --------------------------------
* 
*     ****************************************
*  1  * STREAM WORD                          *  NOTE: ON SOME MESSAGES, 
*     *--------------------------------------*  WORD 1 AND WORD 2 MAY 
*  2  * SEQUENCE NUMBER                      *  HAVE DIFFERENT MEANINGS.
*     *--------------------------------------*
*  3  * SOURCE (ORIGINATING) NODE NUMBER     *
*     *--------------------------------------*
*  4  * DESTINATION NODE NUMBER              *
*     *--------------------------------------*
*  5  * P-REGISTER WHEN ERROR DETECTED       *
*     *--------------------------------------*
*  6  * A-REGISTER WHEN ERROR DETECTED       *
*     *--------------------------------------*
*  7  * B-REGISTER WHEN ERROR DETECTED       *
*     *--------------------------------------*
*  8  * TIME OF DAY WHEN ERROR DETECTED      *
*  9  *    (2 WORDS)                         *
*     *--------------------------------------*
* 10  * PROGRAM NAME WHERE                   *
* 11  *    ERROR IS DETECTED                 *
* 12  *    (3 WORDS)                         *
*     ****************************************
      SPC 3 
K1    DEC 1 
K2    DEC 2 
K3    DEC 3 
K4    DEC 4 
K5    DEC 5 
K6    DEC 6 
K7    DEC 7 
K8    DEC 8 
K9    DEC 9 
K11   DEC 11
K12   DEC 12
K21   DEC 21
N3    DEC -3
* 
MTYPE NOP           MESSAGE TYPE
@PREG DEF PREG
@CVFD DEF CVFLD 
CNTR1 NOP 
PNTR2 NOP 
QCLS  NOP 
* 
IBUF  BSS 12
STREM EQU IBUF
SEQ#  EQU IBUF+1
SRC#  EQU IBUF+2
DESTN EQU IBUF+3
PREG  EQU IBUF+4
AREG  EQU IBUF+5
BREG  EQU IBUF+6
TOD   EQU IBUF+7
PGM   EQU IBUF+9
* 
MSG   ASC 8, DS ERROR: PROG=
ORIGN ASC 3,
      ASC 5,, STREAM= 
.STR. ASC 3,
      ASC 4,, SEQ#= 
.SEQ. ASC 3,
      OCT 6412      CARRIAGE-RETURN/LINE-FEED 
      ASC 2, P= 
CVFLD ASC 3,
      ASC 2,, A=
      ASC 3,
      ASC 2,, B=
      ASC 3,
MSGL  ABS *-MSG 
* 
MSG1  ASC 05, DS ERROR: 
.DSXX ASC 02,       STORAGE FOR "DSXX" ERROR CODE 
      ASC 16,, REPLY FLUSHED
MSG1L ABS *-MSG1
@MSG1 DEF MSG1
      DEF MSG1L 
* 
MSG2  ASC 21, DS ERROR: TCB NOT FOUND, POSSIBLE TIMEOUT 
MSG2L ABS *-MSG2
@MSG2 DEF MSG2
      DEF MSG2L 
* 
MSG3  ASC 14, DS ERROR: COMM. READ, LU =
.LU3  ASC 2,
      ASC 6,I/O STATUS= 
.STAT ASC 3,
MSG3L ABS *-MSG3
@MSG3 DEF MSG3
      DEF MSG3L 
* 
MSG4  ASC 23, DS MSG: MESSAGE ACCOUNTING REMOVED FROM NODE
.N4   BSS 3 
MSG4L ABS *-MSG4
@MSG4 DEF MSG4
      DEF MSG4L 
* 
MSG5  ASC 18, DS ERROR: UP/DOWN COUNTER EXCEEDED
      OCT 6412      CR/LF 
      ASC 05, LINK LU # 
.LU5  ASC 02, 
      ASC 06,IS DISABLED
MSG5L ABS *-MSG5
@MSG5 DEF MSG5
      DEF MSG5L 
* 
MSG6  ASC 7, DS MSG: LU # 
.LU6  ASC 2,
      ASC 6,JUST CAME UP
MSG6L ABS *-MSG6
@MSG6 DEF MSG6
      DEF MSG6L 
* 
MSG7  ASC 7, DS MSG: LU # 
.LU7  ASC 2,
      ASC 7,JUST WENT DOWN
MSG7L ABS *-MSG7
@MSG7 DEF MSG7
      DEF MSG7L 
* 
MSG8  ASC 15, DS ERROR: SELF-CHECK ERROR IN 
.PGM8 ASC 3,
      OCT 6412
      ASC 2, P= 
.P8   ASC 3,
      ASC 2, A= 
.A8   ASC 3,
      ASC 2, B= 
.B8   ASC 3,
      OCT 6412
      ASC 19, REROUTING IS DISABLED FROM THIS NODE
MSG8L ABS *-MSG8
@MSG8 DEF MSG8
      DEF MSG8L 
* 
MSG9  ASC 25, DS ERROR: SELF-CHECK ERROR IN MESSAGE ACCOUNTING! 
      OCT 6412
      ASC 1,
.N9   ASC 4,
.F9   ASC 4,
.A9   ASC 4,
.B9   BSS 3 
MSG9L ABS *-MSG9
@MSG9 DEF MSG9
      DEF MSG9L 
* 
MSGX  ASC 7, STREAM= XXXXXX 
.OX   ASC 9,  ORG NODE= XXXXXX
.DLUX BSS 9 
MSGXL ABS *-MSGX
@MSGX DEF MSGX
      DEF MSGXL 
@DLUX DEF .DLUX 
@LUX  DEF *+1 
      ASC 9,LU= XXXX
@DX   DEF *+1 
      ASC 9, DEST NODE= XXXXXX
* 
TIME  ASC 6, TIME: DAY
.DAY  ASC 2,        DAY NUMBER, CONVERTED TO ASCII
.HR   NOP           HOUR, CONVERTED TO ASCII
      ASC 1,: 
.MIN  ASC 1,        MINUTE, CONVERTED TO ASCII
      ASC 1,: 
.SEC  ASC 1,        SECOND, CONVERTED TO ASCII
TIMEL ABS *-TIME
TMAR  BSS 5 
* 
SIZE  BSS 0 
* 
      END QCLM
                                                                                            