Retro1.org codex

PROC HLRQENQ(ADDR);
 
# TITLE HLRQENQ - HIGH LEVEL REQUEST QUEUE ENQUEUER.                  #
 
      BEGIN  # HLRQENQ #
 
#
**    HLRQENQ - HIGH LEVEL REQUEST QUEUE ENQUEUER.
*
*     *HLRQENQ* INSERTS AN ENTRY INTO THE HIGH LEVEL REQUEST QUEUE
*     (HLRQ) BY LINKING THE ENTRY INTO AN *HLRQ* READY CHAIN. *HLRQENQ*
*     IS CALLED ONLY IF THE *HLRQ* IS NOT FULL.
*
*     PROC       HLRQENQ(ADDR)
*
*     EXIT       (ADDR)   - ADDRESS OF ENTRY ADDED TO QUEUE.
*
*     MESSAGES   * EXEC ABNORMAL, HLRQENQ.*.
#
 
 
      ITEM ADDR       U;             # ADDRESS OF *HLRQ* ENTRY #
 
#
****  PROC HLRQENQ - 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
 
#
****
#
 
      DEF LISTCON #0#;               # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBCHN
*CALL COMXHLR
*CALL COMXMSC
 
 
 
 
#
*     CHECK FOR *HLRQ* FULL.
#
 
      ADDR = CHN$BOC[LCHN"HL$FRSPC"];
 
      IF ADDR EQ 0                   # IF NO FREE ENTRIES #
      THEN
        BEGIN
        FE$RTN[0] = "HLRQENQ.";
        MESSAGE(FEMSG,UDFL1);
        ABORT;
        END
 
      DEL$LNK(ADDR,LCHN"HL$FRSPC",0);  # DELETE ENTRY FROM FREE SPACE
                                         CHAIN #
      P<HLRQ> = ADDR;
      HLR$HPS[0] = PROCST"INITIAL";
      ADD$LNK(ADDR,LCHN"HL$READY",0);  # ADD ENTRY TO READY CHAIN #
      ADD$LNK(ADDR,LCHN"HL$ACTV",1);  # ADD ENTRY TO ACTIVE CHAIN #
 
 
      RETURN;
 
      END  # HLRQENQ #
 
    TERM
PROC HLRQMTR;
 
# TITLE HLRQMTR - HIGH LEVEL REQUEST QUEUE MONITOR.                   #
 
      BEGIN  # HLRQMTR #
 
#
**    HLRQMTR - HIGH LEVEL REQUEST QUEUE MONITOR.
*
*     THE HIGH LEVEL REQUEST QUEUE MONITOR CONTROLS THE ACTIVATION
*     OF *HLRQ* PROCESSORS.  EACH *HLRQ* ENTRY ON THE READY CHAIN IS
*     ACTIVATED BY CALLING THE APPROPRIATE PROCESSOR.
*
*     PROC HLRQMTR.
*
*     EXIT       IF THE PROCESS STATE FIELD OF AN *HLRQ* 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 *HLRQ* ENTRY TO BE
*                RELINKED INTO THE *HLRQ* READY CHAIN.
*
*     NOTES      *HLRQMTR* IS TO BE CALLED ONLY IF THE *HLRQ*
*                READY CHAIN IS POPULATED.
#
 
#
****  PROC HLRQMTR - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC ADD$LNK;                # ADD ENTRY TO END OF CHAIN #
        PROC DEL$LNK;                # DELETE ENTRY FROM CHAIN #
        PROC DESTAGR;                # DESTAGE A FILE #
        PROC STAGER;                 # STAGE A FILE #
        PROC ZFILL;                  # ZERO FILL BUFFER #
        END
 
#
****  PROC HLRQMTR - XREF LIST END.
#
 
      DEF LISTCON    #0#;            # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBCHN
