*DECK DB$TRC
USETEXT CDCSCTX 
      PROC DB$TRC;
      BEGIN 
  
      XREF FUNC DB$CDIS C(10);
      XREF FUNC DB$CFIL C(30);
      XREF PROC DB$LINE;
      XREF PROC DB$PUNT;
  
      CONTROL NOLIST;        #CDCSCOMMN UPDATE COMMON DECK# 
      CONTROL LIST; 
*CALL DB$FUNC 
  
  
      DEF TABFUNC #17#; 
      DEF TABCOMM #28#; 
      ITEM CX = TABCOMM;
      ITEM LINE C(140) = " "; 
      ITEM TAB0 = 2;
      ITEM TEMP;
      XREF ARRAY DB$RA0;
        BEGIN 
        ITEM RA;
        END 
      CONTROL EJECT;
      XDEF PROC DB$TRCO;
      PROC DB$TRCO(DIS,OCT,NUM);
      BEGIN 
      ITEM DIS C(30); 
      ITEM OCT; 
      ITEM NUM; 
  
      IF NUM GR 20 OR NUM LS 0 THEN 
        DB$PUNT("DB$TRCO  1");
      ADDDIS(DIS,NUM);
      IF NUM EQ 0 THEN
        RETURN; 
      IF NUM LQ 10 THEN 
        BEGIN 
        C<CX,NUM>LINE = DB$CDIS(OCT,NUM,8,"0"); 
        CX = CX+NUM;
        END 
      ELSE
        BEGIN 
        C<CX,NUM-10>LINE = DB$CDIS(B<60-3*NUM,3*(NUM-10)>OCT
                                  ,NUM-10,8,"0"); 
        CX = CX+NUM-10; 
        C<CX,10>LINE = DB$CDIS(B<30,30>OCT,10,8,"0"); 
        CX = CX+10; 
        END 
      RETURN; 
      END 
      CONTROL EJECT;
      XDEF PROC DB$TRCT;
      PROC DB$TRCT(DIS,DP,(NUM)); 
      BEGIN 
      ITEM DIS C(30); 
      ITEM DP C(30);
      ITEM NUM; 
  
      IF NUM GR 30 THEN 
        NUM = 30; 
      ADDDIS(DIS,NUM);
      C<CX,NUM>LINE = DP; 
      CX = CX+NUM;
      RETURN; 
      END 
      CONTROL EJECT;
      XDEF PROC DB$TRCS;
      PROC DB$TRCS(FC,UCPA,SCPA); 
      BEGIN 
      ITEM FC;
      ITEM UCPA;
      ITEM SCPA;
  
      ITEM INDEX; 
      ARRAY [10] P(2);
        BEGIN 
        ITEM SFFC (0,0,60)=[DFSFCLTC,DFSFENDT,DFSFEXIT,DFSFREAD,
                            DFSFREGR,DFSFSLTC,DFSFSTAT,DFSFSWPI,
                            DFSFSWPO,DFSFWRIT]; 
        ITEM SFCL C(1,0,4) = ["CLTC","ENDT","EXIT","READ",
                               "REGR","SLTC","STAT","SWPI", 
                               "SWPO","WRIT"];
        END 
  
  
      FOR INDEX=9 STEP -1 UNTIL 0 DO
        BEGIN 
        IF FC EQ SFFC[INDEX] THEN 
          BEGIN 
          DB$TRCT("SFCL :",SFCL[INDEX],4);
          INDEX = 0;
          END 
        END 
      IF UCPA NQ 0 THEN 
        DB$TRCO("UCPA=:",UCPA,6); 
      IF SCPA NQ 0 THEN 
        DB$TRCO("SCPA=:",SCPA,6); 
      RETURN; 
      END 
      CONTROL EJECT;
      XDEF PROC DB$TRCX;
      PROC DB$TRCX(WAITX);
      BEGIN 
      ITEM WAITX; 
  
      ARRAY [15] S(1);
        BEGIN 
        ITEM WAIT C(0,0,10) = [15("WAIT-XXXX:")]; 
        ITEM DUMW0 C(0,0,10)=["WAIT-NONE:"];
        ITEM DUMW1 C(DFWAITINP,0,10) = ["WAIT INPT:"];
        ITEM DUMW3 C(DFWAITIO,0,10) = ["WAIT IO:"]; 
        ITEM DUMW4 C(DFWAITXE,0,10)  = ["WAITEVENT:"];
        ITEM DUMW6 C(DFWAITINV,0,10) = ["WAIT INV:"]; 
        ITEM DUMW8 C(DFWAITLOCK,0,10) = ["WAIT LOCK:"]; 
        ITEM DUMW9 C(DFWAITTASK,0,10)=["WAIT-TASK:"]; 
        ITEM DUMW10 C(DFWAITTERM ,0,10) = ["WAIT TERM:"]; 
        ITEM DUMW11 C(DFWAITLOG  ,0,10) = ["WAIT LOG: "]; 
        ITEM DUMW12 C(DFWAITCOUNT,0,10) = ["WAITCOUNT:"]; 
        ITEM DUMW13 C(DFWAITJFOK ,0,10) = ["WAIT JFOK:"]; 
        ITEM DUMW14 C(DFWAITRTN  ,0,10) = ["WAIT RETN:"]; 
        END 
  
  
      IF WAITX EQ 0 THEN
        RETURN; 
  
      DB$TRCO(WAIT[WAITX],0,0); 
      RETURN; 
      END 
      CONTROL EJECT;
      XDEF PROC DB$TRCD;
      PROC DB$TRCD(DIS,(LOCATION),(NUMBER));
      BEGIN 
 #
