ASMB,R,L,C
      HED <<9580 ERROR ROUTINE>>      09580-16021 REV.A 
      NAM ERROR,7 09580-16021 REV.A 770501
* 
*---------------------------------------------------------------
* 
*     RELOC.     09580-16021
*     SOURCE     09580-18021
* 
*     M.KAESSNER    REV.A   770501
* 
*     HP 92425A TEST SYSTEM SOFTWARE IS THE PROPRIETARY 
*     MATERIAL OF THE HEWLETT-PACKARD COMPANY.  USE AND 
*     DISCLOSURE THEREOF ARE RESTRICTED BY WRITTEN AGREEMENT. 
* 
*     (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. 
*     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. 
* 
*---------------------------------------------------------------
* 
*                   9580 STANDARD ERROR ROUTINE (CALSB COMPATABLE)
* 
      ENT ERROR,LUERR,ERRCD,.LNUM 
      ENT IERR,IERCD
      EXT EXEC,.ENTR,ISN,CNUMD
* 
* 
* 
*   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
      SKP 
* 
* INITIALIZATION
* 
      LDA OSTRT     \ INITIALIZE OUTPUT BUFFER POINTER
      STA OPTR      / 
      LDA LUERR     IF LUERR IS 1, CALL ISN FOR STATION 
      ADA M1
      SZA 
      JMP PKMSG     LU SET PREVIOUSLY 
      JSB ISN       GET STATION NUMBER
      DEF *+1 
      STA LUERR     REPLACE WITH STATION NUMBER 
* 
* PACK ERROR STRING INTO OUTPUT BUFFER
* 
PKMSG LDB MESS,I    GET NUMBER OF CHARACTERS
      SZB,RSS       IF ZERO LENGTH MESSAGE      
      JMP PKDSH        THEN PACK DASH 
      CLE,ERB       DIVIDE BY 2, IF 'E' SET THEN ODD
      SEZ           TEST REMAINDER
      INB           INCREMENT ON ODD COUNT
      LDA B         TEST NUMBER OF WORDS
      ADA M28       WORD COUNT MUST BE =< 27
      SSA 
      JMP *+3       OK, DON'T TRUNCATE
      LDB D27       TRUNCATE TO 27 WORDS (54 CHARACTERS)
      CLE           CLEAR ODD BIT 
      LDA MESS      GET STRING ADDRESS
      INA           'A' POINTS TO STRING
      JSB PAK       STORE STRING INTO OUTPUT BUFFER 
      SEZ,RSS       IF ODD COUNT, ADD A BLANK TO
      JMP PKDSH 
      LDB OPTR      LAST WORD.  GET POINTER 
      ADB M1        BACK UP ONE WORD
      LDA B,I       GET LAST WORD 
      AND UMSK      CLEAR LOWER BITS
      ADA BLNK      STORE A BLANK 
      STA B,I       REPLACE 
* 
* STORE DASH
* 
PKDSH LDA DASH      GET DASH/BLANK
      STA OPTR,I    STORE INTO OUTPUT BUFFER
      ISZ OPTR      INCREMENT BUFFER POINTER
* 
* CONVERT ERROR NUMBER AND STORE IN OUTPUT BUFFER 
* 
      LDA NUMB,I    LOAD ERROR CODE 
      SSA           IF NEGATIVE,
      CMA,INA          CONVERT TO POSITIVE
      STA ERRCD     STORE FOR OTHER FUNCTIONS 
      JSB CNUMD     CONVERT TO ASCII
      DEF *+3 
      DEF ERRCD 
      DEF BUF 
      LDA ABUF1     GET ADDRESS OF BUFFER 
      LDB D1        ONE WORD
      JSB PAK       ADD TO OUTPUT BUFFER
* 
* STORE " IN LINE  " INTO OUTPUT BUFFER 
* 
      LDA INLNE     LOAD ADDRESS OF BUFFER
      LDB D4        LOAD WORD COUNT 
      JSB PAK       STORE INTO OUTPUT BUFFER
* 
* CONVERT LINE NUMBER AND STORE INTO OUTPUT BUFFER
* 
      JSB CNUMD     CONVERT TO ASCII
      DEF *+3 
      DEF .LNUM 
      DEF BUF 
      LDA ABUF2     GET ADDRESS OF BUFFER 
      LDB D3        THREE WORDS 
      JSB PAK       ADD TO OUTPUT BUFFER
* 
* WRITE OUTPUT BUFFER 
* 
      LDA OPTR      CALCULATE 
      LDB OFRNT       SIZE OF 
      CMB,INB           OUTPUT
      ADA B               BUFFER
      STA SIZE
      JSB EXEC      ACTUALLY WRITE IT OUT 
      DEF *+5 
      DEF D2
      DEF LUERR 
OFRNT DEF OBUF
      DEF SIZE
      JMP ERROR,I   RETURN
      SPC 5 
**************
*     PAK    *
**************
PAK   NOP           A=ADDRESS  B=COUNT(WORDS) 
      CMB,INB       COMPLEMENT COUNT FOR LOOP COUNTER 
      STB LUP 
LP    LDB A,I       GET WORD
      STB OPTR,I    STORE IN OUTPUT BUFFER
      ISZ OPTR      INCREMENT OUTPUT POINTER
      INA           INCREMENT STRING POINTER
      ISZ LUP 
      JMP LP
      JMP PAK,I     RETURN
      SKP 
      SKP 
*------------------------------------------------------------------ 
* 
*     THIS ROUTINE ALLOWS FORTRAN PROGRAMS TO TEST THE ERROR CODE 
*     SET WHEN CALLS ARE MADE TO "ERROR"
* 
*     CALLING SEQUENCE: 
* 
*        JSB IERR         (OR JSB IERCD)
*        DEF *+1
*         : 
*         :               VALUE OF ERRCD IS SET IN A REGISTER THEN CLEARED
* 
* 
DUM   NOP 
IERCD EQU *         ENTRY POINT WITH TWO NAMES
IERR  NOP 
      JSB .ENTR 
      DEF DUM 
      SPC 1 
      LDA ERRCD     GET ERROR CODE IN A REG 
      CLB           STORE 0 IN
      STB ERRCD       ERRCD 
      JMP IERR,I    EXIT WITH ERRCD IN A REG
      SKP 
*          WORKING STORAGE AND CONSTANTS
* 
* 
*     EXTERNAL ENTRY VALUES 
* 
ERRCD DEC 0         ERROR CODE VALUE (INITIALLY 0)
LUERR DEC 1         ERROR LU SET BY CALSB 
.LNUM NOP           LINE NUMBER OF ERROR
* 
*     ASCII BUFFERS ETC.
* 
OBUF  OCT 3505      'BELL/E'
      ASC 3,RROR    OUTPUT BUFFER 
      BSS 37
OSTRT DEF OBUF+4    STARTING ADDRESS
OPTR  NOP           BUFFER POINTER
DASH  OCT 26440 
INLNE DEF *+1 
      ASC 4, IN LINE
BUF   BSS 3         BUFFER FOR NUMBER CONVERSION
ABUF1 DEF BUF+2 
ABUF2 DEF BUF 
* 
*     INTERNAL VALUES AND VARIBLES
* 
A     EQU           0 
B     EQU           1 
M1    DEC -1
M28   DEC -28 
D1    DEC 1 
D2    DEC 2 
D3    DEC 3 
D4    DEC 4 
D27   DEC 27
BLNK  OCT 40
UMSK  OCT 177400
LUP   NOP 
SIZE  BSS 1 
      END 
                                                                        