Retro1.org codex

SXSERV

[00001] PROC ACQ$FCT¹⁾ [00144] ADD$LNK - ADD ENTRY TO END OF CHAIN. [00149] ADD$LNK - ADD ENTRY TO END OF CHAIN. [00198] PROC ANLZAST²⁾ [00463] DELAY - TIMED DELAY. [00468] DELAY - TIMED DELAY. [00494] PROC ADD$LNK [00495] PROC RTIME [00536] PROC DEL$LNK³⁾ [00538] DEL$LNK - DELETE ENTRY FROM CHAIN. [00543] DEL$LNK - DELETE ENTRY FROM CHAIN. [00576] PROC ABORT [00577] PROC MESSAGE [00648] PROC GETBUF⁴⁾ [00848] HLCPYCD - *HLRQ**LLRQ* LINK ROUTINE TO COPY CARTRIDGE TO DISK. [00877] PROC ADD$LNK [00997] PROC HLCPYDC⁵⁾ [00999] HLCPYDC - CONTROL ROUTINE FOR COPYING DISK TO CARTRIDGE. [01004] HLCPYDC - *HLRQ**LLRQ* INTERFACE ROUTINE TO LOAD CARTRIDGE. [01213] HLLOAD - *HLRQ**LLRQ* WAITING FOR LARGE BUFFER* CHAIN AND THEN DROP OUT UNTIL ONE BECOMES AVAILABLE. * WHEN A BUFFER BECOMES AVAILABLE, *GOBUF* WILL PUT THE * *HLRQ**LLRQ* READY CHAIN. THE LOCATION OF THE * LARGE BUFFER SPACE IS RETURNED IN THE REQUEST QUEUE * ENTRY. # # PROC GOBUF - XREF LIST BEGIN. #

    XREF
      BEGIN
      PROC ADD$LNK;                # ADD ENTRY TO CHAIN #
      PROC DEL$LNK;                # DELETE ENTRY FROM CHAIN #
      PROC REQBS;                  # REQUEST BUFFER SPACE #
      PROC SETBSTE;                # SET *BST* ENTRY #
      END

# PROC GOBUF - XREF LIST END. #

    DEF LISTCON #0#;               # DO NOT LIST COMMON DECKS #

*CALL,COMBFAS *CALL,COMBCHN *CALL,COMXBST *CALL,COMXMSC

    ITEM ACQFLAG    B;             # BUFFER ACQUIRED FLAG #
    ITEM ENTADR     U;             # ENTRY ADDRESS #
    ITEM I          I;             # LOOP COUNTER #
                                             CONTROL EJECT;

    SLOWFOR I = 1 STEP 1 WHILE I LQ BSTL AND BST$AUTH[I]  ##
      AND (CHN$BOC[LCHN"LL$LGBUF"] NQ 0)
    DO
      BEGIN  # ASSIGN AVAILABLE BUFFERS #
      IF BST$BUSY[I]
      THEN
        BEGIN
        TEST I;
        END

      IF NOT BST$ACQD[I]
      THEN
        BEGIN  # ACQUIRE BUFFER #
        REQBS(I,ACQFLAG);
        IF NOT ACQFLAG
        THEN
          BEGIN
          RETURN;                  # NO BUFFER AVAILABLE #
          END

        END  # ACQUIRE BUFFER #

      IF CHN$BOC[LCHN"LL$LGBUF"] NQ 0
      THEN                         # IF *LLRQ* ENTRY WAITING #
        BEGIN
        ENTADR = CHN$BOC[LCHN"LL$LGBUF"];
        SETBSTE(ENTADR,LLRQIND,I);
        DEL$LNK(ENTADR,LCHN"LL$LGBUF",0);
        ADD$LNK(ENTADR,LCHN"LL$READY",0);
        END

      END  # ASSIGN AVAILABLE BUFFERS #

    RETURN;
    END  # GOBUF #

  TERM

PROC HLCPYCD((HLRQADR)); # TITLE HLCPYCD - *HLRQ**LLRQ* LINK ROUTINE TO COPY CARTRIDGE TO DISK. * * *HLCPYCD* CALLS *CPY$SD* TO COPY DATA FROM A CARTRIDGE BUFFER * TO THE DISK SPECIFIED IN THE *HLRQ* ENTRY. * *HLCPYCD* CHECKS THE STATUS AFTER THE REQUEST IS PROCESSED * AND DOES THE APPROPRIATE ERROR PROCESSING IF AN ERROR * IS ENCOUNTERED IN WRITING THE DATA. * * PROC HLCPYCD((HLRQADR))* * ENTRY (HLRQADR) - ADDRESS OF THE *HLRQ* ENTRY. * * EXIT VOLUME COPIED TO M860 CARTRIDGE. * #

    ITEM HLRQADR    U;             # *HLRQ* ENTRY ADDRESS #

# PROC HLCPYCD - XREF LIST BEGIN. #

    XREF
      BEGIN
      PROC ADD$LNK;                # ADD ENTRY TO END OF CHAIN #
      END

# PROC HLCPYCD - XREF LIST END. #

    DEF LISTCON #0#;               # DO NOT LIST COMMON DECKS #

*CALL,COMBFAS *CALL,COMBCHN *CALL,COMBCPR *CALL,COMBLRQ *CALL,COMBMCT *CALL,COMSPFM *CALL,COMXEMC *CALL,COMXFCQ *CALL,COMXHLR *CALL,COMXMSC

    ITEM FLAG       B;             # STATUS FLAG #
    ITEM STAT       U;             # DRIVER ERROR STATUS #
    ITEM TEMP       U;             # SCRATCH CELL #

                                             CONTROL EJECT;
    P<HLRQ> = HLRQADR;
    P<LLRQ> = HLR$LRQADR[0];

    STAT = HLR$RESP[0];
    IF STAT EQ RESPTYP4"OK4"
    THEN
      BEGIN  # INDICATE NO ERROR #
      HLR$RESP[0] = ERRST"NOERR";
      END  # INDICATE NO ERROR #

    ELSE
      BEGIN  # PROCESS ERROR #
      HLR$RESP[0] = ERRST"TEMP";   # RESPONSE, UNLESS MODIFIED #
      HLR$ERRC[0] = STGERRC"HWPROB";

      IF STAT EQ RESPTYP4"DISK$FULL"
      THEN
        BEGIN
        HLR$RESP[0] = ERRST"ABANDON";
        HLR$ERRC[0] = STGERRC"DSKFULL";
        END

      IF STAT EQ RESPTYP4"RMS$FL$ERR"
      THEN
        BEGIN
        HLR$RESP[0] = ERRST"ABANDON";
        HLR$ERRC[0] = STGERRC"DSKERR";
        END

      IF STAT EQ RESPTYP4"UN$RD$ERR"
      THEN
        BEGIN
        IF HLR$RETRY[0]
        THEN                       # FATAL ERROR #
          BEGIN
          HLR$RESP[0] = ERRST"PERM";
          HLR$PEF[0] = AFPDE;
          HLR$ERRC[0] = STGERRC"DATAERR";
          END

        ELSE                       # RETRY ONE TIME #
          BEGIN
          HLR$RESP[0] = ERRST"RETRY";
          HLR$RETRY[0] = TRUE;
          END

