*DECK SSFERRP 
USETEXT COMCBEG 
USETEXT COMRAPL 
USETEXT COMRQUE 
USETEXT COMRSFC 
USETEXT COMRRTN 
PROC SSFERRP((UCPA)); 
# TITLE SSFERRP - SSF ERROR PROCESSOR. #
  
      BEGIN  # SSFERRP #
  
# 
**    SSFERRP - SSF ERROR PROCESSOR.
* 
*     PROCESS ABNORMAL SSF RETURN CODES.
* 
*     PROC SSFERRP(UCPA)
* 
*     ENTRY   - (SSFADDR) = SSF CALL PARAMETER BLOCK. 
* 
*     EXIT    - P<QU$ADDRESS> IS PRESERVED. 
*               P<APL$HEADER> IS PRESERVED. 
* 
*     PROCESS - SAVE QUEUE ADDRESS. 
*               SAVE APPLICATION ADDRESS. 
*               GET ERROR CODE AND FUNCTION.
*               IF LIST ERROR 
*               THEN: 
*                 DETERMINE ACTUAL ERROR. 
*               IF FATAL RHF ERROR
*               THEN: 
*                 DAYFILE ERROR MESSAGE.
*                 ABORT RHF.
*               ELSE: 
*                 IF USER NOT IN SYSTEM 
*                 THEN: 
*                   DAYILE ERROR MESSAGE. 
*                 ELSE: 
*                   IF NON-TRIVIAL ERROR
*                   THEN: 
*                     DETERMINE APPLICATION TABLE ADDRESS.
*                     IF APPL HEADER FOUND
*                     THEN: 
*                       QUEUE ENTRY ON ERR/LGL QUEUE. 
*                     ELSE: 
*                       DAYFILE ERROR MESSAGE.
*               RESTORE QUEUE ADDRESS.
*               RESTORE APPLICATION ADDRESS.
# 
  
      ITEM UCPA       I;             # UCP RETURN ADDRESS # 
  
# 
****  PROC SSFERRP - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC RHFMSG;                 # DAYFILE RHF MESSAGE #
        PROC QERRLGL;                # QUEUE ON ERR/LGL QUEUE # 
        PROC CALLSYS;                # MAKE RA + 1 CALL # 
        FUNC BINTOOD C(10);          # CONVERT BINARY TO OCTAL DIS #
        ITEM FAPLADR;                # FIRST APPL HEADER ADDRESS #
        ITEM LAPLADR;                # LAST APPL HEADER ADDRESS # 
        END 
  
# 
****  PROC SSFERRP - XREF LIST END. 
# 
  
  
      ITEM SAVEQP     I;             # QUEUE POINTER SAVE AREA #
      ITEM SAVEAP     I;             # APPL POINTER SAVE AREA # 
      ITEM APLFOUND   B;             # APPL HEADER FOUND #
  
      ARRAY [0:0] S(1); 
        BEGIN  # SSF ERROR WORD # 
        ITEM SSFRETWORD I(00,00,60); # SSF RETURN WORD #
        ITEM SSFRETCODE U(00,00,06); # SSF RETURN CODE #
        ITEM SSFFUNCODE U(00,54,06); # SSF FUNCTION CODE #
        ITEM SSFCOMPBIT B(00,59,01); # SSF COMPLETE BIT # 
        END 
  
      ARRAY [0:0] S(1); 
        BEGIN  # SSF JOB ID # 
        ITEM SSFJOBID   I(00,00,60); # SSF JOB ID # 
        ITEM SSFJOBNAME C(00,00,07); # SSF JOB NAME # 
        ITEM SSFJOBORD  I(00,42,18); # SSF JOB ORDINAL #
        END 
  
      ARRAY [0:0] S(5); 
        BEGIN  # RHF FATAL SSF ERROR #
        ITEM RHFFSSFERR C(00,00,40) = 
          [" RHF, FATAL SSF ERROR. FC=00,RC=00."];
        ITEM FSE$FC     C(02,36,02); # SSF FUNCTION CODE #
        ITEM FSE$RC     C(03,12,02); # SSF RETURN CODE #
        ITEM FSE$LENGTH I(04,00,60) = [35]; 
        END 
  
      ARRAY [0:0] S(5); 
        BEGIN  # USER NOT IN SYSTEM # 
        ITEM RHFERRUNS  C(00,00,40) = 
          [" RHF, SSF ERROR, XXXXXXX NOT IN SYSTEM."];
      CONTROL IFEQ OS$NOSBE;
        ITEM UNS$JOBNAM C(01,42,07);
      CONTROL ENDIF;
      CONTROL IFEQ OS$NOS;
        ITEM UNS$JOBNAM C(01,42,04);
        ITEM UNS$BFILL  C(02,06,03) = ["   "];
      CONTROL ENDIF;
        ITEM UNS$LENGTH I(04,00,60) = [39]; 
        END 
  
      ARRAY [0:0] S(5); 
        BEGIN  # JOB NOT IN RHF"S TABLES #
        ITEM RHFJNIRHFT C(00,00,40) = 
          [" RHF, XXXXXXX NOT IN RHF*S TABLES."]; 
      CONTROL IFEQ OS$NOSBE;
        ITEM JNR$JOBNAM C(00,36,07);
      CONTROL ENDIF;
      CONTROL IFEQ OS$NOS;
        ITEM JNR$JOBNAM C(00,36,04);
        ITEM JNR$BFILL  C(01,00,03) = ["   "];
      CONTROL ENDIF;
        ITEM JNR$LENGTH I(04,00,60) = [34]; 
        END 
  
      ARRAY [0:0] S(1); 
        BEGIN 
        ITEM ABORT      C(00,00,03) = ["ABT"];
        END 
  
