Retro1.org codex

*DECK     CSSAST
USETEXT TEXTCS; 
USETEXT TEXTSS; 
USETEXT TXTSMCS;
USETEXT TXTAPSS;
USETEXT TXTSUSS;
USETEXT TXCMDCS;
PROC CSSAST;
# TITLE CSSAST - ACTION STATUS COMMAND. # 
 
      BEGIN # CSSAST #
 
# 
**    CSSAST - ACTION STATUS COMMAND. 
* 
*     C. BRION          82/04/23. 
* 
*     THIS PROCEDURE PERFORMS THE PROCESSING OF ALL STATUS COMMANDS.
* 
*     PROC CSSAST 
* 
*     ENTRY:  
*       WCBUF = WORD COUNT WORD OF ENTRY THAT CONTAINS THE STATUS 
*               COMMAND THAT HAS BEEN RESOLVED INTO A ROUTED
*               COMMAND.
*       HDRCMD = ONE WORD ARRAY THAT CONTAINS PERTINENT INFORMATION 
*                ABOUT THE COMMAND. 
*       PARMS = ARRAY THAT CONTAINS THE COMMAND TEXT, THE SYNTAX
*               PARAMETER LIST AND THE ADDRESS PARAMETER LIST.
* 
*     EXIT: 
*       THE APPROPRIATE SUPERVISORY MESSAGE OR MESSAGES WILL BE SENT
*       TO THE APPROPRIATE NPUS.
* 
*       AN INFORMATIVE MESSAGE MAY BE SENT TO THE ORIGIN OPERATOR IN
*       CASE OF AN ERROR WITH THE COMMAND PROCESSING. 
* 
*       THE APPROPRIATE NPUCB AND OCB TABLE ENTRIES WILL BE UPDATED 
*       AS APPROPRIATE. 
* 
# 
 
# 
****  PROC CSSAST XREF LIST.
# 
 
      XREF
 
        BEGIN 
        PROC SSTAQE;                     # SS- ACCEPT QUEUE ENTRY # 
        FUNC SSDCDA;                     # SS- CONVERT DISPLAY CODE # 
                                         #     TO ASCII CHARACTER   # 
        PROC SSBEBF;                     # SS- EXTRACT BIT FIELD #
        PROC SSBSBF;                     # SS- STORE BIT FIELD   #
        PROC SSBSBW;                     # SS- SET BIT IN WORD #
        PROC MESSAGE;                    # MACREL MSG TO DAYFILE #
        PROC MOVEI;                      # MOVE WORDS INDIRECT #
        PROC ABORT;                      # MACREL PROGRAM ABORT # 
        END 
 
# 
****
# 
 
# 
*     PROC CSSAST DEFINITIONS 
# 
 
      DEF ASCBLNK2$     # O"040040" #;   # 2 ASCII BLANKS # 
 
 
# 
*     STATUS AND SWITCH DEFINITIONS.
# 
 
# 
*     STATLST - LIST OF ELEMENT STATUS VALUES.
# 
 
      STATUS STATLST
        ALL,
        NC, 
        DI, 
        DN, 
        EN, 
        ACT;
 
# 
*     CMDLST - LIST OF TYPE OF COMMANDS.
# 
 
      STATUS CMDLST 
        SINGLE, 
        MULTIPLE; 
 
 
# 
*     ELMLST - LIST OF COMMAND ELEMENT VALUES.
# 
 
      STATUS ELMLST 
        TERM, 
        TERMS,
        LINE, 
        LINES,
        CUPLR,
        CUPLRS, 
        TRUNK,
        TRUNKS, 
        NPU,
        NPUS, 
        LLINK,
        LLINKS, 
        SVC,
        SVCS; 
 
# 
*     BLDSM - SWITCH FOR BUILDING THE APPROPRIATE SM. 
# 
 
      SWITCH BLDSM:ELMLST 
        BLDTERM:TERM, 
        BLDTERMS:TERMS, 
        BLDLINE:LINE, 
        BLDLINES:LINES, 
        BLDCUPLR:CUPLR, 
        BLDCUPLRS:CUPLRS, 
        BLDTRUNK:TRUNK, 
        BLDTRUNKS:TRUNKS, 
        BLDNPU:NPU, 
        BLDNPU:NPUS,
        BLDLLINK:LLINK, 
        BLDLLINKS:LLINKS, 
        BLDSVC:SVC, 
        BLDSVCS:SVCS; 
 
 
