Retro1.org codex

*DECK     CSSATM
USETEXT TEXTCS; 
USETEXT TEXTSS; 
USETEXT TXCMDCS;
USETEXT TXTAPSS;
USETEXT TXTSMCS;
USETEXT TXTSUSS;
PROC CSSATM;
# TITLE CSSATM - ACTION TEST MESSAGE COMMAND #
 
      BEGIN  # CSSATM # 
 
# 
**    CSSATM - ACTION TEST MESSAGE COMMAND. 
* 
*     C. BRION          82/06/09. 
* 
*     THIS PROCEDURE PROCESSES THE DIAGNOSTIC TEST MESSAGE (DATA) 
*     COMMAND FROM AN OPERATOR TO THE ONLINE DIAGNOSTIC PROGRAM IN
*     AN NPU. 
* 
*     PROC CSSATM 
* 
*     ENTRY:  
* 
*       HDRCMD = COMMAND HEADER WORD. 
*       PARMS = COMMAND PARAMETER ARRAY.
* 
*     EXIT: 
* 
*       AN OLDDT SM MAY BE SENT TO A NPU. 
*       A TERMINAL TEXT ENTRY WILL BE SENT TO THE OPERATOR. 
# 
 
# 
****  PROC CSSATM XREF LIST 
# 
 
      XREF
        BEGIN 
        PROC SSBEBF;                     # SS-EXTRACT BIT FIELD # 
        PROC SSBSBF;                     # SS-STOREBIT FIELD #
        PROC SSBTBW;                     # SS-TEST BIT IN WORD #
        FUNC SSDCDA;                     # SS-DISPLAY TO ASCII #
        PROC SSTAQE;                     # SS-ACCEPT QUEUE ENTRY #
        END 
# 
****
# 
 
 
      ITEM OORD         U;               # OCB ORDINAL #
      ITEM NORD         U;               # NPUCB ORDINAL #
      ITEM I            U;               # LOOP INDUCTION VAR # 
      ITEM DORD         U;               # CHAR MOVE VARS # 
      ITEM DBIT         U;
      ITEM AORD         U;
      ITEM ABIT         U;
      ITEM Y            U;               # LOOP INDUCTION VAR # 
      ITEM SCHAR        U;               # CHARACTER VAR #
      ITEM FOUND        B;               # NPUCB ORDINAL FOUND FLAG # 
      ITEM MCINDX       U;               # MSG COUNT PARM INDX #
      ITEM RUNNING      B;               # OLD RUNNING FLAG # 
 
 
# 
*     MSGTXT - DIAGNOSTIC MESSAGE TEXT. 
# 
 
      ARRAY MSGTXT [00:00] S(4);
        BEGIN 
        ITEM MSG$NP     C(00,00,07);     # NPU NAME # 
        ITEM MSG$TXT1   C(00,42,06) = ["/OLD: "]; 
        ITEM MSG$TX2    C(01,18,20);
        ITEM MSG$ZRO   U(03,18,42) = [0]; 
        END 
 
 
 
 
# 
*     INITIALIZE OUTGOING ENTRY WORDS, OCB AND NPUCB ORDINALS, AND
*     MESSAGE TEXT MESSAGE. 
# 
 
      OORD = HDR$OPORD[0];
 
      FOUND = FALSE;
# 
*     FIND NPUCB ORDINAL IN COMMAND PARAMETER ARRAY.
# 
 
      FOR I = 0 STEP 1 WHILE NOT FOUND
      DO
 
        BEGIN 
        IF PAR$PCODE[I] EQ "NOR"
        THEN
 
          BEGIN 
          NORD = PAR$ORD[I];
          FOUND = TRUE; 
          END 
 
        END 
 
      MSG$NP[0] = NPU$NAME[NORD]; 
      WCB$WORD[0] = 0;
      WCB$WORD[1] = 0;
      ABHWORD[0] = 0; 
      ABHWORD[1] = 0; 
      ABHADR[0] = OORD; 
      WCB$WC[0] = 5;
 
# 
*     ORIGIN OPERATOR MAY NOT BE CURRENT OLD OPERATOR. IF SO, SEND
*     ERROR MESSAGE.
# 
 
      SSBTBW(NPU$OVFLGS[NORD],OORD,RUNNING);
 
      IF NOT RUNNING
      THEN
        MSG$TX2[0] = "NO PRIOR REQUEST CMD";
      ELSE
 
# 
*     CURRENT OLD OPERATOR SAME AS ORIGIN BUT OLD REQUEST MAY STILL BE
*     OUTSTANDING. IF SO, SEND INPROGRESS MESSAGE.
# 
 
# 
*     EVERYTHING OK FOR SEND OF OLDDT SM TO OLD PROGRAM OF NPU. 
# 
 
        BEGIN 
        WCB$SMID[1] = SMID"OLDDT";
        ABHDN[1] = NPU$NID[NORD]; 
        ABHSN[1] = NPU$HID[NORD]; 
        ABHABT[1] = APPSUP; 
        ABHBT[1] = APPSUP;
        ABHACT[1] = ACTCSNP$; 
        PFCSFC[1] = OLDDT;
        OLDDO[1] = OORD;
 
# 
*     CONVERT THE MESSAGE TEXT TO ASCII AND STORE INTO OUTGOING SM
# 
 
        FOUND = FALSE;
        FOR I = 0 STEP 1 WHILE NOT FOUND
        DO
 
          BEGIN 
          IF PAR$PCODE[I] EQ "MS0"
          THEN
 
            BEGIN 
            DORD = I + 1; 
            MCINDX = I; 
            FOUND = TRUE; 
            END 
          END 
 
        DBIT = 0; 
        AORD = 0; 
        ABIT = 24;
        ABHTLC[1] = PAR$MSGCL[MCINDX] + 3;
 
        FOR Y = 1 STEP 1 UNTIL PAR$MSGCL[MCINDX]
        DO
 
          BEGIN 
          SSBEBF(PARMS[0],DORD,DBIT,6,SCHAR); 
          SCHAR = SSDCDA(SCHAR);
          SSBSBF(CSSM[1],AORD,ABIT,8,SCHAR);
          END 
 
        WCB$WC[1] = ((ABHTLC[1] + 9)/10) + 2; 
        SSTAQE(P<OTQ>,WCBUF[1],ABH[1],CSSM[1]); 
        WCB$WC[0] = 2;
        END 
 
# 
*     SEND TTEXT TO OPERATOR
# 
 
      WCB$IAF[0] = TRUE;
      WCB$SMID[0] = SMID"TTEXT";
      SSTAQE(P<CNQ>,WCBUF[0],ABH[0],MSGTXT[0]); 
 
      END  # CSSATM # 
 TERM