Retro1.org codex

*DECK HAPFAIL 
USETEXT NIPDEF
USETEXT ACB 
USETEXT ACNB
USETEXT AHEADER 
USETEXT ACNT
USETEXT APPSTAT 
USETEXT AT
USETEXT DISTAIL 
USETEXT DRHDR 
USETEXT DUMPFLG 
USETEXT FLIST 
USETEXT KDIS
USETEXT MSGIDX
USETEXT NWLHEAD 
USETEXT NWLNTRY 
USETEXT OVERLAY 
USETEXT PARAMS
USETEXT PT
USETEXT SUPABH
USETEXT SUPMSG
USETEXT PWL 
USETEXT SWAPIN
      PRGM HAPFAIL;          # PROCESS A FAILED APPLICATION            #
 
 STARTIMS;
 #
*1DC  HAPFAIL 
* 
*     1. PROC NAME           AUTHOR              DATE 
*        HAPFAIL             E. GEE              77/07/27 
* 
*     2. FUNCTIONAL DESCRIPTION.
*        THIS ROUTINE IS RESPONSIBLE FOR PROCESSING A *FAILED-APP*
*        STATUS FROM A NWL OR A *RCUCPGONE* RETURN CODE FROM A SCP CALL.
* 
*     3. METHOD USED. 
*          CHECK IF FAILURE OCCURRED WHILE PROCESSING WORKLIST (APP IS
*            NO LONGER IN SYSTEM) OR OPERATING SYSTEM INFORMED US OF
*            APPLICATION-FAILED STATUS. 
*          IF NIP RECEIVED APPLICATION-FAILED STATUS, CHECK TO SEE IF 
*            ACB OR (NO ACB) SWAPIN ENTRY EXISTS.  IF SO CLEAN UP 
*            APPROPRIATE ENTRIES. 
*          IF ACB EXISTS, CHECK IF IT IS NVF THAT FAILED.  IF SO, ABORT.
*          IF APP STILL HAS CONNECTIONS WITH NETWORK, ISSUE SCP FUNCTION
*            TO CLEAR ALL CONNECTIONS.
*          SEND FAIL/APPL SUP MSG TO NVF IF NECESSARY 
*          CLEAN UP WORKLIST
* 
*     4. ENTRY PARAMETERS.
*          FAILADR           ACB ADDRESS OR NWL ADDRESS 
* 
*     5. EXIT PARAMETERS. 
*          FAILADR           = 0. 
* 
*     6. COMDECKS CALLED AND SYMPL TEXTS USED.
*        ACB     APPSTAT   AT   DRHDR     DUMPFLG 
*        FLIST     MSGIDX    NIPDEF    NWLHEAD
*        NWLNTRY   OPSIZE    OVERLAY   PARAMS 
*        PT        SWAPIN 
*        ACNB     AHEADER     ACNT     KDIS 
*        SUPABH     SUPMSG
* 
*     7. ROUTINES CALLED. 
*          ABORT             ABORT PROGRAM AND DAYFILE MESSAGES 
*          BLINK             LINK MESSAGE ON DATA RING
*          HCSTTP            HOST CONNECTION STATE TABLE PROCESSOR
*          MGETS             ALLOCATE BUFFER
*          MRELS             RELEASE BUFFER SIZE
*          OMSG              ISSUE DAYFILE MESSAGE
*          OSCHAPP           SCHEDULE APPLICATION 
*          OSCCALL           SYSTEM-CONTROL-POINT CALL
*          OVLCALL           LOAD OVERLAY 
*          RDUMP             DUMP NIP-S FIELD LENGTH
*          XRECALL           ISSUE EVENT RECALL 
*          XSAPPDL    OVL    DELINK (NO ACB) SWAPIN ENTRY 
*          XTRACE            TRACES CALLS 
*          XERRMSG    OVL    DAYFILE MESSAGE
* 
*     8. DAYFILE MESSAGES AND OTHER IMPORTANT INFORMATION.
*          NVF FAILURE. 
*          NIP UNABLE TO FIND FAILED APP XXXX   . 
* 
*        THIS PROGRAM IS A PRIMARY OVERLAY LOADED BY SUBROUTINE OVLCALL.
*        WHEN EXECUTION HAS COMPLETED, A JUMP IS MADE TO LOCATION RJMAIN
*        TO RETURN TO THE CALLING PROGRAM.
* 
*        W A R N I N G - THIS PROGRAM CANNOT EXCEED THE PRIMARY 
*CALL OPSIZE
* 
*        THIS OVERLAY IS CALLED BY HHIR AND XSACB.
* 
 #
 STOPIMS; 
# 
                    EXTERNAL VARIABLES
