*DECK TERMPROG
USETEXT CCTTEXT 
          PROC TERMPROG;
# * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * 
* 
*         PROC TERMPROG 
* 
*         DOES - TERMINATES A PROGRAM BY WRITING ERROR SUMMARY, ETC.
*             IF STACKED COMPILES, SAVES FDL TABLE
*             IF VERY LAST JOB, WRAPS IT ALL UP 
* 
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * # 
  
          BEGIN 
          CONTROL FTNCALL;
  
*CALL ASSEMOP 
*CALL DIAGLVL 
*CALL FDLT
*CALL SYSFET
*CALL TABLEDF 
*CALL TABLETYP
  
          XREF
              BEGIN 
              ITEM CC$ET I; 
              ITEM CUMT$ERR;
              ITEM CUMW$ERR;
              ITEM CUMF$ERR;
              ITEM CUMC$ERR;
              ITEM ECSUSED; 
              ITEM FIRSTIME;
              ITEM PDCHWR B;
  
             ITEM LIT$PD C(10); 
              ITEM TOTF$ERR I;
              ITEM TOTW$ERR I;
              ITEM TOTT$ERR I;
              ITEM TOTC$ERR I;
              PROC CMI$FRV; 
              PROC PUTMSG;
              PROC ABTME; 
              FUNC CMI$ALV; 
              PROC GETWA; 
              ITEM BLKGID I;
              FUNC CMM$GSS; 
              FUNC CPTIME;
              FUNC DECR C(10);
              PROC PUTUMSG; 
              PROC PUTSQ; 
              PROC RETRN; 
              FUNC OCT C(40); 
              PROC TIMEOUT; 
              PROC TREPORT; 
              END 
  
          ITEM   ERR$MSG1 C(30) = "XXX T/W AND YYY F ERRORS IN NA"; 
          ITEM   TRMNTR1 C(10) = "ME       "; 
          ITEM   ZEROS1W  I = 0;   #TERMINATE MESSAGE#
          ITEM   ERR$MSG2 C(20) = "ZZ C ERRORS IN NAME "; 
          ITEM   TRMNTR2 C(10) = "         "; 
          ITEM   ZEROS2W  I = 0;
          ITEM   ABT$MSG1 C(15) = "ABORT REQUESTED";
          ITEM   ZEROS1X  I = 0;
          ITEM TIM$MSG C(40) = "XXXXXXB CM, YYYY.YYY CPS, XXXXXXB ECS"; 
          ITEM ZEROS3X I = 0;  # STOPPER FOR MSG #
          BASED ARRAY CMMSTATS [0:0] S(6);
              ITEM CMMMAXFL I(1,0,60);
          ITEM  I I;
          ITEM  J I;
          ITEM  TEMP I; 
  
          IF NOT CCT1STCOMPIL 
          AND TTABFILENBR [TABLETYPE"FDLT$"] NQ 0 
          AND TTABASGD [TABLETYPE "FDLT$"]
          THEN
 #     THE FDLT WAS BROKEN UP AND WRITTEN ON A FILE - PUT IT BACK  #
              BEGIN 
              CMI$FRV (TTABBASE [TABLETYPE "FDLT$"]);  # FREE CURR SPC# 
              I = TTABHIGHWA [TABLETYPE "FDLT$"] - 1;   # SIZE# 
              J = TTABBASE [TABLETYPE "FDLT$"];   # BASE ADDR#
              TEMP = CMI$ALV (I, 1, 0, BLKGID, J, 0);  #ALLOC SPACE#
              TEMP = P<FDLT>; 
              J = TTABFILENBR [TABLETYPE "FDLT$"];
              GETWA(SCRFADDR[J],TEMP,I,TTABBASEWA[TABLETYPE"FDLT$"] 
                      +1);  #READ ENTIRE TABLE BACK IN# 
              END 
  
          IF  TOTF$ERR + TOTW$ERR + TOTT$ERR NQ 0 THEN
              BEGIN 
              I = TOTW$ERR + TOTT$ERR;
              J = DECR(I);
              I = DECR(TOTF$ERR); 
              C<0,3>ERR$MSG1 = C<7,3>J; 
              C<12,3>ERR$MSG1 = C<7,3>I;
              C<28,7>ERR$MSG1 = CCTPROGRAMID; 
              B<36,12>TRMNTR1 = 0;
              PUTUMSG(ERR$MSG1);   #PUT IN USER DAYFILE#
              END 
  
          IF  TOTC$ERR NQ 0 THEN
              BEGIN 
              I = DECR(TOTC$ERR); 
              C<0,2>ERR$MSG2 = C<8,2>I; 
              C<15,7>ERR$MSG2 = CCTPROGRAMID; 
              B<12,12>TRMNTR2 = 0;
              PUTMSG(ERR$MSG2);    #PUT IN ALL DAYFILES#
              END 
          CUMT$ERR = CUMT$ERR + TOTT$ERR; 
          TOTT$ERR = 0; 
  
          CUMW$ERR = CUMW$ERR + TOTW$ERR; 
          TOTW$ERR = 0; 
  
          CUMF$ERR = CUMF$ERR + TOTF$ERR; 
          TOTF$ERR = 0; 
  
          CUMC$ERR = CUMC$ERR + TOTC$ERR; 
          TOTC$ERR = 0; 
  
 CONTROL IFEQ CB5$TIMR,"NO";
 $BEGIN 
 CONTROL FI;
          IF CCTTIMRPT
          THEN
              BEGIN 
              TIMEOUT(19);
              TREPORT;
              END 
 CONTROL IFEQ CB5$TIMR,"NO";
 $END 
 CONTROL FI;
          IF NOT CCT1STCOMPIL 
          THEN
              RETURN;   #WE HAVE A STACKED COMPILE - GO DO NEXT # 
  
