Retro1.org codex

*DECK     CSSATD
USETEXT TEXTCS; 
USETEXT TEXTSS; 
USETEXT TXCMDCS;
USETEXT TXTAPSS;
USETEXT TXTSUSS;
USETEXT TXTSMCS;
PROC CSSATD;
# TITLE CSSATD - ACTION TEST DROP COMMAND. #
 
      BEGIN  # CSSATD # 
 
# 
**    CSSATD - ACTION TEST DROP COMMAND.
* 
*     C. BRION          82/06/09. 
* 
*     THIS PROCEDURE PROCESSES THE DIAGNOSTIC TEST DROP COMMAND 
*     REQUEST.
* 
*     PROC CSSATD 
* 
*     ENTRY:  
* 
*       HDRCMD = COMMAND HEADER WORD. 
*       PARMS = COMMAND PARAMETER ARRAY.
* 
*     EXIT: 
* 
*       AN OVL/TM SM MAY BE SENT TO THE NPU.
*       A NULL TTEXT ENTRY MAY BE SENT TO THE OPERATOR. 
# 
 
# 
****  PROC CSSATD XREF LIST 
# 
 
      XREF
        BEGIN 
        PROC SSBCBW;                     # SS-CLEAR BIT IN WORD # 
        PROC SSBTBW;                     # SS-TEST BIT IN WORD #
        PROC SSTAQE;                     # SS-ACCEPT QUEUE ENTRY #
        END 
# 
****
# 
 
      DEF NOLDTM$       # 2 #;           # CHAR LEN OF SM # 
 
      ITEM OORD         U;               # OCB ORDINAL #
      ITEM NORD         U;               # NPUCB ORDINAL #
      ITEM I            U;               # LOOP INDUCTION VAR # 
      ITEM RUNNING      B;               # ONLINE DIAG RUNNING FLAG    #
 
 
# 
*     DMTXT - DROP MESSAGE TEXT.
# 
 
      ARRAY DMTXT [00:00] S(4); 
        BEGIN 
        ITEM DMT$NP     C(00,00,07);     # NPU NAME # 
        ITEM DMT$TX1    C(00,42,06) = [": OLD "]; 
        ITEM DMT$TX2    C(01,18,20) = ["NO PRIOR REQUEST CMD"]; 
        ITEM DMT$ZERO   U(03,18,42) = [0];
        END 
 
 
# 
*     FLG$WORD - THIS BASED ARRAY POINTS TO THE ONLINE DIAGNOSTIC 
*     OPERATOR BIT MAP IN THE NPUCB.
# 
      BASED ARRAY FLG$WORD [00:00] S(NPCBSZ$);
        BEGIN 
        ITEM FW$WORD    I(00,00,60);
        END 
 
 
 
 
# 
*     SET OCB ORDINAL AND THE NPUCB ORDINAL.
*     ALSO, SET UP TEXT MESSAGE NPU NAME AND THE OUTGOING SM ENTRY
*     HEADER WORDS. 
# 
 
      OORD = HDR$OPORD[0];
 
      FOR I = 0 STEP 1 UNTIL (HDR$TXWCNT[0] + HDR$SPCNT[0] +
                                HDR$APCNT[0]) 
      DO
 
        BEGIN 
        IF PAR$PCODE[I] EQ "NOR"
        THEN
          NORD = PAR$ORD[I];
        END 
 
      DMT$NP[0] = NPU$NAME[NORD]; 
      WCB$WORD[0] = 0;
      ABHWORD[0] = 0; 
      WCB$WORD[1] = 0;
      ABHWORD[1] = 0; 
      ABHADR[0] = OORD; 
 
# 
*     IF ORIGIN OPERATOR NOT CURRENT OVERLAY OPERATOR OF NPU, THEN
*     INFORM WITH ERROR MESSAGE.
# 
 
      SSBTBW(NPU$OVFLGS[NORD],OORD,RUNNING);
 
      IF NOT RUNNING
      THEN
        BEGIN 
        WCB$SMID[1] = SMID"TTEXT";
        WCB$IAF[1] = TRUE;
        WCB$WC[1] = 6;
        ABHADR[1] = OORD; 
        SSTAQE(P<CNQ>,WCBUF[1],ABH[1],DMTXT[0]);
        END 
      ELSE
 
# 
*     THE CURRENT OPERATOR MAY BE DROPPING THE OVERLAY REQUEST PRIOR
*     TO COMPLETION OF THE REQUEST. SET THE CURRENT OVERLAY ORDINAL 
*     OF THE NPUCB OUT OF RANGE. OTHERWISE, CLEAR THE NPUCB AND SET 
*     OVERLAY STATE TO IDLE.
# 
 
 
        BEGIN 
        P<FLG$WORD> = LOC(NPU$OVFLGS[NORD]);
        SSBCBW(FLG$WORD,OORD);
 
# 
*     SET UP OUTGOING OVERLAY TERMINATE SM. 
# 
 
        ABHDN[1] = NPU$NID[NORD]; 
        ABHSN[1] = NPU$HID[NORD]; 
        ABHABT[1] = APPSUP; 
        ABHBT[1] = APPSUP;
        ABHACT[1] = ACTCSNP$; 
        ABHTLC[1] = NOLDTM$;
        PFCSFC[1] = OLDTM;
        OLDDO[1] = OORD;
        WCB$WC[1] = ((ABHTLC[1] + 9)/10) + 2; 
        WCB$SMID[1] = SMID"OLDTM";
        SSTAQE(P<OTQ>,WCBUF[1],ABH[1],CSSM[1]); 
 
# 
*     SET UP AND SEND NULL TTEXT ENTRY TO OPERATOR TO CAUSE READY.. 
# 
 
        WCB$WC[1] = 2;
        WCB$SMID[1] = SMID"TTEXT";
        WCB$IAF[1] = TRUE;
        ABHADR[1] = OORD; 
        SSTAQE(P<CNQ>,WCBUF[1],ABH[1],CSSM[1]); 
        END 
 
      END  #CSSATD# 
 TERM