*DECK C$TRACE 
          IDENT  C$TRACE
          TITLE  CBTRACE - PARAGRAPH TRACE
          MACHINE  ANY,I
          COMMENT  PARAGRAPH TRACE
          SST 
          B1=1
 TAF      IFEQ   OP.TAF,OP.NO 
          SPACE  4
**        C.TRACE - PARAGRAPH TRACE 
* 
*         CALLING SEQUENCE- 
*                RJ   C.TRACE 
*                VFD   60/ FIRST 10 CHARS OF PARAGRAPH NAME 
*                VFD   60/SECOND 10 CHARS OF PARAGRAPH NAME 
*                VFD   60/ THIRD 10 CHARS OF PARAGRAPH NAME 
* 
*                RJ   C.ONTR
*                RJ   C.OFFTR 
*                RJ   C.STPTR 
* 
*         DOES- 
*                C.TRACE-  IF TRACE IS ON- PUTS NAME, TRACE COUNT AND 
*                          TIME USED IN MESSAGE AND WRITES IT OUT 
*                C.ONTR-  SETS TRACE FLAG, FORMATS MESSAGE AND WRITES 
*                         IT OUT
*                C.OFFTR-  CLEARS TRACE FLAG, FORMATS MESSAGE AND WRITES
*                         IT OUT
*                C.STPTR-  FORMATS MESSAGE, WRITES IT OUT AND CLOSES
*                          TRACE FILE 
* 
*         USES- 
*                ALL REGISTERS
*                C.R1U06, C.R1U10 
* 
*         NOTE- 
*                THIS ROUTINE PROVIDES A PARAGRAPH TRACE OF A COBOL5
*                PROGRAM. 
*                PROGRAM MUST BE COMPILED WITH DB=TR PARAMETER ON 
*                CONTROL CARD.
*                A CALL TO C.TRACE IS GENERATED FOR EACH PROC-DEF EXCEPT
*                SECTION HEADERS. 
*                TO TURN THE TRACE ON- ENTER "C.ONTR".
*                TO TURN IT OFF- ENTER "C.OFFTR". 
*                A CALL TO C.STPTR (TO CLOSE THE TRACE FILE) IS 
*                GENERATED FOR EACH STOP RUN AND PRECEDING THE "NO STOP 
*                RUN" FALL-THROUGH CODE AT THE END OF EACH PROGRAM. 
*                THE TRACE IS WRITTEN TO THE FILE ZZZZZTR (LFN= COBTRFL)
*                AS C BLOCKS, 30 CHAR F RECORDS 
* 
          EJECT 
          ENTRY  C.OFFTR
          ENTRY  C.ONTR 
          ENTRY  C.STPTR
          ENTRY  C.TRACE
 C.TRACE  DATA   0
          SA2    C.TRACE
          AX2    30 
          SX0    3
          SA3    X2          1ST 10 CHARS OF NAME 
          IX6    X2+X0       ACTUAL RETURN ADDRESS
          SA5    ONFLAG 
          LX6    30 
          SA6    DPRTN       SAVE RETURN
          ZR     X5,TRACEEX  JP IF TRACE NOT ON 
          BX6    X3 
          SA2    A3+B1       2ND 10 CHARS OF NAME 
          SA6    TRWSA
          BX7    X2 
          SA3    A2+B1       3RD 10 CHARS OF NAME 
          SA7    A6+B1
          BX6    X3 
          SA6    A7+B1
          SB2    =YC.TDUMP    NO TERMINAL DUMP
          NG     B2,WRITE1
          SA3    C.TRPTR
          SX2    3
          IX4    X2*X3
          SB2    X4 
          SA1    TRWSA
          BX6    X1 
          SA6    C.TRWSA+B2 
          SA1    A1+B1
          BX6    X1 
          SA6    A6+B1
          SA1    A1+B1
          BX6    X1 
          SA6    A6+B1
          SX7    X3+1 
          SX4    X7-10
          SA1    C.TRLEN
          SX1    X1-10
          ZR     X1,TRACE1
          SA7    C.TRLEN
 TRACE1   NZ     X4,TRACE2
          MX7    0
 TRACE2   SA7    C.TRPTR
 WRITE1   BSS    0
          SA1    COUNTER     GET TRACE COUNTER
          SX2    B1 
          IX1    X1+X2       BUMP COUNTER 
          BX7    X1 
          SA7    A1 
          RJ     =XC.R1U06   CONVERT COUNT TO DISPLAY 
          MX7    48 
          LX1    12 
          BX6    X7*X1       PUT IN ZERO BYTES
          SA6    TRNBR       PUT NUMBER IN LINE 
          TIME   TIME1       GET CP TIME USED 
          SA2    TIME1
          MX7    48 
          BX1    -X7*X2      MILLISECONDS 
          RJ     =XC.R1U06   CONVERT TO DISP
          SA2    TIME1
          BX6    X1 
          SA6    A2          SAVE MILLISECONDS
          AX2    12 
          MX0    60-24
          BX1    -X0*X2      SECONDS
          RJ     =XC.R1U10
          LX1    18 
          SA2    TIME1
          MX0    60-18
          BX6    X0*X1
          BX2    -X0*X2 
          BX6    X6+X2
          SA6    A2          PUT TIME IN MESSAGE
          PUT    ZZZZZTR     WRITE A PARA NAME
 TRACEEX  BSS    0
          SA1    DPRTN       GET RETURN ADDRESS 
          AX1    30 
          SB2    X1          ACTUAL ADDRESS 
          JP     B2          RETURN 
 DPRTN    DATA   0           RETURN 
          EJECT 