*CALL COMXCTF
*CALL COMXHLR
*CALL COMXMSC
 
      ITEM FLNM       C(7);          # FILE NAME #
      ITEM HLRENT     U;             # *HLRQ* ENTRY ADDRESS #
 
 
      ITEM ACTIVE     I;             # NUMBER OF TIMES HLRQ LOOPED #
      ITEM PFMFIRST   B;             # *UGET/UREPLACE* ACTIVE #
 
      SWITCH HLPROC:HLRPN            # *HLRQ* PROCESSOR CALLS #
                HL1:STAGE,           # PROCESSOR 1 #
                HL2:DESTAGE,         # PROCESSOR 2 #
             ENDHLP:ENDPN;           # END *HLRQ* PROCESSOR CALLS #
                                               CONTROL EJECT;
 
#
*     TRAVERSE THE *HLRQ* READY CHAIN.
#
      IF CHN$BOC[LCHN"HL$PFMWAIT"] NQ 0
      THEN      # UGET OR UREPLACE COMPLETED #
        BEGIN
        HLRENT = CHN$BOC[LCHN"HL$PFMWAIT"];
        DEL$LNK(HLRENT,LCHN"HL$PFMWAIT",0);
        ADD$LNK(HLRENT,LCHN"HL$READY",0);
        PFMFIRST = TRUE;
        END
 
      ACTIVE = 0;
 
      FASTFOR DUMMY = 0 WHILE CHN$BOC[LCHN"HL$READY"] NQ 0
        AND ACTIVE LQ 20
        AND NOT GLPFMFL
      DO
        BEGIN  # TRAVERSE *HLRQ* READY CHAIN #
        ACTIVE = ACTIVE + 1;
        IF PFMFIRST
        THEN
          BEGIN     # TAKE CURRENT *HLRENT* #
          PFMFIRST = FALSE;
          END
 
        ELSE
          BEGIN    # FIND NEW ADDRESS #
          HLRENT = CHN$BOC[LCHN"HL$READY"];
          END
        DEL$LNK(HLRENT,LCHN"HL$READY",0);
        P<HLRQ> = HLRENT;
 
        IF HLR$HPS[0] EQ PROCST"COMPLETE"
        THEN
          BEGIN
          GOTO ENDHLP;
          END
 
#
*     SIMULATED CASE STATEMENT FOR *HLRQ* PROCESSOR CALLS.
#
 
        GOTO HLPROC[HLR$HPN[0]];
 
HL1:                                 # STAGE REQUEST #
        STAGER(HLRENT);
        GOTO ENDHLP;
 
HL2:                                 # DESTAGE REQUEST #
        DESTAGR(HLRENT);
        GOTO ENDHLP;
 
 
 
ENDHLP:
 
#
*     END OF SIMULATED CASE STATEMENT FOR *HLRQ* PROCESSOR CALLS.
#
 
        P<HLRQ> = HLRENT;
        IF HLR$HPS[0] EQ PROCST"COMPLETE"
        THEN
          BEGIN  # PROCESS IS COMPLETE #
 
#
*     CLEAR *HLRQ* ENTRY.
#
 
          DEL$LNK(HLRENT,LCHN"HL$ACTV",1);
          FLNM = HLR$FLNM[0];        # PRESERVE FILE NAME #
          ZFILL(HLRQ,HLRQLEN);
          HLR$FLNM[0] = FLNM;
          ADD$LNK(HLRENT,LCHN"HL$FRSPC",0);
          STG$MSK = 0;
          IF CHN$BOC[LCHN"HL$DRDRESW"] NQ 0
          THEN
            BEGIN
            HLRENT = CHN$BOC[LCHN"HL$DRDRESW"];
            DEL$LNK(HLRENT,LCHN"HL$DRDRESW",0);
            ADD$LNK(HLRENT,LCHN"HL$READY",0);
            END
 
          END  # PROCESS IS COMPLETE #
 
        END  # TRAVERSE *HLRQ* READY CHAIN #
 
      RETURN;
 
      END  # HLRQMTR #
 
    TERM
PROC MSGAFDF(TYPE,FC,CODE,HLRQADR);
 
# TITLE MSGAFDF - ISSUE STATUS MESSAGE TO ACCOUNT AND EXEC DAYFILE.   #
 
      BEGIN  # MSGAFDF #
 
