Retro1.org codex

PROC L;
# TITLE L - LOW LEVEL REQUEST PROCESSOR DOCUMENTATION.                #
      BEGIN  # L #
 
#
****  LOW LEVEL REQUEST PROCESSORS.
*
*     THE FOLLOWING PROCESSORS CONSTITUTE THE LOW LEVEL REQUEST
*     PROCESSORS:
*        CPY$DS
*        CPY$RS
*        CPY$SD
*        INIT$HW
*        LD$CAR
*        RD$LAB
*        TEST$YZ
*        UNL$CAR
*        WT$LAB
*
*     THESE PROCESSORS ARE ALL CODED IN A SPECIAL WAY THAT IS TERMED
*     "PSEUDO-REENTRANT".
*
*     WHEN A LOW LEVEL REQUEST PROCESSOR IS CALLED IT IS PASSED THE
*     ADDRESS OF AN *LLRQ* ENTRY (A REQUEST) WHICH IS READY FOR
*     FURTHER PROCESSING.  ALL THE PARAMETERS THE PROCESSOR NEEDS FOR
*     ADVANCING THE REQUEST ARE CONTAINED IN THE *LLRQ* ENTRY. IN
*     PARTICULAR, THE PROCESS STATE FIELD (LLR$PS) TELLS THE PROCESSOR
*     WHERE IT LEFT OFF THE LAST TIME IT WAS PROCESSING THIS REQUEST,
*     AND THUS WHAT TO DO NEXT TO ADVANCE THE REQUEST.
*
*     WHEN A LOW LEVEL REQUEST PROCESSOR REACHES A POINT WHERE IT
*     CANNOT CONTINUE ADVANCING THE REQUEST WITHOUT A LONG DELAY, IT
*     SETS UP SOME CONDITION THAT WILL EVENTUALLY GET THE REQUEST PUT
*     BACK ON THE *LLRQ* READY CHAIN, AND THEN DROPS OUT BY
*      1) SETTING THE PROCESS STATE FIELD IN THE *LLRQ* ENTRY TO A
*         VALUE THAT WILL ALLOW THE PROCESSOR TO RESTART THE REQUEST
*         AT THE CORRECT POINT LATER, AND
*      2) RETURNING CONTROL TO THE *LLRQ* MONITOR.
*
*     WHEN A LOW LEVEL REQUEST PROCESSOR COMPLETES THE PROCESSING OF
*     A REQUEST, IT CAUSES THE ORIGINATOR OF THE REQUEST TO BE
*     NOTIFIED OF THE COMPLETION.  IF THE REQUEST ORIGINATED FROM A
*     *UCP* THE NOTIFICATION IS DONE BY STORING THE RESPONSE CODE IN
*     THE LONG TERM CONNECT TABLE ENTRY FOR THE *UCP* AND THEN
*     CALLING *UCP$RES*.  IF THE REQUEST ORIGINATED FROM A HIGH LEVEL
*     REQUEST PROCESSOR, THE NOTIFICATION IS DONE BY STORING THE
*     RESPONSE CODE IN THE *HLRQ* ENTRY FOR THE HIGH LEVEL REQUEST,
*     AND PUTTING THE *HLRQ* ENTRY ON THE *HLRQ* READY CHAIN.
*
*     WHEN THE PROCESSOR HAS NOTIFIED THE ORIGINATOR, IT THEN SETS
*     PROCESS STATE FIELD IN THE *LLRQ* ENTRY TO "COMPLETE" AND
*     RETURNS CONTROL TO THE *LLRQ* MONITOR. THE MONITOR THEN ZEROES
*     OUT THE *LLRQ* ENTRY AND PUTS IT ON THE *LLRQ* FREE SPACE
*     CHAIN.
#
 
      END  # L #
 
    TERM
PROC CPY$DS((LLRADR));
# TITLE CPY$DS - COPY DISK TO VOLUME.                                 #
 
      BEGIN  # CPY$DS #
 
#
**    CPY$DS - COPY DISK TO VOLUME.
*
*     *CPY$DS* COPIES THE DISK FILE (FROM ITS CURRENT POSITION) TO THE
*     VOLUME, UNTIL END OF VOLUME OR END OF FILE IS ENCOUNTERED.
*
*     PROC CPY$DS((LLRADR))
*
*     ENTRY      (LLRADR) - ADDRESS OF *LLRQ* ENTRY FOR THE COPY
*                           CONTAINING THE SMA-ID, YZ COORDINATES,
*                           ADDRESS OF THE DISK AND M860 FET-S.  THE
*                           FET-S MUST BE INITIALIZED.
*
*     EXIT       THE PROCESS STATE FIELD IN THE *LLRQ* ENTRY HAS BEEN
*                ADVANCED TO INDICATE WHERE PROCESSING OF THIS REQUEST
*                LEFT OFF AND THUS WHAT TO DO NEXT TO ADVANCE THE
*                REQUEST.  WHEN THE COPY IS COMPLETE AN ERROR RESPONSE
*                CODE IS RETURNED IN THE *HLRQ* ENTRY WHICH GENERATED
*                THE COPY REQUEST.
*                (HLR$RESP[0]) - ERROR RESPONSE CODE.
*                                (VALUES DEFINED IN *COMBCPR*).
*                                = RESPTYP4"OK4".
*                                = RESPTYP4"UN$WRT$ERR".
*                                = RESPTYP4"EX$WRT$ERR".
*                                = RESPTYP4"M86$HDW$PR".
*                                = RESPTYP4"RMS$FL$ERR".
*
*     NOTES      THIS MODULE IS A PSEUDO REENTRANT ROUTINE, CALLED ONLY
*                BY *DESTAGR* THRU THE *HLRQ* PROCESSOR.
#
 
      ITEM LLRADR     U;             # *LLRQ* ENTRY ADDRESS #
      ITEM STRPCT     U;             # NUMBER OF STRIPES #
 
#
****  PROC CPY$DS - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ADD$LNK;                # ADD ENTRY TO CHAIN #
        PROC GETBUF;                 # GET LARGE BUFFER #
        PROC RLSBUF;                 # RELASE LARGE BUFFER #
        PROC READCW;                 # READ WITH CONTROL WORDS #
        PROC SETFET;                 # INITIALIZE LARGE BUFFER #
        END
 
#
****  PROC CPY$DS - XREF LIST END.
#
 
      DEF LISTCON #0#;               # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBCDD
*CALL COMBCHN
*CALL COMBCPR
*CALL COMBFET
*CALL COMBLRQ
*CALL COMBRCD
*CALL COMXCCB
*CALL COMXHLR
*CALL COMXMSC
 
      ITEM FLAG       B;             # FLAG #
 
      SWITCH CDSENTR:PROCST          # COPY DISK TO VOLUME ENTRIES #
             CDSINIT:INITIAL,        # INITIAL ENTRY #
                CDS1:CONT1,          # WAIT LARGE BUFFER #
                CDS2:CONT2,          # DRIVER VOLUME RETURN #
                CDS3:CONT3;          # DRIVER RETURN *REWIND/UNLOAD* #
                                               CONTROL EJECT;
 
      P<LLRQ> = LLRADR;
      P<HLRQ> = LLR$UCPRA[0];
      GOTO CDSENTR[LLR$PRCST[0]];
 
#
*     "INITIAL" PROCESS STATE.
#
 
CDSINIT:                             # SET UP COPY CONTROL BLOCK #
      GETBUF(LLRADR,HLRQIND,FLAG);
      IF NOT FLAG
      THEN                           # NO BUFFER AVAILABLE #
        BEGIN
        LLR$PRCST[0] = PROCST"CONT1";  # WAIT BUFFER ASSIGNMENT #
        ADD$LNK(LLRADR,LCHN"LL$LGBUF",0);
        RETURN;
        END
 
#
*     *CONT1* PROCESS STATE.
#
 
CDS1:
      SETFET(LLRADR);            # INITIALIZE,LARGE BUFFER #
      P<HLRQ> = LLR$UCPRA[0];
      P<LLRQ> = LLRADR;
      P<CCB> = LLR$CCB[0];
      P<FETSET> = LLR$DSKFET[0];
      P<FETFHB> = LLR$MSFET[0];
      CCBOPCODE[0] = CPYC"DISKAU";
      FET$RR[0] = HLR$PRU[0];
 
#
*     SET STRIPE INFORMATION IN LARGE BUFFER.
#
 
      FHB$TIME[0] = PDATEV;
      FHB$SMIF[0] = LLR$SMIF[0];
      FHB$CCSN[0] = HLR$CSNTCU[0];
      FHB$SHDWD[0] = HLR$FETMT[0];
      FHB$PCSN[0] = HLR$CSNTPS[0];
      FHB$PFC[0] = HLR$PFC[0];
      FHB$CODE[0] = FCCWW;       # CONTROL WORD WRITE #
       READCW(FETSET[0],0,NRCL);
      LLR$RC[0] = REQCODE"SWRT$VOL";  # ISSUE WRITE VOLUME REQUEST #
      LLR$RS[0] = PROCST"INITIAL";
      ADD$LNK(CCBLLRQ[0],LCHN"DRQUEUE",0);
      LLR$PRCST[0] = PROCST"CONT2";
      RETURN;
 
#
*     *CONT2* PROCESS STATE.
*     CPU DRIVER RETURN FROM VOLUME MOUNT.
#
 
CDS2:                                # PROCESS DRIVER RESPONSE #
      IF LLR$DR[0] NQ RESPTYP4"OK4"
      THEN
        BEGIN        # PROCESS DRIVER ERROR RETURN CODE #
        IF LLR$DR[0] EQ RESPTYP4"UN$WRT$ERR"
        THEN
          BEGIN       # UNRECOVERED WRITE ERROR #
          HLR$AUUD[0] = (LLR$ST$LW[0] - INFTST) / INSPAU + 1;
          HLR$HRDE[0] = HLR$HRDE[0] + 1;        # SET WRITE ERROR #
          END       # WRITE ERROR #
        GOTO CONT;
        END
 
      ADD$LNK(LLR$CCB[0],LCHN"KC$GOING",0);
      LLR$PRCST[0] = PROCST"CONT3";
      RETURN;
 
 
#
*     *CONT3* PROCESS STATE.
*     KEEP COPY GOING RETURN AFTER REWIND/UNLOAD COMMAND.
#
 
CDS3:
      P<CCB> = LLR$CCB[0];
      HLR$AUUD[0] = (LLR$LT$ST[0] - INFTST) / INSPAU + 1;
      STRPCT = LLR$LOG$ST[0] / INSPAU;
 
       IF CCBDERR[0]
       THEN
         BEGIN         # DISK ERROR #
         LLR$DR[0] = RESPTYP4"RMS$FL$ERR";
         GOTO CONT;
         END
 
      IF (CCBHDWPM[0])
        OR (LLR$DR[0] NQ RESPTYP4"OK4")
        OR (HLR$AUUD[0] LS HLR$VOLAU[0])
        OR (HLR$AUUD[0] GR (HLR$VOLAU[0] + HLR$VOLLN[0]))
        OR (STRPCT GR HLR$VOLLN[0])
      THEN                           # HARDWARE ERROR #
        BEGIN
        LLR$DR[0] = RESPTYP4"M86$HDW$PR";
        LLR$DRFUL[0] = TRUE;         # FORCE UNLOAD OF CARTRIDGE #
        GOTO CONT;
        END
 
      IF CCBTAPPAR
      THEN
        BEGIN       # WRITE PARITY ERROR #
        LLR$DR[0] = RESPTYP4"UN$WRT$ERR";
        HLR$HRDE[0] = HLR$HRDE[0] + 1;       # SET WRITE ERROR #
        GOTO CONT;
        END
 
        HLR$PRU[0] = LLR$LOG$ST[0] * INPRUS + HLR$PRU[0];
 
CONT:
 
      HLR$RESP[0] = LLR$DR[0];       # RETURN RESPONSE #
      ADD$LNK(LLR$UCPRA[0],LCHN"HL$READY",0);
      LLR$MSFET[0] = 0;
      LLR$DSKFET[0] = 0;
      RLSBUF(LLRADR);                # RELEASE BUFFER #
      RETURN;
      END  # CPY$DS #
 
    TERM
PROC CPY$RS((LLRADR));
# TITLE CPY$RS - COPY RAW VOLUME.                                     #
 
      BEGIN  # CPY$RS #
 
