ASMB,R,L,C
      HED <DSERR> DS/1000 ERROR ROUTINE * (C) HEWLETT-PACKARD 1980
      NAM DSERR,7 91750-1X076 REV 2013 791201 ALL 
      ENT DSERR 
      EXT #RQB
RQB   EQU #RQB
      EXT .ENTR,.MBT,.SBT 
      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 1 
*     SUBROUTINE TO RETURN DS ERROR PARAMETERS (DS/1000 REQUESTS ONLY)
* 
*     CALLING SEQUENCE: 
* 
*     CALL DSERR(IERBUF[,NODER[,LQLFR]])
* 
*     RETURNED VALUES:
* 
*     IERBUF MUST BE AN INTEGER ARRAY OF AT LEAST 24 WORDS. 
*     UPON RETURN, IT WILL CONTAIN A MESSAGE OF THE FORM: 
*     DS ERROR: XXXXXXXX(QQ), REPORTED BY NODE NNNNN
*     WHERE THE XXXXXXXX FIELD MAY CONTAIN EITHER THE ASCII OR NUMERIC
*     (CONVERTED TO ASCII) ERROR CODE.
* 
*     QQ = ERROR CODE QUALIFIER 
*     NNNNN = NODE NUMBER REPORTING THE ERROR.
* 
*     NODER = (RETURNED) REPORTING NODE NUMBER (POSITIVE INTEGER) 
*             (OPTIONAL)
* 
*     LQLFR = (RETURNED) QUALIFIER CODE (POSITIVE INTEGER)
*             (OPTIONAL)
* 
*           SAMPLE ERROR MESSAGES 
*          -----------
*            DS ERROR: DS08(0), REPORTING NODE 7
*            DS ERROR: IO04(1), REPORTING NODE 23 
*            DS ERROR: RS-33(12), REPORTING NODE 9
*            DS ERROR: RF-32(0), REPORTING NODE 1 
      SPC 2 
* 
*     OPERATION:
* 
*     1) FOLLOWING ANY DS OPERATION IN WHICH AN ERROR HAS OCCURRED
*        (REGARDLESS OF THE LEVEL AT WHICH THE ERROR WAS DETECTED), 
*        INFORMATION DESCRIBING THE CAUSE OF THAT ERROR IS PLACED IN
*        A PORTION OF THE REQUEST BUFFER LABELLED #RQB, AT AN OFFSET
*        GIVEN BY #EC1, #EC2, #ENO AND #ECQ, BY #MAST AND/OR THE
*        MASTER ROUTINE.
* 
*     2) UPON BEING CALLED, DSERR FETCHES THIS INFORMATION
*        CONVERTS IT INTO VARIOUS FIELDS OF A LOCAL MESSAGE BUFFER, 
*        THEN MOVES THIS BUFFER INTO THE USER'S MESSAGE BUFFER. 
* 
*     THE REPORTING NODE NUMBER AND QUALIFIER ARE RETURNED TO 
*     THE CALLER, IF PARAMETERS FOR THEM ARE SPECIFIED. 
* 
*        THE NODE NUMBER IS ALWAYS RETURNED AS A POSITIVE INTEGER.
* 
*     NOTES: 1) RESULTS MEANINGLESS UNLESS AN ERROR HAS BEEN DETECTED 
*               FOLLOWING A DS/1000 SUBROUTINE CALL.
*            2) RECOMMENDED PROCEDURE FOR PROGRAMMERS, FOR ALL DS/1000
*               REQUESTS, REGARDLESS OF TYPE, IS TO MAKE THE REQUEST, CHECK 
*               FOR AN ERROR, AND IF NONE THEN CONTINUE.  OTHERWISE,
*               CALL DSERR TO OBTAIN COMPLETE INFORMATION ABOUT THE 
*               ERROR.
      SKP 
