Retro1.org codex

*DECK     CSESCS
USETEXT TEXTOV
USETEXT TEXTCS
USETEXT TEXTSS
USETEXT TXTAPSS 
USETEXT TXTSMCS 
      PROC CSESCS;
# TITLE - SEND COUPLER STATUS.                                         #
      BEGIN 
# 
**    CSESCS - SEND COUPLER STATUS. 
* 
*     D.K. ENDO    82/03/29 
* 
*     THE PROCEDURE FORMATS THE COUPLER STATUS MESSAGE TEXT SENT WHEN A 
*     STU/CP/U OR STU/CP/N IS RECEIVED. 
* 
*     PROC CSESCS 
* 
*     ENTRY        1. STU/CP/U OR STU/CP/N SM FROM THE EVENT QUEUE. 
* 
*     EXIT         1. ENTRY IN OPERATOR RESPONSE QUEUE WITH THE STATUS
*                     TEXT AND THE AUDIENCE GROUP SET TO ONE. 
*                  2. ENTRY IN C-LAYER QUEUE WITH THE STATUS TEXT.
* 
# 
# 
****  PROC CSESCS - XREF LIST BEGINS. 
# 
      XREF
        BEGIN 
        PROC CSESLE;         # SEND LOG (FILE) ENTRY                   #
        PROC SSBSBF;         # STORE BIT FIELD                         #
        PROC SSTAQE;         # ADD QUEUE ENTRY                         #
        FUNC XCDD U;         # CONVERT DECIMAL INTEGER TO DISPLAY CODE #
        END 
# 
****
# 
      DEF CPS$TXTL # 50 #;   # CHAR COUNT OF COUPLER STATUS TEXT       #
      DEF HNP$TXTL # 30 #;   # CHAR COUNT OF -HIP NOT PRESENT- TEXT    #
      ITEM CNST1;            # CONSTANT ---> 1                         #
      ITEM CNST2;            # CONSTANT ---> 2                         #
      ITEM CNST3;            # CONSTANT ---> 3                         #
      ITEM I;                # LOOP INDUCTION VARIABLE                 #
      ITEM ITEMP U;          # UNSIGNED INTEGER TEMPORARY              #
      ITEM J;                # LOOP INDUCTION VARIABLE                 #
# 
      THIS ARRAY DEFINES THE COUPLER STATUS TEXT THAT IS SENT WHEN A
      STU/CP/U OR STU/CP/N IS RECEIVED. 
# 
      ARRAY CPS$TXT [00:04] S(1); 
        BEGIN 
        ITEM CPS$TIM    C(00,00,10);
        ITEM CPS$COUP   C(01,00,08) = ["CPLER: "];
        ITEM CPS$CNM    C(01,42,07);
        ITEM CPS$C1     C(02,24,01) = [","];
        ITEM CPS$ST     C(02,30,02);
        ITEM CPS$C2     C(02,42,01) = [","];
        ITEM CPS$CNID   C(02,48,03);
        ITEM CPS$C3     C(03,06,01) = [","];
        ITEM CPS$NNM    C(03,12,07);
        ITEM CPS$C4     C(03,54,01) = ["/"];
        ITEM CPS$CNUM   C(04,00,03);
        ITEM CPS$ZBYT   U(04,18,42) = [ 0 ];
        END 
# 
      THIS ARRAY DEFINES NOT -HIP NOT PRESENT- TEXT AND IS SENT WHEN A
      STU/CP/U IS RECEIVED WITH THE REASON CODE FIELD SET TO EIGHT. 
# 
      ARRAY HNP$TXT [00:00] S(3); 
        BEGIN 
        ITEM HNP$TIM    C(00,00,10) = [" "];
        ITEM HNP$MSG    C(01,00,16) = [" HIP NOT PRESENT"]; 
        ITEM HNP$ZBYT   U(02,36,24) = [ 0 ];
        END 
# 
      THIS ARRAY DEFINES ALL THE POSSIBLE STATUS A COUPLER CAN HAVE 
# 
      DEF MX$ST # 5 #;
      ARRAY ST$TABLE [01:MX$ST] S(1); 
        BEGIN 
        ITEM ST$VAL     C(00,00,02) = ["NC",
                                       "DI",
                                       "DN",
                                       "EN",
                                       "AC",
                                      ];
        END 
# 
      THIS ARRAY DEFINES THE NAME USED WHEN THE NAME OF THE COUPLER OR
      SUPPORTING NPU IS NOT FOUND.
# 
      ARRAY UNK$TXT [00:00] S(1); 
        BEGIN 
        ITEM UNK$NAME   C(00,18,07) = ["UNKNOWN"];
        END 
      CONTROL EJECT;
