Retro1.org codex

PROC ACQCART;
# TITLE ACQCART - ACQUIRE CARTRIDGE.                                  #
 
      BEGIN  # ACQCART #
 
#
**    ACQCART - ACQUIRE CARTRIDGE.
*
*     *ACQCART* PROCESSES *DRQUEUE* REQUESTS TO LOAD CARTRIDGES
*     AND READ CARTRIDGE LABELS.
*
*     PROC ACQCART
*
*     ENTRY      P<LLRQ> = *DRQUEUE* ENTRY ADDRESS.
*
*     EXIT       THE *DRQUEUE* ENTRY REQUEST STATE FIELD HAS BEEN
*                UPDATED TO INDICATE WHERE SUBSEQUENT PROCESSING OF
*                THIS REQUEST IS TO CONTINUE.
*
*     MESSAGES   *EXEC ABNORMAL, ACQCART2.* - UDT MESSAGE BUFFER
*                                             STILL IN USE.
*
*                A K-DISPLAY MESSAGE IS ISSUED IF THE INPUT TRAY OR
*                MATRIX CELL IS EMPTY.
*
*     NOTES      THIS IS A PSEUDO-REENTRANT PROCEDURE.
#
 
 
#
****  PROC ACQCART - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ABORT;                  # ABORT #
        PROC KREQ;                   # SEND K-DISPLAY REQUEST #
        PROC MESSAGE;                # ISSUE DAYFILE MESSAGE #
        PROC SENDMSG;                # SEND M860 MESSAGE #
        PROC ZFILL;                  # ZERO-FILL BUFFER #
        END
 
#
****  PROC ACQCART - XREF LIST END.
#
 
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
*CALL,COMBFAS
*CALL,COMBCPR
*CALL,COMBFET
*CALL,COMBHFC
*CALL,COMBKDD
*CALL,COMBLBL
*CALL,COMBLRQ
*CALL,COMBTDM
*CALL,COMBUCR
*CALL,COMBUDT
*CALL,COMXCTF
*CALL,COMXHLR
*CALL,COMXMSC
 
      ITEM DRDFULL    B;             # NEXT-DRD FULL FLAG #
      ITEM DRDON      B;             # NEXT-DRD ON FLAG #
      ITEM I          I;             # INDEX #
      ITEM OTHERFULL  B;             # OTHER-DRD FULL FLAG #
      ITEM OTHERON    B;             # OTHER-DRD ON FLAG #
      ITEM TEMPALL    B;             # TEMP ALLOCATION FLAG #
      ITEM TEMPCSN0   U;             # FIRST 4 BYTES OF CSN #
      ITEM TEMPCSN1   U;             # NEXT 6 BYTES OF CSN #
      ITEM TEMPCSN2   U;             # LAST 2 BYTES OF CSN #
 
      SWITCH ACQLBL:PROCST           # DRIVER REQUEST STATE #
            ACQINIT:INITIAL,         # INITIAL STATE #
            ACQLOAD:CONT1,           # CONTINUATION 1 #
            ACQREAD:CONT2;           # CONTINUATION 2 #
                                               CONTROL EJECT;
 
      GOTO ACQLBL[LLR$RS[0]];
 
#
*     INITIAL DRIVER REQUEST STATE.
#
 
ACQINIT:
      SLOWFOR I = 1 STEP 1 WHILE (LLR$SMO[0] EQ 0)AND(I LQ MAXSMUNIT)
      DO                             # LOCATE SM ORDINAL FROM SM ID #
        BEGIN  # LOCATE #
        IF LLR$SMA[0] EQ SM$ID[I]    ##
          AND SM$EXIST[I]
        THEN                         # SM ORDINAL FOUND #
          BEGIN  # SET ORD #
          LLR$SMO[0] = I;
          END  # SET ORD #
 
        END  # LOCATE #
 
#
*     ALLOCATE DRD IN PREPARATION FOR LOAD.
#
 
      IF LLR$SMO[0] EQ 0             # SM ORDINAL NOT FOUND #
        OR NOT SM$ON[LLR$SMO[0]]     # SM OFF #
      THEN                           # LOAD NOT POSSIBLE #
        BEGIN  # EXIT #
        DRVRACTIVE = TRUE;
        LLR$DR[0] = RESPTYP4"SMA$OFF";
        LLR$RS[0] = PROCST"COMPLETE";
        RETURN;
        END  # EXIT #
 
      IF SM$SCCU[LLR$SMO[0]]         # PROCESSING SERVICE CELLS ONLY #
        AND LLR$PRCNME[0] NQ REQTYP4"INITHW"  # NOT SRV CELL LOAD #
      THEN                           # LOAD AFTER SRV CELLS PROCESSED #
        BEGIN  # WAIT #
        RETURN;
        END  # WAIT #
 
      DRDON = D1$ON[LLR$SMO[0]]      ##
                AND (NOT D1$ON$ACK[LLR$SMO[0]])  ##
                AND (D1$DONE[LLR$SMO[0]]  ##
                OR SM$DONE[LLR$SMO[0]]  ##
                OR LLR$PRCNME[0] NQ REQTYP4"INITHW");
 
      OTHERON = D0$ON[LLR$SMO[0]]    ##
                  AND (NOT D0$ON$ACK[LLR$SMO[0]])  ##
                  AND (D0$DONE[LLR$SMO[0]]  ##
                  OR SM$DONE[LLR$SMO[0]]  ##
                  OR LLR$PRCNME[0] NQ REQTYP4"INITHW");
 
      DRDFULL = D1$FULL[LLR$SMO[0]];
      OTHERFULL = D0$FULL[LLR$SMO[0]];
      IF SM$TOPDRD[LLR$SMO[0]]
      THEN                           # UPPER DRD CHOSEN #
        BEGIN  # RESET #
        TEMPALL = DRDON;
        DRDON = OTHERON;
        OTHERON = TEMPALL;
        DRDFULL = D0$FULL[LLR$SMO[0]];
        OTHERFULL = D1$FULL[LLR$SMO[0]];
        END  # RESET #
 
      IF DRDFULL OR NOT DRDON
      THEN                           # CHOSEN DRD NOT AVAILABLE #
        BEGIN  # CHECK OTHER DRD #
        IF NOT OTHERON
        THEN                         # OTHER DRD OFF #
          BEGIN  # RECHECK #
          IF NOT DRDON
          THEN                       # BOTH DRD-S OFF #
            BEGIN  # OFF #
            DRVRACTIVE = TRUE;
            LLR$DR[0] = RESPTYP4"SMA$OFF";  # NO ACCESS #
            LLR$RS[0] = PROCST"COMPLETE";
            END  # OFF #
 
          RETURN;                    # CHOSEN DRD IS FULL #
          END  # RECHECK #
 
        IF OTHERFULL
        THEN                         # OTHER DRD IS FULL #
          BEGIN  # WAIT #
          RETURN;                    # AT LEAST ONE DRD IS FULL #
          END  # WAIT #
 
        SM$TOPDRD[LLR$SMO[0]] = NOT SM$TOPDRD[LLR$SMO[0]];
                                     # USE OTHER DRD #
        END  # CHECK OTHER DRD #
 
      IF SM$TOPDRD[LLR$SMO[0]]
      THEN                           # UPPER DRD CHOSEN #
        BEGIN  # UPPER #
        LLR$DRD[0] = 0;
        D0$FULL[LLR$SMO[0]] = TRUE;
        D0$LLADR[LLR$SMO[0]] = P<LLRQ>;
        LLR$MBH[0] = LOC(D0$MSG[LLR$SMO[0]]) - 1;
        END  # UPPER #
 
      ELSE                           # LOWER DRD CHOSEN #
        BEGIN  # LOWER #
        LLR$DRD[0] = 1;
        D1$FULL[LLR$SMO[0]] = TRUE;
        D1$LLADR[LLR$SMO[0]] = P<LLRQ>;
        LLR$MBH[0] = LOC(D1$MSG[LLR$SMO[0]]) - 1;
        END  # LOWER #
 
      P<MBFHDR> = LLR$MBH[0];
      IF MBF$WORD[0] NQ 0
      THEN                           # LAST MESSAGE NOT PROCESSED #
        BEGIN  # ABORT #
        FE$RTN[0] = "ACQCART2.";
        GOTO ACQCART2;
        END  # ABORT #
 
      P<UDT$MSG> = P<MBFHDR> + 1;
      MS$MSG[0] = HFC$ACCR;          # SET *ACQUIRE* FUNCTION #
      IF LLR$Y[0] EQ SM$ENT$TY       # LOAD FROM ENTRY TRAY #
        AND LLR$Z[0] EQ SM$TY$Z
      THEN                           # RESET TO *ENTER* FUNCTION #
        BEGIN  # RESET #
        MS$MSG[0] = HFC$ENCRDR;
        END  # RESET #
 
      MBF$SAVE[0] = SAVEPART;
      LLR$RS[0] = PROCST"CONT1";     # SET NEXT REQUEST STATE #
 
#
*     ISSUE M860 MESSAGE TO LOAD CARTRIDGE.
#
 
ACQLOAD:
      P<MBFHDR> = LLR$MBH[0];
      SENDMSG;                       # SEND M860 MESSAGE #
      IF MBF$SBADDR[0] EQ 0          ##
        AND LLR$DR[0] EQ RESPTYP4"OK4"  # HARDWARE GOOD #
      THEN                           # RESPONSE NOT YET RECEIVED #
        BEGIN  # RETRY #
        RETURN;
        END  # RETRY #
 
      SM$ACCBUSY[LLR$SMO[0]] = FALSE;# SM ARM NOT IN USE #
      IF (MS$MSG[0] EQ HFC$ACCR      # *ACQUIRE* ERROR #
        AND MS$RETCODE[0] NQ 0       ##
        AND MS$RETCODE[0] NQ HRC$CSNMIS)  # HANDLE WHEN READING LABEL #
        OR (MS$MSG[0] EQ HFC$ENCRDR  # *ENTER* ERROR #
        AND MS$RETCODE[0] NQ 0)      ##
        OR LLR$DR[0] EQ RESPTYP4"M86$HDW$PR"
      THEN                           # UNEXPECTED RESPONSE #
        BEGIN  # NO LOAD #
        IF LLR$DRFUL[0]              # DEVICE DRIVER ERROR #
        THEN                         # TURN OFF DRD #
          BEGIN  # OFF #
          LLR$LDERR[0] = TRUE;
          GOTO ACQCART1;
          END  # OFF #
 
        IF MS$RETCODE[0] EQ 0        ##
          AND MS$MSG[0] EQ HFC$ACCR
        THEN                         # HARDWARE ERROR #
          BEGIN  # M860 #
          LLR$DR[0] = RESPTYP4"M86$HDW$PR";
          END  # M860 #
 
        IF MS$RETCODE[0] EQ HRC$CELEMP         ##
          OR MS$RETCODE[0] EQ HRC$TRAYPR
        THEN                         # CELL EMPTY #
          BEGIN  # EXIT #
          LLR$DR[0] = RESPTYP4"CELL$EMP";
 
#
*     SEND K-DISPLAY MESSAGE TO OPERATOR INDICATING EMPTY CELL.
#
 
          IF LLR$PRCNME[0] NQ REQTYP4"INITHW"  # NOT SRV CELL LOAD #
            AND NOT (MS$MSG[0] EQ HFC$ACCR  # NOT UCP LOAD TO MATRIX #
            AND LLR$RQI[0] NQ REQNAME"RQIINT")
          THEN                       # SEND K-DISPLAY MESSAGE #
            BEGIN  # K #
            P<KWORD> = LOC(LLR$KWORDS[0]);
            KW$WORD[0] = 0;
            KW$LINE1[0] = KM"KM2";
            KW$LINE2[0] = KM"KM20";  # ASSUME INPUT TRAY EMPTY #
            IF MS$MSG[0] EQ HFC$ACCR
            THEN                     # MATRIX CELL WAS EMPTY #
              BEGIN  # RESET #
              KW$LINE2[0] = KM"KM7";
              KW$DF[0] = TRUE;       # SEND TO JOB DAYFILE #
              KW$IC[0] = TRUE;       # SET IMMEDIATE COMPLETION #
              END  # RESET #
 
            KW$RPGO[0] = TRUE;       # ALLOW GO RESPONSE #
            KP$EQ = UD$ESTO[LLR$CU[0]];  # PRESET MESSAGE PARAMETERS #
            P<MWBTMP> = LOC(UD$CAMF[LLR$CU[0]]);
            P<FETMWB> = MWB$ADDR[LLR$CIF[0]];
            P<FETMRA> = P<FETMWB> - 1;
            P<FETMRB> = FRA$MRBADR[0];
            KP$CN = FMR$CHAN[0];
            KP$DT = SM$ID[LLR$SMO[0]];
            KP$YA = LLR$Y[0];        # SET EMPTY CELL #
            KP$ZA = LLR$Z[0];
            KREQ(LOC(KWORD),KLINK);  # SEND K-DISPLAY REQUEST #
            END  # K #
 
          END  # EXIT #
 
        IF LLR$DRD[0] EQ 0
        THEN                         # UPPER DRD EMPTY #
          BEGIN  # UPPER #
          D0$FULL[LLR$SMO[0]] = FALSE;
          END  # UPPER #
 
        ELSE                         # LOWER DRD EMPTY #
          BEGIN  # LOWER #
          D1$FULL[LLR$SMO[0]] = FALSE;
          END  # LOWER #
 
        GOTO ACQCART1;
        END  # NO LOAD #
 
      IF MS$MSG[0] EQ HFC$ACCR
      THEN                           # SET DRIVER RETURN CODE IN LLRQ #
        BEGIN  # SET #
        LLR$DR[0] = RESPTYP4"UNK$CART";
        END  # SET #
 
      TEMPCSN0 = MS$CART0[0];        # MOVE CSN TO MSG BUFFER #
      TEMPCSN1 = MS$CART1[0];
      TEMPCSN2 = MS$CART2[0];
      ZFILL(UDT$MSG,MSGLT);          # CLEAR STORAGE BUFFER #
      SM$TOPDRD[LLR$SMO[0]] = NOT SM$TOPDRD[LLR$SMO[0]];
      P<UDT$MSG> = P<MBFHDR> + 1;
      MS$CART0[0] = TEMPCSN0;
      MS$CART1[0] = TEMPCSN1;
      MS$CART2[0] = TEMPCSN2;
      MS$MSG[0] = HFC$RCLBP0;        # SET *READ LABEL* FUNCTION #
      MBF$WORD[0] = 0;               # CLEAR MESSAGE STATUS #
      MBF$SAVE[0] = SAVEMOST;
      LLR$RS[0] = PROCST"CONT2";
 
#
*     ISSUE M860 MESSAGE TO READ CARTRIDGE LABEL.
#
 
ACQREAD:
      P<MBFHDR> = LLR$MBH[0];
      IF LABELBUSY AND NOT MBF$ACTIVE[0]
      THEN                           # ANOTHER REQUEST HAS LABEL BUF #
        BEGIN  # WAIT #
        RETURN;                      # WAIT FOR FREE LABEL BUFFER #
        END  # WAIT #
 
      LABELBUSY = TRUE;              # RESERVE LABEL BUFFER #
      SENDMSG;                       # SEND M860 MESSAGE #
      IF MBF$SBADDR[0] EQ 0          ##
        AND LLR$DR[0] EQ RESPTYP4"OK4"  # GOOD HARDWARE #
      THEN                           # RESPONSE NOT YET RECEIVED #
        BEGIN  # RETRY #
        RETURN;
        END  # RETRY #
 
      IF LLR$DR[0] EQ RESPTYP4"M86$HDW$PR"  # HARDWARE ERROR #
      THEN                           # LABEL NOT NEEDED #
        BEGIN  # M860 #
        LABELBUSY = FALSE;
        GOTO ACQCART1;
        END  # M860 #
 
      P<UDT$MSG> = MBF$SBADDR[0];
      IF LLR$PRCNME[0] EQ REQTYP4"INITHW"
      THEN                           # LABEL NOT NEEDED #
        BEGIN  # CLEAR #
        LABELBUSY = FALSE;
        END  # CLEAR #
 
      IF MS$ASS$DT[0] EQ 0           # NO LABEL RETURNED #
        OR LAB$ALL[0] EQ 0           # LABEL HAS ALL ZEROES #
      THEN                           # NO LABEL ON CARTRIDGE #
        BEGIN  # NO LABEL #
        LLR$DR[0] = RESPTYP4"UNK$CART";
        ZFILL(LABEL$CART,LABLEN);    # CLEAR LABEL BUFFER #
        LAB$CSNA[0] = MS$CART0[0];   # MOVE CSN TO LABEL #
        LAB$CSNB[0] = MS$CART1A[0];
        LAB$CSN1A[0] = MS$CART1B[0];
        LAB$CSN1B[0] = MS$CART2[0];
        GOTO ACQCART1;
        END  # NO LABEL #
 
      LLR$DR[0] = RESPTYP4"CART$LB$ERR";  # ASSUME SOME OF LABEL GOOD #
      P<HLRQ> = LLR$UCPRA[0];        # LOCATE FAMILY/SUBFAMILY #
      P<TDAM> = LOC(HLR$TDAM[0]);
      IF LAB$CSNA[0] EQ MS$CART0[0]  # HEX CSN #
        AND LAB$CSNB[0] EQ MS$CART1A[0]  ##
        AND LAB$CSN1A[0] EQ MS$CART1B[0]  ##
        AND LAB$CSN1B[0] EQ MS$CART2[0]  ##
        AND ((LAB$CSNT[0] EQ LLR$CSNT[0]  # CYBER CSN #
        AND LAB$FMLY[0] EQ TDAMFAM   # FAMILY #
        AND LAB$SF[0] EQ TDAMSBF     # SUBFAMILY #
        AND LAB$SMID[0] EQ LLR$SMA[0]  # SM ID #
        AND LAB$Y[0] EQ LLR$Y[0]     # LOCATION #
        AND LAB$Z[0] EQ LLR$Z[0])  ##
        OR LLR$PRCNME[0] EQ REQTYP4"INITHW"
        OR LLR$RQI[0] LS REQNAME"RQITEST")  # UCP #
      THEN                           # NORMAL READ-LABEL #
        BEGIN  # OK #
        LLR$DR[0] = RESPTYP4"OK4";
        END  # OK #
 
      IF (LAB$CSNA[0] NQ MS$CART0[0] # HEX CSN #
        OR LAB$CSNB[0] NQ MS$CART1A[0]  ##
        OR LAB$CSN1A[0] NQ MS$CART1B[0]  ##
        OR LAB$CSN1B[0] NQ MS$CART2[0])  ##
        AND ((LAB$CSNT[0] NQ LLR$CSNT[0]  # CYBER CSN #
        AND LAB$FMLY[0] NQ TDAMFAM   # FAMILY #
        AND LAB$SF[0] NQ TDAMSBF     # SUBFAMILY #
        AND LAB$SMID[0] NQ LLR$SMA[0]  # SM ID #
        AND (LAB$Y[0] NQ LLR$Y[0]    # LOCATION #
        OR LAB$Z[0] NQ LLR$Z[0]))  ##
        OR LLR$PRCNME[0] EQ REQTYP4"INITHW"
        OR LLR$RQI[0] LS REQNAME"RQITEST")  # UCP #
      THEN                           # TOTAL LABEL MISMATCH #
        BEGIN  # UNKNOWN #
        LLR$DR[0] = RESPTYP4"UNK$CART";
        END  # UNKNOWN #
 
ACQCART1:
      IF LLR$CSNT[0] NQ 0            # *TDAM* REQUEST #
        AND (LLR$DR[0] EQ RESPTYP4"UNK$CART"  # UNEXPECTED LABEL #
        OR LLR$DR[0] EQ RESPTYP4"CART$LB$ERR")
      THEN                           # EJECT CARTRIDGE #
        BEGIN  # EJECT #
        LLR$Y[0] = SM$EXIT$TY;
        LLR$Z[0] = SM$TY$Z;
        END  # EJECT #
 
      LLR$RS[0] = PROCST"COMPLETE";  # ASSUME REQUEST COMPLETE #
        IF MS$RETCODE[0] EQ HRC$TRAYPR    # INPUT TRAY EMPTY #
        AND NOT LLR$UCPABT[0]        # EXIT IF *SSLABEL* ABORTED #
      THEN                           # RETRY LOAD FROM INPUT TRAY #
        BEGIN  # RETRY #
        LLR$RS[0] = PROCST"INITIAL";
        END  # RETRY #
 
      IF MBF$SBADDR[0] NQ 0
      THEN                           # CLEAR SBT ENTRY #
        BEGIN  # CLEAR #
        P<UDT$MSG> = MBF$SBADDR[0];
        ZFILL(UDT$MSG,MSGLT);
        END  # CLEAR #
 
      MBF$WORD[0] = 0;               # CLEAR MESSAGE STATUS #
      RETURN;
 
ACQCART2:
      MESSAGE(FEMSG,UDFL1);
      ABORT;
      END  # ACQCART #
 
    TERM
PROC BMLOG;
# TITLE BMLOG - SEND MESSAGE TO BML.                                  #
 
      BEGIN  # BMLOG #
 
#
**    BMLOG - SEND MESSAGE TO BML.
*
*     *BMLOG* SENDS ERROR LOG AND BUFFERED LOG MESSAGES TO THE
*     BINARY MAINTENANCE LOG.
*
*     PROC BMLOG
*
*     ENTRY      THE MESSAGE FET BASED ARRAYS POINT TO THE ASSOCIATED
*                CHANNEL THROUGH WHICH THE M860 RESPONSE WAS SENT.
*
*     EXIT       THE M860 RESPONSE HAS BEEN REFORMATTED AND SENT TO
*                THE BML.  THE ASSOCIATED *HLRQ* HAS BEEN UPDATED, IF
*                PROCESSING BUFFERED LOG DATA.
*
*     MESSAGES   *EXEC ABNORMAL, BMLOG2.* - AN ERROR OCCURRED
*                                           WHEN READING THE
*                                           LOG DATA FROM THE
*                                           MESSAGE FET.
*
*                *BUFFERED LOG ERROR.* - AN ERROR OCCURRED
*                                        WHEN READING THE
*                                        DRD BUFFERED LOG.
#
 
 
#
****  PROC BMLOG - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ABORT;                  # ABORT #
        PROC GDATA;                  # GET DATA FROM READ BUFFER #
        PROC MESSAGE;                # ISSUE PREPARED MESSAGE #
        PROC MSG;                    # ISSUE MESSAGE #
        PROC ZFILL;                  # ZERO-FILL BUFFER #
        END
 
#
****  PROC BMLOG - XREF LIST END.
#
 
      DEF BFLLEN     #163#;   # M860 BUF LOG LENGTH #
      DEF BFLLENM1   #162#;   # M860 BUF LOG LENGTH - 1 #
      DEF CUCODE     #O"106"#;       # CU COMPONENT CODE #
      DEF ERLMLEN    #20#;           # ERROR LOG BML MSG LENGTH #
      DEF FORLEN     #23#;           # FORMATTING BUFFER LENGTH #
      DEF MAXBLC     #19#;           # NUMBER OF BUF LOG COUNTERS #
      DEF MAXBLCM1   #18#;           # NUMBER OF BUF LOG COUNTERS - 1 #
      DEF M860WLEN   #32#;           # M860 WORD LENGTH #
      DEF SMCODE     #O"107"#;       # SM COMPONENT CODE #
      DEF USFORNUM   #O"1200"#;      # USAGE FORMAT NUMBER #
 
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
*CALL,COMBFAS
*CALL,COMBFET
*CALL,COMBHFC
*CALL,COMBLRQ
*CALL,COMBUDT
*CALL,COMXHLR
*CALL,COMXMSC
 
      ITEM ASSOCDATA  U;             # ASSOCIATED DATA LENGTH #
      ITEM BUFBIT     U;             # BUF LOG BIT INDEX #
      ITEM BUFWORD    U;             # BUF LOG WORD INDEX #
      ITEM FIRSTBIT    U;        # FIRST BIT OF BUF LOG DRD ENTRY #
      ITEM FIRSTPART  U;             # LENGTH OF 1ST PART M860 WORD #
      ITEM I          I;             # INDEX #
      ITEM J          I;             # INDEX #
      ITEM STAT       U;             # LOG TRANSFER STATUS #
 
#
*     ARRAYS TO SEND BML MESSAGE FROM.
#
 
      ARRAY LOGHDR [0:0] S(1);       # LOG HEADER WORD #
        BEGIN
        ITEM LH$WORD    U(00,00,60);
        ITEM LH$CNT     U(00,00,12); # LOG COUNT #
        END
 
      ARRAY FORBUF [0:0] S(FORLEN);  # FORMATTING BUFFER #
        BEGIN
        ITEM FB$WORD0   U(00,00,60);  # FORMAT BUFFER WORD 0 #
        ITEM FB$DC      U(00,00,12);  # COMPONENT CODE #
        ITEM FB$FNUM    U(00,12,12);  # FORMAT NUMBER #
        ITEM FB$CHAN    U(00,30,06);  # CHANNEL #
        ITEM FB$SMUN    U(00,48,06);  # SM UNIT NUMBER #
        ITEM FB$DRD     U(00,54,06);  # DRD #
 
        ITEM FB$WORD1   U(01,00,60);  # FORMAT BUFFER WORD 1 #
        ITEM FB$ESTO    U(01,00,12);  # EST ORDINAL #
 
        ITEM FB$WORD2   U(02,00,60);  # FORMAT BUFFER WORD 2 #
        ITEM FB$ERLOG   U(02,00,60);  # ERROR LOG DATA FWA #
        ITEM FB$ERLFNUM U(02,00,08);  # ERROR LOG FORMAT NUMBER #
        ITEM FB$Y       U(02,21,05);  # ROW NUMBER #
        ITEM FB$Z       U(02,26,04);  # COLUMN NUMBER #
 
        ITEM FB$WORD3   U(03,00,60);  # FORMAT BUFFER WORD 3 #
        ITEM FB$CSN     C(03,00,10);  # DISPLAY-CODE CSN #
 
        ITEM FB$WORD4   U(04,00,60);  # FORMAT BUFFER WORD 4 #
        ITEM FB$BFLOG   U(04,00,60);  # BUF LOG DATA FWA #
 
        ITEM FB$WORD19  U(19,00,60);  # FORMAT BUFFER WORD 19 #
        ITEM FB$EXCESS  U(19,04,56);  # EXCESS BITS #
        END
 
#
*     ARRAYS TO UNPACK BUFFERED LOG DATA.
#
 
      ARRAY TMPBUF [0:BFLLENM1] S(1);  # FULL BUF LOG #
        BEGIN
        ITEM TBFWORD    U(00,00,60);  # TEMP BUF WORD #
        END
 
      ARRAY TMPBYTE [0:MAXBLCM1] S(1);  # BYTE-REVERSED COUNTERS #
        BEGIN
        ITEM TBYWORD    U(00,00,60);  # TEMP BYTE BUF WORD #
        END
 
      BASED
      ARRAY TMPLOG [0:MAXBLCM1] S(1);  # UNPACKED COUNTERS #
        BEGIN
        ITEM TLGWORD    U(00,00,60);  # BUF LOG WORD #
        END
 
#
*     BASED ARRAYS TO REFERENCE LOG DATA.
#
 
      BASED
      ARRAY BFBYTE [0:0] S(MAXBLC);  # UNPACKED BUF LOG DATA #
        BEGIN
        ITEM BFL$STWR   U(04,00,60);  # STRIPES WRITTEN #
        ITEM BFL$SWRE   U(05,00,60);  # SOFT WRITE ERRORS #
        ITEM BFL$STDM   U(08,00,60);  # STRIPES DEMARKED #
        ITEM BFL$STRD   U(10,00,60);  # STRIPES READ #
        ITEM BFL$SRDE   U(11,00,60);  # SOFT READ ERRORS #
        ITEM BFL$CRLD   U(15,00,60);  # LOAD COUNT #
        ITEM BFL$LDER   U(16,00,60);  # LOAD ERRORS #
        END
 
      BASED
      ARRAY LOGADDR [0:0] S(MAXBLC); ;    # LOG FWA #
                                               CONTROL EJECT;
 
#
*     READ LOG INTO FORMAT BUFFER.
#
 
      ZFILL(FORBUF,FORLEN);          # CLEAR BUFFER #
      LH$WORD[0] = 0;
      ASSOCDATA = ((MS$ASS$DT[0]*2)+14)/15;
      P<LOGADDR> = LOC(FB$ERLOG[0]);  # ASSUME ERROR LOG #
      IF MS$MSG[0] GQ HFC$DBLD0      ##
        AND MS$MSG[0] LQ HFC$DBLD7
      THEN                           # PROCESSING BUFFERED LOG #
        BEGIN  # RESET #
        ZFILL(TMPBUF,BFLLEN);        # CLEAR BUFFERS #
        ZFILL(TMPBYTE,MAXBLC);
        P<LOGADDR> = LOC(TMPBUF);
        END  # RESET #
 
      IF MS$ASS$DT[0] NQ 0
      THEN                           # LOG EXISTS #
        BEGIN  # READ #
        GDATA(FETMRB,LOGADDR,ASSOCDATA,STAT);
        IF STAT NQ 0
        THEN                         # ERROR IN READING LOG #
          BEGIN  # ABORT #
          FE$RTN[0] = "BMLOG2.";
          GOTO BMLOG1;
          END  # ABORT #
 
        END  # READ #
 
#
*     SET HEADER FIELDS COMMON TO BOTH LOGS.
#
 
      FB$CHAN[0] = FMR$CHAN[0];      # CHANNEL #
      FB$ESTO[0] = UD$ESTO[FMR$CU[0]];  # EST ORDINAL #
 
#
*     COMPLETE ERROR LOG MESSAGE HEADER AND SEND TO BML.
#
 
      IF P<LOGADDR> EQ LOC(FB$ERLOG[0])
      THEN                           # PROCESSING ERROR LOG #
        BEGIN  # ERROR LOG #
        FB$DC[0] = CUCODE;           # COMPONENT CODE #
        FB$FNUM[0] = FB$ERLFNUM[0];  # FORMAT NUMBER #
        FB$EXCESS[0] = 0;            # CLEAR EXCESS LOG INFO #
        LH$CNT[0] = ERLMLEN;
        MESSAGE(LOGHDR,BML);         # SEND ERROR LOG TO BML #
        RETURN;
        END  # ERROR LOG #
 
#
*     COMPLETE HEADER FOR BUFFERED LOG BML MESSAGE.
#
 
      IF MS$RETCODE[0] NQ 0
      THEN                           # BUFFERED LOG ERROR #
        BEGIN  # ERROR #
        MSG(" BUFFERED LOG ERROR.",SYSUDF1);
        IF MS$ASS$DT[0] EQ 0
        THEN                         # NO DATA TO PROCESS #
          BEGIN  # EXIT #
          RETURN;
          END  # EXIT #
 
        END  # ERROR #
 
      FB$DC[0] = SMCODE;             # COMPONENT CODE #
      FB$FNUM[0] = USFORNUM;         # FORMAT NUMBER #
      FB$SMUN[0] = SM$SUN[MS$MSQN$CN[0]];  # SM UNIT NUMBER #
      P<LLRQ> = D1$LLADR[MS$MSQN$CN[0]];  # ASSUME LOWER DRD #
      FB$DRD[0] = D1$SUN[MS$MSQN$CN[0]];  # DRD UNIT NUMBER #
      IF MS$MSQN$D0[0]
      THEN                           # UPPER DRD BEING PROCESSED #
        BEGIN  # RESET #
        P<LLRQ> = D0$LLADR[MS$MSQN$CN[0]];
        FB$DRD[0] = D0$SUN[MS$MSQN$CN[0]];  # DRD UNIT NUMBER #
        END  # RESET #
 
      FB$Y[0] = LLR$Y[0];            # LOCATION #
      FB$Z[0] = LLR$Z[0];
      FB$CSN[0] = LLR$CSNT[0];       # DISPLAY-CODE CSN #
 
#
*     UNPACK BUFFERED LOG AND SEND TO BML.
#
 
      FIRSTBIT = M860WLEN * MAXBLC * MS$MSG$D[0];  # SET START #
      BUFWORD = FIRSTBIT/60;
      BUFBIT = FIRSTBIT - (BUFWORD * 60);
      SLOWFOR I = 0 STEP 1 UNTIL MAXBLCM1
      DO                             # UNPACK 32-BIT WORDS #
        BEGIN  # UNPACK #
        FIRSTPART = 60 - BUFBIT;     # PRESET 1ST PART OF SPLIT WORD #
        IF FIRSTPART GR M860WLEN
        THEN                         # 32-BIT WORD NOT DIVIDED #
          BEGIN  # RESET #
          FIRSTPART = M860WLEN;
          END  # RESET #
 
        B<0,FIRSTPART>TBYWORD[I] = B<BUFBIT,FIRSTPART>TBFWORD[BUFWORD];
                                     # MOVE FIRST PART OF WORD #
        IF FIRSTPART LS M860WLEN
        THEN                         # 32-BIT WORD HAS 2 PARTS #
          BEGIN  # SECOND #
          B<FIRSTPART,M860WLEN-FIRSTPART>TBYWORD[I] =
            B<0,M860WLEN-FIRSTPART>TBFWORD[BUFWORD+1];
          END  # SECOND #
 
        BUFBIT = BUFBIT + M860WLEN;  # POSITION TO NEXT WORD #
        IF BUFBIT GQ 60
        THEN                         # NEXT WORD ON 60-BIT BOUNDARY #
          BEGIN  # NEXT #
          BUFBIT = BUFBIT - 60;
          BUFWORD = BUFWORD + 1;
          END  # NEXT #
 
        END  # UNPACK #
 
      P<TMPLOG> = LOC(FB$BFLOG[0]);
      SLOWFOR I = 0 STEP 1 UNTIL MAXBLCM1
      DO                             # REVERSE 8-BIT BYTES #
        BEGIN  # REVERSE #
        SLOWFOR J = 0 STEP 1 UNTIL 3
        DO                           # TRANSFER BYTES #
          BEGIN  # BYTE #
          B<60-M860WLEN+(8*J),8>TLGWORD[I] =
            B<8*(3-J),8>TBYWORD[I];
          END  # BYTE #
 
        END  # REVERSE #
 
      LH$CNT[0] = FORLEN;
      MESSAGE(LOGHDR,BML);           # SEND BUFFERED LOG TO BML #
 