END

      IF STAT EQ RESPTYP4"PPU$D$PROB"
      THEN
        BEGIN
        IF HLR$RETRY[0]
        THEN
          BEGIN       # FATAL PASS #
          HLR$RESP[0] = ERRST"PERM";
          HLR$PEF[0] = AFTMP;    # TEMPORARY PFM ERROR #
          HLR$ERRC[0] = STGERRC"PPUDPRB";
          END

        ELSE
          BEGIN       # RETRY ONE TIME #
          HLR$RESP[0] = ERRST"RETRY";
          HLR$RETRY[0] = TRUE;
          END

END

      IF STAT EQ RESPTYP4"VOL$HD$ERR"
      THEN
        BEGIN
        P<FCT> = HLR$FCTQ[0] + FCTQHL;
        SETFCTX(HLR$VOLAU[0]);
        FCT$AUCF(FWD,FPS) = 1;     # SET CONFLICT FLAG #
        HLR$RESP[0] = ERRST"PERM";
        HLR$PEF[0] = AFPSE;
        HLR$ERRC[0] = STGERRC"CHKERR";
        END

      IF STAT EQ RESPTYP4"M86$HDW$PR"
      THEN
        BEGIN
        HLR$RESP[0] = ERRST"RETRY";
        HLR$RETRY[0] = FALSE;
        END

      END  # PROCESS ERROR #

# * RETURN TO CALLING PROGRAM. #

    RETURN;

    END  # HLCPYCD #

  TERM

PROC HLCPYDC((HLRQADR));

# TITLE HLCPYDC - CONTROL ROUTINE FOR COPYING DISK TO CARTRIDGE. #

    BEGIN  # HLCPYDC #

# HLCPYDC - *HLRQ*/*LLRQ* LINK ROUTINE TO COPY DISK TO CARTRIDGE. * * *HLCPYDC* CALLS *CPY$DS* TO COPY DATA FROM A DISK BUFFER * TO THE CARTRIDGE SPECIFIED IN THE *HLRQ* ENTRY. * *HLCPYDC* CHECKS THE STATUS AFTER THE REQUEST IS PROCESSED * AND DOES THE APPROPRIATE ERROR PROCESSING IF AN ERROR * IS ENCOUNTERED IN WRITING THE DATA. * * PROC HLCPYDC⁶⁾ * * ENTRY (HLRQADR) - ADDRESS OF THE *HLRQ* ENTRY. * * EXIT VOLUME COPIED TO M860 CARTRIDGE. * # ITEM HLRQADR U; # *HLRQ* ENTRY ADDRESS # # PROC HLCPYDC - XREF LIST BEGIN. # XREF BEGIN PROC ADD$LNK; # ADD ENTRY TO END OF CHAIN # PROC RLSVOL; # RELEASE UNUSED AU # END # PROC HLCPYDC - XREF LIST END. # DEF LISTCON #0#; # DO NOT LIST COMMON DECKS # *CALL,COMBFAS *CALL,COMBCHN *CALL,COMBCPR *CALL,COMBLRQ *CALL,COMBMCT *CALL,COMBTDM *CALL,COMXFCQ *CALL,COMXHLR *CALL,COMXMSC ITEM FLAG B; # STATUS FLAG # ITEM RELFIRST U; # FIRST AU TO RELEASE # ITEM RELNUM U; # NUMBER OF AU TO RELEASE # ITEM STAT U; # STATUS FROM *HLR$RESP* # ITEM TEMP U; # SCRATCH CELL # CONTROL EJECT; P<HLRQ> = HLRQADR; P<LLRQ> = HLR$LRQADR[0]; # * SET DEFAULT *HLR$RESP* VALUE AND RELEASE PARAMETERS * IN CASE THEY ARE NOT SPECIFICALLY MODIFIED. # STAT = HLR$RESP[0]; IF STAT EQ RESPTYP4“OK4” THEN BEGIN # INDICATE NO ERROR # HLR$RESP[0] = ERRST“NOERR”; END # INDICATE NO ERROR # ELSE BEGIN # PROCESS ERROR # RELFIRST = HLR$VOLAU[0]; RELNUM = HLR$VOLLN[0]; HLR$RESP[0] = ERRST“RETRY”; IF STAT EQ RESPTYP4“RMS$FL$ERR” THEN BEGIN HLR$RESP[0] = ERRST“ABANDON”; HLR$ERRC[0] = ABANDON“DSKRDERR”; END P<FCT> = HLR$FCTQ[0] + FCTQHL; IF STAT EQ RESPTYP4“UN$WRT$ERR” THEN BEGIN # UNRECOVERED WRITE ERROR PROCESSING # RELNUM = HLR$AUUD[0] - HLR$VOLAU[0]; RLSVOL(HLRQADR,HLR$FCTQ[0],HLR$AUUD[0]+1, ## HLR$VOLLN[0] - RELNUM - 1); # RELEASE AU AFTER FLAW # SETFCTX(HLR$AUUD[0]); FCT$FAUF(FWD,FPS) = 1; FCT$FLAWS[0] = FCT$FLAWS[0] + 1; END # UNRECOVERED WRITE ERROR PROCESSING # IF STAT EQ RESPTYP4“EX$DMARK” THEN BEGIN # EXCESSIVE DEMARKS # SLOWFOR TEMP = HLR$VOLAU[0] STEP 1 UNTIL HLR$AUUD[0] DO BEGIN # FLAW ALL AU THAT WERE USED # SETFCTX(TEMP); FCT$FAUF(FWD,FPS) = 1; FCT$FLAWS[0] = FCT$FLAWS[0] + 1; END # FLAW ALL AU THAT WERE USED # RELNUM = HLR$VOLLN[0] - ( HLR$AUUD[0] - HLR$VOLAU[0]) - 1; RELFIRST = HLR$AUUD[0]+1; # RELEASE REST OF AU # END # EXCESSIVE DEMARKS # IF STAT EQ RESPTYP4“M86$HDW$PR” THEN # FORCE CARTRIDGE UNLOAD # BEGIN HLR$ERRC[0] = ERRST“SPECIAL”; END # * IF ERRORS, RELEASE ANY REMAINING UNFLAWED AU. THEN RETURN * TO CALLING PROGRAM. # HLR$VOLLN[0] = 0; RLSVOL(HLRQADR,HLR$FCTQ[0], RELFIRST, RELNUM); # RELEASE AU # END # PROCESS ERROR # RETURN; END # HLCPYDC # TERM PROC HLLDSET⁷⁾; # TITLE HLLDSET - TRANSFER *HLRQ* DATA TO *LLRQ*. # BEGIN # HLLDSET # # HLLDSET - TRANSFER *HLRQ* DATA TO *LLRQ*. * * *HLLDSET* MOVES RELEVANT *HLRQ* INFORMATION TO THE *LLRQ* ENTRY * SO THE DRIVER HAS SUFFICIENT INFORMATION TO PROCESS THE * FORTHCOMING LOAD CARTRIDGE REQUEST. * * PROC HLLDSET⁸⁾ * * ENTRY (HLRQADR) - ADDRESS OF THE *HLRQ* ENTRY. * * EXIT NONE #

    ITEM HLRQADR    U;             # *HLRQ* ENTRY ADDRESS #

