*DECK BSTOP 
USETEXT TAREATB 
USETEXT TCLFN 
USETEXT TCRMDEF 
USETEXT TFIT
USETEXT TNUMOPT 
      PROC  BSTOP;
#----------------------------------------------------------------------#
#                                                                      #
#     PROCEDURE TO PROCESS THE STOP/END DIRECTIVE.                     #
#     THE LOCAL QU SCRATCH FILES ARE RETURNED.                         #
#     IF THERE IS A SU-SCHEMA FILE IT IS ALSO RETURNED.                #
#                                                                      #
#----------------------------------------------------------------------#
  
      BEGIN 
      XREF PROC   ABORTUSE; 
      XREF PROC   BOMB; 
      XREF PROC   CLOSEM; 
      XREF PROC   CLOSETL;
      XREF PROC   DB$CLS;          # CDCS CLOSE FILE                   #
      XREF PROC   DB$END;          # CDCS TERMINATE                    #
      XREF PROC   DIAG; 
      XREF PROC   RETURNM;
      XREF PROC   REWINDM;
      XREF PROC   WRITE;
  
      XREF ITEM   RA0;
      XREF ITEM   ABORTED   B;
      XREF ITEM   AREATBLPTR; 
      XREF ITEM   CDCSCAT B;       # TRUE IF CDCS CATALOG MODE         #005900
      XREF ITEM   CDCSDBM B;       # TRUE IF IN CDCS DATA BASE MODE    #
      XREF ITEM   CDCSUP B;        # === TEMP === TRUE IF USING CDCS   #
      XREF ITEM DBP$NAM C(7);      # NAME OF DBP IN PROGRESS           #
      XREF ITEM DEFCAT       B;    # TRUE IF DEFAULT CATALOG EXISTS    #
      XREF ITEM DIAGABT B;         # TRUE IF ABORTED ON FATAL DIAG     #
      XREF ITEM FATALCT I;         # COUNT OF FATAL DIAGS ISSUED       #
      XREF ITEM   INDEX I;         # INDEX FOR REQUESTED 5,0 ACTIVITY  #
                                   #   0 - ABORT CURRENT USE           #
                                   #   1 - PROCESS A USE               #
                                   #   2 - PROCESS AN END/STOP/ABORT   #
  
      XREF ITEM   QUESF;           # CMM ERR WORD IF CMM REQ ERROR     #
      XREF ITEM   VERSBSCHPTR I;   # PTR TO VERSION SUBSCH TABLE       #006100
      XREF BASED ARRAY  SCHEMAFIT;; 
      ITEM DUMMY1 I;               # SCRATCH VARIABLE                  #
      ITEM DUMRET;
      DEF  $ZZZZZIN$  #O"32323232321116000000"#;
      DEF  $ZZZZZOU$  #O"32323232321725000000"#;
      DEF  $ZZZZZQA$  #O"32323232322101000000"#;
      DEF  $ZZZZZQB$  #O"32323232322102000000"#;
      DEF  $ZZZZZQC$  #O"32323232322103000000"#;
      DEF  $ZZZZZQD$  #O"32323232322104000000"#;
      DEF  $ZZZZZQE$  #O"32323232322105000000"#;
      DEF  $ZZZZZQF$  #O"32323232322106000000"#;
      DEF  $ZZZZZQG$  #O"32323232322107000000"#;
      DEF  $ZZZZZQ2$  #O"32323232322135000000"#;
      DEF  $ZZZZZQ3$  #O"32323232322136000000"#;
      DEF  $ZZZZZQ4$  #O"32323232322137000000"#;
      DEF  $ZZZZZQ5$  #O"32323232322140000000"#;
      DEF  $ZZZZZQ6$  #O"32323232322141000000"#;
      DEF  $ZZZZZQ7$  #O"32323232322142000000"#;
      DEF  $ZZZZZQ8$  #O"32323232322143000000"#;
  
      IF DBP$NAM NQ " "            # IF A DBP IN PROGRESS WHEN ABORTED #
      THEN
        BEGIN 
        DIAG (1014, DBP$NAM);      # IDENTIFY THE DBP IN PROGRESS      #
        END 
  
      IF ABORTED AND QUESF EQ 0 THEN  # IF ABORTED BUT NOT DUE TO CMM  #
                                      # MEM REQ PROCESSING             #
        BEGIN 
        IF DIAGABT                 # IF ABORTED ON FATAL DIAGNOSTIC    #
        THEN
          BEGIN 
          DIAG(305);               # QU ABORT DUE TO FATAL DIAG        #
          END 
        ELSE
          BEGIN 
          PRINTOSERR;              # PRINT O/S ERROR DIAGNOSTIC        #
          END 
        END 
  
      IF FATALCT GR 0              # IF FATAL DIAGNOSTICS ENCOUNTERED  #
      THEN
        BEGIN 
        DIAG(1015,FATALCT);        # INFORM USER OF NUMBER OF FATALS   #
        END 
      IF (NOT CDCSCAT)                                                  006300
        AND PFCATAL                                                     006400
      THEN                         # IF CRM CATALOG MODE               #006500
        BEGIN 
        RETURNM (CATAFIT, RA0);    # RETURN VERSION-ATTACHED CATALOG   #
        END 
  
      IF DEFCAT                    # IF DEFAULT CATALOG WAS INITIALIZED#
      THEN
        BEGIN 
        REWINDM($ZZZZZQ2$, RA0);
        END 
  
      IF AREATBLPTR NQ 0
      THEN                         # IF SUBSCHEMA STILL PRESENT        #
        BEGIN 
        IF CDCSDBM
          AND NOT ABORTED                                               006700
        THEN                       # IF IN CDCS DATA BASE MODE         #
          BEGIN 
          P<AREA$TABLE> = AREATBLPTR;  # CLOSE ALL AREAS               #
          FOR DUMMY1 = 0
            WHILE AT$FORWARD[0] NQ 0
          DO
            BEGIN 
            P<AREA$TABLE> = AT$FORWARD[0];  # POSITION TO NEXT AREA    #
            P<FIT> = LOC (AT$AFITPOS);
            IF FITOC EQ OC$OPEN 
            THEN                   # IF STILL OPEN                     #
              BEGIN 