# 
*     PROC CSSAST ITEM DEFINITIONS. 
# 
 
      ITEM OCBORD       U;               # OCB ORDINAL #
      ITEM NPUORD       U;               # NPUCB ORDINAL #
      ITEM BEGSYIX      U;               # INDEX VARIABLES #
      ITEM FINSYIX      U;
      ITEM BEGAPIX      U;
      ITEM FINAPIX      U;
      ITEM ELMIDX       U;
      ITEM NORIDX       U;
      ITEM QELIDX       U;
      ITEM K,L,I,M,Y    U;               # LOOP VARIABLES # 
      ITEM DORD,DBIT    U;               # CONVERSION VARS #
      ITEM AORD,ABIT    U;
      ITEM SINGCHR      U;               # CHARACTER HOLDING VAR #
      ITEM SENT         B;
      ITEM DONE         B;
      ITEM MATCH        B;
      ITEM NPSFLAG      B;               # SET WHEN NPUS IS SPECIFED #
 
      $BEGIN
      ITEM DBVAR        U;               # DEBUG VARIABLE # 
      $END
 
 
 
 
 
 
 
# 
*     PROC CSSAST ARRAY DEFINITIONS.
# 
 
# 
*     LLINFO - LLINK INFORMATION PACKET.
# 
 
      ARRAY LLINFO [00:01] S(1);
 
        BEGIN 
        ITEM LLI$WORD   U(00,00,60);     # FULL WORD REF #
        ITEM LLI$LLAIX  U(00,00,08);     # LLINK ADDRESS PARAMETER #
                                         # WORD INDEX              #
        ITEM LLI$NORIX  U(00,08,08);     # NPU ORDINAL PARAMETER   #
                                         # WORD INDEX              #
        ITEM LLI$NPORD U(00,16,12);      # NPU NODE ID OF ORDINAL NPU # 
        END 
 
# 
*     CMDPKT - COMMAND DESCRIPTION PACKET.
# 
 
      ARRAY CMDPKT [00:00] S(1);
 
        BEGIN 
        ITEM CMD$WORD   U(00,00,60);     # FULL WORD REF #
        ITEM CMD$ELMID  U(00,00,08);     # CMD ELEMENT ID # 
        ITEM CMD$TYPE   S:CMDLST (00,08,02); # TYPE, SINGLE, MULTIPLE # 
        ITEM CMD$PFC    U(00,10,08);     # CMD SM PFC # 
        ITEM CMD$SFC    U(00,18,08);     # CMD SM SFC # 
        ITEM CMD$STATUS S:STATLST (00,26,08); # CMD DESIRED STATUS #
        END 
 
# 
*     BADRCMD - DAYFILE MSG FOR BAD ROUTED COMMAND FORMAT.
# 
 
      ARRAY BADRCMD [00:00] S(3); 
 
        BEGIN 
        ITEM BAD$TXT1   C(00,00,25) = ["CSSAST-INVALID CMD FORMAT"];
        ITEM BAD$ZERO   U(02,30,30) = [0];
        END 
 
 
# 
*     HHMSG - ERROR MESSAGE FOR TERMINAL STATUS ON HOST/HOST LLINK. 
# 
 
      ARRAY HHMSG [00:00] S(6); 
 
        BEGIN 
        ITEM HH$TXT1    C(00,00,20) = ["TERMINALS CANNOT CON"]; 
        ITEM HH$TXT2    C(02,00,20) = ["NECT ON HOST-HOST LO"]; 
        ITEM HH$TXT3    C(04,00,10) = ["GICAL LINK"]; 
        ITEM HH$ZERO    U(05,00,60) = [0];
        END 
 
# 
*     NOSUPM - ERROR MESSAGE FOR UNSUPERVISED LLINK NODE. 
# 
 
      ARRAY NOSUPM [00:00] S(5);
 
        BEGIN 
        ITEM NO$TXT1    C(00,00,20) = ["TERMINAL NODE OF LLI"]; 
        ITEM NO$TXT2    C(02,00,03) = ["NK "];
        ITEM NO$NAME    C(02,18,07);
        ITEM NO$TXT3    C(03,00,16) = [" NOT SUPERVISED "]; 
        ITEM NO$ZERO    U(04,36,24) = [0];
        END 
 
 
# 
*     FLG$WORD - BASED ARRAY THAT POINTS TO THE PENDING STATUS REQUEST
*     WORD OF THE NPUCB.
# 
 
      BASED ARRAY FLG$WORD [00:00] S(NPCBSZ$);
        BEGIN 
        ITEM FW$WORD    I(00,00,60);
        END 
 
 
 
 
 
