Retro1.org codex

*DECK NS$IND
USETEXT COM$NS
USETEXT DEF$NS
USETEXT DTSB$NS 
USETEXT ERR$NS
USETEXT NAT$NS
USETEXT NPT$NS
USETEXT NDCB$NS 
USETEXT NDF$NS
USETEXT PIC$NS
USETEXT PFC$NS
USETEXT PRF$NS
USETEXT SMB$NS
USETEXT SMD$NS
 
PROC NS$IND(ERRCODE);        # INITIATE NPU DUMP                       #
 
# TITLE NS$IND - INITTIATE NPU DUMP.                                   #
 
      BEGIN    # NS$IND # 
# 
**    NS$IND - INITIATE NPU DUMP. 
* 
*     J.C. LEE    1981
* 
*     THIS ROUTINE INITIATES NPU DUMP.
* 
*     PROC NS$IND(ERRCODE)
* 
*     ENTRY:  
*       NONE. 
* 
*     EXIT: 
*       ERRCODE - IF A BAD DPCB FOUND IN NLF. 
* 
*     METHOD: 
*       CLEAR NPU-STATE.
*       SET NPU-PRIMARY-STATE TO "DUMPING NPU". 
*       LOCATE PICB-TSB.
*       IF DPCB EXISTS: 
*         SET XPCB-DIRECTIVE INDEX TO PICB INDEX OF 
*           DPCB HEADER.
*         SET XPCB-END-DIRECTIVE INDEX TO PICB-INDEX
*           OF DPCB END DIRECTIVE.
*         FORMAT EVENT MESSAGE AND DISPATCH IT. 
*         DEFINE NDF TO DEFINE A NPU DUMPFILE NPXXXYY.
*         IF NO ERROR:  
*           IF "RT" IS SPECIFIED IN NS CONTROL CARD:  
*             FORMAT AND NETPUT NPU/REL/R.
*           REQUEST TSB FOR NPU DUMP TSB. 
*           STORE TSBN IN DUMP-TSBN.
*           INITIALIZE NDF PREFIX TABLE IN SM BUFFER. 
*           TRANSFER NDF PREFIX TABLE TO NPU DUMP BUFFER. 
*           START GLOBAL TIMER. 
*       ELSE: 
*         SET ERROR CODE AND EXIT.
* 
# 
 
      ITEM ERRCODE    U;     # ERROR CODE                              #
 
      $BEGIN
      XREF
        BEGIN 
        PROC NS$DBG;         # TRACE PROCEDURE CALL                    #
        END 
      $END
 
      XREF
        BEGIN 
        FUNC EDATE;          # CONVERT PACKED DATE TO DISPLAY CODE     #
        FUNC ETIME;          # CONVERT PACKED TIME TO DISPLAY CODE     #
        PROC MOVEOK;         # ALLOW TSB TO MOVE                       #
        PROC NS$ABH;         # FORMAT ABH                              #
        FUNC NS$CHD C(4);              # CONVERT TO DISPLAY -CODED HEX #
        FUNC NS$FEC U;       # FORMAT ERROR CODE                       #
        PROC NS$GNW;         # GET NPU WORD                            #
        PROC NS$LSN;         # INCREMENT LOAD SEQUENCE NUMBER          #
        PROC NS$MSG;         # DISPATCH MESSAGE                        #
        PROC NS$NDF;         # DEFINE NDF                              #
        PROC NS$SGT;         # START ACTIVITY TIMER                    #
        PROC NETPUT;         # NETPUT                                  #
        PROC PDATE;          # GET PACKED BINARY DATE/TIME             #
        PROC REQTSB;         # REQUEST TSB                             #
        PROC TSBINFO;        # LOCATE TSB                              #
        PROC VERSION;        # GET OPERATING SYSTEM VERSION            #
        END 
 
      ITEM I          I;     # INDEX TO DPCB HEADER                    #
      ITEM K          I;     # INDEX TO LAST DPCB DIRECTIVE            #
      ITEM NDFPFN     C(7);  # PFN OF NPU DUMP FILE                    #
      ITEM OPSVERSION C(10);           # OPERATING SYSTEM VERSION      #
      ITEM PICBTSBN   U;     # TSB NUMBER OF PICB                      #
      ITEM TEMP       U;     # TEMPORARY VARIABLE                      #
      ITEM TSBN       U;     # TSB NUMBER                              #
      ITEM TSBFWA     U;     # TSB FWA                                 #
      ITEM TSBSIZE    U;     # TSB SIZE                                #
 
      ARRAY COMMENT [0:0] S(7); 
        BEGIN # PREFIX TABLE COMMENT LISTABLE BY CATALOG/ITEMIZE       #
        ITEM NDFCOMMENT C(0,0,70) =    # COMMENT TEXT                  #
          ["  NPUNAME/VARNPU MEMORY DUMP FOR HALT XXXX AT AAAA."];
        ITEM CMTNPUNAME C(0,12,7);     # NPU NAME                      #
        ITEM CMTNPUVAR  C(1,0,6);      # NPU VARIANT NAME              #
        ITEM CMTHALT    C(3,48,4);     # NPU HALT CODE                 #
        ITEM CMTPREG    C(4,36,4);     # NPU P-REGISTER CONTENT        #
        END 
 
      ARRAY STAT [0:0] S(1);
        BEGIN 
        ITEM STATWORD   U(00,00,60);   # PARAMETER FOR VERSION CALL    #
        ITEM BC         U(00,00,12);   # NO OF 12-BIT BYTES TO RETURN  #
        ITEM SB         U(00,12,12);   # STARTING BYTE IN SOURCE FIELD #
        ITEM BP         U(00,24,12);   # STARTING BYTE IN RECEIVING FIL#
        ITEM WADDR      I(00,42,18);   # ADDRESS TO RECEIVE VERSION NO #
        END 
 
      DEF L$EM21     # 3 #;                      # LENGTH IN CM WORDS  #
      DEF DM$EM21    # DM$LOCAL+DM$EVENT+DM$NAMLOG #; # ROUTE OPTION   #
      ARRAY MSG$EM21 [0:0] S(L$EM21); 
        BEGIN 
        ITEM EM21$TEXT  C(0,0,22) =              # EVENT MESSAGE TEXT  #
          ["NPUNAME, DUMP STARTED."]; 
        ITEM EM21$NPNAM C(0,00,7);               # NPU NAME            #
        ITEM EM21$END   U(2,12,48) = [0];        # END OF TEXT         #
        END 
 
      ARRAY ABH [0:0] S(1); 
        BEGIN # APPLICATION BLOCK HEADER WORD FOR NPD/REL/SM           #
        ITEM ABH$ABT    U(00,00,06) = [APPCMD]; 
        ITEM ABH$ADR    U(00,06,12) = [0];
        ITEM ABH$ABN    U(00,18,18) = [0];
        ITEM ABH$ACT    U(00,36,04) = [CT60TRANS];
        ITEM ABH$DBC    U(00,40,08) = [0];
        ITEM ABH$TLC    U(00,48,12) = [LNPD]; 
        END 
 
      ARRAY SM$NPDREL [0:0] S(LNPD);
        BEGIN # NPD/REL/SM   #
        ITEM SM$PFCSFC  U(00,00,16) = [NPDREL]; # PFC/SFC CODE         #
        ITEM SM$F1      U(00,16,44) = [0];
        END 
 
