Retro1.org codex

*DECK     CSESVC
USETEXT TEXTCS
USETEXT TEXTSS
USETEXT TXTAPSS 
USETEXT TXTSMCS 
      PROC CSESVC;
# TITLE - SEND ARCHETYPE SVC STATUS                                    #
      BEGIN 
# 
**    CSESVC - SEND ARCHETYPE SVC STATUS
* 
*     A. L. TURKE   84/01/01
* 
*     THIS PROCEDURE FORMATS THE ARCHETYPE SVC STATUS TEXT
*     FROM THE INCOMING SM, AND SENDS IT OUT. 
* 
*     PROC CSESVC 
* 
*     ENTRY        1. STU/VC/U, OR STU/VC/N SM. 
* 
*     EXIT         1. ENTRY IN CONNECTION QUEUE WITH STATUS TEXT. 
*                  2. ENTRY IN OPERATOR QUEUE WITH STATUS TEXT. 
* 
# 
# 
****  PROC CSESVC - XREF LIST BEGINS. 
# 
      XREF
        BEGIN 
        PROC CSESLE;         # SEND LOG (FILE) ENTRY                   #
        PROC SSBSBF;         # STORE BIT FIELD                         #
        FUNC SSDCAD U;       # CONVERT ASCII TO DISPLAY CODE CHAR      #
        PROC SSTAQE;         # ADD QUEUE ENTRY                         #
        FUNC XCDD C(10);     # CONVERT DECIMAL INTEGER TO DISPLAY      #
        END 
# 
****
# 
      DEF SVC$TXTL # 50 #;   # CHAR COUNT OF STATUS MESSAGE TEXT       #
      DEF UNA$TXTL # 50 #;   # CHAR COUNT OF SVC UNACTIONED CMD TEXT   #
      DEF UNC$TXTL # 40 #;   # CHAR COUNT OF UNACTIONED CMD TEXT       #
 
 
      ITEM CNST1;            # CONSTANT ---> 1                         #
      ITEM CNST2;            # CONSTANT ---> 2                         #
      ITEM CNST3;            # CONSTANT ---> 3                         #
      ITEM I;                # LOOP INDUCTION VARIABLE                 #
# 
      THIS ARRAY DEFINES THE BUFFER WHERE THE NAME OF THE CURRENT 
      DEVICE IS SAVED.
# 
      ARRAY CRNT$SVC [00:00] S(1);
        BEGIN 
        ITEM CRNT$VCN   C(00,30,05);
        END 
# 
      THIS ARRAY IS USED AS A TEMPORARY STORAGE AREA FOR CHARACTER
      STRINGS TO BE PLACED IN THE TEXT CURRENTLY BEING BUILT
# 
      ARRAY CTEMP$WORD [00:00] S(1);
        BEGIN 
        ITEM CTEMP      C(00,00,10);
        ITEM UTEMP      U(00,30,30);
        ITEM CTEMP1     C(00,54,01);
        ITEM CTEMP2     C(00,48,02);
        ITEM CTEMP3     C(00,42,03);
        ITEM CTEMP5     C(00,30,05);
        END 
# 
      THIS TABLE CONTAINS THE POSSIBLE SUBTIP TYPES THAT THE
      NUMERIC VALUE WILL MAP INTO.
# 
      DEF MX$STIP # 7 #;
      ARRAY STIP$TBL [00:MX$STIP] S(1); 
        BEGIN 
        ITEM STIP$VAL   C(00,00,05) = ["UNDEF", 
                                       "PAD  ", 
                                       "ITML ", 
                                       "APPL ", 
                                       "1CDC ", 
                                       "2CDC ", 
                                       "1USR ", 
                                       "2USR "
                                      ];
        END 
# 
      THIS ARRAY DEFINES THE TEXT OF THE ARCHETYPE SVC STATUS 
      MESSAGE FORMATTED BY THIS PROC. 
# 
      ARRAY SVC$TXT [00:04] S(1); 
        BEGIN 
        ITEM SVC$TIM    C(00,00,10);
        ITEM SVC$SVC    C(01,00,05) = ["SVC: "];
        ITEM SVC$VCN    C(01,30,05);
        ITEM SVC$EN     C(02,00,04) = [",EN="]; 
        ITEM SVC$ENN    C(02,24,03);
        ITEM SVC$DI     C(02,42,04) = [",DI="]; 
        ITEM SVC$DIN    C(03,06,03);
        ITEM SVC$AC     C(03,24,04) = [",AC="]; 
        ITEM SVC$ACN    C(03,48,03);
        ITEM SVC$COM    C(04,06,02) = [", "]; 
        ITEM SVC$STIP   C(04,18,05);
        ITEM SVC$ZBYT   U(04,48,12) = [ 0 ];
        END 