* *   DB$TRC  - DEBUGGING TRACE ROUTINES         PAGE  1
* *   DB$TRCD - DUMP SELECTED MEMORY LOCATION (OCTAL AND SYMBOLIC)
* *   CF RICHARDS  (DOCUMENTATION ADDED)         DATE  10/10/78 
* 
* DC  PURPOSE 
* 
*     DUMP SELECTED MEMORY LOCATION TO THE CDCS OUTPUT FILE, TWO CM 
*     WORDS PER LINE, IN OCTAL AND CHARACTER FORMAT.
* 
* DC  ENTRY CONDITIONS
* 
*     PARAMETERS
# 
      ITEM  DIS C(30);       # STRING OF UP TO 30 CHARACTERS,          #
                             # TERMINATED BY A COLON. THIS STRING      #
                             # IS USED TO IDENTIFY THE CONTENT OF      #
                             # THE DUMP.                               #
      ITEM  LOCATION I;      # ABSOLUTE ADDRESS AT WHICH WE SHOULD     #
                             # BEGIN DUMPING. MUST BE LQ FL-2.         #
      ITEM  NUMBER I;        # NUMBER OF WORDS TO BE DUMPED. NOTE      #
                             # IF NUMBER IS ODD, NUMBER+1 WORDS ARE    #
                             # DUMPED.                                 #
