*DECK LATDMP
USETEXT CCTTEXT 
USETEXT DNTEXT
          PROC LATDMP (STARTNUM, ENDNUM, HEADER, ASSOCINFO);
          BEGIN 
  
  #** PURPOSE                                                          #
  
  #       THIS PROCEDURE DUMPS THE LAT IN FORMATTED FORM FROM          #
  #       ORDINAL STARTNUM TO ORDINAL ENDNUM.                          #
  
  #       IF ENDNUM IS OMITTED OR ZERO THE DUMP CONTINUES FROM         #
  #       STARTNUM TO THE END OF THE TABLE. IF BOTH PARAMETERS ARE     #
  #       ZERO THE ENTIRE TABLE IS DUMPED.                             #
  
  #       THE HEADER PARAMETER CONTROLS THE HEADER. IF THE PARAMETER   #
  #       IS NONZERO THE HEADER IS PRINTED.                            #
  
  #       THE ASSOCINFO PARAMETER CONTROLS THE OUTPUT OF EXTRA         #
  #       INFORMATION ASSOCIATED WITH LAT ENTRIES. THE FOLLOWING       #
  #       ARE THE CURRENTLY IMPLEMENTED OPTIONS:                       #
  #                                                                    #
  #       ASSOCINFO          INTERPRETATION                            #
  #       ---------          --------------                            #
  #                                                                    #
  #       0                  NO ADDITIONAL INFORMATION                 #
  #       1                  DNAT ENTRY DUMPED FOR EACH LAT            #
  #       2                  CONVERTED POOLED RESULT DUMPED            #
  #       3                  COMBINATION OF 1 AND 2                    #
  
          ITEM   STARTNUM    I; 
          ITEM   ENDNUM      I; 
          ITEM   HEADER      I; 
          ITEM   ASSOCINFO   I; 
          $BEGIN
  
  #** SUBROUTINES CALLED                                               #
  
          XREF PROC CBLIST; 
          XREF PROC DNATDMP;
          XREF PROC POOLDMP;
          XREF FUNC DEC C(10);
          XREF FUNC OCT C(40);
          XREF PROC TMRECL; 
          XREF PROC TMREOP; 
          XREF FUNC VIRTUAL;
  
          DEF    CALL        # #; 
          DEF    LT          #LS#;
          DEF    GT          #GR#;
          DEF    GE          #GQ#;
          DEF    LE          #LQ#;
          DEF    NE          #NQ#;
  
          DEF    SSF         #1#; 
          DEF    DSF         #2#; 
          DEF    EJECTF      #3#; 
          DEF    TITLEF      #4#; 
          DEF    STITLEF     #5#; 
          DEF    OPENF       #8#; 
          DEF    CLOSEF      #9#; 
CONTROL EJECT;
  
#** INCLUSION OF COMPILER COMMON TABLES                                #
  
*CALL TABLETYP
*CALL DNATVALS
*CALL LAT1
CONTROL EJECT;
  
#      WORKING STORAGE DECLARATION AND INITIALIZATION                  #
  
          ITEM   STARTORD    I; 
          ITEM   ENDORD      I; 
          ITEM   LATINDEX    I; 
          ITEM   REALINDEX   I; 
          ITEM   POOLFLAG    B; 
          ITEM   TEMPDNAT    I; 
          ITEM   TEMPMAJMSEC I; 
          ITEM   TEMPOFFSET  I; 
          ITEM   TEMP        I; 
  
#      DECLARATION OF THE PRINT LINE SKELETON                          #
  
          ARRAY [0] S(13);
          BEGIN 
            ITEM PRINTGROUP  C(0,0,132);
            ITEM PRINTINDEX  C(0,0,6);
            ITEM PRINTTYPE   C(1,0,10); 
            ITEM PRINTDNAT   C(2,0,5);
            ITEM PRINTPLT    C(3,0,5);
            ITEM PRINTALL    C(4,0,1);
            ITEM PRINTIMMED  C(4,30,1); 
            ITEM PRINTROUND  C(5,0,1);
            ITEM PRINTHILO   C(5,30,1); 
            ITEM PRINTSPACES C(6,0,1);
            ITEM PRINTVCODE  C(7,0,5);
            ITEM PRINTOCTAL  C(8,0,20); 
            ITEM PRINTVALUE  C(10,30,20); 
          END 
  