# PROC HLLDSET - XREF LIST BEGIN. #

    XREF
      BEGIN
      PROC LLRQENQ;                # *LLRQ* ENQUEUER #
      END

# HLLDSET - XREF LIST END. #

    DEF LISTCON #0#;               # DO NOT LIST COMMON DECKS #

*CALL,COMBFAS *CALL,COMBCPR *CALL,COMBLRQ *CALL,COMBMCT *CALL,COMBUCR *CALL,COMXEMC *CALL,COMXFCQ *CALL,COMXHLR *CALL,COMXMSC

    ITEM LLRQADR    U;             # *LLRQ* ENTRY ADDRESS #

    P<HLRQ> = HLRQADR;
    LLRQENQ(LLRQADR);              # GET *LLRQ* ENTRY #
    P<LLRQ> = LLRQADR;
    HLR$LRQADR[0] = LLRQADR;
    LLR$UCPRA[0] = HLRQADR;
    LLR$CSNT[0] = HLR$CSNTCU[0];
    LLR$Y[0] = HLR$Y[0];
    LLR$Z[0] = HLR$Z[0];
    LLR$SMA[0] = HLR$SM[0];
    LLR$RQI[0] = REQNAME"RQIINT";
    LLR$PRCNME[0] = REQTYP4"LOAD$CART";
    LLR$PRCST[0] = PROCST"INITIAL";
    P<FCT> = HLR$FCTQ[0] + FCTQHL;

    END  # HLLDSET #

  TERM

PROC HLLOAD⁹⁾;

# TITLE HLLOAD - *HLRQ**LLRQ* LINKING ROUTINE FOR LOADING CARTRIDGES. * * *HLLOAD* CALLS *HLLDSET* TO TRANSFER RELEVANT INFORMATION * FROM THE *HLRQ* ENTRY TO THE *LLRQ* ENTRY FOR LOADING FILES. * *HLLOAD* CHECKS THE STATUS AFTER THE LOAD REQUEST IS PROCESSED * AND DOES THE APPROPRIATE ERROR PROCESSING IF AN ERROR * IS ENCOUNTERED IN LOADING A CARTRIDGE. * * PROC HLLOAD¹⁰⁾ * * ENTRY (HLRQADR) - ADDRESS OF THE *HLRQ* ENTRY. * * EXIT *HLRQ* ENTRY ESTABLISHED. * #

    ITEM FLAG       B;             # STATUS FLAG #
    ITEM HLRQADR    U;             # *HLRQ* ENTRY ADDRESS #

# PROC HLLOAD - XREF LIST BEGIN. #

    XREF
      BEGIN
      PROC ADD$LNK;                # ADD ENTRY TO END OF CHAIN #
      PROC MSGAFDF;                # ISSUE ACCOUNT-DAYFILE MESSAGE #
      PROC HLLDSET;                # TRANSFER DATA TO *LLRQ* #
      END

# PROC HLLOAD - XREF LIST END. #

    DEF LISTCON #0#;               # DO NOT LIST COMMON DECKS #

*CALL,COMBFAS *CALL,COMBCHN *CALL,COMBCPR *CALL,COMBLRQ *CALL,COMBMCT *CALL,COMBTDM *CALL,COMSPFM *CALL,COMXEMC *CALL,COMXFCQ *CALL,COMXHLR *CALL,COMXMSC

    ITEM STAGE      B;             # TRUE IF CALLED FROM *STAGER* #
    ITEM STAT       U;             # STATUS (FROM *HLR$RESP*) #

                                             CONTROL EJECT;
    P<HLRQ> = HLRQADR;
    P<LLRQ> = HLR$LRQADR[0];
    P<FCT> = HLR$FCTQ[0] + FCTQHL;
    STAGE = HLR$HPN[0] EQ HLRPN"STAGE";
    IF HLR$RESP[0] EQ RESPTYP4"OK4"
    THEN
      BEGIN  # NO ERROR #
      HLR$RESP[0] = ERRST"NOERR";
      FCT$LCF[0] = FALSE;           # CLEAR LOST CARTRIDGEFLAG #
      END  # NO ERROR #

    ELSE
      BEGIN  # PROCESS ERROR #

      STAT = HLR$RESP[0];

      IF STAGE
      THEN
        BEGIN
        HLR$RESP[0] = ERRST"TEMP";  # DEFAULT FOR STAGE #
        HLR$ERRC[0] = STGERRC"HWPROB";
        END

      ELSE
        BEGIN
        HLR$RESP[0] = ERRST"RETRY";  # DEFAULT FOR DESTAGER #
        END

      IF STAT EQ RESPTYP4"CELL$EMP"
      THEN
        BEGIN  # SET LOST FLAG IN *FCT* #
        FCT$LCF[0] = TRUE;

        IF STAGE
        THEN
          BEGIN
          HLR$ERRC[0] = STGERRC"LOSTCART";
          END

        END  # SET LOST FLAG IN *FCT* #

      IF STAT EQ RESPTYP4"CART$LB$ERR"
      THEN
        BEGIN  # PROCESS CARTRIDGE LABEL ERROR #
        FCT$IAF[0] = TRUE;

        IF STAGE
        THEN
          BEGIN
          HLR$RESP[0] = ERRST"PERM";
          HLR$PEF[0] = AFPSE;
          HLR$ERRC[0] = STGERRC"CARTLBL";
          END

        END  # PROCESS CARTRIDGE LABEL ERROR #

      IF STAGE
      THEN                         # DIAGNOSE OTHER PROBLEMS #
        BEGIN
        IF STAT EQ RESPTYP4"UNK$CART"
        THEN
          BEGIN
          HLR$RESP[0] = ERRST"RETRY";
          END

        IF STAT EQ RESPTYP4"SMA$OFF"
        THEN
          BEGIN
          HLR$ERRC[0] = STGERRC"SMOFF";
          END

END

        IF STAT EQ RESPTYP4"CSN$IN$USE"
        THEN
          BEGIN
          HLR$RESP[0] = ERRST"RSFULL";
          IF STAGE
          THEN
            BEGIN
            HLR$ERRC[0] = STGERRC"CARTINUSE";
            END

END

      END  # PROCESS ERROR #

    RETURN;
    END  # HLLOAD #

  TERM

PROC MSG¹¹⁾;

# TITLE MSG - DISPLAY DAYFILE MESSAGE. #

    BEGIN  # MSG #