# 
*     PRESET THE ORDINALS AND INDICES TO BE USED. 
# 
 
      WCB$WORD[1] = 0;
      ABHWORD[1] = 0; 
      SPMSG0[1] = 0;
      SPMSG1[1] = 0;
      SPMSG2[1] = 0;
      OCBORD = HDR$OPORD[0];             # OCB ORDINAL #
      BEGSYIX = HDR$TXWCNT[0] + 1;       # BEGINNING SYNTAX LIST INDEX# 
      FINSYIX =  HDR$TXWCNT[0] + HDR$SPCNT[0] - 1;  # FINAL SYN INDX #
      BEGAPIX = FINSYIX + 1;             # BEGINNING ADDRESS LIST INDX# 
      IF HDR$APCNT[0] EQ 0
      THEN                   # IF THERE IS NO NPU ORD OR ELMNT ADDR    #
        BEGIN 
        FINAPIX = BEGAPIX;   # SET FINAL AP INDEX = BEGINNING AP INDEX #
        END 
      ELSE                   # THERE ARE NPU ORD OR ELMNT ADDR         #
        BEGIN 
        FINAPIX = BEGAPIX + HDR$APCNT[0] - 1; # FINAL ADDR LIST INDEX  #
        END 
      ELMIDX = BEGSYIX ;              # ELEMENT INDEX # 
      CMD$WORD[0] = 0;                   # CMD PACKET CLEAR # 
      CMD$TYPE[0] = CMDLST"SINGLE";      # PRESET CMD TYPE #
 
      WCB$SMID[1] = SMID"TTEXT";         # ENTRY IDENTIFIER FOR TTEXT # 
      WCB$IAF[1] = FALSE;                # INPUT ALLOWED TRUE # 
      ABHADR[1] = OCBORD;                # PRESET ADDR FOR TTEXT MSG #
 
 
# 
*     CHECK IF NOP KEYWORD PRESENT. IF SO, BUMP ELEMENT INDEX AND THE 
*     BEGINNING SYNTAX PARAMETER LIST INDEX.
# 
 
      IF PAR$PCODE[BEGSYIX] EQ "NOP"
      THEN
 
        BEGIN 
        BEGSYIX = BEGSYIX + 1;
        ELMIDX = ELMIDX + 1;
        END 
 
# 
*     DETERMINE IF NPUS WAS SPECIFIED.  IF SO, THEN SET FLAG. 
# 
      NPSFLAG = FALSE;
      FOR I=BEGSYIX STEP 1 UNTIL FINSYIX
      DO
        BEGIN 
        IF PAR$PCODE[I] EQ "NPS"
        THEN
          BEGIN 
          NPSFLAG = TRUE; 
          END 
        END 
# 
*     DETERMINE THE TYPE OF COMMAND ELEMENT OF COMMAND. THE SECOND
*     CHARACTER OF EACH COMMAND ELEMENT KEYWORD IS UNIQUE EXCEPT FOR
*     THE P IN NPUS (NP0 OR NPS) AND COUPLERS (CP0 OR CPS). ONCE
*     THE ELEMENT TYPE IS DETERMINED, THE PFC/SFC OF A RESULTING SM IS
*     SET AS WELL AS THE ELEMENT IDENTIFIER. NOTE THAT THE ELEMENT
*     IDENTIFIER IS SET TO THE MULTIPLE VALUE OF THE ID LIST. 
*     THE ORDER OF ELMLST IS CRUCIAL TO THE PROPER ID ASSIGNMENT. 
*     IF LATER EXAMINATION SHOWS A MULTIPLE ELEMENT TYPE OF COMMAND,
*     THEN THE CMD ELEMENT ID HAS TO ONLY BE BUMPED BY 1. 
*     NOTE THAT THE ORDER OF THE SYNTAX PARAMETER LIST IS ALSO A
*     CRUCIAL ASSUMPTION OF CSSAST. THE COMMAND ELEMENT, OR THE ELEMENT 
*     TYPE BEING STATUSED, IS ALWAYS THE FIRST PARAMETER CODE/VALUE 
*     PAIR AFTER THE VERB AND IF PRESENT THE NOP PARAMETERS.
# 
 
      IF PAR$PCHR2[BEGSYIX] EQ "E"       # TERMINAL # 
      THEN
 
        BEGIN 
        CMD$PFC[0] = TES; 
        CMD$SFC[0] = TE;
        CMD$ELMID[0] = ELMLST"TERM";
        END 
 
      ELSE IF PAR$PCHR2[BEGSYIX] EQ "I"  # LINE # 
      THEN
 
        BEGIN 
        CMD$PFC[0] = LIS; 
        CMD$SFC[0] = LI;
        CMD$ELMID[0] = ELMLST"LINE";
        END 
 
      ELSE IF PAR$PCHR2[BEGSYIX] EQ "P"  # NPU OR COUPLER # 
      THEN
 
        BEGIN 
        IF PAR$PCHR1[BEGSYIX] EQ "C"     # COUPLER #
        THEN
 
          BEGIN 
          CMD$PFC[0] = CPS; 
          CMD$SFC[0] = CP;
          CMD$ELMID[0] = ELMLST"CUPLR"; 
          END 
 
        ELSE
 
          BEGIN                          # MUST BE NPU #
          CMD$PFC[0] = NPS; 
          CMD$SFC[0] = NP;
          CMD$ELMID[0] = ELMLST"NPU"; 
          END 
        END 
 
      ELSE IF PAR$PCHR2[BEGSYIX] EQ "R"  # TRUNK #
      THEN
 
        BEGIN 
        CMD$PFC[0] = TRS; 
        CMD$SFC[0] = TR;
        CMD$ELMID[0] = ELMLST"TRUNK"; 
        END 
 
      ELSE IF PAR$PCHR2[BEGSYIX] EQ "L"  # LOGICAL LINK # 
      THEN
 
        BEGIN 
        CMD$PFC[0] = LLS; 
        CMD$SFC[0] = LL;
        CMD$ELMID[0] = ELMLST"LLINK"; 
        END 
 
      ELSE IF PAR$PCHR2[BEGSYIX] EQ "C"  # SVC #
      THEN
 
          BEGIN 
          CMD$PFC[0] = VCS; 
          CMD$SFC[0] = VC;
          CMD$ELMID[0] = ELMLST"SVC"; 
          END 
 
 
      ELSE
 
        BEGIN 
        MESSAGE(BADRCMD[0],0);
        ABORT;
        END;
 
 