#
**    CPY$RS - COPY RAW VOLUME.
*
*     *CPY$RS* APPENDS A RAW VOLUME TO A FILE, STARTING WITH THE
*     CURRENT POSITION ON THE VOLUME TO THE END OF VOLUME.
*
*     PROC CPY$RS((LLRADR))
*
*     ENTRY      (LLRADR) - ADDRESS OF *LLRQ* ENTRY FOR THE COPY
*                           CONTAINING THE SMA-ID, THE VOLUME
*                           NUMBER, AND THE YZ COORDINATES.
*
*     EXIT       THE PROCESS STATE FIELD IN THE *LLRQ* ENTRY HAS BEEN
*                ADVANCED TO INDICATE WHERE PROCESSING OF THIS REQUEST
*                LEFT OFF AND THUS WHAT TO DO NEXT TO ADVANCE THE
*                REQUEST.  WHEN THE COPY IS COMPLETE AN ERROR RESPONSE
*                CODE IS RETURNED VIA *LTC$RQR[LTCENTRY]*.
*                (LTC$RQR[LTCENTRY]) - ERROR RESPONSE CODE.
*                                      (VALUES DEFINED IN *COMBCPR*).
*                                      = RESPTYP4"OK4".
*                                      = RESPTYP4"M86$HDW$PR".
*                                      = RESPTYP4"RMS$FL$ERR".
*                                      = RESPTYP4"DISK$FULL".
*
*     MESSAGES   * EXEC ABNORMAL, CPY$RS.*.
*
*     NOTES      THIS MODULE IS A PSEUDO REENTRANT ROUTINE.  A COPY RAW
*                VOLUME REQUEST ONLY COMES FROM *ASDEBUG* AND IS USED
*                TO SALVAGE INFORMATION FROM A VOLUME WITH READ ERRORS.
#
 
      ITEM LLRADR     U;             # *LLRQ* ENTRY ADDRESS #
 
#
****  PROC CPY$RS - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ABORT;                  # ABORT #
        PROC ADD$LNK;                # ADD ENTRY TO CHAIN #
        PROC DELAY;                  # TIMED DELAY #
        PROC GETBUF;                 # GET LARGE BUFFERS #
        PROC MESSAGE;                # ISSUE MESSAGE #
        PROC PFD;                    # PERMANENT FILE REQUEST DELAYS #
        PROC RETERN;                 # RETURN FILE #
        PROC RLSBUF;                 # RELEASE LARGE BUFFERS #
        PROC SETFET;                 # INITIALIZE LARGE BUFFER #
        PROC SETPFP;                 # SET PERMANENT FILE PARAMETERS #
        PROC SFCALL;                 # INTERFACE TO *SFCALL* MACRO #
        PROC SKIPEI;                 # SKIP TO *EOI* #
        PROC UCP$RESP;               # UCP RESPONSE #
        PROC WRITE;                  # WRITE DATA FROM *CIO* BUFFER #
        PROC WRITER;                 # WRITE *EOR* #
        END
 
#
****  PROC CPY$RS - XREF LIST END.
#
 
      DEF LISTCON #0#;               # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBCHN
*CALL COMBCPR
*CALL COMBFET
*CALL COMBLBL
*CALL COMBLRQ
*CALL COMBPFP
*CALL COMBPFS
*CALL COMBRCD
*CALL COMBUCR
*CALL COMXBST
*CALL COMXIPR
*CALL COMXLTC
*CALL COMXMSC
*CALL COMSPFM
 
      ITEM FLAG       B;             # FLAG #
 
      SWITCH CRSENTR:PROCST          # COPY RAW VOLUME ENTRIES #
             CRSINIT:INITIAL,        # INITIAL ENTRY #
                CRS1:CONT1,          # CONTINUATION 1 #
                CRS2:CONT2,          # CONTINUATION 2 #
                CRS3:CONT3,          # CONTINUATION 3 #
                CRS4:CONT4;          # CONTINUATION 4 #
                                               CONTROL EJECT;
 
      P<LLRQ> = LLRADR;
      LLR$DR[0] = RESPTYP4"OK4";
      GOTO CRSENTR[LLR$PRCST[0]];    # PROCESS REQUEST #
 
#
*     "INITIAL" PROCESS STATE.
#
 
CRSINIT:
      GETBUF(LLRADR,HLRQIND,FLAG);
      IF NOT FLAG
      THEN                           # NO BUFFER AVAILABLE #
        BEGIN
        LLR$PRCST[0] = PROCST"CONT1";   #WAIT BUFFER ASSIGNMENT#
        ADD$LNK(LLRADR,LCHN"LL$LGBUF",0);
        RETURN;
        END
 
 
CRS1:
      SETFET(LLRADR);
 
#
*     "CONT1" PROCESS STATE.
*
*     REREAD THE UCP REQUEST BLOCK TO GET THE FAMILY, USER INDEX,
*     AND FILE NAME.
#
 
CRS2:
      IF LLR$UCPABT[0]
      THEN
        BEGIN
        GOTO CRSCOMP;
        END
 
      P<FETSET> = LLR$DSKFET[0];
      LTCENTRY = LLR$LTCT[0];
      LTC$SFUCPA[LTCENTRY] = LLR$UCPRA[0];
      LTC$SFSCPA[LTCENTRY] = FET$IN[0];
      LTC$SFFP[LTCENTRY] = TYP4$WC + 1;
      LTC$SFFC[LTCENTRY] = SFREAD;
      SFCALL(LOC(LTC$WORD0[LTCENTRY]),RCL);
      IF LTC$SFRC[LTCENTRY] NQ 0
      THEN
        BEGIN  # PROCESS ERROR RESPONSE #
        IF LTC$SFRC[LTCENTRY] EQ SFRCSWPOUT
        THEN
          BEGIN  # SWAP IN UCP #
          LTC$SFUCPA[LTCENTRY] = 0;
          LTC$SFSCPA[LTCENTRY] = 0;
          LTC$SFFC[LTCENTRY] = SFSWPI;
          SFCALL(LOC(LTC$WORD0[LTCENTRY]),NRCL);
 
#
*     "CONT3" PROCESS STATE.
#
 
CRS3:
          LTCENTRY = LLR$LTCT[0];
          IF LTC$SFFCC[LTCENTRY]
          THEN                       # RETRY *SFREAD* #
            BEGIN
            LLR$PRCST[0] = PROCST"CONT2";
            END
 
          ELSE                       # DELAY FOR REQUEST COMPLETION #
            BEGIN
            LLR$PRCST[0] = PROCST"CONT3";
            DELAY(UCP$INTV,LLRADR,LLRQIND);
            END
 
          RETURN;
          END  # SWAP IN UCP #
 
        ELSE                         # FATAL ERROR #
          BEGIN
          GOTO CRSFERR;
          END
 
        END  # PROCESS ERROR RESPONSE #
 
      P<CPR> = FET$IN[0];
      FET$LFN[0] = CPR$PFN[0];
      PFP$WRD0[0] = 0;               # SET FAMILY AND USER INDEX #
      PFP$FAM[0] = CPR$FAM[0];
      PFP$UI[0] = CPR$UI[0];
      PFP$FG1[0] = TRUE;
      PFP$FG4[0] = TRUE;
      SETPFP(PFP);
      IF PFP$STAT[0] NQ 0
      THEN
        BEGIN
        GOTO CRSFERR;
        END
 
      PFD("ATTACH",FET$LFN[0],0,"M","W","RC",PFSTAT,"NA",0,"UP",0,0);
      PFP$FAM[0] = DEF$FAM;          # RETURN TO DEFAULT FAMILY #
      PFP$UI[0] = DEF$UI;
      SETPFP(PFP);
      IF PFP$STAT[0] NQ 0
      THEN
        BEGIN
        GOTO CRSFERR;
        END
 
      IF PFSTAT NQ 0
      THEN                           # IF *ATTACH* ERROR #
        BEGIN
        LLR$DR[0] = RESPTYP4"ATTACH$ERR";
        GOTO CRSCOMP;
        END
 
      SKIPEI(FETSET[0],RCL);
 
#
*     SET READ ONE STRIPE AT A TIME.
#
 
      LLR$SAV$HI[0] = LLR$ST$HI[0];        # SAVE LAST STRIPE TO READ #
      LLR$ST$HI[0] = LLR$ST$LW[0] + 1;
 
#
*     ISSUE A READ RAW STRIPE REQUEST TO THE DRIVER. WHEN IT IS
*     COMPLETED, WRITE THE RAW STRIPE TO THE DISK FILE. THEN LOOP
*     BACK TO READ THE NEXT RAW STRIPE. CONTINUE THIS LOOP UNTIL
*     THE LAST STRIPE IS READ.
#
 
      LLR$RC[0] = REQCODE"SRDRAW$STP";
      LLR$PRCST[0] = PROCST"CONT4";
 
RDRAWSTP:                            # ISSUE READ RAW STRIPE REQUEST #
      IF LLR$UCPABT[0]
      THEN
        BEGIN
        GOTO CRSCOMP;
        END
 
      LLR$DR[0] = 0;
      LLR$RS[0] = PROCST"INITIAL";
      ADD$LNK(LLRADR,LCHN"DRQUEUE",0);
      RETURN;
 
#
*     "CONT4" PROCESS STATE.
#
 
CRS4:
      IF LLR$DR[0] NQ RESPTYP4"OK4"           ##
      THEN
        BEGIN  # PROCESS ERROR #
         GOTO CRSCOMP;
         END
      P<FETFHB> = LLR$MSFET[0];
      P<FETSET> = LLR$DSKFET[0];
      FET$IN[0] = FHB$IN[0];
 
      WRITER(FETSET[0],RCL);
 
      IF FET$AT[0] NQ 0
      THEN
        BEGIN  # WRITE ERROR #
        IF FET$AT[0] EQ ATCODE AND FET$DEC[0] EQ DISKFULL
        THEN                         # DISK FULL #
          BEGIN
          LLR$DR[0] = RESPTYP4"DISK$FULL";
          END
 
        ELSE                         # FILE WRITE ERROR #
          BEGIN
          LLR$DR[0] = RESPTYP4"RMS$FL$ERR";
          END
 
        GOTO CRSCOMP;
        END  # WRITE ERROR #
 
      LLR$ST$LW[0] = LLR$ST$LW[0] + 1;
      LLR$ST$HI[0] = LLR$ST$LW[0] + 1;
 
      IF LLR$ST$LW[0] LQ LLR$SAV$HI[0]
      THEN                           # IF NOT END OF VOLUME #
        BEGIN
        FHB$IN[0] = FET$FRST[0];
        FHB$OUT[0] = FET$FRST[0];
        FET$IN[0] = FET$FRST[0];
        FET$OUT[0] = FET$FRST[0];
        GOTO RDRAWSTP;               # CONTINUE READING STRIPES #
        END
 
      LLR$DR[0] = RESPTYP4"OK4";
 
CRSCOMP:
      P<FETSET> = LLR$DSKFET[0];
      IF FET$LFN[0] NQ 0
      THEN
        BEGIN
        RETERN(FETSET[0],RCL);
        END
 
      LLR$MSFET[0] = 0;
      LLR$DSKFET[0] =0;
      RLSBUF(LLRADR);                # RELEASE BUFFERS #
      P<LLRQ> = LLRADR;
      IF NOT LLR$UCPABT[0]
      THEN                           # ISSUE RESPONSE TO THE UCP #
        BEGIN
        LTCENTRY = LLR$LTCT[0];
        LTC$RQR[LTCENTRY] = LLR$DR[0];
        UCP$RESP;
        END
      ELSE
        BEGIN       # FORCE UNLOAD OF CARTRIDGE #
        LLR$PRCNME[0] = REQTYP4"UNLD$CART";
        LLR$PRCST[0] = PROCST"INITIAL";
        LLR$RQI[0] = REQNAME"RQIAUCP";
        ADD$LNK(LLRADR,LCHN"LL$READY",0);
        END         # UNLOAD CARTRIDGE #
 
      RETURN;
 
CRSFERR:                             # FATAL ERROR #
      FE$RTN[0] = "CPY$RS.";
      MESSAGE(FEMSG,UDFL1);
      ABORT;
      END  # CPY$RS #
 
    TERM
PROC CPY$SD((LLRADR));
# TITLE CPY$SD - COPY VOLUME TO DISK.                                 #
 
      BEGIN  # CPY$SD #
 