* 
*      CALLED TO TURN ON TRACE
* 
 C.ONTR   DATA   0
          SA2    FTFLAG 
          NZ     X2,NTFT     JUMP IF NOT FIRST TIME 
          OPENM  ZZZZZTR,OUTPUT,R  OPEN TRACE FILE
 NTFT     BSS    0
          MX6    1
          SA6    FTFLAG      SET FLAG 
          SA2    C.ONTR 
          SB3    ONMSG
          EQ     PROCA
* 
*      CALLED TO TURN OFF TRACE 
* 
 C.OFFTR  DATA   0
          SA2    C.OFFTR
          MX6    0
          SB3    OFFMSG 
 PROCA    BSS    0
          SA6    ONFLAG      SET TRACE FLAG 
          BX7    X2 
          SA7    DPRTN       RETURN 
          SA2    B3 
          SB3    2
          RJ     MOVEIT      MOVE MESSAGE 
          LX7    30 
          SA2    X7-1        GET CALLING WORD 
 PROCB    BSS    0
          MX0    48 
          BX1    -X0*X2      LINE NUMBER
          RJ     =XC.R1U06   CONVERT TO DECIMAL 
          SA2    MSGLN
          MX0    30 
          BX6    -X0*X1 
          BX6    X2+X6
          SA6    TRWSA+2     LINE NUMBER MOVED
          EQ     WRITE1 
          EJECT 
* 
*   CALLED TO CLOSE TRACE FILE
* 
 C.STPTR  DATA   0
          SA2    FTFLAG 
          ZR     X2,C.STPTR 
          SA2    JPCLS
          BX6    X2 
          SA6    DPRTN       RETURN TO CLOSE INST 
          SA2    ENDMS
          SB3    3           NBR WORDS IN MS
          RJ     MOVEIT 
          SA3    C.STPTR
          LX3    30 
          SA2    X3-1 
          EQ     PROCB
 JPCLS    EQ     CLOSEIT
 CLOSEIT  BSS    0
          MX6    0
          SA6    FTFLAG      SET TO RE-OPEN FILE IF TRACE ON AGAIN
          CLOSEM ZZZZZTR,R,FILE  CLOSE TRACE FILE 
          EQ     C.STPTR
