*DECK LFNPROC 
USETEXT TCMMDEF 
USETEXT TCRMDEF 
USETEXT TENVIRN 
USETEXT TFIT
USETEXT TLFNINF 
USETEXT TOPTION 
USETEXT TSBASIC 
      PROC LFNPROC;                                                      LFNPROC
        BEGIN 
        XREF ITEM SAVELFNAME; 
      XREF PROC XSETFIT;           # READ FILE CARD INFORMATION        #
      XREF PROC DIAG; 
      XREF ITEM CURRENTLFPTR; 
      XREF ITEM LFNLIST;
      XREF ITEM DESLIST;
      XREF ITEM CURLENG;
      XREF ARRAY CURWORD[25]; 
        ITEM ICW C (,,10);
      XREF ARRAY UPNFIT;           # MODEL FIT                         #
        BEGIN 
        ITEM WUPNN; 
        END 
      XDEF BASED ARRAY HOLDER;     # A FIT *HELD* FOR *SORT*/*COMPILE* #
        BEGIN 
        ITEM HOLDBT       U(11,36,03);  # BLOCK TYPE                   #
        ITEM HOLDCL       U(16,24,06);  # COUNT FIELD LENGTH (RT=D/T)  #
        ITEM HOLDCP       U(17,15,24);  # BCP OF COUNT FIELD (RT=T)    #
        ITEM HOLDC1       B(17,13,01);  # COMP-1 BIT (RT=D/T)          #
        ITEM HOLDHL       U(15,00,24);  # HEADER LENGTH (RT=T)         #
        ITEM HOLDLT       U(10,36,02);  # LABEL TYPE                   #
        ITEM HOLDMRL      U(12,00,24);  # MAXIMUM RECORD LENGTH        #
        ITEM HOLDRT       U(11,32,04);  # RECORD TYPE                  #
        ITEM HOLDSB       B(17,14,01);  # SIGN OVERPUNCH (RT=D/T)      #
        ITEM HOLDTL       U(16,00,24);  # TRAILER LENGTH (RT=T)        #
        END 
  
      XREF BASED ARRAY DESPTR;
        ITEM DESCOUNT I (0,0,12),  # NUNBER OF LOCAL FILES REFERENCING #
                                   # THIS LIST OF DESCRIBE ITEMS.      #
             DESSIZE  U (0,24,18),  # SIZE OF DESCRIBED LIST IN CHAR   #
             DESADDR  U (0,42,18); # ADDRESS OF LIST OF ITEMS.         #
        ITEM I; 
        ITEM SAVER; 
        ITEM SAVER2;
        ITEM LOOPCON B; 
        ITEM PREVADDR;
      BASED ARRAY UNAMEIT S(1);                                          LFNPROC
        BEGIN                                                            LFNPROC
        ITEM COPYIT (00,00,60);    #ARRAY FOR MOVING CORE              # LFNPROC
        END                                                              LFNPROC
      CONTROL EJECT;