#
**    CPY$SD - COPY VOLUME TO DISK.
*
*     *CPY$SD* COPIES A VOLUME TO A DISK FILE.
*
*     PROC CPY$SD((LLRADR))
*
*     ENTRY      (LLRADR) - ADDRESS OF *LLRQ* ENTRY FOR THE COPY
*                           CONTAINING THE SMA-ID, YZ COORDINATES,
*                           ADDRESS OF THE DISK AND M860 FET-S.  THE
*                           FET-S MUST BE INITIALIZED.
*
*     EXIT       THE PROCESS STATE FIELD IN THE *LLRQ* ENTRY HAS BEEN
*                ADVANCED TO INDICATE WHERE PROCESSING OF THIS REQUEST
*                LEFT OFF AND THUS WHAT TO DO NEXT TO ADVANCE THE
*                REQUEST.  WHEN THE COPY IS COMPLETE AN ERROR RESPONSE
*                CODE IS RETURNED IN THE *HLRQ* ENTRY WHICH GENERATED
*                THE COPY REQUEST.
*                (HLR$RESP[0]) - ERROR RESPONSE CODE.
*                                (VALUES DEFINED IN *COMBCPR*).
*                                = RESPTYP4"OK4".
*                                = RESPTYP4"UNR$RD$ERR".
*                                = RESPTYP4"M86SYS$ERR".
*                                = RESPTYP4"M86$HDW$PR".
*                                = RESPTYP4"RMS$FL$ERR".
*                                = RESPTYP4"DISK$FULL".
*
*     NOTES      THIS MODULE IS A PSEUDO REENTRANT ROUTINE, CALLED ONLY
*                BY *STAGER* THRU THE *HLRQ* PROCESSOR.
#
 
      ITEM LLRADR     U;             # *LLRQ* ENTRY ADDRESS #
 
#
****  PROC CPY$SD - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ADD$LNK;                # ADD ENTRY TO CHAIN #
        PROC GETBUF;                 # GET LARGE BUFFER #
        PROC RLSBUF;                 # RELEASE LARGE BUFFER #
        PROC SETFET;                 # INITIALIZE LARGE BUFFER #
        END
 
#
****  PROC CPY$SD - XREF LIST END.
#
 
      DEF LISTCON #0#;               # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBCDD
*CALL COMBCHN
*CALL COMBCPR
*CALL COMBFET
*CALL COMBLRQ
*CALL COMBRCD
*CALL COMXCCB
*CALL COMXHLR
*CALL COMXMSC
 
        ITEM FLAG       B;           # FLAG #
 
      SWITCH CSDENTR:PROCST          # COPY VOLUME TO DISK ENTRIES #
             CSDINIT:INITIAL,        # INITIAL ENTRY #
                CSD1:CONT1,          # WAIT LARGE BUFFER #
                CSD2:CONT2,          # DRIVER VOLUME RETURN #
                CSD3:CONT3;          # DRIVER RETURN *REWIND/UNLOAD* #
                                               CONTROL EJECT;
 
      P<LLRQ> = LLRADR;
      P<HLRQ> = LLR$UCPRA[0];
      GOTO CSDENTR[LLR$PRCST[0]];
 
#
*     "INITIAL" PROCESS STATE.
#
 
CSDINIT:                             # SET UP COPY CONTROL BLOCK #
      GETBUF(LLRADR,HLRQIND,FLAG);
      IF NOT FLAG
      THEN                           # NO BUFFER AVAILABLE #
        BEGIN
        LLR$PRCST[0] = PROCST"CONT1";   # WAIT BUFFER ASSIGNMENT #
        ADD$LNK(LLRADR,LCHN"LL$LGBUF",0);
        RETURN;
        END
 
 
#
*     *CONT1* PROCESS STATE.
#
 
CSD1:
      SETFET(LLRADR);                  # INITIALIZE LARGE BUFFER #
      P<LLRQ> = LLRADR;
      P<CCB> = LLR$CCB[0];
      P<FETSET> = LLR$DSKFET[0];
      P<FETFHB> = LLR$MSFET[0];
      CCBOPCODE[0] = CPYC"AUDISK";
      FHB$CODE[0] = FCCWR;
      LLR$RC[0] = REQCODE"SREAD$VOL";  # ISSUE READ VOLUME REQUEST #
      LLR$RS[0] = PROCST"INITIAL";
      ADD$LNK(CCBLLRQ[0],LCHN"DRQUEUE",0);
      LLR$PRCST[0] = PROCST"CONT2";
      RETURN;
 
#
*     *CONT2* PROCESS STATE.
*     CPU DRIVER MOUNT VOLUME RETURN.
#
 
CSD2:                                # PROCESS DRIVER RETURN #
      IF LLR$DR[0] NQ RESPTYP4"OK4"
      THEN
        BEGIN      # PROCESS DRIVER ERROR RETURN CODE #
        GOTO CONT;
        END
 
      ADD$LNK(LLR$CCB[0],LCHN"KC$GOING",0);
      LLR$PRCST[0] = PROCST"CONT3";
      RETURN;
 
 
#
*     *CONT3* PROCESS STATE.
*     CPU DRIVER RETURN FROM REWIND/UNLOAD COMMAND.
#
 
 
CSD3:
      P<CCB> = LLR$CCB[0];
      P<FETSET> = LLR$DSKFET[0];
      P<FETFHB> = LLR$MSFET[0];
       IF CCBDERR[0]
       THEN             # DISK ERROR #
         BEGIN
         LLR$DR[0] = RESPTYP4"RMS$FL$ERR";
         GOTO CONT;
         END
 
       IF CCBDFULL[0]
       THEN             # DISK FULL ERROR #
         BEGIN
         LLR$DR[0] = RESPTYP4"DISK$FULL";
         GOTO CONT;
         END
      IF CCBHDWPM[0] OR LLR$DR[0] NQ RESPTYP4"OK4"
      THEN                           # IF HARDWARE ERROR #
        BEGIN
        LLR$DR[0] = RESPTYP4"M86$HDW$PR";
        LLR$DRFUL[0] = TRUE;         # FORCE UNLOAD OF CARTRIDGE #
         GOTO CONT;
        END
      IF CCBTAPPAR
      THEN
        BEGIN       # READ PARITY ERROR #
        LLR$DR[0] = RESPTYP4"UN$RD$ERR";
        IF NOT HLR$RETRY[0]        # FIRST PARITY ERROR #
        THEN
          BEGIN       # FORCE UNLOAD AND DELINK OF CARTRIDGE #
          LLR$DRFUL[0] = TRUE;
          END
        GOTO CONT;
        END
 
      IF CCPPUDCK
      THEN
        BEGIN      # PPU FOUND DATA TRANSFER ERROR #
        LLR$DR[0]= RESPTYP4"PPU$D$PROB";
        IF NOT HLR$RETRY[0]     # FIRST DATA ERROR #
        THEN
          BEGIN    # FORCE UNLOAD AND DELINK OF CARTRIDGE #
          LLR$DRFUL[0] = TRUE;
          END
 
        GOTO CONT;
        END
 
      IF FHB$PVLN[0] NQ HLR$VOLLNP[0]      # PREVIOUS VOLUME LENGTH #
        OR FHB$PVSN[0] NQ HLR$VOLAUP[0]    # PREVIOUS VOLUME NUMBER #
        OR FHB$CVSN[0] NQ HLR$VOLAU[0]     # VOLUME NUMBER #
        OR FHB$PCSN[0] NQ HLR$CSNTPS       # CSN OR PREVIOUS VOLUME #
        OR FHB$PFC$UI[0] NQ HLR$TDAMUI[0]    # USER INDEX #
        OR FHB$PFC$DT[0]  NQ HLR$TDAMCD[0]   # CREATION DATE / TIME #
      THEN
        BEGIN        # SET VOLUME HEADER ERROR #
        LLR$DR[0] = RESPTYP4"VOL$HD$ERR";
        GOTO CONT;
        END
 
 
      HLR$PRU[0] = FET$CRI[0] + HLR$PRU[0];
 
      IF CCBTPMARK
      THEN
        BEGIN
        HLR$EOI[0] = TRUE;
        END
 
CONT:
 
 
      HLR$RESP[0] = LLR$DR[0];         # RETURN RESPONSE #
      ADD$LNK(LLR$UCPRA[0],LCHN"HL$READY",0);
      LLR$MSFET[0] = 0;
      LLR$DSKFET[0] = 0;
      RLSBUF(LLRADR);                # RELEASE BUFFER #
      RETURN;
      END  # CPY$SD #
 
    TERM
PROC INIT$HW((LLRADR));
# TITLE INIT$HW - INITIALIZE M860 HARDWARE.                           #
 
      BEGIN  # INIT$HW #
 
#
**    INIT$HW - INITIALIZE M860 HARDWARE.
*
*     *INIT$HW* PASSES M860 HARDWARE INITIALIZATION
*     REQUESTS TO THE MSAS DRIVER.  IT CLEARS THE
*     *INITIALIZE* FLAG TO INDICATE THAT FULL
*     INITIALIZATION HAS COMPLETED WHEN IT FINDS THE
*     *LLRQ* READY CHAIN AND *DRQUEUE* BOTH INACTIVE, WHILE
*     PROCESSING A REQUEST JUST RETURNED FROM THE DRIVER.
*
*     PROC INIT$HW((LLRADR))
*
*     ENTRY      (LLRADR) - *LLRQ* ENTRY ADDRESS CONTAINING
*                           CONTROLLER ORDINAL FROM WHICH HARDWARE
*                           INITIALIZATION IS TO BE BASED.
*
*     EXIT       THE *LLRQ* ENTRY PROCESS STATE FIELD HAS BEEN
*                ADVANCED TO INDICATE WHERE SUBSEQUENT PROCESSING OF
*                THIS REQUEST IS TO CONTINUE.
*
*     NOTES      THIS MODULE IS A PSEUDO-REENTRANT ROUTINE.
#
 
      ITEM BYNR       U;             # OFF SET BIT ADDRESS #
      ITEM LLRADR     U;             # *LLRQ* ENTRY ADDRESS #
      ITEM STAT       U;             # STATUS BIT #
 
#
****  PROC INIT$HW - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ABORT;                  # ABORT #
        PROC ADD$LNK;                # ADD ENTRY TO END OF CHAIN #
        PROC MESSAGE;                # ISSUE MESSAGE #
        PROC UCP$RES;                # RETURN RESPONSE TO UCP #
        END
 
#
****  PROC INIT$HW - XREF LIST END.
#
 
      DEF LISTCON #0#;               # DO NOT LIST COMDECKS #
 
*CALL,COMBFAS
*CALL,COMBCHN
*CALL,COMBCPR
*CALL,COMBLRQ
*CALL,COMBRCD
*CALL,COMBUCR
*CALL COMBUDT
*CALL,COMXCTF
*CALL,COMXLTC
*CALL,COMXMSC
 
      BASED
      ARRAY  UDTBIT  [0:0]  P(1);     # CHECK *UDT* AREA #
        BEGIN
        ITEM UDT$BIT      U(00,00,60);
        END
 
#
*     GENERAL MESSAGE BUFFER.
#
 
      ARRAY GMSB [0:0] S(5);
        BEGIN  # INIT MSGS #
        ITEM MSG$LINE   C(00,00,40);  # MESSAGE LINE #
        ITEM MSG$ZERO   U(04,00,12) = [0];  # ZERO-BYTE TERMINATOR #
        END  # INIT MSGS #
 
      SWITCH INITIALS:PROCST         # INITIALIZATION ENTRIES #
                INIT1:INITIAL,       # INITIAL ENTRY #
                INIT2:CONT1;         # FINAL ENTRY #
                                               CONTROL EJECT;
 
      P<LLRQ> = LLRADR;
      GOTO INITIALS[LLR$PRCST[0]];
 
#
*     "INITIAL" PROCESS STATE.
#
 
INIT1:
      LLR$RC[0] = RESTART$CU;        # ASSUME DRIVER RESTART REQUEST #
      IF NOT INITIALIZE              ##
      THEN                           # NO CU RESTART REQUIRED #
        BEGIN  # RESET #
        LLR$RC[0] = INIT$SM;
        END  # RESET #
 
      LLR$PRCST[0] = PROCST"CONT1";
      ADD$LNK(LLRADR,LCHN"DRQUEUE",0);
      RETURN;
 
#
*     "COMPLETE" PROCESS STATE.
#
 
