Retro1.org codex

*DECK CSSAAC
USETEXT  TEXTCS 
USETEXT  TEXTSS 
USETEXT  TXTAPSS
USETEXT  TXCMDCS
      PROC CSSAAC;
# TITLE CSSAAC - ACTION ALERT COMMAND. #
 
      BEGIN    # CSSAAC # 
# 
**    CSSAAC - ACTION ALERT COMMAND.
* 
*     A. LIM    83/02/25
* 
*     THIS PROCEDURE ACTIONS THE ALERT COMMAND FROM THE HOP OR
*     THE CONTROLLING NOP.
* 
*     PROC CSSAAC 
* 
*     ENTRY:  
*       1.  HDRCMD[0] = COMMAND HEADER WORD.
*       2.  PARMS[0]  = COMMAND BLOCK CONTAINING THE ORIGINAL 
*                       TYPEIN, SYNTAX PARAMETER LIST AND ADDRESS.
* 
*     EXIT: 
*       1.  THE *CP* AND/OR *BU* VALUE(S) IN NPUCB(S) GOT UPDATED.
* 
*     NOTE: 
*       THE ALERT COMMAND MAY CONTAIN:  
*         1.  NO *CP* AND *BU*, 
*         2.  EITHER *CP* OR *BU*, OR 
*         3.  BOTH *CP* AND *BU*. 
* 
* 
# 
 
 
# 
****  PROC CSSAAC XREF LIST 
# 
 
      XREF
        BEGIN 
        PROC CSUCDB;                   # CONVERT DC DECIMAL TO BINARY  #
        PROC SSTAQE;                   # SS- ACCEPT A QUEUE ENTRY      #
        END 
 
# 
****
# 
 
 
 
 
 
      ITEM CPVALUE    B;               # SET IF VALID CP VALUE ENTERED #
      ITEM BUVALUE    B;               # SET IF VALID BU VALUE ENTERED #
      ITEM FPINDX     U;               # FIRST INDEX INTO SYNTAX PARM  #
      ITEM LPINDX     U;               # LAST INDEX INTO SYNTAX PARM   #
      ITEM B          U;               # TEMP FOR BINARY VALUE (CSUCDB)#
      ITEM D          U;               # TEMP FOR DECIM VALUE (CSUCDB) #
      ITEM ERROR      B;               # ERROR INDICATOR (CSUCDB)      #
      ITEM CP         U;               # CPU UTILIZATION VALUE         #
      ITEM BU         U;               # BUFFER AVAILABILITY VALUE     #
      ITEM NPUS       B;               # ALERT ALL NPUS INDICATOR      #
      ITEM DONE       B;               # LOOP EXIT VAR                 #
      ITEM I          U;               # LOOP INDICATION VAR           #
      ITEM NPUORD     U;               # NPUCB ORDINAL                 #
 
 
# 
*     IVPBUF - INVALID PARAMETER BUFFER.
# 
      ARRAY IVPBUF[00:00] S(3); 
        BEGIN 
        ITEM IVP$MSG    C(00,00,24) = 
                        ["INVALID PARAMETER VALUE."]; 
        ITEM IVP$ZRO    U(02,24,36) = [0];
        END 
 
 
 
 
 
CONTROL EJECT;
# 
*     INITIALIZE BUFFERS, INDICES, VARIABLES AND FLAGS. 
# 
 
      ABHWORD[1] = 0; 
      WCB$WORD[1] = 0;
 
      FPINDX = HDR$TXWCNT[0] + 2; 
      LPINDX = HDR$TXWCNT[0] + HDR$SPCNT[0] - 1;
 
      CPVALUE = FALSE;
      BUVALUE = FALSE;
 
      NPUS = TRUE;
      ERROR = FALSE;
      DONE = FALSE; 
 
# 
*     SEARCH THE PARAMETER LIST FOR *CP* AND *BU* VALUES. 
*     CONVERT THE VALUES TO BINARY. 
*     DETERMINE IF ALERT WERE FOR ALL NPUS OR JUST A SINGLE NPU.
# 
 
      FOR I = FPINDX STEP 1 WHILE (I LQ LPINDX) AND (NOT ERROR) 
      DO
        BEGIN 
        IF PAR$PCODE[I] EQ "CP1"
        THEN
          BEGIN                        # CP VALUE SPECIFIED            #
          CSUCDB(PAR$ELNAME[I],B,D,ERROR);
          IF     (NOT ERROR)
             AND ((B GQ MINCP$) AND (B LQ MAXCP$))
          THEN
            BEGIN                      # NO ERROR, AND VALUE IN RANGE  #
            CP = B; 
            CPVALUE = TRUE; 
            END 
          ELSE
            BEGIN                      # ERR IN VALUE, OR NOT IN RANGE #
            ERROR = TRUE; 
            END 
          END 
        ELSE IF PAR$PCODE[I] EQ "BU0" 
        THEN
          BEGIN                        # BU VALUE SPECIFIED            #
          CSUCDB(PAR$ELNAME[I],B,D,ERROR);
          IF     (NOT ERROR)
             AND ((B GQ MINBU$) AND (B LQ MAXBU$))
          THEN
            BEGIN 
            BU = B; 
            BUVALUE = TRUE; 
            END 
          ELSE
            BEGIN 
            ERROR = TRUE; 
            END 
          END 
        ELSE IF PAR$PCODE[I] EQ "NP0" 
        THEN
          BEGIN                        # ALERT FOR A SINGLE NPU        #
          NPUS = FALSE; 
          NPUORD = PAR$ORD[LPINDX+1];  # SAVE NPU ORDINAL              #
          END 
        END 
 
      IF     (NOT ERROR)
         AND (CPVALUE OR BUVALUE) 
      THEN                        # NO ERROR                           #
        BEGIN                     #   AND ONE OR MORE VALUES SPECIFIED #
        IF NPUS 
        THEN
          BEGIN                        # ALERT ALL NPUS                #
          NPUORD = 0; 
          END 
        FOR I = NPUORD STEP 1 WHILE     (NOT DONE)
                                    AND (I LS CSNPCNT)
 
        DO
          BEGIN 
          IF CPVALUE
          THEN
            NPU$CP[I] = CP; 
          IF BUVALUE
          THEN
            NPU$BU[I] = BU; 
          IF NOT NPUS 
          THEN
            DONE = TRUE;
          END 
        END 
      ELSE IF ERROR                    # ERROR IN SPECIFIED VALUE      #
      THEN
        BEGIN 
        ABHADR[1] = HDR$OPORD[0]; 
        WCB$SMID[1] = SMID"TTEXT";
        WCB$WC[1] = 3 + 2;
        SSTAQE(P<CNQ>, WCBUF[1], ABH[1], IVPBUF[0]);
        END 
 
# 
*     SEND A NULL TERMINAL TEXT TO C-LAYER TO CLEAR THE PIPELINE. 
# 
 
      ABHWORD[1] = 0; 
      WCB$WORD[1] = 0;
 
      ABHADR[1] = HDR$OPORD[0]; 
      WCB$SMID[1] = SMID"TTEXT";
      WCB$WC[1] = 2;
      WCB$IAF[1] = TRUE;
      SSTAQE(P<CNQ>, WCBUF[1], ABH[1], MSGBUF[0]);
 
      END    # CSSAAC # 
 
TERM