#
*     UPDATE EXEC CARTRIDGE STATISTICS.
#
 
      P<BFBYTE> = LOC(FB$BFLOG[0]);
      P<HLRQ> = LLR$UCPRA[0];
      HLR$STRD[0] = BFL$STRD[0];     # STRIPES READ #
      HLR$STWR[0] = BFL$STWR[0];     # STRIPES WRITTEN #
      HLR$SRDE[0] = BFL$SRDE[0];     # SOFT READ ERRORS #
      HLR$SWRE[0] = BFL$SWRE[0];     # SOFT WRITE ERRORS #
      HLR$STDM[0] = BFL$STDM[0];     # STRIPES DEMARKED #
      HLR$CRLD[0] = BFL$CRLD[0];     # LOAD COUNT #
      HLR$LDER[0] = BFL$LDER[0];     # LOAD ERRORS #
      RETURN;
 
BMLOG1:
      MESSAGE(FEMSG,UDFL1);
      ABORT;
      END  # BMLOG #
 
    TERM
PROC CALLPP((FCODE));
# TITLE CALLPP - ACTIVATE THE PP MODULE *1SS*.                        #
 
      BEGIN  # CALLPP #
 
#
**    CALLPP - ACTIVATE THE PP MODULE *1SS*.
*
*     *CALLPP* SENDS A MESSAGE FROM A UDT MESSAGE BUFFER TO
*     THE M860 HARDWARE, THROUGH A MESSAGE WRITE FET BUFFER.
*     IT CALLS THE PP *1SS* IF IT IS NOT ALREADY ACTIVE ON
*     THE DESIRED CHANNEL.
*
*     PROC CALLPP ((FCODE))
*
*     ENTRY      (FCODE) = PP FUNCTION CODE.
*
*                P<LLRQ> = *DRQUEUE* ENTRY ADDRESS.
*
*                P<UDT$MSG> = UDT/SBT MESSAGE BUFFER ADDRESS.
*
*     EXIT       THE M860 MESSAGE WAS WRITTEN TO THE MESSAGE WRITE
*                FET BUFFER.  IF A PP WAS CALLED, THE ACTIVE PP CALL
*                BLOCK ENTRY COUNT IS INCREMENTED.  IF THE M860 MESSAGE
*                WAS INITIATED BY THE CPU DRIVER, THE CHANNEL MESSAGE
*                COUNT IS INCREMENTED.
*
*     MESSAGES   *EXEC ABNORMAL, CALLPP2.* - EXPECTED FREE CALL
*                                            BLOCK ENTRY NOT FOUND.
*
*                *EXEC ABNORMAL, CALLPP2A.* - TWO DATA TRANSFERS WERE
*                                             TRIED ON THE SAME
*                                             CHANNEL.  ONLY ONE SHOULD
*                                             BE TRIED AT A TIME.
*
*                *EXEC ABNORMAL, CALLPP3.* - TWO RAW DATA READS WERE
*                                            TRIED.  ONLY ONE SHOULD BE
*                                            ACTIVE AT A TIME.
*
*     NOTES      THE M860 MESSAGE IS NOT SENT IF IT REQUIRES THE
*                ACCESSOR ARM AND THE ARM IS BUSY, THE PP CALL BLOCK
*                TABLE IS FULL, OR NO CHANNEL COULD BE ALLOCATED.
#
 
 
#
****  PROC CALLPP - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ABORT;                  # ABORT #
        PROC FSCLOG;                 # DUMP FSC LOG TO BML #
        PROC GETCHAN;                # ALLOCATE CHANNEL #
        PROC MESSAGE;                # ISSUE DAYFILE MESSAGE #
        PROC SMSG;                   # SEND AND CHECKSUM MESSAGE #
        PROC SYSTEM;                 # CALL PP #
        END
 
#
****  PROC CALLPP - XREF LIST END.
#
 
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
*CALL,COMBFAS
*CALL,COMBCDD
*CALL,COMBFET
*CALL,COMBHFC
*CALL,COMBLBL
*CALL,COMBLRQ
*CALL,COMBUDT
*CALL,COMXCTF
*CALL,COMXMSC
 
      ITEM CALLINDEX  U;             # FREE CALL BLOCK ENTRY INDEX #
      ITEM CU         U;             # CONTROLLER ORDINAL #
      ITEM FCODE      U;             # PP FUNCTION CODE PARAMETER #
      ITEM I          I;             # INDEX #
      ITEM RESPCOUNT  U;             # EXPECTED MSG RESPONSE COUNT #
      ITEM STAT       U;             # *SMSG* STATUS #
                                               CONTROL EJECT;
 
      IF SM$ACCBUSY[LLR$SMO[0]]      # SM IN USE #
        AND (((MS$MSG[0] EQ HFC$CHSSMA  # SM STATUS CHANGE #
        OR MS$MSG[0] EQ HFC$CHSDRD)  # DRD STATUS CHANGE #
        AND MS$PARM1A[0] EQ ONLINE)  ##
        OR MS$MSG[0] LQ HFC$STCRNF   # ACQUIRE OR STORE #
        OR MS$MSG[0] EQ HFC$ENCRDR)  # ENTER #
      THEN                           # SM ARM TO BE MOVED #
        BEGIN  # WAIT #
        RETURN;                      # WAIT FOR ARM TO STOP #
        END  # WAIT #
 
#
*     ALLOCATE CHANNEL.
#
 
      GETCHAN(FCODE);
      IF P<FETMWB> EQ 0
      THEN                           # NO CHANNEL ALLOCATED #
        BEGIN  # RETRY #
        RETURN;                      # REALLOCATE LATER #
        END  # RETRY #
 
      IF FMW$AT[0] NQ 0
      THEN                           # LAST MESSAGE CAUSED ERROR #
        BEGIN  # FSC #
        FSCLOG(WFET);                # DUMP FSC LOG TO BML #
        END  # FSC #
 
      CU = LLR$CU[0];                # ASSUME MESSAGE FROM LLRQ #
      IF MS$CU[0] NQ 0
      THEN                           # SENDING ERROR LOG MESSAGE #
        BEGIN  # RESET #
        CU = MS$CU[0];
        END  # RESET #
 
      CALLINDEX = 0;                 # PRESET INDEX #
      IF B<FMR$CIF[0],1>UD$WBACT[CU] EQ OFF
      THEN                           # FREE CHANNEL PICKED #
        BEGIN  # FIND CALL ENTRY #
        IF PPCBENCNT EQ PPCBTSIZE
        THEN                         # NO FREE CALL ENTRY #
          BEGIN  # TRY LATER #
          RETURN;
          END  # TRY LATER #
 
#
*     SEARCH FOR FREE ENTRY IN PP CALL BLOCK TABLE.
#
 
        SLOWFOR I = 1 STEP 1 WHILE (CALLINDEX EQ 0)AND(I LQ PPCBTSIZE)
        DO                           # FIND FREE CALL ENTRY #
          BEGIN  # FIND #
          IF PPU$FC[I] EQ 0
          THEN                       # FREE ENTRY FOUND #
            BEGIN  # FOUND #
            CALLINDEX = I;
            END  # FOUND #
 
          END  # FIND #
 
        IF CALLINDEX EQ 0
        THEN                         # FREE ENTRY NOT FOUND #
          BEGIN  # ABORT #
          FE$RTN[0] = "CALLPP2.";
          GOTO CALLPP2;
          END  # ABORT #
 
        END  # FIND CALL ENTRY #
 
      ELSE                           # CHANNEL PICKED IN USE #
        BEGIN  # IN USE #
        SLOWFOR I = 1 STEP 1 WHILE (CALLINDEX EQ 0)AND(I LQ PPCBTSIZE)
        DO                           # SCAN CALL BLOCK #
          BEGIN  # SCAN #
          IF P<FETMWB> EQ PPU$MBADDR[I]
          THEN                       # PP IN USE FOUND #
            BEGIN  # FOUND #
            CALLINDEX = I;
            END  # FOUND #
 
          END  # SCAN #
 
        END  # IN USE #
 
      IF FCODE EQ IRMDAT
      THEN                           # SENDING DATA #
        BEGIN  # DATA #
        IF PPU$DBADDR[CALLINDEX] NQ 0
        THEN                         # 2 DATA TRANSFERS TO SAME PP #
          BEGIN  # ABORT #
          FE$RTN[0] = "CALLPP2A.";
          GOTO CALLPP2;
          END  # ABORT #
 
        PPU$DBADDR[CALLINDEX] = LLR$MSFET[0];  # PASS DATA BUF ADDR #
        GOTO CALLPP1;
        END  # DATA #
 
#
*     COPY MESSAGE FROM UDT/STORAGE BUFFER TO MESSAGE WRITE BUFFER.
#
 
      RESPCOUNT = 1;                 # ASSUME NORMAL MESSAGE #
      IF MS$MSG[0] GQ HFC$MVLMVR     ##
        AND MS$MSG[0] LQ HFC$MVLMNW
      THEN                           # *MOUNT-VOLUME* MESSAGE #
        BEGIN  # CIF #
        B<3-FMR$CIF[0],1>MS$INTER[0] = ON;  # SWITCH BIT ORDER #
        B<FMR$CIF[0],1>UD$DBACT[LLR$CU[0]] = ON;
        RESPCOUNT = 2;               # INCLUDE REWIND/UNLOAD #
        END  # CIF #
 
      MS$CU[0] = 0;                  # IN CASE ERROR LOG MESSAGE #
      IF MS$MSG[0] NQ HFC$WRTLBL
      THEN                           # NOT A *WRITE-LABEL* MESSAGE #
        BEGIN  # NOT WRITE #
        SMSG(FETMWB,UDT$MSG,0,0,STAT);
        END  # NOT WRITE #
 
      ELSE                           # SEND *WRITE-LABEL* MESSAGE #
        BEGIN  # WRLABEL #
        SMSG(FETMWB,UDT$MSG,LABEL$CART,LABLEN,STAT);
        END  # WRLABEL #
 
      IF STAT NQ 0
      THEN                           # MESSAGE WRITE BUFFER FULL #
        BEGIN  # FREE CHANNEL #
        IF MS$MSG[0] GQ (HRF$ELGFUL + HRF$R)   # ERROR LOG MESSAGE #
          AND MS$MSG[0] LQ (HRF$REQDMP + HRF$R)
        THEN                         # INDICATE RESPONSE NOT SENT #
          BEGIN  # RESTORE #
          MS$CU[0] = CU;
          END  # RESTORE #
 
        RETURN;                      # TRY LATER #
        END  # FREE CHANNEL #
 
      IF MS$MSG[0] EQ HFC$RDRAW
      THEN                           # READING RAW DATA #
        BEGIN  # RAW #
        IF FMR$RDBA[0] NQ 0          # READING 2 RAW STRIPES #
        THEN                         # SHOULD BE ONLY ONE #
          BEGIN  # ABORT #
          FE$RTN[0] = "CALLPP3.";
          GOTO CALLPP2;
          END  # ABORT #
 
        P<FETFHB> = LLR$MSFET[0];
        FMR$RDBA[0] = FHB$FRST[0] + MSGLT;  # SET RAW DATA ADDRESS #
        END  # RAW #
 
      IF MS$MSG[0] LQ HFC$STCRNF     # ACQUIRE OR STORE #
        OR MS$MSG[0] EQ HFC$ENCRDR   # ENTER #
        OR ((MS$MSG[0] EQ HFC$CHSSMA # SM STATUS CHANGE #
        OR MS$MSG[0] EQ HFC$CHSDRD)  # DRD STATUS CHANGE #
        AND MS$PARM1A[0] EQ ONLINE)
      THEN                           # RESERVE SM ARM #
        BEGIN  # SM #
        SM$ACCBUSY[LLR$SMO[0]] = TRUE;
        END  # SM #
 
      IF MS$MSG[0] LS (HRF$ELGFUL + HRF$R)     # NOT ERROR LOG MSG #
        OR MS$MSG[0] GR (HRF$REQDMP + HRF$R)
      THEN                           # LLRQ SENT MESSAGE #
        BEGIN  # LLRQ #
        MBF$SENT[0] = TRUE;          # MESSAGE SENT TO PP #
        LLR$CIF[0] = FMR$CIF[0];
        END  # LLRQ #
 
#
*     DO NOT INCREMENT MESSAGE COUNT IF NO M860 RESPONSE EXPECTED.
#
 
      IF NOT MS$MSG$R[0]
      THEN                           # DRIVER-INITIATED MESSAGE #
        BEGIN  # ADD #
        MSGCNT(FMR$CIF[0],LLR$CU[0]) = MSGCNT(FMR$CIF[0],LLR$CU[0])
                                         + RESPCOUNT;
                                     # UPDATE CHANNEL MSG COUNT #
        END  # ADD #
 
#
*     PRESET PP CALL BLOCK TABLE ENTRY, IF NO PP IS ACTIVE ON
*     THE CHOSEN CHANNEL.
#
 
CALLPP1:
      IF B<FMR$CIF[0],1>UD$WBACT[CU] EQ OFF
      THEN                           # FREE CHANNEL #
        BEGIN  # CALL PP #
        PPCBENCNT = PPCBENCNT + 1;   # CREATE NEW ENTRY #
        B<FMR$CIF[0],1>UD$WBACT[CU] = ON;
        PPU$MBADDR[CALLINDEX] = P<FETMWB>;
        PPU$FC[CALLINDEX] = FCODE;
        PPU$ACTIVE[CALLINDEX] = TRUE;
        PPU$ESTORD[CALLINDEX] = UD$ESTO[CU];
        PPU$CNTORD[CALLINDEX] = CU;
        PPT$WORD0[0] = PPU$WORD0[CALLINDEX];  # PRESET FOR PP CALL #
        SPC$ADDR[0] = LOC(PPT$WORD0[0]);
        REPEAT WHILE PPT$WORD0[0] NQ 0
        DO                           # ISSUE PP CALL #
          BEGIN  # PP #
          SYSTEM(SPC,NRCL);
          END  # PP #
 
        END  # CALL PP #
 
      DRVRACTIVE = TRUE;
      RETURN;
 
CALLPP2:
      MESSAGE(FEMSG,UDFL1);
      ABORT;
      END  # CALLPP #
 
    TERM
PROC CRMSG;
# TITLE CRMSG - CREATE M860 MESSAGE.                                  #
 
      BEGIN  # CRMSG #
 
#
**    CRMSG - CREATE M860 MESSAGE.
*
*     *CRMSG* CREATES AN M860 MESSAGE WITHIN A UDT MESSAGE BUFFER.
*
*     PROC CRMSG
*
*     ENTRY      P<LLRQ> = *DRQUEUE* ENTRY ADDRESS.
*
*                P<UDT$MSG> = UDT MESSAGE BUFFER ADDRESS.
*
*                THE UDT MESSAGE BUFFER CONTAINS THE M860 FUNCTION
*                DEFINING THE MESSAGE TO BE CREATED.
*
*     EXIT       IF THE M860 FUNCTION WAS A PATH/DEVICE STATUS CHANGE
*                OR A *START ERROR LOG*, AND THE UDT HAS BEEN
*                COMPLETELY PROCESSED, THEN THE UDT MESSAGE BUFFER
*                ACTIVE FLAG IS LEFT CLEAR, AND NO MESSAGE IS CREATED.
*                OTHERWISE, AN M860 MESSAGE IS CREATED, AND THE ACTIVE
*                FLAG IS SET.
*
*     MESSAGES   *EXEC ABNORMAL, CRMSG1.* - UDT MESSAGE BUFFER STILL
*                                           IN USE, OR MESSAGE
*                                           SEQUENCE NUMBER IS CLEARED.
*
*                *EXEC ABNORMAL, CRMSG1A.* - MULTIPLE REQUESTS ARE
*                                            PROCESSING SERVICE CELLS
*                                            WHEN TURNING ON A DRD.
*
*                *EXEC ABNORMAL, CRMSG4.* - MULTIPLE REQUESTS ARE
*                                           PROCESSING SERVICE CELLS
*                                           WHEN TURNING ON AN SM.
*
*                *EXEC ABNORMAL, CRMSG5.* - INVALID SUBTYPE FOR A
*                                           *START ERROR LOG* FUNCTION.
*
*     NOTES      A UDT MESSAGE BUFFER IS NEVER CLEARED, EXCEPT WHEN
*                PREPARING TO CREATE ANOTHER MESSAGE IN IT.  THIS IS
*                DONE TO KEEP AN ACCURATE HISTORY FOR DEBUGGING
*                PURPOSES.
#
 
 
#
****  PROC CRMSG - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ABORT;                  # ABORT #
        PROC GETCHAN;                # ALLOCATE CHANNEL #
        PROC MESSAGE;                # ISSUE DAYFILE MESSAGE #
        PROC PDATE;                  # GET PACKED DATE AND TIME #
        PROC ZFILL;                  # ZERO-FILL BUFFER #
        END
 
#
****  PROC CRMSG - XREF LIST END.
#
 
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
*CALL,COMBFAS
*CALL,COMBCDD
*CALL,COMBCPR
*CALL,COMBFET
*CALL,COMBHFC
*CALL,COMBLBL
*CALL,COMBLRQ
*CALL,COMBUDT
*CALL,COMXCTF
*CALL,COMXMSC
 
#
*     DEFINITIONS TO CREATE *CHANGE STATUS* MESSAGES.
#
 
      DEF CIFMASK    #X"0000"#;      # TURN OFF *CIF* ERROR LOGGING #
      DEF CONTDAV    #1#;            # CONTROLLER DEVICE ADDR VALUE #
      DEF DRDHNMASK  #X"8190"#;      # SET DRD/HANDLER ERROR LOGGING #
      DEF EOTBSC     #1#;            # EOT BUFFER STRIPE COUNT #
      DEF FIELDSM1   #7#;            # COUNT OF 6-BIT FIELDS MINUS 1 #
 
      ITEM DRDWORD    U;             # SAVED DRD STATUS WORD ADDRESS #
      ITEM FOUND      B;             # SET IF PATH/DEVICE FOUND #
      ITEM I          I;             # INDEX #
      ITEM J          I;             # INDEX #
      ITEM MSGFTN     U;             # SAVED M860 FUNCTION #
      ITEM MSGSEQN    U;             # SAVED MSG SEQUENCE NUMBER #
      ITEM NEWPTHSTAT U;             # NEW PATH STATUS #
      ITEM START      U;             # 1ST LINE TO CHECK ACK BITS #
      ITEM TEMPCIF    U;             # SAVED *CIF* NUMBER #
      ITEM TEMPCSN0   U;             # FIRST 4 BYTES OF CSN #
      ITEM TEMPCSN1   U;             # NEXT 6 BYTES OF CSN #
      ITEM TEMPCSN2   U;             # LAST 2 BYTES OF CSN #
      ITEM TEMPDRD    U;             # SAVED *DRD* UNIT NUMBER #
 
#
*     ARRAY USED TO CREATE *SET DATE/TIME* MESSAGES.
#
 
      ARRAY DATETIME [0:0] S(1);     # PACKED DATE AND TIME #
        BEGIN
        ITEM DT$YEAR    U(00,24,06);  # YEAR MINUS 1970 #
        ITEM DT$MONTH   U(00,30,06);  # MONTH #
        ITEM DT$DAY     U(00,36,06);  # DAY #
        ITEM DT$HOUR    U(00,42,06);  # HOUR #
        ITEM DT$MINUTE  U(00,48,06);  # MINUTE #
        ITEM DT$SECOND  U(00,54,06);  # SECOND #
        END
 
#
*     ARRAYS USED TO CREATE *CHANGE STATUS* MESSAGES.
#
 
      ARRAY PTH [0:6] S(1);          # UDT PATH STRUCTURE #
        BEGIN
        ITEM PTH$LASTLN U(00,06,06) = [6,,10,,3,4,2];
        ITEM PTH$FRSTLN U(00,12,06) = [5,,7,,3,4,1];
        END
 
      ARRAY BNODE [3:6] S(1);        # BOTTOM PATH NODES #
        BEGIN
        ITEM NODE$B     U(00,00,60);  # PATH WORD #
        ITEM NODE$B0    U(00,00,06) = [0,0,1,1];
        ITEM NODE$B1    U(00,06,06) = [1,1,3,3];
        ITEM NODE$B2    U(00,12,06) = [2,0,0,0];
        ITEM NODE$B3    U(00,18,06) = [3,1,2,2];
        ITEM NODE$B4    U(00,24,06) = [0,0,1,1];
        ITEM NODE$B5    U(00,30,06) = [1,1,3,3];
        ITEM NODE$B6    U(00,36,06) = [2,0,0,0];
        ITEM NODE$B7    U(00,42,06) = [3,1,2,2];
        END
 
      ARRAY TNODE [1:10] S(1);        # TOP PATH NODES #
        BEGIN
        ITEM NODE$T     U(00,00,60);  # PATH WORD #
        ITEM NODE$T0    U(00,00,06) = [0,1,0,1,0,2,0,1,2,3];
        ITEM NODE$T1    U(00,06,06) = [0,1,0,1,0,2,0,1,2,3];
        ITEM NODE$T2    U(00,12,06) = [0,1,0,3,0,2,0,1,2,3];
        ITEM NODE$T3    U(00,18,06) = [0,1,0,3,0,2,0,1,2,3];
        ITEM NODE$T4    U(00,24,06) = [0,1,1,0,1,3,0,1,2,3];
        ITEM NODE$T5    U(00,30,06) = [0,1,1,0,1,3,0,1,2,3];
        ITEM NODE$T6    U(00,36,06) = [0,1,1,2,1,3,0,1,2,3];
        ITEM NODE$T7    U(00,42,06) = [0,1,1,2,1,3,0,1,2,3];
        END
 
      SWITCH M860FUNCTN              # M860 FUNCTION CODES #
        ,                            # RESERVED #
        ACQUIRECRT,                  # ACQUIRE CARTRIDGE #
        STORECRT,                    # STORE CARTRIDGE #
        ,                            # RESERVED #
        READCRTLBL,                  # READ CARTRIDGE LABEL #
        WRTLBLCRT,                   # WRITE CARTRIDGE LABEL #
        MNTVOLUME,                   # MOUNT VOLUME #
        WRTLBLVOL,                   # WRITE VOLUME LABEL #
        ENTERCRT,                    # ENTER CARTRIDGE #
        ,                            # RESERVED #
        ,                            # RESERVED #
        CHANGEPATH,                  # CHANGE PATH STATUS #
        DUMPBUFLOG,                  # DUMP BUFFERED LOG #
        ,                            # RESERVED #
        SETDATTIME,                  # SET DATE/TIME #
        ,                            # RESERVED #
        SETMASCHAN,                  # SET MASTER CHANNEL #
        RDRAWSTRP,                   # READ RAW STRIPE #
        ,                            # RESERVED #
        STERRLOG,                    # START/STOP ERROR LOG #
        ,                            # RESERVED #
        ,                            # RESERVED #
        SETERRLEN,                   # SET ERROR LOG LENGTH #
        ,                            # RESERVED #
        ,                            # RESERVED #
        ,                            # RESERVED #
        ,                            # RESERVED #
        ,                            # RESERVED #
        RESTARTCU;                   # RESTART CONTROLLER #
                                               CONTROL EJECT;
 
      IF MBF$SBADDR[0] NQ 0          ##
        OR MS$MSQN[0] EQ 0
      THEN                           # MESSAGE ERROR #
        BEGIN  # ABORT #
        FE$RTN[0] = "CRMSG1.";
        MESSAGE(FEMSG,UDFL1);
        ABORT;
        END  # ABORT #
 
      IF MS$MSG[0] NQ HFC$CHSSMA     # HANDLED LATER #
        AND MS$MSG[0] NQ HFC$CHSDRD
      THEN                           # INDICATE DRIVER ACTIVITY #
        BEGIN  # ACTIVE #
        DRVRACTIVE = TRUE;
        END  # ACTIVE #
 
      IF MBF$SAVE[0] NQ SAVENONE
      THEN                           # PRESERVE PART OF MSG BUFFER #
        BEGIN  # PRESET NORMALLY #
        MBF$ACTIVE[0] = TRUE;        # MESSAGE BUFFER NOW ACTIVE #
        MSGSEQN = MS$MSQN[0];        # SAVE MSG SEQUENCE NUMBER #
        MSGFTN = MS$MSG[0];          # SAVE M860 FUNCTION #
        IF MBF$SAVE[0] EQ SAVEMOST
        THEN                         # SAVE CSN AND DRD #
          BEGIN  # SAVE #
          TEMPCSN0 = MS$CART0[0];
          TEMPCSN1 = MS$CART1[0];
          TEMPCSN2 = MS$CART2[0];
          TEMPDRD = MS$DRDN[0];
          END  # SAVE #
 
        ZFILL(UDT$MSG,MSGLT);        # CLEAR MESSAGE BUFFER #
        MS$MSG[0] = MSGFTN;
        MS$MSQN[0] = MSGSEQN;
        IF MBF$SAVE[0] EQ SAVEMOST
        THEN                         # RESTORE CSN AND DRD #
          BEGIN  # RESTORE #
          MS$CART0[0] = TEMPCSN0;
          MS$CART1[0] = TEMPCSN1;
          MS$CART2[0] = TEMPCSN2;
          MS$DRDN[0] = TEMPDRD;
          END  # RESTORE #
 
        END  # PRESET NORMALLY #
 
      GOTO M860FUNCTN[MS$MSG$M[0]];
 
#
*     CREATE *LOAD CARTRIDGE* MESSAGE.
#
 
ACQUIRECRT:
      MS$YADD[0] = LLR$Y[0];         # SET COORDINATES #
      MS$ZADD[0] = LLR$Z[0];
      MS$CART0[0] = O"31160552100";  # ** *IBM * EBCDIC #
      SLOWFOR I = 0 STEP 1 UNTIL FIELDSM1
      DO                             # CONVERT CSN TO EBCDIC #
        BEGIN  # CONVERT #
        IF I LQ 5                    ##
        THEN                         # BYTES 1 THRU 6 #
          BEGIN  # I LQ 5 #
          B<I*8,8>MS$CART1[0] = X"F0" LOR B<I*6,6>LLR$CSND[0] - O"33";
          END  # I LQ 5 #
 
        ELSE                         # BYTES 7 AND 8 #
          BEGIN  # I GR 5 #
          B<(I-6)*8,8>MS$CART2[0] = X"F0" LOR
                                    B<I*6,6>LLR$CSND[0] - O"33";
          END  # I GR 5 #
 
        END  # CONVERT #
 
      GOTO ENTERCRT;                 # SET DRD AND LOCATION #
      RETURN;
 
#
*     CREATE *CHANGE DRD STATUS* MESSAGE.
#
 
CHANGEDRD:
      FOUND = FALSE;
      UD$DRDWAIT[LLR$CU[0]] = FALSE; # ASSUME CHANGING DRD-S EMPTY #
      SLOWFOR I = 0 STEP 1 WHILE I LQ MAX$DRD AND NOT FOUND
      DO                             # SEARCH FOR DRD CHANGING STATUS #
        BEGIN  # SEARCH #
        SMO = B<I*6,6>UD$SMORDS[LLR$CU[0]];
        IF SMO EQ 0                  ##
          OR NOT SM$EXIST[SMO]
        THEN                         # SM NOT FOUND #
          BEGIN  # RETRY #
          TEST I;
          END  # RETRY #
 
        DRST = DRST1;                # ASSUME 2ND CU #
        IF LLR$CU[0] EQ SM$CUO0[SMO]
        THEN                         # 1ST CU CHANGING DRD STATUS #
          BEGIN  # RESET #
          DRST = DRST0;
          END  # RESET #
 
        DRDWORD = LOC(D1$ST[SMO]);   # CHECK LOWER DRD FIRST #
        SLOWFOR J = 1 STEP 1 WHILE J LQ MAX$SMDRD AND NOT FOUND
        DO                           # CHECK BOTH DRD-S OF ELIGIBLE SM #
          BEGIN  # DRD-S #
          P<PTHSTAT> = DRDWORD;      # CHECK NEXT DRD #
          IF PATHBIT(DRST,PATH$DF"U$EXISTS") EQ ON  ##
            AND PATHBIT(DRST,PATH$DF"U$DONE") EQ OFF  # NOT CHECKED #
            AND (UD$CNUP[LLR$CU[0]]  # IGNORE ACK BITS IF SET #
            OR PATHBIT(DRST,PATH$DF"U$CU$ACK") EQ ON  # ON/OFF STATUS #
            OR PATHBIT(DRST,PATH$DF"U$DIAG$ACK") EQ ON)  # DIAG STATUS #
          THEN                       # DRD CHANGING STATUS #
            BEGIN  # CHANGING #
            IF (P<PTHSTAT> EQ LOC(D0$ST[SMO]) AND D0$FULL[SMO]  ##
              AND P<LLRQ> NQ D0$LLADR[SMO])  # OTHER DRD COULD GO OFF #
              OR (P<PTHSTAT> EQ LOC(D1$ST[SMO]) AND D1$FULL[SMO]  ##
              AND P<LLRQ> NQ D1$LLADR[SMO])
            THEN                     # CHOSEN DRD STILL FULL #
              BEGIN  # SKIP #
              UD$DRDWAIT[LLR$CU[0]] = TRUE;  # HAVE LLRQ RETRY #
              DRDWORD = LOC(D0$ST[SMO]);  # IN CASE AT DRD 1 #
              TEST J;
              END  # SKIP #
 
            PATHBIT(DRST,PATH$DF"U$DONE") = ON;
            IF P<PTHSTAT> EQ LOC(D0$ST[SMO])
            THEN                     # UPPER DRD PROCESSED #
              BEGIN  # DRD 0 #
              D0$DONE[SMO] = TRUE;
              END  # DRD 0 #
 
            ELSE                     # LOWER DRD PROCESSED #
              BEGIN  # DRD 1 #
              D1$DONE[SMO] = TRUE;
              END  # DRD 1 #
 
            FOUND = TRUE;
            TEST J;
            END  # CHANGING #
 
          DRDWORD = LOC(D0$ST[SMO]); # CHECK UPPER DRD NEXT #
          END  # DRD-S #
 
        END  # SEARCH #
 
      IF NOT FOUND
      THEN                           # NO DRD LEFT TO PROCESS #
        BEGIN  # EXIT #
        IF UD$DRDWAIT[LLR$CU[0]]
        THEN                         # STILL WAITING FOR DRD TO EMPTY #
          BEGIN  # WAIT #
          RETURN;
          END  # WAIT #
 
        DRVRACTIVE = TRUE;           # SO DRD ERROR SENDS K-DISPLAY #
        SLOWFOR I = 0 STEP 1 UNTIL MAX$DRD
        DO                           # CLEAR DRD DONE FLAGS #
          BEGIN  # CLEAR #
          SMO = B<I*6,6>UD$SMORDS[LLR$CU[0]];
          IF SMO EQ 0                ##
            OR NOT SM$EXIST[SMO]     # NO SM #
          THEN                       # TRY NEXT ORDINAL #
            BEGIN  # NEXT #
            TEST I;
            END  # NEXT #
 
          DRST = DRST1;              # ASSUME 2ND CU #
          IF LLR$CU[0] EQ SM$CUO0[SMO]
          THEN                       # 1ST CU PROCESSED DRD #
            BEGIN  # RESET #
            DRST = DRST0;
            END  # RESET #
 
          P<PTHSTAT> = LOC(D0$ST[SMO]);  # CLEAR DRD 0 FLAG #
          PATHBIT(DRST,PATH$DF"U$DONE") = OFF;
          GOTO CRMSGA;
 
CRMSGA:##
          D0$FLAG[SMO] = B<12,6>D0$WD0[SMO] LOR B<18,6>D0$WD0[SMO];
          GOTO CRMSGB;
 
CRMSGB:##
          P<PTHSTAT> = LOC(D1$ST[SMO]);  # CLEAR DRD 1 FLAG #
          PATHBIT(DRST,PATH$DF"U$DONE") = OFF;
          GOTO CRMSGC;
 
