*DECK CIOERRC 
USETEXT COMCBEG 
USETEXT COMADEF 
USETEXT COMACBF 
USETEXT COMACBX 
USETEXT COMADFM 
USETEXT COMAFET 
USETEXT COMAMCB 
PROC CIOERRC; 
# TITLE CIOERRC - CIO ERROR CHECK.  # 
  
      BEGIN  # CIOERRC #
  
# 
**    CIOERRC - CIO ERROR CHECK.
* 
*     CIOERRC PROCESSES A CIO ERROR BY SETTING THE ERROR ORDINAL IN 
*     THE FTT, CALLING DAYFMSG TO WRITE A DAYFILE MESSAGE, AND
*     INITIATES COMPLETION OF THE FILE TRANSFER.
* 
*     PROC CIOERRC
* 
*     ENTRY      <FTTENT> = FWA FTT ENTRY.
* 
*     EXIT       (SEE PROCESS). 
* 
*     PROCESS    IF CIO ERROR CODE .GT. EOI:  
*                  IF NOS/BE DEVICE FULL: 
*                    IF RETRIES NOT EXHAUSTED:  
*                      CLEAR CIO ERROR. 
*                      INCREMENT RETRY COUNT. 
*                      SET FTTSTATE = TRANSFER-DELAY. 
*                      RETURN.
*                  IF ERROR CODE HAS ADDITIONAL TEXT: 
*                    ADD TEXT TO MESSAGE. 
*                  CALL DAYFMSG TO SEND DAYFILE MESSAGE.
*                  SET FTTTSTATIS = CIO$ERROR.
*                CALL QUITXFR TO END DATA TRANSFER. 
* 
****  PROC CIOERRC - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC DAYFMSG;                #  WRITE DAYFILE MESSAGE # 
        FUNC OCTCHF  C(10);          # OCTAL TO DISPLAY CODE #
        PROC QUITXFR;                # QUIT DATA TRANSFER # 
        FUNC REPZERO C(7);           # BLANK TRAILING ZEROS # 
        END 
  
# 
****  PROC CIOERRC XREF LIST END. 
# 
  
      DEF MAXCIOERR  #   3 #;      # MAX NUMBER OF ERRORS WITH TEXT # 
      DEF CIO$ERPE   #   4 #;      # PARITY ERROR # 
  
      CONTROL IFEQ OS$NOS;
      DEF CIO$ERDF   #   2 #;      # DEVICE FULL #
      CONTROL ENDIF;
  
      CONTROL IFEQ OS$NOSBE;
      DEF CIO$ERDF   #O"10"#;      # DEVICE FULL/TAPE BLOCK SIZE #
      CONTROL ENDIF;
  
      ARRAY [1:MAXCIOERR] S(3);    # ADDITIONAL CIO MESSAGE TEXT #
        BEGIN 
        ITEM CIO$MSG    C(00,00,28) = 
             [", PARITY ERROR.             ", 
              ", DEVICE FULL.              ", 
              ", TAPE BLOCK SIZE ERROR.    "];
        ITEM CIO$MSGT1  C(00,00,06);  # ERROR TEXT, PART 1 #
        ITEM CIO$MSGT2  C(00,36,22);  # ERROR TEXT, PART 2 #
        ITEM CIO$ERRCOD U(02,48,12) = 
             [CIO$ERPE,            # PARITY ERROR # 
              CIO$ERDF,            # DEVICE FULL #
              CIO$ERDF];           # TAPE BLOCK SIZE #
        END 
  
      ITEM I          I;           # SCRATCH #
                                               CONTROL EJECT; 
      IF LFETEC GT EOI
      THEN
        BEGIN 
        IDFM$LFN1A[CIO$ERROR] = REPZERO(LFETLFNC);  # FILE NAME # 
        IDFM$CIOER[CIO$ERROR] = OCTCHF(LFETEC,2);  # ERROR CODE # 
        SLOWFOR I = 1 STEP 1 UNTIL MAXCIOERR
        DO
          BEGIN 
          IF CIO$ERRCOD[I] EQ LFETEC  # IF ADDITIONAL TEXT #
          THEN
            BEGIN 
  
      CONTROL IFEQ OS$NOSBE;
            IF LFETEC EQ CIO$ERDF  # IF DEVICE FULL # 
            THEN
              BEGIN 
              IF INTAPE            # IF READING TAPE #
              THEN
                BEGIN 
                I = I + 1;         # USE ALTERNATE MESSAGE #
                END 
  
              ELSE
                BEGIN 
                IF FTTDLYCTR LE DFULLRETRY    # IF NOT RETRY LIMIT #
                THEN
                  BEGIN 
                  FTTDLYCTR = FTTDLYCTR + 1;  # INCREMENT COUNT # 
                  FTTSTATE = S"DATAXFRDLY";   # RESET STATE # 
                  FTTTIME = 0;                # RESET TIME #
                  LFETEC = 0;                 # CLEAR ERROR # 
                  RETURN; 
                  END 
  
                END 
  
              END 
      CONTROL ENDIF;
  
            IDFM$CIOTX[CIO$ERROR] = CIO$MSGT1[I];  # ADD TEXT 1 # 
            BUFF$MSG2 = CIO$MSGT2[I];   # AND TEXT 2 TO MESSAGE # 
            EXIT DONE;
            END 
  
          END 
  
      DONE: 
        DAYFMSG(CIO$ERROR);        # SEND DAYFILE MESSAGE # 
        FTTTSTATIS = CIO$ERROR;    # SET TEMPORARY STATUS # 
        END 
  
      QUITXFR;                     # QUIT DATA TRANSFER # 
      END    # CIOERRC #
  
      TERM