# 
*     THE ELEMENT TYPE BEING STATUSED MAY BE A MUTIPLE TYPE (I.E A
*     STATUS OF TERMINALS ON A LINE (ST,TES,LI=XXXXXXX)). IF SO,
*     THE THIRD CHARACTER OF THE PARAMETER CODE WILL ALWAYS BE "S". 
*     IF TRUE, THEN THE QUALIFIER ELEMENT (I.E. LI=XXXXXXX) HAS TO
*     BE DETERMINED AND THE SFC ADJUSTED. ALSO THE CMD TYPE MUST
*     BE CHANGED TO INDICATE A MULTIPLE TYPE. 
*     THE ELEMENT IDENTIFIER SET TO THIS POINT IS FOR THE SINGLE
*     ELEMENT TYPE OF THE COMMAND. IF MULTIPLE, SIMPLY BUMP THE 
*     VALUE BY 1 AND THE PROPER ID VALUE IS SET. NOTE THE ORDER OF
*     THE ID VALUES IN THE STATUS LIST ELMLST.
*     NOTE THAT THE ASSUMPTION THAT THE QUALIFIER ELEMENT PARAMETER 
*     WORD FOLLOWS THE STATUSED ELEMENT PARAMETER WORD OF THE 
*     SYNTAX PARAMETER LIST.
# 
 
      QELIDX = BEGSYIX ;              # BUMP PARAMETER WORD INDEX # 
 
      IF PAR$PCHR3[QELIDX] EQ "S" 
      THEN
        BEGIN 
        QELIDX = QELIDX + 1;             # BUMP TO QUALIFIER ELM #
 
        CMD$TYPE[0] = CMDLST"MULTIPLE"; 
        CMD$ELMID[0] = CMD$ELMID[0] + 1;
 
 
        IF PAR$PCHR2[QELIDX] EQ "I"      # LI= QUALIFIER #
        THEN
          CMD$SFC[0] = LI;
 
        ELSE IF PAR$PCHR2[QELIDX] EQ "P" # NP= QUALIFIER #
        THEN
          CMD$SFC[0] = NP;
 
        ELSE IF PAR$PCHR2[QELIDX] EQ "L" # LL= QUALIFIER #
        THEN
          CMD$SFC[0] = LL;
 
        END 
 
# 
*     CHECK IF A STATUS OF ALL TERMINALS ON A HOST TO HOST LOGICAL
*     LINK HAS BEEN ATTEMPTED. IF SO, SEND ERROR MESSAGE TO OPERATOR, 
*     THEN EXIT PROCESS. OTHERWISE, CHECK THAT THE NPU NODE ID OF 
*     THE NPU ORDINAL DOES IN FACT MATCH THE NPU NODE ID OF THE 
*     ASSOCIATED LOGICAL LINK ADDRESS. IF NOT, DELETE THE NPU 
*     ORDINAL AND LLA FROM THE ADDRESS PARAMETER LIST OF THE COMMAND. 
# 
 
      IF CMD$ELMID[0] EQ ELMLST"TERMS"
         AND CMD$SFC[0] EQ LL 
      THEN
 
        BEGIN 
        NORIDX = ELMIDX + 2;             # SET NOR INDEX #
 
# 
*     FOR EACH POSSIBLE NPU ORDINAL SPECIFIED ( MAX IS 2) 
# 
 
 
        FOR K = 0 STEP 1 UNTIL 1
        DO
 
          BEGIN 
          LLI$WORD[K] = 0;               # CLEAR LLINK INFO WORD #
 
# 
*     SEARCH THE ADDRESS PARAMETER LIST FOR A NOR PARAMETER.
# 
 
          FOR L = BEGAPIX STEP 1 UNTIL FINAPIX
          DO
 
            BEGIN 
            IF PAR$PCODE[L] EQ "NOR"
            THEN
 
              BEGIN 
              LLI$LLAIX[K] = L + 1;      # SET LLA INDEX FOR NOR #
              LLI$NORIX[K] = L;          # SET NOR INDEX #
              LLI$NPORD[K] = PAR$ORD[L]; # SET NPU ORDINAL #
 