#      DECLARATION OF DUMP HEADING LINE                                #
  
          ARRAY HEAD [0] S(12); 
          BEGIN 
            ITEM HEAD0       C(0,0,10) = ["INDEX     "];
            ITEM HEAD1       C(1,0,10) = ["DIVISION  "];
            ITEM HEAD2       C(2,0,10) = ["DNAT      "];
            ITEM HEAD3       C(3,0,10) = ["PLT       "];
            ITEM HEAD4       C(4,0,10) = ["ALL  IMM  "];
            ITEM HEAD5       C(5,0,10) = ["RND  HILO "];
            ITEM HEAD6       C(6,0,10) = ["SPACES    "];
            ITEM HEAD7       C(7,0,10) = ["VCODE     "];
            ITEM HEAD8       C(8,0,10) = ["OCTAL     "];
            ITEM HEAD9       C(9,0,10) = ["          "];
            ITEM HEAD10      C(10,0,10) = ["     LITER"]; 
            ITEM HEAD11      C(11,0,10) = ["AL VALUE  "]; 
          END 
  
CONTROL EJECT;
  
#      INITIALIZATION AND SETUP OF LISTING TITLE                       #
  
          TMREOP (TABLETYPE "LAT$"  );   #RE-OPEN THA TABLE IF CLOSED#
          TMREOP (TABLETYPE "DNAT$" );   #RE-OPEN THA TABLE IF CLOSED#
          TMREOP (TABLETYPE "LPOOL$");
          IF HEADER NE 0  THEN
            BEGIN 
              CALL CBLIST (OPENF, "LATDMP", 6); 
              CALL CBLIST (TITLEF, "L A T   D U M P", 15);
              IF ASSOCINFO EQ 0  THEN 
                BEGIN 
                  HEAD10 [0] = "          ";
                  HEAD11 [0] = "          ";
                END 
              ELSE
                BEGIN 
                  HEAD10 [0] = "     LITER";
                  HEAD11 [0] = "AL VALUE  ";
                END 
              CALL CBLIST (STITLEF, HEAD, 120); 
              CALL CBLIST (EJECTF); 
            END 
  
#      SETUP OF STARTING AND ENDING ORDINALS                           #
  
          STARTORD = STARTNUM;
          IF STARTORD LE 0  THEN
            STARTORD = 1; 
  
          ENDORD = ENDNUM;
          IF ENDORD EQ 0  OR
             ENDORD GT CCTLATLEN  THEN
            ENDORD = CCTLATLEN; 
  
#      TEST FOR SPECIAL TERMINATION CONDITIONS                         #
  
          IF ENDORD LT STARTORD  THEN 
            ENDORD = STARTORD;
  
          IF CCTLATLEN LE 0  THEN 
            BEGIN 
              CALL CBLIST (SSF, "*** NO LAT ENTRIES ***", 22);
              GOTO FILECLOSE; 
            END 
  
CONTROL EJECT;
  
#      MAIN PRINT LOOP THROUGH THE LAT                                 #
  
          FOR LATINDEX = STARTORD STEP 1 UNTIL ENDORD 
            DO BEGIN
  
#      CALCULATE VIRTUALIZED LAT ENTRY INDEX                           #
  
          REALINDEX = VIRTUAL (TABLETYPE "LAT$", LATINDEX); 
  
#      CLEAR OUT THE PRINT SKELETON                                    #
  
          PRINTGROUP [0] = " "; 
  
#      PUT LAT INDEX INTO PRINT SKELETON                               #
  
          PRINTINDEX [0] = DEC (LATINDEX);
  
