*DECK TDMISC
          IDENT  TDMISC 
          TITLE  TDMISC - MISCELLANEOUS ROUTINES FOR TERMINAL DUMP ANALY
,ZER. 
  
          MACHINE  ANY,I
          COMMENT  MISC STUFF FOR TERMINAL DUMP.
          LDSET  LIB=COB5LIB
          SST 
          B1=1
          SPACE  4
**        CDD - CONSTANT TO DECIMAL DISPLAY CODE CONVERSION.
* 
*         G.R. MANSFIELD, 69/11/13. 
*         ADAPTED FROM SUBROUTINE *CONDEC* IN *COMPASS VER 2.0*.
* 
*              *CDD* CONVERTS UP TO TEN DIGITS TO DISPLAY CODE WITH 
*         LEADING ZERO SUPPRESSION.  CONVERSION CONTAINS SPACE FILL 
*         AND IS RIGHT JUSTIFIED. 
* 
*         FUNC CDD; 
*         DD = CDD(BIN);
* 
*         DD  = DECIMAL DISPLAY CONVERSION. 
*         BIN = NUMBER TO BE CONVERTED. 
  
  
          ENTRY  CDD
 CDD1     DX6    X1*X2       COMPUTE QUOTIENT 
          FX1    X1*X2
          SB5    X1          SET NEXT DIGIT 
          LX4    60-6        SHIFT ASSEMBLY 
          SB6    B6+B4
          FX6    X6*X3       EXTRACT REMAINDER DIGIT
          SX7    X6+B7       CONVERT DIGIT
          IX4    X7+X4
          NZ     B5,CDD1     LOOP TO ZERO DIGIT 
          LX4    60-6        RIGHT JUSTIFY ASSEMBLY 
          LX6    X4,B6
 CDD      EQ     *+1S17      ENTRY / EXIT 
          SA1    X1          (X1) = VALUE 
          SB1    1           (B1) = 1 
          SA2    CDDA        =.1P48+1 
          SA3    A2+B1       =10.P
          PX1    X1 
          SB6    B0          CLEAR JUSTIFY COUNT
          SA4    A3+B1       =1H
          SB7    1R0-1R      (B7) = CONVERSION CONSTANT 
          SB4    6           (B4) = SHIFT INCREMENT 
          EQ     CDD1 
  
 CDDA     CON    0.1000000001P48,10.0P0,1H
          SPACE  4,10 
**        CVCOMP1 - CONVERT COMP-1 ITEMS. 
* 
*         PROC CVCOMP1; 
*         CVCOMP1(VALUE,DEST);
* 
*         VALUE = VALUE OF ITEM.
*         DEST  = FWA OF DESTINATION FIELD. 
  
  
          ENTRY  CVCOMP1
 CVCOMP1  EQ     *+1S17      ENTRY / EXIT 
          SA2    A1+1        (B2) = DESTINATION FWA 
          SB2    X2 
          SA1    X1          (X1) = VALUE 
          SB1    1
          RJ     =XC.R1S14   DO CONVERSION
          BX6    X1          STORE IN DESTINATION FIELD 
          LX7    X2 
          SA6    B2 
          SA7    A6+B1
          EQ     CVCOMP1     RETURN 
          SPACE  4,10 
**        CVCOMP2 - CONVERT COMP-2 ITEMS. 
* 
*         PROC CVCOMP2; 
*         CVCOMP2(VALUE,BCP,DEST);
* 
*         VALUE = VALUE OF ITEM.
*         BCP   = BCP OF DESTINATION FIELD. 
*         DEST  = FWA OF DESTINATION FIELD. 
  
  
          ENTRY  CVCOMP2
 CVCOMP2  EQ     *+1S17      ENTRY / EXIT 
          SB1    1
          SA2    A1+B1       (B4) = BCP OF DESTINATION FIELD
          SA1    X1          (X1) = VALUE 
          SB3    B0          (B3) = SCALING FACTOR
          SA3    A2+B1       (B5) = FWA OF DESTINATION FIELD
          SA2    X2 
          SB4    X2 
          SB5    X3 
          RJ     =XC.R22XF   CONVERT COMP-2 
          EQ     CVCOMP2     RETURN 
          EJECT 