CRMSGC:##
          D1$FLAG[SMO] = B<12,6>D1$WD0[SMO] LOR B<18,6>D1$WD0[SMO];
          END  # CLEAR #
 
        RETURN;
        END  # EXIT #
 
      DRVRACTIVE = TRUE;             # INDICATE DRIVER ACTIVITY #
      UD$LLRQA[LLR$CU[0]] = P<LLRQ>; # STORE LLRQ ADDRESS #
      MBF$ACTIVE[0] = TRUE;
      MSGSEQN = MS$MSQN$CN[0];       # PRESET MESSAGE BUFFER #
      MSGFTN = MS$MSG[0];
      ZFILL(UDT$MSG,MSGLT);
      MS$MSQN$CN[0] = MSGSEQN;
      MS$MSG[0] = MSGFTN;
      MS$DRDN[0] = D1$SUN[SMO];      # ASSUME LOWER DRD #
      LLR$DRD[0] = 1;
      IF P<PTHSTAT> EQ LOC(D0$ST[SMO])
      THEN                           # UPPER DRD BEING CHANGED #
        BEGIN  # RESET #
        MS$DRDN[0] = D0$SUN[SMO];
        LLR$DRD[0] = 0;
        END  # RESET #
 
      IF PATHBIT(DRST,PATH$DF"U$ON") EQ 1  ##
        AND (UD$CNUP[LLR$CU[0]]      ##
        OR PATHBIT(DRST,PATH$DF"U$CU$ACK") EQ 1)
      THEN                           # DRD GOING ONLINE #
        BEGIN  # ON #
        PATHBIT(DRST,PATH$DF"U$CU$ACK") = 1;  # IN CASE CU RESTARTING #
        MS$PARM1A[0] = ONLINE;
        IF SM$SCCU[SMO]
        THEN                         # 2 REQUESTS CHECKING SRV CELLS #
          BEGIN  # ABORT #
          FE$RTN[0] = "CRMSG1A.";
          MESSAGE(FEMSG,UDFL1);
          ABORT;
          END  # ABORT #
 
        SM$SCCU[SMO] = TRUE;         # CHECK SERVICE CELLS #
        END  # ON #
 
      IF PATHBIT(DRST,PATH$DF"U$ON") EQ OFF  ##
        AND PATHBIT(DRST,PATH$DF"U$RQ$DIAG") EQ OFF
      THEN                           # DRD GOING OFFLINE #
        BEGIN  # OFF #
        MS$PARM1A[0] = OFFLINE;
        END  # OFF #
 
      IF PATHBIT(DRST,PATH$DF"U$RQ$DIAG") EQ 1  ##
        AND (UD$CNUP[LLR$CU[0]]      ##
        OR PATHBIT(DRST,PATH$DF"U$DIAG$ACK") EQ 1)
      THEN                           # DRD GOING INTO DIAGNOSTIC MODE #
        BEGIN  # DIAG #
        MS$PARM1A[0] = DIAGNOSTIC;
        END  # DIAG #
 
      LLR$SMO[0] = SMO;              # SAVE SM ORDINAL #
      RETURN;
 
#
*     CREATE *CHANGE PATH STATUS* MESSAGE.
#
 
CHANGEPATH:
      IF MS$MSG[0] EQ HFC$CHSSMA
      THEN                           # CHANGE SM STATUS #
        BEGIN  # SM #
        GOTO CHANGESM;
        END  # SM #
 
      IF MS$MSG[0] EQ HFC$CHSDRD
      THEN                           # CHANGE DRD STATUS #
        BEGIN  # DRD #
        GOTO CHANGEDRD;
        END  # DRD #
 
      ACKLINE = 0;                   # PRESET ACK BIT LOCATION IN UDT #
      ACKINDEX = 0;
      START = PTH$FRSTLN[MS$MSG$S[0]];  # PRESET FIRST LINE OF SEARCH #
      FOUND = FALSE;
 
#
*     SEARCH FOR ACKNOWLEDGE BITS SET FOR THE DESIRED PATH.
#
 
      SLOWFOR I = START STEP 1 UNTIL PTH$LASTLN[MS$MSG$S[0]]
      DO                             # SCAN UDT PATH WORDS #
        BEGIN  # SCAN WORDS #
        IF NOT FOUND
        THEN                         # CONTINUE WORD SCAN #
          BEGIN  # CHECK WORD #
          P<PTHSTAT> = P<UDT$CN> + ((LLR$CU[0]-1) * UDTCNTL) + I;
          SLOWFOR J = 0 STEP 1 UNTIL FIELDSM1
          DO                         # SCAN UDT PATH ACK BITS #
            BEGIN  # SCAN BITS #
            IF NOT FOUND
            THEN                     # CONTINUE BIT SCAN #
              BEGIN  # CHECK BITS #
              IF PATHBIT(J,PATH$DF"U$EXISTS") EQ ON  ##
                AND PATHBIT(J,PATH$DF"U$DONE") EQ OFF
              THEN                   # PATH EXISTS AND NOT PROCESSED #
                BEGIN  # SEND MSG #
                IF PATHBIT(J,PATH$DF"U$ON") EQ ON  ##
                  AND (UD$CNUP[LLR$CU[0]]  ##
                  OR PATHBIT(J,PATH$DF"U$CU$ACK") EQ ON)
                THEN                 # SEND ON MSG #
                  BEGIN  # ONLINE #
                  PATHBIT(J,PATH$DF"U$CU$ACK") = ON;  # SET ON ACK #
                  PATHBIT(J,PATH$DF"U$DONE") = ON;  # IGNORE CU CNUP #
                  NEWPTHSTAT = ONLINE;
                  FOUND = TRUE;
                  ACKLINE = I;       # SAVE LOCATION #
                  ACKINDEX = J;
                  END  # ONLINE #
 
                  IF PATHBIT(J,PATH$DF"U$ON") EQ OFF
                  THEN               # PATH IS OFF #
                    BEGIN  # OFF #
                    IF UD$CNUP[LLR$CU[0]]
                    THEN             # CONTROLLER RESTARTING #
                      BEGIN  # CLEAR #
                      PATHBIT(J,PATH$DF"U$CU$ACK") = OFF;
                      END  # CLEAR #
 
                    IF PATHBIT(J,PATH$DF"U$CU$ACK") EQ ON
                    THEN             # SEND OFF MSG #
                      BEGIN  # OFFLINE #
                      PATHBIT(J,PATH$DF"U$DONE") = ON;  # IGNORE CNUP #
                      NEWPTHSTAT = OFFLINE;
                      FOUND = TRUE;
                      ACKLINE = I;   # SAVE LOCATION #
                      ACKINDEX = J;
                      END  # OFFLINE #
 
                    END  # OFF #
 
                END  # SEND MSG #
 
              END  # CHECK BITS #
 
            END  # SCAN BITS #
 
          END  # CHECK WORD #
 
        END # SCAN WORDS #
 
      IF NOT FOUND
      THEN                           # ALL STATUS CHANGES COMPLETED #
        BEGIN  # EXIT #
        SLOWFOR I = START STEP 1 UNTIL PTH$LASTLN[MS$MSG$S[0]]
        DO                           # SCAN UDT PATH WORDS #
          BEGIN  # SCAN #
          P<PTHSTAT> = P<UDT$CN> + ((LLR$CU[0]-1) * UDTCNTL) + I;
          SLOWFOR J = 0 STEP 1 UNTIL FIELDSM1
          DO                         # CLEAR PATH-PROCESSED BITS #
            BEGIN  # CLEAR #
            PATHBIT(J,PATH$DF"U$DONE") = OFF;
            END  # CLEAR #
 
          END  # SCAN #
 
        RETURN;                      # LEAVE MSG BUF FLAG CLEAR #
        END  # EXIT #
 
#
*     STORE PATH INFORMATION INTO MESSAGE BUFFER.
#
 
      MSGSEQN = MS$MSQN$CN[0];       # PRESET MESSAGE BUFFER #
      MSGFTN = MS$MSG[0];
      ZFILL(UDT$MSG,MSGLT);
      MS$MSQN$CN[0] = MSGSEQN;
      MS$MSG[0] = MSGFTN;
      MS$PARM1A[0] = NEWPTHSTAT;     # SET NEW PATH STATUS #
      MS$PATH[0] = B<ACKINDEX*6,6>NODE$B[ACKLINE];  # ASSUME PATH #
      IF MS$MSG[0] EQ HFC$CHSAIF
      THEN                           # SET SM UNIT NUMBER #
        BEGIN  # RESET #
        MS$PATH[0] = SM$SUN[B<ACKINDEX*6,6>UD$SMORDS[LLR$CU[0]]];
        END  # RESET #
 
      IF MS$MSG[0] EQ HFC$CHSDRC
      THEN                           # SET DRD UNIT NUMBER #
        BEGIN  # RESET #
        MS$PATH[0] = ACKINDEX;
        IF P<PTHSTAT> GQ LOC(UD$DRCP2[LLR$CU[0]])
        THEN                         # 2ND DRD GROUP BEING ACCESSED #
          BEGIN  # 2ND #
          MS$PATH[0] = ACKINDEX + 8;
          END  # 2ND #
 
        END  # RESET #
 
      MS$DRDN[0] = B<ACKINDEX*6,6>NODE$T[ACKLINE];
      MBF$ACTIVE[0] = TRUE;          # SET MSG BUFFER ACTIVE #
      UD$LLRQA[LLR$CU[0]] = P<LLRQ>; # STORE LLRQ ADDRESS #
      LLR$ACKIN[0] = ACKINDEX;       # STORE UDT ACK LOCATION #
      LLR$ACKLN[0] = ACKLINE;
      RETURN;
 
#
*     CREATE *CHANGE SM STATUS* MESSAGE.
#
 
CHANGESM:
      UD$DRDWAIT[LLR$CU[0]] = FALSE; # ASSUME CHANGING SM-S EMPTY #
      SLOWFOR I = 0 STEP 1 UNTIL MAX$DRD
      DO                             # SEARCH FOR SM CHANGING STATUS #
        BEGIN  # SEARCH #
        SMO = B<I*6,6>UD$SMORDS[LLR$CU[0]];
        IF SMO EQ 0
        THEN                         # NO SM #
          BEGIN  # NEXT #
          TEST I;
          END  # NEXT #
 
        P<PTHSTAT> = LOC(SM$STS[SMO]);
        SMST = SMST1;                # ASSUME 2ND CU #
        IF LLR$CU[0] EQ SM$CUO0[SMO]
        THEN                         # 1ST CU CHANGING SM #
          BEGIN  # RESET #
          SMST = SMST0;
          END  # RESET #
 
        IF PATHBIT(SMST,PATH$DF"U$DONE") EQ ON
        THEN                         # SM ALREADY PROCESSED #
          BEGIN  # NEXT #
          TEST I;
          END  # NEXT #
 
        IF UD$CNUP[LLR$CU[0]]        # CURESTART IN PROGRESS #
          AND PATHBIT(SMST,PATH$DF"U$ON") EQ OFF  ##
          AND PATHBIT(SMST,PATH$DF"U$RQ$DIAG") EQ OFF
        THEN                         # ON/OFF ACK BIT MAY BE SET #
          BEGIN  # CLEAR #
          PATHBIT(SMST,PATH$DF"U$CU$ACK") = OFF;  # SM ALREADY OFF #
          PATHBIT(SMST,PATH$DF"U$DIAG$ACK") = OFF;
          END  # CLEAR #
 
        IF SM$EXIST[SMO]             ##
          AND (PATHBIT(SMST,PATH$DF"U$CU$ACK") EQ 1  ##
          OR PATHBIT(SMST,PATH$DF"U$DIAG$ACK") EQ 1  ##
          OR UD$CNUP[LLR$CU[0]])
        THEN                         # SM STATUS CHANGING #
          BEGIN  # CLEAR #
          IF D0$FULL[SMO] OR D1$FULL[SMO]
          THEN                       # WAIT FOR SM TO EMPTY #
            BEGIN  # SKIP #
            UD$DRDWAIT[LLR$CU[0]] = TRUE;  # HAVE LLRQ RETRY #
            TEST I;
            END  # SKIP #
 
          GOTO CHANGESM1;            # PROCESS SM #
          END  # CLEAR #
 
        END  # SEARCH #
 
      IF UD$DRDWAIT[LLR$CU[0]]
      THEN                           # STILL WAITING FOR SM TO EMPTY #
        BEGIN  # RETRY #
        RETURN;
        END  # RETRY #
 
      DRVRACTIVE = TRUE;             # KEEP UDT SCAN CONTINUING #
      SLOWFOR I = 0 STEP 1 UNTIL MAX$DRD
      DO                             # CLEAR *SM-PROCESSED* FLAGS #
        BEGIN  # SCAN #
        SMO = B<I*6,6>UD$SMORDS[LLR$CU[0]];
        IF SMO NQ 0                  ##
          AND SM$EXIST[SMO]
        THEN                         # SM EXISTS #
          BEGIN  # CLEAR #
          SMST = SMST1;              # ASSUME 2ND CU #
          IF LLR$CU[0] EQ SM$CUO0[SMO]
          THEN                       # 1ST CU PROCESSED SM #
            BEGIN  # RESET #
            SMST = SMST0;
            END  # RESET #
 
          P<PTHSTAT> = LOC(SM$STS[SMO]);
          PATHBIT(SMST,PATH$DF"U$DONE") = OFF;  # CLEAR SM DONE FLAG #
          GOTO CRMSGF;
 
CRMSGF:##
          SM$FLAG[SMO] = SM$STS0[SMO] LOR SM$STS1[SMO];# RESET GLOBALS #
          END  # CLEAR #
 
        END  # SCAN #
 
      RETURN;                        # ALL SM-S ON THIS CU PROCESSED #
 
#
*     PRESET SM ORDINAL IF VARYING SM ONLINE.
#
 
CHANGESM1:
      PATHBIT(SMST,PATH$DF"U$DONE") = ON;  # SM BEING PROCESSED #
      GOTO CRMSGD;
 
CRMSGD:##
      SM$FLAG[SMO] = SM$STS0[SMO] LOR SM$STS1[SMO];  # RESET GLOBALS #
      GOTO CRMSGE;
 
CRMSGE:##
      IF PATHBIT(SMST,PATH$DF"U$ON") EQ 1  ##
        AND (PATHBIT(SMST,PATH$DF"U$CU$ACK") EQ 1  ##
        OR UD$CNUP[LLR$CU[0]])
      THEN                           # SM TURNING ON #
        BEGIN  # PRESET #
        IF NOT INITIALIZE
        THEN                         # CHECK SERVICE CELLS #
          BEGIN  # SERV #
          IF SM$SCCU[SMO]
          THEN                       # 2 REQUESTS CHECKING SRV CELLS #
            BEGIN  # ABORT #
            FE$RTN[0] = "CRMSG4.";
            MESSAGE(FEMSG,UDFL1);
            ABORT;
            END  # ABORT #
 
          SM$SCCU[SMO] = TRUE;
          END  # SERV #
 
        PATHBIT(SMST,PATH$DF"U$CU$ACK") = 1;  # IN CASE CU RESTARTING #
        SM$TOPDRD[SMO] = FALSE;      # USE LOWER DRD FIRST #
        END  # PRESET #
 
      DRVRACTIVE = TRUE;             # INDICATE DRIVER ACTIVITY #
      MBF$ACTIVE[0] = TRUE;
      UD$LLRQA[LLR$CU[0]] = P<LLRQ>; # STORE LLRQ ADDRESS #
      MSGSEQN = MS$MSQN$CN[0];       # PRESET MESSAGE BUFFER #
      MSGFTN = MS$MSG[0];
      ZFILL(UDT$MSG,MSGLT);
      MS$MSQN$CN[0] = MSGSEQN;
      MS$MSG[0] = MSGFTN;
      MS$DRDN[0] = SM$SUN[SMO];      # SET SM UNIT NUMBER #
      MS$PARM1A[0] = ONLINE;         # ASSUME VARYING SM ONLINE #
      IF PATHBIT(SMST,PATH$DF"U$RQ$DIAG") EQ OFF  ##
        AND PATHBIT(SMST,PATH$DF"U$ON") EQ OFF
      THEN                           # SET SM OFFLINE #
        BEGIN  # OFF #
        MS$PARM1A[0] = OFFLINE;
        END  # OFF #
 
      IF PATHBIT(SMST,PATH$DF"U$RQ$DIAG") EQ 1  ##
        AND (UD$CNUP[LLR$CU[0]]      ##
        OR PATHBIT(SMST,PATH$DF"U$DIAG$ACK") EQ 1)
      THEN                           # SET SM DIAGNOSTIC MODE #
        BEGIN  # DIAGNOSTIC #
        MS$PARM1A[0] = DIAGNOSTIC;
        END  # DIAGNOSTIC #
 
      LLR$SMO[0] = SMO;              # SAVE SM ORDINAL #
      RETURN;
 
#
*     CREATE *DUMP BUFFERED LOG* MESSAGE.
#
 
DUMPBUFLOG:
      MS$MSG$D[0] = D1$SUN[LLR$SMO[0]];  # ASSUME LOWER DRD #
      IF LLR$DRD[0] EQ 0
      THEN                           # UPPER DRD BEING USED #
        BEGIN  # RESET #
        MS$MSG$D[0] = D0$SUN[LLR$SMO[0]];
        END  # RESET #
 
      RETURN;
 
#
*     CREATE *ENTER CARTRIDGE* MESSAGE.
#
 
ENTERCRT:
      MS$DRDN[0] = D1$SUN[LLR$SMO[0]];  # ASSUME LOWER DRD #
      IF SM$TOPDRD[LLR$SMO[0]]
      THEN                           # LOAD TO UPPER DRD #
        BEGIN  # RESET #
        MS$DRDN[0] = D0$SUN[LLR$SMO[0]];
        END  # RESET #
 
      RETURN;
 
#
*     CREATE *MOUNT VOLUME* MESSAGE.
#
 
MNTVOLUME:
      MS$DEV$NB[0] = MS$DRDN[0];     # DEVICE NUMBER #
      MS$PARM2[0] = EOTBSC;          # EOT BUFFER STRIPE COUNT #
      MS$STPL[0] = LLR$ST$LW[0];     # STRIPE LOW #
      MS$STPH[0] = LLR$ST$HI[0];     # STRIPE HIGH #
      MS$PARM1A[0] = LLR$ST$HI[0];   # LAST STRIPE WRITTEN, IF STAGE #
      IF LLR$PRCNME[0] EQ REQTYP4"CPY$DA"
      THEN                           # DATA BEING DESTAGED #
        BEGIN  # RESET #
        MS$MSG[0] = HFC$MVLMVW;      # MOUNT WRITE-ENABLED VOLUME #
        MS$PARM1A[0] = LLR$LT$ST[0]; # USE VALUE FROM WRITE-VOLUME #
        END  # RESET #
 
      MS$CONT[0] = CONTDAV;          # ASSUME 8 DRD-S OR LESS #
      RETURN;
 
#
*     CREATE *READ RAW STRIPE* MESSAGE.
#
 
RDRAWSTRP:
      MS$STPL[0] = LLR$ST$LW[0];     # SET RAW STRIPE TO READ #
      RETURN;
 
#
*     CREATE *READ CARTRIDGE LABEL* MESSAGE.
#
 
READCRTLBL:
      RETURN;                        # NO NEW MSG PARAMETERS NEEDED #
 
#
*     CREATE *RESTART* MESSAGE.
#
 
RESTARTCU:
      UD$LLRQA[LLR$CU[0]] = P<LLRQ>; # STORE LLRQ ADDRESS #
      RETURN;                        # NO MESSAGE PARAMETERS REQUIRED #
 
#
*     CREATE *SET DATE/TIME* MESSAGE.
#
 
SETDATTIME:
      PDATE(DATETIME);               # GET CURRENT DATE AND TIME #
      IF (DT$YEAR[0] LS 30)
      THEN                               # IF YEAR PRIOR TO 2000 #
        BEGIN
        MS$PARM1[0] = DT$YEAR[0] + 70;   # DATE PLUS 70 TO BUFFER #
        END
      ELSE                               # YEAR AFTER 1999 #
        BEGIN
        MS$PARM1[0] = DT$YEAR[0] - 30;   # DATE MINUS 30 TO BUFFER #
        END
      MS$PARM1A3[0] = DT$MONTH[0];
      MS$PARM1A4[0] = DT$DAY[0];
      MS$PARM21[0] = DT$HOUR[0];
      MS$PARM22[0] = DT$MINUTE[0];
      MS$PARM23[0] = DT$SECOND[0];
      RETURN;
 
#
*     CREATE *SET ERROR LOG LENGTH* MESSAGE.
#
 
SETERRLEN:
      MS$PARM1A[0] = DEF$ERLEN;      # SET DEFAULT LENGTH #
      RETURN;
 
#
*     CREATE *SET MASTER CHANNEL* MESSAGE.
#
 
SETMASCHAN:
      GETCHAN(IRPMSG);               # ALLOCATE MASTER CHANNEL #
      IF P<FETMWB> EQ 0
      THEN                           # NO AVAILABLE CHANNEL ON CU #
        BEGIN  # DOWN #
        LLR$DR[0] = RESPTYP4"M86$HDW$PR";  # INFORM OPERATOR #
        RETURN;
        END  # DOWN #
 
      MBF$ACTIVE[0] = TRUE;
      MSGSEQN = MS$MSQN$CN[0];       # PRESET MESSAGE BUFFER #
      MSGFTN = MS$MSG[0];
      ZFILL(UDT$MSG,MSGLT);
      MS$MSQN$CN[0] = MSGSEQN;
      MS$MSG[0] = MSGFTN;
      MS$DRDN[0] = FMR$CIF[0];
      B<FMR$CIF[0],1>UD$MASCPOS[LLR$CU[0]] = ON;  # SET MASTER CHAN #
      UD$MASC[LLR$CU[0]] = FMR$CHAN[0];  # SET MASTER CHANNEL IN UDT #
      UD$MASCIF[LLR$CU[0]] = FMR$CIF[0];  # SET MASTER CHANNEL CIF #
      RETURN;
 
#
*     CREATE *START ERROR LOG* MESSAGE.
#
 
STERRLOG:
      IF MS$MSG[0] EQ HFC$STERLG
      THEN                           # *START ERROR LOG - CIF* MSG #
        BEGIN  # *CIF* #
        CHT$WORD[0] = UD$CHANA[LLR$CU[0]];  # PRESET CHANNEL TABLE #
        CHT$WORD[1] = UD$CHANB[LLR$CU[0]];
        CHT$WORD[2] = UD$CHANC[LLR$CU[0]];
        CHT$WORD[3] = UD$CHAND[LLR$CU[0]];
        SLOWFOR I = MS$DRDN[0] STEP 1 UNTIL MAX$CIF
        DO                           # SEARCH FOR ON *CIF* #
          BEGIN  # SEARCH #
          IF CHT$ON[I]
          THEN                       # *CIF* IS ON #
            BEGIN  # ON #
            TEMPCIF = I;             # SAVE *CIF* NUMBER #
            GOTO STERRLOG1;
            END  # ON #
 
          END  # SEARCH #
 
        RETURN;                      # ALL *CIF* MESSAGES SENT #
 
STERRLOG1:
        MBF$ACTIVE[0] = TRUE;
        MSGFTN = MS$MSG[0];          # PRESET MESSAGE BUFFER #
        MSGSEQN = MS$MSQN$CN[0];
        ZFILL(UDT$MSG,MSGLT);
        MS$MSQN$CN[0] = MSGSEQN;
        MS$MSG[0] = MSGFTN;
        MS$PARM1A[0] = CIFMASK;      # TURN OFF *CIF* ERROR LOGGING #
        MS$DRDN[0] = TEMPCIF;
        RETURN;
        END  # *CIF* #
 
      IF MS$MSG[0] EQ HFC$STERDR
      THEN                           # *START ERROR LOG - DRD* MSG #
        BEGIN  # DRD #
        SLOWFOR I = 0 STEP 1 UNTIL MAX$DRD
        DO                           # SEARCH FOR DRD #
          BEGIN  # SEARCH #
          SMO = B<I*6,6>UD$SMORDS[LLR$CU[0]];
          IF SMO NQ 0
          THEN                       # VALID SM ORDINAL #
            BEGIN  # CHECK BIT #
            IF LLR$CU[0] EQ SM$CUO0[SMO]
            THEN                     # CHECKING 1ST CU #
              BEGIN  # CU 0 #
              IF NOT D0$LOG0[SMO]
              THEN                   # SET DRD 0 LEVEL #
                BEGIN  # LOG #
                D0$LOG0[SMO] = TRUE;
                TEMPDRD = D0$SUN[SMO];
                GOTO STERRLOG2;
                END  # LOG #
 
              IF NOT D1$LOG0[SMO]
              THEN                   # SET DRD 1 LEVEL #
                BEGIN  # LOG #
                D1$LOG0[SMO] = TRUE;
                TEMPDRD = D1$SUN[SMO];
                GOTO STERRLOG2;
                END  # LOG #
 
              END  # CU 0 #
 
            IF LLR$CU[0] EQ SM$CUO1[SMO]
            THEN                     # CHECKING 2ND CU #
              BEGIN  # CU 1 #
              IF NOT D0$LOG1[SMO]
              THEN                   # SET DRD 0 LEVEL #
                BEGIN  # LOG #
                D0$LOG1[SMO] = TRUE;
                TEMPDRD = D0$SUN[SMO];
                GOTO STERRLOG2;
                END  # LOG #
 
              IF NOT D1$LOG1[SMO]
              THEN                   # SET DRD 1 LEVEL #
                BEGIN  # LOG #
                D1$LOG1[SMO] = TRUE;
                TEMPDRD = D1$SUN[SMO];
                GOTO STERRLOG2;
                END  # LOG #
 
              END  # CU 1 #
 
            END  # CHECK BIT #
 
          END  # SEARCH #
 
        SLOWFOR I = 0 STEP 1 UNTIL MAX$DRD
        DO                           # SCAN SM-S #
          BEGIN  # SCAN #
          SMO = B<I*6,6>UD$SMORDS[LLR$CU[0]];
          IF SMO NQ 0
          THEN                       # VALID ORDINAL #
            BEGIN  # CLEAR BITS #
            IF LLR$CU[0] EQ SM$CUO0[SMO]
            THEN                     # CLEARING 1ST CU BITS #
              BEGIN  # CLEAR #
              D0$LOG0[SMO] = FALSE;
              D1$LOG0[SMO] = FALSE;
              END  # CLEAR #
 
            IF LLR$CU[0] EQ SM$CUO1[SMO]
            THEN                     # CLEARING 2ND CU BITS #
              BEGIN  # CLEAR #
              D0$LOG1[SMO] = FALSE;
              D1$LOG1[SMO] = FALSE;
              END  # CLEAR #
 
            END  # CLEAR BITS #
 
          END  # SCAN #
 
        RETURN;                      # ALL DRD MESSAGES SENT #
 
STERRLOG2:
        MBF$ACTIVE[0] = TRUE;
        MSGFTN = MS$MSG[0];          # PRESET MESSAGE BUFFER #
        MSGSEQN = MS$MSQN$CN[0];
        ZFILL(UDT$MSG,MSGLT);
        MS$MSQN$CN[0] = MSGSEQN;
        MS$MSG[0] = MSGFTN;
        MS$DRDN[0] = TEMPDRD;        # SET DRD ERROR LOG LEVEL #
        MS$PARM1A[0] = DRDHNMASK;
        RETURN;
        END  # DRD #
 
      IF MS$MSG[0] EQ HFC$STERSH     ##
        OR MS$MSG[0] EQ HFC$STERST
      THEN                           # *START ERROR LOG - HLR* MSG #
        BEGIN  # STRIPE/SMT #
        MS$PARM1A[0] = DRDHNMASK;    # SET HANDLER ERROR LOG LEVEL #
        END  # STRIPE/SMT #
 
      ELSE                           # FUNCTION NOT FOUND #
        BEGIN  # ABORT #
        FE$RTN[0] = "CRMSG5.";
        MESSAGE(FEMSG,UDFL1);
        ABORT;
        END  # ABORT #
 
      RETURN;
 
#
*     CREATE *STORE CARTRIDGE* MESSAGE.
#
 
STORECRT:
      MS$YADD[0] = LLR$Y[0];
      MS$ZADD[0] = LLR$Z[0];
      IF MS$MSG[0] EQ HFC$STCRNF     # FORCED STORE #
      THEN                           # SET DRD UNIT NUMBER TO VERIFY #
        BEGIN  # UNIT #
        MS$CONT[0] = CONTDAV;        # ASSUME 8 DRD-S OR LESS #
        MS$DEV$NB[0] = MS$DRDN[0];
        END  # UNIT #
 
      RETURN;
 
#
*     CREATE *WRITE CARTRIDGE/VOLUME LABEL* MESSAGE.
#
 
WRTLBLCRT:
WRTLBLVOL:
      IF MS$MSG[0] EQ HFC$WRTLBL
      THEN                           # WRITING CARTRIDGE LABEL #
        BEGIN  # CART #
        MS$ASS$DT[0] = LABLENB;      # SET ASSOCIATED DATA COUNT #
        END  # CART #
 
      ELSE                           # WRITING VOLUME LABEL #
        BEGIN  # VOLUME #
        MS$STPL[0] = LLR$ST$LW[0];   # SET STRIPES LOW AND HIGH #
        MS$STPH[0] = LLR$ST$HI[0];
        END  # VOLUME #
 
      RETURN;
      END  # CRMSG #
 
    TERM
PROC CHNGCHN;
# TITLE CHNGCHN - CHANGE CHANNEL STATUS.                              #
 
      BEGIN  # CHNGCHN #
 
#
**    CHNGCHN - CHANGE CHANNEL STATUS.
*
*     *CHNGCHN* CHANGES THE STATUS OF AN M860 CONTROLLER CHANNEL.
*
*     PROC CHNGCHN
*
*     ENTRY      P<LLRQ> = *DRQUEUE* ENTRY ADDRESS.
*
*                THE MESSAGE FET BASED ARRAYS POINT TO THE CHANNEL
*                TURNING OFF.
*
*     EXIT       A K-DISPLAY MESSAGE IS ISSUED INDICATING THE CHANNEL
                 WAS TURNED OFF.  THE CHANNEL STATUS IS CHANGED IN
*                THE UDT AND IN THE ASSOCIATED MESSAGE WRITE FET.
#
 
 
#
****  PROC CHNGCHN - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC KREQ;                   # SEND K-DISPLAY REQUEST #
        PROC MESSAGE;                # ISSUE DAYFILE MESSAGE #
        PROC RTIME;                  # GET TIME SINCE DEADSTART #
        END
 
#
****  PROC CHNGCHN - XREF LIST END.
#
 
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
*CALL,COMBFAS
*CALL,COMBCDD
*CALL,COMBFET
*CALL,COMBKDD
*CALL,COMBUDT
 
      ITEM I          I;             # INDEX #
                                               CONTROL EJECT;
 
      IF NOT FMW$CHON[0]
      THEN                           # CHANNEL ALREADY DOWN #
        BEGIN  # EXIT #
        RETURN;                      # K-DISPLAY MSG ALREADY SENT #
        END  # EXIT #
 
#
*     DECIDE IF RETRY COUNT AND TIME JUSTIFY TURNING CHANNEL OFF.
#
 
      FMW$RCNT[0] = FMW$RCNT[0] + 1;  # BUMP RETRY COUNT #
      FMW$ERROR[0] = TRUE;           # DO NOT RECOUNT AS DRD ERROR #
      RTIME(RTIMESTAT);
      IF (FMW$RCNT[0] EQ 1           # START OF ERROR SEQUENCE #
        AND FMW$RCNT[0] LS MAXCHERR)  ##
        OR (FMW$RCNT[0] GR 1         # RETRY TIME EXPIRED #
        AND RTIMSECS[0] GQ FMW$RTIME[0])
      THEN                           # RESET CHAN FOR NEW INTERVAL #
        BEGIN  # RESET #
        FMW$RCNT[0] = 1;             # IN CASE INTERVAL EXPIRED #
        FMW$RTIME[0] = RTIMSECS[0] + MAXCHERRTM;  # RESET RETRY TIME #
        END  # RESET #
 
      IF (FMW$RCNT[0] GR 1           ##
        AND FMW$RCNT[0] GQ MAXCHERR  ##
        AND RTIMSECS[0] GQ FMW$RTIME[0])  # ERROR SEQUENCE EXPIRED #
        OR FMW$RCNT[0] LS MAXCHERR   # SEQUENCE NOT COMPLETE #
      THEN                           # NOT READY TO TURN OFF CHANNEL #
        BEGIN  # ON #
        IF FMW$AT[0] NQ 0
        THEN                         # ERROR IN WRITING MESSAGE #
          BEGIN  # WRITE #
          FMW$CMPL[0] = FALSE;       # RESTART CHANNEL #
          END  # WRITE #
 
        RETURN;                      # LEAVE CHANNEL ON #
        END  # ON #
 
      FMW$CHON[0] = FALSE;           # DRIVER DOWNED CHANNEL #
      UDT$CHNS$O[0] = TRUE;          # ASSUME ALL CHANNELS OFF #
      SLOWFOR I = 1 STEP 1 UNTIL MAXCTN
      DO                             # CHECK IF ALL CHANNELS OFF #
        BEGIN  # CHECK #
        IF UD$CHANA$O[I]             ##
          OR UD$CHANB$O[I]           ##
          OR UD$CHANC$O[I]           ##
          OR UD$CHAND$O[I]
        THEN                         # AT LEAST ONE CHANNEL IS ON #
          BEGIN  # RESET #
          UDT$CHNS$O[0] = FALSE;
          END  # RESET #
 
        END  # CHECK #
 
      IF UDT$CHNS$O[0]
      THEN                           # NO CHANNELS LEFT ON #
        BEGIN  # SHIFT #
        MESSAGE(" ALL CHANNELS OFF.",SYSUDF1);
        UDT$CUS$O[0] = FALSE;        # ISSUE NEW FLASHING MESSAGE #
        END  # SHIFT #
 
      IF FMW$AT[0] EQ RCCIFO         ##
        OR FMR$AT[0] EQ RCCIFO
      THEN                           # CIF OFFLINE #
        BEGIN  # EXIT #
        RETURN;                      # K-DISPLAY MSG ALREADY SENT #
        END  # EXIT #
 
      P<KWORD> = LOC(FMR$KWORDS[0]);
      KW$WORD[0] = 0;
      KW$LINE1[0] = KM"KM1";         # PRESET MESSAGE ORDINALS #
      KW$LINE2[0] = KM"KM14";
      KW$LINE3[0] = KM"KM13";
      KW$RPGO[0] = TRUE;             # ALLOW GO RESPONSE #
      KW$IC[0] = TRUE;               # SET IMMEDIATE COMPLETION #
      KW$DF[0] = TRUE;               # ISSUE TO JOB DAYFILE #
      KP$EQ = UD$ESTO[FMR$CU[0]];    # PRESET MESSAGE PARAMETERS #
      KP$CN = FMR$CHAN[0];
      KREQ(LOC(KWORD),KLINK);        # SEND K-DISPLAY REQUEST #
      RETURN;
      END  # DOWNCHN #
 
    TERM
PROC DOWNCU((CO));
# TITLE DOWNCU - DOWN CONTROLLER.                                     #
 
      BEGIN  # DOWNCU #
 