#      ANY PRE-TERMINATION CLEANUP GOES HERE #
          # RESET PRINT DENSITY TO JOBS CURRENT VALUE # 
          IF PDCHWR 
          THEN
              PUTSQ(OUTFET, LOC(LIT$PD), 1); # RESET TO JOBS PD # 
          PUTSQ(OUTFET,0,0);        #FLUSH BUFFER#
          RETRN(OUTFET);
          $BEGIN
              IF CCTCHKOUT[0] NQ 0 THEN 
                  RETRN(CHKFET);
          $END
  
 #
        PUT OUT STATISTICS MESSAGE IN DAYFILE 
 #
          J = CPTIME(0);  # GET CP TIME NOW # 
          I = J - FIRSTIME; 
          J = DECR(I);  #CONVERT TO DISPLAY#
          IF C<7,1>J EQ " " 
          THEN
              C<7,1>J = "0";
          IF C<8,1>J EQ " " 
          THEN
              C<8,1>J = "0";
          C<17,3>TIM$MSG = C<7,3>J; 
          C<12,4>TIM$MSG = C<3,4>J; 
          P<CMMSTATS> = CMM$GSS;   # GET CMM STATS #
          J = OCT(CMMMAXFL, 14, 6);  # MAX FIELD LENGTH TO DISPLAY #
          C<0,6>TIM$MSG = C<0,6>J;
          J = OCT(ECSUSED,  14, 6) ;  # CONV ECS USED TO DISP CODE #
          C<26,6>TIM$MSG = C<0,6>J; 
          C<38,2>TIM$MSG = C<0,2>I; # PUT IN ZERO BYTE TERMINATOR # 
          PUTUMSG(TIM$MSG);   #WRITE STATS MSG TO DAYFILE # 
  
  
#                            HERE WE SEE IF ABORT REQUESTED#
  
          IF CC$ET NQ 0 
          THEN
              IF CUMC$ERR NQ 0  THEN
                  BEGIN 
                  PUTMSG(ABT$MSG1); 
                  ABTME;     #GO AND DIE# 
                  END 
              ELSE
                  IF CC$ET LQ FATAL  AND  CUMF$ERR NQ 0  THEN 
                      BEGIN 
                      PUTMSG(ABT$MSG1); 
                      ABTME;
                      END 
                  ELSE
                      IF CC$ET LQ WARNING  AND  CUMW$ERR NQ 0  THEN 
                          BEGIN 
                          PUTMSG(ABT$MSG1); 
                          ABTME;
                          END 
                      ELSE
                          IF CC$ET EQ TRIVIAL  AND  CUMT$ERR NQ 0  THEN 
                              BEGIN 
                              PUTMSG(ABT$MSG1); 
                              ABTME;
                              END 
  
          RETURN;   #DONE#
          END   #END OF TERMPROG# 
          TERM; 
