Retro1.org codex

*DECK NS$FLR
USETEXT COM$NS
USETEXT DIR$NS
USETEXT ERR$NS
USETEXT NPT$NS
 
PROC NS$FLR((RNAME),RI,RL,ERRCODE);    # FIND LOAD RECORD              #
 
# TITLE NS$FLR - FIND LOAD RECORD.                                     #
 
      BEGIN    # NS$FLR # 
# 
**    NS$FLR - FIND LOAD RECORD.
* 
*     J.C. LEE    1981
* 
*     THIS ROUTINE FINDS A LOAD RECORD. 
* 
*     PROC NS$FLR((RNAME),RI,RL,ERRCODE)
* 
*     ENTRY:  
*       RNAME - NAME OF LOAD MODULE RECORD. 
* 
*     EXIT: 
*       ERRCODE.
*       RI - RANDOM INDEX OF LOAD MODULE RECORD.
*       RL - LOAD MODULE RECORD LENGTH. 
* 
*     METHOD: 
*       DETERMINE IF DEFAULT OR ALTERNATE CCP LOAD FILE 
*       (NLF) IN EFFECT.
*       LOCATE NLF-INDEX-RECORD TSB.
*       SEARCH NLF-INDEX-RECORD FOR MATCH "RNAME".
*       IF FOUND, RETURN "RI" AND "RL". 
*       ELSE, SET ERRCODE TO "NLF ERROR-LOAD MODULE MISSING". 
* 
# 
 
      ITEM RNAME      C(6);  # NAME OF LOAD MODULE RECORD              #
      ITEM RI         U;     # RANDOM INDEX OF LOAD MODULE RECORD      #
      ITEM RL         U;     # RECORD LENGTH                           #
      ITEM ERRCODE    U;     # ERROR CODE                              #
      ITEM TSBFWA     U;     # TSB FWA                                 #
      ITEM TSBN       U;     # TSB NUMBER                              #
      ITEM TSBSIZE    U;     # TSB SIZE                                #
 
      $BEGIN
      XREF
        BEGIN 
        PROC NS$DBG;         # TRACE PROCEDURE CALL                    #
        END 
      $END
 
      XREF
        BEGIN 
        FUNC NS$FEC U;       # FORMAT ERROR CODE                       #
        PROC MOVEOK;         # ALLOW TSB TO MOVE                       #
        PROC TSBINFO;        # LOCATE TSB                              #
        END 
 
      ITEM FOUND      B;     # RECORD FOUND FLAG                       #
      ITEM I          I;     # LOOP VARIABLE                           #
      ITEM TEMP       U;     # TEMPORARY VARIABLE                      #
 
CONTROL EJECT;
 
      $BEGIN
      NS$DBG("FLR");
      $END
 
      ERRCODE = 0;
      FOUND = FALSE;
 
      IF NPT$ALFWD[NTORD] NQ 0
      THEN # ALTERNATE CCP LOAD FILE IN EFFECT                         #
        BEGIN 
        TSBN = NPT$DIRTSB[NTORD]; # DIRECTORY TSB                      #
        TSBINFO(TSBSIZE,TSBFWA,TSBN); # LOCATE TSB                     #
        P<DIR> = TSBFWA; # FWA OF ALTERNATE NLF DIRECTORY              #
        MOVEOK(TSBN); # ALLOW DIRECTORY TSB TO MOVE                    #
        END 
 
      ELSE # DEFAULT CCP LOAD FILE                                     #
        P<DIR> = NLFDIRFWA; # FWA OF DEFAULT NLF DIRECTORY             #
 
      TEMP = (DIR$WC[0] - 1) / DIR$ENTRYL; # ENTRIES IN INDEX RECORD   #
 
      FOR I = 1 STEP 1 WHILE I LQ TEMP
                         AND NOT FOUND
      DO                     # SEARCH INDEX RECORD FOR LOAD MODULE     #
        BEGIN 
        IF DIR$RNAME[I] EQ RNAME
        THEN                 # FOUND ENTRY FOR LOAD PARTITION          #
          BEGIN 
          RI = DIR$RSA[I];   # RANDOM INDEX                            #
          RL = DIR$RL[I];    # RECORD LENGTH                           #
          FOUND = TRUE; 
          END 
        END 
 
      IF NOT FOUND
      THEN                   # NLF ERROR-LOAD MODULE MISSING           #
        BEGIN 
        ERRCODE = NS$FEC(EC"ERR$FILE",FEC"ERR$LMNF"); 
        END 
 
      RETURN; 
      END   # NS$FLR #
      TERM