ASMB,R,L,C
      HED <<RTE-BASIC ERROR ROUTINE>>      92101-19018 REV.1644 
      NAM ERRSB,7 92101-16018 REV.1644
* 
* 
* 
* 
**************************************************************
* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976.  ALL RIGHTS    *
* RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- *
* PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  *
* OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  *
**************************************************************
* 
* 
* 
*           LISTING:   92101-19018
*           RELOC:     92101-16018
*           SOURCE:    92101-18018
* 
* 
* 
********************************************************************* 
* 
* 
* 
*                   RTE-BASIC ERROR ROUTINE FOR CALSB 
* 
      ENT ERROR,LUERR,ERRCD,.LNUM 
      EXT REIO,.ENTR
* 
* 
* 
*   CALLING SEQUENCE: 
* 
*      JSB ERROR
*      DEF *+3
*      DEF NUMBR            DECIMAL NUMBER
*      DEF STRING           ERROR MNEMONIC
*       : 
*       : 
*         THE ERROR MESSAGE IS OF THE FORMAT: 
* 
*      ERROR XXXXXX-KK IN LINE NNNN 
* 
* 
*    WHERE:   XXXXXX IS THE MNEMONIC STRING 
*             KK     IS THE ERROR NUMBER
*             NNNN   IS THE CURRENT BASIC LINE NUMBER 
* 
* 
NUMB  NOP 
MESS  NOP 
ERROR NOP 
      JSB .ENTR 
      DEF NUMB
* 
      LDA MESS,I    GET NUMBER
      CMA,INA         OF CHARACTERS 
      STA RERR          AND SAVE
      ISZ MESS
      LDA LUERR     SET HONESTY 
      IOR B2000       MODE
      STA LUERR 
      LDA EBUFA     PRINT 
      LDB M9          'ERROR' 
      JSB WRITE 
      LDA MESS
      LDB RERR      PRINT 
      JSB WRITE       ERROR MNEMONIC
      LDA DASH      PRINT 
      JSB OUTCR       '-' 
      LDA NUMB,I    PRINT 
      STA ERRCD       AND SAVE
      JSB OUTIN         ERROR NUMBER
      LDA LBUFA     PRINT 
      LDB M9          'IN LINE' 
      JSB WRITE 
      LDA .LNUM     PRINT 
      JSB OUTIN       LINE NUMBER 
      LDA EBUFA     CR-LF 
      LDB M3
      JSB WRITE 
      JMP ERROR,I 
      SKP 
*********************** 
*                     * 
*  OUTPUT AN INTEGER  * 
*                     * 
*********************** 
* 
OUTIN NOP           INTEGER IN (A)
      LDB M3        SET DIGIT 
      STB PCNT        COUNTER 
      LDB LDVSR     SET DIVISOR 
      STB TEMP4       ADDRESS 
      CLB           SUPPRESS
      STB TEMP2       LEADING ZEROES
OUTI1 DIV TEMP4,I   DIVIDE INTEGER
      STB TEMP1       CURRENT DIVISOR 
      CPA TEMP2     LEADING ZERO? 
      JMP OUTI2     YES!
      ADA .48       NO, TURN OFF
      STA TEMP2       ZERO SUPPRESION 
      JSB OUTCR     OUTPUT DIGIT
OUTI2 CLB 
      LDA TEMP1     RETRIEVE REMAINDER
      ISZ TEMP4     SET FOR NEXT DIVISOR
      ISZ PCNT      ALL DIVISOR USED? 
      JMP OUTI1     NO! 
      ADA .48       YES, OUTPUT 
      JSB OUTCR       LAST DIGIT
      JMP OUTIN,I 
* 
* 
*  OUTPUT ONE CHARACTER 
* 
OUTCR NOP 
      ALF,ALF       LEFT JUSTIFY CHARACTER
      STA ABREG 
      LDA DMMYA 
      LDB M1
      JSB WRITE 
      JMP OUTCR,I 
* 
*  OUTPUT A LINE
* 
WRITE NOP 
      STA BUFR
      STB TEMP
      JSB REIO      WRITE 
      DEF *+5 
      DEF .2          OUT 
      DEF LUERR 
BUFR  NOP               LINE
      DEF TEMP
      JMP WRITE,I 
      SKP 
*          WORKING STORAGE AND CONSTANTS
* 
* 
PCNT  BSS 1 
TEMP  BSS 1 
TEMP1 BSS 1 
TEMP4 BSS 1 
RERR  BSS 1 
ABREG BSS 2 
TEMP2 EQU ABREG 
ERRCD NOP           ERROR CODE VALUE INITIALLY 0
LUERR DEC 1         ERROR LUN, DEFAULT LU 1 
.LNUM NOP           LINE NUMBER OF ERROR
      SPC 2 
B2000 OCT 2000
.2    DEC 2 
.48   DEC 48
LDVSR DEF *+1 
      DEC 1000
      DEC 100 
      DEC 10
M1    DEC -1
M3    DEC -3
M9    DEC -9
      SPC 2 
DMMYA DEF ABREG 
EBUFA DEF *+1 
      OCT 6412
      OCT 3505      'BELL',E
      ASC 3,RROR
LBUFA DEF *+1 
      ASC 5, IN LINE
DASH  OCT 55
      END 
                                                                          