* 
*   THIS ROUTINE MOVES A MESSAGE TO THE RECORD AREA 
*         ENTER WITH THE FIRST WORD IN X2, ADDR IN A2 
*                B3          HAS COUNT OF WORDS 
*                DESTROYS A2, X2, B2, A6, X6
 MOVEIT   DATA   0
          SB2    B0 
 MOVEITL  BSS    0
          BX6    X2 
          SA6    B2+TRWSA 
          SB2    B2+B1
          EQ     B2,B3,MOVEIT 
          SA2    A2+B1
          EQ     MOVEITL
 ZZZZZTR  FILE   LFN=COBTRFL,RT=F,BT=C,BFS=130,WSA=TRWSA,FF=YES,FL=50 
          ENTRY  C.TRLEN
          ENTRY  C.TRPTR
          ENTRY  C.TRWSA
          ENTRY  C.LINE 
 C.LINE   DATA   0
 C.TRLEN  DATA   0
 C.TRPTR  DATA   0
 C.TRWSA  BSS    30 
 TRWSA    BSSZ   3
 TIME1    DATA   0           TIME USED
 TRNBR    DATA   8C00000000 
 COUNTER  DATA   0           COUNT OF NUMBER OF TRACE ITEMS 
 ONMSG    DATA   20H**** TRACE ON FROM
 OFFMSG   DATA   20H**** TRACE OFF FROM 
 ENDMS    DATA   30H**** TRACE CLOSED 
 ONFLAG   DATA   0
 FTFLAG   DATA   0
 MSGLN    VFD    30/5HLINE ,30/0
 TAF      ELSE
          ENTRY  C.TRACE
          ENTRY  C.ONTR 
          ENTRY  C.STPTR
          ENTRY  C.OFFTR
          SYSCOM B1 
*COMMENT  TRANSACTION COBOL5 TRACE ROUTINE. 
          COMMENT  COPYRIGHT CONTROL DATA. 1978.
          SPACE  4
*****     C.TRACE - COBOL5 DUBUGGING PARAGRAPH TRACE. 
* 
*         D. F. NELSON.      1976.
*         W. E. MARTIN.      1978.
          SPACE  4,40 
***       C.TRACE - COBOL5 DEBUGGING PARAGRAPH TRACE. 
* 
*         C.TRACE IS CALLED IN DUBUGGING MODE, FORMATTING A MESSAGE 
*         WHICH CONTAINS THE CALLING PARAGRAPH NAME, TRACE COUNT AND
*         TIME.  THIS TRACE PACKET IS THEN ISSUED TO THE TERMINAL VIA 
*         A TRANSACTION *SEND*.  IN ORDER TO ACTIVATE THE PARAGRAPH 
*         TRACE, THE PROGRAM MUST BE COMPILED WITH THE *DB=TR*
*         PARAMETER ON THE COBOL5 CONTROL CARD.  A CALL TO *C.TRACE*
*         IS GENERATED BY THE COMPILER FOR EACH PARAGRAPH DEFINITION, 
*         WITH THE EXCEPTION OF SECTION HEADERS.
* 
*         C.ONTR - SETS TRACE FLAG, FORMATS MESSAGE AND ISSUES *SEND* 
*         TO TERMINAL.
* 
*         C.OFFTR - CLEARS TRACE FLAG, FORMATS MESSAGE AND ISSUES 
*         *SEND* TO TERMINAL. 
* 
*         C.STPTR - FORMATS MESSAGE AND ISSUES *SEND* TO TERMINAL.
*         THIS IS SUPPORTED FOR COMPATIBILITY, IN THAT CLOSES OF
*         THE *TRACE* FILE ARE NOT NECESSARY IN THE TRANSACTION 
*         ENVIRONMENT.
* 
*         COMPILER GENERATED SEQUENCE - 
*                RJ   =XC.TRACE 
*                VFD   60/ FIRST TEN CHARACTERS OF PARAGRAPH NAME.
*                VFD   60/ SECOND TEN CHARACTERS OF PARAGRAPH NAME. 
*                VFD   60/ THIRD TEN CHARACTERS OF PARAGRAPH NAME.
* 
*         ALTERNATE SEQUENCE -
*                RJ   C.ONTR
*                RJ   C.OFFTR 
*                RJ   C.STPTR 
* 
*         NOTE - TRANSACTION SUPPORT OF *PARAGRAPH TRACING* IS ONLY 
*         SUPPORTED FOR USE WITH THE COBOL5 COMPILER. 
  
  
          VFD    42/0LC.TRACE,18/C.TRACE
  
 C.TRACE  PS                 ENTRY
          SB1    1
          SA2    C.TRACE     READ ADDRESS OF CALLING PARAGRAPH
          SA5    CBTA        READ *TRACE-ON* FLAG 
          LX2    29-59
          SA3    X2          READ FIRST TEN CHARACTERS OF NAME
          ZR     X5,CBT1     IF *TRACE-ON* FLAG NOT SET 
          BX6    X3 
          SA2    A3+B1       READ SECOND TEN CHARACTERS OF PARAGRAPH
          SA6    CBTK 
          BX7    X2 
          SA3    A2+B1       READ THIRD TEN CHARACTERS OF PARAGRAPH 
          SA7    A6+B1
          BX6    X3 
          SA6    A7+1 
          RJ     IMT         ISSUE MESSAGE TO TERMINAL
  
