Retro1.org codex

*DECK NPININD 
USETEXT NIPDEF
USETEXT NBT 
USETEXT NHEADER 
USETEXT PARAMP
 PRGM NPININD;               # PROCESS INID/MDI FROM PIP               #
 
 STARTIMS;
 STOPIMS; 
 
# 
      EXTERNAL REFERENCES 
# 
      XREF
        BEGIN 
        FUNC GETFIL;         # GET A DIRECT ACCESS PERMANENT FILE      #
        PROC OMSG;           # DAYFILE ERROR MESSAGE                   #
        PROC ROUTE;          # ROUTE JOB FILE TO INPUT QUEUE           #
        PROC XTRACE;         # TRACE CALL                              #
        LABEL RJMAIN; 
        END 
# 
      LOCAL DEFINITIONS 
# 
      DEF PFN$IND # "ZZININD" #; # PFN OF THE INITMDI JOB FILE         #
# 
      LOCAL VARIABLES 
# 
      ITEM FOUND    B;       # NBT ENTRY FOUND INDICATOR               #
      ITEM I        I;       # NBT ENTRY INDEX                         #
      ITEM INDJOBF  C(7);    # PFN FOR GETFIL CALL                     #
      ITEM RSTATUS  U;       # RETURN STATUS OF GETFIL CALL            #
 
      ARRAY DSPERRMSG  S(4);
        BEGIN 
        ITEM DSPERRTEXT C(0,0,30) = [" DSP ERROR NNB, LFN = ZZININD."]; 
        ITEM DSPERRNN   U(1,6,12);     # ERROR CODE FIELD IN DAY MSG   #
        ITEM DSPERREND  U(3,0,60) = [0];
        END 
 
      ARRAY RPARAM P(7);
        BEGIN                # ROUTE JOB PARAMETER BLOCK               #
        ITEM RPAR$JOBF     C(00,00,07); # NAME OF INITMDI JOB FILE     #
        ITEM RPAR$EC       U(00,42,06); # ERROR CODE RESPONSE          #
        ITEM RPAR$F        B(00,48,01); # FORCED ORIGIN FLAG           #
        ITEM RPAR$OT       U(00,53,06); # FORCED JOB ORIGIN TYPE       #
        ITEM RPAR$CB       B(00,59,01); # COMPLETION BIT               #
        ITEM RPAR$DISP     C(01,24,02); # FILE DISPOSITION             #
        ITEM RPAR$EP       B(01,47,01); # ERROR PROCESSING FLAG        #
        ITEM RPAR$FSC      B(01,39,01); # FORCE SERVICE CLASS          #
        ITEM RPAR$ID       B(01,58,01); # ROUTE TO CENTRAL SITE        #
        ITEM RPAR$DCF      B(01,55,01); # DISPOSITION CODSET FLAG      #
        ITEM RPAR$SC       C(04,12,02); # SERVICE CLASS                #
        ITEM RPAR$WD0      U(00,00,60) = [0]; 
        ITEM RPAR$WD1      U(01,00,60) = [0]; 
        ITEM RPAR$WD2      U(02,00,60) = [0]; 
        ITEM RPAR$WD3      U(03,00,60) = [0]; 
        ITEM RPAR$WD4      U(04,00,60) = [0]; 
        ITEM RPAR$WD5      U(05,00,60) = [0]; 
        ITEM RPAR$WD6      U(06,00,60) = [0]; 
        END 
 
      ARRAY INDMSG1 S(5); 
        BEGIN                # ERROR MESSAGE                           #
        ITEM MSG1$TEXT   C(00,00,48) =
          ["NIP/NO INITMDI STARTUP - ZZININD NOT FOUND."];
        ITEM MSG1$END    U(04,48,12) = [0]; 
        END 
 
      ARRAY INDMSG2 S(5); 
        BEGIN                # ERROR MESSAGE                           #
        ITEM MSG2$TEXT   C(00,00,48) =
          ["NIP/BAD MDI INITIATION REQUEST RECEIVED."]; 
        ITEM MSG2$END    U(04,48,12) = [0]; 
        END 
 
      CONTROL EJECT;
 
      BEGIN # NPININD # 
 
      CONTROL IFEQ DEBUG,1; 
      XTRACE("NPIND");       # TRACE CALL                              #
      CONTROL FI; 
 
      P<NHEADER> = PARAMP1 + BLKHSIZE; # NETWORK HEADER WORD           #
      FOUND = FALSE;
 
      FOR I = 0 STEP NBTFETNO WHILE NOT FOUND AND I LQ NBTMAXID 
      DO                     # SEARCH NBT FOR MATCHING COUPLER NODE    #
        BEGIN                # FRONT END MUST BE A ND DEVICE           #
        IF NBTIUF[I]         # NBT ENTRY IS IN USE                     #
          AND NBTHN[I] EQ DN[0] 
        THEN                 # FOUND MATCHING COUPLER NODE             #
          BEGIN 
          FOUND = TRUE; 
 
          IF NBTET[I] EQ "ND" 
          THEN               # NBT ENTRY IS A MDI DEVICE               #
            BEGIN            # INITIATE INITMDI TO LOAD A DOWN MDI     #
            INDJOBF = PFN$IND; # SET INITMDI JOB FILE PFN              #
            RSTATUS = GETFIL(INDJOBF,INDJOBF); # GET PFN               #
 
            IF RSTATUS NQ 0 
            THEN # INITMDI JOB NOT FOUND                               #
              OMSG(INDMSG1,0); # DAYFILE ZZININD FILE NOT FOUND        #
 
            ELSE # ZZININD EXISTS, NOW ROUTE JOB TO SYSTEM             #
              BEGIN 
              RPAR$JOBF[0] = PFN$IND; # SET JOB FILE FILENAME          #
              RPAR$F[0] = TRUE; # SET TO SYSTEM ORIGIN                 #
              RPAR$OT[0] = SYOT; # SET SYSTEM ORIGIN JOB TYPE          #
              RPAR$CB[0] = FALSE; # CLEAR COMPLETION BIT               #
              RPAR$DISP[0] = "IN"; # SET FILE DISPOSITION              #
              RPAR$FSC[0] = TRUE;  # SET FORCED SERVICE CLASS FLAG     #
              RPAR$DCF[0] = TRUE; # SET DISPOSITION CODE SET           #
              RPAR$EP[0] = TRUE;  # SET ERROR PROCESSING FLAG          #
              RPAR$ID[0] = TRUE; # SET ROUTE TO CENTRAL SITE           #
              RPAR$SC[0] = "NS";  # SET NETWORK SERVICE CLASS          #
              ROUTE(RPARAM,1); # ROUTE ZZININD TO INPUT QUEUE          #
              IF RPAR$EC[0] NQ 0
              THEN           # DSP DETECTED ERROR - FILE NOT ROUTED    #
                BEGIN 
                DSPERRNN[0] = RPAR$EC[0] - (RPAR$EC[0]/8)*8 + 
                              (RPAR$EC[0]/8)*64 + O"3333";
                OMSG(DSPERRMSG,0);  # ISSUE DAYFILE MESSAGE            #
                END 
              END 
            END 
 
          ELSE               # PIP ERROR, INIT/MDI SENT ON A NON-MDI   #
            OMSG(INDMSG2,0); # DAYFILE BAD INIT/MDI RECEIVED           #
          END 
        END #   END FOR LOOP #
 
      GOTO RJMAIN;
      END 
      TERM