INIT2:
      IF CHN$BOC[LCHN"LL$READY"] EQ 0  ##
        AND CHN$BOC[LCHN"DRQUEUE"] EQ 0  ##
        AND INITIALIZE
      THEN                           # FULL INITIALIZATION COMPLETED #
        BEGIN  # INIT DONE #
        IF UDT$HWOFF[0] EQ 0
        THEN                         # INITIALIZATION WAS SUCCESSFUL #
          BEGIN  # OK #
          INITIALIZE = FALSE;
          MSG$LINE[0] = " INITIALIZATION COMPLETE.";
          MESSAGE(GMSB,SYSUDF1);
          END  # OK #
 
        ELSE                         # NO 7990 HARDWARE ACCESS #
          BEGIN  # EXIT #
          MSG$LINE[0] = " INITIALIZATION HALTED.";
          MESSAGE(GMSB,SYSUDF1);
          MSG$LINE[0] = "$INITIALIZATION HALTED.";
          MESSAGE(GMSB,LINE2);
          END  # EXIT #
 
        END  # INIT DONE #
 
      IF LLR$RQI[0] EQ REQNAME"RQIALTER"      # SSALTER WORKING #
        AND NOT LLR$UCPABT[0]
      THEN                           # REQUEST FROM UCP #
        BEGIN  # RETURN #
        BYNR = LLR$BYNR[0];
        P<UDTBIT> = LLR$UDTQ[0];
        STAT = B<BYNR,1> UDT$BIT[0];
        LTCENTRY = LLR$LTCT[0];
        LTC$RQR[LTCENTRY] = RESPTYP5"OK5";
        IF STAT NQ LLR$PMMR[0]       # STATUS UNCHANGED #
          OR LLR$DR[0] EQ RESPTYP4"M86$HDW$PR"  # HARDWARE PROBLEM #
        THEN
          BEGIN      # STATUS REMAINED #
          LTC$RQR[LTCENTRY] = RESPTYP5"SSA$ERROR";
          END        # STATUS REMAINED #
 
        LTC$LLRQA[LTCENTRY] = 0;
        UCP$RES;                     # RETURN RESPONSE TO UCP #
        END  # RETURN #
 
      LLR$PRCST[0] = PROCST"COMPLETE";
      RETURN;
 
      END  # INIT$HW #
 
     TERM
PROC KCG;
# TITLE KCG - KEEP COPY GOING.                                        #
 
      BEGIN  # KCG #
 
#
**    KCG - KEEP COPY GOING.
*
*     *KCG* MONITORS THE PROGRESS OF COPIES BETWEEN DISK AND A
*     CARTRIDGE VOLUME, MOVES *IN* AND *OUT* POINTERS BETWEEN THE *CIO*
*     AND *1SS* FET AND RESTARTS *CIO* OR *1SS* AS NECESSARY TO
*     KEEP THE COPY PROCESS GOING.
*
*     PROC KCG
*
*     EXIT       ALL COPY REQUESTS WHICH HAVE BEEN COMPLETED ARE
*                DELETED FROM THE KEEP COPY GOING CHAIN AND ADDED BACK
*                ON THE *LLRQ* READY CHAIN.
*
*         SENSE SWITCH 2 IS USED TO SET READ AND WRITE 1MS
*         CALLS IN THE DAYFILE.  THE NUMBER OF TIMES 1MS IS CALLED
*         IN A VOLUME CAN BE TRACED BY SETTING SENSE SWITCHS 1 AND 2.
*
*         THE STRIPES ARE READ OR WRITTEN IN 13 PRU BLOCKS.
*         THE BUFFER HAS BEEN SET FOR 4 PLUS BLOCKS.
*         THE BUFFER SIZE IS CHANGED BY *DATABL* IN COMXBST.
*
*
*         THE CODE IS SET TO CALL 1MS WHEN A BUFFER IS 1/2 FULL.
*
*         THE BUFFER SIZE CAN BE VARIED, BUT 1/3 OF A BUFFER MUST BE
*         OVER 13 PRU-S OR A LOCK WILL HAPPEN BETWEEN 1SS AND 1MS.
*         DATABL  (BUFFER SIZE) HAS BEEN INCREASED FROM 3700 TO
*         6501.
*
*         TO CHANGE FROM 1/2 TO 2/3 BUFFER FULL CALLS TO *1MS* -
*             ((DATABL-1) / 2) TO ((DATABL-1) / 3) * 2
*
#
 
 
        DEF BUFSTART #((DATABL-1) / 2)#;     # SETS HALF BUFFER START #
 
      DEF EOI$IWRD       #O"2000 0000 0000 0000 0000"#;  # *EOI* WORD #
#
****  PROC KCG - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ADD$LNK;                # ADD ENTRY TO CHAIN #
        PROC CALLPPU;                # CALL PPU #
        PROC DEL$LNK;                # DELETE ENTRY FROM CHAIN #
        PROC READCW;                 # READ WITH CONTROL WORDS #
        PROC WRITECW;                # WRITE WITH CONTROL WORDS #
        PROC K8G;                    # KEEP M860 GOING #
        PROC MESSAGE;                # ISSUE MESSAGE #
        END
 
#
****  PROC KCG - XREF LIST END.
#
 
      DEF LISTCON #0#;               # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBCDD
*CALL COMBCHN
*CALL COMBFET
*CALL COMBLRQ
*CALL     COMXBST
*CALL COMXCCB
*CALL COMXCTF
*CALL COMXJCA
*CALL COMXMSC
 
      ITEM ENTADR     U;             # *CCB* ENTRY ADDRESS #
      ITEM NEXTADDR   U;             # NEXT ENTRY ADDRESS #
      ITEM TEMP       U;             # TEMPORARY STORAGE #
      ITEM RD$READY   B;             # READ BUFFER READY #
      ITEM WRT$READY  B;             # WRITE BUFFER READY #
 
 
 
      ARRAY  WRITEMG   [0:0]  S(2);
        BEGIN
        ITEM WRITEMSG  C(00,00,12) = [" 1MS WRITE."];
        ITEM TERMA     U(01,48,12) = [0];     # TERMINATOR #
        END
 
 
      ARRAY  READMG   [0:0]  S(2) ;
        BEGIN
        ITEM READMSG   C(00,00,12) = [" 1MS READ."];
        ITEM TERMB     U(01,48,12) = [0];     # TERMINATOR #
        END
 
                                               CONTROL EJECT;
 
      ENTADR = CHN$BOC[LCHN"KC$GOING"];
      REPEAT WHILE ENTADR NQ 0
      DO
        BEGIN  # MONITOR ENTRIES ON KEEP COPY GOING CHAIN #
        P<CCB> = ENTADR;
        P<LLRQ> = CCBLLRQ[0];
        NEXTADDR = CCBLINK[0];
        P<FETSET> = CCBDKFET[0];
        P<FETFHB> = CCBM86FET[0];
       IF CCBOPCODE[0] EQ CPYC"DISKAU"
 
          THEN
            BEGIN    # COPY DISK TO M860 #
            FHB$IN[0] = FET$IN[0];
            FET$OUT[0] = FHB$OUT[0];
            END
          ELSE
            BEGIN    # COPY M860 TO DISK #
            FET$IN[0] = FHB$IN[0];
            FHB$OUT[0] = FET$OUT[0];
            END
 
        IF FET$LOCK[0]                                             ##
          AND NOT (CCBDERR[0] OR CCBDFULL[0])
        THEN                         # IF MEDIA NOT EMPTY, NO DISK
                                    ERRORS AND *CIO* NOT RUNNING #
          BEGIN
          IF FET$AT[0] NQ 0
          THEN
            BEGIN                 # SET DISK ERROR FLAG #
            IF FET$AT[0] EQ 1
            THEN
              BEGIN     # DISK FULL #
              CCBDFULL[0] = TRUE;
              END
 
            ELSE
              BEGIN      # DISK ERROR #
              CCBDERR[0] = TRUE;
              END
 
          END
 
 
          ELSE
            BEGIN            # START COPY #
            IF CCBOPCODE[0] EQ CPYC"DISKAU"
            THEN
              BEGIN              # DISK INPUT #
              IF FET$EOI[0]
              THEN
                BEGIN         # WRITE *EOI* WORD #
                RA$WORD[FET$IN[0]] = EOI$IWRD;
 
                IF FET$IN[0] EQ FET$LIM[0] - 1
                THEN
                  BEGIN
                  FET$IN[0] = FET$FRST[0];
                  END
 
                ELSE
                  BEGIN
                  FET$IN[0] = FET$IN[0] + 1;
                  END
 
                CCBDEOI[0] = TRUE;
                END              # END OF *EOI* WRITE #
 
              RD$READY = ((FET$OUT[0] GR FET$IN[0])                 ##
                AND ((FET$OUT[0] - FET$IN[0]) GR  BUFSTART))        ##
                OR ((FET$OUT[0] LQ FET$IN[0])                       ##
                AND (((FET$OUT[0]-FET$FRST[0]) + (FET$LIM[0]-FET$IN[0]))
                GR BUFSTART));
 
              IF RD$READY                       ##
                AND (CCBRWCT[0] EQ 0)           ##
                AND (NOT CCBDEOI[0])
              THEN
                BEGIN
                READCW(FETSET[0],0,NRCL);
 
                IF RA$SW2
                THEN
                  BEGIN
                  MESSAGE(READMSG,UDFL1);
                  END
 
              END
 
              END                  # END OF DISK INPUT #
 
           ELSE
              BEGIN                 # WRITE DISK #
              WRT$READY = ((FET$IN[0] GR FET$OUT[0])          ##
                 AND ((FET$IN[0] - FET$OUT[0]) GR  BUFSTART))
               OR ((FET$IN[0] LQ FET$OUT[0])                      ##
                  AND ((FET$LIM[0] - FET$OUT[0])                  ##
                    + (FET$IN[0] - FET$FRST[0]) GR  BUFSTART));
 
              IF (WRT$READY OR CCBRWDULD[0] OR (CCBRWCT[0] NQ 0))    ##
                 AND (NOT FET$IN[0] EQ FET$OUT[0])
 
 
              THEN
                BEGIN
                WRITECW(FETSET[0],NRCL);
 
                 IF RA$SW2
                 THEN
                   BEGIN
                   MESSAGE(WRITEMSG,UDFL1);
                   END
 
                END
              END                    # END OF WRITE DISK #
            END                   # END OF COPY #
 
          IF CCBDERR[0] OR CCBDFULL[0]
          THEN         # STOP *1SS* #
            BEGIN
            FHB$ST$SS[0] = TRUE;
            END
 
          END
 
        IF FHB$LOCK[0] AND NOT CCBRWDULD[0]
        THEN                         # IF *1SS* RUNNING #
          BEGIN
          K8G(ENTADR);               # M860 SIDE OF COPY #
          P<CCB> = ENTADR;
           P<FETFHB> = CCBM86FET[0];
          END
 
#
*     IF THE INPUT COULD NOT BE RESTARTED (BECAUSE THE BUFFER WAS
*     FULL OR THE INPUT MEDIA WAS EMPTY OR THERE WAS AN UNRECOVERABLE
*     READ ERROR), AND THE OUTPUT COULD NOT BE RESTARTED (BECAUSE THE
*     BUFFER WAS EMPTY OR THE OUTPUT MEDIA WAS FULL OR THERE WAS AN
*     UNRECOVERABLE WRITE ERROR), THEN THE COPY OPERATION IS COMPLETE.
#
 
 
        IF FET$LOCK[0]                                             ##
          AND ((CCBOPCODE[0] EQ CPYC"DISKAU" AND CCBRWDULD[0])     ##
          OR (CCBOPCODE[0] EQ CPYC"AUDISK" AND CCBRWDULD[0]        ##
          AND FET$IN[0] EQ FHB$IN[0] AND FET$IN[0] EQ FET$OUT[0])  ##
          OR (CCBRWDULD[0] AND (CCBDERR[0] OR CCBDFULL[0])))
        THEN                         # INDICATE COPY COMPLETE #
          BEGIN
          DEL$LNK(ENTADR,LCHN"KC$GOING",0);
          LLR$CCF[0] = TRUE;
          LLR$RS[0] = PROCST"CONT3";
          DRVRRECALL = TRUE;     # INSURE DRIVER ACTIVE #
          ADD$LNK(CCBLLRQ[0],LCHN"DRQUEUE",0);
          IF CCBHDWPM
          THEN
            BEGIN   # DELINK 1SS, NO REWIND/UNLOAD MESSAGE #
            LLR$DRFUL[0] = TRUE;     # FORCE UNLOAD OF CARTRIDGE #
            END        # RETURN OF COPY #
          END
 
        ENTADR = NEXTADDR;
        END  # MONITOR ENTRIES ON KEEP COPY GOING CHAIN #
 
      RETURN;
      END  # KCG #
 
    TERM