#      PUT DIVISION INDICATOR INTO PRINT SKELETON                      #
  
          IF LATINDEX LE CCTLATDDLNGT  THEN 
            PRINTTYPE [0] = "DATA      "; 
          ELSE
            PRINTTYPE [0] = "PROCEDURE "; 
          TEMPDNAT = L$DNAT [REALINDEX];
  
#      PUT POINTER TO CORRESPONDING DNAT ENTRY INTO PRINT SKELETON     #
  
          PRINTDNAT [0] = DEC (TEMPDNAT); 
          TEMP = L$PLT [REALINDEX]; 
  
#      PUT POINTER TO CORRESPONDING PLT ENTRY INTO PRINT SKELETON      #
  
          PRINTPLT [0] = DEC (TEMP);
  
#      PUT VALUES OF LAT BITS INTO PRINT SKELETON - 27 IS "0"          #
  
          PRINTALL [0] = 27 + L$ALL [REALINDEX];
          PRINTIMMED [0] = 27 + L$IMMEDIATE [REALINDEX];
          PRINTROUND [0] = 27 + L$ROUNDED [REALINDEX];
          PRINTHILO [0] = 27 + L$HILO [REALINDEX];
          PRINTSPACES [0] = 27 + L$SPACES [REALINDEX];
          TEMP = L$VCODE [REALINDEX]; 
  
#      PUT VALUE OF VERB CODE INTO PRINT SKELETON                      #
  
          PRINTVCODE [0] = DEC (TEMP);
          TEMP = L$GROUP [REALINDEX]; 
  
#      PUT OCTAL VALUE OF LAT ENTRY INTO PRINT SKELETON                #
  
          PRINTOCTAL [0] = OCT (TEMP, 0, 20); 
CONTROL EJECT;
  
#      PRINT VALUE OF LITERAL                                          #
#      NOTE- CURRENTLY ONLY PROCEDURE DIVISION LITERALS ARE PRINTED    #
  
          POOLFLAG = FALSE; 
          IF ASSOCINFO NE 0 AND LATINDEX GT CCTLATDDLNGT  THEN
            BEGIN 
              TEMP = VIRTUAL (TABLETYPE "DNAT$", TEMPDNAT); 
              TEMPMAJMSEC = DN$MAJMSEC [TEMP];
              TEMPOFFSET = DN$LONGOFF [TEMP]; 
              IF TEMPMAJMSEC EQ UNLITMSEC  THEN 
                PRINTVALUE [0] = OCT (TEMPOFFSET, 0, 20); 
              ELSE IF TEMPMAJMSEC EQ LITMSEC  THEN
                BEGIN 
                  TEMP = DN$ITMLEN [TEMP];
                  POOLFLAG = TRUE;
                END 
            END 
  
#      OUTPUT THE COMPLETED PRINT SKELETON                             #
  
          CALL CBLIST (DSF, PRINTGROUP [0], 130); 
  
#      PRINT THE CORRESPONDING DNAT ENTRY                              #
  
          IF ASSOCINFO EQ 1 OR ASSOCINFO EQ 3  THEN 
            CALL DNATDMP (TEMPDNAT, TEMPDNAT, 0, 0);
  
#      PRINT OUT THE CONVERTED LITERAL USING POOLDMP                   #
  
          IF ASSOCINFO GE 2 AND POOLFLAG  THEN
            CALL POOLDMP (TEMPOFFSET, TEMPOFFSET + TEMP, 0);
  
          END    # FOR LATINDEX ... # 
  
#      FINAL TERMINATION CLEANUP                                       #
  
 FILECLOSE: 
          IF HEADER NE 0  THEN
            CALL CBLIST (CLOSEF, "LATDMP", 6);
          TMRECL (TABLETYPE "LAT$"  );   #RE-CLOSE THE TABLE IF NEEDED# 
          TMRECL (TABLETYPE "DNAT$" );   #RE-CLOSE THE TABLE IF NEEDED# 
          TMRECL (TABLETYPE "LPOOL$");
  
          $END
          END    # LATDMP # 
          TERM