IF CDCSUP THEN
                                   # ISSUE CDCS CLOSE OF AREA FILE     #
              DB$CLS (FIT, AT$AREAORD[0]);
              END 
            END 
          END 
        END 
  
      IF CDCSDBM                                                        007100
        OR CDCSCAT                                                      007200
      THEN                                                              007300
        BEGIN                                                           007400
IF CDCSUP THEN                                                          007500
        IF NOT ABORTED             # IF NOT FATAL ERROR                #
        THEN
          BEGIN 
          DB$END;                  # ISSUE TERMINATE TO CDCS           #
          END 
        CDCSCAT = FALSE;           # TURN OFF CDCS CATALOG MODE        #007700
        CDCSDBM = FALSE;           # TURN OFF CDCS DATABASE MODE       #007800
        END                                                             007900
                                                                        008000
      IF AREATBLPTR LOR VERSBSCHPTR NQ 0                                008100
      THEN                         # SUBSCHEMA IS PRESENT              #008200
        BEGIN                                                           008300
        RETURNM (SCHEMAFIT, RA0);  # RETURN SUBSCHEMA                  #008400
        END                                                             008500
                                                                        008600
      IF DEFCAT                    # IF DEFAULT CATALOG WAS INITIALIZED#
      THEN
        BEGIN 
      WRITE (" **CAUTION**", 12, DUMRET); 
      WRITE(" DEFAULT CATALOG REMAINS AS LOCAL FILE ZZZZZQ2",46,DUMRET);
        END 
  
      CLOSETL;                     # CLOSE THE ZZZZZOU  OR THE OUTPUT  #
  
  