PROC K8G((CCBADR));
# TITLE K8G - KEEP M860 COPY GOING.                               #
 
      BEGIN  # K8G #
 
#
**    K8G - KEEP M860 COPY GOING.
*
*     *K8G* KEEPS THE M860 COPY SIDE OF A VOLUME OPERATION GOING.
*     FLAGS IN THE *CCB* ARE UPDATED TO INDICATE THE STATE OF THE COPY
*     OPERATION AND A *1SS* CALL IS ISSUED IF NECESSARY.
*
*     PROC K8G((CCBADR))
*
*     ENTRY      (CCBADR) - ADDRESS OF THE COPY CONTROL BLOCK.
#
 
      ITEM CCBADR     U;             # COPY CONTROL BLOCK ADDRESS #
 
#
****  PROC K8G - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ABORT;                  # ABORT #
        PROC FSCLOG;                 # LOG FSC ERROR MESSAGE #
        PROC MESSAGE;                # ISSUE MESSAGE #
        END
 
#
****  PROC K8G - XREF LIST END.
#
 
      DEF LISTCON #0#;               # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBCDD
*CALL COMBCHN
*CALL COMBFET
*CALL COMBRCD
*CALL COMXCCB
*CALL COMXCTF
*CALL COMXMSC
                                               CONTROL EJECT;
 
#
*     SET FLAGS TO INDICATE WHY *1SS* HAS STOPPED.
#
 
      P<CCB> = CCBADR;
      P<FETFHB> = CCBM86FET[0];
      IF CCBRWCT[0] NQ 0
      THEN        # FIRST REWIND/UNLOAD EXECUTED #
        BEGIN
        IF FHB$AT[0] EQ 0
        THEN
          BEGIN       # REWIND/UNLOAD COMPLETED #
          CCBRWDULD[0] = TRUE;
          RETURN;
          END
        ELSE
          BEGIN      # SET FOR ANOTHER TRY #
          IF CCBRWCT[0] LQ 5
          THEN
            BEGIN      # TRY AN OTHER REWIND/UNLOAD #
            GOTO RWDAUND;
            END
          ELSE
            BEGIN      # HARDWARE PROBLEM - REWIND/UNLOAD #
            CCBHDWPM[0] = TRUE;
            CCBRWDULD[0] = TRUE;       # FORCE COMPLETE #
            RETURN;
            END
        END     # END OF REWIND/UNLOAD SET UP #
      END       # IF REWIND/UNLOAD COMPLETED #
      IF FHB$EOI[0]
      THEN
        BEGIN       # SET TAPE MARK #
        CCBTPMARK[0] = TRUE;
        END
 
      IF FHB$AT[0] EQ RCENDV    # #
        OR FHB$AT[0] EQ RCTBRT
      THEN     # *TAPE MARK* OR *END OF VOLUME* #
        BEGIN
        CCBENDVOL[0] = TRUE;
        GOTO RWDAUND;
        END
 
      IF FHB$AT[0] EQ 0
      THEN
        BEGIN    # NO ERROR #
        GOTO RWDAUND;
        END
 
      IF FHB$AT[0] EQ RCTERF
      THEN
        BEGIN
        FHB$ST$SS[0] = FALSE;
        GOTO RWDAUND;
        END
 
      IF FHB$AT[0] EQ RCBFTO
      THEN
        BEGIN
        CCBHDWPM[0] = TRUE;
        GOTO BMLRWUL;
        END
 
      IF FHB$AT[0] EQ RCSTER            # #
        AND FHB$ERRCD[0] EQ 0           # #
        AND FHB$PYERR[0] EQ 1
      THEN
        BEGIN    # TAPE PARITY ERROR #
        CCBTAPPAR[0] = TRUE;
        GOTO BMLRWUL;
        END
 
 
      IF FHB$AT[0] EQ RCILLF
      OR FHB$AT[0] EQ RCBARG
      OR FHB$AT[0] EQ RCILLU
      THEN     # ABORT ON ERRORS #
        BEGIN
        FE$RTN[0] = "K8G.";
        MESSAGE(FEMSG,UDFL1);
        ABORT;
        END
 
      IF (FHB$AT[0] EQ RCDLER)
        OR (FHB$AT[0] EQ RCCWER)
        OR (FHB$AT[0] EQ RCHDER)
      THEN
        BEGIN    # PPU FOUND DATA TRANSFER ERROR #
        CCPPUDCK[0] = TRUE;
        GOTO BMLRWUL;
        END
 
      FSCLOG(DFET);             # ERROR LOG MESSAGE #
 
      CCBHDWPM[0] = TRUE;   # REMAINING ERRORS #
      CCBRWDULD[0] = TRUE;
      RETURN;
 
 
#
*     SEND A *BML* MESSAGE BEFORE REWIND/UNLOAD.
#
 
BMLRWUL:
 
      FSCLOG(DFET);                  # ERROR LOG MESSAGE #
 
#
*     RELEASE THE HARDWARE WITH A REWIND/UNLOAD FUNCTION.
#
 
RWDAUND:
 
      DRVRRECALL = TRUE;       # INSURE CPUDRIVER ACTIVE #
      FHB$CODE[0] = FCRUN;    # SET REWIND/UNLOAD #
      CCBRWCT[0] = CCBRWCT[0] + 1;
 
      RETURN;
      END  # KDG #
 
    TERM
PROC LD$CAR((LLRADR));
# TITLE LD$CAR - LOAD CARTRIDGE.                                      #
 
      BEGIN  # LD$CAR #
 
#
**    LD$CAR - LOAD CARTRIDGE.
*
*     LOAD CARTRIDGE GETS THE SPECIFIED CARTRIDGE LOADED ON A
*      DRD AND THE LABEL VERIFIED BY *SSDRIVER*.
*
*     PROC LD$CAR((LLRADR))
*
*     ENTRY      (LLRADR) - ADDRESS OF *LLRQ* ENTRY FOR THE REQUEST
*                           CONTAINING THE SMA-ID AND THE YZ
*                           COORDINATES.
*
*     EXIT       THE PROCESS STATE FIELD IN THE *LLRQ* ENTRY HAS BEEN
*                ADVANCED TO INDICATE WHERE PROCESSING OF THIS REQUEST
*                LEFT OFF, AND THUS WHAT TO DO NEXT TO ADVANCE THE
*                REQUEST.  IF THE MOUNT IS COMPLETE AN ERROR RESPONSE
*                CODE IS RETURNED VIA *HLR$RESP[0]* FOR INTERNAL
*                REQUESTOR OR *LTC$RQR[LTCENTRY]* FOR EXTERNAL
*                REQUESTORS.
*                ERROR RESPONSE CODES (VALUES DEFINED IN *COMBCPR*).
*                  = RESPTYP4"OK4".
*                  = RESPTYP4"NO$CART".
*                  = RESPTYP4"M86$HDW$PR".
*
*     NOTES      THIS MODULE IS A PSEUDO REENTRANT ROUTINE.
*
#
 
      ITEM DRDCOUNT   I;             # *DRD-S* ACTIVE #
      ITEM LLRADR     U;             # *LLRQ* ENTRY ADDRESS #
      ITEM I          U;             # COUNTER #
      ITEM MUCPRA     U;             # *UCP* OR *HLRQ* ADDRESS #
      ITEM RQIID      B;             # INTERIAL REQUEST #
      ITEM SMAO       U;             # REQUEST SM-ID #
      ITEM YZO        U;             # Y AND Z COORDINATE #
 
#
****  PROC LD$CAR - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ABORT;                  # INTERFACE TO *ABORT* MACRO #
        PROC ADD$LNK;                # ADD ENTRY TO END OF CHAIN #
        PROC DELAY;                  # TIMED DELAY #
        PROC KILL$UC;                # ABORT A UCP #
        PROC MESSAGE;                # INTERFACE TO *MESSAGE* MACRO #
        PROC SFCALL;                 # INTERFACE TO *SFCALL* MACRO #
        PROC UCP$RES;                # SEND RESPONSE TO UCP #
        END
 
#
****  PROC LD$CAR - XREF LIST END.
#
 
      DEF LISTCON #0#;               # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBCHN
*CALL COMBCPR
*CALL COMBLRQ
*CALL COMBLBL
*CALL COMBMAT
*CALL COMBRCD
*CALL COMBUCR
*CALL COMXHLR
*CALL COMXCTF
*CALL COMBUDT
*CALL COMXIPR
*CALL COMXLTC
*CALL COMXMSC
 
      DEF SKELLAB   #" E CSN=CCCCCCCC, SM=A, SF=X, FFFFFFF.  "#;
 
      ARRAY MSGS   [0:0]  S(4);
        BEGIN
        ITEM MSGS$SKEL       C(00,00,36);       # TEXT #
        ITEM MSGS$TYPE       C(00,06,01);       # TYPE #
        ITEM MSGS$CSN        C(00,42,08);       # CCCCCCCC #
        ITEM MSGS$SM         C(02,00,01);       # A #
        ITEM MSGS$SF         C(02,36,01);       # SUB FAMILY #
        ITEM MSGS$FAM        C(02,54,07);       # FAMILY #
        ITEM MSGS$FI         U(03,36,24);       # ZERO FILL #
        END
 
      BASED
      ARRAY CLEAR [0:0] S(1);
        BEGIN
        ITEM CLN      U(00,36,24);     # CLEAR DRD ASSIGNMENT #
        END
 
      SWITCH LDENTR:PROCST           # LOAD CARTRIDGE ENTRIES #
             LDINIT:INITIAL,         # INITIAL ENTRY INTO PROCESS #
             LDCONT:CONT1,           # CONTINUE PROCESS #
             LDWAIT1:CONT2;          # AFTER A SWAPIN DELAY #
 
                                               CONTROL EJECT;
 
      P<LLRQ> = LLRADR;
      GOTO LDENTR[LLR$PRCST[0]];
 
#
*     "INITIAL" PROCESS STATE.
#
 
LDINIT:                              # INITIAL ENTRY #
#
*     SEARCH THE *LLRQ* FOR AN MATCHING *CSN*.  IF AN INTERNAL
*     REQUEST, LINK THE NEW REQUEST AT THE END OF THE DUPLICATE
*     *CSN* REQUEST.  IF THE REQUEST IS FROM A *UCP* RETURN AN
*     *CSN$IN$USE* RESPONSE.
#
 
 
      SMAO = LLR$SMA[0];
      YZO = LLR$YZ[0];
      RQIID = LLR$RQI[0] EQ REQNAME"RQIINT";
      P<LLRQ> = MAT$FWA[MAT$ENTRY"LLRQ"];
      SLOWFOR I=0 STEP LLRQENTL WHILE I LS MAT$SPACE[MAT$ENTRY"LLRQ"]
      DO
        BEGIN     # CHECK IF CALL FROM *UCP* #
        IF SMAO EQ LLR$SMA[0]      ##
          AND YZO EQ LLR$YZ[0]     ##
          AND (LLR$DRDL[0] OR LLR$UNLD[0])
        THEN
          BEGIN      # CHECK FOR *UCP* OR *INTERNAL* CALL #
 
          IF LLR$UNLD[0]
          THEN     # DUPLICATE CARTRIDGE IN UNLOAD STATE #
            BEGIN
            P<LLRQ> = LLRADR;
            DELAY(UCP$INTV,LLRADR,LLRQIND);
            RETURN;
            END
 
          IF NOT RQIID
          THEN
            BEGIN     # *UCP* DUPLICATE CARTRIDGE REQUEST #
            P<LLRQ> = LLRADR;
            LTCENTRY = LLR$LTCT[0];
            LTC$RQR[LTCENTRY] = RESPTYP4"CSN$IN$USE";
            UCP$RES;
            END       # END *UCP* DUPLICATE CARTRIDGE #
          ELSE
            BEGIN   # *INTERNAL* DUPLICATE CARTRIDGE REQUEST #
            P<LLRQ> = LLRADR;
            P<HLRQ> = LLR$UCPRA[0];
            HLR$RESP[0] = RESPTYP4"CSN$IN$USE";
            P<CLEAR> = HLR$DRDRA[0];
            CLN = 0;
            HLR$DRDRA[0] = 0;
            HLR$LRQADR[0] = 0;
            ADD$LNK(LLR$UCPRA[0],LCHN"HL$READY",0);
            END
 
          LLR$PRCST[0] = PROCST"COMPLETE";
          RETURN;
        END     # END OF *DUPLICATE* CARTRIDGE FOUND #
 
      P<LLRQ> = P<LLRQ> + LLRQENTL;
      END       # END OF DUPLICATE CARTRIDGE SEARCH #
      P<LLRQ> = LLRADR;
 
      IF NOT RQIID
      THEN      # ASSIGN *DRD* TO EXTERNAL REQUEST #
        BEGIN
        SLOWFOR I=1 STEP 1 UNTIL MAXSMUNIT
        DO
          BEGIN    # UNTIL *SM* FOUND #
          IF SMAO EQ SM$ID[I]
          THEN
            BEGIN      # *SM* FOUND #
            GOTO SMFOUND;
            END
          END
 