# MSG - DISPLAY DAYFILE MESSAGE. * * *MSG* SEARCHES A MESSAGE FOR A TERMINATING CHARACTER AND * ZERO FILLS THE MESSAGE FROM THE TERMINATOR TO THE END * OF THE MESSAGE. * * PROC MSG¹²⁾ * * ENTRY (DFMSG) - MESSAGE TO BE DISPLAYED, 40 CHARACTER * MAXIMUM. * (OP) - MESSAGE ROUTING OPTION. * (VALUES DEFINED IN *COMBFAS*) * * EXIT THE MESSAGE HAS BEEN DISPLAYED AT THE LOCATION * SPECIFIED BY (OP). # ITEM DFMSG C(40); # MESSAGE TEXT # ITEM OP I; # MESSAGE ROUTING OPTION # # * PROC MSG - XREF LIST BEGIN. # XREF BEGIN PROC MESSAGE; # ISSUE MESSAGE # END # * PROC MSG - XREF LIST END. # DEF BLANK #“ ”#; # BLANK CHARACTER # DEF TERMCHAR #“;”#; # TERMINATOR CHARACTER # DEF LISTCON #0#; # DO NOT LIST COMMON DECKS # *CALL,COMBFAS ITEM I I; # LOOP COUNTER # ITEM CP I; # CHARACTER POSITION # CONTROL EJECT; CP = 0; FASTFOR I = 0 STEP 1 WHILE I LS 40 AND CP EQ 0 DO # FIND TERMINATOR # BEGIN IF C<I,1>DFMSG EQ TERMCHAR THEN BEGIN CP = I; END END IF CP NQ 0 THEN # ZERO FILL END OF MESSAGE # BEGIN B<CP*6,(40-CP)*6>DFMSG = 0; END MESSAGE(DFMSG,OP); # ISSUE MESSAGE # RETURN; END # MSG # TERM PROC REQBS¹³⁾; # TITLE RLSBUF - RELEASE LARGE BUFFER. # BEGIN # RLSBUF # # RLSBUF - RELEASE LARGE BUFFER. * * *RLSBUF* ALLOWS THE CALLER TO RELINQUISH CONTROL OF A LARGE * BUFFER AND CALLS *GOBUF* TO ASSIGN ANY AVAILABLE BUFFERS TO * WAITING *HLRQ*/*LLRQ* PROCESSES. * * PROC RLSBUF((REQADR)) * * ENTRY (REQADR) - ADDRESS OF REQUEST QUEUE ENTRY. * * EXIT IF A *BST* ENTRY CONTROLLED BY *REQADR* IS FOUND, THE * ENTRY IS MARKED AVAILABLE AND THE *GLBRTRNB* FLAG IS * SET. # ITEM REQADR U; # REQUEST QUEUE ENTRY ADDRESS # # PROC RLSBUF - XREF LIST BEGIN. # XREF BEGIN PROC GOBUF; # ASSIGN AVAILABLE BUFFERS # END # PROC RLSBUF - XREF LIST END. # DEF LISTCON #0#; # DO NOT LIST COMMON DECKS # *CALL,COMBFAS *CALL,COMXBST *CALL,COMXCTF ITEM I I; # LOOP VARIABLE # CONTROL EJECT; SLOWFOR I = 1 STEP 1 WHILE I LQ BSTL DO BEGIN # FIND ENTRY TO BE RELEASED # IF BST$REQA[I] EQ REQADR THEN BEGIN BST$REQA[I] = 0; # SET BUFFER AVAILABLE # BST$BUSY[I] = FALSE; GOBUF; GLBRTRNB = TRUE; RETURN; END END # FIND ENTRY TO BE RELEASED # RETURN; END # RLSBUF # TERM PROC RLSVOL(HLRQADR,FCTADR,VOLAU,VOLLN); # TITLE RLSVOL - RELEASE UNUSED AU. # BEGIN # RLSVOL # # RLSVOL - RELEASE UNUSED AU. * * THIS PROCEDURE UPDATES AN *FCT* ENTRY TO MAKE THE * INDICATED AU AVAILABLE FOR RE-ALLOCATION. *RLSVOL* * WILL CREATE THESE AU INTO ONE VOLUME AND LINK THIS * VOLUME INTO THE CORRECT CHAIN OF FREE AU. * * RLSVOL(HLRQADR,FCTADR,VOLAU,VOLLN) * * ENTRY (HLRQADR) - ADDRESS OF *HLRQ* ENTRY. * (FCTADR) - ADDRESS OF *FCT* ENTRY. * (VOLAU) - FIRST AU OF THE VOLUME TO BE * MADE AVAILABLE FOR REUSE. * (VOLLN) - LENGTH OF THE VOLUME TO BE RELEASED. * (ZERO OR NEGATIVE IS LEGAL) * * EXIT - THE CORRECT (LONG OR SHORT FILE) CHAIN * OF VOLUMES AVAILABLE FOR ALLOCATION * IS UPDATED TO INCLUDE THIS VOLUME. #

    ITEM HLRQADR    U;             # *HLRQ* ENTRY ADDRESS #
    ITEM FCTADR     U;             # ADDRESS OF *FCT* ENTRY #
    ITEM VOLAU      U;             # INDEX OF FIRST AU OF THE VOLUME
                                   #
    ITEM VOLLN      I;             # LENGTH OF THE VOLUME #

    DEF LISTCON #0#;               # DO NOT LIST COMMON DECKS #

*CALL,COMBFAS *CALL,COMBMCT *CALL,COMXFCQ *CALL,COMXHLR

    ITEM CAUF       U;             # CONTINUATION AU FIELD VALUE #
    ITEM I          I;             # LOOP INDEX #
    ITEM LINK       U;             # VALUE OF LINK FIELD #
    ITEM NOTYET     B;             # LOOP TERMINATOR #
    ITEM PREV       U;             # LINK FIELD OF PREVIOUS CHAIN
                                     ELEMENT #
    ITEM PREVLN     U;             # LENGTH OF PREVIOUS VOLUME #
                                             CONTROL EJECT;
    P<FCT> = FCTADR + FCTQHL;
    P<HLRQ> = HLRQADR;

    IF VOLLN LQ 0
    THEN                           # NO-OP CALL #
      BEGIN
      RETURN;
      END

# * INITIALIZE FOR SEARCH OF FREE VOLUME CHAIN. #

    IF VOLAU LS FCT$CDP[0]
    THEN                           # USE SHORT FILE CHAIN #
      BEGIN
      LINK = FCT$FAUSF[0];
      END

    ELSE                           # USE LONG FILE CHAIN #
      BEGIN
      LINK = FCT$FAULF[0];
      END

    PREV = 0;

# * SEARCH FREE VOLUME CHAIN TO DETERMINE WHERE TO ADD THIS VOLUME. #

    NOTYET = TRUE;
    FOR I = 0 STEP 1 WHILE NOTYET
    DO
      BEGIN
      IF (LINK NQ 0)               # NOT END OF CHAIN #
        AND (LINK LS VOLAU)        # NOT BEFORE THIS VOLUME #
      THEN                         # TRY THE NEXT FREE VOLUME #
        BEGIN
        PREV = LINK;
        SETFCTX(LINK);
        PREVLN = FCT$LEN(FWD,FPS);
        LINK = FCT$LINK(FWD,FPS);
        TEST I;
        END

      NOTYET = FALSE;              # TERMINATE SEARCH LOOP #
      END