#  RETURN ALL QU/BLP SCRATCH FILES TO RELEASE FNT SPACE                #
  
      RETURNM($ZZZZZIN$, $ZZZZZOU$, RA0);  # QU INTERACTIVE INPUT/OUTPT#
      RETURNM($ZZZZZQ3$, $ZZZZZQ4$, $ZZZZZQ5$, RA0);
      RETURNM($ZZZZZQ6$, $ZZZZZQ7$, $ZZZZZQ8$, RA0);
      RETURNM($ZZZZZQA$, $ZZZZZQB$, $ZZZZZQC$, RA0);
      RETURNM($ZZZZZQD$, $ZZZZZQE$, $ZZZZZQF$, $ZZZZZQG$, RA0); 
  
      IF ABORTED  THEN             # WAS THE JOB ABORTED               #
        BEGIN 
        BOMB;                      # YES, SET PREVIOUS ERROR CONDITION #
        END 
      ELSE
        BEGIN 
        STOP;                      # NORMAL TERMINATION                #
        END 
 CONTROL EJECT; 
#----------------------------------------------------------------------#
#                                                                      #
#     THIS IS THE PLACE TO DO ANY CLEAN UP FOR THE OVERLAY             #
#      ABORT HAS OCCURRED - NO ASSURANCE OF HOW FAR THE OVERLAY WAS IN #
#      EXECUTION                                                       #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC AUTOPSY;
      PROC      AUTOPSY;
      BEGIN 
      IF INDEX EQ 1 THEN           # ABORTED DURING -USE- PROCESSING   #
        BEGIN 
        ABORTUSE;                  # TRY TO RELEASE CORE FROM -USE-    #
        END 
  
      RETURN; 
      END 
 CONTROL EJECT; 
CONTROL IFEQ OS$NAME,SCOPE; 
      PROC PRINTOSERR;
#                                      #
#        P R I N T O S E R R           #
#                                      #
# THIS PROC PRINTS OUT AN APPROPIATE DIAGNOSTIC IF THIS RUN WAS#
# ABORTED BY THE OPERATING SYSTEM # 
      BEGIN 
      XREF ARRAY ABTADDR; 
        BEGIN 
        ITEM ERRORFLAG I(3,48,12);
        END 
      SWITCH ERRTYPE ET0, ET1, ET2, ET3, ET4, ET5, ET6, ET7, ET10,
                     ET11, ET12, ET13, ET14, ET15, ET16, ET17, ET20,
                     ET21;
  
      IF ERRORFLAG[0] EQ O"40"
      THEN
        BEGIN 
        GOTO ET40;                 # PROCESS TERMINAL INTERRUPT        #
        END 
  
      IF ERRORFLAG[0] GR O"21" THEN 
        BEGIN   # UNKNOWN ERRORFLAG VALUE - PRINT GENERAL MESSAGE # 
         DIAG (286, ERRORFLAG[0]);
        RETURN; 
        END 
      ELSE
        BEGIN   # ERRORFLAG VALUE WITHIN RANGE #
        GOTO ERRTYPE [ERRORFLAG[0]];
ET0:    # NORMAL EXIT # 
        RETURN; 
ET1:    # TIME LIMIT #
         DIAG (266);
        RETURN; 
ET2:    # MODE ERROR #
         DIAG (267);
        RETURN; 
ET3:    # PP ABORT #
         DIAG (268);
        RETURN; 
ET4:    # CP ABORT #
         DIAG (269);
        RETURN; 
ET5:    # PP CALL ERROR # 
         DIAG (270);
        RETURN; 
ET6:    # OPERATOR DROP # 
         DIAG (331);
        RETURN; 
ET7:    # OPERATOR KILL # 
         DIAG (272);
        RETURN; 
ET10:   # OPERATOR RERUN #
         DIAG (273);
        RETURN; 