SMFOUND:
      DRDCOUNT = 0;
      IF D0$ON[I]
      THEN
        BEGIN
        DRDCOUNT = 1;
        END
 
      IF D1$ON[I]
      THEN
        BEGIN
        DRDCOUNT = DRDCOUNT + 1;
        END
 
      IF SM$REQRES1[I] NQ 0      ##
        AND SM$REQRES2[I] NQ 0
      THEN      # NO *DRD-S* AVAILABLE #
        BEGIN
        DELAY(UCP$INTV,LLRADR,LLRQIND);
        RETURN;
        END
 
      IF DRDCOUNT EQ 1
      THEN     # ONLY ONE *DRD* ACTIVE #
        BEGIN
        IF (SM$REQRES1[I] NQ 0)      ##
          OR (SM$REQRES2[I] NQ 0)
        THEN     # NO *DRD* AVAILABLE #
            BEGIN
            DELAY(UCP$INTV,LLRADR,LLRQIND);
            RETURN;
            END
 
         END      # *DRD*  = 1 #
 
      IF SM$REQRES1[I] EQ 0
      THEN      # RESERVE A *DRD* #
        BEGIN
        SM$REQRES1[I] = LLRADR;
        SM$LLRQ1[I] = TRUE;
        LLR$DRDRA[0] = LOC(SM$REQRES1[I]);
        END
 
      ELSE
        BEGIN
        SM$REQRES2[I] = LLRADR;
        SM$LLRQ2[I] = TRUE;
        LLR$DRDRA[0] = LOC(SM$REQRES2[I]);
        END
 
        END      # EXTERNAL *DRD*ASSIGNMENT #
      LLR$RC[0] = REQCODE"SMOUNT";   # ISSUE MOUNT REQUEST TO DRIVER #
      LLR$DRDL[0] = TRUE;
      ADD$LNK(LLRADR,LCHN"DRQUEUE",0);
      LLR$PRCST[0] = PROCST"CONT1";
      RETURN;
 
#
*     "CONT1" PROCESS STATE.
*
*     RETURN RESPONSE FROM *SSDRVR* TO THE REQUESTOR.
#
 
LDCONT:                              # CONTINUE PROCESSING #
      LTCENTRY = LLR$LTCT[0];
      IF LLR$RQI[0] LQ REQNAME"RQITEST"
      THEN
        BEGIN  # REQUEST IS FROM A UCP #
        IF LLR$UCPABT[0]
        THEN
          BEGIN  # UCP HAS ABORTED #
          IF LLR$DR[0] EQ RESPTYP4"OK4"
            OR (LLR$DR[0] EQ RESPTYP4"M86$HDW$PR" AND NOT LLR$LDERR[0])
          THEN
            BEGIN  # MOUNT WAS OK SO DISMOUNT CARTRIDGE #
            GOTO UNLCART;
            END  # MOUNT WAS OK SO DISMOUNT CARTRIDGE #
 
          ELSE
            BEGIN  # CLEAR LLRQ #
            GOTO CL$EX$UDT;
            END
 
          END  # UCP HAS ABORTED #
 
        ELSE
          BEGIN  # UCP IS STILL RUNNING #
          IF LLR$DR[0] EQ RESPTYP4"OK4"
            OR LLR$DR[0] EQ RESPTYP4"CART$LB$ERR"   # #
            OR LLR$DR[0] EQ RESPTYP4"UNK$CART"
          THEN
            BEGIN        # MOUNT OK, SET UP *LTC* #
            LTC$CART[LTCENTRY] = TRUE;
            LTC$DRD[LTCENTRY] = LLR$DRD[0];
            LTC$YP[LTCENTRY] = LLR$Y[0];
            LTC$ZP[LTCENTRY] = LLR$Z[0];
 
#
*     RETURN THE LABEL TO THE UCP.  IF THE UCP IS SWAPPED OUT,
*     DELAY THE REQUEST AND TRY AGAIN LATER.
#
 
WRTLOOP:
            LTCENTRY = LLR$LTCT[0];
            LTC$SFUCPA[LTCENTRY] = LLR$ADDR2[0];
            LTC$SFSCPA[LTCENTRY] = MAT$FWA[MAT$ENTRY"LABBUF"];
            LTC$SFFP[LTCENTRY] = LABLEN;
            LTC$SFFC[LTCENTRY] = SFWRIT;
            SFCALL(LOC(LTC$WORD0[LTCENTRY]),RCL);
            IF LTC$SFRC[LTCENTRY] EQ SFRCUCPGON
            THEN
              BEGIN
              GOTO UNLCART;
              END
 
            IF LTC$SFRC[LTCENTRY] EQ SFRCBDUCPA
            THEN
              BEGIN
              KILL$UC(KILLCODE"INVADDR");
              GOTO UNLCART;
              END
 
            IF LTC$SFRC[LTCENTRY] EQ SFRCSWPOUT
            THEN
              BEGIN
              LTC$SFUCPA[LTCENTRY] = 0;
              LTC$SFSCPA[LTCENTRY] = 0;
              LTC$SFFC[LTCENTRY] = SFSWPI;
              SFCALL(LOC(LTC$WORD0[LTCENTRY]),RCL);
 
#
*      "CONT2" PROCESS STATE.
#
 
 
LDWAIT1:
 
              LTCENTRY = LLR$LTCT[0];
              IF LTC$SFFCC[LTCENTRY]
              THEN
                BEGIN
                GOTO WRTLOOP;
                END
 
              LLR$PRCST[0] = PROCST"CONT2";
              DELAY(UCP$INTV,LLRADR,LLRQIND);
              RETURN;
              END
 
            LTC$RQR[LTCENTRY] = LLR$DR[0];
            LABELBUSY = FALSE;
            UCP$RES;
            RETURN;
            END  # MOUNT WAS OK SO BUILD UTC #
 
 
#
*     ERROR - CLEAN UP *LTCT*.
#
 
          LLR$RQR[0] = LLR$DR[0];
          LTC$LLRQA[LTCENTRY] = 0;       # CLEAR *LLRQ* ENTRY #
          LTC$RQR[LTCENTRY] = LLR$DR[0];
          UCP$RES;
          END  # UCP IS STILL RUNNING #
      LABELBUSY = FALSE;
CL$EX$UDT:
      P<CLEAR> = LLR$DRDRA[0];      # CLEAR *DRD* RESERVATION #
      CLN = 0;
      LLR$PRCST[0] = PROCST"COMPLETE";
      RETURN;
 
        END  # REQUEST IS FROM A UCP #
 
 
      IF LLR$RQI[0] EQ REQNAME"RQIINT"
      THEN                           # IF REQUEST IS INTERNAL #
        BEGIN
 
#
*     ADD REQUESTING *HLRQ* ENTRY TO THE READY CHAIN.
#
 
        P<HLRQ> = LLR$UCPRA[0];
        HLR$RESP[0] = LLR$DR[0];
        HLR$ADRD[0] = LLR$DRD[0];
        IF LLR$DR[0] NQ RESPTYP4"OK4"
        THEN
          BEGIN       # RETURN THE *LLRQ* #
          MSGS$SKEL[0] = SKELLAB;
          MSGS$CSN[0] = HLR$CSND[0];
          MSGS$SM[0] = HLR$SM[0];
          MSGS$SF[0] = O"33" + HLR$SBF[0];
          MSGS$FAM[0] = HLR$FAM[0];
          MESSAGE(MSGS,SYSUDF1);
 
          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
            BEGIN      # OUTPUT DRIVER LABEL BUFFER #
            MSGS$TYPE[0] = "R";
            MSGS$CSN[0] = LAB$CSND[0];
            MSGS$SM[0] = LAB$SMID;
            MSGS$SF[0] = O"33" + LAB$SF;
            MSGS$FAM[0] = LAB$FMLY;
            MESSAGE(MSGS,SYSUDF1);
            END       # DRIVER LABEL BUFFER #
 
          IF LLR$DR[0] EQ RESPTYP4"M86$HDW$PR" AND NOT LLR$LDERR[0]
          THEN
            BEGIN    # UNLOAD OF CARTRIDGE #
            GOTO INTIALUNL;            # LET EXEC UNLOAD CARTRIDGE #
            END
 
 
#
*     DELINK LLRQ FROM HLRQ.
*     RELEASE LLRQ.
#
 
          HLR$LRQADR[0] = 0;
          LLR$PRCST[0] = PROCST"COMPLETE";
          P<CLEAR> = HLR$DRDRA[0];    # CLEAR *DRD* RESERVATION #
          CLN = 0;
          HLR$DRDRA[0] = 0;
          IF LLR$DR[0] EQ RESPTYP4"CELL$EMP"      ##
            OR LLR$DR[0] EQ RESPTYP4"SMA$OFF"      ##
            OR LLR$DR[0] EQ RESPTYP4"M86$HDW$PR"
          THEN
            BEGIN      # DO NOT RELEASE LABEL BUFFER #
          GOTO NOLABREL;
            END        # RETURNED #
          END
 
INTIALUNL:
        LABELBUSY = FALSE;
 
NOLABREL:
 
        ADD$LNK(LLR$UCPRA[0],LCHN"HL$READY",0);
        RETURN;
        END
 
#
*     UNLOAD A CARTRIDGE.
#
 
UNLCART:
      LLR$PRCNME[0] = REQTYP4"UNLD$CART";
      LLR$PRCST[0] = PROCST"INITIAL";
      LABELBUSY = FALSE;
      ADD$LNK(LLRADR,LCHN"LL$READY",0);
      RETURN;
      END  # LD$CAR #
 
    TERM
PROC LLRQENQ(ADDR);
# TITLE LLRQENQ - LOW LEVEL REQUEST QUEUE ENQUEUER.                   #
 
      BEGIN  # LLRQENQ #
 
#
**    LLRQENQ - LOW LEVEL REQUEST QUEUE ENQUEUER.
*
*     *LLRQENQ* DELETES AN ENTRY FROM THE FREE SPACE CHAIN AND
*     LINKS IT INTO THE *LLRQ* READY CHAIN.
*     *LLRQENQ* IS CALLED ONLY IF THE *LLRQ* IS NOT FULL.
*
*     PROC LLRQENQ(ADDR)
*
*     EXIT       (ADDR) - ADDRESS OF ENTRY ADDED TO QUEUE.
*
*     MESSAGES   * EXEC ABNORMAL, LLRQENQ.*
#
 
      ITEM ADDR       U;             # ADDRESS OF *LLRQ* ENTRY #
 
#
****  PROC LLRQENQ - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ABORT;                  # ABORT #
        PROC ADD$LNK;                # ADD ENTRY TO END OF CHAIN #
        PROC DEL$LNK;                # DELETE ENTRY FROM CHAIN #
        PROC MESSAGE;                # ISSUE MESSAGE #
        END
 
#
****  PROC LLRQENQ - XREF LIST END.
#
 
      DEF LISTCON #0#;               # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBCHN
*CALL,COMBKDD
*CALL COMBLRQ
*CALL COMXMSC
 
                                               CONTROL EJECT;
 