# 
*     CHECK THE LINK TYPE FOR HOST TO HOST. IF SO, SEND MESSAGE AND 
*     EXIT THE PROCESS. 
# 
 
              IF PAR$LLTYPE[LLI$LLAIX[K]] 
              THEN
 
                BEGIN 
                WCB$WC[1] = 8 ;          # SET MSG ENTRY SIZE # 
                ABHTLC[1] = 60;          # SET MSG CHARACTER LEN #
                SSTAQE(P<CNQ>,WCBUF[1],ABH[1],HHMSG[0]);
                GOTO ENDEXIT; 
                END 
 
              ELSE                       # LOGICAL LINK HOST TO NPU # 
 
                BEGIN 
 
# 
*     CHECK TO SEE IF UNMATCHED NPU NODE ID OF NPU AT NOR ORDINAL AND 
*     NPU NODE ID OF LOGICAL LINK ADDRESS IS PRESENT. IF SO, A RESULT-
*     ING STATUS REQUEST CAN NOT BE SENT TO THAT NPU SINCE IT IS NOT
*     THE TERMINAL NODE OF THE LINK. THEREFORE, DELETE THE NPU ORDINAL
*     PARAMETER AS WELL AS THE LOGICAL LINK ADDRESS PARAMETER WORD. 
# 
 
                IF PAR$LLNID2[LLI$LLAIX[K]] NQ NPU$NID[LLI$NPORD[K]]
                THEN
 
                  BEGIN 
                  PAR$PCODE[LLI$NORIX[K]] = "NUL";
                  PAR$PCODE[LLI$LLAIX[K]] = "NUL";
                  LLI$NORIX[K] = 0; 
                  END 
 
                END # IF PAR$LLTYPE # 
 
              END # IF PAR$PCODE EQ NOR # 
 
            END # FOR L=BEGAPIX LOOP #
 
          END # FOR K = 0 LOOP #
 
# 
*     IF THERE IS NOT AN NOR PARAMETER WORD PRESENT IN THE COMMAND
*     AFTER THE PREVIOUS ACTIONS, THEN CS IS NOT SUPERVISING THE
*     TERMINAL NODE OF THE LOGICAL LINK QUALIFIER ELEMENT. A
*     MESSAGE IS SENT TO THE OPERATOR.
# 
 
          IF (LLI$NORIX[0] EQ 0 
             AND LLI$NORIX[1] EQ 0) 
          THEN
 
            BEGIN 
            NO$NAME[0] = PAR$ELNAME[BEGSYIX + 1]; # SET NPU NAME #
            WCB$WC[1] = 7;                   # SET MSG ENTRY SIZE # 
            ABHTLC[1] = 50;                  # SET MSG CHAR LENGTH #
            SSTAQE(P<CNQ>,WCBUF[1],ABH[1],NOSUPM[0]); 
            GOTO ENDEXIT; 
            END 
 
        END # IF CMD$ELMID #
 
      OC$NCNT[OCBORD] = 0;               # CLEAR AFFECTED NPU COUNT # 
 
# 
*     FOR EACH NPU ORDINAL IN COMMAND (MAX IS TWO), CHECK TO SEE IF 
*     THE NPU IS BUSY WITH ANOTHER STATUS COMMAND. IF SO, INFORM THE
*     REQUESTING OPERATOR AND EXIT. OTHERWISE, CONTINUE PROCESSING
*     THE CURRENT STATUS COMMAND. 
# 
 
      SENT = FALSE; 
 
      FOR I = BEGAPIX STEP 1 UNTIL FINAPIX
      DO
 
        BEGIN 
        IF PAR$PCODE[I] EQ "NOR" OR 
           NPSFLAG
        THEN
 
          BEGIN 
          NPUORD = PAR$ORD[I];           # SET LOCAL NPU ORDINAL #
 
 