# 
      THIS ARRAY DEFINES THE -SVC UNACTIONED COMMAND- MESSAGE 
      TEXT THAT IS SENT OUT WHEN A STU/VC/U HAS A REASON CODE 
      OF TEM(DUE AN ARCHETYPE SVC NOT CONFIGURED).
# 
      ARRAY UNA$TXT [00:00] S(5); 
        BEGIN 
        ITEM UNA$TIM    C(00,00,10) = [" "];
        ITEM UNA$SVC    C(01,00,05) = ["SVC: "];
        ITEM UNA$VCN    C(01,30,05);
        ITEM UNA$MSG    C(02,00,20) = [", UNACTIONED COMMAND"]; 
        ITEM UNA$ZBYT   U(04,00,60) = [ 0 ];
        END 
# 
      THIS ARRAY DEFINES THE -UNACTIONED COMMAND- MESSAGE TEXT
      THAT IS SENT WHEN A STU/VC/U HAS A REASON CODE OF NINE
      (AN EXPLANATORY ARCHETYE SVC STATUS LINE FOLLOWS).
# 
      ARRAY UNC$TXT [00:00] S(4); 
        BEGIN 
        ITEM UNC$TIM    C(00,00,10) = [" "];
        ITEM UNC$MSG    C(01,00,19) = [" UNACTIONED COMMAND"];
        ITEM UNC$ZBYT1  U(02,54,06) = [ 0 ];
        ITEM UNC$ZBYT2  U(03,00,60) = [ 0 ];
        END 
      CONTROL EJECT;
#                                                                      #
#                            CSESVC CODE BEGINS HERE                   #
#                                                                      #
# 
*     BEGIN CONSTRUCTING THE LINE IMAGE FOR THE ARCHETYPE SVC 
*     STATUS.  CONVERT THE ASCII ARCHETYPE SVC NAME TO DISPLAY
*     CODE AND PLACE IT IN THE TEXT.  CONVERT THE ES(NO. OF ENABLED 
*     SVCS), DS(NO. OF DISABLED SVCS), AS(NO. OF ACTIVE SVCS), AND
*     STIP FIELDS TO DISPLAY CODE AND INSERT THEM INTO THE TEXT.
# 
 
 
      ABHWORD[1] = 0;        # INITIALIZE ABH                          #
      FOR I = 0 STEP 1 UNTIL 4
      DO
        BEGIN 
        B<I*6,6>UTEMP[0] = SSDCAD(B<I*8,8>STUAN[0]);
        END 
      SVC$VCN[0] = CTEMP5[0];  # STORE ARCHETYPE SVC NAME              #
      CRNT$VCN[0] = CTEMP5[0];  # SAVE ARCHETYPE SVC NAME TEMPORARILY  #
      CTEMP[0] = XCDD(1000 + STUES[0]);  # CAUSES LEADING ZEROES       #
      SVC$ENN[0] = CTEMP3[0];  # STORE NO. OF ENABLED SVCS             #
 
      CTEMP[0] = XCDD(1000 + STUDS[0]);  # CAUSES LEADING ZEROES       #
      SVC$DIN[0] = CTEMP3[0];  # STORE NO. OF DISABLED SVCS            #
 
      CTEMP [0] = XCDD(1000 + STUAS[0]);  # CAUSES LEADING ZEROES      #
      CNST1 = 3;             # WORD ORDINAL OF BITFIELD                #
      CNST2 = 48;            # STARTING BIT POSITION                   #
      CNST3 = 18;            # NO. OF BITS TO STORE                    #
      SSBSBF(SVC$TXT,CNST1,CNST2,CNST3,CTEMP$WORD);  # STORE BITFIELD  #
 
      SVC$STIP[0] = STIP$VAL[STUSTP[0]];  # STORE SUBTIP TYPE          #
 
 