# 
 XREF BEGIN 
   PROC ABORT;               # ABORT PROGRAM AND DAYFILE MESSAGES      #
   PROC BLINK ; 
   PROC HCSTTP ;
   PROC MGETS ; 
   PROC MRELS;               # RELEASE BUFFER SPACE                    #
   PROC OVLCALL;             # LOAD OVERLAY                            #
   PROC OMSG;                # DAYFILE MESSAGE                         #
   PROC OSCCALL;
   PROC OSCHAPP ; 
   PROC RDUMP;               # DUMP NIP-S FIELD LENGTH                 #
   PROC XRECALL;             # ISSUE EVENT RECALL                      #
   PROC XTRACE;              # TRACE CALLS                             #
   LABEL RJMAIN;             # RETURN ADDRESS IN OVLCALL               #
   END
# 
                    INTERNAL VARIABLES
# 
 ITEM BLKADDR ; 
 ITEM I ; 
 ITEM LIMIT ; 
 ITEM FOUND B;               # TRUE = FOUND SWAPIN ENTRY FOR FAILED APP#
 ITEM IDX;
 ITEM OLDACNT;               # ADDR OF ACNT OF FAILED APP              #
 ITEM SECACN;                # APP CON NUM FOR SECONDARY APPLICATION   #
 ITEM HWHERE;                # INDEX TO UNASSIGNED APP NAME IN ALERT   #
 ITEM HAPNO;
 ITEM HINDEX; 
 ITEM FAILANAME C(7); 
 ARRAY LOCALFL S(FLSIZE) ;
   BEGIN
   ITEM WORD U(0,0,WL) ;
   END
  BASED ARRAY HALTNR [1:1] S(1);
    BEGIN 
    ITEM  HALTN C(00,00,07);
    END 
 SWITCH HHN HM,HA,HB,HC,HD,HHE; 
#**********************************************************************#
      BEGIN 
      CONTROL IFEQ DEBUG,1 ;
        XTRACE("HAPFA") ; 
      CONTROL FI; 
# 
      DETERMINE IF APP FAILED WHILE NIP WAS PROCESSING ITS WORKLIST OR
      NIP RECEIVED APPLICATION FAILED STATUS FROM CPU MONITOR 
# 
      P<DRHDRWD> = FAILADR; 
      IF BLKID[0] NQ NWLIDVALUE 
      THEN
        BEGIN                          # APPL FAILS WHILE PROCESSING   #
        ACBADDR = FAILADR ;            # NWL OR PWL                    #
        P<ACB> = ACBADDR ;
        END                            #                               #
      ELSE
        BEGIN                          # NORMAL FAILURE CASE           #
        P<NWLHEADER> = FAILADR ;       # NWL BUFFER                    #
        JOBID = NWLJOBID[0] ;          # JOB ID WORD                   #
        FOUND = FALSE ;                # INITIALIZE                    #
        ACBADDR = 0 ; 
# 
       SEARCH FOR ACB 
# 
       FOR I = 1 STEP 1 WHILE I LQ ATHAN[0] 
                            AND NOT FOUND 
       DO 
         BEGIN                         # SEARCHING                     #
         P<ACB> = ATACBA[I] ; 
         IF ACBJNWD[0] EQ JOBID 
         THEN 
           BEGIN                       # SAME ID WORD                  #
           ACBADDR = P<ACB> ; 
           FOUND = TRUE ; 
           IF ATASBI[I] # SWAPIN IN PROGRESS                           #
             AND ACBSCPCB[0] EQ 0 # WAITING FOR SWAPIN COMPLETION      #
           THEN 
             BEGIN
             XRECALL(LOC(ACBSWAPWR[0])); # ISSUE EVENT RECALL          #
             ACBID[0] = ACBIDVALUE; 
             END
           ATASB[I]=FALSE;# CLEAR APPLICATION STATUS BITS # 
           END                         # SAME ID WORD                  #
         END                           # SEARCHING                     #
 
       IF NOT FOUND 
         OR ATNVFN[ACBAN[0]] # NETOFF IN PROGRESS                      #
       THEN 
         BEGIN                         # ACN NOT FOUND                 #
# 
      LOOK INTO THE SWAP-IN RING