*     GLBLK-START 
******************************************************************
*                                                                *
*     G L O B A L   B L O C K               REV 2001 790531      *
*                                                                *
*     GLOBAL OFFSETS INTO DS/1000 MESSAGE BUFFERS, USED BY:      *
*                                                                *
*         REMAT, RFMST, DEXEC, DMESS, FLOAD, POPEN, #MAST        *
*         GET,   #SLAV, RQCNV, RPCNV, GRPM,  DINIT, PTOPM        *
*         EXECM, EXECW, OPERM, RFAM1, RFAM2, DLIST, DLIS3        *
*         DSTIO, LUMAP, #CMGT                                    *
******************************************************************
* 
***!!!!! THE ORDER OF THE FIRST 7 WORDS (#STR THRU #ENO) IS      *
***!!!!!     FIXED BY THE REQUIREMENT THAT THE STREAM, ADDRESSES *
***!!!!!     AND ERROR CODES ALWAYS BE IN THE SAME PLACE,        *
***!!!!!     REGARDLESS OF MESSAGE FORMAT.  THIS MAKES STORE-AND-*
***!!!!!     FORWARD CODE MUCH SIMPLER.                          *
#STR  EQU 0         STREAM WORD.
#SEQ  EQU #STR+1    SEQUENCE NUMBER.
#SRC  EQU #SEQ+1    SOURCE NODE #.
#DST  EQU #SRC+1    DEST. NODE #. 
#EC1  EQU #DST+1    REPLY ECOD1.
#EC2  EQU #EC1+1    REPLY ECOD2.
#ENO  EQU #EC2+1    NUMBER OF NODE REPORTING ERROR. 
* 
#ECQ  EQU #ENO+1    ERROR CODE QUALIFIER (BITS 4 TO 7)
#LVL  EQU #ECQ      MESSAGE FORMAT LEVEL (BITS 0 TO 3)
#MAS  EQU #LVL+1    MA "SEND" SEQ. #
#MAR  EQU #MAS+1    MA "RECV" SEQ. #
#MAC  EQU #MAR+1    MA "CANCEL" FLAGS 
#HCT  EQU #MAC+1    HOP COUNT 
#SID  EQU #HCT+1    SESSION ID WORD 
* 
#EHD  EQU #SID      LAST ITEM OF HEADER 
#MHD  EQU #EHD+1    MINIMUM HEADER SIZE 
#REQ  EQU #MHD      START OF REQUEST SPECIFIC AREA
#REP  EQU #MHD      START OF REPLY SPECIFIC AREA
* 
#MXR  EQU #MHD+24   <<< MAXIMUM DS REQ/REPLY BUFFER SIZE >>>
#LSZ  EQU 2         <<< SIZE OF LOCAL APPENDAGE AREA >>>
* 
******************************************************************
* 
*  GLBLK-END
      SKP 
ERBUF NOP 
NODER NOP 
QLFR  NOP 
DSER. EQU * 
DSERR NOP 
      JSB .ENTR 
      DEF ERBUF 
      LDB ERBUF 
      CLE,ELB       BYTE ADDRESS
      STB ERBUF 
* 
*     GET #EC1 AND #EC2 
* 
      LDA RQB+#EC1
      STA MSG+5 
      LDA RQB+#EC2     (ASSUME ASCII) 
      STA MSG+6 
      LDA RQB+#ECQ     MOVE QUALIFIER AND NODE NUMBER 
      STA QUAL            TO ALLOW REQUEST BUFFER 
      LDA RQB+#ENO           TO BE OVERWRITTEN
      STA NODE
      LDA B         SETUP DEFAULT FIELD 1 
      ADA D14          TERMINATING
      STA @FLD1+1         ADDRESS 
* 
*     MOVE PARTIALLY COMPLETE MSG TO USERS AREA 
* 
      LDA @MSG
      JSB .MBT
      DEF MSGLN 
      NOP 
* 
*     SEE IF EC2 NUMERIC, IF SO CONVERT IT
* 
      LDA NODE      TEST SIGN OF NODE 
      SSA           NUMERIC?
      JMP GETQ      . NO
      LDA MSG+6     (#EC2)
      LDB .EC2      <B> = OFFSET OF EC2 
      JSB DECML 
      STB @FLD1+1   SAVE ACTUAL TERMINATING ADDRESS 
* 
*     GET QUALIFIER IF ANY
* 
GETQ  LDB QUAL
      LSL 8         ISOLATE QUALIFIER BITS (4-7)
      LSR 12
      LDA B 
      STA QLFR,I    RETURN QUALIFIER
      LDB .QUAL     <B> = OFFSET FOR QUALFIER OUTPUT
      JSB DECML 
      STB @FLD2+1   SAVE TERMINATING ADDRESS
* 
*     GET REPORTING NODE NUMBER 
* 
      LDA NODE
      ELA,CLE,ERA   CLEAR SIGN BIT
      STA NODER,I   RETURN NODE NUMBER
      LDB .NODE     <B> = OFFSET FOR NODE OUTPUT
      JSB DECML 
* 
*     COMPRESS MESSAGE
* 
      DLD @FLD2 
      ADA ERBUF     CHANGE OFFSET TO ADDRESS
      JSB .MBT
      DEF @FLD2+2 
      NOP 
      DLD @FLD1 
      ADA ERBUF     CHANGE OFFSET TO ADDRESS
      JSB .MBT
      DEF @FLD1+2 
      NOP 
      JMP DSERR,I   AND RETURN
      SKP 
* 
* DECML- CONVERTS BINARY TO DECIMAL (LEFT JUST) 
*     <A> = BINARY   <B> = OFFSET INTO MSG
* 
DECML NOP 
      ADB ERBUF     CONVERT OFFSET TO (BYTE) ADDRESS
      STA NBR 
      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 
      SPC 2 
@32K  DBL *+1 
      ASC 3,-32768
DTBL  DEF *+1 
      DEC 10000 
      DEC 1000
      DEC 100 
      DEC 10
* 
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 
A     EQU 0 
B     EQU 1 
* 
*                                   CHAR OFFSET OF DATA FIELDS
.EC2  DEC 12
.QUAL DEC 19
.NODE DEC 39
*                                   FIELD DATA FOR COMPRESSION OF MSG 
@FLD1 DEC 18        OFFSET OF MAX FIELD POSITION+1
      BSS 1         ACTUAL ADDRESS OF MAX POSITION+1
      DEC 30        CHARACTERS TO MOVE
@FLD2 DEC 21
      BSS 1 
      DEC 27
@MSG  DBL *+1 
MSG   ASC 12,DS ERROR: DDXXXXXX(QQ),  
      ASC 12,REPORTING NODE N 
MSGLN DEC 48
D14   DEC 14
QUAL  BSS 1 
NODE  BSS 1 
SIZE  EQU * 
      END