EXDRVR
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
