Retro1.org codex

*DECK NS$SLB
USETEXT COM$NS
USETEXT DEF$NS
USETEXT ERR$NS
USETEXT LTSB$NS 
USETEXT NAT$NS
USETEXT NPT$NS
USETEXT PFC$NS
USETEXT SMB$NS
USETEXT SMD$NS
 
PROC NS$SLB((RNAME),(RI),ERRCODE);     # SEND LOAD BATCH               #
 
# TITLE NS$SLB - SEND LOAD BATCH.                                      #
 
      BEGIN    # NS$SLB # 
# 
**    NS$SLB - SEND LOAD BATCH. 
* 
*     J.C. LEE    1981
* 
*     THIS ROUTINE SENDS A LOAD BATCH.
* 
*     PROC NS$SLB((RNAME),(RI),ERRCODE) 
* 
*     ENTRY:  
*       RNAME - LOAD MODULE RECORD NAME.
*       RI    - RANDOM INDEX OF RNAME.
* 
*     EXIT: 
*       ERRCODE = "BAD NLF LOAD-PARTITION RECORD".
* 
*     METHOD: 
*       ACCESS LOAD BUFFER IN LOAD-TSB. 
*       CALL READW TO TRANSFER RECORD-HEADER OF 
*       LOAD-PARTITION LOGICL RECORD TO SM-BUFFER.
*       IF TRANSFER COMPLETE: 
*         VALIDATE RECORD NAME IN RECORD-HEADER 
*         IF RECORD NAME MATCH LOAD-PARTITION NAME: 
*           FOR EACH LOAD-PACKET IN LOGICAL RECORD WHILE
*             END-OF-LOAD-PARTITION FLAG FALSE AND
*             ERROR-CODE IS ZERO AND
*             READW COMPLETE: 
*             SEND A LOAD-PACKET. 
*           IF ERROR-CODE EQ 0: 
*             IF LOAD-BATCH-COUNT NQ 0 AND
*                LOAD-BATCH-COUNT LQ LBC: 
*               STORE END-OF-LOAD-PARTITION FLAG IN NAT.
*               STORE CURRENT-RANDOM-INDEX OF LOAD-FET IN NAT.
*               IF LOAD-FET COMPLETE-BIT SET: 
*                 ALLOW LOAD-TSB TO MOVE. 
*               ELSE
*                 SET ERRCODE.
*             ELSE
*               SET ERRCODE.
*           ELSE
*             SET ERRCODE.
*         ELSE
*           SET ERRCODE.
* 
# 
 
      ITEM RNAME      C(6);  # LOAD MODULE RECORD NAME                 #
      ITEM RI         U;     # RANDOM INDEX OF RECORD RNAME ON LFN     #
      ITEM ERRCODE    U;     # ERROR CODE                              #
 
      $BEGIN
      XREF
        BEGIN 
        PROC NS$DBG;         # TRACE PROCEDURE CALL                    #
        END 
      $END
 
      XREF
        BEGIN 
        PROC MOVEOK;         # ALLOW TSB TO MOVE                       #
        PROC NETPUT;         # SEND MESSAGE                            #
        PROC NS$FBH;         # FORMAT ABH AND CLEAR SM BUFFER          #
        FUNC NS$FEC U;       # FORMAT ERROR CODE                       #
        FUNC NS$XZFN C(10);  # ZERO-FILLED FILE NAME                   #
        PROC READ;
        PROC READW;          # READW DATA TRANSFER                     #
        PROC RECALL;         # RECALL                                  #
        PROC TSBINFO;        # LOCATE TSB                              #
        END 
 
      ITEM ERROR      B;     # ERROR FLAG                              #
      ITEM F$LAST     B;     # END OF LOAD MODULE FLAG                 #
      ITEM LBC        I;     # LOAD BATCH COUNT                        #
      ITEM LFN        C(7);  # FILE WHERE LOAD MODULE RESIDES          #
      ITEM LTSBN      U;     # TSB NUMBER OF LOAD TSB                  #
      ITEM N          U;     # SM TEXT LENGTH IN CM WORDS              #
      ITEM STAT       U;     # READW RETURN STATUS                     #
      ITEM TLC        U;     # SM TEXT LENGTH IN ASCII CHARACTERS      #
      ITEM TSBFWA     U;     # FWA OF TSB                              #
      ITEM TSBSIZE    U;     # SIZE OF TSB                             #
 
      DEF L$RHDR      # 1 #; # LOAD MODULE RECORD HEADER LENGTH        #
      BASED ARRAY LMR$RHDR [0:0] S(L$RHDR); 
        BEGIN                # LOAD MODULE RECORD HEADER               #
        ITEM LMR$RNAME  C(0,0,6);  # CCP LOAD MODULE NAME              #
        END 
 
      DEF L$LPHDR     # 1 #; # LOAD PACKET HEADER LENGTH               #
      BASED ARRAY LMR$LPHDR [0:0] S(L$LPHDR); 
        BEGIN                # LOAD PACKET HEADER                      #
        ITEM LPH$F$LAST B(0,0,1);      # END OF MODULE FLAG            #
        ITEM LPH$TLC    U(0,24,18);    # TEXT LENGTH IN ASCII CHARACTER#
        ITEM LPH$PS     U(0,42,18);    # LOAD PACKET SIZE IN CM WORDS  #
        END 
 
      DEF MAX$LPSIZE  # 30 #;          # MAX LOAD PACKET SIZE ALLOWED  #
      BASED ARRAY LMR$LPENT [1:MAX$LPSIZE] S(1);
        BEGIN                # LOAD PACKET                             #
        ITEM LPE$WORD   U(0,0,60);
        END 
 
      ARRAY NCBPBA [0:0] S(1);
        BEGIN                # NCB LOAD PACKET BEGINNING ADDRESS       #
        ITEM PBA1     U(0,36,4);
        ITEM PBA2     U(0,40,20); 
        ITEM PBA      U(0,36,24); 
        END 
 