#
**    DOWNCU - DOWN CONTROLLER.
*
*     *DOWNCU* PROCESSES M860 CONTROLLER TERMINATION.
*
*     PROC DOWNCU((CO))
*
*     ENTRY      (CO) = UDT ORDINAL OF CONTROLLER TO BE TURNED OFF.
*
*                THE MESSAGE FET BASED ARRAYS POINT TO THE
*                CHANNEL ON WHICH THE ERROR WAS DETECTED.
*
*     EXIT       A DAYFILE MESSAGE AND A K-DISPLAY MESSAGE ARE
*                ISSUED INDICATING THE CONTROLLER IS OFF.
#
 
 
#
****  PROC DOWNCU - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC KREQ;                   # SEND K-DISPLAY REQUEST #
        PROC MESSAGE;                # ISSUE DAYFILE MESSAGE #
        FUNC XCOD C(10);             # CONVERT OCTAL TO DISPLAY-CODE #
        END
 
#
****  PROC DOWNCU - XREF LIST END.
#
 
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
*CALL,COMBFAS
*CALL,COMBCDD
*CALL,COMBFET
*CALL,COMBHFC
*CALL,COMBKDD
*CALL,COMBUDT
*CALL,COMBLRQ
*CALL,COMXCTF
 
      ITEM CO         U;             # PASSED CU ORDINAL #
      ITEM CORD       U;             # TEMPORARY CU ORDINAL #
      ITEM I          I;             # INDEX #
                                               CONTROL EJECT;
 
#
*     SEND DAYFILE MESSAGE INDICATING THAT THE CONTROLLER IS OFF.
#
 
      CORD = XCOD(UD$ESTO[CO]);      # SET EST ORDINAL #
      CU$ORD[0] = C<6,4>CORD;
      CU$STAT[0] = CUOFF;
      MESSAGE(CUMSG,SYSUDF1);        # SEND DAYFILE MESSAGE #
 
#
*     RESET CONTROLLER STATUS FLAGS.
#
 
      IF UD$CNUP[CO] AND UD$CUON[CO]
      THEN                           # CU WAS INITIALIZING #
        BEGIN  # RESET #
        UD$CNUP[CO] = FALSE;         # STOP CU FROM INITIALIZING #
        CURESERVED = FALSE;          # ALLOW OTHER CU-S TO INITIALIZE #
        END  # RESET #
 
#
*     SEND K-DISPLAY MESSAGE TO OPERATOR.
#
 
      UD$CUON[CO] = FALSE;           # TURN OFF CONTROLLER #
      UDT$CUS$O[0] = TRUE;           # ASSUME ALL CONTROLLERS OFF #
      SLOWFOR I = 1 STEP 1 UNTIL MAXCTN
      DO                             # CHECK IF ALL CONTROLLERS OFF #
        BEGIN  # CHECK #
        IF UD$CUON[CO]
        THEN                         # AT LEAST ONE CU IS ON #
          BEGIN  # RESET #
          UDT$CUS$O[0] = FALSE;
          END  # RESET #
 
        END  # CHECK #
 
      IF UDT$CUS$O[0]
      THEN                           # NO CONTROLLERS LEFT ON #
        BEGIN  # SHIFT #
        MESSAGE(" ALL CONTROLLERS OFF.",SYSUDF1);
        UDT$CHNS$O[0] = FALSE;       # ISSUE NEW FLASHING MESSAGE #
        END  # SHIFT #
 
      IF FMW$AT[0] EQ RCIMPL         # CU NEEDS IMPL #
        OR FMR$AT[0] EQ RCIMPL
      THEN                           # K-DISPLAY MSG ALREADY MADE #
        BEGIN  # EXIT #
        RETURN;
        END  # EXIT #
 
      P<KWORD> = LOC(LLR$KWORDS[0]);
      KW$WORD[0] = 0;
      KW$LINE1[0] = KM"KM1";         # SET MESSAGE ORDINALS #
      KW$LINE2[0] = KM"KM15";        # DEVICE DRIVER ERROR FOUND #
      IF MS$MSG[0] GQ HFC$CHSCIF     # STATUS CHANGE #
        AND MS$MSG[0] LQ HFC$CHSAIF  ##
        AND MS$MSG[0] NQ HFC$CHSDRD  # NOT SM OR DRD #
        AND MS$MSG[0] NQ HFC$CHSSMA  ##
        AND MS$PARM1A[0] EQ ONLINE
      THEN                           # INDICATE PATH NOT VARIED ONLINE #
        BEGIN  # OFF #
        KW$LINE2[0] = KM"KM10";
        END  # OFF #
 
      IF MS$MSG[0] EQ HFC$SETMAS
      THEN                           # NO CHANNEL ALLOCATED #
        BEGIN  # CHANNEL #
        KW$LINE2[0] = KM"KM22";
        END  # CHANNEL #
 
      KW$LINE3[0] = KM"KM16";
      IF P<FETMWB> EQ 0
      THEN                           # NO CHANNEL ALLOCATED #
        BEGIN  # NONE #
        KW$LINE1[0] = KM"KM23";
        END  # NONE #
 
      KW$RPGO[0] = TRUE;             # ALLOW GO RESPONSE #
      KW$IC[0] = TRUE;               # SET IMMEDIATE COMPLETION #
      KW$DF[0] = TRUE;               # SEND TO JOB DAYFILE #
      KP$EQ = UD$ESTO[CO];
      KP$CN = FMR$CHAN[0];
      KREQ(LOC(KWORD),KLINK);        # SEND K-DISPLAY REQUEST #
      END  # DOWNCU #
 
    TERM
PROC FSCLOG((FETTYPE));
# TITLE FSCLOG - LOG FSC ERRORS IN BML.                               #
 
      BEGIN  # FSCLOG #
 
#
**    FSCLOG - LOG FSC ERRORS IN BML.
*
*     *FSCLOG* SENDS FSC ERROR MESSAGES TO THE BINARY MAINTENANCE LOG.
*
*     PROC FSCLOG((FETTYPE))
*
*     ENTRY      (FETTYPE) = TYPE OF FET WHICH HAD THE ERROR.
*
*                P<FETFHB> = DATA FET ADDRESS, IF IT HAD THE ERROR.
*
*                THE MESSAGE FET BASED ARRAYS POINT TO THE CHANNEL ON
*                WHICH THE ERROR OCCURRED.
*
*     EXIT       THE ERROR HAS BEEN FORMATTED AND LOGGED IN THE BML.
*                IF IT OCCURRED IN A MESSAGE FET AND WAS A HARDWARE
*                ERROR TYPE, THEN THE CHANNEL WAS ALSO TURNED OFF.
#
 
 
#
****  PROC FSCLOG - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC CHNGCHN;                # DOWN BAD CHANNEL #
        PROC DOWNCU;                 # DOWN BAD CONTROLLER #
        PROC KREQ;                   # SEND K-DISPLAY REQUEST #
        PROC MESSAGE;                # ISSUE BML MESSAGE #
        PROC ZFILL;                  # ZERO-FILL BUFFER #
        END
 
#
****  PROC FSCLOG - XREF LIST END.
#
 
      DEF FBLEN      #10#;           # FSC FORMAT BUFFER LENGTH #
      DEF FSCCODE    #O"105"#;       # FSC COMPONENT CODE #
      DEF NOUNIT     #O"77"#;        # NO UNIT NUMBER AVAILABLE #
      DEF PMSGLT     #9#;            # PACKED M860 MESSAGE LENGTH #
 
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
*CALL,COMBFAS
*CALL,COMBCDD
*CALL,COMBFET
*CALL,COMBKDD
*CALL,COMBUDT
*CALL,COMXCTF
 
      ITEM ASSOCDATA  U;             # LENGTH OF ASSOCIATED DATA #
      ITEM FETTYPE    U;             # FET TYPE HAVING ERROR #
      ITEM SAVEDMSG   U;             # SAVED MSG BUF LOCATION #
      ITEM TEMPOUT    U;             # TEMPORARY FET *OUT* POINTER #
 
#
*     ARRAYS FOR FORMATTING FSC BML MESSAGE.
#
 
      ARRAY FSCCNT [0:0] S(1);       # FSC COUNT WORD #
        BEGIN
        ITEM FC$WORD    U(00,00,60);
        ITEM FC$CNT     U(00,00,12) = [FBLEN];  # FSC COUNT #
        END
 
      ARRAY FSCBUF [0:0] S(FBLEN);   # FSC LOG FORMATTING BUFFER #
        BEGIN
        ITEM FS$DC      U(00,00,12); # COMPONENT CODE #
        ITEM FS$ET      U(00,12,12); # PP ERROR TYPE #
        ITEM FS$CHAN    U(00,30,06); # CHANNEL #
        ITEM FS$SMUN    U(00,48,06); # SM UNIT NUMBER #
        ITEM FS$DRDUN   U(00,54,06); # DRD UNIT NUMBER #
        ITEM FS$ESTO    U(01,00,12); # EST ORDINAL #
        ITEM FS$FSC     C(04,00,50); # FSC STATUS WORDS #
        END
                                               CONTROL EJECT;
 
      ZFILL(FSCBUF,FBLEN);           # PRESET FORMAT BUFFER #
 
#
*     PROCESS DATA FET ERROR.
#
 
      IF FETTYPE EQ DFET
      THEN                           # ACCESS DATA FET #
        BEGIN  # DATA #
        FS$ET[0] = FHB$AT[0];        # ERROR TYPE #
        P<FETMRB> = FHB$RBADDR[0];
        FS$CHAN[0] = FMR$CHAN[0];
        FS$SMUN[0] = FHB$SMUN[0];    # SM/DRD UNIT NUMBERS #
        FS$DRDUN[0] = FHB$UNIT[0];
        IF FS$ET[0] GQ RCHWET
        THEN                         # ERROR INCLUDES FSC LOG #
          BEGIN  # LOG #
          FS$FSC[0] = FHB$FSC[0];    # FSC STATUS #
          END  # LOG #
 
        FHB$AT[0] = 0;               # MARK ERROR AS PROCESSED #
        END  # DATA #
 
#
*     SEND K-DISPLAY MESSAGE IF CIF IS OFFLINE
*     OR AN OPERATOR *IMPL* IS REQUIRED.
#
 
      IF FETTYPE EQ RFET
      THEN                           # READ FET ERROR #
        BEGIN  # RESET #
        FS$ET[0] = FMR$AT[0];
        END  # RESET #
 
      IF FETTYPE EQ WFET
      THEN                           # WRITE FET ERROR #
        BEGIN  # RESET #
        FS$ET[0] = FMW$AT[0];
        END  # RESET #
 
      IF FS$ET[0] EQ RCCIFO          # CIF OFFLINE #
        OR FS$ET[0] EQ RCIMPL        # IMPL REQUIRED #
      THEN                           # K-DISPLAY MESSAGE NECESSARY #
        BEGIN  # K #
        P<KWORD> = LOC(FMR$KWORDS[0]);
        KW$WORD[0] = 0;
        KW$LINE1[0] = KM"KM23";      # ASSUME IMPL REQUIRED #
        KW$LINE2[0] = KM"KM25";
        KW$LINE3[0] = KM"KM16";
        KP$EQ = UD$ESTO[FMR$CU[0]];
        IF FS$ET[0] EQ RCCIFO
        THEN                         # RESET PARAMETERS #
          BEGIN  # RESET #
          KW$LINE1[0] = KM"KM1";
          KW$LINE2[0] = KM"KM24";
          KW$LINE3[0] = KM"KM13";
          KP$CN = FMR$CHAN[0];
          KP$CI = FMR$CIF[0];
          END  # RESET #
 
        KW$RPGO[0] = TRUE;           # ALLOW GO RESPONSE #
        KW$DF[0] = TRUE;             # SEND TO JOB DAYFILE #
        KW$IC[0] = TRUE;             # SET IMMEDIATE COMPLETION #
        KREQ(LOC(KWORD),KLINK);      # SEND K-DISPLAY REQUEST #
        END  # K #
 
#
*     PROCESS DRIVER READ FET ERROR.
#
 
      IF FETTYPE EQ RFET
      THEN                           # ACCESS READ FET #
        BEGIN  # READ #
        FS$CHAN[0] = FMR$CHAN[0];
        FS$SMUN[0] = NOUNIT;         # NO UNIT NUMBERS AVAILABLE #
        FS$DRDUN[0] = NOUNIT;
        IF FS$ET[0] GQ RCHWET
        THEN                         # ERROR INCLUDES FSC LOG #
          BEGIN  # LOG #
          IF FS$ET[0] NQ RCXSUM
          THEN                       # NOT A CHECKSUM ERROR #
            BEGIN  # FSC #
            FS$FSC[0] = FMR$FSC[0];  # FSC STATUS #
            END  # FSC #
 
          IF FS$ET[0] NQ RCIMPL
          THEN                       # DOWN BAD CHANNEL #
            BEGIN  # DOWN #
            CHNGCHN;
            END  # DOWN #
 
          ELSE                       # DOWN BAD CONTROLLER #
            BEGIN  # DOWN #
            DOWNCU(FMR$CU[0]);
            END  # DOWN #
 
          END  # LOG #
 
        FMR$AT[0] = 0;               # MARK ERROR AS PROCESSED #
        END  # READ #
 
#
*     PROCESS DRIVER WRITE FET ERROR.
#
 
      IF FETTYPE EQ WFET
      THEN                           # ACCESS WRITE FET #
        BEGIN  # WRITE #
        FS$CHAN[0] = FMW$CHAN[0];
        SAVEDMSG = P<UDT$MSG>;       # SAVE MSG BUF LOCATION #
        P<UDT$MSG> = FMW$OUT[0];
        FS$SMUN[0] = NOUNIT;         # ASSUME UNIT NUMBERS UNAVAILABLE #
        FS$DRDUN[0] = NOUNIT;
        IF MS$MSQN$DI[0] NQ 0
        THEN                         # SM/DRD UNIT NUMBERS AVAILABLE #
          BEGIN  # RESET #
          FS$SMUN[0] = SM$SUN[MS$MSQN$CN[0]];  # ASSUME LOWER DRD #
          FS$DRDUN[0] = D1$SUN[MS$MSQN$CN[0]];
          IF MS$MSQN$D0[0]
          THEN                       # MESSAGE GOING TO UPPER DRD #
            BEGIN  # UPPER #
            FS$DRDUN[0] = D0$SUN[MS$MSQN$CN[0]];
            END  # UPPER #
 
          END  # RESET #
 
        ASSOCDATA = ((MS$ASS$DT[0]*2)+14)/15;
        TEMPOUT = FMW$OUT[0] + PMSGLT + ASSOCDATA;
        IF TEMPOUT GQ FMW$LIMIT[0]
        THEN                         # MESSAGE WRAPPED AROUND FET #
          BEGIN  # WRAP #
          TEMPOUT = TEMPOUT - FMW$LIMIT[0] + FMW$FIRST[0];
          END  # WRAP #
 
        FMW$OUT[0] = TEMPOUT;        # REMOVE MESSAGE FROM FET #
        P<UDT$MSG> = SAVEDMSG;       # RESTORE POINTER #
        IF FS$ET[0] GQ RCHWET
        THEN                         # ERROR INCLUDES FSC LOG #
          BEGIN  # LOG #
          FS$FSC[0] = FMW$FSC[0];    # FSC STATUS #
          IF FS$ET[0] NQ RCIMPL
          THEN                       # DOWN BAD CHANNEL #
            BEGIN  # DOWN #
            CHNGCHN;
            END  # DOWN #
 
          ELSE                       # DOWN BAD CONTROLLER #
            BEGIN  # DOWN #
            DOWNCU(FMR$CU[0]);
            END  # DOWN #
 
          END  # LOG #
 
        FMW$AT[0] = 0;               # MARK ERROR AS PROCESSED #
        FMW$CMPL[0] = FALSE;         # LET PP CONTINUE #
        DRVRACTIVE = TRUE;           # INSURE PP ACTIVE WHEN RETRYING #
        END  # WRITE #
 
      FS$DC[0] = FSCCODE;            # SET COMMON FIELDS #
      FS$ESTO[0] = UD$ESTO[FMR$CU[0]];
      MESSAGE(FSCCNT,BML);           # SEND FSC LOG TO BML #
      RETURN;
      END  # FSCLOG #
 
    TERM
PROC GENREQ;
# TITLE GENREQ - GENERAL DRIVER REQUESTS.                             #
 
      BEGIN  # GENREQ #
 
#
**    GENREQ - GENERAL DRIVER REQUESTS.
*
*     *GENREQ* PROCESSES *DRQUEUE* REQUESTS TO WRITE VOLUME LABELS,
*     WRITE CARTRIDGE LABELS, AND READ RAW STRIPES.
*
*     PROC GENREQ
*
*     ENTRY      P<LLRQ> = *DRQUEUE* ENTRY ADDRESS.
*
*     EXIT       THE *DRQUEUE* ENTRY REQUEST STATE FIELD HAS BEEN
*                UPDATED TO INDICATE WHERE SUBSEQUENT PROCESSING OF
*                THIS REQUEST IS TO CONTINUE.
*
*     MESSAGES   *EXEC ABNORMAL, GENREQ1.* - UDT MESSAGE BUFFER STILL
*                                            IN USE.  IT ALSO OCCURS IF
*                                            THE LABEL BUFFER WAS NOT
*                                            INTERLOCKED WHEN WRITING A
*                                            CARTRIDGE LABEL.
*
*                *EXEC ABNORMAL, GENREQ2.* - DATA LENGTH ERROR WHEN
*                                            WRITING A CARTRIDGE OR
*                                            VOLUME LABEL.
*
*     NOTES      IF THE REQUEST WAS TO WRITE A VOLUME LABEL, TWO TAPE
*                MARKS ARE WRITTEN AT THE START OF THE VOLUME.
*
*                IF THE REQUEST WAS TO READ A RAW STRIPE, THE M860
*                RESPONSE PRECEDES THE RAW STRIPE IN THE ASSOCIATED
*                DATA BUFFER.
*
*                THIS IS A PSEUDO-REENTRANT PROCEDURE.
#
 
 
#
****  PROC GENREQ - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ABORT;                  # ABORT #
        PROC MESSAGE;                # ISSUE DAYFILE MESSAGE #
        PROC SENDMSG;                # SEND M860 MESSAGE #
        PROC ZFILL;                  # ZERO-FILL BUFFER #
        END
 
#
****  PROC GENREQ - XREF LIST END.
#
 
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
*CALL,COMBFAS
*CALL,COMBCPR
*CALL,COMBHFC
*CALL,COMBLRQ
*CALL,COMBRCD
*CALL,COMBUDT
*CALL,COMXCTF
*CALL,COMXMSC
 
      SWITCH GDREQ:PROCST            # DRIVER REQUEST STATE #
           GDRINIT:INITIAL,          # INITIAL STATE #
           GDRMSGE:CONT1;            # CONTINUATION 1 #
                                               CONTROL EJECT;
 
      GOTO GDREQ[LLR$RS[0]];
 
#
*     INITIAL DRIVER REQUEST STATE.
#
 
GDRINIT:
      P<MBFHDR> = LLR$MBH[0];
      IF MBF$WORD[0] NQ 0            # DRD STILL IN USE #
        OR (LLR$RC[0] EQ WRT$LABEL   # LABEL BUFFER EMPTY #
        AND NOT LABELBUSY)
      THEN                           # EXEC/DRIVER ERRORS #
        BEGIN  # ABORT #
        FE$RTN[0] = "GENREQ1.";
        GOTO GENREQ1;
        END  # ABORT #
 
      P<UDT$MSG> = P<MBFHDR> + 1;
      MS$MSG[0] = HFC$WRTLBL;        # ASSUME *WRITE-CARTRIDGE-LABEL* #
      IF LLR$RC[0] EQ WRT$VOL
      THEN                           # WRITING VOLUME LABEL #
        BEGIN  # RESET #
        MS$MSG[0] = HFC$WVLBUT;
        END  # RESET #
 
      IF LLR$RC[0] EQ RD$RAW$STP
      THEN                           # READING RAW DATA #
        BEGIN  # RESET #
        MS$MSG[0] = HFC$RDRAW;
        END  # RESET #
 
      MBF$SAVE[0] = SAVEMOST;
      LLR$RS[0] = PROCST"CONT1";     # SET NEXT REQUEST STATE #
 
#
*     ISSUE GENERAL M860 MESSAGE.
#
 
GDRMSGE:
      P<MBFHDR> = LLR$MBH[0];
      SENDMSG;                       # SEND M860 MESSAGE #
      IF MBF$SBADDR[0] EQ 0          ##
        AND LLR$DR[0] EQ RESPTYP4"OK4"  # HARDWARE OK #
      THEN                           # RESPONSE NOT YET RECEIVED #
        BEGIN  # RETRY #
        RETURN;
        END  # RETRY #
 
      IF MS$RETCODE[0] EQ HRC$DLERR
      THEN                           # DATA LENGTH ERROR #
        BEGIN  # ABORT #
        FE$RTN[0] = "GENREQ2.";
        GOTO GENREQ1;
        END  # ABORT #
 
      IF MS$MSG[0] EQ HFC$WRTLBL
      THEN                           # CARTRIDGE LABEL WRITTEN #
        BEGIN  # CLEAR #
        LABELBUSY = FALSE;           # FREE UP LABEL BUFFER #
        END  # CLEAR #
 
      IF MS$MSG[0] EQ HFC$WVLBUT     # VOLUME LABEL WRITTEN #
        OR MS$MSG[0] EQ HFC$WVLBLT
      THEN                           # MNT-VOL NEEDS LAST-STRIPE-WRIT #
        BEGIN  # LAST #
        LLR$LT$ST[0] = MS$PARM1A[0]; # SAVE LAST-STRIPE-WRITTEN #
        END  # LAST #
 
      IF MS$MSG[0] NQ HFC$RDRAW      # SAVE RESPONSE IN DATA BUFFER #
        AND MBF$SBADDR[0] NQ 0       # RESPONSE DID NOT TIME OUT #
        AND (LLR$DR[0] NQ RESPTYP4"M86$HDW$PR"  # RESPONSE RECEIVED #
        OR LLR$DRFUL[0])
      THEN                           # CLEAR STORAGE BUFFER #
        BEGIN  # CLEAR #
        ZFILL(UDT$MSG,MSGLT);
        END  # CLEAR #
 
      MBF$WORD[0] = 0;
      LLR$RS[0] = PROCST"COMPLETE";
      RETURN;
 
GENREQ1:
      MESSAGE(FEMSG,UDFL1);
      ABORT;
      END  # GENREQ #
 
    TERM
PROC GETCHAN((FNCODE));
# TITLE GETCHAN - ALLOCATE CHANNEL.                                   #
 
      BEGIN  # GETCHAN #
 
#
**    GETCHAN - ALLOCATE CHANNEL.
*
*     *GETCHAN* ALLOCATES AN M860 CONTROLLER CHANNEL.
*
*     PROC GETCHAN((FNCODE))
*
*     ENTRY      (FNCODE) = PP FUNCTION CODE TO BE ISSUED ON THE
*                           DESIRED CHANNEL.
*
*                P<LLRQ> = *DRQUEUE* ENTRY ADDRESS, IF NOT ALLOCATING A
*                          CHANNEL TO RETURN AN M860 ERROR LOG MESSAGE.
*
*                P<UDT$MSG> = UDT/SBT MESSAGE BUFFER ADDRESS.
*
*     EXIT       THE MESSAGE FET BASED ARRAYS POINT TO THE FETS USED BY
*                THE ALLOCATED CHANNEL.  THE *DRQUEUE* ENTRY CONTAINS
*                THE ASSOCIATED UDT CONTROLLER ORDINAL.  IF NO CHANNEL
*                IS ALLOCATED, *HARDWARE PROBLEM* STATUS IS RETURNED IN
*                THE *DRQUEUE* ENTRY, AND THE MESSAGE WRITE FET ADDRESS
*                IS CLEARED TO INDICATE IT.
#
 
 
      DEF FIRSTCU    #0#;            # NUMBER OF 1ST CU ORD TO SM #
      DEF LASTCU     #1#;            # NUMBER OF 2ND CU ORD TO SM #
 
      DEF ACTIVE     #1#;            # WRITE/DATA BUFFER ACTIVE #
      DEF INACTIVE   #0#;            # WRITE/DATA BUFFER INACTIVE #
 
      DEF FIRSTTEST  #1#;            # FREE CHANNEL (DATA) #
      DEF TEST2      #2#;            # ONLY MESSAGES ACTIVE #
      DEF TEST3      #3#;            # FREE CHANNEL (MESSAGES) #
      DEF TEST4      #4#;            # MESSAGES AND DATA ACTIVE #
      DEF LASTTEST   #5#;            # ONLY DATA ACTIVE #
 
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
*CALL,COMBFAS
*CALL,COMBCDD
*CALL,COMBCPR
*CALL,COMBFET
*CALL,COMBHFC
*CALL,COMBLRQ
*CALL,COMBUDT
 
      ITEM FNCODE     U;             # PASSED FUNCTION CODE #
      ITEM I          I;             # INDEX #
      ITEM J          I;             # INDEX #
      ITEM K          I;             # INDEX #
      ITEM MSGC       U;             # SAVED MESSAGE COUNT #
 
#
*     CONTROLLER ORDINAL ARRAY.
#
 
      ARRAY SC [FIRSTCU:LASTCU] S(1);  # SM CU-S #
        BEGIN
        ITEM SC$ORD     U(00,00,60); # CU ORDINAL #
        END
 
#
*     CHANNEL TEST DEFINITION ARRAY.
#
 
      ARRAY TST [FIRSTTEST:LASTTEST] S(1);  # TESTS #
        BEGIN
        ITEM TEST$WB    U(00,00,01) = [INACTIVE,
                                       ACTIVE,
                                       INACTIVE,
                                       ACTIVE,
                                       INACTIVE];  # WRITE BUF TESTS #
        ITEM TEST$DB    U(00,01,01) = [INACTIVE,
                                       INACTIVE,
                                       INACTIVE,
                                       ACTIVE,
                                       ACTIVE];  # DATA BUF TESTS #
        END
 
#
*     CHANNEL STATUS ARRAY.
#
 
      ARRAY CH [0:MAX$CH] S(1);
        BEGIN
        ITEM CH$O       B(00,00,01); # ON/OFF STATUS #
        END
                                               CONTROL EJECT;
 
      IF UDT$HWOFF[0] NQ 0
      THEN                           # NO CU-S/CHANNELS TO ALLOCATE #
        BEGIN  # EXIT #
        GOTO GETCHAN1;
        END  # EXIT #
 
      IF FNCODE EQ IRMDAT
      THEN                           # PICK SAME CIF AS MNT-VOL #
        BEGIN  # SAME #
        P<MWBTMP> = LOC(UD$CAMF[LLR$CU[0]]);
        P<FETMWB> = MWB$ADDR[LLR$CIF[0]];
        P<FETMRA> = P<FETMWB> - 1;
        P<FETMRB> = FRA$MRBADR[0];
        P<FETFHB> = LLR$MSFET[0];    # SAVE ADDRESS FOR FSC LOG #
        FHB$RBADDR[0] = P<FETMRB>;
        RETURN;
        END  # SAME #
 
      IF MS$MSG$R[0]                 # M860-INITIATED MESSAGE #
      THEN                           # PICK CHANNEL THIS MSG LAST USED #
        BEGIN  # PICK #
        IF MS$MSG[0] LS (HRF$ELGFUL + HRF$R)   # NOT ERROR LOG MSG #
          OR MS$MSG[0] GR (HRF$REQDMP + HRF$R)
        THEN                         # RESET NEW CHANNEL #
          BEGIN  # CIF #
          P<MWBTMP> = LOC(UD$CAMF[LLR$CU[0]]);
          P<FETMWB> = MWB$ADDR[LLR$CIF[0]];
          P<FETMRA> = P<FETMWB> - 1;
          P<FETMRB> = FRA$MRBADR[0];
          IF (NOT FMW$CHON[0])       # CHANNEL DOWN #
            OR (NOT UD$CUON[FMR$CU[0]])  # CONTROLLER DOWN #
          THEN                       # NO HARDWARE AVAILABLE #
            BEGIN  # DOWN #
            GOTO GETCHAN1;
            END  # DOWN #
 
          END  # CIF #
 
        RETURN;
        END  # PICK #
 
      P<FETMWB> = 0;                 # PRESET AS NO CHANNEL FOUND #
      MSGC = -1;                     # ASSUME SENDING MESSAGE #
      IF MS$MSG$M[0] EQ HFC$MVLM     # MOUNT-VOLUME #
      THEN                           # DATA TRANSFER NEEDS LEAST MSGS #
        BEGIN  # DATA #
        MSGC = 7777;
        END  # DATA #
 
#
*     DETERMINE ELIGIBLE CONTROLLERS.
#
 
      SC$ORD[FIRSTCU] = 0;           # CLEAR CONTROLLER ARRAY #
      SC$ORD[LASTCU] = 0;
      SC$ORD[FIRSTCU] = LLR$CU[0];   # ASSUME GENERAL MESSAGE #
      IF (MS$MSG[0] EQ HFC$ACCR      ##
        OR MS$MSG[0] EQ HFC$ENCRDR)  ##
        AND LLR$PRCNME[0] NQ REQTYP4"INITHW"  # NOT SERVICE-CELL LOAD #
      THEN                           # ONLY NORMAL LOAD HAS CHOICE #
        BEGIN  # DRD #
        IF UD$CUON[SM$CUO0[MS$MSQN$CN[0]]]
        THEN                         # 1ST CU AVAILABLE #
          BEGIN  # 1ST #
          SC$ORD[FIRSTCU] = SM$CUO0[MS$MSQN$CN[0]];
          END  # 1ST #
 
        IF UD$CUON[SM$CUO1[MS$MSQN$CN[0]]]
        THEN                         # 2ND CU AVAILABLE #
          BEGIN  # 2ND #
          SC$ORD[LASTCU] = SM$CUO1[MS$MSQN$CN[0]];
          END  # 2ND #
 
        END  # DRD #
 
      IF SC$ORD[FIRSTCU] EQ 0        ##
        AND SC$ORD[LASTCU] EQ 0
      THEN                           # NO HARDWARE AVAILABLE #
        BEGIN  # NONE #
        GOTO GETCHAN1;
        END  # NONE #
 
#
*     SEARCH FOR BEST CHANNEL ON ALL ELIGIBLE CONTROLLERS.
#
 
      LLR$DR[0] = RESPTYP4"M86$HDW$PR";
      SLOWFOR I = FIRSTTEST STEP 1 UNTIL LASTTEST
      DO                             # APPLY TESTS FOR BEST CHANNEL #
        BEGIN  # TEST #
        IF (MS$MSG$M[0] EQ HFC$MVLM  # DATA TEST #
          AND I GR TEST2)            ##
          OR (MS$MSG$M[0] NQ HFC$MVLM  # NORMAL MESSAGE TEST #
          AND I EQ FIRSTTEST)
        THEN                         # SKIP THIS TEST #
          BEGIN  # LOOP #
          TEST I;
          END  # LOOP #
 
        SLOWFOR J = FIRSTCU STEP 1 UNTIL LASTCU
        DO                           # SCAN ELIGIBLE CONTROLLERS #
          BEGIN  # CU #
          IF SC$ORD[J] EQ 0          # NO CU #
            OR (UD$CUON[SC$ORD[J]]   ##
            AND UD$CNUP[SC$ORD[J]]   ##
            AND LLR$PRCNME[0] NQ REQTYP4"INITHW")  # CU INITIALIZING #
            OR ((LLR$PRCNME[0] EQ REQTYP4"INITHW"  ##
            OR MS$MSG[0] EQ HFC$ACCR)  ##
            AND NOT UD$CUON[SC$ORD[J]])  # ALLOW ERR RCVRY AFTER INIT #
          THEN                       # SKIP THIS CU #
            BEGIN  # SKIP #
            TEST J;
            END  # SKIP #
 
          IF MS$MSQN$DI[0] NQ 0
          THEN                       # CHECK IF DRD ON TO CU #
            BEGIN  # DRD #
            P<PTHSTAT> = LOC(D1$ST[LLR$SMO[0]]);  # ASSUME LOWER DRD #
            IF LLR$DRD[0] EQ 0
            THEN                     # MESSAGE FOR UPPER DRD #
              BEGIN  # RESET #
              P<PTHSTAT> = LOC(D0$ST[LLR$SMO[0]]);
              END  # RESET #
 
            DRST = DRST1;            # ASSUME 2ND CU #
            IF SC$ORD[J] EQ SM$CUO0[LLR$SMO[0]]
            THEN                     # MESSAGE FOR 1ST CU #
              BEGIN  # RESET #
              DRST = DRST0;
              END  # RESET #
 
            IF PATHBIT(DRST,PATH$DF"U$ON") EQ OFF  ##
              AND PATHBIT(DRST,PATH$DF"U$CU$ACK") EQ OFF
            THEN                     # DRD NOT ON TO THIS CU #
              BEGIN  # RETRY #
              TEST J;
              END  # RETRY #
 
            END  # DRD #
 
          IF (LLR$PRCNME[0] NQ REQTYP4"INITHW"  # NORMAL LOAD #
            AND MS$MSG[0] EQ HFC$ACCR)  ##
            OR MS$MSG[0] EQ HFC$ENCRDR  # ENTER #
            OR (MS$MSG[0] EQ HFC$CHSDRD  # DRD TURNING ON #
            AND MS$PARM1A[0] EQ ONLINE)
          THEN                       # CHECK IF SM CAN BE ACCESSED #
            BEGIN  # SM #
            P<PTHSTAT> = LOC(SM$STS[LLR$SMO[0]]);
            SMST = SMST1;            # ASSUME 2ND CU #
            IF SC$ORD[J] EQ SM$CUO0[LLR$SMO[0]]
            THEN                     # MESSAGE FOR 1ST CU #
              BEGIN  # RESET #
              SMST = SMST0;
              END  # RESET #
 
            IF PATHBIT(SMST,PATH$DF"U$ON") EQ OFF  # SM NOT ON #
              OR PATHBIT(SMST,PATH$DF"U$CU$ACK") EQ ON
            THEN                     # SM CANNOT BE ACCESSED #
              BEGIN  # RETRY #
              TEST J;
              END  # RETRY #
 
            END  # SM #
 
          CH$O[0] = UD$CHANA$O[SC$ORD[J]];  # PRESET CHANNEL ARRAY #
          CH$O[1] = UD$CHANB$O[SC$ORD[J]];
          CH$O[2] = UD$CHANC$O[SC$ORD[J]];
          CH$O[3] = UD$CHAND$O[SC$ORD[J]];
          SLOWFOR K = 0 STEP 1 UNTIL MAX$CH
          DO                         # SCAN ALL CHANS ON ELIGIBLE CU #
            BEGIN  # CHANNEL #
            IF B<K,1>UD$CHEX[SC$ORD[J]] EQ 0  # NOT EXISTS #
              OR NOT CH$O[K]         # CHANNEL OFF #
            THEN                     # TRY ANOTHER CHANNEL #
              BEGIN
              TEST K;
              END
 
            LLR$DR[0] = RESPTYP4"OK4";
            IF B<K,1>UD$WBACT[SC$ORD[J]] EQ TEST$WB[I]  ##
              AND B<K,1>UD$DBACT[SC$ORD[J]] EQ TEST$DB[I]  ##
              AND ((MS$MSG$M[0] NQ HFC$MVLM  # SENDING NORMAL MSG #
              AND MSGCNT(K,SC$ORD[J]) GR MSGC)  # CHN WITH MOST MSGS #
              OR (MS$MSG$M[0] EQ HFC$MVLM  # DATA TRANSFER #
              AND MSGCNT(K,SC$ORD[J]) LS MSGC))  # CHN WITH LEAST MSGS #
            THEN                     # ELIGIBLE CHANNEL FOUND #
              BEGIN  # FOUND #
              P<MWBTMP> = LOC(UD$CAMF[SC$ORD[J]]);
              P<FETMWB> = MWB$ADDR[K];  # SET FET ADDRESS #
              P<FETMRA> = P<FETMWB> - 1;
              P<FETMRB> = FRA$MRBADR[0];
              LLR$CU[0] = SC$ORD[J]; # SAVE CU ORDINAL #
              MSGC = MSGCNT(K,SC$ORD[J]);  # SAVE NEW MSG COUNT #
              END  # FOUND #
 
            END  # CHANNEL #
 
          END  # CU #
 
        IF P<FETMWB> NQ 0
        THEN                         # BEST CHANNEL FOUND #
          BEGIN  # EXIT #
          RETURN;
          END  # EXIT #
 
        END  # TEST #
 
      RETURN;                        # NO CHANNEL SELECTED #
 