#
**    MSGAFDF - ISSUE STATUS MESSAGE TO ACCOUNT AND EXEC-S DAYFILE.
*
*     *MSGAFDF* IS CALLED BY *STAGER*, *DESTAGR*, *HLLOAD*, AND
*     *HLUNLD* TO ISSUE STATUS MESSAGES NOTING BEGIN OR END
*     OF A STAGE OR DESTAGE OPERATION, OR INITIATION OF A CARTRIDGE
*     LOAD/UNLOAD.  AN APPROPRIATE MESSAGE IS CONSTRUCTED AND ISSUED
*     TO EITHER OR BOTH THE ACCOUNT AND JOB DAYFILE DEPENDING ON THE
*     CONTROLLING BIT MASKS AND THE *TM* RUN-TIME PARAMETER.
*
*     PROC MSGAFDF(TYPE,FC,CODE,HLRQADR)
*
*     ENTRY     (TYPE)    = MESSAGE TYPE.  "I", "B", "E", OR "S".
*               (FC)      = CODE FOR THE FUNCTION BEING PERFORMED.
*                          "LD", "UL", "BS", "ES", "BD", "ED".
*D250
*                       FC = *FC*   LD/UL/BS/ES/BD/ED.
*               (CODE)    = COMPLETION STATUS OF A STAGE OR DESTAGE.
*               (HLRQADR) = ADDRESS OF *HLRQ* ENTRY.
*
*     EXIT      THE APPROPRIATE MESSAGE IS ISSUED.
*
*     MESSAGES
*                T  FC  MESSAGE DETAIL.
*                       T  = *TYPE* = B/E/I.
*                       FC = *FC*   = DS/LD/ST/UL.
*
*                       MESSAGE DETAIL VARIES BY MESSAGE TYPE...
*
*                 SMFC, SM=X, CSN=CCCCCCCC, ID=ZZ.
*
*                       CCCCCCCC = CARTRIDGE SERIAL NUMBER.
*                       ZZ       = MANUFACTURES'S ID.
*
*
*                 SMFC, PPPPPPP/UUUUUU/FFFFFFF.
*
*                 SMFC, PPPPPPP/UUUUUU/LLLLLL-WW.
*
*                       PPPPPPP = PERMANENT FILE NAME.
*                       UUUUUU  = USER INDEX (OCTAL).
*                       FFFFFFF = FAMILY NAME.
*                       LLLLLL  = FILE LENGTH (DECIMAL).
*                       WW      = VALUE OF *CODE* (OCTAL).
#
 
#
****  PROC MSGAFDF - XREF LIST BEGIN.
#
 
      ITEM TYPE       C(1);          # MESSAGE TYPE #
      ITEM FC         C(2);          # FUNCTION BEING DONE #
      ITEM CODE       U;             # COMPLETION STATUS #
      ITEM HLRQADR    U;             # *HLRQ* ENTRY ADDRESS #
 
 
      XREF
        BEGIN
        FUNC XCDD C(10);             # BINARY TO DISPLAY (DECIMAL) #
        FUNC XCOD C(10);             # BINARY TO DISPLAY (OCTAL) #
        PROC BZFILL;                 # BLANK FILL A MESSAGE #
        PROC MESSAGE;                # ISSUE MESSAGE TO O/S #
        END
 
#
****  PROC MSGAFDF - XREF LIST END.
#
 
      DEF LISTCON   #0#;             # DO NOT LIST COMMON DECKS #
*CALL,COMBFAS
*CALL,COMBBZF
*CALL,COMBLRQ
*CALL,COMBTDM
*CALL,COMXHLR
*CALL,COMXJCA
*CALL,COMXMSC
 
 
      DEF SKELCART   #"SMFC, SM=X, CSN=CCCCCCCC, ID=ZZ." #;
      DEF SKELFILE   #"SMFC, PPPPPPP/UUUUUU/FFFFFFF." #;
      DEF SKELTAG    #"-WW." #;
 
      ITEM DOAF       U;             # CONTROL ACCOUNT FILE MESSAGE #
      ITEM DODF       U;             # CONTROL DAYFILE MESSAGE #
      ITEM OFFSET     U;             # BIT POSITION #
 
 
      ARRAY MSGS [0:0] S(4);
        BEGIN
 
