*DECK RDUMP 
          IDENT  RDUMP
          ENTRY  RDUMP
          EXT    OMSG 
          EXT    XTRACE 
          SST 
          IPARAMS 
*#
*1DC  RDUMP 
* 
*     1. PROC NAME           AUTHOR              DATE 
*        RDUMP               E. GEE              77/08/03 
* 
*     2. FUNCTIONAL DESCRIPTION.
*        THIS ROUTINE IS RESPONSIBLE FOR DUMPING NIP-S FIELD-LENGTH.
* 
*     3. METHOD USED. 
*          CHECK IF DMPFLG IS SET TO ZERO.  IF SO, ALWAYS DUMP
*          IF NONZERO, CHECK IF DUMP ALREADY TAKEN OF SAME PROBLEM. 
*            IF SO, DO NOT DUMP AGAIN.
*            IF NOT, DUMP AND STORE REASON CODE FOR DUMP IN DUMPTRK 
*          DUMP BY CREATING FET WITH I/O BUFFER WHICH IS NIP-S ENTIRE 
*            FL AND EXECUTING WRITER. 
*          IF I/O ERROR OCCURS, 
*            ISSUE INFORMATIVE DAYFILE MESSAGE. 
* 
*     4. ENTRY PARAMETERS.  NONE
* 
*     5. EXIT PARAMETERS.  NONE 
* 
*     6. COMDECKS CALLED. 
*          CYBERDEFS DUMPFLG FREETAB INPARU MACDEF
* 
*     7. ROUTINES CALLED. 
*          OMSG              ISSUE DAYFILE MESSAGE
*          WRITER            WRITE WITH END OF RECORD MACRO 
*          XTRACE            TRACES CALLS 
* 
*     8. DAYFILE MESSAGES.
*        " CIO ERROR NNB, LFN = ZZZZTMP." 
* 
*#
 DMPWD    VFD    30/0,18/300000B,12/0 
 DMPCHK   BSSZ   1           COUNT OF DUMPS, NEVER MORE THAN 2
* 
* 
* 
*CALL MACDEF
*CALL CYBERDEFS 
*CALL INPARU
*CALL FREETAB 
*CALL DUMPFLG 
  
DUMPTRK   BSSZ   1           WORD TO KEEP TRACK OF DUMP PROBLEMS
* 
*         FET FOR FILE DUMP 
* 
LN        EQU    0           EOR/EOF LEVEL NUMBER 
AT        EQU    0           ABNORMAL TERMINATION CODE
CODE      EQU    0           REQUEST/RETURN CODE
DT        EQU    0           DEVICE TYPE
R         EQU    0           RNADOM ACCESS BIT
 UP       EQU    1           USER PROCESSING BIT
 EP       EQU    1           ERROR PROCESSING BIT 
XL        EQU    0           EXTENDED LABEL PROCESSING BIT
L         EQU    0           ADDITIONAL FET LENGTH OVER 5 
FNT       EQU    0           FNT ADDRESS
PRUSIZE   EQU    0           PRU SIZE 
  
FET       VFD    42/7LZZZZTMP,4/LN,4/AT,9/CODE,1/1
          VFD    12/DT,1/R,1/0,1/UP,1/EP,2/0,1/XL,17/0,6/L,18/0 
IN        VFD    42/0,18/0   NEXT LOCATION TO WRITE OUT DATA
OUT       VFD    42/0,18/0   LAST LOCATION TO WRITE OUT DATA
LIMIT     VFD    12/FNT,12/0,18/PRUSIZE 
          VFD    18/0        LWA+1 OF I/O BUFFER
  
 ERRMSG   DIS    ,* CIO ERROR NNB, LFN = ZZZZTMP.*
 ERRMSGC  EQU    ERRMSG+2    WORD TO CONTAIN ABNORMAL TERM CODE 
  
 LOCMSG   VFD    60D/ERRMSG  LOCATION OF DAYFILE MESSAGE
  
  
 RDUMP    SUBR   =           ENTRY/EXIT 
          IFEQ    DEBUG,1,6 
          SX6    A1 
          SA6    TEMP 
          SX1     XRDUMP
          RJ     XTRACE 
          SA1    TEMP 
          SA1    X1 
          SA1    DMPFLG      REASON CODE FOR DUMPING NIP-S FIELD LENGTH 
          ZR     X1,DUMP     IF RC = 0, ALWAYS DUMP 
          SB1    X1 
          SA2    DUMPTRK     CHECK TO SEE IF PROBLEM OCCURRED BEFORE
          LX3    B1,X2
          NG   X3,RETURN     DUMP ALREADY TAKEN OF PROBLEM
* 
*         SET REASON CODE BIT IN DUMPTRK SO DUMP OF SAME PROBLEM WILL 
*         NOT OCCUR AGAIN 
* 
          MX4    1
          BX5    X3+X4
          SB2    60D         CM WORD SIZE 
          SB1    B2-B1
          LX7    B1,X5
          SA7    DUMPTRK
* 
*         SET UP FET BUFFER POINTERS
* 
 DUMP     SA1    CTLSLWA     LWA+1 OF NIP 
          BX6    X1 
          SA6    LIMIT       SET I/O BUFFER LIMIT ADDRESS 
          SX7    B0 
          SA7    OUT         SET I/O BUFFER OUT ADDRESS 
          SX6    X6-1 
          SA6    IN          SET I/O BUFFER IN ADDRESS
  
          WRITER FET,R       WRITE NIP-S FL TO FILE DUMP
          MX5    5           MASK FOR ABNORMAL TERMINATION FIELD IN FET 
          SA2    FET         X2 = FIRST WORD OF FET 
          LX5    9+5         SHIFT MASK TO ABNORMAL TERM FIELD POSITION 
          BX5    X5*X2       EXTRACT ABNORMAL TERMINATION CODE
          ZR     X5,RETURN   RETURN IF NO I/O ERROR 
  
          MX0    3           MASK FOR ONE OCTAL DIGIT 
          AX5    5           RIGHT JUSTIFY ABNORMAL TERM CODE 
          LX0    3           RIGHT JUSTIFY OCTAL DIGIT MASK 
          SA2    ERRMSGC     X2 = WORD OF DAYFILE MSG TO CONTAIN CODE 
          BX4    X0*X5       EXTRACT LEAST SIGNIFICANT DIGIT
          AX5    3           EXTRACT MOST SIGNIFICANT DIGIT 
          SX4    X4+33B      CONVERT OCTAL DIGIT TO OCTAL DISPLAY 
          SX5    X5+33B      CONVERT OCTAL DIGIT TO OCTAL DISPLAY 
          LX5    6           SHIFT MOST SIG DIGIT TO 2ND DIGIT POS
          MX0    12D         MASK FOR ABNORMAL TERM FIELD IN DAY MSG
          BX5    X5+X4       ABNORMAL TERM CODE IN OCTAL DISPLAY CODE 
          LX0    42D+12D     SHIFT MASK TO ABNORMAL TERM FIELD POSITION 
          LX5    42D         SHIFT DISPLAY CODE NO TO DAY MSG POSITION
          BX0    -X0*X2      CLEAR ABNORMAL TERM CODE FIELD IN DAY MSG
          BX6    X0+X5       ADD ABNORMAL TERM CODE TO DAY MSG
          SA6    A2 
          SA1    LOCMSG      A1 = ADDRESS OF PARAMETER BLOCK
          RJ     OMSG        ISSUE DAYFILE MESSAGE
  
  
RETURN    EQ   RDUMP         RETURN TO CALLING PROGRAM
 XRDUMP   DATA    L*RDUMP*
 TEMP     BSS    1
          END