GETCHAN1:                            # CLEAN UP FROM HARDWARE PROBLEM #
      P<FETMWB> = 0;                 # NO CHANNEL ALLOCATED #
      LLR$DR[0] = RESPTYP4"M86$HDW$PR";
      RETURN;
      END  # GETCHAN #
 
    TERM
PROC INITDRD;
# TITLE INITDRD - INITIALIZE DRD-S.                                   #
 
      BEGIN  # INITDRD #
 
#
**    INITDRD - INITIALIZE DRD-S.
*
*     *INITDRD* PROCESSES ALL DRD STATUS CHANGE REQUESTS.  THE UDT IS
*     SCANNED FOR ANY DRD-S CHANGING STATUS, AND AN M860 MESSAGE IS
*     SENT FOR EACH CHANGE FOUND.  IF THE DRD IS TO BE PUT ONLINE, AN
*     M860 CLEAR CARTRIDGE IS LOADED AND STORED THROUGH IT, AND THE
*     SERVICE CELLS IN THE SM ARE CHECKED FOR CARTRIDGES.  ANY
*     CARTRIDGES THUS FOUND ARE THEN STORED IN THE MATRIX OR EJECTED.
*
*     PROC INITDRD
*
*     ENTRY      P<LLRQ> = *DRQUEUE* ENTRY ADDRESS.
*
*     EXIT       THE *DRQUEUE* ENTRY REQUEST STATE FIELD HAS BEEN
*                UPDATED TO INDICATE WHERE SUBSEQUENT PROCESSING OF
*                THIS REQUEST IS TO CONTINUE.
*
*     MESSAGES   *EXEC ABNORMAL, INITDRD1.* - UDT MESSAGE BUFFER STILL
*                                             IN USE.
*
*     NOTES      THIS IS A PSEUDO-REENTRANT PROCEDURE.
#
 
 
#
****  PROC INITDRD - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ABORT;                  # ABORT #
        PROC KREQ;                   # SEND K-DISPLAY REQUEST #
        PROC MESSAGE;                # ISSUE DAYFILE MESSAGE #
        PROC SENDMSG;                # SEND M860 MESSAGE #
        PROC ZFILL;                  # ZERO-FILL BUFFER #
        END
 
#
****  PROC INITDRD - XREF LIST END.
#
 
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
*CALL,COMBFAS
*CALL,COMBCPR
*CALL,COMBFET
*CALL,COMBHFC
*CALL,COMBKDD
*CALL,COMBLBL
*CALL,COMBLRQ
*CALL,COMBUDT
*CALL,COMXCTF
*CALL,COMXMSC
 
      ITEM STSP       U;             # STATUS FROM 1ST CU #
      ITEM STSS       U;             # STATUS FROM 2ND CU #
 
      SWITCH DRDLBL:PROCST           # DRIVER REQUEST STATE #
            DRDINIT:INITIAL,         # INITIAL STATE #
            DRDMSGE:CONT1,           # CONTINUATION 1 #
            DRDACQC:CONT2,           # CONTINUATION 2 #
            DRDSTRC:CONT3;           # CONTINUATION 3 #
                                               CONTROL EJECT;
 
      GOTO DRDLBL[LLR$RS[0]];
 
#
*     INITIAL DRIVER REQUEST STATE.
#
 
DRDINIT:
      P<MBFHDR> = LOC(UD$MSG[LLR$CU[0]]) - 1;
      IF MBF$ACTIVE[0]
      THEN                           # MESSAGE BUFFER IN USE #
        BEGIN  # EXIT #
        IF LLR$PRCNME[0] EQ REQTYP4"INITHW"  ##
          AND LLR$DRFUL[0]
        THEN                         # PRESET MSG BUF TO TURN OFF DRD #
          BEGIN  # ERROR #
          DRVRACTIVE = TRUE;
          LLR$RS[0] = PROCST"CONT1"; # TURN OFF DRD ON NEXT PASS #
          P<UDT$MSG> = P<MBFHDR> + 1;
          MS$MSG[0] = HFC$CHSDRD;    # IN CASE SM WAS GOING ON #
          GOTO INITDRD1;
          END  # ERROR #
 
        RETURN;                      # WAIT TO TURN OFF DRD ON ERROR #
        END  # EXIT #
 
      IF MBF$WORD[0] NQ 0
      THEN                           # LAST MESSAGE NOT PROCESSED #
        BEGIN  # ABORT #
        FE$RTN[0] = "INITDRD1.";
        GOTO INITDRD2;
        END  # ABORT #
 
      P<UDT$MSG> = LOC(UD$MSG[LLR$CU[0]]);
      MS$MSG[0] = HFC$CHSDRD;        # CHANGE DRD STATUS #
      UD$SAVE[LLR$CU[0]] = SAVENONE;
      LLR$RS[0] = PROCST"CONT1";     # SET NEW REQUEST STATE #
 
#
*     ISSUE MESSAGES TO CHANGE DRD STATUSES.
#
 
DRDMSGE:
      IF INITIALIZE                  ##
        AND DRYUP
      THEN                           # FORCE QUICK EXIT #
        BEGIN  # EXIT #
        RETURN;
        END  # EXIT #
 
      P<MBFHDR> = LOC(UD$MSG[LLR$CU[0]]) - 1;
      IF P<LLRQ> NQ UD$LLRQA[LLR$CU[0]]  # MSG BUF IN USE #
        AND MBF$ACTIVE[0]
      THEN                           # DRD-S TURNING OFF FROM ERROR #
        BEGIN  # RETRY #
        RETURN;                      # WAIT UNTIL OTHER LLRQ FINISHED #
        END  # RETRY #
 
      SENDMSG;                       # SEND M860 MESSAGE #
      IF UD$DRDWAIT[LLR$CU[0]]
      THEN                           # WAITING FOR DRD TO EMPTY #
        BEGIN  # WAIT #
        UD$DRDWAIT[LLR$CU[0]] = FALSE;  # IF 2ND LLRQ AWAITING MSG #
        LLR$RS[0] = PROCST"INITIAL";  # IN CASE RESERVED NEXT PASS #
        RETURN;
        END  # WAIT #
 
      IF NOT UD$MBACT[LLR$CU[0]]
      THEN                           # ALL DRD-S ON THIS CU PROCESSED #
        BEGIN  # EXIT #
        LLR$RS[0] = PROCST"COMPLETE";
        UD$CNUP[LLR$CU[0]] = FALSE;  # CU CLEANUP COMPLETE #
        IF NOT LLR$DRDOFF[0]         # NOT PROCESSING DRD ERROR #
        THEN                         # CU INITIALIZING COMPLETED #
          BEGIN  # CLEAR #
          CURESERVED = FALSE;        # LET ANOTHER CU INITIALIZE #
          END  # CLEAR #
 
        GOTO INITDRD1;
        END  # EXIT #
 
      IF UD$SBADDR[LLR$CU[0]] EQ 0   ##
        AND LLR$DR[0] NQ RESPTYP4"M86$HDW$PR"
      THEN                           # RESPONSE NOT YET RECEIVED #
        BEGIN  # RETRY #
        RETURN;
        END  # RETRY #
 
      P<PTHSTAT> = LOC(D1$ST[LLR$SMO[0]]);  # ASSUME LOWER DRD #
      IF LLR$DRD[0] EQ 0
      THEN                           # UPPER DRD BEING CHANGED #
        BEGIN  # RESET #
        P<PTHSTAT> = LOC(D0$ST[LLR$SMO[0]]);
        END  # RESET #
 
      DRST = DRST1;                  # ASSUME 2ND CU #
      IF LLR$CU[0] EQ SM$CUO0[LLR$SMO[0]]
      THEN                           # RESET DRD INDEX TO 1ST CU #
        BEGIN  # RESET #
        DRST = DRST0;
        END  # RESET #
 
      IF PATHBIT(DRST,PATH$DF"U$ON") EQ ON  ##
        AND PATHBIT(DRST,PATH$DF"U$CU$ACK") EQ ON
      THEN                           # CLEAR SM RESERVATION #
        BEGIN  # CLEAR #
        SM$ACCBUSY[LLR$SMO[0]] = FALSE;
        IF LLR$DR[0] EQ RESPTYP4"M86$HDW$PR"
        THEN                         # DO NOT CHECK SERVICE CELLS #
          BEGIN  # SCCU #
          SM$SCCU[LLR$SMO[0]] = FALSE;  # ALSO DONE FOR BAD DRD CASE #
          END  # SCCU #
 
        END  # CLEAR #
 
      IF LLR$DR[0] EQ RESPTYP4"M86$HDW$PR"
      THEN                           # RECOVER DRD STATUS #
        BEGIN  # RECOVER #
        DRVRACTIVE = TRUE;           # FORCE NEXT NORMAL UDT PASS #
        IF (PATHBIT(DRST,PATH$DF"U$ON") EQ ON  ##
          OR PATHBIT(DRST,PATH$DF"U$RQ$DIAG") EQ ON)  ##
          AND MBF$SENT[0]            # DRD REALLY OFF IN HARDWARE #
        THEN                         # INFORM OPERATOR OF DRD PROBLEM #
          BEGIN  # K #
          P<KWORD> = LOC(LLR$KWORDS[0]);
          KW$WORD[0] = 0;
          KW$LINE1[0] = KM"KM3";     # SET MESSAGE ORDINALS #
          KW$LINE2[0] = KM"KM16";
          KP$EQ = UD$ESTO[LLR$CU[0]];  # SET MESSAGE PARAMETERS #
          P<MWBTMP> = LOC(UD$CAMF[LLR$CU[0]]);
          P<FETMWB> = MWB$ADDR[LLR$CIF[0]];
          P<FETMRA> = P<FETMWB> - 1;
          P<FETMRB> = FRA$MRBADR[0];
          KP$CN = FMR$CHAN[0];
          KP$DT = SM$ID[LLR$SMO[0]];
          KP$ID = D1$SUN[LLR$SMO[0]];  # ASSUME LOWER DRD #
          IF LLR$DRD[0] EQ 0
          THEN                       # LOWER DRD HAD ERROR #
            BEGIN  # RESET #
            KP$ID = D0$SUN[LLR$SMO[0]];
            END  # RESET #
 
          KW$IC[0] = TRUE;             # SET IMMEDIATE COMPLETION #
          KW$DF[0] = TRUE;             # SEND TO JOB DAYFILE #
          KW$RPGO[0] = TRUE;           # ALLOW GO RESPONSE #
          KREQ(LOC(KWORD),KLINK);      # SEND K-DISPLAY REQUEST #
          END  # K #
 
        PATHBIT(DRST,PATH$DF"U$ON") = OFF;  # DRD ASSUMED OFF IN M860 #
        PATHBIT(DRST,PATH$DF"U$RQ$DIAG") = OFF;
        END  # RECOVER #
 
      PATHBIT(DRST,PATH$DF"U$CU$ACK") = OFF;
      PATHBIT(DRST,PATH$DF"U$DIAG$ACK") = OFF;
 
      IF LLR$DRD[0] EQ 0
      THEN                           # UPPER DRD BEING CHANGED #
        BEGIN  # DRD0 #
        STSP = D0$STSP[LLR$SMO[0]];
        STSS = D0$STSS[LLR$SMO[0]];
        D0$FLAG[LLR$SMO[0]] = STSP LOR STSS;
        END  # DRD0 #
 
      ELSE                           # LOWER DRD BEING PROCESSED #
        BEGIN  # DRD1 #
        STSP = D1$STSP[LLR$SMO[0]];
        STSS = D1$STSS[LLR$SMO[0]];
        D1$FLAG[LLR$SMO[0]] = STSP LOR STSS;
        END  # DRD1 #
 
#
*     CLEAR THE SERVICE CELLS IF THE DRD WAS VARIED ONLINE.
#
 
      IF PATHBIT(DRST,PATH$DF"U$ON") EQ OFF  ##
      THEN                           # DRD NOT TURNED ON #
        BEGIN  # CONTINUE #
        IF LLR$DRFUL[0]
        THEN                         # INDICATE BAD DRD TURNED OFF #
          BEGIN  # FLAG #
          LLR$DRDOFF[0] = TRUE;
          IF LLR$SC[0] NQ 0
          THEN                       # THIS DRD WAS CHECKING SRV CELLS #
            BEGIN  # SCCU #
            LLR$SC[0] = 0;
            SM$SCCU[LLR$SMO[0]] = FALSE;  # HALT SRV CELL CHECKING #
            END  # SCCU #
 
          END  # FLAG #
 
        GOTO INITDRD1;
        END  # CONTINUE #
 
      IF LLR$DRD[0] EQ 0
      THEN                           # UPPER DRD BEING EMPTIED #
        BEGIN  # UPPER #
        D0$FULL[LLR$SMO[0]] = FALSE; # PRESET #
        END  # UPPER #
 
      ELSE                           # LOWER DRD BEING EMPTIED #
        BEGIN  # LOWER #
        D1$FULL[LLR$SMO[0]] = FALSE; # PRESET #
        END  # LOWER #
 
      SM$TOPDRD[LLR$SMO[0]] = LLR$DRD[0] EQ 0;  # FORCE DRD CHOICE #
      LLR$Y[0] = SC$LOWER$Y;         # LOAD FROM LOWER SERVICE CELL #
      LLR$Z[0] = SC$LOWER$Z;
      LLR$LOWSC[0] = TRUE;
      RETURN;
 
DRDACQC:
      DRVRACTIVE = TRUE;             # ACQUIRE ATTEMPTED #
      IF LLR$DR[0] EQ RESPTYP4"OK4"
      THEN                           # CARTRIDGE LOADED OK #
        BEGIN  # STORE #
        LLR$Y[0] = LAB$Y[0];
        LLR$Z[0] = LAB$Z[0];
        RETURN;
        END  # STORE #
 
      IF LLR$DR[0] EQ RESPTYP4"UNK$CART"  ##
        OR LLR$DR[0] EQ RESPTYP4"CART$LB$ERR"  ##
        OR LLR$DR[0] EQ RESPTYP4"M86$HDW$PR"
      THEN                           # NO LABEL OR LABEL ERROR #
        BEGIN  # EJECT #
        LLR$Y[0] = SM$EXIT$TY;
        LLR$Z[0] = SM$TY$Z;
        RETURN;
        END  # EJECT #
 
DRDSTRC:
      DRVRACTIVE = TRUE;             # STORE ATTEMPTED #
      IF LLR$LOWSC[0]                ##
        AND NOT LLR$DRFUL[0]         # NO ERROR ON DRD #
      THEN                           # LOWER CELL JUST PROCESSED #
        BEGIN  # UPPER #
        LLR$Y[0] = SC$UPPER$Y;       # LOAD FROM UPPER SERVICE CELL #
        LLR$Z[0] = SC$UPPER$Z;
        SM$TOPDRD[LLR$SMO[0]] = LLR$DRD[0] EQ 0;  # FORCE DRD CHOICE #
        LLR$LOWSC[0] = FALSE;
        LLR$UPSC[0] = TRUE;
        RETURN;
        END  # UPPER #
 
      LLR$SC[0] = 0;
      SM$SCCU[LLR$SMO[0]] = FALSE;   # BOTH SERVICE CELLS CHECKED #
      LLR$RS[0] = PROCST"CONT1";     # RESET REQUEST STATE #
 
INITDRD1:
      P<MBFHDR> = LOC(UD$MSG[LLR$CU[0]]) - 1;  # RESET FROM SM ORDINAL #
      IF MBF$SBADDR[0] NQ 0
      THEN                           # STORAGE BUFFER HAS RESPONSE #
        BEGIN  # CLEAR #
        P<UDT$MSG> = MBF$SBADDR[0];
        ZFILL(UDT$MSG,MSGLT);        # CLEAR STORAGE BUFFER #
        END  # CLEAR #
 
      MBF$WORD[0] = 0;
      RETURN;
 
INITDRD2:
      MESSAGE(FEMSG,UDFL1);
      ABORT;
      END  # INITDRD #
 
    TERM
PROC INITSM;
# TITLE INITSM - INITIALIZE STORAGE MODULES AND CONTROLLER PATHS.     #
 
      BEGIN  # INITSM #
 
#
**    INITSM - INITIALIZE STORAGE MODULES AND CONTROLLER PATHS.
*
*     *INITSM* PROCESSES ALL STATUS CHANGE REQUESTS FOR M860 STORAGE
*     MODULES AND CONTROLLER PATHS.  THE UDT IS SCANNED FOR ANY
*     SM-S/PATHS CHANGING STATUS, AND AN M860 MESSAGE IS SENT FOR EACH
*     CHANGE FOUND.  IF AN SM IS TO BE PUT ONLINE, THE PICKER IS TESTED
*     BY LOADING AND STORING AN M860 CLEAR CARTRIDGE AT LOCATION
*     Y=0,Z=0.  IF NO M860 CLEAR CARTRIDGE IS FOUND THERE, THE ONE AT
*     LOCATION Y=0,Z=15 IS USED.  FINALLY,IF NOT INITIALIZING
*     *SSEXEC*, THE SERVICE CELLS ARE CHECKED FOR CARTRIDGES.  ANY THUS
*     FOUND ARE EJECTED.
*
*     PROC INITSM
*
*     ENTRY      P<LLRQ> = *DRQUEUE* ENTRY ADDRESS.
*
*     EXIT       THE *DRQUEUE* ENTRY REQUEST STATE FIELD HAS BEEN
*                UPDATED TO INDICATE WHERE SUBSEQUENT PROCESSING OF
*                THIS REQUEST IS TO CONTINUE.
*
*     MESSAGES   *EXEC ABNORMAL, INITSM1.* - UDT MESSAGE BUFFER STILL
*                                            IN USE.
*
*     NOTES      THIS IS A PSEUDO-REENTRANT PROCEDURE.
#
 
 
#
****  PROC INITSM - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ABORT;                  # ABORT #
        PROC KREQ;                   # SEND K-DISPLAY REQUEST #
        PROC MESSAGE;                # ISSUE DAYFILE MESSAGE #
        PROC SENDMSG;                # SEND M860 MESSAGE #
        PROC ZFILL;                  # ZERO-FILL BUFFER #
        END
 
#
****  PROC INITSM - XREF LIST END.
#
 
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
*CALL,COMBFAS
*CALL,COMBCPR
*CALL,COMBFET
*CALL,COMBHFC
*CALL,COMBKDD
*CALL,COMBLRQ
*CALL,COMBUDT
*CALL,COMXCTF
*CALL,COMXMSC
 
      ITEM I          I;             # INDEX #
      ITEM PI         U;             # SM/PATH STATUS INDEX #
 
      SWITCH SMLBL:PROCST            # DRIVER REQUEST STATE #
            SMINIT:INITIAL,          # INITIAL STATE #
            SMMSGE:CONT1,            # CONTINUATION 1 #
            SMACQC:CONT2,            # CONTINUATION 2 #
            SMSTRC:CONT3;            # CONTINUATION 3 #
                                               CONTROL EJECT;
 
      GOTO SMLBL[LLR$RS[0]];
 
#
*     INITIAL DRIVER REQUEST STATE.
#
 
SMINIT:
      P<MBFHDR> = LOC(UD$MSG[LLR$CU[0]]) - 1;
      IF MBF$ACTIVE[0]
      THEN                           # MESSAGE BUFFER IN USE #
        BEGIN  # EXIT #
        IF LLR$PRCNME[0] EQ REQTYP4"INITHW"  ##
          AND LLR$DRFUL[0]
        THEN                         # RESET MSG BUF TO TURN OFF DRD #
          BEGIN  # ERROR #
          GOTO SMSTRC;
          END  # ERROR #
 
        RETURN;                      # ANOTHER LLRQ TURNING OFF DRD #
        END  # EXIT #
 
      IF MBF$WORD[0] NQ 0
      THEN                           # LAST MESSAGE NOT PROCESSED #
        BEGIN  # ABORT #
        FE$RTN[0] = "INITSM1.";
        MESSAGE(FEMSG,UDFL1);
        ABORT;
        END  # ABORT #
 
      P<UDT$MSG> = LOC(UD$MSG[LLR$CU[0]]);
      MS$MSG[0] = HFC$CHSAIF;        # SET *AIF* STATUS #
      UD$SAVE[LLR$CU[0]] = SAVENONE;
      LLR$RS[0] = PROCST"CONT1";     # SET NEW REQUEST STATE #
 
#
*     ISSUE MESSAGES TO CHANGE PATH/SM STATUSES.
#
 
SMMSGE:
      IF INITIALIZE                  ##
        AND DRYUP
      THEN                           # FORCE QUICK EXIT #
        BEGIN  # EXIT #
        RETURN;
        END  # EXIT #
 
      P<MBFHDR> = LOC(UD$MSG[LLR$CU[0]]) - 1;
      IF P<LLRQ> NQ UD$LLRQA[LLR$CU[0]]  # MSG BUF IN USE #
        AND MBF$ACTIVE[0]
      THEN                           # DRD TURNING OFF FROM ERROR #
        BEGIN  # RETRY #
        LLR$RS[0] = PROCST"INITIAL"; # RESET MSG TYPE FROM DRD #
        RETURN;
        END  # RETRY #
 
      SENDMSG;                       # SEND M860 MESSAGE #
      IF UD$MBACT[LLR$CU[0]]
      THEN                           # MESSAGE WAS CREATED #
        BEGIN  # MSG COMPLETE #
        IF UD$SBADDR[LLR$CU[0]] EQ 0 ##
          AND LLR$DR[0] EQ RESPTYP4"OK4"  # GOOD HARDWARE #
        THEN                         # RESPONSE NOT YET RECEIVED #
          BEGIN  # TRY LATER #
          RETURN;
          END  # TRY LATER #
 
        IF MS$MSG[0] EQ HFC$CHSSMA
        THEN                         # SM STATUS CHANGED #
          BEGIN  # CLEAR SM #
          IF MS$PARM1A[0] NQ ONLINE
          THEN                       # SM NOT RESERVED BY THIS MSG #
            BEGIN  # SKIP #
            GOTO INITSM2;
            END  # SKIP #
 
          SM$ACCBUSY[LLR$SMO[0]] = FALSE;  # CLEAR RESERVATION #
          IF LLR$DR[0] NQ RESPTYP4"M86$HDW$PR"
          THEN                       # CHECK FOR SERV CELL CLEANUP #
            BEGIN  # NOT BUSY #
            IF NOT INITIALIZE
            THEN                     # SERVICE CELLS MAY BE FULL #
              BEGIN  # SRV CELL #
              LLR$Y[0] = SC$LOWER$Y; # LOAD FROM LOWER SERVICE CELL #
              LLR$Z[0] = SC$LOWER$Z;
              LLR$LOWSC[0] = TRUE;
              RETURN;
 
SMACQC:
              DRVRACTIVE = TRUE;     # ACQUIRE ATTEMPTED #
              IF LLR$DR[0] NQ RESPTYP4"CELL$EMP"  ##
                AND LLR$DR[0] NQ RESPTYP4"SMA$OFF"  ##
                AND LLR$DR[0] NQ RESPTYP4"M86$HDW$PR"
              THEN                   # EJECT - FULL CELL TURNS SM OFF #
                BEGIN  # EJECT #
                LLR$Y[0] = SM$EXIT$TY;
                LLR$Z[0] = SM$TY$Z;
                RETURN;
                END  # EJECT #
 
SMSTRC:
              DRVRACTIVE = TRUE;     # STORE ATTEMPTED #
              IF LLR$LOWSC[0]        ##
                AND NOT LLR$DRFUL[0] # NO ERROR ON DRD #
              THEN                   # LOWER CELL JUST PROCESSED #
                BEGIN  # UPPER #
                LLR$Y[0] = SC$UPPER$Y;  # LOAD FROM UPPER SERVICE CELL #
                LLR$Z[0] = SC$UPPER$Z;
                LLR$LOWSC[0] = FALSE;
                LLR$UPSC[0] = TRUE;
                RETURN;
                END  # UPPER #
 
              LLR$DR[0] = RESPTYP4"OK4";  # IF LAST STORE HAD ERROR #
              LLR$SC[0] = 0;
              END  # SRV CELL #
 
            END  # NOT BUSY #
 
          SM$SCCU[LLR$SMO[0]] = FALSE;  # BOTH SRV CELLS CHECKED #
 
INITSM2:
          SMST = SMST1;              # ASSUME 2ND CU #
          IF LLR$CU[0] EQ SM$CUO0[LLR$SMO[0]]
          THEN                       # 1ST CU CHANGED SM #
            BEGIN  # RESET #
            SMST = SMST0;
            END  # RESET #
 
          P<PTHSTAT> = LOC(SM$STS[LLR$SMO[0]]);
          PI = SMST;
          GOTO INITSM1;
          END  # CLEAR SM #
 
        P<PTHSTAT> = P<UDT$CN> + ((LLR$CU[0]-1) * UDTCNTL)
                       + LLR$ACKLN[0];
        PI = LLR$ACKIN[0];
        GOTO INITSM1;
        END  # MSG COMPLETE #
 
      IF UD$DRDWAIT[LLR$CU[0]]       ##
        AND MS$MSG[0] EQ HFC$CHSSMA  # STOPS HANG ON AIF-S #
      THEN                           # WAIT FOR SM TO EMPTY #
        BEGIN  # WAIT #
        LLR$RS[0] = PROCST"INITIAL"; # IN CASE RESERVED BY NEXT PASS #
        RETURN;
        END  # WAIT #
 
#
*     ADVANCE TO THE NEXT PATH IN THE M860 INITIALIZING SEQUENCE.
#
 
      IF MS$MSG[0] EQ HFC$CHSDRC
      THEN                           # *DRC* STATUSES CHANGED #
        BEGIN  # EXIT #
        LLR$RS[0] = PROCST"COMPLETE";
        RETURN;
        END  # EXIT #
 
      IF MS$MSG[0] EQ HFC$CHSCIF
      THEN                           # *CIF* STATUSES CHANGED #
        BEGIN  # DRC #
        MS$MSG[0] = HFC$CHSDRC;      # NEXT FUNCTION #
        END  # DRC #
 
      IF MS$MSG[0] EQ HFC$CHSDIO
      THEN                           # *DTI/DTO* STATUSES CHANGED #
        BEGIN  # CIF #
        MS$MSG[0] = HFC$CHSCIF;      # NEXT FUNCTION #
        END  # CIF #
 
      IF MS$MSG[0] EQ HFC$CHSDIF
      THEN                           # *DIF* STATUSES CHANGED #
        BEGIN  # DIO #
        MS$MSG[0] = HFC$CHSDIO;      # NEXT FUNCTION #
        END  # DIO #
 
      IF MS$MSG[0] EQ HFC$CHSSMA
      THEN                           # SM STATUSES CHANGED #
        BEGIN  # DIF #
        MS$MSG[0] = HFC$CHSDIF;      # NEXT FUNCTION #
        END  # DIF #
 
      IF MS$MSG[0] EQ HFC$CHSAIF
      THEN                           # *AIF* STATUSES CHANGED #
        BEGIN  # SM #
        MS$MSG[0] = HFC$CHSSMA;      # NEXT FUNCTION #
        END  # SM #
 
      RETURN;
 
#
*     PRESET MESSAGE BUFFER BEFORE CHANGING STATUSES.
#
 
INITSM1:
      P<MBFHDR> = LOC(UD$MSG[LLR$CU[0]]) - 1;  # RESET FROM SM ORD #
      P<UDT$MSG> = P<MBFHDR> + 1;
      IF MS$MSG[0] EQ HFC$CHSDRD
      THEN                           # BAD DRD WHILE SM TURNED ON #
        BEGIN  # RESET #
        MS$MSG[0] = HFC$CHSSMA;      # GO BACK TO CHECKING SM-S #
        END  # RESET #
 
      IF LLR$DR[0] EQ RESPTYP4"M86$HDW$PR"
      THEN                           # RECOVER SM/PATH STATUS #
        BEGIN  # RECOVER #
        DRVRACTIVE = TRUE;           # FORCE NEXT NORMAL UDT PASS #
        IF (PATHBIT(PI,PATH$DF"U$ON") EQ ON  ##
          OR PATHBIT(PI,PATH$DF"U$RQ$DIAG") EQ ON)  # SM-S ONLY #
          AND MBF$SENT[0]            # SM/PATH REALLY OFF IN HARDWARE #
        THEN                         # INFORM OPER OF SM/PATH PROBLEM #
          BEGIN  # K #
          P<KWORD> = LOC(LLR$KWORDS[0]);
          KW$WORD[0] = 0;
          KW$LINE1[0] = KM"KM2";     # ASSUME SM PROBLEM #
          KW$LINE2[0] = KM"KM16";
          IF MS$MSG[0] NQ HFC$CHSSMA
          THEN                       # PROBLEM IS IN VARYING PATH ON #
            BEGIN  # RESET #
            KW$LINE1[0] = KM"KM1";
            KW$LINE2[0] = KM"KM10";
            END  # RESET #
 
          KP$EQ = UD$ESTO[LLR$CU[0]];  # SET MESSAGE PARAMETERS #
          P<MWBTMP> = LOC(UD$CAMF[LLR$CU[0]]);
          P<FETMWB> = MWB$ADDR[LLR$CIF[0]];
          P<FETMRA> = P<FETMWB> - 1;
          P<FETMRB> = FRA$MRBADR[0];
          KP$CN = FMR$CHAN[0];
          KP$DT = SM$ID[LLR$SMO[0]];
          KW$IC[0] = TRUE;             # SET IMMEDIATE COMPLETION #
          KW$DF[0] = TRUE;             # SEND TO JOB DAYFILE #
          KW$RPGO[0] = TRUE;           # ALLOW GO RESPONSE #
          KREQ(LOC(KWORD),KLINK);      # SEND K-DISPLAY REQUEST #
          END  # K #
 
        IF PATHBIT(PI,PATH$DF"U$ON") EQ OFF  ##
          AND PATHBIT(PI,PATH$DF"U$RQ$DIAG") EQ OFF  ##
          AND NOT MBF$SENT[0]
        THEN                         # STATUS UNCHANGED #
          BEGIN  # SAME #
          PATHBIT(PI,PATH$DF"U$ON") = PATHBIT(PI,PATH$DF"U$CU$ACK");
          PATHBIT(PI,PATH$DF"U$RQ$DIAG") =
                                      PATHBIT(PI,PATH$DF"U$DIAG$ACK");
          END  # SAME #
 
        ELSE                         # SM/PATH ASSUMED OFF IN M860 #
          BEGIN  # OFF #
          PATHBIT(PI,PATH$DF"U$ON") = OFF;
          PATHBIT(PI,PATH$DF"U$RQ$DIAG") = OFF;
          END  # OFF #
 
        END  # RECOVER #
 
      PATHBIT(PI,PATH$DF"U$CU$ACK") = OFF;
      PATHBIT(PI,PATH$DF"U$DIAG$ACK") = OFF;
      IF MBF$SBADDR[0] NQ 0
      THEN                           # STORAGE BUFFER HAS RESPONSE #
        BEGIN  # CLEAR #
        P<UDT$MSG> = MBF$SBADDR[0];
        ZFILL(UDT$MSG,MSGLT);        # CLEAR STORAGE BUFFER #
        END  # CLEAR #
 
      MBF$WORD[0] = 0;
      LLR$RS[0] = PROCST"CONT1";
      RETURN;
      END  # INITSM #
 
    TERM