# 
*     ASSUMPTIONS 
* 
*     NONE. 
* 
* DC  EXIT CONDITIONS 
* 
*     NONE. 
* 
* DC  CALLING ROUTINES
* 
*     NONE. 
* 
* DC  CALLED ROUTINES 
* 
*          PROC ADDDIS         ADD DISPLAY STRING TO TRACE LINE 
*          FUNC DB$CDIS C(10)        CONVERT TO OCTAL DISPLAY CODE
*          PROC DB$LINE        WRITE LINE TO CDCS OUTPUT FILE 
*          PROC DB$TRCO        ENTER IDENTIFIED OCTAL VALUE IN
*                              TRACE STRING 
* 
* DC  NON-LOCAL VARIABLES 
* 
*     NONE OTHER THAN THOSE SHARED BY ALL TRACE ROUTINES. 
* 
* DC  DESCRIPTION 
* 
*     THE IDENTIFYING STRING IS ENTERED IN THE TRACE LINE. THE
*     LOCATION IS ENTERED IN THE TRACE LINE, PRECEDED BY *LOC=*.
*     THEN A LOOP IS ENTERED FOR EACH PAIR OF WORDS REQUESTED (NOTE 
*     IF THE NUMBER OF WORDS REQUESTED IS AN ODD NUMBER, AN EXTRA 
*     WORD IS DUMPED). THE LOOP WRITES THE CURRENT LINE, INITIALIZES
*     THE LINE, AND FILLS THE LINE WITH THE NEXT TWO WORDS
*     (OCTAL/SYMBOLIC/OCTAL/SYMBOLIC). NOTE THE FIRST EXECUTION 
*     FLUSHES ANY PREVIOUS LINE SO ALL DUMP LINES ARE ALIGNED.
*     NOTE ALSO THAT A DISPLAY CODE OF ZERO IS PRINTED AS A BLANK.
*     UPON EXIT FROM THIS ROUTINE, THE LAST DUMPED LINE REMAINS IN
*     *LINE*, BUT *CX* WAS LEFT SUCH THAT NO ROOM EXISTED IN *LINE*,
*     THUS THE NEXT TRACE CALL WOULD FLUSH IT.
 #
  
      ITEM INDEX; 
      ITEM INDEX1;
      ITEM INDEX2;
      ITEM TEMPC C(1);
  
      ADDDIS(DIS,0);
      DB$TRCO("LOC=:",LOCATION,6);
      FOR INDEX = 1 STEP 2 UNTIL NUMBER DO
        BEGIN 
        DB$LINE(LINE,CX); 
        LINE = " "; 
        CX = TABCOMM; 
        FOR INDEX1 = 1 STEP -1 UNTIL 0 DO   #DO TWOE WORDS PER LINE#
        BEGIN 
        TEMP = RA[LOCATION];
        C<CX,10>LINE = DB$CDIS(B<0,30>TEMP,10,8,"0"); 
        CX = CX+11; 
        C<CX,10>LINE = DB$CDIS(B<30,30>TEMP,10,8,"0");
        CX = CX + 11; 
        FOR INDEX2=0 STEP 1 UNTIL 9 DO
          BEGIN 
          IF B<6*INDEX2,6>TEMP NQ 0 THEN
            BEGIN 
            TEMPC = C<INDEX2>TEMP;
            C<CX>LINE = TEMPC;
            END 
          CX = CX+1;
          END 
        LOCATION = LOCATION + 1;
        CX = CX + 1;
        END 
        END 
      CX = 135; 
      RETURN; 
      END 
      CONTROL EJECT;
      XDEF PROC DB$TRCZ;
      PROC DB$TRCZ; 
      BEGIN 
      DB$LINE(LINE,CX); 
      RETURN; 
      END 
      CONTROL EJECT;
      PROC ADDDIS(DIS,NUM); 
      BEGIN 
      ITEM DIS C(30); 
      ITEM NUM; 
  
      ITEM DISX;
      ITEM FUNCSAVED; 
      ITEM RCBSAVED;
      ITEM TQTSAVED;
  
  
      IF RCBSAVED NQ LOC(RCB) 
      OR TQTSAVED NQ LOC(TQT) 
      THEN
        BEGIN 
        IF TQTSAVED NQ 0 THEN 
          BEGIN 
          DB$LINE(LINE,CX); 
          CX = TABCOMM; 
          LINE = " "; 
          END 
        RCBSAVED = LOC(RCB);
        TQTSAVED = LOC(TQT);
        FUNCSAVED = RCFUNC[0];
        IF LOC(TQT) NQ 0 THEN 
          BEGIN 
          C<TAB0,7>LINE = DB$CFIL(C<0,7>TQRUID[0],7," "); 
          IF C<0,7>TQRUID[0] NQ "MONITOR" THEN
            C<TAB0+9,3>LINE = DB$CDIS(TQTASK[0],3,8,"0"); 
          ELSE
            C<TAB0+6,6>LINE = DB$CDIS(LOC(RCB),6,8," ");
          IF FUNCSAVED LQ DFFUNCMAX THEN
            C<TABFUNC,10>LINE = FUNCODE[FUNCSAVED]; 
          ELSE
            C<TABFUNC,10>LINE = FUNCODE[0]; 
          END 
        ELSE
          BEGIN 
          C<TAB0,12>LINE = "-------"; 
          C<TABFUNC,5>LINE = " "; 
          END 
        GOTO ADDCOMMENT;
        END 
  
      IF FUNCSAVED EQ 0 
      AND RCFUNC[0] NQ 0
      THEN
        BEGIN 
        FUNCSAVED = RCFUNC[0];
        C<TABFUNC,10>LINE = FUNCODE[FUNCSAVED]; 
        END 
      IF FUNCSAVED NQ RCFUNC[0] THEN
        BEGIN 
        DB$LINE(LINE,CX); 
        LINE = " "; 
        FUNCSAVED = RCFUNC[0];
        C<TABFUNC,10>LINE = FUNCODE[FUNCSAVED]; 
        CX = TABCOMM; 
        END 
  
  
ADDCOMMENT: 
      FOR DISX=0 STEP 1 UNTIL 29 DO 
        BEGIN 
        IF C<DISX>DIS EQ ":" THEN 
          GOTO DISXOUT; 
        END 
      DISX = 29;
DISXOUT:  
  
      IF CX+DISX+NUM GR 126 THEN
        BEGIN 
        DB$LINE(LINE,CX); 
        LINE = " "; 
        CX = TABCOMM; 
        END 
      IF CX NQ TABCOMM THEN 
        BEGIN 
        C<CX,3>LINE = "   ";
        CX = CX+3;
        END 
      C<CX,DISX>LINE = DIS; 
      CX = CX+DISX; 
      RETURN; 
      END 
  
      END 
      TERM; 