# * VERIFY THAT THE NEW VOLUME DOES NOT INCLUDE ANY AU BELONGING * TO EITHER OF THE VOLUMES BETWEEN WHICH IT IS TO BE LINKED. #

    IF                             # NEW VOLUME OVERLAPS NEXT ONE #
      (( LINK NQ 0)                ##
      AND (VOLAU+VOLLN GR LINK))   ##
      OR                           # PREVIOUS VOLUME OVERLAPS NEW ONE
                                   #
      ((PREV NQ 0)                 ##
      AND (PREV+PREVLN GR VOLAU))
    THEN                           # DO NOT ADD IN THE NEW VOLUME #
      BEGIN
      RETURN;
      END

# * INITIALIZE NEW VOLUME ELEMENTS AND * INSERT NEW VOLUME INTO CHAIN AT THIS SPOT. #

    CAUF = 0;                      # FIRST CAUF FIELD = 0 #

    FOR I = 0 STEP 1 UNTIL VOLLN-1
    DO
      BEGIN
      SETFCTX(VOLAU+I);            # DEFINE *FWD* AND *FPS* #

      FCT$CLFG(FWD,FPS) = 0;
      FCT$CAUF(FWD,FPS) = CAUF;
      FCT$LEN(FWD,FPS) = VOLLN-I-1;
      FCT$LINK(FWD,FPS) = LINK;

      LINK = VOLAU;
      CAUF = 1;                    # REMAINING CAUF FIELDS = 1 #
      END

    IF PREV NQ 0
    THEN                           # LINK PREVIOUS VOLUME TO NEW
                                     VOLUME #
      BEGIN
      SETFCTX(PREV);
      FCT$LINK(FWD,FPS) = VOLAU;
      END

    ELSE                           # UPDATE HEAD OF CORRECT CHAIN TO
                                     POINT TO NEW VOLUME #
      BEGIN
      IF VOLAU LS FCT$CDP[0]
      THEN                         # UPDATE SHORT FILE POINTER #
        BEGIN
        FCT$FAUSF[0] = VOLAU;
        END

      ELSE                         # UPDATE LONG FILE POINTER #
        BEGIN
        FCT$FAULF[0] = VOLAU;
        END

END

    IF HLRQADR NQ 0
    THEN                           # UPDATE AVAILABLE AU LEFT ON
                                     CARTRIDGE #
      BEGIN
      IF HLR$SH[0]
      THEN
        BEGIN
        HLR$AUSF[0] = HLR$AUSF[0] + VOLLN;
        END

      ELSE
        BEGIN
        HLR$AULF[0] = HLR$AULF[0] + VOLLN;
        END

END

    RETURN;
    END  # RLSVOL #

  TERM

PROC RLS$FCT(FCTQADDR,(REQADDR),RSTATUS);

# TITLE RLS$FCT - RELEASE AN *FCTQ* ENTRY. #

    BEGIN  # RLS$FCT #

# RLS$FCT - RELEASE AN *FCTQ* ENTRY. * * *RLS$FCT* RELEASES AN *FCT* ENTRY WHEN IT IS NO LONGER * NEEDED BY A PROCESS. * * PROC RLS$FCT(FCTQADDR,(REQADDR),RSTATUS) * * ENTRY (FCTQADDR) - ADDRESS OF *FCTQ* ENTRY TO BE RELEASED. * (REQADDR) - ADDRESS OF *HLRQ* ENTRY, ELSE ZERO. * * EXIT (RSTATUS) - *CPUTFCT* ERROR STATUS (DEFINED IN * PROC *CPUTFCT* IN DECK *CATACC*). * * NOTES *FCTQADDR* WILL BE ZERO UPON RETURN FROM THIS * PROCEDURE PROVIDING THE *FCTQ* ENTRY WAS FOUND AND * THE USER COUNT DECREMENTED. * * IF THE CATALOG IS INTERLOCKED AND IF *REQADDR* IS * NONZERO, *CGETFCT* WILL PUT THE *HLRQ* ENTRY ON THE * “WAITING-FOR-CATALOG-INTERLOCK” CHAIN. # ITEM FCTQADDR U; # *FCTQ* ADDRESS TO BE RELEASED # ITEM REQADDR U; # *HLRQ* REQUEST ADDRESS # ITEM RSTATUS U; # *CPUTFCT* ERROR STATUS # # PROC RLS$FCT - XREF LIST BEGIN. # XREF BEGIN PROC ABORT; # ABORT # PROC ADD$LNK; # ADD ENTRY TO CHAIN # PROC CPUTFCT; # PUT AN *FCT* ENTRY # PROC DEL$LNK; # DELETE ENTRY FROM CHAIN # PROC MESSAGE; # INTERFACE TO *MESSAGE* MACRO # PROC ZFILL; # ZERO FILL BUFFER # END # PROC RLS$FCT - XREF LIST END. # DEF LISTCON #0#; # DO NOT LIST COMMON DECKS # *CALL,COMBFAS *CALL,COMBCHN *CALL,COMBMCT *CALL,COMXFCQ *CALL,COMXMSC CONTROL EJECT; RSTATUS = 0; # * IF THERE IS NO *FCTQ* ENTRY TO RELEASE, RETURN TO CALLER. # IF FCTQADDR EQ 0 THEN BEGIN RETURN; END IF CHN$BOC[LCHN“FCT$ACT”] EQ 0 THEN # NO *FCTQ* ENTRIES # BEGIN FE$RTN[0] = “RLS$FCT.”; MESSAGE(FEMSG[0],UDFL1); ABORT; END # * UPDATE *FCT* WITH THE CONTENT OF THE *FCTQ* ENTRY. # P<FCTQ> = FCTQADDR; P<FCT> = FCTQADDR + FCTQHL; CPUTFCT(FCTQFAMILY[0],FCTQSUBF[0],FCTQSMID[0],FCTQFCTORD[0], ## P<FCT>,REQADDR,RSTATUS); IF RSTATUS NQ 0 THEN BEGIN RETURN; END # * DO NOT DELETE THE *FCTQ* ENTRY IF THERE ARE STILL ACTIVE USERS. # FCTQACTCNT[0] = FCTQACTCNT[0] - 1; IF FCTQACTCNT[0] NQ 0 THEN BEGIN FCTQADDR = 0; RETURN; END # * DELETE THE ENTRY FROM THE ACTIVE CHAIN. # DEL$LNK(FCTQADDR,LCHN“FCT$ACT”,0); ZFILL(FCTQ[0],FCTQHL+FCTENTL); # * MOVE THE DELETED ENTRY TO THE FREE SPACE CHAIN. # ADD$LNK(FCTQADDR,LCHN“FCT$FRSPC”,0); P<FCTQ> = FCTQADDR; FCTQADDR = 0; RETURN; END # RLS$FCT # TERM PROC RMVBLNK(CHARBUF,(COUNT)); # TITLE RMVBLNK - REMOVE MULTIPLE BLANKS. # BEGIN # RMVBLNK # # RMVBLNK - REMOVE MULTIPLE BLANKS. * * *RMVBLNK* REPLACES STRINGS OF MULTIPLE BLANKS WITH A SINGLE * BLANK AND REMOVES ALL BLANKS IMMEDIATELY PRECEEDING A COMMA * OR A PERIOD. * * PROC RMVBLNK(CHARBUF,(COUNT)) * * ENTRY (CHARBUF) - CHARACTER STRING, LEFT JUSTIFIED, MAXIMUM * OF 80 CHARACTERS. * (COUNT) - NUMBER OF CHARACTERS. * * EXIT (CHARBUF) - CHARACTER STRING PASSED IN WITH EXCESS * BLANKS REMOVED. #

    ITEM CHARBUF    C(80);         # CHARACTER BUFFER #
    ITEM COUNT      I;             # CHARACTER COUNT #

    DEF BLANK   #" "#;             # DISPLAY CODE BLANK #
    DEF COMMA      #","#;          # DISPLAY CODE COMMA #
    DEF PERIOD     #"."#;          # DISPLAY CODE PERIOD #

    DEF LISTCON    #0#;            # DO NOT LIST COMMON DECKS #