CONTROL EJECT;
 
      $BEGIN
      NS$DBG("SLB");
      $END
 
      ERRCODE = 0;
      ERROR = FALSE;
      LTSBN = LTW$LTSBN[0];            # LOAD TSB NUMBER               #
      TSBINFO(TSBSIZE,TSBFWA,LTSBN);   # LOCATE LOAD TSB               #
 
      IF RNAME EQ "NCB   "
      THEN                             # LOAD NETWORK CONFIGURATION BLK#
        LFN = LFN$NCF;                 # FROM NCF                      #
 
      ELSE                             # LOAD MODULE FROM NLF          #
        BEGIN 
        IF NPT$ALFWD[NTORD] NQ 0
        THEN # ALTERNATE CCP LOAD FILE IN EFFECT                       #
          LFN = NPT$ALFPFN[NTORD];
        ELSE # DEFAULT CCP LOAD FILE                                   #
          LFN = LFN$NLF;
        END 
 
      P<LTSB$FET> = TSBFWA + L$LTSBHDR; # FWA OF LOAD FET              #
      LFET$LFN[0] = NS$XZFN(LFN);      # SET LFN                       #
      P<LTSB$BUF> = P<LTSB$FET> + L$LFET; # FWA OF CIO BUFFER          #
      LFET$FIRST[0] = P<LTSB$BUF>;     # FIRST PTR                     #
      LFET$IN[0] = P<LTSB$BUF>;        # IN PTR                        #
      LFET$OUT[0] = P<LTSB$BUF>;       # OUT PTR                       #
      LFET$LIMIT[0] = P<LTSB$BUF> + L$LBUF; # LIMIT PTR                #
      LFET$RR[0] = RI;                 # SET RANDOM INDEX              #
      P<LMR$RHDR> = LOC(ABH$WORD);     # FWA OF WORKING BUFFER         #
 
      READ(LTSB$FET);                  # INITIATE READ                 #
      RECALL(LTSB$FET);                # WAIT TILL I/O COMPLETES       #
 
      READW(LTSB$FET,LMR$RHDR,L$RHDR,STAT); # READ RECORD HEADER       #
 
      IF STAT EQ READWOK               # TRANSFER COMPLETE             #
        AND LMR$RNAME[0] EQ RNAME      # RECORD NAME MATCH             #
      THEN
        BEGIN                # SEND LOAD BATCH                         #
        F$LAST = FALSE; 
 
        FOR LBC = 0 WHILE NOT ERROR          # LOAD RECORD FORMAT OK   #
                      AND STAT EQ READWOK        # TRANSFER COMPLETE   #
        DO                   # SEND LOAD PACKET(S) TILL EOR IS REACHED #
          BEGIN              # SEND A LOAD PACKET                      #
          P<LMR$LPHDR> =LOC(ABH$WORD); # BUF FWA FOR PACKET HEADER     #
 
          READW(LTSB$FET,LMR$LPHDR,L$LPHDR,STAT); # READ PACKET HEADER #
 
          IF STAT EQ READWOK
          THEN               # TRANSFER COMPLETE                       #
            BEGIN 
            F$LAST = LPH$F$LAST[0];    # SAVE END OF LOAD MODULE FLAG  #
            P<LMR$LPENT> = LOC(SMB$BUFFER); # BUF FWA FOR LOAD PACKET  #
            N = LPH$PS[0] - L$LPHDR;   # LOAD PACKET LENGTH IN CM WORD #
 
            IF N LQ MAX$SMSIZE         # VALID LOAD PACKET LENGTH      #
              AND LBC EQ 0             # NOT END OF BATCH              #
            THEN
              BEGIN 
              NS$FBH(LPH$TLC[0],FALSE); # FORMAT ABH FOR NETWORK SM    #
 
              READW(LTSB$FET,LMR$LPENT,N,STAT); # READ LOAD PACKET     #
 
              IF STAT EQ READWOK       # TRANSFER COMPLETE             #
              THEN           # LOAD PACKET READ INTO SMB$BUFFER        #
                BEGIN 
                  LBC = NPUBC[0];      # SAVE LOAD BATCH COUNT         #
                  NPUPO[0] = NAT$PN[0];  # STORE PORT NUMBER           #
                  NPUSP[0] = NAT$SPN[0]; # STORE SUBPORT NUMBER        #
                  NPULS[0] = NAT$LSN[0]; # STORE LOAD SEQUENCE NUMBER  #
 
                  IF RNAME EQ "NCB   "
                  THEN       # LOADING NCB FROM NCF                    #
                    BEGIN    # UPDATE BEGINNING ADDRESS                #
                    PBA[0] = NAT$NCBFWA[0] + NPUBA2[0]; 
                    NPUBA2[0] = PBA2[0];
                    NPUBA1[0] = NPUBA1[0] + PBA1[0];
                    END 
 
                NETPUT(ABH$WORD,SMB$BUFFER);     # SEND SM TO NPU      #
 
                END 
 
              ELSE           # BAD LOAD RECORD                         #
                ERROR = TRUE; 
 
              END 
 
            ELSE             # BAD LOAD PACKET LENGTH                  #
              ERROR = TRUE; 
 
            END 
 
          ELSE               # END OF RECORD REACHED                   #
            BEGIN 
            IF LBC EQ 0 
            THEN             # NOT END OF BATCH                        #
              ERROR = TRUE; 
            END 
 
          END 
        END 
 
      ELSE                   # BAD RECORD HEADER                       #
        ERROR = TRUE; 
 
      IF NOT ERROR
      THEN                   # WHOLE RECORD READ                       #
        BEGIN 
        NAT$BC[0] = LBC;               # STORE LOAD BATCH COUNT        #
        NAT$F$DP[0] = F$LAST;          # SET DIRECTIVE DONE FLAG       #
        NAT$CRRI[0] = RI;    # SAVE CURRENT RANDOM INDEX OF FILE       #
        NAT$NRRI[0] = LFET$CRI[0];     # RANDOM INDEX OF NEXT RECORD   #
        END 
 
      ELSE                   # LOAD RECORD ERROR                       #
        BEGIN 
        ERRCODE = NS$FEC(EC"ERR$FILE",FEC"ERR$LM"); 
        END 
 
      RECALL(LTSB$FET);      # WAIT TILL I/O COMPLETES                 #
 
      MOVEOK(LTSBN);         # ALLOW LOAD TSB TO MOVE                  #
 
      RETURN; 
      END   # NS$SLB #
      TERM