*COMDECK C5DBPROC 
BEGIN 
$BEGIN
#THIS VERSION OF THE DEBUG PROCESSOR HAS BEEN WRITTEN SPECIFICALLY
FOR THE COBOL 5 COMPILER
# 
CONTROL NOLIST; 
CONTROL IFEQ DEBUG,"ON";
DEF DEBUG$SW #1#;  #NECESSARY FOR CLEAN COMPILE WHEN E-OPTION ON# 
*CALL DEBUGVARS 
  
  
  
FUNC DEC(VALUE) C(10);
BEGIN 
ITEM DECVALUE C(10);  #OUTPUT DECIMAL CHARACTER STRING# 
ITEM COUNT; 
ITEM VALUE;  #SIGNED VALUE AS SPECIFIED#
ITEM USVALUE;  #UNSIGNED VALUE# 
ITEM QUOTIENT; #RESULT OF VALUE/DIVISOR#
ITEM ASTERS C(10) = "**********";  #RETURNED IF OVERFLOW# 
  
ARRAY DIVISA [8] S(1);
 ITEM DIVISOR = [100000000,10000000,1000000,100000,10000,1000,100,10,1];
  
IF VALUE LS 0 
  THEN #-VE#
  BEGIN 
  USVALUE=-VALUE; 
  C<9,1>DECVALUE="-"; 
  END 
  ELSE #+VE#
  BEGIN 
  USVALUE=VALUE;
  C<9,1>DECVALUE=" "; 
  END 
  
IF USVALUE GR 999999999  #NINE 9S#
  THEN
  BEGIN 
  DEC=ASTERS;  #RETURN ASTERISKS# 
  END 
  
  
FOR COUNT = 0 STEP 1 UNTIL 8
  DO #CHARACTER CONVERSION# 
  BEGIN 
  QUOTIENT=USVALUE/DIVISOR[COUNT];
  C<COUNT,1>DECVALUE = O"33" + QUOTIENT ; 
  USVALUE=USVALUE-(DIVISOR[COUNT]*QUOTIENT);
  END 
  
  
FOR COUNT=0 STEP 1 WHILE C<COUNT,1>DECVALUE EQ "0"
                             AND COUNT LQ 7 
  DO C<COUNT,1>DECVALUE = " ";
  
  
DEC=DECVALUE; 
END #DECIMAL CONVERSION#
  
  
FUNC OCT(VALUE) C(25);
BEGIN 
ITEM VALUE U;  #UNSIGNED# 
ITEM OCTVALUE C(25);  #FORMAT IS 77777 77777 77777 77777 B# 
ITEM CHARPOS;  #CHARACTER POSITION WITHIN OCTVALUE# 
ITEM GRPCOUNT; #COUNTS THE 5-DIGIT GROUPS#
ITEM CHARCOUNT; #COUNTS THE OCTAL DIGITS (TRIADS) IN VALUE# 
CHARPOS=0;
  
FOR GRPCOUNT=0 STEP 15 UNTIL 45 
  DO
  BEGIN 
  FOR CHARCOUNT=0 STEP 1 UNTIL 4
    DO
    BEGIN 
    C<CHARPOS+CHARCOUNT,1>OCTVALUE =
           O"33" + B<GRPCOUNT+(CHARCOUNT*3),3>VALUE;
    END 
  C<CHARPOS+CHARCOUNT+1>OCTVALUE=" ";  #STACK A SPACE#
  CHARPOS=CHARPOS+CHARCOUNT+1;  #UPDATE OCTVALUE POINTER# 
  END 
  
C<24,1>OCTVALUE="B";
OCT=OCTVALUE; 
END #OCTAL CONVERSION#
  
  
  
XREF PROC CBLIST; 
  
ARRAY PRINTLINE [13] S(1);
  BEGIN 
  ITEM PRINTWORD C(0,0,10); 
  END 
  
ITEM FIRST I=0;  #FIRST TIME FLAG#
ITEM PRINTPTR I=0 ; #CHARACTER POINTER TO PRINTLINE#
ITEM COUNT; 
ITEM OCTCHAR C(25);  #HOLD $NVALUE$ IN OCTAL# 
ITEM DECCHAR C(10);  #HOLDS $NVALUE$ IN DECIMAL#
  
#CLEAR LINE#
FOR COUNT = 0 STEP 1 UNTIL 13 
  DO PRINTWORD[COUNT] = " ";
PRINTPTR=0; 
  
IF FIRST EQ 0 
  THEN #FIRST TIME# 
  BEGIN 
  CBLIST(8,"DEBUGO",6);  #OPEN# 
  CBLIST(4,"START OF DEBUG OUTPUT",30); #DEFINE TITLE#
  CBLIST(5,"MODULE      TYPE",20);  #DEFINE SUBTITLE# 
  CBLIST(3,0,0);  #PAGE EJECT#
  FIRST=1;
  END 
  
STACK($CURRMODL$,12);  #STACK MODULE NAME#
  
IF $DBUGTYPE$ EQ $SET$
  THEN
  BEGIN 
  STACK("XS ",3);  #LINE TYPE FOR SET#
  
  STACK(" ",10);
  END 
  
IF $DBUGTYPE$ EQ $LOGIC$
  THEN
  BEGIN 
  STACK("XSL",3);  #LINE TYPE FOR LOGIC#
  STACK(" ",10);
  STACK(" ",10);
  END 
  
IF $DBUGTYPE$ EQ $STARFIN$
  THEN
  BEGIN 
  STACK("X  ",3);  #LINE TYPE FOR START/FINISH# 
  END 
  
FOR COUNT = 0 STEP 1 WHILE C<COUNT,2>$TITLE$ NQ "  "
                           AND COUNT LS 20
  DO BEGIN END
  
STACK($TITLE$,COUNT);  #STACK TITLE#
STACK(" = ",3); 
  
IF $DATATYPE$ EQ $CHAR$ 
  THEN
  BEGIN 
  STACK($CVALUE$,80); 
  END 
  
IF $DATATYPE$ EQ $INT$
  THEN
  BEGIN 
  STACK(DEC($NVALUE$),10);
  END 
  
IF $DATATYPE$ EQ $OCT$
  THEN
  BEGIN 
  STACK(OCT($NVALUE$),25);
  END 
  
IF $TITLE$ EQ $START$ THEN CBLIST(2,PRINTLINE,136); 
                      ELSE CBLIST(1,PRINTLINE,136); 
  
  
PROC STACK(DATA,LENGTH);
BEGIN 
ITEM DATA C(80);
ITEM LENGTH;
  
C<PRINTPTR,LENGTH>PRINTWORD[0]=C<0,LENGTH>DATA; 
PRINTPTR=PRINTPTR+LENGTH; 
  
END #STACK# 
CONTROL FI; 
  
  
  
$END
CONTROL LIST; 
END #DEBUGPROC# 
TERM