PROC PPDONE((CBORD));
# TITLE PPDONE - PROCESSED COMPLETED PP CALLS.                        #
 
      BEGIN  # PPDONE #
 
#
**    PPDONE - PROCESS COMPLETED PP CALLS.
*
*     *PPDONE* PROCESSES A PP CALL BLOCK ENTRY WHEN ITS
*     ASSOCIATED PP HAS COMPLETED.
*
*     PROC PPDONE((CBORD))
*
*     ENTRY      (CBORD) = PP CALL BLOCK ENTRY OF COMPLETED PP.
*
*     EXIT       IF ANY INCOMPLETE MESSAGE OR DATA TRANSFERS EXIST ON
*                THE CHANNEL, *1SS* IS RECALLED ON IT.  OTHERWISE, THE
*                ENTRY IS PRESET, AND THE ACTIVE CALL BLOCK ENTRY COUNT
*                IS DECREMENTED.
*
*     MESSAGES   *EXEC ABNORMAL, PPDONE2.* - ERROR IN CALL BLOCK ENTRY
*                                            FIELDS NOT CLEARED WHEN
*                                            PRESETTING.  ALSO OCCURS
*                                            WHEN ACTIVE CALL BLOCK
*                                            ENTRY COUNT NOT GREATER
*                                            THAN ZERO.
*
*                *EXEC ABNORMAL, PPDONE3.* - ERROR IN CALL BLOCK ENTRY
*                                            ADDRESSES CLEARED WHEN
*                                            PRESETTING.
#
 
 
#
****  PROC PPDONE - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ABORT;                  # ABORT #
        PROC FSCLOG;                 # DUMP FSC LOG TO BML #
        PROC MESSAGE;                # ISSUE DAYFILE MESSAGE #
        PROC PROCMRB;                # PROCESS MSG READ BUFFERS #
        PROC SYSTEM;                 # CALL PP #
        END
 
#
****  PROC PPDONE - XREF LIST END.
#
 
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
*CALL,COMBFAS
*CALL,COMBCDD
*CALL,COMBFET
*CALL,COMBUDT
*CALL,COMXCTF
*CALL,COMXMSC
 
      ITEM CBORD      U;             # PP CALL BLOCK ENTRY ORDINAL #
      ITEM MRBSTAT    B;             # SET IF MSG MOVED FROM READ BUF #
                                               CONTROL EJECT;
 
      IF PPU$PADDR[CBORD] EQ 0       ##
        OR PPCBENCNT LQ 0            ##
        OR PPU$ACTIVE[CBORD]
      THEN                           # CALL BLOCK ENTRY ERRORS #
        BEGIN  # ABORT #
        FE$RTN[0] = "PPDONE2.";
        GOTO PPDONE1;
        END  # ABORT #
 
      IF PPU$MBADDR[CBORD] NQ 0
      THEN                           # PP TRANSFER COMPLETE #
        BEGIN  # DONE #
        P<FETMWB> = PPU$MBADDR[CBORD];  # GET WRITE BUF ADDRESS #
        P<FETMRA> = P<FETMWB> - 1;
        P<FETMRB> = FRA$MRBADR[0];   # GET READ BUF ADDRESS #
        IF PPU$ESTORD[CBORD] EQ 0    ##
          OR PPU$CNTORD[CBORD] EQ 0  ##
          OR B<FMR$CIF[0],1>UD$WBACT[FMR$CU[0]] EQ 0  ##
          OR (PPU$DBADDR[CBORD] NQ 0 ##
          AND B<FMR$CIF[0],1>UD$DBACT[FMR$CU[0]] EQ 0)
        THEN                         # ERRORS IN PRESETTING #
          BEGIN  # ABORT #
          FE$RTN[0] = "PPDONE3.";
          GOTO PPDONE1;
          END  # ABORT #
 
        IF FMW$AT[0] NQ 0
        THEN                         # PP ERROR FOUND #
          BEGIN  # FSC #
          FSCLOG(WFET);              # DUMP FSC LOG TO BML #
          IF PPU$ACTIVE[CBORD]
          THEN                       # ERROR CAUSED PP TO DOWN CHANNEL #
            BEGIN  # EXIT #
            RETURN;                  # DO NOT PROCESS ACTIVE PP #
            END  # EXIT #
 
          END  # FSC #
 
        DRVRACTIVE = TRUE;           # DRIVER HAS WORK TO DO #
        MRBSTAT = TRUE;
        REPEAT WHILE MRBSTAT
        DO                           # REMOVE MSGS FROM READ BUFFER #
          BEGIN  # REMOVE MSGS #
          PROCMRB(MRBSTAT);          # PROCESS READ BUFFER #
          END  # REMOVE MSGS #
 
        P<FETFHB> = PPU$DBADDR[CBORD];  # IN CASE DATA TRANSFER #
        IF PPU$DBADDR[CBORD] NQ 0    ##
          AND (FHB$CODE[0] NQ FCRUN  # STILL TRANSFERRING DATA #
          OR NOT FHB$LOCK[0])        # FUNCTION NOT ANSWERED #
        THEN                         # DATA TRANSFER INCOMPLETE #
          BEGIN  # RECALL PP #
          PPU$FC[CBORD] = IRMDAT;    # IN CASE OF CHANNEL FUNCTION #
          GOTO PPDONE2;
          END  # RECALL PP #
 
        IF PPU$DBADDR[CBORD] NQ 0    # NOT MOUNT-VOLUME MESSAGE #
        THEN                         # DATA TRANSFER COMPLETE #
          BEGIN  # OFF #
          PPU$DBADDR[CBORD] = 0;
          B<FMR$CIF[0],1>UD$DBACT[FMR$CU[0]] = OFF;
          END  # OFF #
 
        IF FMW$IN[0] NQ FMW$OUT[0]   # WRITE BUFFER NOT EMPTY #
          OR MSGCNT(FMR$CIF[0],FMR$CU[0]) NQ 0  # MSGS EXPECTED #
        THEN                         # MESSAGE TRANSFER INCOMPLETE #
          BEGIN  # RECALL PP #
          PPU$FC[CBORD] = IRPMSG;    # IN CASE OF DATA/CHN FUNCTION #
          GOTO PPDONE2;              # ISSUE PP RECALL #
          END  # RECALL PP #
 
        B<FMR$CIF[0],1>UD$WBACT[FMR$CU[0]] = OFF;
                                     # CLEAR WRITE BUFFER ACTIVE FLAG #
        END  # DONE #
 
      PPU$W0INFO[CBORD] = 0;         # PRESET FOR NEXT PP CALL #
      PPU$WORD1[CBORD] = 0;
      PPU$DRCL[CBORD] = LOC(DRVRRECALL);  # RESET RECALL ADDRESS #
      PPCBENCNT = PPCBENCNT - 1;     # MARK ENTRY AS REMOVED #
      RETURN;
 
PPDONE1:
      MESSAGE(FEMSG,UDFL1);          # ABORT PROCESSING #
      ABORT;
 
PPDONE2:
      PPU$CHAN[CBORD] = 0;
      PPU$ACTIVE[CBORD] = TRUE;      # SET PP ACTIVE #
      PPT$WORD0[0] = PPU$WORD0[CBORD];
      SPC$ADDR[0] = LOC(PPT$WORD0[0]);
      REPEAT WHILE PPT$WORD0[0] NQ 0
      DO                             # ISSUE PP CALL #
        BEGIN  # PP #
        SYSTEM(SPC,NRCL);
        END  # PP #
 
      RETURN;
      END  # PPDONE #
 
    TERM
PROC PROCDRQ;
# TITLE PROCDRQ - PROCESS DRIVER REQUESTS.                            #
 
      BEGIN  # PROCDRQ #
 
#
**    PROCDRQ - PROCESS DRIVER REQUESTS.
*
*     *PROCDRQ* PROCESSES A *DRQUEUE* REQUEST.  IT ROUTES IT
*     TO THE APPROPRIATE REQUEST PROCEDURE BASED ON THE
*     *DRQUEUE* ENTRY REQUEST CODE.
*
*     PROC PROCDRQ
*
*     ENTRY      P<LLRQ> = *DRQUEUE* ENTRY ADDRESS.
*
*     EXIT       THE *DRQUEUE* ENTRY REQUEST STATE FIELD HAS BEEN
*                UPDATED TO INDICATE WHERE SUBSEQUENT PROCESSING OF
*                THIS REQUEST IS TO CONTINUE.
#
 
 
#
****  PROC PROCDRQ - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ACQCART;                # LOAD CARTRIDGE #
        PROC GENREQ;                 # GENERAL DRIVER REQUESTS #
        PROC INITDRD;                # INITIALIZE DRD-S #
        PROC INITSM;                 # INITIALIZE SM-S #
        PROC RESTCU;                 # RESTART CONTROLLER #
        PROC STRCART;                # STORE CARTRIDGE #
        PROC XFRDATA;                # TRANSFER DATA TO/FROM M860 #
        END
 
#
****  PROC PROCDRQ - XREF LIST END.
#
 
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
*CALL,COMBFAS
*CALL,COMBCDD
*CALL COMBCPR
*CALL,COMBLRQ
*CALL,COMBRCD
*CALL,COMBUDT
*CALL,COMXMSC
 
      SWITCH DRQCODE:REQCODE         # DRIVER REQUEST CODES #
             DRQINDR:SINIT$DRD,      # INITIALIZE DRD-S #
             DRQINSM:SINIT$SM,       # INITIALIZE SM-S AND PATHS #
             DRQSTRC:SDISMOUNT,      # STORE CARTRIDGE #
             DRQACQC:SMOUNT,         # LOAD CARTRIDGE #
             DRQRDRW:SRDRAW$STP,     # READ RAW DATA #
             DRQXFRD:SREAD$VOL,      # TRANSFER DATA #
             DRQRSCU:SRESTART$CU,    # RESTART CONTROLLER #
             DRQWRCL:SWRT$LABEL,     # WRITE CARTRIDGE LABEL #
             DRQWRVL:SWRT$VOL;       # WRITE VOLUME LABEL #
                                               CONTROL EJECT;
 
      GOTO DRQCODE[LLR$RC[0]];
 
#
*     LOAD CARTRIDGE.
#
 
DRQACQC:
      ACQCART;
      IF LLR$RS[0] EQ PROCST"COMPLETE"  ##
        AND LLR$PRCNME[0] EQ REQTYP4"INITHW"
      THEN                           # LOAD FROM SERVICE CELL #
        BEGIN  # CELL #
        LLR$RC[0] = LLR$SRC[0];      # INITDRD OR INITSM #
        LLR$RS[0] = PROCST"CONT2";
        END  # CELL #
 
      IF (LLR$Y[0] EQ SM$EXIT$TY     # EJECT CARTRIDGE #
        AND LLR$Z[0] EQ SM$TY$Z)     ##
        OR LLR$LDERR[0]              # DDE ON LOAD #
      THEN                           # PROCESS PROBLEM #
        BEGIN  # EJECT #
        LLR$RC[0] = DISMOUNT;
        LLR$RS[0] = PROCST"INITIAL";
        END  # EJECT #
 
      RETURN;
 
#
*     INITIALIZE DRD-S.
#
 
DRQINDR:
      INITDRD;
      IF LLR$DRDOFF[0]               # DRD OFF DUE TO ERROR #
        AND (LLR$RS[0] EQ PROCST"COMPLETE"  # NORMAL REQUEST DONE #
        OR LLR$PRCNME[0] EQ REQTYP4"INITHW")  # INIT REQUEST NOT DONE #
      THEN                           # SEND K-DISPLAY MSG #
        BEGIN  # K #
        LLR$RC[0] = DISMOUNT;
        LLR$RS[0] = PROCST"CONT3";
        END  # K #
 
      IF LLR$SC[0] NQ 0              ##
        AND NOT LLR$DRFUL[0]         # NOT IF TURNING OFF DRD #
      THEN                           # PROCESSING SERVICE CELL #
        BEGIN  # CELL #
        GOTO PROCDRQ1;
        END  # CELL #
 
      RETURN;
 
#
*     INITIALIZE SM-S AND ALL CONTROLLER PATHS.
#
 
DRQINSM:
      INITSM;
      IF LLR$RS[0] EQ PROCST"COMPLETE"  ##
        AND LLR$DR[0] EQ RESPTYP4"OK4"
      THEN                           # COMPLETED REQUEST #
        BEGIN  # COMPLETE #
        LLR$RC[0] = INIT$DRD;        # PROCESS DRD-S #
        LLR$RS[0] = PROCST"INITIAL";
        END  # COMPLETE #
 
      IF LLR$SC[0] NQ 0
      THEN                           # PROCESSING SERVICE CELLS #
        BEGIN  # CELL #
        GOTO PROCDRQ1;
        END  # CELL #
 
      RETURN;
 
#
*     READ RAW DATA.
#
 
DRQRDRW:
      GENREQ;
      RETURN;
 
#
*     RESTART CONTROLLER.
#
 
DRQRSCU:
      RESTCU;
      IF LLR$RS[0] EQ PROCST"COMPLETE"  ##
        AND LLR$DR[0] EQ RESPTYP4"OK4"
      THEN                           # COMPLETED REQUEST #
        BEGIN  # COMPLETE #
        LLR$RC[0] = INIT$SM;         # PROCESS SM-S AND CU PATHS #
        LLR$RS[0] = PROCST"INITIAL";
        END  # COMPLETE #
 
      RETURN;
 
#
*     STORE CARTRIDGE.
#
 
DRQSTRC:
      STRCART;
      IF LLR$RS[0] EQ PROCST"CONT3"
      THEN                           # TURN DRD OFF #
        BEGIN  # OFF #
        LLR$RC[0] = INIT$DRD;
        LLR$RS[0] = PROCST"INITIAL";
        END  # OFF #
 
      IF LLR$RS[0] EQ PROCST"COMPLETE"  ##
        AND LLR$PRCNME[0] EQ REQTYP4"INITHW"
      THEN                           # SM/DRD INITIALIZING #
        BEGIN  # INIT #
        LLR$RC[0] = LLR$SRC[0];      # INITDRD OR INITSM #
        LLR$RS[0] = PROCST"CONT3";
        END  # INIT #
 
      RETURN;
 
#
*     WRITE CARTRIDGE LABEL.
#
 
DRQWRCL:
      GENREQ;
      IF LLR$RS[0] EQ PROCST"COMPLETE"  ##
        AND LLR$DR[0] EQ RESPTYP4"OK4"
      THEN                           # COMPLETED REQUEST #
        BEGIN  # COMPLETE #
        LLR$RC[0] = DISMOUNT;        # STORE CARTRIDGE #
        LLR$RS[0] = PROCST"INITIAL";
        END  # COMPLETE #
 
      RETURN;
 
#
*     WRITE VOLUME LABEL.
#
 
DRQWRVL:
      GENREQ;
      IF LLR$RS[0] EQ PROCST"COMPLETE"  ##
        AND LLR$DR[0] EQ RESPTYP4"OK4"
      THEN                           # COMPLETED REQUEST #
        BEGIN  # COMPLETE #
        LLR$RC[0] = READ$VOL;        # MOUNT VOLUME #
        LLR$RS[0] = PROCST"INITIAL";
        END  # COMPLETE #
 
      RETURN;
 
#
*     TRANSFER DATA TO/FROM M860.
#
 
DRQXFRD:
      XFRDATA;
      RETURN;
 
PROCDRQ1:
      LLR$SRC[0] = LLR$RC[0];        # SAVE IN CASE OF DRD ERROR #
      LLR$RC[0] = DISMOUNT;          # ASSUME STORE #
      LLR$RS[0] = PROCST"INITIAL";
      IF (LLR$Y[0] EQ SC$LOWER$Y     ##
        AND LLR$Z[0] EQ SC$LOWER$Z)  ##
        OR (LLR$Y[0] EQ SC$UPPER$Y   ##
        AND LLR$Z[0] EQ SC$UPPER$Z)
      THEN                           # LOADING CARTRIDGE #
        BEGIN  # RESET #
        LLR$RC[0] = MOUNT;
        END  # RESET #
 
      RETURN;
      END  # PROCDRQ #
 
    TERM
PROC PROCMRB(MSTAT);
# TITLE PROCMRB - PROCESS MESSAGE READ BUFFERS.                       #
 
      BEGIN  # PROCMRB #
 
#
**    PROCMRB - PROCESS MESSAGE READ BUFFERS.
*
*     *PROCMRB* PROCESSES ALL INCOMING M860 RESPONSES FOUND WITHIN THE
*     MESSAGE READ FET BUFFERS.
*
*     PROC PROCMRB(MSTAT)
*
*     ENTRY      (MSTAT) = NONZERO, IF AN M860 MESSAGE WAS REMOVED FROM
*                          THE READ BUFFER.
*
*                THE MESSAGE FET BASED ARRAYS POINT TO THE FETS
*                ASSOCIATED WITH THE DESIRED CHANNEL.
*
*     EXIT       THE M860 RESPONSE IS TRANSFERRED OUT OF THE MESSAGE
*                READ BUFFER AND INTO A STORAGE BUFFER TABLE ENTRY.  IF
*                THE RESPONSE WAS INITIATED BY THE CPU DRIVER, THE
*                CHANNEL MESSAGE COUNT IS DECREMENTED.
*
*     MESSAGES   *EXEC ABNORMAL, PROCMRB2.* - ERROR LOG COUNT IS ZERO
*                                             WITH AN ERROR LOG IN THE
*                                             SBT.
*
*                *EXEC ABNORMAL, PROCMRB3.* - NO RAW DATA ADDRESS FOUND
*                                             FOR AN M860 *READ RAW
*                                             DATA* RESPONSE.
*
*                *EXEC ABNORMAL, PROCMRB4.* - M860 RESPONSE FOUND
*                                             CSN/DRD IN USE.
*
*                *EXEC ABNORMAL, PROCMRB7.* - ERROR IN READING
*                                             CARTRIDGE LABEL.
*
*                *EXEC ABNORMAL, PROCMRB8.* - ERROR WHEN FLUSHING DATA
*                                             FROM THE MESSAGE READ
*                                             BUFFER.
#
 
 
#
****  PROC PROCMRB - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ABORT;                  # ABORT #
        PROC BMLOG;                  # SEND LOG TO BML #
        PROC CALLPP;                 # PASS MESSAGES TO PP #
        PROC DOWNCU;                 # DOWN BAD CONTROLLER #
        PROC FSCLOG;                 # DUMP FSC LOG TO BML #
        PROC GDATA;                  # GET DATA FROM READ BUFFER #
        PROC GMSG;                   # CHECKSUM MSG FROM READ BUFFER #
        PROC MESSAGE;                # ISSUE DAYFILE MESSAGE #
        PROC ZFILL;                  # ZERO-FILL BUFFER #
        END
 
#
****  PROC PROCMRB - XREF LIST END.
#
 
      DEF DBLEN      #10#;           # BAD-DATA BUFFER LENGTH #
      DEF ERRLOGLEN  #18#;           # ERROR LOG LENGTH #
 
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
*CALL,COMBFAS
*CALL,COMBCDD
*CALL,COMBFET
*CALL,COMBCPR
*CALL,COMBHFC
*CALL,COMBLBL
*CALL,COMBKDD
*CALL,COMBLRQ
*CALL,COMBMAT
*CALL,COMBUDT
*CALL,COMXCTF
*CALL,COMXMSC
 
      ITEM ASSOCDATA  U;             # ASSOCIATED DATA LENGTH #
      ITEM DATASIZE   U;             # SIZE OF BAD DATA MOVED #
      ITEM I          I;             # INDEX #
      ITEM MSTAT      B;             # SET IF MSG REMOVED #
      ITEM STAT       U;             # MSG/DATA TRANSFER STATUS #
 
#
*     ARRAY TO READ DATA FROM ABORTED MESSAGE INTO.
#
 
      ARRAY DBUF [0:0] S(DBLEN); ;   # BAD-DATA ARRAY #
                                               CONTROL EJECT;
 
      MSTAT = FALSE;                 # NO MESSAGE REMOVED #
      P<KWORD> = LOC(FMR$KWORDS[0]);
      IF NOT KW$COMP[0]
      THEN                           # K-DISPLAY REQUEST INCOMPLETE #
        BEGIN  # WAIT #
        DRVRRECALL = TRUE;           # INSURE K-DISPLAY MSG SENT #
        RETURN;
        END  # WAIT #
 
      IF FMR$AT[0] NQ 0
      THEN                           # PP ERROR CODE FOUND #
        BEGIN  # FSC #
        FSCLOG(RFET);                # DUMP FSC LOG TO BML #
        END  # FSC #
 
      IF FMR$ELCNT[0] NQ 0
      THEN                           # ERROR LOG RESPONSES NOT SENT #
        BEGIN  # ERROR LOG #
        SLOWFOR I = 0 STEP 1 WHILE I LS MAT$COUNT[MAT$ENTRY"SBT"]
        DO                           # SEARCH FOR ERROR LOG RESPONSE #
          BEGIN  # SEARCH #
          P<UDT$MSG> = MAT$FWA[MAT$ENTRY"SBT"] + (I * MSGLT);
          IF MS$CU[0] NQ FMR$CU[0]   # NOT RIGHT CU #
            OR UD$MASC[FMR$CU[0]] NQ FMR$CHAN[0]  # NOT MASTER CHAN #
          THEN                       # NOT ERROR LOG FROM THIS CU #
            BEGIN  # NEXT #
            TEST I;
            END  # NEXT #
 
          IF UD$CUON[FMR$CU[0]]
          THEN                       # HARDWARE AVAILABLE #
            BEGIN  # SEND #
            CALLPP(IRPMSG);          # SEND RESPONSE TO CU #
            IF MS$CU[0] NQ 0         ##
              AND LLR$DR[0] NQ RESPTYP4"M86$HDW$PR"
            THEN                     # RESPONSE NOT SENT #
              BEGIN  # NEXT #
              TEST I;
              END  # NEXT #
 
            END  # SEND #
 
          IF FMR$ELCNT[0] EQ 0
          THEN                       # LOG COUNT TOO LOW #
            BEGIN  # ABORT #
            FE$RTN[0] = "PROCMRB2.";
            GOTO PROCMRB1;
            END  # ABORT #
 
          FMR$ELCNT[0] = FMR$ELCNT[0] - 1;  # MARK RESPONSE AS SENT #
          ZFILL(UDT$MSG,MSGLT);      # CLEAR SBT ENTRY #
          END  # SEARCH #
 
        END  # ERROR LOG #
 
      IF FMR$IN[0] EQ FMR$OUT[0]
      THEN                           # EMPTY READ BUFFER #
        BEGIN  # EXIT #
        RETURN;
        END  # EXIT #
 
      P<UDT$MSG> = FMR$OUT[0];
      IF MS$MSG[0] EQ HFC$RDRAW      ##
        AND FMR$RDBA[0] EQ 0
      THEN                           # MISSING RAW DATA BUF ADDRESS #
        BEGIN  # ABORT #
        FE$RTN[0] = "PROCMRB3.";
        GOTO PROCMRB1;
        END  # ABORT #
 
      IF MS$MSG[0] EQ HFC$RDRAW      # READ-RAW-DATA MSG #
      THEN                           # READ MSG INTO DATA BUFFER #
        BEGIN  # DATA BUF #
        P<UDT$MSG> = FMR$RDBA[0] - MSGLT;
        END  # DATA BUF #
 
      ELSE                           # READ MSG INTO SBT ENTRY #
        BEGIN  # SBT #
        P<UDT$MSG> = SBTADR;
        SLOWFOR I = 1 STEP 1 WHILE MS$MSG0[0] NQ 0
        DO                           # FIND FREE STORAGE BUFFER #
          BEGIN  # FIND #
          IF I GQ MAT$COUNT[MAT$ENTRY"SBT"]
          THEN                       # NO FREE ENTRY #
            BEGIN  # EXIT #
            RETURN;
            END  # EXIT #
 
          P<UDT$MSG> = P<UDT$MSG> + MSGLT;  # NEXT ENTRY #
          END  # FIND #
 
        END  # SBT #
 
      GMSG(FETMRB,UDT$MSG,STAT);     # CHECKSUM TO STORAGE BUFFER #
      MSTAT = TRUE;                  # INDICATE MESSAGE REMOVED #
      DRVRACTIVE = TRUE;             # NOTE DRIVER HAD ACTIVITY #
      ASSOCDATA = ((MS$ASS$DT[0]*2)+14)/15;
      IF STAT NQ 0                   # BAD CHECKSUM ON READ #
        OR ((MS$RETCODE[0] EQ HRC$XSMERR  # BAD CHECKSUM ON WRITE #
        OR MS$RETCODE[0] EQ HRC$XSMNA)  # NO ABORT ON CHECKSUM #
        AND MS$MSG[0] LS HRF$M860)   # NOT M860-INITIATED #
      THEN                           # FATAL CHANNEL ERROR #
        BEGIN  # DOWN #
        IF FMW$CHON[0]
        THEN                         # FIRST INDICATION OF BAD CHANNEL #
          BEGIN  # FIRST #
          FMR$AT[0] = RCXSUM;        # SET CHECKSUM ERROR IN FET #
          FSCLOG(RFET);              # DUMP FSC LOG TO BML #
          END  # FIRST #
 
        GOTO PROCMRB2;               # LET MESSAGE TIMEOUT HANDLE IT #
        END  # DOWN #
 
      IF MS$MSG[0] EQ HFC$ENCRDR     # *ENTER* MESSAGE #
        AND MS$RETCODE[0] EQ HRC$DRVERR  # DEVICE DRIVER ERROR #
      THEN                           # ACTUALLY MEANS INPUT TRAY EMPTY #
        BEGIN  # RESET #
        MS$RETCODE[0] = HRC$TRAYPR;     ##
        END  # RESET #
 
      IF MS$RETCODE[0] EQ HRC$DRVNA
        AND MS$MSG[0] EQ HFC$RCLBP0
      THEN  # ** M860 PATCH #
        BEGIN
        MS$RETCODE[0] = HRC$NOLAB;
        END
 
      IF (MS$RETCODE[0] EQ HRC$DRVERR  # DEVICE DRIVER ERROR #
        OR MS$RETCODE[0] EQ HRC$DRVHW  ##
        OR MS$RETCODE[0] EQ HRC$DRVNA)  ##
        AND (MS$MSG[0] LS HFC$CHSCIF  # LET CU ACCESS ON SM/DRD-S #
        OR MS$MSG[0] GR HFC$CHSAIF)  # HANDLE PATH STATUS ERRS LATER #
        AND MS$MSQN$DI[0] EQ 0       # ONLY CU MESSAGES #
        AND MS$MSG[0] LS HRF$M860    # NOT M860-INITIATED #
      THEN                           # CONTROLLER HAVING PROBLEMS #
        BEGIN  # DOWN #
        IF UD$CUON[FMR$CU[0]] OR UD$CNUP[FMR$CU[0]]
        THEN                         # FIRST INDICATION OF BAD CU #
          BEGIN  # FIRST #
          DOWNCU(FMR$CU[0]);         # DOWN BAD CONTROLLER #
          END  # FIRST #
 
        ZFILL(UDT$MSG,MSGLT);        # THROW AWAY MESSAGE #
        RETURN;
        END  # DOWN #
 
      IF MS$MSG[0] GQ HRF$ELGFUL     ##
        AND MS$MSG[0] LQ HRF$REQDMP
      THEN                           # SEND ERROR LOG TO BML #
        BEGIN  # BML #
        IF ASSOCDATA GR ERRLOGLEN
        THEN                         # THROW AWAY MESSAGE #
          BEGIN  # EXIT #
          GOTO PROCMRB2;
          END  # EXIT #
 
        BMLOG;
        MS$RETCODE[0] = 0;           # SEND OK BACK TO CU #
        MS$MSG$R[0] = TRUE;          # SET AS RESPONSE #
        MS$ASS$DT[0] = 0;            # SEND BACK MESSAGE ONLY #
        MS$CU[0] = FMR$CU[0];        # SAVE CU ORDINAL #
        FMR$ELCNT[0] = FMR$ELCNT[0] + 1;  # COUNT ERROR LOG RESPONSES #
        RETURN;
        END  # BML #
 
      IF MS$RETCODE[0] EQ HRC$CSNERR # CSN/DRD IN USE #
        AND MS$MSG[0] NQ HFC$STCRNF  # RETRY AS NORMAL STORE #
        AND MS$MSG[0] NQ HFC$STCRNV  # IN CASE RCVY FROM *ACQ* ERROR #
      THEN                           # SOFTWARE ERROR #
        BEGIN  # ABORT #
        FE$RTN[0] = "PROCMRB4.";
        GOTO PROCMRB1;
        END  # ABORT #
 
      IF MSGCNT(FMR$CIF[0],FMR$CU[0]) EQ 0
      THEN                           # THIS RESPONSE TIMED OUT #
        BEGIN  # THROW #
        GOTO PROCMRB2;               # ORIGINAL MESSAGE TIMED OUT #
        END  # THROW #
 
#
*     LOCATE THE UDT MESSAGE BUFFER ASSOCIATED WITH THE
*     INCOMING RESPONSE.
#
 
      P<MBFHDR> = LOC(UD$MSG[MS$MSQN$CN[0]]) - 1;  # ASSUME CU MSG #
      IF MS$MSQN$D0[0]
      THEN                           # DRD 0 MESSAGE #
        BEGIN  # DRD 0 #
        P<MBFHDR> = LOC(D0$MSG[MS$MSQN$CN[0]]) - 1;
        END  # DRD 0 #
 
      IF MS$MSQN$D1[0]
      THEN                           # DRD 1 MESSAGE #
        BEGIN  # DRD 1 #
        P<MBFHDR> = LOC(D1$MSG[MS$MSQN$CN[0]]) - 1;
        END  # DRD 1 #
 
      IF MS$MSG[0] EQ HRF$CONRES
      THEN                           # *CURESTART* MESSAGE #
        BEGIN  # LOCATE ADDRESS #
        P<MBFHDR> = LOC(UD$MSG[FMR$CU[0]]) - 1;  # USE PASSED CU ORD #
        END  # LOCATE ADDRESS #
 
      IF MS$MSG[0] EQ HRF$UNITRW     ##
        OR MS$MSG[0] EQ HRF$FORCRW
      THEN                           # *UNLOAD* MESSAGE #
        BEGIN  # LOCATE ADDRESS #
        P<MBFHDR> = LOC(D1$MSG[MS$DEV$SM[0]+1]) - 1;  # ASSUME LOWER #
        IF NOT MS$DEV$ODD[0]
        THEN                         # UPPER DRD IN USE #
          BEGIN  # RESET #
          P<MBFHDR> = LOC(D0$MSG[MS$DEV$SM[0]+1]) - 1;
          END  # RESET #
 
        END  # LOCATE ADDRESS #
 
      IF (NOT MBF$ACTIVE[0])         # NO ACTIVE MESSAGE BUFFER #
        OR MBF$SBADDR[0] NQ 0        # STILL PROCESSING LAST RESPONSE #
      THEN                           # MSG BUFFER FIELDS NOT READY #
        BEGIN  # ABORT #
        GOTO PROCMRB2;
        END  # ABORT #
 
      MBF$SBADDR[0] = P<UDT$MSG>;    # SET STORAGE BUF ADDR #
      IF MS$MSG[0] GQ HFC$RCLBP0     # *READCRTLBL* MESSAGE #
        AND MS$MSG[0] LQ HFC$RCLBP9  ##
        AND MS$ASS$DT[0] NQ 0
      THEN                           # CARTRIDGE LABEL FOLLOWS MSG #
        BEGIN  # GET LABEL #
        ASSOCDATA = ((MS$ASS$DT[0]*2)+14)/15;
        IF ASSOCDATA GR LABLEN
        THEN                         # COULD BE CE LABEL #
          BEGIN  # CLEAR #
          MS$ASS$DT[0] = 0;          # TREAT LIKE NO-LABEL #
          MS$RETCODE[0] = HRC$NOLAB;
          RETURN;
          END  # CLEAR #
 
        GDATA(FETMRB,LABEL$CART,ASSOCDATA,STAT);
        IF STAT NQ 0
        THEN                         # ERROR IN READING LABEL #
          BEGIN  # ABORT #
          FE$RTN[0] = "PROCMRB7.";
          GOTO PROCMRB1;
          END  # ABORT #
 
        END  # GET LABEL #
 
      IF MS$MSG[0] GQ HFC$DBLD0  ##
        AND MS$MSG[0] LQ HFC$DBLD7
      THEN                           # SEND BUFFERED LOG TO BML #
        BEGIN  # BML #
        BMLOG;
        END  # BML #
 
      IF MS$MSG[0] EQ HFC$RDRAW
      THEN                           # FINISH RAW DATA BUF PROCESSING #
        BEGIN  # FINISH RAW #
        P<FETFHB> = FMR$RDBA[0] - MSGLT - RFHBL;  # GET DATA BUF ADDR #
        FMR$RDBA[0] = 0;             # NO RAW DATA EXPECTED #
        IF MS$ASS$DT[0] NQ 0
        THEN                         # RAW DATA READ OK #
          BEGIN  # OK #
          FHB$IN[0] = FHB$FRST[0] + MSGLT + RWDATA;
          END  # OK #
 
        ELSE                         # STRIPE HAS NO DATA #
          BEGIN  # NONE #
          FHB$IN[0] = FHB$FRST[0] + MSGLT;  # COUNT MSG ONLY #
          END  # NONE #
 
        FHB$LOCK[0] = TRUE;          # SET DATA TRANSFER COMPLETE #
        END  # FINISH RAW #
 
      RETURN;
 
PROCMRB1:
      MESSAGE(FEMSG,UDFL1);          # ABORT PROCESSING #
      ABORT;
 
