*DECK FIPRPV
USETEXT COMCBEG 
USETEXT COMADEF 
USETEXT COMACBF 
USETEXT COMACBX 
USETEXT COMADFM 
USETEXT COMAFET 
    PROC FIPRPV (RPB,ABT,JFL);
# TITLE FIPRPV - FIP REPRIEVE PROCESSOR. #
  
      BEGIN  # FIPRPV # 
  
# 
**    FIPRPV - FIP REPRIEVE PROCESSOR.
* 
*     FIPRPV PERFORMS RECOVERY PROCESSING FOLLOWING A SYSTEM ERROR. 
* 
*     ENTRY      RPB = ARRAY CONTAINING RECOVR PARAMETER BLOCK. 
*                      (WORDS  1-16 = EXCHANGE PACKAGE, 
*                       WORDS 17-26 = RECOVR PARAMETERS.) 
*                ABT = ABORT FLAG (RETURNED). 
*                JFL = ARRAY CONTAINING JOB CM FIELD LENGTH.
* 
*     EXIT       SEE PROCESS. 
* 
*     PROCESS    IF RECOVERABLE SYSTEM ERROR: 
*                  ADD DETAIL TO *SYSTEM ERROR* MESSAGE 
*                  INCREMENT REPRIEVE COUNT [ERROR] 
*                  IF REPRIEVE COUNT GE MAXIMUM:  
*                    CALL RECOVR (DEACTIVATE FIPRPV). 
*                    CALL DAYFMSG (*SYSTEM ERROR. ..DETAIL..
*                                       FIP REPRIEVES EXHAUSTED *). 
*                  ELSE:  
*                    SET RPV$MSG = *FIP REPRIEVING*.
*                    SET RECOVR PARAMETER TO RESUME FIP EXECUTION.
*                    FOR ALL ACTIVE TRANSFERS:  
*                      SET FTTTSTATIS = SYSTEM$ER.
*                      SET FTTDXPA = ERR21/ERR29 (RECEIVE/SEND).
*                      RETURN (RESUME FIP EXECUTION). 
*                RETURN (RESTORE SYSTEM ERROR AND ABORT). 
# 
      ARRAY RPB [1:26] S(1);       # RECOVR PARAMETER BLOCK # 
        BEGIN 
        ITEM RPB$WORD   U(00,00,60);  # PARAMETER BLOCK WORD #
        ITEM RPB$CMFL   I(00,06,18);  # JOB CM FIELD LENGTH [3] # 
        ITEM RPB$RPLY   I(00,42,18);  # RA+1 REPLY WORD ADDR [23] # 
        ITEM RPB$SYSERR U(00,48,12);  # SYSTEM ERROR CODE [21] #
        END 
  
      ITEM ABT        U;           # RECOVR TERMINATION FLAG #
  
      BASED ARRAY JFL [1:1] S(1);  # JOB FIELD LENGTH # 
        BEGIN 
        ITEM JFL$WORD   U(00,00,60);  # CM WORD # 
        END 
  
# 
****  PROC FIPRPV - XREF LIST BEGIN.
# 
      XREF
        BEGIN 
        PROC DAYFMSG;              # DAYFILE MESSAGE #
        PROC RECOVR;               # SYSTEM REPRIEVE ROUTINE #
        END 
# 
****  PROC FIPRPV - XREF LIST END.
# 
  
      DEF NUMRPVERR  # 5 #;        # NUMBER OF REPRIEVABLE ERRORS # 