# 
*     IF THE COMMAND TYPE IS MULTIPLE, THEN THE STATUS DESIRED FOR
*     THE STATUSED ELEMENT GROUP MUST BE DETERMINED. A SEARCH OF THE
*     SYNTAX PARAMETER LIST FOR THE ELEMENT STATUS QUALIFIER IS DONE. 
*     THE COMMAND STATUS QUALIFIER IS THEN SET ACCORDINGLY. 
# 
 
          IF CMD$TYPE[0] EQ CMDLST"MULTIPLE"
          THEN
 
            BEGIN 
            CMD$STATUS[0] = STATLST"ALL"; 
            DONE = FALSE; 
 
            FOR M = BEGSYIX STEP 1 WHILE (M LQ FINSYIX
              AND CMD$STATUS[0] EQ STATLST"ALL" 
              AND NOT DONE) 
            DO
 
              BEGIN 
 
              IF PAR$PCODE[M] EQ "EN1"   # ENABLED ELEMENTS # 
              THEN
 
                CMD$STATUS[0] = STATLST"EN";
 
              ELSE IF PAR$PCODE[M] EQ "AC0" # ACTIVE ELEMENTS # 
              THEN
 
                CMD$STATUS[0] = STATLST"ACT"; 
 
              ELSE IF PAR$PCODE[M] EQ "DI1" # DISABLED ELEMENTS # 
              THEN
 
                CMD$STATUS[0] = STATLST"DI";
 
              ELSE IF PAR$PCODE[M] EQ "DN0" # DOWNED ELEMENTS # 
              THEN
 
                CMD$STATUS[0] = STATLST"DN";
 
              ELSE IF PAR$PCODE[M] EQ "MSG" 
              THEN
 
                DONE = TRUE;
 
 
              END # FOR M LOOP #
 
            END # IF CMD$TYPE # 
 
# 
*     INITIALIZE THE OUTGOING SM MEMORY AREAS.
# 
 
          ABHABT[1] = APPSUP;            # ABH BLOCK TYPE # 
          ABHBT[1] = APPSUP;
          ABHACT[1] = ACTCSNP$;          # SET ACT FOR OUTGOING SM #
 
# 
*     BASED ON THE DETERMINED COMMAND ELEMENT IDENTIFIER, BRANCH TO 
*     THE APPROPRIATE CASE AND BUILD THE OUTGOING SM. 
# 
 
          GOTO BLDSM[CMD$ELMID[0]]; 
 
 
 
BLDTERM:                                 # ST,TE=XXXXXXX COMMAND #
 
# 
*     CONVERT THE DISPLAY CODED TERMINAL NAME TO ASCII. 
# 
 
          DORD = ELMIDX;
          DBIT = 0; 
          AORD = 1; 
          ABIT = 4; 
          FOR Y = 1 STEP 1 UNTIL 7
          DO
 
            BEGIN 
            SSBEBF(PARMS[0],DORD,DBIT,6,SINGCHR); 
            SINGCHR = SSDCDA(SINGCHR);
            SSBSBF(CSSM[1],AORD,ABIT,8,SINGCHR);
            END 
 
# 
*     SET UP REST OF TES/TE SM
# 
 
          ABHTLC[1] = NTESTE; 
          TESP[1] = PAR$ELADDR[I+1];     # ADD PORT NUMBER #
          WCB$WC[1] = LTESTE + 2; 
          WCB$SMID[1] = SMID"TESTE";
          GOTO SENDSM;
 
 
 
BLDTERMS:                                # ST,TES,YY=XXXXXXX COMMAND #
 
# 
*     THE MULTIPLE TES STATUS COMMAND MAY BE REQUESTED WITH THE NP, LL
*     OR LI QUALIFIER ELEMENTS (NPU,LOGICAL LINK, LINE). THE GENERATED
*     SM DIFFERS SLIGHTLY FOR EACH VARIATION. DETERMINE THE QUALIFIER 
*     AND SET UP THE APPROPRIATE SM.
# 
 
          IF CMD$SFC[0] EQ NP            # NPU QUALIFIER ELEMENT #
          THEN
 
            BEGIN 
            TESSTL[1] = CMD$STATUS[0];   # SET STATUS DESIRED#
            ABHTLC[1] = NTESNP; 
            WCB$WC[1] = LTESNP + 2; 
            WCB$SMID[1] = SMID"TESNP";
            END 
 
          ELSE IF CMD$SFC[0] EQ LL       # LLINK QUALIFIER ELEMENT #
          THEN
 
            BEGIN 
            TESN1[1] = PAR$LLNID1[I+1]; 
            TESN2[1] = PAR$LLNID2[I+1]; 
            ABHTLC[1] = NTESLL; 
            WCB$WC[1] = LTESLL + 2; 
            WCB$SMID[1] = SMID"TESLL";
            END 
 
          ELSE                           # LINE QUALIFIER ELEMENT # 
 
            BEGIN 
            TESP[1] = PAR$ELADDR[I+1];
            ABHTLC[1] = NTESLI; 
            WCB$WC[1] = LTESLI + 2; 
            WCB$SMID[1] = SMID"TESLI";
            END 
 
          TESST[1] = CMD$STATUS[0]; 
          GOTO SENDSM;
 
 
 
 
BLDLINE:                                 # ST,LI=XXXXXXX COMMAND #
 
          LISP[1] = PAR$ELADDR[I+1];
          ABHTLC[1] = NLISLI; 
          WCB$WC[1] = LLIS + 2; 
          WCB$SMID[1] = SMID"LISLI";
          GOTO SENDSM;
 
 
 
