Retro1.org codex

*DECK LFGMDE
      PROC LFGMDE(PN,RSA,RECL,SUCCESS,DIRBUF);
      BEGIN                  # MAKE DIRECTORY ENTRY                    #
*IF DEF,IMS 
# 
**    LFGMDE - MAKE DIRECTORY ENTRY.
* 
*     M. E. VATCHER  81/02/20 
* 
*     LFGMDE MAKES A DIRECTORY ENTRY IN THE OPLD BUFFER.
* 
*     PROC LFGMDE(PN,RSA,RECL,SUCCESS,DIRBUF) 
* 
*     ENTRY PN        PARTITION NAME
*           RSA       RELATIVE SECTOR ADDRESS 
*           RECL      RECORD LENGTH 
*           DIRBUF    DIRECTORY BUFFER ARRAY ADDRESS
* 
*     EXIT  SUCCESS   SUCCESSFUL COMPLETION INDICATOR 
* 
*     METHOD
* 
*     PUT PARTITION NAME,RELATIVE SECTOR ADDRESS, AND RECORD LENGTH 
*     IN CURRENT POSITION IN THE DIRECTORY BUFFER.
* 
# 
*ENDIF
 
# 
****  PROC LFGMDE - XREF LIST BEGIN.
# 
 
      XREF
        BEGIN 
        ITEM OUTPUT;         # FWA OF OUTPUT FILE FET                  #
        PROC WRITEC;         # WRITE LINE TO CIO BUFFER                #
        PROC WRITER;         # WRITE RECORD                            #
        END 
 
# 
****
# 
 
      ITEM I U;              # LOOP INDEX                              #
      ITEM PN C(6);          # PARTITION NAME                          #
      ITEM RECL U;           # RECORD LENGTH                           #
      ITEM RSA U;            # RELATIVE SECTOR ADDRESS                 #
      ITEM SUCCESS B; 
 
      ARRAY DIRBUF [0:0] S(2);
        BEGIN                # DIRECTORY BUFFER                        #
        ITEM NLFWC        U(01,48,12); # ENTRY INDEX                   #
        ITEM RN           C(00,00,06); # RECORD NAME                   #
        ITEM RLEN         U(01,00,30); # RECORD LENGTH                 #
        ITEM RANINDX      U(01,30,30); # RELATIVE SECTOR ADDRESS       #
        END 
 
      ARRAY DUPRN [0:0] S(4); 
        BEGIN 
        ITEM DUPRN1 C(0,0,30) = 
          [" DUPLICATE RECORD NAME XXXXXX."]; 
        ITEM DUPNAME C(2,18,6); 
        ITEM DUPZ U(3,0,60) = [ 0 ];
        END 
 
      SUCCESS = TRUE; 
      FOR I = 1 STEP 1 UNTIL NLFWC[0] DO
        BEGIN 
        IF C<0,6>PN EQ C<0,6>RN[I]
        THEN                 # DUPLICATE RECORD NAME                   #
          BEGIN 
          DUPNAME[0] = PN;
          WRITEC(OUTPUT,DUPRN); 
          WRITER(OUTPUT,"R"); 
          SUCCESS = FALSE;
          RETURN;            # ***** EXIT *****                        #
 
          END 
        END 
      NLFWC[0] = NLFWC[0] + 1;
      RN[NLFWC[0]] = PN;     # PUT IN RECORD NAME                      #
      RLEN[NLFWC[0]] = RECL; # PUT IN RECORD LENGTH                    #
      RANINDX[NLFWC[0]] = RSA; # PUT IN RELATIVE SECTOR ADRESS         #
      END TERM