CONTROL EJECT;
  
      SAVEQP = P<QU$ADDRESS>; 
      SAVEAP = P<APL$HEADER>; 
  
      P<QU$ADDRESS> = SSFADDR - 1;
      SSFRETWORD = QU$WD1;
      SSFJOBID = QU$SFJOBID;
  
      IF SSFRETCODE EQ SFRC$LERR
      THEN
        BEGIN  # LIST ERROR # 
  
        IF QU$SFRC2 GT SFRC$LERR
        THEN
          BEGIN  # ERROR ON FUNCTION 2 #
          SSFRETWORD = QU$WD3;
          END 
        ELSE
          BEGIN 
  
          IF QU$SFRC3 GT SFRC$LERR
          THEN
            BEGIN  # ERROR ON FUNCTION 3 #
            SSFRETWORD = QU$WD4;
            END 
          ELSE
            BEGIN 
  
            IF QU$SFRC4 GT SFRC$LERR
            THEN
              BEGIN  # ERROR ON FUNCTION 4 #
              SSFRETWORD = QU$WD5;
              END 
  
            ELSE
              BEGIN  # ERROR ON FUNCTION 5 #
              SSFRETWORD = QU$WD6;
              END 
            END 
          END 
        END 
  
      SSFCOMPBIT = FALSE; 
  
      IF SSFRETCODE EQ SFRC$SCPA
        OR SSFRETCODE EQ SFRC$INVFC 
      THEN
        BEGIN  # FATAL RHF SSF ERROR #
        FSE$FC = BINTOOD(SSFFUNCODE,2); 
        FSE$RC = BINTOOD(SSFRETCODE,2); 
        RHFMSG(LOC(RHFFSSFERR),FSE$LENGTH); 
        CALLSYS(ABORT); 
        END 
      ELSE
        BEGIN 
  
        IF SSFRETCODE EQ SFRC$IDBAD 
          OR SSFRETCODE EQ SFRC$UNKWN 
        THEN
          BEGIN  # JOB NOT KNOWN TO SYSTEM #
          UNS$JOBNAM = SSFJOBNAME;
          RHFMSG(LOC(RHFERRUNS),UNS$LENGTH);
          END 
        ELSE
          BEGIN 
  
          IF SSFRETCODE GT SFRC$LERR
          THEN
            BEGIN  # IF NOT TRIVIAL ERROR # 
            APLFOUND = FALSE; 
            P<APL$HEADER> = FAPLADR;
            ASLONGAS  P<APL$HEADER> LE LAPLADR
              AND NOT APLFOUND
            DO
              BEGIN  # FIND MATCHING APPL HEADER #
              IF APL$JOBID EQ QU$SFJOBID
                AND NOT APL$NETOFF
              THEN
                BEGIN  # MATCHING APPL FOUND #
                APLFOUND = TRUE;
                END 
              ELSE
                BEGIN  # CHECK NEXT APPL HEADER # 
                P<APL$HEADER> = P<APL$HEADER> + APL$LENGTH
                  + APL$NUMCON * CON$LENGTH;
                END 
              END 
            IF APLFOUND 
            THEN
              BEGIN  # OFFENDING APPL FOUND # 
              QERRLGL(LGL$NULERR,SSFRETCODE,UCPA,SSFRETWORD,0,0,0); 
              END 
            ELSE
              BEGIN  # JOB NOT ACTIVE IN RHF"S TABLES # 
              JNR$JOBNAM = SSFJOBNAME;
              RHFMSG(LOC(RHFJNIRHFT),JNR$LENGTH); 
              END 
            END 
          END 
        END 
  
      P<APL$HEADER> = SAVEAP; 
      P<QU$ADDRESS> = SAVEQP; 
  
      END # SSFERRP # 
  
      TERM