#
*     BASIC MESSAGE FORMAT.
#
 
        ITEM MSGS$SKEL  C(00,00,38);  # TEXT #
        ITEM MSGS$SMA   C(00,00,02);  # *SM* #
        ITEM MSGS$FC    C(00,12,02);  # *FC* #
        ITEM MSGS$ZERO  U(03,48,12) = [0];  # TERMINATOR #
 
#
*     DETAIL FOR TYPE = "I".
#
 
        ITEM MSGS$SM    C(00,54,01);  # X #
        ITEM MSGS$CSN   C(01,36,08);  # CCCCCCCC #
        ITEM MSGS$ID    C(02,54,02);  # ZZ #
 
#
*     DETAIL FOR TYPE = "B" AND PART OF "E".
#
 
        ITEM MSGS$PFN   C(00,36,07);  # PPPPPPPP #
        ITEM MSGS$UI    C(01,24,06);  # UUUUUU #
        ITEM MSGS$FAM   C(02,06,07);  # FFFFFFF #
 
#
*     REST OF DETAIL FOR "E" TYPE MESSAGES.
#
 
        ITEM MSGS$LEN   C(02,06,06);  # LLLLLL #
        ITEM MSGS$TAG   C(02,42,04);  # "-WW." #
        ITEM MSGS$CODE  C(02,48,02);  # WW #
        END
 
                                               CONTROL EJECT;
      IF TYPE EQ "S"
      THEN
        BEGIN
        P<TDAM> = HLRQADR;
        TYPE = "E";
        END
 
      ELSE
        BEGIN
        P<HLRQ> = HLRQADR;
        P<TDAM> = LOC(HLR$TDAM[0]);
        P<LLRQ> = HLR$LRQADR[0];
        END
 
      DODF = 0;                      # DEFAULT IS NOT TO ISSUE MESSAGE
                                     #
 
      IF TYPE EQ "I"
      THEN                           # CARTRIDGE MESSAGE #
        BEGIN
        DOAF = B<59,1>MSG$AF$CTL[0];
        MSGS$SKEL[0] = SKELCART;
        MSGS$SM[0] = HLR$SM[0];
        IF FC EQ "LD"
        THEN
          BEGIN
          MSGS$CSN[0] = HLR$CSND[0];
          MSGS$ID[0] = HLR$CCOD[0];
          END
 
        ELSE
          BEGIN
          MSGS$CSN[0] = LLR$CSND[0];
          MSGS$ID[0] = LLR$CCOD[0];
          END
 
        END
 
      ELSE                           # FILE MESSAGE #
        BEGIN
        MSGS$SKEL[0] = SKELFILE;
        MSGS$PFN[0] = TDAMPFN[0];
        CH$10[0] = XCOD(O"1000000" + TDAMUI[0]);
        MSGS$UI[0] = CH$06[0];
 
        IF TYPE EQ "B"
        THEN                         # INSERT FAMILY NAME #
          BEGIN
          MSGS$FAM[0] = TDAMFAM[0];
          DOAF = B<58,1>MSG$AF$CTL[0];
          END
 
        ELSE                         # ADD LENGTH AND TAG #
          BEGIN
          CH$10[0] = XCDD(TDAMFLN[0]);
          MSGS$LEN[0] = CH$06[0];
          DOAF = B<57,1>MSG$AF$CTL[0];
 
          MSGS$TAG[0] = SKELTAG;
          CH$10[0] = XCOD(O"100" + CODE);
          MSGS$CODE[0] = CH$02[0];
          IF FC EQ "BS" OR FC EQ "ES"
          THEN
            BEGIN
            OFFSET = 59;
            END
 
          ELSE
            BEGIN
            OFFSET = 29;
            END
 
          DODF = B<OFFSET-CODE,1>MSG$DF$CTL[0];
          B<OFFSET-CODE,1>MSG$ACT[0] = 1;
 
          END
 
        END
 
      MSGS$FC[0] = FC;
 
      BZFILL(MSGS,TYPFILL"BFILL",38);
 
 
      IF (DOAF NQ 0) AND RA$TRACE[0]
      THEN
        BEGIN
        MESSAGE(MSGS[0],ACTDF);
        END
 
      IF DODF NQ 0
      THEN
        BEGIN
        MSGS$SMA[0] = "  ";
        MESSAGE(MSGS[0],UDFL1);
        END
 
      END  # MSGAFDF #
 
    TERM