# 
*     RECOVR ERROR CODE VALUES (FROM RPB[21]).
# 
  
      DEF SYSERR$CPL #O"01"#;      # CPU TIME LIMIT # 
      DEF SYSERR$PPA #O"03"#;      # PP ABORT # 
      DEF SYSERR$OPD #O"06"#;      # OPERATOR DROP #
      DEF SYSERR$MSL #O"17"#;      # MASS STORAGE LIMIT # 
      DEF SYSERR$IOL #O"21"#;      # I/O LIMIT #
  
      ARRAY [1:2] S(3); 
        BEGIN 
        ITEM RPV$MESS   C(00,00,28) = 
             ["PRIEVING.                   ", 
              "PRIEVES EXHAUSTED.          "];
        ITEM RPV$MESSZ  U(02,48,12) = [2(0)]; 
        END 
  
      ARRAY [1:NUMRPVERR] S(3); 
        BEGIN 
        ITEM RPV$ERRCNT U(00,36,12) = 
             [5,5,2,5,5];              # REPRIEVE COUNT (LIMITS) #
        ITEM RPV$ERRCOD U(00,48,12) = 
             [SYSERR$CPL,              # RECOVR ERROR CODES # 
              SYSERR$PPA, 
              SYSERR$OPD, 
              SYSERR$MSL, 
              SYSERR$IOL];
        ITEM RPV$MSGTXT C(01,00,17) = 
             ["CP TIME LIMIT, RE",     # MESSAGE TEXT # 
              "PP ABORT,      RE",
              "OPERATOR DROP, RE",
              "M/S LIMIT,     RE",
              "I/O LIMIT,     RE"]; 
        END 
  
      ITEM I          I;           # SCRATCH #
  
      ARRAY [0:0] S(1); 
        BEGIN 
        ITEM ERRCOD     I(00,00,60);  # RECOVR ERROR CODE # 
        ITEM SAVFTTA    I(00,42,18);  # FTT ENTRY ADDR #
        END 
                                               CONTROL EJECT; 
      ERRCOD = RPB$SYSERR[21];     # RECOVR ERROR CODE #
  
      SLOWFOR I = 1 STEP 1 UNTIL NUMRPVERR
      DO
        BEGIN 
  
        IF ERRCOD EQ RPV$ERRCOD[I]  # IF REPRIEVABLE ERROR #
        THEN
          BEGIN 
          IDFM$SYSER[SYSTEM$ER] = RPV$MSGTXT[I];  # ADD TEXT #
          RPV$ERRCNT[I] = RPV$ERRCNT[I] - 1;  # DECREMENT RPV COUNT # 
  
          IF RPV$ERRCNT[I] LE 0    # IF REPRIEVES EXHAUSTED # 
          THEN
            BEGIN 
            BUFF$MSG2 = RPV$MESS[2];  # 2D LINE *REPRIEVES EXHAUSTED* # 
            RECOVR (FIPRPV,0,0);   # DEACTIVATE FIPRPV #
            DAYFMSG (SYSTEM$ER);   # SEND DAYFILE MESSAGE # 
            END 
  
          ELSE
            BEGIN 
            RPV$MSG = RPV$MESS[1];  # 2D LINE *REPRIEVING* #
            RPB$WORD[18] = 4;      # SET RESUME EXECUTION # 
            SAVFTTA  = P<FTTENT>;  # SAVE FTT ENTRY POINTER # 
  
            SLOWFOR I = 0 STEP 1 UNTIL MAXFILEXM1 
            DO
              BEGIN                # SCAN FTT ENTRIES # 
              P<FTTENT> = LOC(FTT$WD0[I]);
  
              IF FTTACN NE 0       # IF TABLE ENTRY IN USE #
              THEN
                BEGIN 
  
                IF FTTTSTATIS LT SYSTEM$ER
                  AND (   FTTSTATE LE S"DATAXFRPRG" 
                       OR FTTSTATE EQ S"DATAXFRDLY" 
                       OR FTTSTATE EQ S"QRISSWFACK")
                THEN
                  BEGIN 
                  FTTTSTATIS = SYSTEM$ER;  # SYSTEM ERROR # 
  
                  IF FTTDIRECN EQ SEND
                  THEN
                    BEGIN 
                    FTTDXPA = P$ES$ERR29; 
                    END 
  
                  ELSE
                    BEGIN 
                    FTTDXPA = P$ES$ERR21; 
                    END 
                  END 
                END 
              END 
  
            P<FTTENT> = SAVFTTA;   # RESTORE FTT POINTER #
            END 
  
          EXIT DONE;               # RETURN # 
          END 
  
        END 
  
      DONE: 
      END  # FIPRPV # 
  
    TERM