# 
         FOR IDX = SWAPINFP WHILE IDX NQ 0
                               AND IDX NQ LOC(SWAPINFP) 
         DO 
           BEGIN                       # SEARCH    SWAP-IN  RING       #
           P<SWPIE> = IDX ; 
           IF SWPIJOBID[0] EQ JOBID 
           THEN 
             BEGIN                     # IN SWAP-IN     RING           #
             FOUND = TRUE ; 
             IF SWPICB[0] EQ 0
             THEN # WAITING FOR SCP REQUEST COMPLETION                 #
               XRECALL(LOC(SWPIFW[0])); # ISSUE EVENT RECALL           #
             IDX = SWPIWR[0] ;
             IF IDX NQ 0
             THEN 
               MRELS(IDX) ; 
             IDX = SWPIFL[0] ;
             IF IDX NQ 0
             THEN 
               MRELS(IDX) ; 
             IDX = SWPINFP[0];
             PARAMS1 = P<SWPIE> ;      # REMOVE ENTRY FOR SWAP IN RING #
             OVLNAME = XSAPPDLP ; 
             OVLCALL ;
             MRELS(P<SWPIE>) ;         # RELEASE SWAP-IN RING ENTRY   # 
             END                       # IN  SWAPPING IN RING          #
 
           ELSE 
             IDX = SWPINFP[0] ; 
           END                         # SEARCHING                     #
 
         END                           # ACB NOT FOUND                 #
 
       IF NOT FOUND 
       THEN 
         BEGIN                         # ACB NOT FOUND IN *AT* AND     #
         CONTROL IFEQ DEBUG,1;
         PARAMS1 = DFMSG04 ;           # IN SWAP-IN  RING              #
         PARAMS2 = JOBID ;             # ISSUE A DAYFILE MESSAGE       #
         OVLNAME = XERRMSGP ; 
         OVLCALL ;
         CONTROL FI;
         P<FLHEAD> = LOC(LOCALFL) - 1 ;  # BLOCK FOR SCP CALL          #
         FLFW[0] = 0 ;
         FLUCPA[0] = -1 ; 
         FLFC[0] = SFENDT ; 
         FLJOBID[0] = JOBID ; 
         P<FLE> = LOC(LOCALFL) ;
         HFCALL = TRUE ;
         OSCCALL(FLE) ; 
         HFCALL = FALSE ; 
 
         IF FLRC[0] EQ RCUCPAOOR
         THEN 
           BEGIN                         # BAD REASON CODE RETURNED    #
           D25M2[0] = "HAPFAIL" ; 
           OMSG(DFMSG25,0);  # NIP DUMP TAKEN                          #
           RDUMP ;
           END                           # BAD REASON CODE RETURNED    #
         END
 
          MRELS(P<NWLHEADER>) ;             # RELEASE THE NWL          #
 
        END                            # APPL. FAILURE CASE            #
# 
      IF ACB EXISTS      , CALL STATE TABLE PROCESSOR 