#                                                                      #
#                            CSESCS CODE BEGINS HERE                   #
#                                                                      #
# 
*     SEARCH THE PHYSICAL LINK XREF TABLE FOR THIS COUPLER.  IF IT IS 
*     FOUND, THEN INSERT THE COUPLER NUMBER AND NAME INTO THE STATUS
*     TEXT, FIND THE NPUCB OF THE NPU THAT SUPPORTS THIS COUPLER AND
*     IF FOUND THEN INSERT THE NPU NAME INTO THE TEXT, OTHERWISE INSERT 
*     -UNKNOWN- FOR THE NPU NAME.  IF THE COUPLER IS NOT FOUND IN THE 
*     PHYSICAL LINK XREF TABLE, THEN INSERT -UNKNOWN- FOR THE NAMES AND 
*     CLEAR THE COUPLER NUMBER VALUE.  INSERT THE COUPLER NODE I.D. AND 
*     STATUS FOR THE COUPLER. 
# 
      FOR I=0 STEP 1 WHILE STUN1[0] NQ PLX$HNID[I] AND
                           I LS PLXREFL/2 AND 
                           NOT PLX$TYPE[I]
      DO
        BEGIN 
        END 
      IF I LS PLXREFL/2 
      THEN
        BEGIN 
        CNST1 = 1;
        CNST2 = 42; 
        SSBSBF(CPS$TXT,CNST1,CNST2,CNST2,B<0,42>PLX$WORD[I]); 
        IF PLX$CPRI[I]
        THEN
          BEGIN 
          CPS$CNUM[0] = "SEC";
          END 
        ELSE
          BEGIN 
          CPS$CNUM[0] = "PRI";
          END 
        FOR J=0 STEP 1 WHILE PLX$CNPU[I] NQ NPU$NID[J] AND
                             J LS CSNPCNT 
        DO
          BEGIN 
          END 
        IF J LS CSNPCNT 
        THEN
          BEGIN 
          CPS$NNM[0] = NPU$NAME[J]; 
          END 
        ELSE
          BEGIN 
          CPS$NNM[0] = UNK$NAME[0]; 
          END 
        END 
      ELSE
        BEGIN 
        CNST1 = 1;
        CNST2 = 42; 
        SSBSBF(CPS$TXT,CNST1,CNST2,CNST2,UNK$TXT);
        CPS$NNM[0] = UNK$NAME[0]; 
        CPS$CNUM[0] = " ";
        END 
      CPS$ST[0] = ST$VAL[STUST[0]]; 
      ITEMP = XCDD(1000 + STUN1[0]);
      CNST1 = 2;
      CNST2 = 48; 
      CNST3 = 18; 
      SSBSBF(CPS$TXT,CNST1,CNST2,CNST3,ITEMP);
# 
*     IF THIS SM IS STU/CP/U, THEN INSERT CURRENT TIME IN STATUS TEXT.
*     SEND THE TEXT OFF TO THE OPERATOR RESPONSE QUEUE WITH THE AUDIENCE
*     GROUP SET TO ONE, IF THE REASON CODE FIELD IS NON-ZERO THEN APPEND
*     THE CURRENT TIME TO THE -HIP NOT PRESENT- MESSAGE TEXT AND SEND IT
*     TO THE OPERATOR RESPONSE RESPONSE QUEUE WITH AN AUDIENCE GROUP OF 
*     ONE.
# 
      IF WCB$SMID[0] EQ SMID"STUCP" 
      THEN
        BEGIN 
        CPS$TIM[0] = CTM$CLOCK[0];
        WCB$WORD[1] = 0;
        WCB$WC[1] = 2 + (CPS$TXTL / 10);
        ABHWORD[1] = CPS$TXTL;
        ABHADR[1] = AUDGR3$;
        ABHABN[1] = J;
        SSTAQE(P<ORQ>,WCBUF[1],ABH[1],CPS$TXT[0]);
        CSESLE(ABHSN[0],WCBUF[1],CPS$TXT);
        IF STURC[0] NQ 0
        THEN
          BEGIN 
          WCB$WC[1] = 2 + (HNP$TXTL / 10);
          ABHTLC[1] = HNP$TXTL; 
          SSTAQE(P<ORQ>,WCBUF[1],ABH[1],HNP$TXT[0]);
          CSESLE(ABHSN[0],WCBUF[1],HNP$TXT);
          END 
        END 
# 
*     IF THIS SM IS STU/CP/N, THEN SEND THE STATUS TEXT TO THE OPERATOR 
*     VIA THE C-LAYER WITH THE INPUT ALLOWED FLAG CLEARED.
# 
      ELSE                   # IF NOT STU/CP/U, THEN ASSUME STU/CP/N.  #
        BEGIN 
        WCB$WORD[1] = 0;
        WCB$SMID[1] = SMID"TTEXT";
        WCB$WC[1] = 2 + (CPS$TXTL / 10) - 1;
        ABHWORD[1] = 0; 
        ABHADR[1] = ABHCN[0]; 
        ABHTLC[1] = CPS$TXTL - 10;
        SSTAQE(P<CNQ>,WCBUF[1],ABH[1],CPS$TXT[1]);
        END 
      RETURN;                # **** RETURN ****                        #
      END # CSESCS #
      TERM