*         COMPUTE RETURN ADDRESS AND EXIT.
  
 CBT1     SA1    C.TRACE     READ RETURN ADDRESS
          LX1    29-59
          SB2    X1+3        INCREMENT TO PROPER ADDRESS
          JP     B2          RETURN 
 C.ONTR   SPACE  4,10 
**        C.ONTR - TURN ON PARAGRAPH TRACE. 
* 
*         C.ONTR IS CALLED TO TURN ON PARAGRAPH TRACE.  THIS MUST BE
*         DONE BY THE USER WITH AN EXPLICIT USER CALL TO *C.ONTR*.
  
  
 C.ONTR   PS                 ENTRY/EXIT 
          SB3    CBTEL       (B3) = LENGTH OF *TRACE-ON* MESSAGE
          SA2    C.ONTR 
          MX6    1           SET *TRACE-ON* FLAG
          SA6    FTFLAG      SET TRACE OPEN FLAG
          SB5    CBTE        (B5) = FWA OF MESSAGE
          RJ     POM         PROCESS ON/OFF MESSAGE 
          EQ     C.ONTR      RETURN 
 C.OFFTR  SPACE  4,10 
**        C.OFFTR - TURN OFF PARAGRAPH TRACE. 
* 
*         C.OFFTR IS CALLED TO TURN OFF THE PARAGRAPH TRACE.  THIS
*         MUST BE DONE WITH AN EXPLICIT USER CALL TO *C.OFFTR*. 
  
  
 C.OFFTR  PS                 ENTRY/EXIT 
          SX6    B0+         SET *TRACE-OFF* FLAG 
          SA2    C.OFFTR
          SB3    CBTFL       (B3) = LENGTH OF *TRACE-OFF* MESSAGE 
          SB5    CBTF        (B5) = FWA OF MESSAGE
          RJ     POM         PROCESS ON/OFF MESSAGE 
          EQ     C.OFFTR     RETURN 
 C.STPTR  SPACE  4,15 
**        C.STPTR - STOP PARAGRAPH TRACE. 
* 
*         C.STPTR IS CALLED TO STOP PARAGRAPH TRACING.  THE CALLS 
*         TO THIS ENTRY POINT ARE EXPLICITY GENERATED BY THE COMPILER 
*         FOR *STOPRUNS*.  IN THE TRANSACTION ENVIRONMENT, THIS 
*         ENTRY POINT IS UNNECESSARY, SINCE THE TRACE FILE IS ACTUALLY
*         THE TRANSACTION TERMINAL AND NORMAL I/O BUFFERING IS NOT
*         DONE. 
  
  
 C.STPTR  PS                 ENTRY/EXIT 
          SA2    FTFLAG 
          ZR     X2,C.STPTR  RETURN IF TRACE FILE NOT OPEN
          SX6    B0+         SET *TRACE-OFF* FLAG 
          SA6    A2          SET TRACE FLAG CLOSED
          SB3    CBTGL       (B3) = NUMBER OF WORDS IN MESSAGE
          SB5    CBTG        (B5) = FWA OF MESSAGE
          SA2    C.STPTR
          RJ     POM         PROCESS ON/OFF MESSAGE 
          SYSTEM  CTI,R,CBTL,0B  ISSUE NULL LINE TO TERMONAL
          EQ     C.STPTR     RETURN 
 IMT      SPACE  4,15 