*CALL,COMBFAS

    ITEM CHARPOS    I;             # CHARACTER POSITION #
    ITEM I          I;             # LOOP COUNTER #
    ITEM NEXTCHAR   C(1);          # NEXT CHARACTER #
    ITEM TEMPBUF    C(80);         # TEMPORARY BUFFER #
                                             CONTROL EJECT;

    TEMPBUF = CHARBUF;
    C<0,COUNT>CHARBUF = BLANK;
    CHARPOS = 0;

# * TRANSFER CHARACTERS, REMOVING MULTIPLE BLANKS. #

    SLOWFOR I = 0 STEP 1 WHILE I LS COUNT
    DO
      BEGIN  # TRANSFER #
      NEXTCHAR = C<I+1,1>TEMPBUF;
      IF C<I,1> TEMPBUF EQ BLANK   ##
        AND (NEXTCHAR EQ BLANK OR NEXTCHAR EQ COMMA  ##
        OR NEXTCHAR EQ PERIOD) AND I NQ COUNT-1
      THEN
        BEGIN
        TEST I;                    # IGNORE MULTIPLE BLANKS #
        END

      C<CHARPOS,1>CHARBUF = C<I,1>TEMPBUF;
      CHARPOS = CHARPOS + 1;
      END  # TRANSFER #

    RETURN;
    END  # RMVBLNK #

  TERM

PROC RTRNBUF;

# TITLE RTRNBUF - RETURN LARGE BUFFER SPACE. #

    BEGIN  # RTRNBUF #

# RTRNBUF - RETURN LARGE BUFFER SPACE. * * *RTRNBUF* RETURNS MEMORY OCCUPIED BY UNUSED BUFFERS TO REDUCE * EXEC-S FIELD LENGTH. * * PROC RTRNBUF. * * EXIT (GLBRTRNB) - FALSE. * THE ACQUIRED FLAG IS CLEARED IN *BST* ENTRIES WHOSE * BUFFER SPACE IS RELEASED. * * MESSAGES *STF2, NNNNNN.*. # # PROC RTRNBUF - XREF LIST BEGIN. # XREF BEGIN PROC MNGMEM; # MANAGE MEMORY # PROC MSG; # ISSUE MESSAGE # FUNC XCDD C(10); # CONVERT TO DISPLAY CODE # END # PROC RTRNBUF - XREF LIST END. # DEF LISTCON #0#; # DO NOT LIST COMMON DECKS # *CALL,COMBFAS *CALL,COMBLBL *CALL,COMXACM *CALL,COMXBST *CALL,COMXCCB *CALL,COMXCTF *CALL,COMXJCA *CALL,COMXMSC ITEM COUNT I; # UNUSED BUFFER COUNT # ITEM DC$FL C(10); # DISPLAY CODED FIELD LENGTH # ITEM I I; # LOOP COUNTER # ITEM REDUCEFL I; # FIELD LENGTH REDUCTION VALUE # ITEM STAT I; # STATUS # CONTROL EJECT; GLBRTRNB = FALSE; COUNT = 0; SLOWFOR I = BSTL STEP -1 WHILE I GR 0 AND NOT BST$BUSY[I] DO # SEARCH *BST* FOR FREE ENTRIES # BEGIN IF BST$ACQD[I] THEN BEGIN COUNT = COUNT + 1; # COUNT ACQUIRED, FREE ENTRIES # END END IF COUNT EQ 0 THEN # NO BUFFER SPACE TO BE RELEASED # BEGIN RETURN; END REDUCEFL = -(COUNT * (CCBLEN + (2 * RFETL) + DATABL + LABLEN)); MNGMEM(REDUCEFL,STAT); IF STAT NQ 0 THEN BEGIN # MEMORY REDUCTION HONORED # FASTFOR I = BSTL STEP -1 WHILE COUNT NQ 0 DO BEGIN IF BST$ACQD[I] THEN BEGIN COUNT = COUNT - 1; BST$ACQD[I] = FALSE; # CLEAR ACQUIRED FLAG # END END END # MEMORY REDUCTION HONORED # RETURN; END # RTRNBUF # TERM PROC SETBSTE¹⁴⁾; # TITLE SETBSTE - SET *BST* ENTRY BUSY. # BEGIN # SETBSTE # # SETBSTE - SET *BST* ENTRY BUSY. * * *SETBSTE* ASSIGNS THE SPECIFIED *BST* ENTRY TO A HIGH LEVEL/LOW * LEVEL PROCESS AND RETURNS THE LOCATION OF THE LARGE BUFFER SPACE * IN THE REQUEST QUEUE ENTRY. * * PROC SETBSTE¹⁵⁾ * * ENTRY (REQADR) - ADDRESS OF HIGH LEVEL/LOW LEVEL REQUEST * QUEUE ENTRY. * (REQIND) - HIGH LEVEL/LOW LEVEL REQUEST INDICATOR. * = TRUE, HIGH LEVEL REQUEST. * = FALSE, LOW LEVEL REQUEST. * (ORD) - *BST* ENTRY ORDINAL. * * EXIT (BST$REQA[ORD]) = (REQADR). * (BST$BUSY[ORD]) = TRUE. * IF THE REQUEST IS A HIGH LEVEL REQUEST, THE ADDRESSES * OF THE COPY CONTROL BLOCK, MSF FET, DISK FET, LABEL * BUFFER AND DATA BUFFER (WHICH MAKE UP THE LARGE * BUFFER) ARE RETURNED IN THE *HLRQ* ENTRY. IF THE * REQUEST IS A LOW LEVEL REQUEST, THE ADDRESSES OF THE * MSF AND DISK FET-S ARE RETURNED IN THE *LLRQ* ENTRY * AND THE FET-S ARE INITIALIZED (BUFFER POINTERS SET). #

    ITEM REQADR     U;             # REQUEST ADDRESS #
    ITEM REQIND     B;             # REQUEST TYPE INDICATOR #
    ITEM ORD        I;             # *BST* ENTRY ORDINAL #

# PROC SETBSTE - XREF LIST BEGIN. #

    XREF
      BEGIN
      PROC ZFILL;                  # ZERO FILL BUFFER #
      PROC ZSETFET;                # INITIALIZE A FET #
      END

# PROC SETBSTE - XREF LIST END. #

    DEF LISTCON #0#;               # DO NOT LIST COMMON DECKS #

