Retro1.org codex

*DECK     CSSADI
USETEXT TEXTCS; 
USETEXT TEXTSS; 
USETEXT TXCMDCS;
USETEXT TXTAPSS;
USETEXT TXTSMCS;
USETEXT TXTSUSS;
PROC CSSADI;
# TITLE CSSADI - ACTION DISABLE COMMAND # 
 
      BEGIN  # CSSADI # 
# 
**    CSSADI - ACTION DISABLE COMMAND.
* 
*     C. BRION          82/04/21. 
* 
*     PROC CSSADI 
* 
*     ENTRY:  
* 
*       HDRCMD = COMMAND HEADER WORD. 
* 
*       PARMS = COMMAND PARAMETER ARRAY THAT CONTAINS THE COMMAND TEXT, 
*               SYNTAX PARAMETER LIST AND THE ADDRESS PARAMETER LIST. 
* 
*     EXIT: 
* 
*       A DISABLE ELEMENT SUPERVISORY MESSAGE WILL BE SENT TO A NPU.
* 
*       THE COMMAND TEXT WILL BE ENTERED INTO THE LOG FILE. 
* 
*       A READY.. MESSAGE WILL BE CAUSED TO BE SENT TO THE ORIGIN 
*       OPERATOR. 
* 
# 
 
# 
****  PROC CSSADI XREF LIST.
# 
 
      XREF
        BEGIN 
        FUNC SSDCDA;                     #SS-CONVERT DISPLAY TO ASCII#
        PROC SSBEBF;                     #SS-EXTRACT BIT FIELD# 
        PROC MOVE;                       #MACREL MOVE MEMORY# 
        PROC SSBSBF;                     #SS-STORE BIT FIELD# 
        PROC SSTAQE;                     #SS-ACCEPT QUEUE ENTRY#
        PROC CSESLE ; 
        END 
 
# 
****
# 
 
      ITEM NPUORD       U;
      ITEM ADIX         U;
      ITEM BEGAPIX      U;
      ITEM FINAPIX      U;
      ITEM DORD,DBIT    U;
      ITEM AORD,ABIT    U;
      ITEM SINGCHAR     U;
      ITEM ELINDX       U;
      ITEM I            U;
 
# 
*     INFOELM - ARRAY THAT HOLDS INFORMATION RE: AN ELEMENT.
# 
 
      ARRAY INFOELM [00:01] S(1); 
        BEGIN 
        ITEM INF$WORD   U(00,00,60);     # FULL WORD 0 REF #
        ITEM INF$ORD    U(00,00,12);     # NPU ORDINAL #
        ITEM INF$ADIX   U(00,12,08);     # INDEX VALUE FOR ADDR PARM #
        ITEM INF$ORDIN  B(00,59,01);     # NPU ORDINAL PRESENT FLAG # 
        END 
 
      ARRAY IGNOREMSG S(6) ;
        BEGIN 
        ITEM IGMSGW        U(00,00,60) ;
        ITEM IGMSG1        C(00,00,26) =[" COMMAND IGNORED- VERSION "] ;
        ITEM IGMSG2        U(02,36,12) ;
        ITEM IGMSG3        C(02,48,30) =
                           [" CCP UNABLE TO ACTION COMMAND "] ; 
        ITEM IGMSG4        U(05,48,12) =[0] ; 
        END 
 
 
 
 
 
 
 
 
# 
*     INITIAILIZE INDICES AND LOCAL STORAGE.
# 
 
      BEGAPIX =  HDR$SPCNT[0] + HDR$TXWCNT[0];   # BEGIN ADDR LIST #
      FINAPIX = BEGAPIX + HDR$APCNT[0] - 1; 
      INF$WORD[0] = 0;
      INF$WORD[1] = 0;
 