PROC PFMEC((ERRSTAT),ACTION);
 
# TITLE PFMEC - CONVERT *PFM* ERROR CODES.                            #
 
      BEGIN  # PFMEC #
 
#
**    PFMEC - CONVERT *PFM* ERROR CODES.
*
*     *PFMEC* CONVERTS AN ERROR CODE RETURNED FROM *PFM* TO AN ERROR
*     ACTION CODE.  THIS ACTION CODE REPRESENTS WHAT TYPE OF ACTION
*     EXEC SHOULD TAKE WHEN PROCESSING THE ERROR.
*
*     PROC PFMEC((ERRSTAT),ACTION)
*
*     ENTRY      (ERRSTAT) - *PFM* ERROR CODE.
*
*     EXIT       (ACTION) - ERROR ACTION.
*                           (VALUES DEFINED IN *COMXMSC*)
*                           = ERRST"NOERR".
*                           = ERRST"WAIT".
*                           = ERRST"FATAL".
*                           = ERRST"ABANDON".
*                           = ERRST"SPECIAL".
#
 
      ITEM ERRSTAT    I;             # *PFM* ERROR CODE #
      ITEM ACTION     I;             # ERROR ACTION #
 
      DEF LISTCON #0#;               # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMXMSC
*CALL COMSPFM
                                               CONTROL EJECT;
 
      IF ERRSTAT EQ PFA OR ERRSTAT EQ FIN OR ERRSTAT EQ INA  ##
        OR ERRSTAT EQ FTF OR ERRSTAT EQ PEA
      THEN                           # DELAY CONDITION #
        BEGIN
        ACTION = ERRST"WAIT";
        RETURN;
        END
 
      IF ERRSTAT EQ FBS OR ERRSTAT EQ FDA  ##
        OR ERRSTAT EQ DTE OR ERRSTAT EQ IOE OR ERRSTAT EQ PRL  ##
        OR ERRSTAT EQ DAF OR ERRSTAT EQ MSE OR ERRSTAT EQ EDA  ##
        OR ERRSTAT EQ EPT OR ERRSTAT EQ EDP                    ##
        OR ERRSTAT EQ FLC OR ERRSTAT EQ NEM OR ERRSTAT EQ FSE  ##
        OR ERRSTAT EQ AIO OR ERRSTAT EQ ICU ##
        OR ERRSTAT EQ FIA OR ERRSTAT EQ PVE OR ERRSTAT EQ FND
      THEN                           # ABANDON CONDITION #
        BEGIN
        ACTION = ERRST"ABANDON";
        RETURN;
        END
 
      IF ERRSTAT EQ SPN OR ERRSTAT EQ TKL
      THEN                           # SPECIAL CONDITION #
        BEGIN
        ACTION = ERRST"SPECIAL";
        RETURN;
        END
 
      ACTION = ERRST"FATAL";         # FATAL CONDITION #
      RETURN;
      END  # PFMEC #
 
    TERM
PROC TRACMSG((TDAMADR),(ACTV));
 
# TITLE TRACMSG - ISSUE TRACE MESSAGE.                                #
 
      BEGIN  # TRACMSG #
 