**        IMT - ISSUE MESSAGE TO TERMINAL.
* 
*         ISSUE MESSAGE TO TERMINAL IS CALLED TO COMPLETE THE 
*         TRACE PACKET BY FORMATING THE TRACE COUNT AND CP TIME USED. 
*         ONCE THE PACKET IS COMLETE, IT IS ISSUED TO THE TERMINAL
*         VIA A *SEND*. 
* 
*         ENTRY (CBTK - CBTK+2) UPDATED WITH MESSAGE. 
* 
*         EXIT   (CBTB) UPDATED.
*                TRACE MESSAGE ISSUED TO TERMINAL.
* 
*         USES   A - 1, 6, 7. 
*                X - 0, 1, 2, 6, 7. 
* 
*         CALLS  C.R1U06, C.R1U10.
* 
*         MACROS TIME, SYSTEM.
  
  
 IMT      PS                 ENTRY/EXIT 
  
*         PROCESS TRACE COUNT.
  
          SA1    CBTB        INCREMENT TRACE COUNTER
          SX2    B1 
          IX1    X1+X2
          BX7    X1 
          SA7    A1 
          RJ     =XC.R1U06   CONVERT COUNT TO DISPLAY 
          MX7    -12
          LX1    12 
          BX6    X7*X1       PUT IN ZERO BYTES
          SA6    CBTK+4      SET NUMBER IN LINE 
  
*         OBTAIN TIME AND CONVERT TO DISPLAY. 
  
          TIME   CBTK+3      GET CP TIME USED 
          SA2    CBTK+3 
          MX7    48 
          BX1    -X7*X2      (X1) = MILLISECONDS
          RJ     =XC.R1U06   CONVERT TO DISPLAY 
          SA2    CBTK+3 
          BX6    X1 
          SA6    A2          SAVE MILLISECONDS
          AX2    12 
          MX0    60-24
          BX1    -X0*X2      (X1) = SECONDS 
          RJ     =XC.R1U10   CONVERT TO DISPLAY 
          LX1    18          SET TIME IN MESSAGE
          MX0    60-18
          SA2    CBTK+3 
          BX6    X0*X1
          BX2    -X0*X2 
          BX6    X6+X2
          SA6    A2 
  
*         ISSUE SEND TO TERMINAL. 
  
          SYSTEM  CTI,R,CBTI,0B  ISSUE *SEND* 
          EQ     IMT         RETURN 
 MMB      SPACE  4,15 
**        MMB - MOVE MESSAGE TO BUFFER. 
* 
*         MOVE MESSAGE TO BUFFER MOVES A MESSAGE TO THE BUFFER AREA 
*         FROM WHICH THE TERMINAL *SEND* IS ISSUED. 
* 
*         ENTRY  (B5) = FWA OF MESSAGE. 
*                (B3) = NUMBER OF WORDS IN MESSAGE. 
* 
* 
*         EXIT   (CBTK - CBTK+3) UPDATED WITH TRACE MESSAGE.
* 
*         USES   A - 2, 6.
*                X - 2, 6.
*                B - 2, 4.
* 
  
  
 MMB      PS                 ENTRY/EXIT 
          SB2    B3-B1
          SB4    CBTK        (B4) = FWA OF BUFFER 
          SA2    B5+B2
 MMB1     BX6    X2 
          SA6    B4+B2
          SB2    B2-B1
          SA2    A2-B1
          GE     B2,MMB1     IF NOT LAST WORD 
          EQ     MMB         RETURN 
 POM      SPACE  4,15 