BLDLINES:                                # ST,LIS,YY=XXXXXXX COMMAND #
 
          LISST[1] = CMD$STATUS[0]; 
          ABHTLC[1] = NLISNP; 
          WCB$WC[1] = LLIS + 2; 
          WCB$SMID[1] = SMID"LISNP";
          GOTO SENDSM;
 
 
 
BLDCUPLR:                                # ST,CP=XXXXXXX COMMAND #
 
          CPSN1[1] = PAR$ELADDR[I+1]; 
          ABHTLC[1] = NCPS; 
          WCB$WC[1] = LCPS + 2; 
          WCB$SMID[1] = SMID"CPSCP";
          GOTO SENDSM;
 
 
 
BLDCUPLRS:                               # ST,CPS,NP=XXXXXXX COMMAND #
 
          CPSST[1] = CMD$STATUS[0]; 
          ABHTLC[1] = NCPS; 
          WCB$WC[1] = LCPS + 2; 
          WCB$SMID[1] = SMID"CPSNP";
          GOTO SENDSM;
 
 
 
 
BLDTRUNK:                                # ST,TR=XXXXXXX COMMAND #
 
          TRSP[1] = PAR$ELADDR[I+1];
          ABHTLC[1] = NTRSTR; 
          WCB$WC[1] = LTRS + 2; 
          WCB$SMID[1] = SMID"TRSTR";
          GOTO SENDSM;
 
 
 
BLDTRUNKS:                               # ST,TRS,NP=XXXXXXX COMMAND #
 
 
          TRSST[1] = CMD$STATUS[0]; 
          ABHTLC[1] = NTRSNP; 
          WCB$WC[1] = LTRS + 2; 
          WCB$SMID[1] = SMID"TRSNP";
          GOTO SENDSM;
 
 
 
BLDNPU:                                  # ST,NP=XXXXXXX COMMAND #
 
          ABHTLC[1] = NNPS; 
          WCB$WC[1] = LNPS + 2; 
          WCB$SMID[1] = SMID"NPSNP";
          GOTO SENDSM;
 
 
 
 
BLDLLINK:                                # ST,LL=XXXXXXX COMMAND #
 
          LLSN1[1] = PAR$LLNID1[I+1]; 
          LLSN2[1] = PAR$LLNID2[I+1]; 
          ABHTLC[1] = NLLSLL; 
          WCB$WC[1] = LLLS + 2; 
          WCB$SMID[1] = SMID"LLSLL";
          GOTO SENDSM;
 
 
 
 
BLDLLINKS:                               # ST,LLS,NP=XXXXXXX COMMAND #
 
          LLSST[1] = CMD$STATUS[0]; 
          ABHTLC[1] = NLLSNP; 
          WCB$WC[1] = LLLS + 2; 
          WCB$SMID[1] = SMID"LLSNP";
          GOTO SENDSM;
 
 
BLDSVC:                                  # ST,SVC=XXXXX COMMAND        #
 
# 
          CONVERT THE DISPLAY CODE ARCHETYPE NAME TO ASCII
# 
          DORD = ELMIDX;                 # BITFIELD START POSITION     #
          DBIT = 0; 
          AORD = 1; 
          ABIT = 4; 
          FOR Y = 1 STEP 1 UNTIL 5
          DO
 
            BEGIN 
            SSBEBF(PARMS[0],DORD,DBIT,6,SINGCHR);  # EXTRACT BITFIELD  #
            SINGCHR = SSDCDA(SINGCHR);
            SSBSBF(CSSM[1],AORD,ABIT,8,SINGCHR);  # STORE BITFIELD     #
            END 
 
# 
          SET UP REST OF VCS/VC SM
# 
 
          VCSP[1] = PAR$ELADDR[I+1];     # PORT NUMBER                 #
          VCSSP[1] = 0;                  # SUBPORT ALWAYS 0            #
          VCSBL[1] = X"2020";            # INSERT TWO BLANKS           #
          ABHTLC[1] = NVCSVC;            # LENGTH IN CHAR              #
          WCB$WC[1] = LVCSVC + 2; 
          WCB$SMID[1] = SMID"VCSVC";
          GOTO SENDSM;
 
 
 
BLDSVCS:  # ST,SVS,YY=XXXXXXX COMMAND # 
 
# 
*         THE MULTIPLE SVC STATUS COMMAND MAY BE REQUESTED WITH 
*         THE NP OR LI QUALIFIER ELEMENT.  THE GENERATED SM 
*         DIFFERS SLIGHTLY FOR EACH VARIATION.  DETERMINE QUALIFIER 
*         AND SET UP APPROPRIATE SM.
# 
 
          IF CMD$SFC[0] EQ NP            # NPU QUALIFIER ELEMENT       #
          THEN
 
            BEGIN 
            ABHTLC[1] = NVCSNP;          # LENGTH IN CHAR              #
            WCB$WC[1] = LVCSNP + 2; 
            WCB$SMID[1] = SMID"VCSNP";
            END 
 
          ELSE                           # LINE QUALIFIER ELEMENT      #
 
            BEGIN 
            VCSP[1] = PAR$ELADDR[I+1];   # PORT NUMBER                 #
            VCSSP[1] = 0;                # SUBPORT ALWAYS 0            #
            ABHTLC[1] = NVCSLI;          # LENGTH IN CHAR              #
            WCB$WC[1] = LVCSLI + 2; 
            WCB$SMID[1] = SMID"VCSLI";
            END 
 
          GOTO SENDSM;
 
 