#**********************************************************************#
#                                                                      #
#            C H E C K F O R L F N                                     #
#                                                                      #
#**********************************************************************#
#  CHECKFORLFN IS CALLED TO CHECK WHETHER OR NOT THE LOCAL FILE        #
#  NAME REFERENCED ALREADY EXISTS.  IF IT DOES EXIST, ALL SPACE WHICH  #
#  WAS USED IS RELEASED, THE POINTERS ARE MODIFIED ACCORDINGLY, AND    #
#  RETURN.  IF NOT, THE LIST OF LFNS REMAINS AS IT WAS.                #
      XDEF PROC CHECKFORLFN;
      PROC CHECKFORLFN; 
        BEGIN 
        IF LFNLIST EQ 0 THEN RETURN;
        P<LFNINFO> = LFNLIST;            # FIRST TABLE IN LIST         #
        LOOPCON = TRUE; 
        PREVADDR = P<LFNINFO>;           # SAVE CURRENT ADDRESS        #
        FOR I = 0 STEP 1 WHILE LOOPCON DO 
          BEGIN 
          P<FIT> = LOC(L$FITLOC);                                        LFNPROC
          IF B<0,42>SAVELFNAME EQ FITLFN THEN  #FILE EXISTS - RELEASE  # LFNPROC
            BEGIN                          # SPACE.                    #
            SAVER = L$NEXT;        #SAVE THE POINTER TO NEXT           # LFNPROC
            P<DESPTR> = L$DESPTR;  #IF NO OTHER LFN IS LINKED          # LFNPROC
            IF DESCOUNT[0] LQ 1 THEN       # TO THIS ATTRIBUTE LIST,   #
              BEGIN                        # FREE THE MEMORY.  IF      #
              IF DESADDR[0] NQ 0 THEN      # IF ATTRIBUTE LIST RESERVED#
                BEGIN 
                CMM$FRF(DESADDR[0]);       # FREE ATTRIBUTE LIST CM    #
                END 
              CMM$FRF(L$DESPTR);   #FREE ONLY LFNINFO                  # LFNPROC
              END 
            ELSE
              BEGIN 
              DESCOUNT[0] = DESCOUNT[0] - 1;
              END 
            IF I EQ 0              #IF THIS IS ONLY TABLE              # LFNPROC
              AND L$NEXT EQ 0                                            LFNPROC
            THEN                                                         LFNPROC
              BEGIN                        # IN THE LIST.  THE POINTER #
              SAVER2 = P<LFNINFO>;
              LFNLIST = 0;                 # LFNLIST IS LET TO ZERO TO #
              END                          # INDICATE NO TABLES.       #
            ELSE
              BEGIN 
              SAVER2 = P<LFNINFO>;
              IF I EQ 0 THEN               # FIRST TABLE IN LIST IS    #
                BEGIN                      # RELEASED, AND NEW LIST BE-#
                LFNLIST = L$NEXT;          #GINS AT SECOND TABLE IN    # LFNPROC
                                           # LIST.                     #
                END 
              ELSE
                BEGIN                      # BACK UP TO PREVIOUS TABLE.#
                P<LFNINFO> = PREVADDR;     # SET THE POINTER TO NEXT   #
                L$NEXT = SAVER;    #TABLE ENTRY TO THE SAVED           # LFNPROC
                                           # VALUE.                    #
                END 
              END 
            P<LFNINFO> = SAVER2;    # POSITION TO TABLE TO BE RELEASED #
            CMM$FRF (SAVER2);       # RELEASE LFN TABLE CM             #
            LOOPCON = FALSE;   # END PROCESSING--FOUND A DUPLICATE.    #
            TEST I; 
            END 
          ELSE
            BEGIN                   # MOVE TO NEXT TABLE IN LFN LIST   #
            PREVADDR = P<LFNINFO>;  # AND CONTINUE LOOPING.            #
            IF L$NEXT EQ 0 THEN    #NO MORE TABLES IN CHAIN            # LFNPROC
              BEGIN 
              LOOPCON = FALSE;
              TEST I; 
              END 
            P<LFNINFO> = L$NEXT;                                         LFNPROC
            TEST I; 
            END 
          END         # LOOPCON LOOP #
          RETURN; 
        END       # CHECKFORLFN  #
      CONTROL EJECT;
      XDEF PROC LFNLOOKUP;
      PROC LFNLOOKUP (RC);
#**********************************************************************#
#                                                                      #
#                  L F N L O O K U P                                   #
#                                                                      #
#**********************************************************************#
#  -LFNLOOKUP- SEARCHES THE LIST OF LFNS TO FIND THE ADDRESS OF THE    #
#  LFN TABLE ASSOCIATED WITH THE LFN BEING PROCESSED.  IF THERE IS NO  #
#  MATCH, A RETURN CODE OF 1 IS PASSED BACK.  IF THERE IS A MATCH, THE #
#  RETURN CODE IS ZERO.  CURRENTLFPTR WILL HOLD THE ADDRESS OF THE     #
# TABLE WHICH APPLIES, IN THE CASE OF A MATCH.                         #
            BEGIN                 # SEARCH FOR CORRECT ENTRY IN THE    #
            ITEM RC;
            ITEM LFNAMEZF I;       # ZERO FILLED LFN NAME              #
            LFNAMEZF = 0; 
            B<0,CURLENG*6>LFNAMEZF = B<0,CURLENG*6>ICW[0];
            P<LFNINFO> = LFNLIST; # LFN LIST.                          #
            LOOPCON = TRUE; 
            CURRENTLFPTR = 0; 
            FOR I = 1 WHILE LOOPCON DO
              BEGIN 
              P<FIT> = LOC(L$FITLOC);                                    LFNPROC
              IF B<0,42>FITLFN EQ B<0,42>LFNAMEZF 
              THEN                                                       LFNPROC
                BEGIN                                                    LFNPROC
                LOOPCON = FALSE;
                CURRENTLFPTR = P<LFNINFO>;
                REFERFILE = 0;
                P<DESPTR> = L$DESPTR;                                    LFNPROC
                DESLIST = DESADDR[0]; 
                FSIZE = DESSIZE[0];  # SIZE OF DESCRIBED LIST IN CHAR  #
                TEST I; 
                END 
              ELSE
                BEGIN 
                IF L$NEXT EQ 0 THEN                                      LFNPROC
                  BEGIN 
                  LOOPCON = FALSE;
                  TEST I; 
                  END 
                ELSE
                  BEGIN 
                  P<LFNINFO> = L$NEXT;                                   LFNPROC
                  TEST I; 
                  END 
                END 
              END    # END OF LOOP #
            IF CURRENTLFPTR EQ 0 THEN 
              BEGIN               # NO MATCH--RETURN CODE OF 1         #
              RC = 1; 
              END 
            ELSE                  # MATCH--RETURN CODE OF 0            #
              BEGIN 
              RC = 0; 
              END 
            RETURN; 
            END     # LFNLOOKUP # 
      CONTROL EJECT;