#
*     CHECK FOR NO FREE SPACE.
#
 
      ADDR = CHN$BOC[LCHN"LL$FRSPC"];
      IF ADDR EQ 0                   # IF NO FREE ENTRIES #
      THEN
        BEGIN
        FE$RTN[0] = "LLRQENQ.";
        MESSAGE(FEMSG,UDFL1);
        ABORT;
        END
 
      DEL$LNK(ADDR,LCHN"LL$FRSPC",0);  # DELETE ENTRY FROM FREE SPACE
                                         CHAIN #
      P<LLRQ> = ADDR;
      P<KWORD> = LOC(LLR$KWORDS[0]); # PRESET K-DISPLAY WORDS #
      KW$COMP[0] = TRUE;
      ADD$LNK(ADDR,LCHN"LL$READY",0);  # ADD ENTRY TO READY CHAIN #
      RETURN;
 
      END  # LLRQENQ #
 
    TERM
PROC LLRQMTR;
# TITLE LLRQMTR - LOW LEVEL REQUEST QUEUE MONITOR.                    #
 
      BEGIN  # LLRQMTR #
 
#
**    LLRQMTR - LOW LEVEL REQUEST QUEUE MONITOR.
*
*     THE LOW LEVEL REQUEST QUEUE MONITOR CONTROLS THE ACTIVATION
*     OF *LLRQ* PROCESSORS.  EACH *LLRQ* ENTRY ON THE READY CHAIN IS
*     ACTIVATED BY CALLING THE APPROPRIATE PROCESSOR.
*
*     PROC LLRQMTR
*
*     EXIT       IF THE PROCESS STATE FIELD OF AN *LLRQ* ENTRY IS SET
*                TO "COMPLETE" AFTER ITS PROCESSOR IS CALLED, THE ENTRY
*                IS CLEARED AND LINKED INTO THE FREE SPACE CHAIN.
*                OTHERWISE, THE PROCESSOR HAS SET UP SOME CONDITION
*                THAT WILL EVENTUALLY CAUSE THE *LLRQ* ENTRY TO BE
*                RELINKED INTO THE *LLRQ* READY CHAIN.
#
 
#
****  PROC LLRQMTR - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ADD$LNK;                # ADD ENTRY TO END OF CHAIN #
        PROC CPY$DS;                 # COPY DISK TO VOLUME #
        PROC CPY$RS;                 # COPY RAW VOLUME #
        PROC CPY$SD;                 # COPY VOLUME TO DISK #
        PROC DEL$LNK;                # DELETE ENTRY FROM CHAIN #
        PROC INIT$HW;                # INITIALIZE M860 HARDWARE #
        PROC LD$CAR;                 # LOAD CARTRIDGE #
        PROC SSDRVR;                 # SS DRIVER #
        PROC UNL$CAR;                # UNLOAD CARTRIDGE #
        PROC WT$LAB;                 # WRITE LABEL #
        PROC ZFILL;                  # ZERO FILL BUFFER #
        END
 
#
****  PROC LLRQMTR - XREF LIST END.
#
 
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBCHN
*CALL COMBCPR
*CALL COMBLRQ
*CALL COMXMSC
 
      ITEM LLRENT     U;             # *LLRQ* ENTRY ADDRESS #
 
      SWITCH LLPROC:REQTYP4          # *LLRQ* PROCESSOR CALLS #
                LL1:LOAD$CART,       # #
                LL2:UNLD$CART,       # #
                LL3:WRT$LAB,         # #
                LL4:CPY$AD,          # #
                LL5:CPY$DA,          # #
                LL6:CP$RAW$AU,       # #
                LL7:INITHW,          # #
 
        ENDLLP:LSTREQTYP4;           # END OF *LLRQ* PROCESSOR CALLS #
 
                                               CONTROL EJECT;
 
#
*     *LLRQMTR* IS CALLED WHEN THERE IS WORK FOR *SSDRVR* TO DO OR
*     WHEN THERE ARE ENTRIES ON THE *LLRQ* READY CHAIN TO BE PROCESSED.
*     PROCESSING OF ENTRIES ON THE *LLRQ* READY CHAIN CAN CREATE WORK
*     FOR *SSDRVR*, AND EXECUTION OF *SSDRVR* CAN PUT ENTRIES BACK
*     ON THE *LLRQ* READY CHAIN.
#
 
      IF CHN$BOC[LCHN"LL$READY"] EQ 0
      THEN                           # IF READY CHAIN IS EMPTY #
        BEGIN
        SSDRVR;
        END
 
#
*     TRAVERSE THE *LLRQ* READY CHAIN.
#
 
      REPEAT WHILE CHN$BOC[LCHN"LL$READY"] NQ 0
      DO
        BEGIN  # PROCESS READY *LLRQ* ENTRIES #
        LLRENT = CHN$BOC[LCHN"LL$READY"];
        DEL$LNK(LLRENT,LCHN"LL$READY",0);
        P<LLRQ> = LLRENT;
 
#
*     SIMULATED CASE STATEMENT FOR *LLRQ* PROCESSOR CALLS.
#
 
        GOTO LLPROC[LLR$PRCNME[0]];
 
LL1:                                 # LOAD CARTRIDGE #
        LD$CAR(LLRENT);
        GOTO ENDLLP;
 
LL2:                                 # UNLOAD CARTRIDGE #
        UNL$CAR(LLRENT);
        GOTO ENDLLP;
 
LL3:                                 # WRITE LABEL #
        WT$LAB(LLRENT);
        GOTO ENDLLP;
 
LL4:                                 # COPY VOLUME TO DISK #
        CPY$SD(LLRENT);
        GOTO ENDLLP;
 
LL5:                                 # COPY DISK TO VOLUME #
        CPY$DS(LLRENT);
        GOTO ENDLLP;
 
LL6:                                 # COPY RAW VOLUME #
        CPY$RS(LLRENT);
        GOTO ENDLLP;
 
LL7:                                 # INITIALIZE M860 HARDWARE #
        INIT$HW(LLRENT);
        GOTO ENDLLP;
 
 
 
ENDLLP:                              # CONTINUE #
 
#
*     END SIMULATED CASE STATEMENT FOR *LLRQ* PROCESSOR CALLS.
#
 
#
*     IF A PROCESSOR CREATED WORK FOR THE DRIVER, CALL *SSDRVR*.
#
 
        IF CHN$BOC[LCHN"DRQUEUE"] NQ 0
        THEN                         # IF DRIVER QUEUE NOT EMPTY #
          BEGIN
          SSDRVR;
          END
 
#
*     ADD *LLRQ* ENTRY TO THE FREE SPACE CHAIN IF PROCESS IS COMPLETE.
#
 
        P<LLRQ> = LLRENT;
        IF LLR$PRCST[0] EQ PROCST"COMPLETE"
        THEN                         # IF PROCESS IS COMPLETE #
          BEGIN
          ZFILL(LLRQ,LLRQENTL);        # CLEAR *LLRQ* ENTRY #
          ADD$LNK(LLRENT,LCHN"LL$FRSPC",0);
          END
 
        END  # PROCESS READY *LLRQ* ENTRIES #
 
      RETURN;
      END  # LLRQMTR #
 
    TERM
PROC UNL$CAR((LLRENT));
# TITLE UNL$CAR - RETURN CARTRIDGE TO MATRIX.                         #
 
      BEGIN  # UNL$CAR #
 
#
**    UNL$CAR - RETURN CARTRIDGE TO MATRIX.
*
*     *UNL$CAR* RETURNS THE CARTRIDGE FROM THE DRD TO THE
*     DESIGNATED MATRIX POSITION.  IF THE CARTRIDGE IS ASSIGNED TO THE
*     INPUT TRAY ON ENTRY, THE ASSIGNMENT WILL BE CHANGED TO THE
*     OUTPUT TRAY PRIOR TO DISMOUNTING THE CARTRIDGE.
*
*     PROC UNL$CAR((LLRENT))
*
*     ENTRY      (LLRENT) - ADDRESS OF *LLRQ* ENTRY FOR THE REQUEST
*                           CONTAINING THE SMA-ID AND THE YZ
*                           COORDINATES.
*
*     EXIT       THE PROCESS STATE FIELD IN THE *LLRQ* ENTRY HAS BEEN
*                ADVANCED TO INDICATE WHERE PROCESSING OF THIS REQUEST
*                LEFT OFF, AND THUS WHAT TO DO NEXT TO ADVANCE THE
*                REQUEST.
*
*                WHEN THE PROCESS IS COMPLETED AN ERROR RESPONSE CODE
*                IS RETURNED VIA *LTC$RQR[LTCENTRY]* FOR EXTERNAL
*                REQUESTORS OR *HLR$RESP[0]* FOR INTERNAL REQUESTORS.
*                RESPONSE CODE (VALUES ARE DEFINED IN *COMBCPR*).
*                  = RESPTYP4"OK4".
*
*                THE CARTRIDGE LOAD, PASS, AND ERROR COUNTS ARE
*                ALSO RETURNED WHEN THE REQUEST IS COMPLETED.
*
*     NOTES      THIS MODULE IS A PSEUDO REENTRANT ROUTINE.
#
 
      ITEM LLRENT     U;             # *LLRQ* ENTRY TO PROCESS #
      ITEM LLRENTI    U;             # WAITTING  *LLRQ* ADDRESS #
      ITEM SCR1        U;            # SCRATCH WORD #
      ITEM SCR2       U;             # SCRATCH WORD #
      ITEM SCR3       U;             # SCRATCH WORD #
 
#
****  PROC UNL$CAR - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ADD$LNK;                # ADD ENTRY TO END OF CHAIN #
        PROC UCP$RES;                # NOTIFY UCP OF REQUEST COMPLETE #
        END
 
#
****  PROC UNL$CAR - XREF LIST END.
#
 
      DEF LISTCON #0#;               # DO NOT LIST COMMON DECKS #
 
*CALL COMBFAS
*CALL COMBCHN
*CALL COMBCPR
*CALL COMBLRQ
*CALL COMBRCD
*CALL COMBUCR
*CALL COMXHLR
*CALL COMXLTC
*CALL COMXMSC
 
 
      BASED
      ARRAY  CLEAR   [0:0]  S(1);
        BEGIN
        ITEM CLN     U(00,36,24);     # CLEAR *DRD* ASSIGNMENT #
        END
 
 
      SWITCH UNLENTR:PROCST          # UNLOAD CARTRIDGE ENTRIES #
             UNLINIT:INITIAL,        # INITIAL ENTRY POINT #
               UNLC1:CONT1;          # CONTINUE AFTER DISMOUNT REQUEST
                                     #
                                               CONTROL EJECT;
      P<LLRQ> = LLRENT;
      GOTO UNLENTR[LLR$PRCST[0]];
 
#
*     "INITIAL" PROCESS STATE.
*
*     ASSIGN THE CARTRIDGE TO THE EXIT TRAY IF THE ORIGINAL
*     ASSIGNMENT WAS TH ENTRY TRAY.
#
 
UNLINIT:
 
      IF LLR$Y[0] EQ SM$ENT$TY         ##
        AND LLR$Z[0] EQ SM$TY$Z
      THEN
        BEGIN
        LLR$Y[0] = SM$EXIT$TY;
        LLR$Z[0] = SM$TY$Z;
        END
 
 
#
*     DISMOUNT THE CARTRIDGE.
#
 
      LLR$RC[0] = REQCODE"SDISMOUNT";
      LLR$PRCST[0] = PROCST"CONT1";
      LLR$DRDL[0] = FALSE;
      LLR$UNLD[0] = TRUE;     # UNLOAD STARTED #
      LLR$RS[0] = PROCST"INITIAL";
      ADD$LNK(LLRENT,LCHN"DRQUEUE",0);
      RETURN;
 
#
*     "CONT1" PROCESS STATE.
*
*     UPDATE THE APPROPRIATE DATA FIELDS OF THE REQUEST AND PASS
*     THE REQUEST ON TO THE NEXT PROCESS.
#
 
UNLC1:
 
      IF LLR$RQI[0] EQ REQNAME"RQIINT"
      THEN
        BEGIN        # INTERNAL REQUEST #
        P<HLRQ> = LLR$UCPRA[0];
        HLR$LRQADR[0] = 0;     # DELINK *LLRA* FROM *HLRA* #
        HLR$RESP[0] = RESPTYP4"OK4";
        ADD$LNK(LLR$UCPRA[0],LCHN"HL$READY",0);
        END       # INTERNAL REQUEST #
 
      ELSE
        BEGIN  # EXTERNAL REQUEST #
        P<CLEAR> = LLR$DRDRA[0];   # CLEAR *DRD* RESERVE #
        CLN = 0;
        IF NOT LLR$UCPABT[0]
        THEN                         # RETURN RESPONSE TO UCP #
          BEGIN
          LTCENTRY = LLR$LTCT[0];
          LTC$LLRQA[LTCENTRY] = 0;
          LTC$CART[LTCENTRY] = FALSE;
          LTC$RQR[LTCENTRY] = RESPTYP4"OK4";
          UCP$RES;
          END
 
        END  # EXTERNAL REQUEST #
 
 