SENDSM: 
 
# 
*     SET THE PFC AND SFC OF THE OUTGOING SM. 
# 
 
          PFC[1] = CMD$PFC[0];
          SFC[1] = CMD$SFC[0];
 
# 
*     IF THIS STATUS REQUEST GOES TO ALL NPUS, FOR EACH SUPERVISED NPU
*     SET THE STATUS REQUEST PENDING FLAG FOR THIS OPERATOR AND INCRE-
*     MENT THE AFFECTED NPU COUNT, AND SAVE THE NPU ORDINAL.  FIND THE
*     FIRST NPU THAT IS NOT BUSY WITH A STATUS REQUEST. 
# 
 
          P<FLG$WORD> = LOC(NPU$STFLGS[0]); 
          IF NPSFLAG
          THEN
            BEGIN 
 
            FOR Y=0 STEP 1 WHILE Y LS CSNPCNT 
            DO
              BEGIN 
              IF NPU$STAT[Y] EQ SUPSTAT"SUP"
              THEN
                BEGIN 
                SSBSBW(FLG$WORD[Y],OCBORD); 
                OC$NCNT[OCBORD] = OC$NCNT[OCBORD] + 1;
                NPUORD = Y; 
                END 
              END 
 
            MATCH = FALSE;
            FOR Y=0 STEP 1 WHILE NOT MATCH AND
                                 Y LS CSNPCNT 
            DO
              BEGIN 
              IF NPU$STAT[Y] EQ SUPSTAT"SUP" AND
                 NPU$OPST[Y] EQ 0 
              THEN
                BEGIN 
                MATCH = TRUE; 
                NPUORD = Y; 
                END 
              END 
            END 
 
# 
*     STATUS REQUEST IS JUST TO ONE NPU.  SET THE STATUS REQUEST PENDING
*     FLAG IN THE NPU AND INCREMENT THE AFFECTED NPU COUNT. 
# 
 
          ELSE
            BEGIN 
            SSBSBW(FLG$WORD[NPUORD],OCBORD);
            OC$NCNT[OCBORD] = OC$NCNT[OCBORD] + 1;
            END 
 
# 
*     IF THE NPU IS NOT BUSY AND THIS IS THE FIRST NPU THEN, SET THE
*     NPUORD IN THE OCB, SAVE THE CURRENT STATUS OPERATOR ORD IN THE
*     NPUCB, AND SEND THE SM. 
# 
 
          IF NPU$OPST[NPUORD] EQ 0 AND
             NOT SENT 
          THEN
            BEGIN 
            OC$CNPU[OCBORD] = NPUORD; 
            NPU$OPST[NPUORD] = OCBORD;
 
            ABHDN[1] = NPU$NID[NPUORD]; 
            ABHSN[1] = NPU$HID[NPUORD]; 
            SSTAQE(P<OTQ>,WCBUF[1],ABH[1],CSSM[1]); 
          SENT = TRUE;
            END 
 
          END # IF PAR$PCODE EQ NOR # 
 
        END # FOR I = BEGAPIX LOOP #
 
ENDEXIT:  
 
 
# 
*     IF AFFECTED NPU COUNT OF THE OCB IS ZERO, CAUSE A READY.. MSG 
*     TO THE OPERATOR VIA A NULL TERMINAL TEXT ENTRY. 
# 
 
      IF OC$NCNT[OCBORD] EQ 0 
      THEN
 
        BEGIN 
        WCB$WC[1] = 2;
        WCB$SMID[1] = SMID"TTEXT";
        ABHADR[1] = HDR$OPORD[0]; 
        WCB$IAF[1] = TRUE;               # SET INPUT ALLOWED #
        ABHTLC[1] = 0;
        SSTAQE(P<CNQ>,WCBUF[1],ABH[1],CSSM[1]); 
        END 
 
      ELSE
 
        BEGIN 
        OC$VERB[OCBORD] = HDR$VERB[0];
 
        OC$WC[OCBORD] = WCB$WC[1] - 2;
        OC$TLC[OCBORD] = ABHTLC[1]; 
        MOVEI(OC$WC[OCBORD],LOC(CSSM[1]),LOC(OC$SM[OCBORD])); 
        END 
 
 
      $BEGIN
 
      DBVAR = 1;
 
      $END
 
      END # CSSAST #
 
 
 TERM