ET11:   # ABORT FROM CP # 
         DIAG (269);
        RETURN; 
ET12:   # ECS PARITY ERROR #
         DIAG (274);
        RETURN; 
ET13:   # NULL #
         DIAG (286, ERRORFLAG[0]);
        RETURN; 
ET14:   # NULL #
         DIAG (286, ERRORFLAG[0]);
        RETURN; 
ET15:   # AUTO RECALL MISSING # 
         DIAG (275);
        RETURN; 
ET16:   # HUNG IN AUTO RECALL # 
         DIAG (276);
        RETURN; 
ET17:   # MASS STORAGE LIMIT #
         DIAG (277);
        RETURN; 
ET20:   # XXX NOT IN LIB #
         DIAG (270);
        RETURN; 
ET21:   # I/O TIME LIMIT #
         DIAG (278);
        RETURN; 
ET40:   #  TERMINAL INTERRUPT  #
         DIAG (909);
         RETURN;
  
        END 
      END  # PRINTOSERR # 
CONTROL ENDIF;
      CONTROL EJECT;
CONTROL IFEQ OS$NAME,NOS; 
      PROC PRINTOSERR;
#                                      #
#        P R I N T O S E R R           #
#                                      #
# THIS PROC PRINTS OUT AN APPROPIATE DIAGNOSTIC IF THIS RUN WAS # 
# ABORTED BY THE -NOS- OPERATING SYSTEM # 
      BEGIN 
      XREF ARRAY ABTADDR; 
        BEGIN 
         ITEM ERRORFLAG I(7,48,12); 
        END 
  
      XREF ITEM QUMAP I;           # SWITCH SUBSCRIPT FOR QU DIAG      #
  
      SWITCH ERRTYPE ET0, ET1, ET2, ET3, ET4, ET5, ET6, ET7, ET10,
               ET11,ET12,ET13,ET14,ET15,ET16,ET17;
  
      GOTO ERRTYPE[QUMAP];
  
ET0:                               # ERROR UNKNOWN TO QU, PASS TO USER #
      DIAG( 286, ERRORFLAG ); 
      RETURN; 
  
ET1:                               # EP TIME LIMIT    ( TLET )         #
      DIAG( 266 );
      RETURN; 
ET2:                               # MODE ERROR       ( ARET )         #
      DIAG( 267 );
      RETURN; 
ET3:                               # PP ABORT         ( PPET )         #
      DIAG( 268 );
      RETURN; 
ET4:                               # CP ABORT         ( CPET )         #
      DIAG( 269 );
      RETURN; 
ET5:                               # PP CALL ERROR    ( PCET )         #
      DIAG( 270 );
      RETURN; 
ET6:                               # OPERATOR DROP    ( ODET )         #
      DIAG( 271 );
      RETURN; 
ET7:                               # OPERATOR KILL    ( OKET )         #
      DIAG( 272 );
      RETURN; 
ET10:                              # OPERATOR RERUN   ( RRET )         #
      DIAG( 273 );
      RETURN; 
ET11:                              # ECS PARITY ERROR ( ECET )         #
      DIAG( 274 );
      RETURN; 
ET12:                              # TRACK LIMIT      ( TKET )         #
      DIAG( 277 );
      RETURN; 
ET13:                              # I/O ERROR        ( SRET )         #
      DIAG( 278 );
      RETURN; 
ET14:                              # PROGRAM STOP     ( PSET )         #
      DIAG( 279 );
      RETURN; 
ET15:                              # FILE LIMIT       ( FLET )         #
      DIAG( 280 );
      RETURN; 
ET16:                              # SYSTEM ABORT     ( SYET )         #
      DIAG( 281 );
      RETURN; 
ET17:                              # TERMINAL INTERRUPT  ( TIET )      #
      DIAG( 909 );
      RETURN; 
  
      END   # PRINTOSERR #
CONTROL ENDIF;
      END 
      TERM