# 
*     CHECK FOR TWO NPU ORDINALS PRESENT IN THE ADDRESS PARAMETER LIST
*     OF COMMAND. IF PRESENT, THEN A DISABLE OF A TRUNK OR LOGICAL LINK 
*     COMMAND ATTEMPTED.
* 
*     SET THE LOCAL INFO ACCORDING TO THE NPU ORDINALS FOUND. 
# 
 
      FOR I = BEGAPIX STEP 1 UNTIL FINAPIX
      DO
 
        BEGIN 
        IF PAR$PCODE[I] EQ "NOR"
        THEN
 
          BEGIN 
          IF NOT INF$ORDIN[0]            # FIRST NPU ORDINAL SEEN # 
          THEN
 
            BEGIN 
            INF$ORDIN[0] = TRUE;
            INF$ORD[0] = PAR$ORD[I];
            INF$ADIX[0] = I+1;           # SET INDEX FOR ADDR PARM# 
            END 
 
          ELSE                           # SECOND NPU ORDINAL SEEN #
 
            BEGIN 
            INF$ORDIN[1] = TRUE;
            INF$ORD[1] = PAR$ORD[I];
            INF$ADIX[1] = I+1;
            END 
 
          END  # IF PAR$PCODE EQ NOR #
 
        END  # FOR I LOOP # 
 
# 
*     CHECK TO SEE IF MORE THAN 1 NPU ORDINAL IN COMMAND .
# 
 
      IF INF$ORDIN[0] AND INF$ORDIN[1]
      THEN
 
# 
*     THERE ARE 2 NPU ORDINALS IN COMMAND. THE OUTGOING DISABLE SM CAN
*     ONLY BE SENT TO 1 NPU. THE SM IS SENT EITHER TO THE LOCAL NPU 
*     OR IF BOTH ARE REMOTE THEN THE SM IS SENT TO THE NPU WITH THE 
*     LOWEST NODE NUMBER. 
# 
 
        BEGIN 
 
        IF ((NPU$RIND[INF$ORD[0]] AND NPU$RIND[INF$ORD[1]]) 
          OR (NOT NPU$RIND[INF$ORD[0]]
              AND NOT NPU$RIND[INF$ORD[1]]))
        THEN
 
          BEGIN 
 
          IF NPU$NID[INF$ORD[0]] LS NPU$NID[INF$ORD[1]] 
          THEN
 
            BEGIN 
            NPUORD = INF$ORD[0];
            ADIX = INF$ADIX[0]; 
            END 
 
          ELSE
 
            BEGIN 
            NPUORD = INF$ORD[1];
            ADIX = INF$ADIX[1]; 
            END 
 
          END 
 
        ELSE  # ONE NPU LOCAL # 
 
          BEGIN 
 
          IF NPU$RIND[INF$ORD[0]] 
          THEN
 
            BEGIN 
            NPUORD = INF$ORD[1];
            ADIX = INF$ADIX[1]; 
            END 
 
          ELSE
 
            BEGIN 
            NPUORD = INF$ORD[0];
            ADIX = INF$ADIX[0]; 
            END 
 
          END 
 
        END 
 
      ELSE
 
# 
*     ONLY ONE NPU ORDINAL IS IN THE COMMAND. SET ORDINAL AND ADDRESS 
*     INDEX VALUE.
# 
 
        BEGIN 
        NPUORD = INF$ORD[0];
        ADIX = INF$ADIX[0]; 
        END 
 
# 
*     SET THE INDEX VALUE FOR THE ELEMENT KEEPING IN MIND THAT THE NOP
*     KEYWORD MAY CAUSE ADJUSTMENT. 
# 
 
      ELINDX = HDR$TXWCNT[0] + 1; 
      IF PAR$PCODE[ELINDX] EQ "NOP" 
      THEN
        ELINDX = ELINDX + 1;
 
# 
*     INITIALIZE THE OUTGOING SM AND THE QUEUE ENTRY STORAGE AREAS. 
# 
 
      WCB$WORD[1]= 0; 
      ABHWORD[1] = 0; 
      SPMSG0[1] = 0;
      PFC[1] = DIB; 
      ABHACT[1] = ACTCSNP$; 
      ABHABT[1] = APPSUP; 
      ABHBT[1] = APPSUP;
      ABHDN[1] = NPU$NID[NPUORD];        # DESTINATION NODE # 
      ABHSN[1] = NPU$HID[NPUORD];        # SOURCE NODE #
 
 