# 
      IF ACBADDR NQ 0 
      THEN
        BEGIN                          # ACB STILL EXISTS              #
        FAILANAME = ACBANAME[0];       # SAVE FAILED APPLICATION NAME  #
        IF ACBAN[0] EQ NVFAN
        THEN
          ABORT(DFMSG10,0) ;             # NVF NETTING OFF             #
 
        IF ATNVFA[ACBAN[0]] 
        THEN
          BEGIN                    # APPLIACTION DID NOT NETON O.K.    #
          PARAMS1 = ACBAN[0] ;     # RELEASE ACB AND NOT SEND APPL/FAIL#
          OVLNAME = RELACBP ;      # TO NVF                            #
          OVLCALL ; 
          END                      # NET/ON/A RECEIVED FOR THIS APPL   #
 
        ELSE
 
          BEGIN                    # APPLICATION NETTED ON O.K.        #
          IF NOT ATNVFN[ACBAN[0]] 
            AND NOT ATNVFF[ACBAN[0]]
          THEN # APPLICATION NOT AWAITING NET/OFF/N FROM NVF           #
          BEGIN 
 
          P<ACNT> = ACBACNT[0] ;         # ACNT TABLE                  #
          OLDACNT = P<ACNT>;
 
          LIMIT = ACNTHCN[0] - ACNTMINACN[0] + ACNTHSIZE ;
          FOR IDX = ACNTHSIZE STEP 1 UNTIL LIMIT
          DO
            BEGIN                        # CALL HC STATE TABLE         #
                                         # WITH APP FAILED TRIGGER     #
            IF ACNTACNB[IDX] NQ 0 
            THEN
              BEGIN 
              P<ACNB> = ACNTACNB[IDX] ; 
              ACNBRC[0] = RCRC"AF" ;     # RC= 2, APPL FAILURE         #
              HCSTTP(ACBADDR,ACNBACN[0],FAILAP,0) ; 
              END 
            ELSE
              BEGIN                        # IN-ACTIVE ENTRY           #
              IF ACNTSECID[IDX] NQ 0       # SEC  ID NOT ZERO          #
              THEN
                BEGIN                      # LOANED CONN. EXIT         #
                SECACN = ACNTSECACN[IDX];  # ACN FOR SECONDARY APP     #
                P<ACB> = ATACBA[ACNTSECAN[IDX]];  # ACB OF SECONDARY AP#
                P<ACNT> = ACBACNT[0];  # ACNT OF SECONDARY APP         #
                P<ACNB> = ACNTACNB[SECACN-ACNTMINACN[0]-ACNTHSIZE]; 
                IF P<ACNB> NQ 0 
                THEN                   # CON STILL EXISTS IN SEC APP   #
                  BEGIN 
                  ACNBPRAF[0] = TRUE;  # SET PRI APP FAILED FLAG       #
                  END 
                P<ACNT> = OLDACNT;     # RESTORE ACNT ADR OF FAILED APP#
                END                        # LOANED CONN. EXIT         #
              END                          # IN-ACTIVE ENTRY           #
            END                          # CALL HC STATE TABLE         #
        IF ACBFNTW0[0] NQ 0 
        THEN
          BEGIN                        # FILE LOANNING EXISTED         #
          IF ACBFNTMAS[0] 
          THEN
            PARAMS1 = TMAB ;           # MASTER HAS FAILED             #
          ELSE
            PARAMS1 = TSAB ;           # ELSE IS SLAVE                 #
          PARAMS2 = ACBAN[0] ;         # AC  OF FAILED      APPLICATION#
          PARAMS3 = 0 ; 
          OVLNAME = HFNTSMP ; 
          OVLCALL ; 
          END 
  # 
        FORMAT APP/FAIL/U SM SEND TO NVF
  # 
            MGETS(LAPPF + BLKHSIZE + ABHSIZE,BLKADDR,TRUE) ;
            P<AHEADER> = BLKADDR + BLKHSIZE ; 
            ABHWORD[0] = SMABHW[0] ;
            ABHTLC[0] = LAPPF ; 
 
            P<SUPMSG> = BLKADDR + BLKHSIZE + ABHSIZE ;
 
            P<SMNVF> = P<SUPMSG> ;
            FAILAN[0] = ACBAN[0] ;
            PFCSFC[0] = FAIAPP ;
 
            BLINK(BLKADDR,ATACBA[NVFAN]) ;
            OSCHAPP(ATACBA[NVFAN]) ;
            ATNVFF[ACBAN[0]] = TRUE; # SET WAITING FOR FAIL/APPL/N     #
            END                # SEND APPL/FAIL/U TO NVF               #
          END                      # APPLICATION NETTED ON O.K.        #
        IF KDAM[0] # NAM K DISPLAY IN APPLICATION MODE                 #
          AND KDAN[0] EQ ACBAN[0] # ASSIGNED TO FAILED APPLICATION     #
        THEN # CLEAN UP NAM K DISPLAY TABLES                           #
          BEGIN 
          OVLNAME = KPCLNUPP; 
          OVLCALL;
          END 
        IF NOT KDAM[0]         # KDISPLAY IN NAME MODE                 #
        THEN
          BEGIN 
          IF KDNAL[0] GR 0     # SOME APPL IN ALERT                    #
          THEN
            BEGIN              # CHECK IF THIS IS THE ONE IN ALERT     #
            HWHERE = 0; 
            P<HALTNR> = LOC(KAPALT1[0]);
            FOR HINDEX = 1 STEP 1 WHILE HWHERE EQ 0 AND HINDEX LQ 
                         KMAXALT
            DO
              BEGIN 
              IF HALTN[HINDEX] EQ FAILANAME # IF NAME ON ALERT BUFFER  #
              THEN                         # SAME AS FAILED APPL NAME  #
                BEGIN 
                HWHERE = HINDEX;           # MARK THE INDEX            #
                END 
              END            # END OF FOR                              #
            IF HWHERE NQ 0   # START SHIFT APPL NAMES IN ALERT BUFFER  #
            THEN
              BEGIN 
              FOR HINDEX = HWHERE STEP 1 UNTIL KMAXALT -1 
              DO
                BEGIN 
                HALTN[HINDEX] = HALTN[HINDEX + 1];
                END 
              KAPALT5[0] = " "; 
              GOTO HHN[HWHERE]; 
      HM:    ;
      HA:    KDALAN1[0] = KDALAN2[0]; 
      HB:    KDALAN2[0] = KDALAN3[0]; 
      HC:    KDALAN3[0] = KDALAN4[0]; 
      HD:    KDALAN4[0] = KDALAN5[0]; 
      HHE:   KDALAN5[0] = 0;
             KDNAL[0] = KDNAL[0] - 1; 
             END             # END OF APPL SHIFT                       #
           END               # END OF SOME KAPPL                       #
         END                 # END OF KDAM                             #
       END                   # END OF NON-ZERO ACB ADDRESS             #
      FAILADR = 0 ;          # APPL/FAILURE PROCESSED                  #
      GOTO RJMAIN;           # RETURN TO CALLING PROGRAM               #
      END 
TERM