**
*         DSP2BIN - DISPLAY CODE LITERAL TO BINARY CONVERSION 
* 
*         FUNC   DSP2BIN; 
*         BIN = DSP2BIN(DC,SIZE); 
* 
*         BIN = BINARY CONVERSION 
*         DC  = NUMBER TO BE CONVERTED
*         SIZE= SIZE OF SOURCE
* 
  
          ENTRY  DSP2BIN
          EXT    C.N12RN
          EXT    C.U10R1
  
 DSP2BIN  EQ     *+1S17      ENTRY / EXIT 
          SB1    1
          SA1    A1 
          SB3    X1          B3 = ADDRESS OF DC 
          SX2    0           X2 = BCP 
          SA1    A1+1 
          SA1    X1 
          SB4    X1          B4 = SIZE OF DC
          SA3    C.ZEROS   X3 = 10H0000000000 
          RJ     =XC.N12RN   RIGHT JUSTIFY W/DISPLAY CODE ZEROS 
          RJ     =XC.U10R1   CONVERT TO BINARY
          SX6    X1 
          EQ     DSP2BIN
  
          SPACE  4,10 
**        SETHDR - SET UP HEADER. 
* 
*         PROC SETHDR;
*         SETHDR; 
  
  
          ENTRY  SETHDR 
 SETHDR   EQ     *+1S17      ENTRY / EXIT 
          SB1    1
          SA5    PAGENO 
          NZ     X5,SEH1     IF NOT 1ST PAGE
          DATE   DATELOC     INSERT DATE AND TIME 
          CLOCK  TIMELOC
 SEH1     SX6    X5+B1       ADVANCE PAGE NUMBER
          SA6    A5 
          SA1    PAGENOA     CONVERT TO DECIMAL 
          RJ     CDD
          MX7    -6*6        PUT IN HEADER IN LAST 6 CHARS
          BX6    -X7*X6 
          LX6    24 
          SA6    PAGELOC
          EQ     SETHDR      RETURN 
  
 PAGENOA  CON    PAGENO 
 PAGENO   CON    0
  
          ENTRY  MAINHDR
 MAINHDR  DATA   50H1CDC COBOL "COBVER" - LEVEL "COBLVL"  TERMINATION DU
,MP 
          DATA    30H 
          DATA   10H
 DATELOC  DATA   10H
 TIMELOC  DATA   10H
          DATA   10H      PAGE
 PAGELOC  DATA   10H
          SPACE  4,10 
**        TDEMPTY  -  EMPTY INPUT FILE
* 
          ENTRY  TDEMPTY
 TDEMPTY  DATA   0
          MESSAGE EMPTY,,RCL
          ENDRUN
          SPACE  3
 EMPTY    DIS    ,*EMPTY TDF OR/AND DUMP FILE(S)* 
          SPACE  3
**        TDERROR - ISSUE MESSAGE AND ABORT.
* 
*         PROC TDERROR; 
*         TDERROR(MES); 
* 
*         MES = FWA OF 40 CHAR ITEM CONTAINING MESSAGE. 
*               (LAST 2 CHARS WILL BE CHANGED TO A ZERO BYTE.)
  
  
          ENTRY  TDERROR
 MSGSIZE  EQU    4           SIZE OF MESSAGES PASSED FROM C5TDMP
 TDERROR  EQ     *+1S17      ENTRY / EXIT 
          SB1    1
          SA2    X1          WORD 1 OF MESSAGE
          BX6    X2 
          SB7    MSGSIZE-1
          SA6    MSGBUF 
 TDE1     SA2    A2+B1       REMAINING WORDS OF MESSAGE 
          SB7    B7-B1
          BX6    X2 
          SA6    A6+B1
          NZ     B7,TDE1
          MX3    -12         PUT ZERO BYTE AT END 
          BX6    X3*X6
          SA6    A6 
          MESSAGE  MSGBUF,,RCL  SEND MESSAGE
          ENDRUN
  
 MSGBUF   BSS    MSGSIZE
  
          ENTRY  C.BLANK
 C.BLANK  BSS    0
          DUP    15,1 
          CON    10H
  
          ENTRY  C.MASK 
 C.MASK   BSS    0
          CON    0
          CON    77000000000000000000B
          CON    77770000000000000000B
          CON    77777700000000000000B
          CON    77777777000000000000B
          CON    77777777770000000000B
          CON    77777777777700000000B
          CON    77777777777777000000B
          CON    77777777777777770000B
          CON    77777777777777777700B
          CON    77777777777777777777B
  
          ENTRY  C.ZEROS
 C.ZEROS  CON    10H0000000000
          ENTRY  C.ZERO 
 C.ZERO   EQU    C.ZEROS
  
          ENTRY  C.CNVRT
 C.CNVRT  CON    00770077007700770077B
          CON    00007777000077770000B
#T1       DECMIC 1S24-1000
          CON    -"#T1".0S-24 
          CON    100000000
          CON    10000000000
          END 