#
**    TRACMSG - ISSUE TRACE MESSAGE.
*
*     *TRACMSG* ISSUES MESSAGES TO THE ACCOUNT DAYFILE FOR *STAGER*
*     AND *DESTAGR* PROVIDING INFORMATION ON THE FILE STAGE AND
*     DESTAGE REQUESTS BEING PROCESSED.
*
*     PROC TRACMSG((TDAMADR),(ACTV))
*
*     ENTRY      (TRACMSG) - ADDRESS OF *TDAM* REQUEST BLOCK CONTAINING
*                            FILE NAME AND FILE LENGTH.
*                (ACTV) - 2 CHARACTER ACTIVITY CODE.
*
*     MESSAGES   *STD1, FFFFFFF.*
*                *STD2, FFFFFFF.*
*                *STD3, FFFFFFF.*
*                *STD4, FFFFFFF, LLLLLL.*
*                *STD5, FFFFFFF.*
*                *STS2, FFFFFFF.*
*                *STS3, FFFFFFF.*
*                *STS4, FFFFFFF, LLLLLL.*
*                *STS5, FFFFFFF.*
*                *STS6, FFFFFFF.*
*
*     NOTES      *ACTV* IS A 2 CHARACTER CODE IDENTIFYING THE ACTIVITY
*                WHICH OCCURED.  THE FIRST CHARACTER IS *S* FOR STAGE
*                REQUESTS AND *D* FOR DESTAGE REQUESTS.  THE SECOND
*                CHARACTER REPRESENTS THE ACTION AS FOLLOWS:
*                  *1* - FILE ATTACHED FOR DESTAGE (UNDEFINED FOR
*                        STAGE).
*                  *2* - CARTRIDGE LOADED.
*                  *3* - COPY TO BE INITIATED.
*                  *4* - COPY COMPLETE.
*                  *5* - *PFC* HAS BEEN UPDATED.
*                  *6* - COPY FROM FIRST CARTRIDGE COMPLETE FOR A
*                        MULTICARTRIDGE FILE (UNDEFINED FOR DESTAGE).
#
 
      ITEM TDAMADR    U;             # ADDRESS OF *TDAM* REQUEST BLOCK
                                     #
      ITEM ACTV       C(2);          # ACTIVITY RECORDED #
 
#
****  PROC TRACMSG - XREF LIST BEGIN.
#
 
      XREF
        BEGIN
        PROC BZFILL;                 # BLANK OR ZERO FILL ITEM #
        PROC MSG;                    # ISSUE MESSAGE #
        PROC RMVBLNK;                # REMOVE EXCESS BLANKS #
        FUNC XCDD C(10);             # CONVERT DECIMAL TO DISPLAY #
        END
 
#
****  PROC TRACMSG - XREF LIST END.
#
 
      DEF LISTCON #0#;               # DO NOT LIST COMDECKS #
*CALL COMBFAS
*CALL COMBBZF
*CALL COMBTDM
*CALL COMXACM
*CALL COMXJCA
 
      ITEM FLEN       C(10);         # DISPLAY CODED FILE LENGTH #
      ITEM FLNM       C(7);          # FILE NAME #
                                               CONTROL EJECT;
      IF NOT RA$TRACE[0]
      THEN                           # TRACE MODE NOT SELECTED #
        BEGIN
        RETURN;
        END
 
      P<TDAM> = TDAMADR;
      IF ACTV EQ "S4" OR ACTV EQ "D4"
      THEN                           # INCLUDE FILE LENGTH IN MESSAGE #
        BEGIN
        ACCMMES[0] = ACCMSG4;
        FLEN = XCDD(TDAMFLN[0]);
        ACCMFLEN[0] = C<4,6>FLEN;
        END
 
      ELSE
        BEGIN
        ACCMMES[0] = ACCMSG3;
        END
 
      FLNM = TDAMPFN[0];
      BZFILL(FLNM,TYPFILL"BFILL",7);
      ACCMPFN[0] = FLNM;
      ACCMACTV[0] = ACTV;
      RMVBLNK(ACCMSG[0],40);
      MSG(ACCMSG[0],ACTDF);
 
      RETURN;
      END  # TRACMSG #
 
    TERM