# 
*     DETERMINE THE ELEMENT TYPE AND SET UP THE OUTGOING SM WITH THE
*     APPROPRIATE SM VALUES.
# 
 
      IF PAR$PCODE[ELINDX] EQ "TE0"      # DISABLE TERMINAL # 
      THEN
 
        BEGIN 
        SFC[1] = TE;
 
# 
*     CONVERT THE TERMINAL NAME FROM THE ELEMENT PARAMETER VALUE IN 
*     THE COMMAND TO ASCII FORMAT INTO THE OUTGOING DISABLE SM. 
# 
 
        DORD = ELINDX;
        DBIT = 0; 
        AORD = 1; 
        ABIT = 4;                        # SET TO PLACE IN SM WORD 1 #
 
        FOR I = 1 STEP 1 UNTIL 7
        DO
 
          BEGIN 
          SSBEBF(PARMS[0],DORD,DBIT,6,SINGCHAR);
          SINGCHAR = SSDCDA(SINGCHAR);
          SSBSBF(CSSM[1],AORD,ABIT,8,SINGCHAR); 
          END 
 
# 
*     SET UP THE REST OF THE DISABLE TERMINAL SMAND QUEUE ENTRY.
# 
 
        ABHTLC[1] = NDIBTE; 
        WCB$SMID[1] = SMID"DIBTE";
        DIBP[1] = PAR$ELADDR[ADIX]; 
        WCB$WC[1] = LDIBTE + 2; 
 
        END  # IF TE0 # 
 
      ELSE IF PAR$PCODE[ELINDX] EQ "LI0"  # DISABLE LINE #
      THEN
 
        BEGIN 
        SFC[1] = LI;
        DIBP[1] = PAR$ELADDR[ADIX];      # SET PORT NUMBER IN SM #
        ABHTLC[1] = NDIBLI; 
        WCB$SMID[1] = SMID"DIBLI";
        WCB$WC[1] = LDIBLI + 2; 
        END 
 
      ELSE IF PAR$PCODE[ELINDX] EQ "TR0"  # DISABLE TRUNK # 
      THEN
 
 
        BEGIN 
        SFC[1] = TR;
        DIBP[1] = PAR$ELADDR[ADIX];      # SET PORT NUMBER IN SM #
        IF PAR$PCODE[ELINDX+1] EQ "LD0" 
        THEN
          BEGIN                          # LD PARAM SPECIFIED          #
          IF V24FLAG
          THEN                           # AND RUNNING WITH 2.4 CCP    #
            DIBLDF[1] = TRUE ;           # SET THE LOAD FLAG           #
          ELSE
            BEGIN                        # NOT RUNNING WITH 2.4 CCP    #
                                         # SEND MESSAGE TO OPERATOR    #
            ABHWORD[1] = 0 ;
            ABHTLC[1] = 6 ; 
            ABHADR[1] = AUDGR4$ ; 
 
 
            CSESLE(NPU$NID[NPUORD],8,IGMSGW[0]) ; 
            IGMSG2[0] = CCPVERS      ;   # STORE VERSION TO MSG        #
            WCB$WC[1] = 8 ; 
 
            SSTAQE(P<ORQ>,WCBUF[1],ABH[1],IGMSGW[0]) ;
 
            RETURN ;
 
            END                          # SEND  MESSAGE               #
          END                            # LD PARAM SPECIFIED          #
        ABHTLC[1] = NDIBLI; 
        WCB$SMID[1] = SMID"DIBTR";
        WCB$WC[1] = LDIBLI + 2; 
        END 
 
      ELSE IF PAR$PCODE[ELINDX] EQ "VC0"  # DISABLE ARCHETYPE SVC # 
      THEN
 
        BEGIN 
        SFC[1] = VC;
 