CONTROL EJECT;
 
      $BEGIN
      NS$DBG("IND");         # TRACE CALL                              #
      $END
 
      ERRCODE = 0;
      NAT$STATE[0] = 0;                  # CLEAR NPU STATE             #
      NAT$PSTATE[0] = S"NPS$DNPU";       # PRIMARY STATE = DUMPING NPU #
# 
      LOCATE PICB 
# 
      PICBTSBN = NAT$PITSBN[0];          # TSB NUMBER OF PICB          #
      TSBINFO(TSBSIZE,TSBFWA,PICBTSBN);  # LOCATE PICB                 #
      P<PICB> = TSBFWA;                  # FWA OF PICB                 #
      I = PICB$HDRL + PICB$PARWL;        # INDEX TO DPCB HEADER        #
      K = I + PICB$LDPCB[PICB$HDRL] - 1; # INDEX TO LAST DPCB DIRECTIVE#
 
      IF PICB$PCBID[I] EQ ID$DPCB            # VALID IDENTIFIER        #
        AND K LQ PICB$BS[0]                  # DPCB SIZE WITHIN LIMIT  #
        AND PICB$CODE[K] EQ DIRCODE"ENDPCB"  # END DIRECTIVE EXISTS    #
      THEN                               # VALID DPCB                  #
        BEGIN                            # INITIATE NPU DUMP PROCEDURE #
        NAT$PDIRI[0] = I;                # CURRENT DPCB DIRECTIVE INDEX#
        NAT$PENDI[0] = K;                # LAST DPCB DIRECTIVE INDEX   #
        EM21$NPNAM[0] = NPNAM;           # SET NPU NAME                #
        NS$MSG(MSG$EM21,L$EM21,DM$EM21); # SEND EVENT MESSAGE          #
 
        NS$NDF(NDFPFN,ERRCODE);          # DEFINE NDF                  #
 
        IF ERRCODE EQ 0 
        THEN                             # NDF DEFINED                 #
          BEGIN 
          REQTSB(L$DTSB,TSBFWA,TSBN);    # REQUEST TSB FOR DUMP TSB    #
 
          NAT$NDTSBN[0] = TSBN;          # SAVE DUMP TSB NUMBER IN NAT #
          P<DTSB$HDR> = TSBFWA;          # FWA OF DTSB                 #
          PDATE(DTSB$HDR);               # SET PACKED BINARY DATE/TIME #
          DTSB$ID[0] = DTSB$IDENT;       # SET TSB IDENTIFIER          #
          DTSB$BS[0] = L$DTSB;           # SET TSB SIZE                #
 
          $BEGIN
          IF RT EQ ASC$YY 
          THEN                           # RELEASE TRACE FILE          #
            NETPUT(ABH,SM$NPDREL); # SEND NPD/REL/SM TO NIP            #
          $END