*CALL,COMBFAS *CALL,COMBFET *CALL,COMBLBL *CALL,COMBLRQ *CALL,COMXBST *CALL,COMXCCB *CALL,COMXHLR

    ITEM LENGTH     I;             # BUFFER SPACE LENGTH #

    BASED
    ARRAY LBUF [0:0] P(1); ;       # LARGE BUFFER SPACE #
                                             CONTROL EJECT;

    BST$REQA[ORD] = REQADR;        # SET *BST* ENTRY BUSY #
    BST$BUSY[ORD] = TRUE;
    P<LBUF> = BST$CCB[ORD];        # ZERO FILL BUFFER SPACE #
    LENGTH = CCBLEN + RFETL + RFHBL + DATABL;
    ZFILL(LBUF[0],LENGTH);
    P<LLRQ> = REQADR;

    LLR$CCB[0] = BST$CCB[ORD];
    LLR$DSKFET[0] = BST$DISKF[ORD];
    LLR$MSFET[0] = BST$M86F[ORD];
    LLR$DA[0] = BST$DATA[ORD];

    RETURN;
    END  # SETBSTE #

  TERM

PROC UASTPRM¹⁶⁾; # TITLE UPUSAGE - UPDATE CARTRIDGE USAGE STATISTICS. # BEGIN # UPUSAGE # # UPUSAGE - UPDATE CARTRIDGE USAGE STATISTICS. * * *UPUSAGE* ADDS CARTRIDGE USAGE INFORMATION FROM FIELDS * IN THE *HLRQ* ENTRY TO THE CORRESPONDING FIELDS IN THE * *FCT* ENTRY. * * PROC ((HLRQADR),(FCTADR)). * * ENTRY (HLRQADR) - ADDRESS OF *HLRQ* ENTRY. * (FCTADR) - ADDRESS OF *FCT* ENTRY. * (HLR$UUU) - USAGE FIELDS IN *HLRQ* ENTRY. * * EXIT FCT - USAGE FIELDS IN THE *FCT* ENTRY * ARE INCREMENTED. THE *FCT* ENTRY IS * LEFT IN MEMORY. #

    ITEM HLRQADR    U;             # *HLRQ* ADDRESS #
    ITEM FCTADR     U;             # *FCT* ADDRESS #

    DEF LISTCON #0#;               # DO NOT LIST COMMON DECKS #

*CALL,COMBFAS *CALL,COMBCMD *CALL,COMBMCT *CALL,COMXFCQ *CALL,COMXHLR

                                             CONTROL EJECT;
    P<HLRQ> = HLRQADR;
    P<FCT> = FCTADR + FCTQHL;

    FCT$STRD[0] = FCT$STRD[0] + HLR$STRD[0];
    FCT$STWR[0] = FCT$STWR[0] + HLR$STWR[0];

    FCT$SRDE[0] = FCT$SRDE[0] + HLR$SRDE[0];
    FCT$SWRE[0] = FCT$SWRE[0] + HLR$SWRE[0];

    FCT$HRDE[0] = FCT$HRDE[0] + HLR$HRDE[0];
    FCT$STDM[0] = FCT$STDM[0] + HLR$STDM[0];
    FCT$CRLD[0] = FCT$CRLD[0] + HLR$CRLD[0];
    FCT$LDER[0] = FCT$LDER[0] + HLR$LDER[0];

    HLR$USE1[0] = 0;
    HLR$USE2[0] = 0;
    HLR$USE3[0] = 0;

    RETURN;

    END  # UPUSAGE #

  TERM

</file>

¹⁾

FAMNAME),(SUBFAM),(SMID),(FCTORD),FCTQADDR,(REQADDR)

[00004] ACQ$FCT - ACQUIRE AN *FCTQ* ENTRY.
[00009] ACQ$FCT - ACQUIRE AN *FCTQ* ENTRY.
[00046] PROC ABORT
[00047] PROC ADD$LNK
[00048] PROC CGETFCT
[00049] PROC DEL$LNK
[00050] PROC MESSAGE
[00142] PROC ADD$LNK((ADDR),(CHNTYP),(WRD

²⁾

SM),(NEED$S),(NEED$L),FCTX$S,FCTX$L,GPX,GPS)

[00200] ANLZAST - SCAN *AST* TO DETERMINE BEST CARTRIDGES AND GROUP.
[00205] ANLZAST - SCAN *AST* TO DETERMINE BEST CARTRIDGES AND GROUP.
[00461] PROC DELAY((DTIME),(ADDR),(TYP

³⁾

ADDR),(CHNTYP),(WRD

⁴⁾

REQADR),(REQIND),FLAG)

[00650] GETBUF - GET LARGE BUFFER.
[00655] GETBUF - GET LARGE BUFFER.
[00693] PROC REQBS
[00694] PROC SETBSTE
[00762] PROC GOBUF
[00764] GOBUF - ASSIGN AVAILABLE BUFFERS.
[00769] GOBUF - ASSIGN AVAILABLE BUFFERS.
[00788] PROC ADD$LNK
[00789] PROC DEL$LNK
[00790] PROC REQBS
[00791] PROC SETBSTE
[00846] PROC HLCPYCD((HLRQADR

⁵⁾ , ⁶⁾ , ⁷⁾ , ⁸⁾ , ⁹⁾ , ¹⁰⁾

HLRQADR

¹¹⁾ , ¹²⁾

DFMSG),(OP

¹³⁾

ORD),ACQFLAG); # TITLE REQBS - REQUEST LARGE BUFFER SPACE. #

    BEGIN  # REQBS #

# REQBS - REQUEST LARGE BUFFER SPACE. * * *REQBS* REQUESTS ADDITIONAL MEMORY FOR A LARGE BUFFER. * * PROC REQBS((ORD),ACQFLAG) * * ENTRY (ORD) - ORDINAL OF *BST* ENTRY. * * EXIT (ACQFLAG) - BUFFER ACQUIRED FLAG. * = TRUE, BUFFER SPACE ACQUIRED. * = FALSE, MEMORY NOT AVAILABLE. * IF THE BUFFER SPACE IS ACQUIRED, THE ADDRESSES OF THE * COPY CONTROL BLOCK, MSF FET, DISK FET, LABEL BUFFER * AND DATA BUFFER (WHICH MAKE UP THE LARGE BUFFER SPACE) * ARE STORED IN THE *BST* ENTRY. * * MESSAGES *STF1, NNNNNN.*. #
ITEM ORD I; # ORDINAL OF *BST* ENTRY # ITEM ACQFLAG B; # BUFFER ACQUIRED FLAG #
# PROC REQBS - XREF LIST BEGIN. #
XREF BEGIN PROC MNGMEM; # MANAGE MEMORY # PROC MSG; # ISSUE MESSAGE # FUNC XCDD C(10); # CONVERT TO DISPLAY CODE # END
# PROC REQBS - XREF LIST END. #
DEF LISTCON #0#; # DO NOT LIST COMMON DECKS #
*CALL,COMBFAS *CALL,COMBLBL *CALL,COMXACM *CALL,COMXBST *CALL,COMXCCB *CALL,COMXCTF *CALL,COMXJCA *CALL,COMXMSC
ITEM BUFADR U; # BUFFER ADDRESS # ITEM DC$FL C(10); # DISPLAY CODED FIELD LENGTH # ITEM LBUFLEN I; # LARGE BUFFER SPACE LENGTH # CONTROL EJECT;