PROCMRB2:
      IF ASSOCDATA NQ 0              ##
        AND MS$MSG[0] NQ HFC$RDRAW   # RAW DATA ALREADY SENT #
      THEN                           # THROW ASSOCIATED DATA #
        BEGIN  # THROW #
        DATASIZE = DBLEN;
        REPEAT WHILE ASSOCDATA GR 0
        DO                           # READ DATA FROM FET BUFFER #
          BEGIN  # READ #
          IF ASSOCDATA LS DBLEN
          THEN                       # LAST DATA PORTION #
            BEGIN  # RESET #
            DATASIZE = ASSOCDATA;    # READ SMALL BLOCK #
            END  # RESET #
 
          GDATA(FETMRB,DBUF,DATASIZE,STAT);
          IF STAT NQ 0
          THEN                       # DATA READ ERROR #
            BEGIN  # ABORT #
            FE$RTN[0] = "PROCMRB8.";
            GOTO PROCMRB1;
            END  # ABORT #
 
          ASSOCDATA = ASSOCDATA - DATASIZE;  # COUNT DATA REMOVED #
          END  # READ #
 
        END  # THROW #
 
      ZFILL(UDT$MSG,MSGLT);          # THROW AWAY MESSAGE #
      RETURN;
      END  # PROCMRB #
 
    TERM
PROC RESTCU;
# TITLE RESTCU - PERFORM CONTROLLER RESTART PROCESSING.               #
 
      BEGIN  # RESTCU #
 
#
**    RESTCU - PERFORM CONTROLLER RESTART PROCESSING.
*
*     *RESTCU* PROCESSES M860 CONTROLLER STATUS CHANGES.  ALL M860
*     MESSAGES NEEDED FOR CONTROLLER INITIALIZATION ARE SENT.
*
*     PROC RESTCU
*
*     ENTRY      P<LLRQ> = *DRQUEUE* ENTRY ADDRESS.
*
*     EXIT       THE *DRQUEUE* ENTRY REQUEST STATE FIELD HAS BEEN
*                UPDATED TO INDICATE WHERE SUBSEQUENT PROCESSING OF
*                THIS REQUEST IS TO CONTINUE.
*
*     MESSAGES   *EXEC ABNORMAL, RESTCU1.* - UDT MESSAGE BUFFER STILL
*                                            IN USE.
*
*                *EXEC ABNORMAL, RESTCU2.* - THE NEXT M860 CONTROLLER
*                                            INITIALIZATION FUNCTION
*                                            WAS NOT FOUND IN THE
*                                            FUNCTION LIST.
*
*     NOTES      THIS IS A PSEUDO-REENTRANT PROCEDURE.
#
 
 
#
****  PROC RESTCU - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ABORT;                  # ABORT #
        PROC DOWNCU;                 # DOWN CONTROLLER #
        PROC MESSAGE;                # ISSUE DAYFILE MESSAGE #
        PROC SENDMSG;                # SEND M860 MESSAGE #
        FUNC XCOD C(10);             # CONVERT OCTAL TO DISPLAY-CODE #
        PROC ZFILL;                  # ZERO-FILL BUFFER #
        END
 
#
****  PROC RESTCU - XREF LIST END.
#
 
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
*CALL,COMBFAS
*CALL,COMBCPR
*CALL,COMBFET
*CALL,COMBHFC
*CALL,COMBLRQ
*CALL,COMBUDT
*CALL,COMXCTF
*CALL,COMXMSC
 
      DEF MSGNUMM1   #7#;            # NUMBER OF CU MSGS TO SEND - 1 #
 
      ITEM CORD       U;             # TEMP CU ORDINAL #
      ITEM I          I;             # INDEX #
 
#
*     THIS ARRAY DEFINES THE ORDER TO ISSUE CONTROLLER MESSAGES.
#
 
      ARRAY NEXTMSG [0:MSGNUMM1] S(1);  # NEXT MESSAGE TO ISSUE #
        BEGIN
        ITEM NEXTFTN    U(00,00,60) = [HFC$RESCON,  ##
                                       HFC$SETMAS,  ##
                                       HFC$STDATM,  ##
                                       HFC$STERLN];
        END
 
      SWITCH RESTARTLBL:PROCST       # DRIVER REQUEST STATE #
                RESINIT:INITIAL,     # INITIAL STATE #
                RESMSGE:CONT1;       # CONTINUATION 1 #
                                               CONTROL EJECT;
 
      GOTO RESTARTLBL[LLR$RS[0]];
 
#
*     INITIAL DRIVER REQUEST STATE.
#
 
RESINIT:
      P<MBFHDR> = LOC(UD$MSG[LLR$CU[0]]) - 1;
      IF MBF$WORD[0] NQ 0
      THEN                           # LAST MESSAGE NOT PROCESSED #
        BEGIN  # ABORT #
        FE$RTN[0] = "RESTCU1.";
        GOTO RESTCU1;
        END  # ABORT #
 
      IF CURESERVED
      THEN                           # ANOTHER CU INITIALIZING #
        BEGIN  # WAIT #
        RETURN;                      # INITIALIZE CU-S ONE AT A TIME #
        END  # WAIT #
 
      CURESERVED = TRUE;             # ONLY THIS CU INITIALIZING #
      P<UDT$MSG> = P<MBFHDR> + 1;
      MS$MSG[0] = HFC$RESCON;        # *RESTART* FUNCTION #
      UD$SAVE[LLR$CU[0]] = SAVEPART;
      LLR$RS[0] = PROCST"CONT1";     # SET NEW REQUEST STATE #
 
#
*     ISSUE MESSAGES TO INITIALIZE CONTROLLER.
#
 
RESMSGE:
      IF INITIALIZE                  ##
        AND DRYUP
      THEN                           # FORCE QUICK EXIT #
        BEGIN  # EXIT #
        RETURN;
        END  # EXIT #
 
      P<MBFHDR> = LOC(UD$MSG[LLR$CU[0]]) - 1;
      SENDMSG;                       # SEND M860 MESSAGE #
      IF (UD$SBADDR[LLR$CU[0]] EQ 0  # RESPONSE NOT YET RECEIVED #
        OR NOT UD$MSGSENT[LLR$CU[0]])# CURESTART RESPONSE NOT SENT #
        AND UD$MBACT[LLR$CU[0]]      # *START ERROR LOG* NOT DONE #
        AND LLR$DR[0] EQ RESPTYP4"OK4"  # GOOD HARDWARE #
      THEN                           # MESSAGE TRANSFER NOT COMPLETE #
        BEGIN  # TRY LATER #
        RETURN;
        END  # TRY LATER #
 
      IF MS$MSG[0] EQ HRF$CONRES     # RESPONSE BIT NOT YET SET #
      THEN                           # SEND CURESTART RESPONSE TO CU #
        BEGIN  # PRESET #
        MBF$TMOUT[0] = 0;            # RESET TIMEOUT #
        MS$MSG$R[0] = TRUE;          # SET RESPONSE FLAG #
        MBF$SENT[0] = FALSE;         # FORCE RESPONSE TO BE SENT #
        RETURN;
        END  # PRESET #
 
      IF UD$SBADDR[LLR$CU[0]] NQ 0   # RESPONSE RECEIVED #
        OR LLR$DR[0] EQ RESPTYP4"M86$HDW$PR"  # BAD HARDWARE #
      THEN                           # PRESET FOR NEXT MESSAGE #
        BEGIN  # CLEAR #
        IF MBF$SBADDR[0] NQ 0
        THEN                         # CURESTART RESPONSE NOT SENT #
          BEGIN  # THROW #
          P<UDT$MSG> = MBF$SBADDR[0];# CLEAR SBT ENTRY #
          ZFILL(UDT$MSG,MSGLT);
          END  # THROW #
 
        MBF$WORD[0] = 0;             # CLEAR MESSAGE STATUS #
        IF LLR$DR[0] EQ RESPTYP4"M86$HDW$PR"
        THEN                         # RETURN LLRQ #
          BEGIN  # EXIT #
          P<MWBTMP> = LOC(UD$CAMF[LLR$CU[0]]);  # LOCATE WRITE FET #
          IF MWB$ADDR[LLR$CIF[0]] NQ 0
          THEN                       # CHANNEL WAS ALLOCATED #
            BEGIN  # EXISTS #
            P<FETMWB> = MWB$ADDR[LLR$CIF[0]];
            P<FETMRA> = P<FETMWB> - 1;  # KEEP FET PAIRS TOGETHER #
            P<FETMRB> = FRA$MRBADR[0];
            IF UD$CUON[LLR$CU[0]] AND FMW$CHON[0]
            THEN                     # NOT DUE TO DEVICE DRIVER ERROR #
              BEGIN  # OFF #
              DOWNCU(LLR$CU[0]);     # DOWN CONTROLLER #
              END  # OFF #
 
            END  # EXISTS #
 
          LLR$RS[0] = PROCST"COMPLETE";
          RETURN;
          END  # EXIT #
 
        P<UDT$MSG> = LOC(UD$MSG[LLR$CU[0]]);
        IF MS$MSG[0] EQ HFC$STERLG   ##
          OR MS$MSG[0] EQ HFC$STERDR
        THEN                         # MULTIPLE MESSAGE NOT COMPLETED #
          BEGIN  # CONTINUE #
          MBF$SAVE[0] = SAVENONE;
          MS$DRDN[0] = MS$DRDN[0] + 1;  # CHECK NEXT CIF/DRD #
          RETURN;
          END  # CONTINUE #
 
        END  # CLEAR #
 
      P<UDT$MSG> = LOC(UD$MSG[LLR$CU[0]]);  # RESET BASED ARRAY #
      IF MS$MSG[0] EQ HFC$STERLN
      THEN                           # *SET ERROR LOG LENGTH* ISSUED #
        BEGIN  # EXIT #
        LLR$RS[0] = PROCST"COMPLETE";
        CORD = XCOD(UD$ESTO[LLR$CU[0]]);  # SET EST ORDINAL #
        CU$ORD[0] = C<6,4>CORD;
        CU$STAT[0] = CUON;
        MESSAGE(CUMSG,SYSUDF1);      # SEND CU ON MESSAGE #
        RETURN;
        END  # EXIT #
 
      MBF$SAVE[0] = SAVEPART;        # SET FOR MOST SINGLE MESSAGES #
      IF MS$MSG[0] EQ HFC$RESCON
      THEN                           # RESET FOR *SETMASCHAN* #
        BEGIN  # RESET #
        MBF$SAVE[0] = SAVENONE;
        END  # RESET #
 
      SLOWFOR I = 0 STEP 1 UNTIL MSGNUMM1
      DO                             # SET UP NEXT CU MESSAGE #
        BEGIN  # NEXT #
        IF NEXTFTN[I] EQ MS$MSG[0]
        THEN                         # MESSAGE FOUND #
          BEGIN  # RESET #
          MS$MSG[0] = NEXTFTN[I+1];  # GET NEXT FUNCTION #
          RETURN;
          END  # RESET #
 
        END  # NEXT #
 
      FE$RTN[0] = "RESTCU2.";        # NEXT MESSAGE NOT FOUND #
 
RESTCU1:
      MESSAGE(FEMSG,UDFL1);
      ABORT;
      END  # RESTCU #
 
    TERM
PROC SENDMSG;
# TITLE SENDMSG - SEND M860 MESSAGE.                                  #
 
      BEGIN  # SENDMSG #
 
#
**    SENDMSG - SEND M860 MESSAGE.
*
*     *SENDMSG* MONITORS M860 MESSAGE PROCESSING.  IT CONTROLS THE
*     PROGRESS OF AN M860 MESSAGE FROM ITS CREATION TO THE VERIFICATION
*     OF ITS INCOMING M860 RESPONSE.
*
*     PROC SENDMSG
*
*     ENTRY      P<LLRQ> = *DRQUEUE* ENTRY ADDRESS.
*
*                P<MBFHDR> = UDT MESSAGE BUFFER HEADER ADDRESS.
*
*     EXIT       THE M860 RESPONSE TO THE ORIGINAL M860 MESSAGE IS
*                STORED IN THE STORAGE BUFFER TABLE, AND HAS BEEN
*                VERIFIED.
*
*     MESSAGES   *EXEC ABNORMAL, SENDMSG0.* - CHANNEL MESSAGE COUNT WAS
*                                             ZERO WHEN AN M860 MESSAGE
*                                             TIMED OUT.
*
*                *EXEC ABNORMAL, SENDMSG2.* - FATAL RETURN CODE ERROR
*                                             FOUND IN M860 RESPONSE.
*
*                *EXEC ABNORMAL, SENDMSG3.* - CHANNEL MESSAGE COUNT WAS
*                                             ZERO WHEN AN M860
*                                             RESPONSE WAS RECEIVED.
*
*     NOTES      IF AN M860 RESPONSE TIMES OUT, *HARDWARE PROBLEM*
*                STATUS IS RETURNED IN THE *DRQUEUE* ENTRY, AND THE
*                CHANNEL MESSAGE COUNT IS DECREMENTED.
#
 
 
#
****  PROC SENDMSG - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ABORT;                  # ABORT #
        PROC CALLPP;                 # PASS MESSAGES/DATA TO PP #
        PROC CRMSG;                  # CREATE M860 MESSAGE #
        PROC MESSAGE;                # ISSUE DAYFILE MESSAGE #
        PROC RTIME;                  # GET TIME SINCE DEADSTART #
        PROC ZFILL;                  # ZERO-FILL BUFFER #
        END
 
#
****  PROC SENDMSG - XREF LIST END.
#
 
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
*CALL,COMBFAS
*CALL,COMBCDD
*CALL,COMBCPR
*CALL,COMBFET
*CALL,COMBHFC
*CALL,COMBKDD
*CALL,COMBLRQ
*CALL,COMBUDT
*CALL,COMXCTF
*CALL,COMXMSC
 
      ITEM MBFTN      U;             # SAVE MSG BUFFER M860 FUNCTION #
                                               CONTROL EJECT;
 
      P<UDT$MSG> = P<MBFHDR> + 1;    # ASSUME MESSAGE IN UDT #
      MBFTN = MS$MSG[0];             # SAVE FOR LATER COMPARE #
      IF MBF$SBADDR[0] NQ 0
      THEN                           # PROCESS MESSAGE IN SBT #
        BEGIN  # SBT #
        P<UDT$MSG> = MBF$SBADDR[0];
        END  # SBT #
 
      P<KWORD> = LOC(LLR$KWORDS[0]);
      IF MBF$TMOUT[0] NQ 0           # AWAITING M860 RESPONSE #
      THEN                           # CHECK FOR CU OR CHANNEL OFF #
        BEGIN  # PRESET #
        P<MWBTMP> = LOC(UD$CAMF[LLR$CU[0]]);
        P<FETMWB> = MWB$ADDR[LLR$CIF[0]];
        P<FETMRA> = P<FETMWB> - 1;
        P<FETMRB> = FRA$MRBADR[0];
        END  # PRESET #
 
      IF MBF$TMOUT[0] NQ 0           # MESSAGE EXISTS #
        AND (RTIMSECS[0] - MBF$TMOUT[0] GQ MAX$MSTO  # MSG TIMED OUT #
        OR (NOT UD$CUON[LLR$CU[0]])  # CU TURNED OFF #
        OR NOT FMW$CHON[0])          # CHANNEL TURNED OFF #
        AND MBF$SBADDR[0] EQ 0       # RESPONSE NOT RECEIVED #
        AND KW$COMP[0]               # SKIP IF GO NOT YET RECEIVED #
      THEN                           # CLEAN UP BEFORE RETURNING LLRQ #
        BEGIN  # CLEAN UP #
        IF MSGCNT(LLR$CIF[0],LLR$CU[0]) EQ 0
        THEN                         # MESSAGE COUNT INCORRECT #
          BEGIN  # ABORT #
          FE$RTN[0] = "SENDMSG0.";
          GOTO SENDMSG1;
          END  # ABORT #
 
        MSGCNT(LLR$CIF[0],LLR$CU[0]) = MSGCNT(LLR$CIF[0],LLR$CU[0])-1;
                                     # DECREMENT CHANNEL MSG COUNT #
        IF MS$MSG[0] EQ HFC$RDRAW    # READING RAW DATA #
        THEN                         # RESET READ FET #
          BEGIN  # RESET #
          FMR$RDBA[0] = 0;           # REMOVE RAW DATA BUFFER ADDR #
          END  # RESET #
 
        LLR$DR[0] = RESPTYP4"M86$HDW$PR";  # INDICATE HARDWARE PROBLEM #
        IF MS$MSQN$DI[0] NQ 0        # DRD MESSAGE #
        THEN                         # TURN DRD OFF #
          BEGIN  # OFF #
          LLR$DRFUL[0] = TRUE;       # FORCE STORE, IF POSSIBLE #
          LLR$SCIF[0] = LLR$CIF[0];  # SAVE TO DECIDE IF DRD GOES OFF #
          LLR$SCU[0] = LLR$CU[0];
          END  # OFF #
 
        RETURN;
        END  # CLEAN UP #
 
      IF NOT MBF$SENT[0]
      THEN                           # MSG NOT ISSUED TO WRITE BUFFER #
        BEGIN  # SEND #
        IF NOT MBF$ACTIVE[0]
        THEN                         # MESSAGE NOT CREATED #
          BEGIN  # CREATE #
          CRMSG;                     # CREATE M860 MESSAGE #
          LLR$DR[0] = RESPTYP4"OK4"; # ASSUME RESPONSE OK #
          END  # CREATE #
 
        IF NOT MBF$ACTIVE[0]       ##
          AND ((MS$MSG[0] GQ HFC$CHSCIF  ##
          AND MS$MSG[0] LQ HFC$CHSAIF)  ##
          OR MS$MSG[0] EQ HFC$SETMAS  ##
          OR MS$MSG[0] EQ HFC$STERLG  ##
          OR MS$MSG[0] EQ HFC$STERDR)
        THEN                         # ALL SPECIAL MSGS COMPLETED #
          BEGIN  # EXIT #
          RETURN;
          END  # EXIT #
 
        CALLPP(IRPMSG);              # SEND MSG TO WRITE BUFFER #
        IF NOT MBF$SENT[0]
        THEN                         # MESSAGE NOT YET SENT #
          BEGIN  # TRY LATER #
          RETURN;
          END  # TRY LATER #
 
        RTIME(RTIMESTAT);            # PRESET MESSAGE TIMEOUT #
        MBF$TMOUT[0] = RTIMSECS[0];
        END  # SEND #
 
      IF MBF$SBADDR[0] EQ 0          # STILL AWAITING RESPONSE #
        OR MS$MSG$R[0]               # NO RESPONSE EXPECTED #
      THEN                           # NO RESPONSE TO BE CHECKED #
        BEGIN  # EXIT #
        RETURN;
        END  # EXIT #
 
      DRVRACTIVE = TRUE;             # NOTE DRIVER HAD ACTIVITY #
      P<UDT$MSG> = MBF$SBADDR[0];
      IF MS$MSG[0] NQ MBFTN          ##
        AND (NOT MS$MSG$R[0])        # M860 RESPONSES ALREADY CHECKED #
        AND (NOT (MBFTN GQ HFC$MVLMVR  # MOUNT VOLUME - UNLOAD PAIR #
        AND MBFTN LQ HFC$MVLMNW      ##
        AND (MS$MSG[0] EQ HRF$UNITRW ##
        OR MS$MSG[0] EQ HRF$FORCRW)))  ##
        AND NOT (MBFTN EQ HFC$RESCON # RESTART - CURESTART PAIR #
        AND MS$MSG[0] EQ HRF$CONRES)
      THEN                           # MESSAGE TYPE MISMATCH #
        BEGIN  # THROW #
        ZFILL(UDT$MSG,MSGLT);        # ASSUME THIS RESPONSE TIMED OUT #
        MBF$SBADDR[0] = 0;
        RETURN;
        END  # THROW #
 
      IF ((MS$RETCODE[0] EQ HRC$CSNMIS  # CSN MISMATCH #
        AND MS$MSG[0] NQ HFC$ACCR)   # POSSIBLE MAP ERROR #
        OR MS$RETCODE[0] EQ HRC$DLERR# DATA LENGTH ERROR #
        OR MS$RETCODE[0] EQ HRC$UNITAS)  # UNIT ALREADY ASSIGNED #
        AND MS$MSG[0] NQ HFC$RDRAW   # HANDLE THESE OUT OF EXEC #
      THEN                           # FATAL ERROR #
        BEGIN  # ABORT #
        FE$RTN[0] = "SENDMSG2.";
        GOTO SENDMSG1;
        END  # ABORT #
 
      IF MSGCNT(LLR$CIF[0],LLR$CU[0]) EQ 0
      THEN                           # MESSAGE COUNT INCORRECT #
        BEGIN  # ABORT #
        FE$RTN[0] = "SENDMSG3.";
        GOTO SENDMSG1;
        END  # ABORT #
 
      MSGCNT(LLR$CIF[0],LLR$CU[0]) = MSGCNT(LLR$CIF[0],LLR$CU[0]) - 1;
                                     # DECREMENT CHANNEL MSG COUNT #
      IF MS$RETCODE[0] EQ HRC$DRVERR # DEVICE DRIVER ERROR #
        OR MS$RETCODE[0] EQ HRC$DRVHO  ##
        OR MS$RETCODE[0] EQ HRC$DRVHW  ##
        OR MS$RETCODE[0] EQ HRC$DRVNA  ##
        OR MS$RETCODE[0] EQ HRC$THRERR # CARTRIDGE THREADING ERRFOR #
      THEN                           # DRD MESSAGE ERROR #
        BEGIN  # DRD #
        LLR$DR[0] = RESPTYP4"M86$HDW$PR";
        IF MS$MSG[0] EQ HFC$WVLBUT   # ASSUME WRITE ERROR INSTEAD #
          AND MS$RETCODE[0] EQ HRC$DRVERR
        THEN                         # LET DESTAGING TO SM CONTINUE #
          BEGIN  # RESET #
          LLR$DR[0] = RESPTYP4"UN$WRT$ERR";
          END  # RESET #
 
        IF (MS$MSG[0] LS HFC$CHSCIF  # NOT STATUS CHANGES #
          OR MS$MSG[0] GR HFC$CHSAIF)  ##
          AND (MS$MSG[0] NQ HFC$WVLBUT  # ASSUME WRITE ERROR INSTEAD #
          OR MS$RETCODE[0] NQ HRC$DRVERR)
        THEN                         # TRY TO REMOVE CARTRIDGE #
          BEGIN  # REMOVE #
          LLR$DRFUL[0] = TRUE;       # FORCE STORE, IF NOT ACQUIRE #
          LLR$SCIF[0] = LLR$CIF[0];  # SAVE IN CASE OVERWRITTEN #
          LLR$SCU[0] = LLR$CU[0];
          END  # REMOVE #
 
        END  # DRD #
 
      RETURN;
 
SENDMSG1:
      MESSAGE(FEMSG,UDFL1);          # ABORT PROCESSING #
      ABORT;
      END  # SENDMSG #
 
    TERM
PROC SSDRVR;
# TITLE SSDRVR - MSAS DRIVER MAIN ROUTINE.                            #
 
      BEGIN  # SSDRVR #
 
#
**    SSDRVR - MSAS DRIVER MAIN ROUTINE.
*
*     *SSDRVR* IS THE INTERFACE BETWEEN *SSEXEC* AND
*     THE PRIMARY FUNCTIONS OF THE MSAS DRIVER.  IT IS
*     CALLED TO BOTH PROCESS NEW REQUESTS FROM *SSEXEC*,
*     AND TO CONTINUE PROCESSING FOR THOSE REQUESTS
*     ALREADY STARTED.
*
*     PROC SSDRVR
*
*     ENTRY      THE *DRQUEUE* CONTAINS A QUEUE OF *LLRQ* ENTRIES
*                WHICH DEFINE THE SET OF NEW REQUESTS BEING PASSED
*                FROM *SSEXEC* TO THE DRIVER.  THIS QUEUE MAY
*                BE EMPTY.
*
*     EXIT       ALL DRIVER REQUESTS HAVE BEEN PROCESSED AS FAR AS
*                POSSIBLE, AND ALL COMPLETED DRIVER REQUESTS HAVE
*                BEEN RETURNED TO THE *LLRQ* READY CHAIN.  AN OPERATOR
*                *N.IDLE* COMMAND DURING FULL INITIALIZATION FORCES
*                AN IMMEDIATE RETURN TO *SSEXEC*.
*
#
 
 
#
****  PROC SSDRVR - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ADD$LNK;                # ADD ENTRY TO END OF CHAIN #
        PROC DEL$LNK;                # DELETE ENTRY FROM CHAIN #
        PROC MESSAGE;                # SEND DAYFILE MESSAGE #
        PROC PPDONE;                 # PROCESS COMPLETED PP CALLS #
        PROC PROCDRQ;                # PROCESS DRIVER REQUESTS #
        PROC PROCMRB;                # PROCESS MESSAGE READ BUFFERS #
        PROC RECALL;                 # SUSPEND PROCESSING #
        END
 
#
****  PROC SSDRVR - XREF LIST END.
#
 
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBCHN
*CALL,COMBKDA
*CALL,COMBFET
*CALL,COMBKDD
*CALL COMBLRQ
*CALL COMBUDT
*CALL COMXCTF
*CALL,COMXJCA
*CALL COMXMSC
 
      ITEM I          I;             # INDEX #
      ITEM J          I;             # INDEX #
      ITEM MRBACTIVE  B;             # MSG READ BUFFER ACTIVITY FLAG #
      ITEM MRBSTAT    B;             # SET IF MSG READ BUF PROCESSED #
      ITEM NEXTREQ    U;             # ADDRESS OF NEXT DRIVER REQUEST #
                                               CONTROL EJECT;
 
      DRVRRECALL = FALSE;            # INDICATE NO DRIVER RECALL #
      DRVRACTIVE = TRUE;
      REPEAT WHILE DRVRACTIVE
      DO                             # DRIVER MAIN LOOP #
        BEGIN  # MAIN LOOP #
        DRVRACTIVE = FALSE;          # INDICATE NO ACTIVITY #
 
#
*     PROCESS ALL DRIVER QUEUE ENTRIES.
#
 
        P<LLRQ> = CHN$BOC[LCHN"DRQUEUE"];  # POINT TO FIRST REQUEST #
        SLOWFOR I = 0 WHILE P<LLRQ> NQ 0
        DO                           # PROCESS DRIVER QUEUE #
          BEGIN  # PROCESS #
          P<KWORD> = LOC(LLR$KWORDS[0]);
          IF NOT (KW$COMP[0]         # K-DISPLAY ACTIVE #
            OR LLR$UCPABT[0])        # UCP ABORTED #
          THEN                       # RECALL DRIVER UNTIL COMPLETE #
            BEGIN  # RECALL #
            DRVRRECALL = TRUE;
            P<LLRQ> = LLR$LINK1[0];  # POINT TO NEXT REQUEST #
            TEST I;
            END  # RECALL #
 
          IF LLR$RS[0] NQ PROCST"COMPLETE"
          THEN                       # MORE PROCESSING REQUIRED #
            BEGIN  # CONTINUE #
            PROCDRQ;                 # PROCESS DRIVER REQUEST #
            END  # CONTINUE #
 
          NEXTREQ = LLR$LINK1[0];    # SAVE NEXT REQUEST ADDRESS #
          IF LLR$RS[0] EQ PROCST"COMPLETE"  ##
            AND KW$COMP[0]           # REQUEST NOT PENDING #
          THEN                       # PUT REQUEST BACK ON READY QUEUE #
            BEGIN  # BACK #
            IF LLR$CU[0] NQ 0
            THEN                     # CHECK FOR CU/CHANNEL OFF #
              BEGIN  # OFF #
              P<MWBTMP> = LOC(UD$CAMF[LLR$CU[0]]);
              P<FETMWB> = MWB$ADDR[LLR$CIF[0]];
              IF P<FETMWB> EQ 0
              THEN                   # NO CHANNEL ALLOCATED #
                BEGIN  # SKIP #
                GOTO SSDRVR1;        # NO HARDWARE TO CHECK #
                END  # SKIP #
 
              P<FETMRA> = P<FETMWB> - 1;
              P<FETMRB> = FRA$MRBADR[0];
              IF NOT (FMW$CHON[0]    # CHANNEL TURNED OFF #
                AND UD$CUON[LLR$CU[0]])  # CU TURNED OFF #
              THEN                   # CHECK IF SM STILL ACCESSIBLE #
                BEGIN  # STOP #
                IF LLR$CU[0] EQ SM$CUO0[LLR$SMO[0]]
                THEN                   # 1ST CU/CHAN BAD #
                  BEGIN  # 1ST #
                  SM$HWOFF1[LLR$SMO[0]] = TRUE;
                  END  # 1ST #
 
                IF LLR$CU[0] EQ SM$CUO1[LLR$SMO[0]]
                THEN                   # 2ND CU/CHAN BAD #
                  BEGIN  # 2ND #
                  SM$HWOFF2[LLR$SMO[0]] = TRUE;
                  END  # 2ND #
 
                IF (SM$HWOFF1[LLR$SMO[0]]  # 1ST HW BAD #
                  OR NOT UD$EXIST[SM$CUO0[LLR$SMO[0]]])  ##
                  AND (SM$HWOFF2[LLR$SMO[0]]  # 2ND HW BAD #
                  OR NOT UD$EXIST[SM$CUO1[LLR$SMO[0]]])
                THEN                   # ALL HW TO THIS SM BAD #
                  BEGIN  # BAD #
                  SM$HWOFF[LLR$SMO[0]] = TRUE;  # STOP ALL SM ACCESS #
                  END  # BAD #
 
                END  # STOP #
 
              END  # OFF #
 
SSDRVR1:
            DEL$LNK(LOC(LLRQ),LCHN"DRQUEUE",0);
            ADD$LNK(LOC(LLRQ),LCHN"LL$READY",0);
            END  # BACK #
 
          P<LLRQ> = NEXTREQ;         # POINT TO NEXT REQUEST #
          END  # PROCESS #
 
#
*     PROCESS ALL MESSAGE READ BUFFERS.
#
 
        MRBACTIVE = TRUE;            # SET MESSAGE PROCESSED #
        REPEAT WHILE MRBACTIVE
        DO                           # SCAN WHILE MESSAGES TO PROCESS #
          BEGIN  # SCAN #
          MRBACTIVE = FALSE;         # PRESET TO INDICATE NO ACTIVITY #
          SLOWFOR I = 1 STEP 1 WHILE UD$EXIST[I] AND (I LQ MAXCTN)
          DO                         # SCAN CONTROLLERS #
            BEGIN  # CHECK #
            P<MWBTMP> = LOC(UD$CAMF[I]);
            SLOWFOR J = 0 STEP 1 UNTIL MAX$CIF
            DO                       # CHECK READ BUFFERS #
              BEGIN  # EXISTS #
              IF MWB$ADDR[J] NQ 0
              THEN                   # READ BUFFER EXISTS #
                BEGIN  # PROCESS INCOMING MESSAGES #
                P<FETMWB> = MWB$ADDR[J];
                P<FETMRA> = P<FETMWB> - 1;
                P<FETMRB> = FRA$MRBADR[0];  # READ BUFFER ADDRESS #
                PROCMRB(MRBSTAT);
                MRBACTIVE = MRBACTIVE OR MRBSTAT;
                END  # PROCESS INCOMING MESSAGES #
 
              END  # EXISTS #
 
            END  # CHECK #
 
          END  # SCAN #
 
#
*     PROCESS ALL COMPLETED PP CALL BLOCK ENTRIES.
#
 
        SLOWFOR I = 1 STEP 1 UNTIL PPCBTSIZE
        DO                           # PROCESS CALL BLOCK #
          BEGIN  # PROCESS #
          IF PPU$FC[I] EQ 0
          THEN                       # TRY NEXT ENTRY #
            BEGIN  # NEXT #
            TEST I;
            END  # NEXT #
 
          IF DRYUP                   ##
            AND INITIALIZE           # ACTIVE LLRQ-S WONT BE FINISHED #
            AND PPU$ACTIVE[I]
          THEN                       # RECALL DRIVER UNTIL PP DROPS #
            BEGIN  # RECALL #
            DRVRRECALL = TRUE;
            TEST I;
            END  # RECALL #
 
          IF (NOT (DRYUP AND INITIALIZE))  # LET LLRQ-S END FIRST #
            AND NOT PPU$ACTIVE[I]
          THEN                       # PP COMPLETED #
            BEGIN  # REMOVE #
            PPDONE(I);               # PROCESS COMPLETED ENTRY #
            END  # REMOVE #
 
          END  # PROCESS #
 
        END  # MAIN LOOP #
 
#
*     INFORM OPERATOR IF THE 7990 HARDWARE CAN NO LONGER BE ACCESSED.
#
 
      IF UDT$HWOFF[0] NQ 0           # EXEC TO BE SHUT DOWN #
        AND KREQCLEAR                # B-DISPLAY AVAILABLE FOR MSG #
        AND NOT INITIALIZE           # *HALT* MSG TO BE SHOWN INSTEAD #
      THEN                           # INFORM OPERATOR OF PROBLEM #
        BEGIN  # MSG #
        IF UDT$CUS$O[0]
        THEN                         # FLASH CONTROLLER MESSAGE #
          BEGIN  # CU #
          MESSAGE("$ALL CONTROLLERS OFF.",LINE2);
          END  # CU #
 
        ELSE                         # FLASH CHANNEL MESSAGE #
          BEGIN  # CHAN #
          MESSAGE("$ALL CHANNELS OFF.",LINE2);
          END  # CHAN #
 
        END  # MSG #
 
      RECALL(0);                     # KEEP CPU TIME DOWN #
      RETURN;
      END  # SSDRVR #
 
    TERM
PROC STRCART;
# TITLE STRCART - STORE CARTRIDGE.                                    #
 
      BEGIN  # STRCART #
 