# 
          INITIALIZE FET FOR SEQUENTIAL WRITE OF NDF
# 
          P<DTSB$FET> = P<DTSB$HDR> + L$DTSBHDR; # FWA OF FET          #
          DFET$LFN[0] = NDFPFN;                  # SET LFN             #
          DFET$FM[0] = TRUE;                     # SET BINARY FILE MODE#
          DFET$COMP[0] = TRUE;                   # SET COMPLETE BIT    #
          P<DTSB$BUF> = P<DTSB$FET> + L$DFET;    # FWA OF CIO BUFFER   #
          DFET$LEN[0] = L$DFET - 5;              # FET LENGTH          #
          DFET$FIRST[0] = P<DTSB$BUF>;           # FIRST PTR           #
          DFET$IN[0] = P<DTSB$BUF> + L$PRFNDF;   # IN PTR              #
          DFET$OUT[0] = P<DTSB$BUF>;             # OUT PTR             #
          DFET$LIMIT[0] = P<DTSB$BUF> + L$DBUF;  # LIMIT PTR           #
# 
          FORMAT PREFIX TABLE FOR NDF 
# 
          P<PRF$TABLE> = P<DTSB$BUF>; 
          PRF$ID[0] = PRF$IDENT;       # PREFIX TABLE IDENTIFIER       #
          PRF$WC[0] = L$PRFNDF;        # SET NDF PREFIX TABLE SIZE     #
          PRF$LFN[0] = NDFPFN;         # SET DUMP FILE LFN             #
          TEMP = EDATE(DTSB$DDATE[0]); # GET DISPLAY-CODED DUMP DATE   #
          PRF$DATE[0] = C<1,8>TEMP;    # SET DUMP DATE                 #
          TEMP = ETIME(DTSB$DTIME[0]); # GET DISPLAY-CODED DUMP TIME   #
          PRF$TIME[0] = C<1,8>TEMP;    # SET DUMP TIME                 #
          STATWORD[0] = 0;             # SET UP PARAMETERS FOR VERSION #
          BC[0] = 5;
          WADDR[0] = LOC(OPSVERSION); 
          VERSION(STAT);               # GET VERSION OF OPERATING SYS  #
          PRF$OPS[0] = OPSVERSION;     # SET OPS VERSION               #
          PRF$NSVER[0] = NSVER[0];     # SET NS VERSION                #
          CMTNPUNAME[0] = NPNAM;       # SET NPU NAME IN COMMENT       #
          PRF$NPNAME[0] = NPNAM;       # SET NPU NAME                  #
 
          TSBN = NAT$SMTSBN[0];        # TSB NO OF DUMP NDCB RESPONSE  #
          TSBINFO(TSBSIZE,TSBFWA,TSBN);    # LOCATE NDCB TSB           #
          P<NDCB> = TSBFWA;            # FWA OF DUMP NDCB RESPONSE     #
          NS$GNW(NDCB,LNPUDTDN,NDCBINDEX"NDCB$PREG",TEMP);
          PRF$NPPREG[0] = TEMP;        # SET P-REGISTER HEX VALUE      #
          CMTPREG[0] = NS$CHD(TEMP);   # DISPLAY-CODED HEX P-REG       #
          PRF$NPUVAR[0] = NPT$NPUVAR[NTORD];     # SET NPU VARIANT     #
          CMTNPUVAR[0] = NPT$NPUVAR[NTORD]; # SET NPU VARIANT NAME     #
          PRF$NPUID[0] = NPT$NN[NTORD];          # SET NPU NODE NO     #
          NS$GNW(NDCB,LNPUDTDN,NDCBINDEX"NDCB$HALTC",TEMP); 
          PRF$NPHALT[0] = TEMP;        # SET HEX HALT CODE             #
          CMTHALT[0] = NS$CHD(TEMP);   # DISPLAY-CODED HEX HALT CODE   #
          PRF$COMMNT[0] = NDFCOMMENT[0];
          MOVEOK(TSBN);                # ALLOW NDCB TSB TO MOVE        #
          NS$LSN; # ASSIGN LSN FOR DUMP SEQUENCE                       #
 
 
          NS$SGT;                      # START ACTIVITY TIMER          #
 
          END 
        END 
 
      ELSE                             # NLF ERROR-BAD DPCB            #
        BEGIN 
        ERRCODE = NS$FEC(EC"ERR$FILE",FEC"ERR$DPCB"); 
        END 
 
      MOVEOK(PICBTSBN);                # ALLOW PICB TSB TO MOVE        #
 
      RETURN; 
      END   # NS$IND #
      TERM