#
*     MARK THE REQUEST COMPLETE AND RETURN TO *LLRQ* MONITOR.
#
 
      LLR$UNLD[0] = FALSE;     # UNLOAD COMPLETE #
      LLR$PRCST[0] = PROCST"COMPLETE";
      RETURN;
 
      END  # UNL$CAR #
 
    TERM
PROC SETFET(LLRADR);
# TITLE SETFET - SETS LARGE BUFFER POINTERS #
 
      BEGIN     # SETFET #
 
#
**    SETFET - SETS LARGE BUFFER POINTERS.
*
*     *SETFET* SETS FET POINTERS FOR CIO AND *1SS*.
*
*     PROC SETFET
*
*     ENTRY      (LLRADR) - ADDRESS OF THE *LLRQ* ENTRY THAT
*                           CONTAINS THE ADDRESS OF THE DISK
*                           AND *M860* FET AND BUFFER ADDRESSES.
*                           (LARGE BUFFER MUST ALREADY EXIST.)
*
*     EXIT       FETS ARE COMPLETE FOR BOTH CIO AND *1SS*
*                PROCESSING.  STRIPE HIGH AND LOW SET INTO THE
*                *LLRQ*.
*
*     NOTES      THIS MODULE IS CALLED ONLY BY THE COP$XX ROUTINES.
#
 
      ITEM LLRADR;                       # *LLRQ* ADDRESS #
 
#
****  PROC SETFET - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ZFILL;                  # ZERO FILL BUFFER #
        PROC ZSETFET;                # INITIALIZE A FET #
        END
 
#
****  PROC SETFET - XFET LIST END.
#
 
      DEF LISTCON #0#;       # DO NOT LIST COMDECKS #
 
*CALL COMBFAS
*CALL COMBCPR
*CALL COMBFET
*CALL COMBLRQ
*CALL COMXBST
*CALL COMXCCB
*CALL COMXHLR
 
#
*     SET *LLRQ* STIPE LOW AND HIGH POINTERS.
#
 
      P<LLRQ> = LLRADR;
      P<HLRQ> = LLR$UCPRA[0];
      P<CCB> = LLR$CCB[0];
      IF LLR$PRCNME[0] NQ REQTYP4"CP$RAW$AU"
      THEN
        BEGIN
        LLR$ST$LW[0] = INSPAU*HLR$VOLAU[0]+(INFTST-INSPAU);
        LLR$ST$HI[0] = INSPAU*HLR$VOLLN[0]+LLR$ST$LW[0]-1;
        END
 
#
*     INITIALIZE CIO AND *1SS* FETS.
#
 
      CCBDKFET[0] = LLR$DSKFET[0];
      CCBM86FET[0] = LLR$MSFET[0];
      CCBLLRQ[0] = LLRADR;
      CCBCLFG[0] = 0;
      CCBRWCT[0] = 0;          # CLEAR COUNTER #
      ZSETFET(LLR$DSKFET[0],HLR$FLNM[0],LLR$DA[0],DATABL,(RFETL+RFHBL));
      P<FETFHB> = LLR$MSFET[0];
      P<FETSET> = LLR$DSKFET[0];
      FET$EP[0] = TRUE;
      FET$R[0] = TRUE;
      FET$UP[0] = TRUE;
      FHB$FRST[0] = FET$FRST[0];
      FHB$IN[0] = FET$IN[0];
      FHB$OUT[0] = FET$OUT[0];
      FHB$LIM[0] = FET$LIM[0];
 
      END
 
       TERM
PROC WT$LAB((LLRENT));
# TITLE WT$LAB - WRITE CARTRIDGE LABEL.                      #
 
      BEGIN  # WT$LAB #
 
#
**    WT$LAB - WRITE CARTRIDGE LABEL.
*
*     *WT$LAB* WRITES THE CARTRIDGE LABEL.
*
*     PROC WT$LAB((LLRENT))
*
*     ENTRY      (LLRENT) - ADDRESS OF *LLRQ* ENTRY FOR THE REQUEST
*                           CONTAINING THE SMA-ID, THE VOLUME NUMBER,
*                           AND THE YZ COORDINATES.
*
*     EXIT       THE PROCESS STATE FIELD IN THE *LLRQ* ENTRY HAS BEEN
*                ADVANCED TO INDICATE WHERE PROCESSING OF THIS REQUEST
*                LEFT OFF, AND THUS WHAT TO DO NEXT TO ADVANCE THE
*                REQUEST.
*
*                WHEN THE PROCESS IS COMPLETED AN ERROR RESPONSE CODE
*                IS RETURNED VIA LTC$RQR[LTCENTRY] FOR EXTERNAL
*                REQUESTORS OR HLR$RESP[0] FOR INTERNAL REQUESTORS.
*                IS RETURNED VIA *LTC$RQR[LTCENTRY]* FOR EXTERNAL
*                REQUESTORS OR *HLR$RESP[0]* FOR INTERNAL REQUESTORS.
*                RESPONSE CODE (VALUES ARE DEFINED IN *COMBCPR*).
*                  = RESPTYP4"OK4".
*                  = RESPTYP4"UN$WRT$ERR".
*                  = RESPTYP4"EX$WRT$ERR".
*                  = RESPTYP4"MSFHDW$ERR".
*
*     MESSAGES   * EXEC ABNORMAL, WT$LAB.*
*
*     NOTES      THIS MODULE IS A PSEUDO REENTRANT ROUTINE.
*
*                COMMON BUFFER *LABBUF* WILL BE USED TO TRANSFER
*                THE LABEL FROM THE *UCP* TO THE *SSDRIVER*.
#
 
      ITEM LLRENT     U;             # ADDRESS OF *LLRQ* ENTRY #
 
#
****  PROC WT$LAB - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ABORT;                  # INTERFACE TO *ABORT* MACRO #
        PROC ADD$LNK;                # ADD ENTRY TO END OF CHAIN #
        PROC DELAY;                  # TIMED DELAY #
        PROC KILL$UC;                # ABORT A UCP #
        PROC MESSAGE;                # CALLS *MESSAGE* MACRO #
        PROC SFCALL;                 # INTERFACE TO *SFCALL* MACRO #
        PROC UCP$RES;                # NOTIFY UCP OF REQUEST COMPLETE #
        END
 
#
****  PROC WT$LAB - XREF LIST END.
#
 
      DEF LISTCON   #0#;             # DO NOT LIST COMMON DECKS #
 
*CALL COMBFAS
*CALL COMBCHN
*CALL COMBCPR
*CALL COMBFET
*CALL COMBLBL
*CALL COMBLRQ
*CALL COMBMAT
*CALL COMBRCD
*CALL COMBUCR
*CALL COMXCTF
*CALL COMXHLR
*CALL COMXIPR
*CALL COMXLTC
*CALL COMXMSC
 
 
      ITEM REQTYP     B=FALSE;       # *LLRQ* ID FOR *GET$SB* #
 
      BASED
      ARRAY   CLEAR    [0:0]   S(1);
        BEGIN
        ITEM CLN      U(00,36,24);        # CLEAR *DRD* ASSIGNMENT #
        END
 
      SWITCH  WTENTR:PROCST          # WRITE LABEL ENTRIES #
              WTINIT:INITIAL,        # INITIAL ENTRY POINT #
                WTC1:CONT1,          # AFTER A SWAPIN DELAY #
                WTC2:CONT2;          # AFTER WRITE LABEL #
                                               CONTROL EJECT;
      P<LLRQ> = LLRENT;
      LLR$DR[0] = 0;
      LTCENTRY = LLR$LTCT[0];
      GOTO WTENTR[LLR$PRCST[0]];
 
#
*     "INITIAL" PROCESS STATE.
#
 
WTINIT:
 
#
*     CHECK LABEL BUFFER FOR BUSY.  IF BUSY, RETURN *LLRQ*
*     TO THE DELAY CHAIN.
#
 
 
      IF LABELBUSY
      THEN
        BEGIN       # EXIT TO DELAY CHAIN #
        DELAY(UCP$INTV,LLRENT,LLRQIND);
        RETURN;
        END         # RETURNED TO DELAY CHAIN #
 
      LABELBUSY = TRUE;      # RESERVE LABEL BUFFER #
#
*     READ THE LABEL FROM THE UCP.  IF THE UCP IS SWAPPED OUT, DELAY
*     THE REQUEST AND TRY AGAIN LATER.
#
 
SFLOOP:
      LTC$SFUCPA[LTCENTRY] = LLR$ADDR2[0];
      LTC$SFSCPA[LTCENTRY] = MAT$FWA[MAT$ENTRY"LABBUF"];
      LTC$SFFP[LTCENTRY] = LABLEN;
      LTC$SFFC[LTCENTRY] = SFREAD;
      SFCALL(LOC(LTC$WORD0[LTCENTRY]),RCL);
      IF LTC$SFRC[LTCENTRY] EQ SFRCUCPGON
      THEN
        BEGIN
        GOTO COMPLUCP;
        END
 
      IF LTC$SFRC[LTCENTRY] EQ SFRCBDUCPA
      THEN
        BEGIN
        KILL$UC(KILLCODE"INVADDR");
        GOTO COMPLUCP;
        END
 
      IF LTC$SFRC[LTCENTRY] EQ SFRCSWPOUT
      THEN
        BEGIN
        LTC$SFUCPA[LTCENTRY] = 0;
        LTC$SFSCPA[LTCENTRY] = 0;
        LTC$SFFC[LTCENTRY] = SFSWPI;
        SFCALL(LOC(LTC$WORD0[LTCENTRY]),RCL);
 
#
*     "CONT1" PROCESS STATE.
#
 
WTC1:
        LTCENTRY = LLR$LTCT[0];
        IF LTC$SFFCC[LTCENTRY]
        THEN
          BEGIN
          GOTO SFLOOP;
          END
 
        LLR$PRCST[0] = PROCST"CONT1";
        DELAY(UCP$INTV,LLRENT,LLRQIND);
        RETURN;
        END
 
      IF LTC$SFRC[LTCENTRY] NQ 0
      THEN
        BEGIN
        FE$RTN[0] = "WT$LAB.";
        MESSAGE(FEMSG[0],UDFL1);
        ABORT;
        END
 
 
        LLR$PRCST[0] = PROCST"CONT2";
        LLR$RC[0] = REQCODE"SWRT$LABEL";
        LLR$RS[0] = PROCST"INITIAL";
        ADD$LNK(LLRENT,LCHN"DRQUEUE",0);
        RETURN;
 
#
*     RETURN THE RESPONSE CODE TO THE *UCP*.
#
 
COMPLUCP:
        LABELBUSY = FALSE;
        LLR$DR[0] = 0;
        LLR$UCPABT[0] = FALSE;
        LLR$Y[0] = SM$EXIT$TY;
        LLR$Z[0] = SM$TY$Z;
        LLR$PRCNME[0] = REQTYP4"UNLD$CART";
        LLR$PRCST[0] = PROCST"INITIAL";
        ADD$LNK(LLRENT,LCHN"LL$READY",0);
        RETURN;
 
#
*     "CONT2" PROCESS STATE.
#
 
WTC2:
 
#
*     MARK THE REQUEST COMPLETE AND RETURN TO *LLRQ* MONITOR.
#
 
      IF NOT LLR$UCPABT[0]
      THEN
        BEGIN        # SEND REQUEST BACK TO UCP #
        LTC$CART[LTCENTRY] = FALSE;
        LTC$LLRQA[LTCENTRY] = 0;
        LTC$RQR[LTCENTRY] = LLR$DR[0];
        UCP$RES;
        END         # COMPLETED RETURN REQUEST #
 
      P<CLEAR> = LLR$DRDRA[0];        # CLEAR *DRD* RESERVE #
      CLN = 0;
      LLR$PRCST[0] = PROCST"COMPLETE";
      RETURN;
      END  # WT$LAB #
 
    TERM