#
**    STRCART - STORE CARTRIDGE.
*
*     *STRCART* PROCESSES *DRQUEUE* REQUESTS TO STORE CARTRIDGES.  IF
*     THE STORE WAS INITIATED BY A *TDAM* REQUEST, THE DRD BUFFERED LOG
*     IS FORMATTED AND SENT TO THE BML, AND PART OF THE LOG IS SENT TO
*     THE ASSOCIATED *HLRQ* ENTRY.
*
*     PROC STRCART
*
*     ENTRY      P<LLRQ> = *DRQUEUE* ENTRY ADDRESS.
*
*     EXIT       THE *DRQUEUE* ENTRY REQUEST STATE FIELD HAS BEEN
*                UPDATED TO INDICATE WHERE SUBSEQUENT PROCESSING OF
*                THIS REQUEST IS TO CONTINUE.
*
*     MESSAGES   *EXEC ABNORMAL, STRCART1.* - UDT MESSAGE BUFFER STILL
*                                             IN USE.
*
*                *EXEC ABNORMAL, STRCART2.* - CSN OR DRD IN USE.
*
*                A K-DISPLAY MESSAGE IS ISSUED IF THE CARTRIDGE WAS
*                EJECTED, THE OUTPUT TRAY OR MATRIX CELL WAS FULL, OR
*                THE ASSOCIATED DRD WAS TURNED OFF DUE TO AN ERROR
*                FOUND BY THE M860 HARDWARE.
*
*     NOTES      THIS IS A PSEUDO-REENTRANT PROCEDURE.
#
 
 
#
****  PROC STRCART - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ABORT;                  # ABORT #
        PROC KREQ;                   # SEND K-DISPLAY REQUEST #
        PROC MESSAGE;                # ISSUE DAYFILE MESSAGE #
        PROC RTIME;                  # GET TIME SINCE DEADSTART #
        PROC SENDMSG;                # SEND M860 MESSAGE #
        PROC ZFILL;                  # ZERO-FILL BUFFER #
        END
 
#
****  PROC STRCART - XREF LIST END.
#
 
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
*CALL,COMBFAS
*CALL,COMBCPR
*CALL,COMBFET
*CALL,COMBHFC
*CALL,COMBKDD
*CALL,COMBLRQ
*CALL,COMBUCR
*CALL,COMBUDT
*CALL,COMXCTF
*CALL,COMXMSC
 
      SWITCH STRLBL:PROCST           # DRIVER REQUEST STATE #
            STRINIT:INITIAL,         # INITIAL STATE #
            STRCUBE:CONT1,           # CONTINUATION 1 #
            STRBUFL:CONT2,           # CONTINUATION 2 #
            STRDRDO:CONT3;           # CONTINUATION 3 #
                                               CONTROL EJECT;
                                               CONTROL INERT;
 
      GOTO STRLBL[LLR$RS[0]];
 
#
*     INITIAL DRIVER REQUEST STATE.
#
 
STRINIT:
      IF LLR$MBH[0] EQ 0
      THEN                           # ** PATCH #
        BEGIN
        FE$RTN[0] = "STRCART0.";
        GOTO STRCART2;
        END
 
      P<KWORD> = LOC(LLR$KWORDS[0]);
      IF LLR$UCPABT[0]               ##
        AND NOT KW$COMP[0]           # K-DISPLAY MSG PENDING #
      THEN                           # IGNORE UCP ABORT #
        BEGIN  # EXIT #
        RETURN;                      # AVOID ISSUING INFINITE STORES #
        END  # EXIT #
 
      IF LLR$SCU[0] EQ 0             # NO CHANNEL/CU SAVED #
        AND LLR$DRFUL[0]             # ERROR OCCURRED #
      THEN                           # DATA ERROR AFTER GOOD REW/UNL #
        BEGIN  # SAVE #
        LLR$SCIF[0] = LLR$CIF[0];    # SAVE TO DECIDE ON RETRY #
        LLR$SCU[0] = LLR$CU[0];
        END  # SAVE #
 
      LLR$SDR[0] = LLR$DR[0];        # IN CASE EJECTING CARTRIDGE #
      P<MBFHDR> = LLR$MBH[0];
      P<UDT$MSG> = P<MBFHDR> + 1;
      IF MBF$WORD[0] NQ 0
      THEN                           # LAST MESSAGE NOT PROCESSED #
        BEGIN  # CHECK #
        IF MS$MSG[0] GQ HFC$MVLMVR   # MOUNT-VOLUME #
          AND MS$MSG[0] LQ HFC$MVLMNW
        THEN                         # FORCED STORE ON DATA TRANSFER #
          BEGIN  # OK #
          MBF$WORD[0] = 0;           # PRESET HEADER #
          MS$MSG[0] = HFC$STCRNF;    # FORCE REWIND/UNLOAD #
          END  # OK #
 
        ELSE                         # SOFTWARE ERROR #
          BEGIN  # ABORT #
          FE$RTN[0] = "STRCART1.";
          GOTO STRCART2;
          END  # ABORT #
 
        END  # CHECK #
 
      ELSE                           # ISSUE NORMAL STORE #
        BEGIN  # OK #
        MS$MSG[0] = HFC$STCRNV;
        END  # OK #
 
      MBF$SAVE[0] = SAVEMOST;
      LLR$RS[0] = PROCST"CONT1";
 
#
*     ISSUE M860 MESSAGE TO STORE CARTRIDGE.
#
 
STRCUBE:
      P<MBFHDR> = LLR$MBH[0];
      SENDMSG;                       # SEND M860 MESSAGE #
      IF MBF$SBADDR[0] EQ 0          ##
        AND LLR$DR[0] EQ RESPTYP4"OK4"  # GOOD HARDWARE #
      THEN                           # RESPONSE NOT YET RECEIVED #
        BEGIN  # RETRY #
        RETURN;
        END  # RETRY #
 
      IF MS$RETCODE[0] EQ HRC$CSNERR # CSN/DRD IN USE #
        AND MS$MSG[0] EQ HFC$STCRNV  # NORMAL STORE #
      THEN                           # MAY BE *ACQUIRE* ERROR RCVY #
        BEGIN  # CHECK #
        IF NOT LLR$LDERR[0]
        THEN                         # DRIVER ERROR #
          BEGIN  # ABORT #
          FE$RTN[0] = "STRCART2.";
          GOTO STRCART2;
          END  # ABORT #
 
        ELSE                         # CARTRIDGE HAD LOADED OK #
          BEGIN  # IGNORE #
          MS$RETCODE[0] = 0;         # DRD IN USE BY THIS LLRQ #
          END  # IGNORE #
 
        END  # CHECK #
 
      SM$ACCBUSY[LLR$SMO[0]] = FALSE;# SM ARM NOT IN USE #
      IF LLR$DR[0] EQ RESPTYP4"M86$HDW$PR"
      THEN                           # HARDWARE PROBLEM #
        BEGIN  # EXIT #
        IF LLR$SDR[0] EQ 0
        THEN                         # SAVE THIS ERROR FOR EXEC #
          BEGIN  # SAVE #
          LLR$SDR[0] = LLR$DR[0];
          END  # SAVE #
 
        GOTO STRCART3;               # ASSUME CARTRIDGE NOT STORED #
        END  # EXIT #
 
      IF MS$RETCODE[0] EQ HRC$CSNERR  # FORCED STORE VOLUME UNLOADED #
        OR (MS$RETCODE[0] EQ 0       # NO M860 ERROR #
        AND ((LLR$RQI[0] EQ REQNAME"RQILABL"  # SSLABEL HANDLES EJECTS #
        AND NOT LLR$UCPABT[0])       # SSLABEL MUST BE UP #
        OR LLR$Y[0] NQ SM$EXIT$TY    # CARTRIDGE NOT EJECTED #
        OR LLR$Z[0] NQ SM$TY$Z))
      THEN                           # DO NOT ISSUE K-DISPLAY MSG #
        BEGIN  # MATRIX #
        GOTO STRCART3;
        END  # MATRIX #
 
      IF MS$RETCODE[0] EQ HRC$CELEMP  # CELL FULL #
        AND NOT (LLR$Y[0] EQ SM$EXIT$TY  # NOT OUTPUT TRAY FULL #
        AND LLR$Z[0] EQ SM$TY$Z)
      THEN                           # TURN SM OFF IN UDT #
        BEGIN  # OFF #
        P<PTHSTAT> = LOC(SM$STS[LLR$SMO[0]]);
        SMST = SMST1;                # ASSUME 2ND CU #
        IF LLR$CU[0] EQ SM$CUO0[LLR$SMO[0]]
        THEN                         # RESET INDEX TO 1ST CU #
          BEGIN  # RESET #
          SMST = SMST0;
          END  # RESET #
 
        PATHBIT(SMST,PATH$DF"U$ON") = OFF;
 
                                               CONTROL REACTIVE;
 
        SM$FLAG[LLR$SMO[0]] = SM$STS0[LLR$SMO[0]] LOR  # RESET GLOBALS #
                              SM$STS1[LLR$SMO[0]];
 
                                               CONTROL INERT;
 
        END  # OFF #
 
#
*     ISSUE A K-DISPLAY MESSAGE INFORMING THE OPERATOR THAT
*     EITHER A CARTRIDGE WAS EJECTED, THE OUTPUT TRAY WAS
*     FULL, OR A MATRIX CELL WAS FULL.
#
 
      P<KWORD> = LOC(LLR$KWORDS[0]);
      KW$WORD[0] = 0;
      KW$LINE1[0] = KM"KM2";         # PRESET MESSAGE ORDINALS #
      KW$LINE2[0] = KM"KM9";         # ASSUME CARTRIDGE EJECTED #
      KW$IC[0] = TRUE;               # SET IMMEDIATE COMPLETION #
      KW$DF[0] = TRUE;               # ISSUE TO JOB DAYFILE #
      IF LLR$CSNT[0] NQ 0            # *TDAM* REQUEST #
        AND (LLR$SDR[0] EQ RESPTYP4"UNK$CART"  # UNEXPECTED LABEL #
        OR LLR$SDR[0] EQ RESPTYP4"CART$LB$ERR")
      THEN                           # INDICATE LABEL ERROR IN MESSAGE #
        BEGIN  # RESET #
        KW$LINE2[0] = KM"KM8";
        KW$LINE3[0] = KM"KM9";       # CARTRIDGE EJECTED #
        END  # RESET #
 
      IF MS$RETCODE[0] EQ HRC$CELEMP
      THEN                           # CELL WAS FULL #
        BEGIN  # FULL #
        KW$LINE2[0] = KM"KM11";      # ASSUME MATRIX CELL FULL #
        KW$LINE3[0] = KM"KM16";      # SM TURNED OFF #
        IF LLR$Y[0] EQ SM$EXIT$TY    ##
          AND LLR$Z[0] EQ SM$TY$Z
        THEN                         # OUTPUT TRAY IS FULL #
          BEGIN  # TRAY #
          KW$LINE2[0] = KM"KM19";
          KW$LINE3[0] = 0;           # SM LEFT ON #
          KW$IC[0] = FALSE;          # WAIT FOR OPERATOR RESPONSE #
          KW$DF[0] = FALSE;
          END  # TRAY #
 
        END  # FULL #
 
      KW$RPGO[0] = TRUE;             # ALLOW GO RESPONSE #
      KP$EQ = UD$ESTO[LLR$CU[0]];    # PRESET MESSAGE PARAMETERS #
      P<MWBTMP> = LOC(UD$CAMF[LLR$CU[0]]);  # LOCATE READ FET #
      P<FETMWB> = MWB$ADDR[LLR$CIF[0]];
      P<FETMRA> = P<FETMWB> - 1;
      P<FETMRB> = FRA$MRBADR[0];
      KP$CN = FMR$CHAN[0];
      KP$DT = SM$ID[LLR$SMO[0]];
      KP$YA = LLR$Y[0];              # SET FULL CELL #
      KP$ZA = LLR$Z[0];
      KREQ(LOC(KWORD),KLINK);        # SEND K-DISPLAY REQUEST #
 
STRCART3:
      IF MS$RETCODE[0] EQ HRC$CSNERR # RETRY FORCED AS NORMAL STORE #
        OR LLR$LDERR[0]              # RCVY FROM *ACQ* ERROR #
        OR LLR$CSNT[0] EQ 0          # ERROR RELATED TO UTILITY #
      THEN                           # BUFFERED LOG NOT NEEDED #
        BEGIN  # SKIP #
        GOTO STRCART5;
        END  # SKIP #
 
      IF KW$LINE2[0] EQ KM"KM19"     # OUTPUT TRAY FULL #
        AND NOT KW$COMP[0]
      THEN                           # RETRY STORE REQUEST #
        BEGIN  # EXIT #
        GOTO STRCART4;
        END  # EXIT #
 
      IF LLR$DR[0] EQ RESPTYP4"M86$HDW$PR"
      THEN                           # BUFFERED LOG NOT NEEDED #
        BEGIN  # SKIP #
        GOTO STRCART5;               # TREAT DRD AS FULL #
        END  # SKIP #
 
      IF MBF$SBADDR[0] NQ 0
      THEN                           # CLEAR SBT ENTRY #
        BEGIN  # CLEAR #
        P<UDT$MSG> = MBF$SBADDR[0];
        ZFILL(UDT$MSG,MSGLT);
        END  # CLEAR #
 
      MBF$WORD[0] = 0;               # CLEAR MESSAGE STATUS #
      MBF$SAVE[0] = SAVEPART;
      P<UDT$MSG> = P<MBFHDR> + 1;
      MS$MSG[0] = HFC$DBLD0;         # SET *DUMP BUF LOG* FUNCTION #
      LLR$RS[0] = PROCST"CONT2";
 
#
*     ISSUE M860 MESSAGE TO DUMP BUFFERED LOG.
#
 
STRBUFL:
      P<MBFHDR> = LLR$MBH[0];
      SENDMSG;                       # SEND M860 MESSAGE #
      IF MBF$SBADDR[0] EQ 0          ##
        AND LLR$DR[0] EQ RESPTYP4"OK4"
      THEN                           # RESPONSE NOT YET RECEIVED #
        BEGIN  # RETRY #
        RETURN;
        END  # RETRY #
 
      LLR$DR[0] = RESPTYP4"OK4";     # DO NOT RETURN ERRORS #
 
#
*     TURN OFF THE DRD IF AN M860 RESPONSE TO
*     A DRD MESSAGE WAS A DEVICE DRIVER ERROR, OR THE RESPONSE
*     TIMED OUT.
#
 
STRCART5:
      IF MS$RETCODE[0] EQ HRC$CSNERR  # RETRY AS NORMAL STORE FIRST #
        OR NOT LLR$DRFUL[0]
      THEN                           # DO NOT TURN OFF DRD #
        BEGIN  # OK #
        GOTO STRCART4;
        END  # OK #
 
#
*     DECIDE IF RETRY COUNT AND RETRY TIME JUSTIFY TURNING DRD OFF.
#
 
      P<MWBTMP> = LOC(UD$CAMF[LLR$SCU[0]]);  # LOCATE BAD CHAN FETS #
      P<FETMWB> = MWB$ADDR[LLR$SCIF[0]];
      P<FETMRA> = P<FETMWB> - 1;
      P<FETMRB> = FRA$MRBADR[0];
      IF FMW$ERROR[0]                # ORIGINALLY A CHANNEL ERROR #
      THEN                           # RETRY CNT ALREADY INCREMENTED #
        BEGIN  # CLEAR #
        FMW$ERROR[0] = FALSE;        # IN CASE OF ANOTHER CHAN ERR #
        END  # CLEAR #
 
      ELSE                           # ONLY A DRD ERROR #
        BEGIN  # BUMP #
        FMW$RCNT[0] = FMW$RCNT[0] + 1;  # RECORD ERROR #
        END  # BUMP #
 
      RTIME(RTIMESTAT);
      IF (FMW$RCNT[0] EQ 1           # START OF ERROR SEQUENCE #
        AND FMW$RCNT[0] LS MAXCHERR)  ##
        OR (FMW$RCNT[0] GR 1         # RETRY TIME EXPIRED #
        AND RTIMSECS[0] GQ FMW$RTIME[0])
      THEN                           # RESET CHAN FOR NEW INTERVAL #
        BEGIN  # RESET #
        FMW$RCNT[0] = 1;             # IN CASE INTERVAL EXPIRED #
        FMW$RTIME[0] = RTIMSECS[0] + MAXCHERRTM;  # RESET RETRY TIME #
        END  # RESET #
 
      IF LLR$DR[0] EQ RESPTYP4"M86$HDW$PR"
      THEN                           # DRD CANNOT BE REUSED #
        BEGIN  # OFF #
        FMW$RCNT[0] = MAXCHERR;      # 7990 WOULD ABORT A RE-ACQUIRE #
        END  # OFF #
 
      IF (FMW$RCNT[0] GR 1           ##
        AND FMW$RCNT[0] GQ MAXCHERR  ##
        AND RTIMSECS[0] GQ FMW$RTIME[0])  # ERROR SEQUENCE EXPIRED #
        OR FMW$RCNT[0] LS MAXCHERR   # SEQUENCE NOT COMPLETE #
      THEN                           # DRD NOT READY TO BE TURNED OFF #
        BEGIN  # ON #
        GOTO STRCART4;               # SKIP TURNING OFF DRD #
        END  # ON #
 
      FMW$RCNT[0] = 0;               # PRESET IN CASE OF MORE ERRORS #
 
#
*     PRESET UDT TO TURN OFF DRD.
#
 
      DRVRACTIVE = TRUE;             # IN CASE DRD MSG TIMED OUT #
      P<PTHSTAT> = LOC(D1$ST[LLR$SMO[0]]);  # ASSUME LOWER DRD #
      IF LLR$DRD[0] EQ 0
      THEN                           # UPPER DRD GOING OFF #
        BEGIN  # RESET #
        P<PTHSTAT> = LOC(D0$ST[LLR$SMO[0]]);
        END  # RESET #
 
      DRST = DRST1;                  # ASSUME 2ND CU #
      IF LLR$CU[0] EQ SM$CUO0[LLR$SMO[0]]
      THEN                           # RESET DRD INDEX TO 1ST CU #
        BEGIN  # RESET #
        DRST = DRST0;
        END  # RESET #
 
      PATHBIT(DRST,PATH$DF"U$ON") = OFF;
      PATHBIT(DRST,PATH$DF"U$CU$ACK") = ON;
      PATHBIT(DRST,PATH$DF"U$DONE") = OFF;
 
                                               CONTROL REACTIVE;
 
      IF LLR$DRD[0] EQ 0
      THEN                           # STOP LOADS TO UPPER DRD #
        BEGIN  # DRD 0 #
        D0$FLAG[LLR$SMO[0]] = D0$STSP[LLR$SMO[0]] LOR
                                D0$STSS[LLR$SMO[0]];
        END  # DRD 0 #
 
      ELSE                           # STOP LOADS TO LOWER DRD #
        BEGIN  # DRD 1 #
        D1$FLAG[LLR$SMO[0]] = D1$STSP[LLR$SMO[0]] LOR
                                D1$STSS[LLR$SMO[0]];
        END  # DRD 1 #
 
                                               CONTROL INERT;
 
      LLR$SSD[0] = LLR$D$SMO[0];     # SAVE SM/DRD ORDINALS #
      LLR$RS[0] = PROCST"CONT3";
      RETURN;
 
#
*     ISSUE A K-DISPLAY MESSAGE STATING THAT THE DRD WAS
*     TURNED OFF.
#
 
STRDRDO:
      P<MBFHDR> = LLR$MBH[0];
      P<UDT$MSG> = P<MBFHDR> + 1;
      LLR$D$SMO[0] = LLR$SSD[0];     # RESTORE SM/DRD ORDINALS #
      P<KWORD> = LOC(LLR$KWORDS[0]);
      KW$WORD[0] = 0;
      KW$LINE1[0] = KM"KM3";         # PRESET MESSAGE ORDINALS #
      KW$LINE2[0] = KM"KM16";
      KW$IC[0] = TRUE;               # SET IMMEDIATE COMPLETION #
      KW$DF[0] = TRUE;               # SEND TO JOB DAYFILE #
      KW$RPGO[0] = TRUE;             # ALLOW GO RESPONSE #
      KP$EQ = UD$ESTO[LLR$CU[0]];    # PRESET MESSAGE PARAMETERS #
      P<MWBTMP> = LOC(UD$CAMF[LLR$CU[0]]);  # LOCATE READ FET #
      P<FETMWB> = MWB$ADDR[LLR$CIF[0]];
      P<FETMRA> = P<FETMWB> - 1;
      P<FETMRB> = FRA$MRBADR[0];
      KP$CN = FMR$CHAN[0];
      KP$DT = SM$ID[LLR$SMO[0]];
      KP$ID = D1$SUN[LLR$SMO[0]];    # ASSUME LOWER DRD #
      IF LLR$DRD[0] EQ 0
      THEN                           # LOWER DRD HAD ERROR #
        BEGIN  # RESET #
        KP$ID = D0$SUN[LLR$SMO[0]];
        END  # RESET #
 
      KREQ(LOC(KWORD),KLINK);        # SEND K-DISPLAY REQUEST #
 
STRCART4:
      IF LLR$DRD[0] EQ 0
      THEN                           # UPPER DRD EMPTY #
        BEGIN  # CLEAR #
        D0$FULL[LLR$SMO[0]] = FALSE;
        END  # CLEAR #
 
      ELSE                           # LOWER DRD EMPTY #
        BEGIN  # CLEAR #
        D1$FULL[LLR$SMO[0]] = FALSE;
        END  # CLEAR #
 
      IF LLR$SDR[0] NQ 0
      THEN                           # RESTORE ORIGINAL ERROR FOR EXEC #
        BEGIN  # RESET #
        LLR$DR[0] = LLR$SDR[0];
        END  # RESET #
 
      IF LLR$PRCNME[0] EQ REQTYP4"INITHW"
      THEN                           # CLEAR SO UDT SCAN CAN FINISH #
        BEGIN  # CLEAR #
        IF MS$RETCODE[0] NQ HRC$CSNERR  # DRD NOT YET OFF #
        THEN                         # NOT RETRYING AS NORMAL STORE #
          BEGIN  # OFF #
          LLR$DRFUL[0] = FALSE;
          END  # OFF #
 
        LLR$DRDOFF[0] = FALSE;
        LLR$LDERR[0] = FALSE;        # IN CASE LOAD ERROR OCCURRED #
        END  # CLEAR #
 
      LLR$RS[0] = PROCST"COMPLETE";
      IF MS$RETCODE[0] EQ HRC$CSNERR  # RETRY AS NORMAL STORE #
        OR (KW$LINE2[0] EQ KM"KM19"  # RETRY STORE TO OUTPUT TRAY #
        AND NOT KW$COMP[0])
      THEN                           # RETRY STORING CARTRIDGE #
        BEGIN  # RETRY #
        LLR$RS[0] = PROCST"INITIAL";
        END  # RETRY #
 
      IF MBF$SBADDR[0] NQ 0
      THEN                           # CLEAR SBT ENTRY #
        BEGIN  # CLEAR #
        P<UDT$MSG> = MBF$SBADDR[0];
        ZFILL(UDT$MSG,MSGLT);
        END  # CLEAR #
 
      MBF$WORD[0] = 0;               # CLEAR MESSAGE STATUS #
      RETURN;
 
STRCART2:
      MESSAGE(FEMSG,UDFL1);
      ABORT;
      END  # STRCART #
 
    TERM
PROC XFRDATA;
# TITLE XFRDATA - TRANSFER DATA TO/FROM M860.                         #
 
      BEGIN  # XFRDATA #
 
#
**    XFRDATA - TRANSFER DATA TO/FROM M860.
*
*     *XFRDATA* PROCESSES *DRQUEUE* REQUESTS TO MOUNT AND UNLOAD
*     VOLUMES, AND INITIATES DATA TRANSFERS BETWEEN *SSEXEC* AND THE
*     M860 HARDWARE.
*
*     PROC XFRDATA
*
*     ENTRY      P<LLRQ> = *DRQUEUE* ENTRY ADDRESS.
*
*     EXIT       THE *DRQUEUE* ENTRY REQUEST STATE FIELD HAS BEEN
*                UPDATED TO INDICATE WHERE SUBSEQUENT PROCESSING OF
*                THIS REQUEST IS TO CONTINUE.
*
*     MESSAGES   *EXEC ABNORMAL, XFRDATA1.* - UDT MESSAGE BUFFER STILL
*                                             IN USE.
*
*                *EXEC ABNORMAL, XFRDATA2.* - FATAL ERROR RECEIVED IN
*                                             M860 *MOUNT VOLUME*
*                                             RESPONSE.
*
*     NOTES      THIS IS A PSEUDO-REENTRANT PROCEDURE.
#
 
 
#
****  PROC XFRDATA - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ABORT;                  # ABORT #
        PROC CALLPP;                 # PASS MESSAGES/DATA TO PP #
        PROC MESSAGE;                # ISSUE DAYFILE MESSAGE #
        PROC RTIME;                  # GET TIME SINCE DEADSTART #
        PROC SENDMSG;                # SEND M860 MESSAGE #
        PROC ZFILL;                  # ZERO-FILL BUFFER #
        END
 
#
****  PROC XFRDATA - XREF LIST END.
#
 
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
*CALL,COMBFAS
*CALL,COMBCDD
*CALL COMBCPR
*CALL,COMBFET
*CALL,COMBHFC
*CALL,COMBLRQ
*CALL,COMBUDT
*CALL,COMXMSC
 
      ITEM I          I;             # INDEX #
 
      SWITCH XFRLBL:PROCST           # DRIVER REQUEST STATE #
            XFRINIT:INITIAL,         # INITIAL STATE #
            XFRMNVL:CONT1,           # CONTINUATION 1 #
            XFRPDAT:CONT2,           # CONTINUATION 2 #
            XFRINCR:CONT3,           # CONTINUATION 3 #
            XFRUNLD:CONT4,           # CONTINUATION 4 #
            XFRRESP:CONT5;           # CONTINUATION 5 #
                                               CONTROL EJECT;
 
      GOTO XFRLBL[LLR$RS[0]];
 
#
*     INITIAL DRIVER REQUEST STATE.
#
 
XFRINIT:
      P<MBFHDR> = LLR$MBH[0];
      IF MBF$WORD[0] NQ 0
      THEN                           # DRD STILL IN USE #
        BEGIN  # ABORT #
        FE$RTN[0] = "XFRDATA1.";
        GOTO XFRDATA1;
        END  # ABORT #
 
      P<UDT$MSG> = P<MBFHDR> + 1;
      MBF$SAVE[0] = SAVEMOST;
      MS$MSG[0] = HFC$MVLMVR;        # ASSUME READING DATA #
      LLR$RS[0] = PROCST"CONT1";
 
#
*     ISSUE M860 MESSAGE TO MOUNT VOLUME.
#
 
XFRMNVL:
      P<FETFHB> = LLR$MSFET[0];
      FHB$UNIT[0] = D1$SUN[LLR$SMO[0]];
      IF LLR$DRD[0] EQ 0
      THEN                           # UPPER DRD BEING USED #
        BEGIN  # RESET #
        FHB$UNIT[0] = D0$SUN[LLR$SMO[0]];
        END  # RESET #
 
      P<MBFHDR> = LLR$MBH[0];
      SENDMSG;                       # SEND M860 MESSAGE #
      IF LLR$DR[0] EQ RESPTYP4"M86$HDW$PR"
      THEN                           # HARDWARE PROBLEM #
        BEGIN  # EXIT #
        IF MS$INTER[0] NQ 0          # CIF SELECTED #
        THEN                         # DATA TRANSFER STOPPED #
          BEGIN  # NO DATA #
          B<LLR$CIF[0],1>UD$DBACT[LLR$CU[0]] = OFF;
          END  # NO DATA #
 
        IF MBF$SENT[0]
        THEN                         # IGNORE RESPONSES #
          BEGIN  # IGNORE #
          MSGCNT(LLR$CIF[0],LLR$CU[0]) = MSGCNT(LLR$CIF[0],LLR$CU[0])-1;
                                     # COUNT INCLUDED REWIND/UNLOAD #
          END  # IGNORE #
 
        GOTO XFRDATA2;
        END  # EXIT #
 
      IF MBF$SBADDR[0] EQ 0
      THEN                           # RESPONSE NOT YET RECEIVED #
        BEGIN  # RETRY #
        RETURN;
        END  # RETRY #
 
      IF MS$RETCODE[0] NQ 0
      THEN                           # SOFTWARE ERROR #
        BEGIN  # ABORT #
        FE$RTN[0] = "XFRDATA2.";
        GOTO XFRDATA1;
        END  # ABORT #
 
      ZFILL(UDT$MSG,MSGLT);          # CLEAR STORAGE BUFFER #
      MBF$SBADDR[0] = 0;             # CLEAR SBT ENTRY ADDRESS #
      MBF$TMOUT[0] = 0;              # CLEAR MESSAGE TIMEOUT #
      LLR$RS[0] = PROCST"CONT2";
 
#
*     PASS DATA BUFFER ADDRESS TO PP TO START DATA TRANSFER.
#
 
XFRPDAT:
      P<MBFHDR> = LLR$MBH[0];
      P<UDT$MSG> = P<MBFHDR> + 1;
      CALLPP(IRMDAT);
      IF LLR$DR[0] EQ RESPTYP4"M86$HDW$PR"
      THEN                           # HARDWARE PROBLEM #
        BEGIN  # EXIT #
        GOTO XFRDATA2;
        END  # EXIT #
 
      IF B<FMR$CIF[0],1>UD$DBACT[LLR$CU[0]] EQ ON  ##
        AND P<FETMWB> NQ 0           # CHANNEL WAS ALLOCATED #
      THEN                           # DATA TRANSFER STARTED #
        BEGIN  # RETRY #
        LLR$RS[0] = PROCST"COMPLETE";# RETURN WHEN COPY COMPLETE #
        END  # RETRY #
 
      RETURN;
 
#
*     AWAIT M860-INITIATED UNLOAD MESSAGE.
#
 
XFRINCR:
      SLOWFOR I = 1 STEP 1 UNTIL PPCBTSIZE
      DO                             # NOTE DATA TRANSFER COMPLETE #
        BEGIN  # SCAN #
        IF LLR$MSFET[0] EQ PPU$DBADDR[I]
        THEN                         # REMOVE ADDRESS #
          BEGIN  # CLEAR #
          PPU$DBADDR[I] = 0;
          B<LLR$CIF[0],1>UD$DBACT[LLR$CU[0]] = OFF;
                                     # FREE PP FOR NEXT DATA XFER #
          END  # CLEAR #
 
        END  # SCAN #
 
      IF LLR$DRFUL[0]
      THEN                           # DATA TRANSFER ERROR #
        BEGIN  # EXIT #
        LLR$SCIF[0] = LLR$CIF[0];    # SAVE TO DECIDE IF DRD GOES OFF #
        LLR$SCU[0] = LLR$CU[0];
        MSGCNT(LLR$CIF[0],LLR$CU[0]) = MSGCNT(LLR$CIF[0],LLR$CU[0])-1;
        GOTO XFRDATA2;               # DO NOT EXPECT REWIND/UNLOAD #
        END  # EXIT #
 
      RTIME(RTIMESTAT);              # RESET MESSAGE TIMEOUT #
      P<MBFHDR> = LLR$MBH[0];
      MBF$TMOUT[0] = RTIMSECS[0];
      LLR$RS[0] = PROCST"CONT4";
 
XFRUNLD:
      P<MBFHDR> = LLR$MBH[0];
      SENDMSG;                       # AWAIT UNLOAD MESSAGE #
      IF LLR$DR[0] EQ RESPTYP4"M86$HDW$PR"
      THEN                           # RESPONSE TIMED OUT #
        BEGIN  # EXIT #
        GOTO XFRDATA2;
        END  # EXIT #
 
      IF MBF$SBADDR[0] EQ 0
      THEN                           # MESSAGE NOT YET RECEIVED #
        BEGIN  # RETRY #
        RETURN;
        END  # RETRY #
 
      IF LLR$PRCNME[0] EQ REQTYP4"CPY$DA"   # VOLUME DESTAGE #
      THEN                           # RETURN STATISTICS #
        BEGIN  # STATS #
        LLR$LT$ST[0] = MS$PARM1A[0]; # LAST STRIPE WRITTEN #
        LLR$LOG$ST[0] = MS$PARM2[0]; # LOGICAL STRIPE POSITION #
        END  # STATS #
 
      MBF$SENT[0] = FALSE;
      MS$MSG$R[0] = TRUE;            # SET AS UNLOAD RESPONSE #
      LLR$RS[0] = PROCST"CONT5";
 
#
*     ISSUE RESPONSE TO M860-INITIATED UNLOAD MESSAGE.
#
 
XFRRESP:
      P<MBFHDR> = LLR$MBH[0];
      SENDMSG;                       # SEND UNLOAD RESPONSE #
      IF LLR$DR[0] EQ RESPTYP4"OK4"  # HARDWARE GOOD #
        AND NOT MBF$SENT[0]
      THEN                           # RESPONSE NOT YET SENT #
        BEGIN  # RETRY #
        RETURN;
        END  # RETRY #
 
XFRDATA2:
      IF MBF$SBADDR[0] NQ 0
      THEN                           # CLEAR SBT ENTRY #
        BEGIN  # CLEAR #
        P<UDT$MSG> = MBF$SBADDR[0];
        ZFILL(UDT$MSG,MSGLT);
        END  # CLEAR #
 
      IF NOT LLR$DRFUL[0]
      THEN                           # DO NOT ISSUE FORCED-STORE #
        BEGIN  # NORMAL #
        MBF$WORD[0] = 0;             # STOP *STRCART* FROM FORCING #
        END  # NORMAL #
 
      LLR$RS[0] = PROCST"COMPLETE";
      RETURN;
 
XFRDATA1:
      MESSAGE(FEMSG,UDFL1);
      ABORT;
      END  # XFRDATA #
 
    TERM