**        POM - PROCESS ON/OFF MESSAGES.
* 
*         PROCESS ON/OFF MESSAGES BY CONSTRUCTING THE PROPER MESSAGES 
*         WHICH ARE ISSUED IN RESPONSE TO CALLS TO *C.OFFTR* AND
*         *C.ONTR*. 
* 
*         ENTRY  (X2) = (ENTRY POINT).
*                (B5) = FWA OF MESSAGE TO BE CONSTRUCTED. 
*                (B3) = LENGTH OF MESSAGE TO BE PROCESSED.
*                (X6) .EQ. ZERO - IF *TRACE-OFF* OPERATION. 
*                (X6) .LT. ZERO - IF *TRACE-ON* OPERATION.
* 
*         EXIT   ON/OFF TRACE MESSAGE ISSUED TO TERMINAL. 
*                (CBTA) UPDATED.
* 
*         USES   A - 2, 6, 7. 
*                X - 0, 1, 2, 6, 7. 
* 
*         CALLS  C.R1U06, IMT, MMB. 
  
  
 POM      PS                 ENTRY/EXIT 
          SB1    1
          SA6    CBTA        SET TRACE FLAG 
          BX7    X2          SAVE (X2)
          RJ     MMB         MOVE MESSAGE TO BUFFER 
          MX0    -12
  
*         CONVERT CALLING LINE NUMBER TO DISPLAY. 
  
          LX7    29-59
          SA2    X7-1        GET CALLING WORD 
          BX1    -X0*X2      (X1) = CALLING LINE NUMBER 
          RJ     =XC.R1U06   CONVERT TO DECIMAL 
          MX0    -30
          BX6    -X0*X1 
          SA2    CBTH        SET CALLING LINE NUMBER INTO MESSAGE 
          BX6    X2+X6
          SA6    CBTK+2 
          RJ     IMT         ISSUE MESSAGE TO TERMINAL
          EQ     POM         RETURN 
  
 FTFLAG   DATA   0           STORAGE FOR FIRST TIME FLAG *TR FILE OPEN* 
 CBTA     CON    0           STORAGE FOR *TRACE-ON* FLAG
 CBTB     CON    0           STORAGE FOR TRACE COUNT
 CBTC     CON    0           STORAGE FOR TIME USED
 CBTD     DATA   8C00000000 
 CBTE     DATA   20H**** TRACE ON FROM
 CBTEL    EQU    *-CBTE      LENGTH OF MESSAGE
 CBTF     DATA   20H**** TRACE OFF FROM 
 CBTFL    EQU    *-CBTF      LENGTH OF MESSAGE
 CBTG     DATA   30H**** TRACE CLOSED 
 CBTGL    EQU    *-CBTG      LENGTH OF MESSAGE
 CBTH     VFD    30/5HLINE ,30/0
  
*         *SEND* PARAMETER BLOCK - INCLUDING NETWORK ABH. 
  
 CBTI     VFD    6/4,24/CBTK,30/CBTKL 
          BSSZ   1           STORAGE FOR SECOND WORD OF *SEND* BLOCK
  
*         NETWORK APLICATION BLOCK HEADER.
  
 CBTJ     VFD    6/2,12/0,18/0,4/4,1/0,3/0,1/1,3/0,12/CBTKL*10
 CBTK     BSSZ   5           STORAGE FOR MESSAGE
 CBTKL    EQU    *-CBTK      LENGTH OF WORK BUFFER
  
*         *SEND* HEADER FOR TRAILING NULL LINE. 
  
 CBTL     VFD    6/1,24/CBTM,30/CBTML 
          BSSZ   1           STORAGE FOR SECOND WORD OF *SEND* BLOCK
  
*         NETWORK APLICATION BLOCK HEADER.
  
          VFD    6/2,12/0,18/0,4/4,1/0,3/0,1/0,3/0,12/CBTML*10
 CBTM     DATA   C*.* 
 CBTML    EQU    *-CBTM 
          SPACE  4
 TAF      ENDIF 
          END 