#**********************************************************************#
#                                                                      #
#            L I N K N E W L F N                                       #
#                                                                      #
#**********************************************************************#
# LINKNEWLFN IS CALLED TO LINK A NEW LFN INTO THE CHAIN OF             #
# LFNS.  IT WILL BE LINKED IN ALPHABETICAL ORDER, WITH THE FIELD       #
# -NXTPTR- POINTING TO THE NEXT ENTRY IN THE LIST.  IF THERE ARE       #
# NO MORE ENTRIES, NXTPTR WILL BE ZERO.  THE FIT AND FET FIELDS        #
# ARE FILLED IN HERE, ALSO.                                            #
#  AN ENTRY CODE OF 1 INDICATES A CALL FROM THE SORT SEMANTIC ROUTINES.#
#  AN ENTRY CODE OF 0 INDICATES A CALL FROM OTHER LFN PROCESSORS.      #
      XDEF PROC LINKNEWLFN; 
      PROC LINKNEWLFN (EC); 
      BEGIN 
      ITEM EC;
      ITEM J; 
      IF DESLIST EQ 0 THEN         # IF NO DESCRIBE LIST               #
        BEGIN 
        FSIZE = 0;                 # SIZE OF DESCRIBED LIST IN CHARS   #
        TYPETWD = 0;               # DESCRIPTION OF RT=T RECORDS       #
        END 
      P<LFNINFO> = CMM$ALF(LFNINFOSIZE, 0, 0);  #ALLOCATE CM FOR TABLE # CHANGES
      P<FIT> = LOC(L$FITLOC);                                            LFNPROC
      IF EC NQ 1 THEN              # IF NOT CALLED FROM SORT           #
        BEGIN 
        P<DESPTR> = CMM$ALF (1,0,0);
        DESCOUNT = 1; 
        DESADDR = DESLIST;
        DESSIZE = FSIZE;
        END 
  
                                   # INITIALIZE LFNINFO POINTER WORDS  #
  
      L$FIRSTIME = TRUE;                                                 LFNPROC
      L$NEXT = 0;                                                        LFNPROC
      CURRENTLFPTR = P<LFNINFO>;
      L$DESPTR = P<DESPTR>;                                              LFNPROC
  
                                   # INITIALIZE FIT                    #
  
      P<UNAMEIT> = LOC(L$FITLOC);  #GET SET TO COPY THE MODEL FIT      #
      FITLFN = B<0,42>SAVELFNAME;  #FILE NAME                          # LFNPROC
      FOR I=1 STEP 1               #COPY MODEL FIT                     # LFNPROC
        UNTIL LFITM1               #STARTING AFTER THE LFN             # LFNPROC
      DO                                                                 LFNPROC
        BEGIN                                                            LFNPROC
        COPYIT[I] = WUPNN[I];                                            LFNPROC
        END                                                              LFNPROC
      IF EC NQ 1 THEN              # IF NOT CALLED FROM SORT           #
        BEGIN 
        IF TYPETWD NQ 0 THEN       # IF RT = T AS PER DESCRIBE LIST    #
          BEGIN 
          FITRT = RTT;             #RT = T                             # LFNPROC
          FITHL = TYPETHL;         #HEADER LENGTH                      # LFNPROC
          FITTL = TYPETTL;         #TRAILER LENGTH                     # LFNPROC
          FITCP = TYPETCP;         #BCP OF TRAILER COUNT FIELD         # LFNPROC
          FITSB = TYPETSB;         #OVERPUNCH                          # LFNPROC
          FITC1 = TYPETCI;         #COMP-1                             # LFNPROC
          END 
        FITMRL = FSIZE;                                                  LFNPROC
        END 
      ELSE                         # IF CALLED FROM SORT               #
        BEGIN 
        FITBT = HOLDBT;            #BLOCK TYPE                         # LFNPROC
        FITRT = HOLDRT;            #RECORD TYPE                        # LFNPROC
        FITLT = HOLDLT;            #LABEL TYPE                         # LFNPROC
        FITHL = HOLDHL;            #HEADER LENGTH OF T RECORD          # LFNPROC
        FITTL = HOLDTL;            #TRAILER LENGTH OF T RECORD         # LFNPROC
        FITMRL = HOLDMRL;          #MAXIMUM RECORD LENGTH              # LFNPROC
        FITCP = HOLDCP;            #BCP OF RT=T TRAILER COUNT FIELD    # LFNPROC
        FITSB = HOLDSB;            #T IF KEY HAS COBOL SIGN OVERPUNCH  # LFNPROC
        FITC1 = HOLDC1;            #T IF KEY IS IN COBOL COMP-1        # LFNPROC
        FITCL = HOLDCL;            # COUNT FIELD LENGTH (RT=D/T)       #
        END 
      XSETFIT(FIT);                # READ FILE CARD INFORMATION        #
      IF FITMRL LS FSIZE THEN                                            LFNPROC
        BEGIN 
        DIAG(264, FSIZE, FITMRL);                                        LFNPROC
        END 
  
      IF FITRT EQ RTF              # IF RT = F (FIXED LENGTH)          #
      THEN
        BEGIN 
        FITMNR = FITMRL;           # TELL CRM TO DISCARD ANYTHING      #
                                   # LESS THAN MRL CHARACTERS LONG     #
        END 
      FITCMPLT = TRUE;             # SET THE COMPLETION BIT            #
        IF LFNLIST EQ 0 THEN
          BEGIN 
          LFNLIST = P<LFNINFO>; 
          RETURN; 
          END 
        ELSE
          BEGIN 
          PREVADDR = 0; 
          SAVER = P<LFNINFO>;      # THE LFNINFO ENTRY TO BE LINKED IN #
          P<LFNINFO> = LFNLIST;           # ARE STORED IN ALPHABETICAL #
          P<FIT> = LOC(L$FITLOC);  # POSITION FIT FOR NAME COMPARISON  #
          LOOPCON = TRUE;                 # ORDER, SO COMPARE WITH EX- #
          FOR I = 1 WHILE LOOPCON DO      # ISTING NAMES AND CHANGE    #
            BEGIN                            # POINTERS WHEN BECESSARY.#
            P<FIT> = LOC(L$FITLOC); 
            FOR J = 0 STEP 6 UNTIL 42 DO
              BEGIN 
              IF B<J,6>SAVELFNAME EQ B<J,6>FITLFN THEN                   LFNPROC
                BEGIN 
                TEST J; 
                END 
              IF B<J,6>SAVELFNAME LS B<J,6>FITLFN THEN                   LFNPROC
              BEGIN                          # LINK IN WHEN THE NEW    #
              IF PREVADDR EQ 0 THEN          # NAME IS LESS THAN THE   #
                BEGIN                        # CURRENT OLD NAME.       #
                PREVADDR = P<LFNINFO>;
                LFNLIST = SAVER;
                P<LFNINFO> = SAVER; 
                P<FIT> = LOC(L$FITLOC);  # POSITION FOR NAME COMPARISON#
                L$NEXT = PREVADDR;                                       LFNPROC
                LOOPCON = FALSE;
                TEST I; 
                END 
              ELSE
                BEGIN 
                P<LFNINFO> = PREVADDR;   # NEW LFN IS LINKED IN--EXIT  #
                SAVER2 = L$NEXT;   #LOOP AND FINISH                    # LFNPROC
                L$NEXT = SAVER;                                          LFNPROC
                P<LFNINFO> = SAVER; 
                P<FIT> = LOC(L$FITLOC);  # POSITION FOR NAME COMPARISON#
                L$NEXT = SAVER2;                                         LFNPROC
                LOOPCON = FALSE;
                TEST I; 
                END 
              END 
            ELSE
             BEGIN
             IF L$NEXT EQ 0 THEN   #END OF TABLES IN LIST--            # LFNPROC
               BEGIN                    # SET NEW NXTPTR AND RETURN.  # 
               LOOPCON = FALSE; 
               L$NEXT = SAVER;                                           LFNPROC
               END
             ELSE 
               BEGIN                    # CONTINUE SEARCHING FOR THE  # 
               PREVADDR = P<LFNINFO>;   # SPOT TO LINK IN.  NXTPTR[0] # 
               P<LFNINFO> = L$NEXT;        #IS THE ADDRESS OF THE NEXT # LFNPROC
               P<FIT> = LOC(L$FITLOC);                                   LFNPROC
               END                      # TABLE IN THE CHAIN.         # 
             TEST I;
             END
              END 
            END     # END OF LOOP # 
          END 
      END           # END OF LINKNEWLFN. #
      END 
      TERM; 
