*DECK FDLTDMP 
USETEXT CCTTEXT 
          PROC FDLTDMP; 
# * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
*         PROC - FDLTDMP
* 
*         DOES - DUMPS FDLT 
* 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * # 
          BEGIN 
*CALL FDLT
*CALL TABLETYP
  
          XREF
              BEGIN 
              PROC CBLIST;
              FUNC DECR C(10);
              PROC TMRECL;
              PROC TMREOP;
              FUNC VIRTUAL; 
              END 
  
          ITEM CTEMP C(10); 
          ITEM INDEX I; 
          ITEM ITEMNBR C(20) = " ENTRY NO.          ";
          ITEM I1    I; 
          ITEM OPS I; 
          ITEM PLCHAR I;
          ITEM PRINTLINE C(100);
          ITEM SPACES    C(100)= "   "; 
          ITEM USEIND I;
  
          ARRAY LISTINFO [1:NBRUSEOPS] S(4);
              BEGIN 
              ITEM ENTVAL  C(0,0,20)
                  =[
                  "PROG EQUIVALENCE    ", 
                  "AREA DECLARATION    ", 
                  "RELATION DECL       ", 
                  ];
              ITEM AREAOP  C(2,0,20)
                  =[
                  "CLOSE               ", 
                  "DELETE              ", 
                  "OPEN", 
                  "READ                ", 
                  "REWRITE             ", 
                  "START               ", 
                  "WRITE               ", 
                  ];
              END 
          CONTROL EJECT;
          FUNC BLFILL (PARAM, LEN) C(30); 
 #     FILL ZERO BYTE TERMINATORS WITH BLANKS # 
          BEGIN 
          ITEM PARAM C(30); 
          ITEM ZPAR C(30);
          ITEM LEN I; 
          ITEM IBL  I;
          ZPAR = PARAM; 
          FOR IBL = LEN - 1 STEP -1 
          WHILE C<IBL,1> ZPAR EQ O"00"
          DO
              C<IBL,1>ZPAR = " "; 
          BLFILL = ZPAR;
          RETURN; 
          END 
          CONTROL EJECT;
 #     MAIN PROCEDURE OF FDLTDMP #
          TMREOP (TABLETYPE "FDLT$"); 
          CBLIST (4, " FDLT DUMP ", 11);  #HEADER#
          CBLIST (2, " ", 1);   #BLANK SUBTITLE#
          CBLIST (3);   #EJECT PAGE#
          FOR INDEX = 1 STEP 1 UNTIL CCTFDLTLEN DO
              BEGIN 
              CTEMP = DECR (INDEX); 
              C<11,3>ITEMNBR = C<7,3>CTEMP; 
              I1 = VIRTUAL(TABLETYPE "FDLT$",  INDEX);
              CBLIST (2,ITEMNBR, 15);   #PRINT ENTRY NO#
              PRINTLINE = SPACES; 
              C<2,20>PRINTLINE = ENTVAL [FDLTENTTYPE [I1]]; 
              CBLIST(1, PRINTLINE,30);
              PRINTLINE = SPACES; 
              IF FDLTENTTYPE [I1] EQ S"PROGEQUIV" 
              THEN
                  BEGIN 
                  C<2,13>PRINTLINE = "COBOL NAME =";
                  C<15,30>PRINTLINE = FDLTPROGNAME [I1];
                  CBLIST(1, PRINTLINE, 50); 
                  PRINTLINE = SPACES; 
                  C<2,16>PRINTLINE = "INTERNAL NAME = ";
                  C<18,7>PRINTLINE = BLFILL(FDLTINTNAME [I1], 7); 
                  CBLIST(1, PRINTLINE, 40); 
                  PRINTLINE = SPACES; 
              IF FDLTSTATICF [I1] 
              THEN
                  CBLIST (1, "  STATIC ",9);
                  IF FDLTCOMPILED [I1]
                  THEN
                      CBLIST(1, "  COMPILED ", 11); 
                  IF FDLTLIBNAME [I1] NQ O"00000000000000"
                  THEN
                      BEGIN 
                      C<2,15>PRINTLINE = "LIBRARY NAME = "; 
                      C<17,7>PRINTLINE=BLFILL(FDLTLIBNAME [I1],7);
                      CBLIST(1, PRINTLINE, 30); 
                      PRINTLINE = SPACES; 
                      END 
                  END 
              ELSE
                  BEGIN 
                  IF FDLTENTTYPE [I1] EQ S"AREADECL"
                  THEN
                      BEGIN 
                      C<2,12>PRINTLINE = "AREA NAME = ";
                      C<14,30>PRINTLINE = BLFILL (FDLTAREANAME [I1],30);
                      CBLIST(1,PRINTLINE,50); 
                      PRINTLINE = SPACES; 
                      C<2,5>PRINTLINE = "USES ";
                      PLCHAR = 7; 
                      B<0,NBRUSEOPS>OPS = B<0,NBRUSEOPS>FDLTAREAOP [I1];
                      FOR USEIND = 1 STEP 1 UNTIL NBRUSEOPS DO
                          BEGIN 
                          IF B<USEIND,1>OPS NQ 0
                          THEN
                              BEGIN 
                              C<PLCHAR, 10>PRINTLINE = AREAOP [USEIND]; 
                              PLCHAR = PLCHAR + 11; 
                              END 
                          END 
                      END 
                  ELSE
                      BEGIN 
                      C<2,16>PRINTLINE = "RELATION NAME = ";
                      C<18,30>PRINTLINE = BLFILL (FDLTRELNAME [I1],30); 
                      END 
                  CBLIST (1, PRINTLINE,100);
                  PRINTLINE = SPACES; 
                  END 
              END 
          CBLIST(2, " END OF TABLE", 20); 
          TMRECL(TABLETYPE"FDLT$"); 
          RETURN; 
          END 
          TERM; 