LBUFLEN = CCBLEN + RFETL + RFHBL + DATABL; MNGMEM(LBUFLEN,BUFADR); # GET ADDITIONAL FIELD LENGTH # IF BUFADR EQ 0 THEN # IF REQUEST DENIED # BEGIN ACQFLAG = FALSE; # NO BUFFER SPACE AVAILABLE # RETURN; END

BST$CCB[ORD] = BUFADR; # STORE LOCATIONS IN ENTRY # BST$DISKF[ORD] = BUFADR + CCBLEN; BST$M86F[ORD] = BST$DISKF[ORD] + RFETL; BST$DATA[ORD] = BST$M86F[ORD] + RFHBL; BST$ACQD[ORD] = TRUE; ACQFLAG = TRUE; # BUFFER SPACE ACQUIRED # RETURN; END # REQBS #

TERM
PROC RLSBUF((REQADR

¹⁴⁾ , ¹⁵⁾
REQADR),(REQIND),(ORD

¹⁶⁾
FAM),(SFX),(SMX),(FCTADR),STAT); # TITLE UASTPRM - UPDATE *AST* AND PREAMBLE. #
BEGIN # UASTPRM #
# UASTPRM((FAM),(SFX),(SMX),(FCTADR),STAT). * * WHEN AN *FCT* ENTRY HAS BEEN UPDATED SUCH THAT ITS * ALLOCATION STATUS HAS CHANGED (MORE OR FEWER AU AVAILABLE, * CHANGE IN *OCL* OR USABILITY, ETE.), THIS ROUTINE IS * CALLED TO UPDATE THE CORRESPONDING *AST* ENTRY AND THEN * UPDATE THE PREAMBLE FOR THE ASSOCIATED STORAGE MODULE. * * ENTRY (FAM) - FAMILY NAME. * (SFX) - SUBFAMILY INDEX. * (SMX) - STORAGE MODULE INDEX. * (FCTADR) - ADDRESS OF *FCT* ENTRY. * =0 *AST* IS IN CORE ALREADY. * * EXIT (STAT) - STATUS. =0, IF NO ERRORS. * AST - UPDATED ON DISK. * PREAMBLE - UPDATED ON DISK AND IN MEMORY. #
ITEM FAM C(7); # FAMILY # ITEM SFX U; # SUBFAMILY INDEX # ITEM SMX U; # STORAGE MODULE INDEX # ITEM FCTADR U; # ADDRESS OF *FCT* ENTRY # ITEM STAT U; # REPLAY STATUS #
# PROC UASTPRM - XREF LIST BEGIN. #
XREF BEGIN PROC ANLZAST; # ANALYZE *AST* # PROC CRDAST; # READ *AST* TO MEMORY # PROC CWTAST; # WRITE *AST* BACK TO DISK # PROC OCTSRCH; # OPEN CATALOG SEARCH # END
# PROC UASTPRM - XREF LIST END. #
DEF LISTCON #0#; # DO NOT LIST COMMON DECKS #
*CALL,COMBFAS *CALL,COMBCMD *CALL,COMBCMS *CALL,COMBMCT *CALL,COMXFCQ *CALL,COMXMSC
ITEM FCTLX U; # INDEX TO BEST CARTRIDGE FOR LONG FILES # ITEM FCTSX U; # INDEX TO BEST CARTRIDGE FOR SHORT FILES # ITEM GPLN U; # AU ON BEST GROUP # ITEM I U; # LOOP INDEX # ITEM J U; # LOOP INDEX # ITEM LINK U; # INDEX OF NEXT VOLUME IN CHAIN # ITEM PREV U; # PREVIOUS LINK VALUE # ITEM TMP1 U; # TEMPORARY # ITEM TOTAL U; # TOTAL AU AVAILABLE FOR ALLOCATION #

CONTROL EJECT;
# * LOCATE PREAMBLE AND READ IN *AST* (IF *FCTADR* NQ 0). #
OCTSRCH(FAM,SFX,TMP1,0,STAT); IF STAT EQ CMASTAT"NOERR" AND FCTADR NQ 0 THEN BEGIN CRDAST(FAM,SFX,SMX,ASTBADR,0,STAT); END

IF STAT NQ CMASTAT"NOERR" THEN BEGIN RETURN; END

P<AST> = ASTBADR; P<PREAMBLE> = OCT$PRMA[TMP1];
# * UPDATE *AST INFORMATION FOR CARTRIDGE. #
IF FCTADR NQ 0 THEN BEGIN # *AST* UPDATE # P<FCT> = FCTADR + FCTQHL; TMP1 = FCT$ORD[0]; FOR I = 1 STEP 1 UNTIL 2 DO BEGIN # FREE SPACE CALCULATIONS # IF I EQ 1 THEN BEGIN LINK = FCT$FAUSF[0]; END

ELSE BEGIN LINK = FCT$FAULF[0]; AST$AUSF[TMP1] = TOTAL; END

TOTAL = 0; PREV = 0; SLOWFOR J = 0 WHILE LINK GR PREV DO BEGIN SETFCTX(LINK); TOTAL = TOTAL + FCT$LEN(FWD,FPS) + 1; PREV = LINK; LINK = FCT$LINK(FWD,FPS); END

END # FREE SPACE CALCULATIONS #

AST$FLAWS[TMP1] = FCT$FLAWS[0]; AST$AULF[TMP1] = TOTAL; AST$NOCLF[TMP1] = FCT$OCLF[0] EQ 7; AST$AAF[TMP1] = NOT ( FCT$IAF[0] ## OR FCT$LCF[0] OR FCT$FCF[0] OR FCT$EEF[0]);

END # *AST* UPDATE #
# * DETERMINE THE BEST CARTRIDGES AND GROUP FOR SHORT AND * LONG FILES. ENTER AVAILABLE AU FOR EACH INTO *AST*. #
ANLZAST(SMX,999999,999999,FCTSX,FCTLX,TMP1,GPLN); IF FCTSX EQ 0 THEN BEGIN PRM$MXAUS[SMX] = 0; END ELSE BEGIN PRM$MXAUS[SMX] = AST$AUSF[FCTSX]; END

IF FCTLX EQ 0 THEN BEGIN PRM$MXAUL[SMX] = 0; END ELSE BEGIN PRM$MXAUL[SMX] = AST$AULF[FCTLX]; END

PRM$MXAUGR[SMX] = GPLN;
# * CALL *CWTAST* TO WRITE THE *AST* AND PREAMBLE TO DISK. #
CWTAST(FAM,SFX,SMX,ASTBADR,0,STAT);

RETURN; END # UASTPRM #

TERM
PROC UPUSAGE((HLRQADR),(FCTADR

cdc/nos2.source/opl871/sxserv.txt · Last modified: 2023/08/05 17:24 by Site Administrator

SXSERV

Table Of Contents