# 
*     IF THIS SM IS STU/VC/U, GET THE CURRENT TIME AND APPEND IT
*     TO THE BEGINNING OF THE STATUS TEXT.  IF THE REASON CODE
*     INDICATES NOT CONFIGURED, THEN SEND THE -SVC UNACTIONED 
*     COMMAND- TEXT TO THE OPERATOR REPONSE QUEUE WITH AN 
*     AUDIENCE GROUP OF ONE.  IF THE REASON CODE INDICATES CCP
*     COULD NOT ENABLE/DISABLE ARCHETYPE SVCS, THEN SEND THE
*     -UNACTIONED COMMMAND- TEXT FOLLOWED BY AN EXPLANATORY 
*     ARCHETYPE SVC STATUS LINE.
# 
      IF WCB$SMID[0] EQ SMID"STUVC" 
      THEN
        BEGIN 
        WCB$WORD[1] = 0;
        ABHADR[1] = AUDGR3$;
        FOR I = 0 STEP 1 WHILE NPU$NID[I] NQ ABHSN[0] AND 
                               I LS CSNPCNT 
        DO
          BEGIN 
          END 
        ABHABN[1] = I;
 
        IF STURCV[0] EQ RRCV"SNC"  # REASON CODE = 10                  #
        THEN
          BEGIN 
          UNA$TIM[0] = CTM$CLOCK[0];  # STORE CURRENT TIME             #
          UNA$VCN[0] = CRNT$VCN[0];  # STORE ARCHETYPE SVC NAME        #
          WCB$WC[1] = 2 + (UNA$TXTL / 10);  # WORD LENGTH OF TEXT      #
          ABHTLC[1] = UNA$TXTL;   # WORD LENGTH OF TEXT                #
          SSTAQE(P<ORQ>,WCBUF[1],ABH[1],UNA$TXT[0]);
          CSESLE(ABHSN[0],WCBUF[1],UNA$TXT);
          END 
        ELSE
          BEGIN 
          IF STURCV[0] EQ RRCV"NED"  # REASON CODE = 9                 #
          THEN
            BEGIN 
            UNC$TIM[0] = CTM$CLOCK[0];  # STORE CURRENT TIME           #
            WCB$WC[1] = 2 + (UNC$TXTL / 10);  # WORD LENGTH OF TEXT    #
            ABHTLC[1] = UNC$TXTL;   # CHAR LENGTH OF TEXT              #
            SSTAQE(P<ORQ>,WCBUF[1],ABH[1],UNC$TXT[0]);
            CSESLE(ABHSN[0],WCBUF[1],UNC$TXT);
            SVC$TIM[0] = CTM$CLOCK[0];  # STORE CURRENT TIME           #
            WCB$WC[1] = 2 + (SVC$TXTL / 10);  # WORD LENGTH OF TEXT    #
            ABHTLC[1] = SVC$TXTL;   # TEXT CHAR LENGTH                 #
            SSTAQE(P<ORQ>,WCBUF[1],ABH[1],SVC$TXT[0]);
            CSESLE(ABHSN[0],WCBUF[1],SVC$TXT);
            END 
          ELSE                      # STU/VC/U NO REASON CODE          #
            BEGIN 
            SVC$TIM[0] = CTM$CLOCK[0];  # STORE CURRENT TIME           #
            WCB$WC[1] = 2 + (SVC$TXTL / 10);  # WORD LENGTH OF TEXT    #
            ABHTLC[1] = SVC$TXTL;   # TEXT CHAR LENGTH                 #
            SSTAQE(P<ORQ>,WCBUF[1],ABH[1],SVC$TXT[0]);
            CSESLE(ABHSN[0],WCBUF[1],SVC$TXT);
            END 
          END 
        END                  # STU/VC/U                                #
# 
*     IF THIS SM IS STU/VC/N, THEN SEND THE STATUS TEXT TO
*     THE OPERATOR IDENTIFIED BY THE ACN OF INCOMING SM 
# 
      ELSE                   # ASSUME STU/VC/N                         #
        BEGIN 
        WCB$WORD[1] = 0;
        WCB$WC[1] = 2 + (SVC$TXTL / 10) -1;  # SUBTRACT TIME WORD      #
        WCB$SMID[1] = SMID"TTEXT";
 
        ABHADR[1] = ABHCN[0]; 
        ABHTLC[1] = SVC$TXTL - 10;  # SUBTRACT WORD CONTAINING TIME    #
 
        SSTAQE(P<CNQ>,WCBUF[1],ABH[1],SVC$TXT[1]);
        END 
 
 
      RETURN;                # **** RETURN **** # 
      END # CSESVC #
      TERM