# 
*     CONVERT THE ARCHETYPE SVC NAME FROM THE ELEMENT VALUE IN
*     THE COMMAND TO THE ASCII FORMAT INTO THE OUTGOING DISABLE SM. 
# 
 
          DORD = ELINDX;                 # BITFIELD START POSITION #
          DBIT = 0; 
          AORD = 1; 
          ABIT = 4; 
          FOR I = 1 STEP 1 UNTIL 5
          DO
 
            BEGIN 
            SSBEBF(PARMS[0],DORD,DBIT,6,SINGCHAR);  # EXTRACT BITFIELD #
            SINGCHAR = SSDCDA(SINGCHAR);
            SSBSBF(CSSM[1],AORD,ABIT,8,SINGCHAR);  # STORE BITFIELD # 
            END 
 
# 
*     SET UP THE REST OF THE DISABLE ARCHETYPE SVC SM 
# 
 
      ABHTLC[1] = NDIBVC;                # LENGTH IN CHAR # 
      DIBP[1] = PAR$ELADDR[ADIX];        # SET PORT NUMBER IN SM #
      FOR  I = ELINDX STEP 1 UNTIL BEGAPIX
      DO
        BEGIN 
        IF PAR$PCODE[I] EQ "NC0"         # FOUND NCIR PARAMETER CODE #
        THEN
          DIBNC[1] = PAR$NCIR[I];        # STORE NO. OF SVCS TO DISABLE#
        END  # FOR LOOP # 
      DIBBL[1] = X"2020";                # INSERT TWO BLANKS #
      WCB$SMID[1] = SMID"DIBVC";
      WCB$WC[1] = LDIBVC + 2; 
 
      END  # IF VC0 # 
 
      ELSE                               # DISABLE LLINK #
 
        BEGIN 
        SFC[1] = LL;
        DIBN1[1] = PAR$LLNID1[ADIX];     # SET SM COUPLER NODE NUMBER # 
        DIBN2[1] = PAR$LLNID2[ADIX];     # SET SM NPU NODE NUMBER # 
        ABHTLC[1] = NDIBLL; 
        WCB$SMID[1] = SMID"DIBLL";
        WCB$WC[1] = LDIBLL + 2; 
        END 
 
# 
*     THE OUTGOING DISABLE SM READY FOR QUEUING TO OUTPUT TRAFFIC 
*     QUEUE.
# 
 
      SSTAQE(P<OTQ>,WCBUF[1],ABH[1],CSSM[1]); 
 
# 
*     THE COMMAND TEXT IS TO BE LOGGED INTO THE LOG FILE VIA A
*     SUPERVISION EVENT TO THE EVENT PROCESSOR. 
# 
 
      WCB$WORD[1] = 0;
      ABHWORD[1] = 0; 
      WCB$SMID[1] = SMID"CMDTXT"; 
      CMD$TNAM[0] = OC$TNAM[HDR$OPORD[0]]; # SET OP TERMINAL NAME # 
      P<MSCMD> = LOC(CMD$TEXT[0]);         # SET UP FOR TEXT MOVE # 
      MOVE(HDR$TXWCNT[0],PARMS[0],MSCMD[0]);
      WCB$WC[1] = HDR$TXWCNT[0] + 4;
      ABHTLC[1] = (HDR$TXWCNT[0] + 2) * 10;  # SET CHAR LENGTH #
      SSTAQE(P<EVQ>,WCBUF[1],ABH[1],CMDLINE[0]);
 
# 
*     SEND THE NULL TERMINAL TEXT TO THE ORIGIN OPERATOR SO AS TO 
*     CAUSE THE READY.. MESSAGE TO BE ISSUED. 
# 
 
      WCB$WORD[1] = 0;
      ABHWORD[1] = 0; 
      WCB$SMID[1] = SMID"TTEXT";
      WCB$WC[1] = 2;
      ABHADR[1] = HDR$OPORD[0]; 
      WCB$IAF[1] = TRUE;                 # INPUT ALLOWED TRUE # 
      SSTAQE(P<CNQ>,WCBUF[1],ABH[1],CSSM[1]); 
 
      END  # CSSADI # 
 TERM