*DECK DB$SR71 
USETEXT MDBCMTX 
USETEXT MD10CTX 
USETEXT UTMPTTX 
USETEXT CUGBATX 
      PROC DB$SR71; 
 #
* *   DB$SR71 - CHANGE AREA PF DATA              PAGE  1
* *   G. F. KENDALL                              DATE  08/01/79 
* *   BOB MCALLESTER - TABLE LENGTH CONTROL      DATE  03/30/84 
* 
* DC  PURPOSE 
* 
*     REPLACE AREA PERMANENT FILE INFORMATION IN THE PERMANENT FILE 
*     INFORMATION TABLE, AND, IF THE AREA BELONGS TO THE MASTER VERSION,
*     REPLACE IT IN THE AREA DIRECTORY TABLE. 
* 
* DC  ENTRY CONDITIONS
* 
*     ARDIRBP   - ADDRESS OF BLOCK FOR AREA DIRECTORY TABLE 
*     ARINFOBP  - ADDRESS OF BLOCK FOR AREA INFORMATION TABLE 
*     AREAORD   - ORDINAL OF CURRENT AREA IN THE AREA DIRECTORY TABLE 
*     AREACNT   - NUMBER OF ENTRIES IN THE AREA DIRECTORY TABLE 
*     AREAFLAGS - LOG OPTION FLAGS FOR AREA 
*     ARLOGAIR  - LOG AFTER IMAGE RECORD FLAG 
*     ARLOGAIRN - CHANGE FLAG FOR LOG AFTER IMAGE RECORD IN AREA
*     ARLOGBIB  - LOG BEFORE IMAGE RECORD FLAG
*     ARLOGBIBN - CHANGE FLAG FOR LOG BEFORE IMAGE RECORD IN AREA 
*     ARLOGBIR  - LOG BEFORE IMAGE RECORD FLAG
*     ARLOGBIRN - CHANGE FLAG FOR LOG BEFORE IMAGE RECORD IN AREA 
*     CHANGFLAGS- CHANGE IN LOG OPTION FLAG FOR AREA
*     CURFILTYP - CONTAINS THE CURRENT FILE TYPE (AREA) 
*     MDPFINFO  - HAS PERMANENT FILE INFORMATION FOR AREA 
*     PITBP     - ADDRESS OF BLOCK FOR PERMANENT FILE INFORMATION TABLE 
*     SCDRBP    - ADDRESS OF BLOCK FOR SCHEMA DIRECTORY TABLE 
*     SCHDIRP   - INDEX INTO CURRENT ENTRY IN SCHEMA DIRECTORY
*     VERINFBP  - ADDRESS OF BLOCK FOR VERSION INFORMATION TABLE
*     VERSORD   - ORDINAL OF VERSION IN THE VERSION DIRECTORY TABLE 
* 
* DC  EXIT CONDITIONS 
* 
*     AREA PERMANENT FILE INFORMATION HAS BEEN REPLACED IN THE PERMANENT
*     FILE INFORMATION TABLE. 
*     IF THE CURRENT VERSION IS MASTER, AND THE CHANGE OPTION FOR THE 
*     AREA IS TO SAME AS MASTER, ISSUE DIAGNOSTIC 152.
*     IF THE PFN IS NOT UNIQUE, DIAGNOSTIC 137 IS ISSUED. 
*     WHEN THE APPROPRIATE TABLES HAVE BEEN BUILT, EXIT IS TO DB$NO.
* 
* DC  CALLING ROUTINES
* 
*     DB$SNTX - SYNTAX CRACKER (SYNGEN) 
* 
* DC  CALLED ROUTINES 
* 
* 
# 
      XREF FUNC DB$MDPF B;         # VALIDATE PFN UNIQUENESS           #
      XREF PROC DB$DIAG;           # ISSUE DIAGNOSTICS                 #
      XREF PROC DB$MDPR;           # REPLACE PFN/UN/ID IN PFN TABLE    #
      XREF PROC DB$NO;             # SYNTAX TABLE DRIVER -NO- RETURN   #
      XREF PROC DB$RNRD;           # RANDOM READ                       #
      XREF PROC DB$RNRW;           # RANDOM REWRITE                    #
      XREF PROC DB$UAOS;           # ADJUST TABLE OFFSET               #
      XREF PROC DB$UAWS;           # ADJUST WORK SPACE                 #
# 
* 
* DC  NON-LOCAL VARIABLES MODIFIED
# 
      XREF ARRAY DB$RNFT;;         # FET FOR RANDOM I/O                #
# 
*     DESCRIPTION 
* 
*     CHECK IF PF INFO IS SPECIFIED OR AREA LEVEL FLAGS CHANGED. IF 
*     NOT, THEN RETURN TO DB$NO.
*     CHECK IF CURRENT VERSION IS MASTER.  IF YES, THEN FIND OUT IF 
*     CHANGE FLAG IN PF INFO TABLE FOR THIS AREA IS SET.  IF YES, THEN
*     ISSUE DIAG 152.  IF NOT SET, THEN REPLACE THE AREA PF INFORMATION 
*     IN THE PF INFO TABLE AND THE AREA INFO TABLE. 
*     IF CURRENT VERSION IS NOT MASTER, THEN IF THE AREA SHARES SAME
*     PFN WITH MASTER, CHECK FOR UNIQUE PFN.  IF NOT UNIQUE, ISSUE DIAG 
*     137.  IF UNIQUE, THEN BUILD AN ENTRY IN THE PIT FOR THIS AREA.
*     INCREMENT THE NUMBER OF UNIQUE PFNS IN THE AREA DIRECTORY COUNTER.
*     IF AREA HAS UNIQUE PF INFO, THEN REPLACE THE OLD INFO IN THE PIT
*     WITH THE NEW ONES.
* 
 #
  
  
  
  
      BASED ARRAY ARDIR[0:0] S(DFMDADEN); 
        BEGIN 
*CALL MDARDDCLS 
        END 
  
      BASED ARRAY MDARINFO [0:0] S(1);  # AREA INFORMATION TABLE       #
        BEGIN 
*CALL MDARIDCLS              AREA INFORMATION TABLE 
        END 
  
      BASED ARRAY VERINFO [0:0] S(DFMDVIEN);  # VERSION INFO TABLE     #
        BEGIN 
*CALL MDVITDCLS              VERSION INFORMATION TABLE
        END 
  
      BASED ARRAY MDSCENTRY[0:0] S(1);  # SCHEMA DIRECTORY TABLE       #
        BEGIN 
*CALL MDSCDDCLS 
        END 
      ARRAY [0:0] S(1); 
        BEGIN 
        ITEM FLAGS   U(0,00,06);   # TEMPORARY AREA LEVEL FLAGS        #
        ITEM NDXFLG  B(0,00,01);   # INDEX FILE FLAG                   #
        ITEM BIRFLG  B(0,01,01);   # LOG BEFORE IMAGE RECORDS FLAG     #
        ITEM AIRFLG  B(0,02,01);   # LOG AFTER IMAGE RECORDS FLAG      #
        ITEM BIBFLG  B(0,03,01);   # LOG BEFORE IMAGE BLOCKS FLAG      #
        ITEM RECFLG  B(0,04,01);   # RECOVER AREA FLAG                 #
                                   # BIT 5 IS UNUSED                   #
        END 
  
#     LOCAL VARIABLES                                                  #
  
      ITEM BUFLOC;                 # BUFFER LOCATION FOR I/O           #
      ITEM I;                      # DUMMY INDEX VARIABLE              #
      ITEM LENGTH;                 # LENGTH FOR RANDOM I/O             #
      ITEM NEXTSEG;                # NEXT SEGMENT TO BE LOADED         #
      ITEM OFFSET;                 # OFFSET FOR A SEGMENTED TABLE      #
      ITEM ORIGSEG;                # ORIGINAL SEGMENT                  #
      ITEM PITLENG;                # LENGTH OF THE PIT                 #
      ITEM PITOFFSET;              # OFFSET INTO PIT                   #
      ITEM PRUNUM;                 # PRU NUMBER FOR RANDOM I/O         #
      ITEM VPOFFSET;               # OFFSET FROM VIT POINTER, INCL TLC #
  
  
  
  
#     B E G I N   D B $ S R 7 1   E X E C U T A B L E   C O D E .      #
  
  
      BEGIN 
  
      IF MDPFINAME[CURFILTYP] EQ 0 # IF PF INFO NOT SPECIFIED          #
        AND AREAFLAGS[0] EQ 0      # AND OPTIONS NOT CHANGED           #
        AND CHANGFLAGS[0] EQ 0
      THEN
        BEGIN 
        DB$NO;                     # EXIT TO DB$NO                     #
  
        END 
      AREACHGF = TRUE;                 # SET AREA CHANGED FLAG         #
      P<TLC> = B<42,18>VERINFBP;
      OFFSET = (VERSORD -1) * AREACNT * DFMDVIEN; 
      DB$UAOS(OFFSET);             # ADJUST OFFSET FOR SWAPPED SEGMENTS#
      VPOFFSET = TLCHLEN[0] + OFFSET; 
      P<VERINFO> = LOC(TLC) + VPOFFSET; 
  
      P<TLC> = B<42,18>PITBP;      # TLC HEADER FOR THE PIT            #
      OFFSET = MDVITFOFF[AREAORD -1] - DFPITHDR;
      DB$UAOS(OFFSET);             # ADJUST OFFSET FOR SWAPPED SEGMENTS#
  
                                   # SET PERM FILE INFO POINTER        #
      P<PFINFO> = LOC(TLC) + TLCHLEN[0] + DFPITHDR + OFFSET;
      IF TLCHLEN[0] GR DFTLCHL     # IF THERE ARE DISK SEGMENTS AND    #
                                   # THE OFFSET IS IN THE DS PORTION   #
        AND OFFSET + DFPITHDR LS TLCBSBW[0] 
      THEN
        BEGIN 
        TLCDSMF[0] = TRUE;         # SET DISK SEGMENT MODIFIED FLAG    #
        END 
  
      FLAGS[0] = MDPITFLAGS[0]; 
  
  
#     SET AREA LEVEL FLAGS.                                            #
  
      IF ARLOGBIRN[0] 
      THEN
        BEGIN 
        BIRFLG[0] = ARLOGBIR[0];
        END 
      IF ARLOGAIRN[0] 
      THEN
        BEGIN 
        AIRFLG[0] = ARLOGAIR[0];
        END 
      IF ARLOGBIBN[0] 
      THEN
        BEGIN 
        BIBFLG[0] = ARLOGBIB[0];
        END 
      P<PITPF> = LOC(MDPITPFINFO[0]);  # POSITION PIT PF ENTRY         #
  
#     CHECK IF THIS AREA BELONGS TO VERSION MASTER (VERSORD = 1).      #
  
      IF VERSORD EQ 1 
      THEN
        BEGIN 
        IF MDPITCHGF[0] 
        THEN
          BEGIN 
          DB$DIAG(152,AREANAM); 
          DB$NO;
  
          END 
        DB$MDPR(MDPITNAME[0],MDPITUNID[0],MDPITSNPN[0], 
          MDPFINAME[CURFILTYP],MDPFUNID[CURFILTYP],MDPFSNPN[CURFILTYP]);
  
#     REPLACE AREA PF INFO IN THE PERMANENT FILE INFO TABLE            #
  
        MDPITCHGF[0] = TRUE;       # SET PIT CHANGED FLAG              #
        MDPITFLAGS[0] = FLAGS[0];  # SET FLAGS                         #
        P<PUTENTRY> = LOC(PITPF); 
        P<GETENTRY> = LOC(MDPFWORD[CURFILTYP]); 
        FOR I = 0 STEP 1
          UNTIL DFPFENTLEN - 1
        DO
          BEGIN 
          PUTUNSIG[I] = GETUNSIG[I];
          END 
  
#     REPLACE AREA PF INFO IN THE AREA INFORMATION TABLE               #
  
        P<MDARINFO> = ARINFOBP + 1 + (AREAORD - 1) * DFMDAIEN;
        P<MDSCENTRY> = SCDRBP + 1; # POSITION SCHEMA DIRECTORY         #
  
# CHECK CHANGE FLAG FOR LOG AFTER IMAGE RECORD.                        #
# IF CHANGED, THEN DO ONE OF THE FOLLOWING -                           #
#     IF LOG OPTION IS CHANGED FROM OFF TO ON, THEN INCREMENT THE      #
#     COUNTER IN SDT THAT KEEPS TRACK OF THE NUMBER OF AREAS IN A      #
#     SCHEMA WITH LOG AFTER IMAGE RECORD OPTION ON.                    #
#     OTHERWISE, DECREMENT THE COUNTER.                                #
  
        IF ARLOGAIRN[0]            # IF LOG AFTER RECORD OPTION CHANGED#
        THEN
          BEGIN 
          IF ARLOGAIR[0]           # LOG AFTER IMAGE RECORD OPTION IS  #
            AND NOT MDAILGAR[0]    # CHANGED FROM OFF TO ON            #
          THEN
            BEGIN 
            MDSCNBAFTIM[SCHDIRP] = MDSCNBAFTIM[SCHDIRP] + 1;
            END 
  
          IF NOT ARLOGAIR[0]       # LOG AFTER IMAGE RECORD OPTION IS  #
            AND MDAILGAR[0]        # CHANGED FROM ON TO OFF            #
          THEN
            BEGIN 
            MDSCNBAFTIM[SCHDIRP] = MDSCNBAFTIM[SCHDIRP] - 1;
            END 
          END 
  
        MDAIFLAGS[0] = FLAGS[0];     # SET FLAGS                       #
        P<PUTENTRY> = LOC(MDAIARPF[0]); 
        FOR I = 0 STEP 1
          UNTIL DFPFENTLEN - 1
        DO
          BEGIN 
          PUTUNSIG[I] = GETUNSIG[I];
          END 
        DB$NO;                     # EXIT TO DB$NO                     #
  
        END 
  
#     AREA BELONGS TO A NON MASTER VERSION                             #
  
      P<VERINFO> = VERINFBP + VPOFFSET; 
      IF MDVITNAME[AREAORD - 1] EQ "MASTER" 
      THEN
        BEGIN 
  
#     OLD PFN IS THE SAME AS MASTER. AND MUST BE CHANGED               #
#     TO A UNIQUE PFN                                                  #
  
        IF NOT DB$MDPF(MDPFINAME[CURFILTYP],MDPFUNID[CURFILTYP],
                            MDPFSNPN[CURFILTYP])  # IF PF NOT UNIQUE   #
        THEN
          BEGIN 
          DB$DIAG(137,MDPFINAME[CURFILTYP]);  # ISSUE DIAGNOSTIC       #
          DB$NO;                              # EXIT TO DB$NO          #
  
          END 
  
#     SEARCH THE PERMANENT FILE INFORMATION TABLE (PIT) FOR AN ENTRY   #
#     THAT IS NOT IN USE (MDPITUSEF = FALSE).                          #
  
        P<TLC> = B<42,18>PITBP;               # TLC HEADER FOR THE PIT #
        P<PFINFO> = B<42,18>PITBP + TLCHLEN[0];  # POINT TO PIT HEADR  #
        PITLENG = MDPITTOTENT[0] * DFMDPITEN; # LENGTH OF PIT          #
        MDPITACTENT[0] = MDPITACTENT[0] + 1;  # TOTAL ACTIVE ENTRIES   #
        IF MDPITACTENT[0] LQ MDPITTOTENT[0] 
        THEN
          BEGIN 
          P<PFINFO> = LOC(PFINFO) + DFPITHDR; # RELOCATE PIT           #
          ORIGSEG = TLCDSOR[0];               # ORIGINAL SEGMENT ORDINL#
          PITOFFSET = DFPITHDR; 
          IF ORIGSEG NQ 0 
          THEN
            BEGIN 
            PITOFFSET = DFPITHDR + (TLCDSWL[0] * (ORIGSEG - DFTLCHL));
            END 
          FOR PITOFFSET = PITOFFSET 
            STEP DFMDPITEN                    # STEP THRU THE PIT UNTIL#
            WHILE PITOFFSET LQ PITLENG        # THE END OF THE PIT     #
            AND MDPITUSEF[0]                  # OR AVAILABLE SLOT FOUND#
          DO
            BEGIN 
                                              # GET NEXT PIT ENTRY     #
            P<PFINFO> = LOC(PFINFO) + DFMDPITEN;
  
            IF ORIGSEG NQ 0        # IF THERE ARE ANY DISK SEGMENTS    #
              AND LOC(PFINFO) GQ LOC(TLC) 
                  + TLCHLEN[0] + TLCDSBW[0] + TLCDSWL[0]
            THEN                  # IT IS THE END OF THIS DISK SEGMENT #
  
              BEGIN               # DO A CIRCULAR SCAN OF THE SEGMENTS #
              NEXTSEG = TLCDSOR[0] +1;
              IF NEXTSEG EQ TLCHLEN[0]
              THEN                 # AT THE LAST SEGMENT               #
                BEGIN              # GO TO THE FIRST SEGMENT           #
                NEXTSEG = DFTLCHL;
                PITOFFSET = DFPITHDR - DFMDPITEN; 
                END 
              IF NEXTSEG EQ ORIGSEG  # IF THE NEXT IS THE ORIGINAL     #
              THEN                 # ALL SEGMENTS HAVE BEEN SEARCHED   #
                BEGIN              # EXCEPT THE BUILD SEGMENT          #
                P<PFINFO> = LOC(TLC) + TLCHLEN[0] + TLCBSBW[0]; 
                PITOFFSET = DFPITHDR - DFMDPITEN
                              + (TLCDSWL[0] * (TLCHLEN[0] - DFTLCHL));
                ORIGSEG = 0;
                TEST PITOFFSET;    # CONTINUE SCAN IN THE BUILD SEGMENT#
  
                END 
                                   # SWAP IN THE NEXT SEGMENT          #
              BUFLOC = LOC(TLC) + TLCHLEN[0] + TLCDSBW[0];
              P<PFINFO> = BUFLOC; 
              IF TLCDSMF[0]        # IF THE MODIFIED FLAG IS SET       #
              THEN                 # REWRITE THE RESIDENT SEGMENT      #
                BEGIN 
                LENGTH = TLCSLEN[TLCDSOR[0]]; 
                PRUNUM = TLCSPRU[TLCDSOR[0]]; 
                TLCDSMF[0] = FALSE; 
                DB$RNRW(LOC(DB$RNFT),BUFLOC,LENGTH,PRUNUM); 
                END 
                                   # READ IN THE NEW SEGMENT           #
              LENGTH = TLCSLEN[NEXTSEG];
              PRUNUM = TLCSPRU[NEXTSEG];
              DB$RNRD(LOC(DB$RNFT),BUFLOC,LENGTH,PRUNUM); 
              TLCDSOR[0] = NEXTSEG; 
              TLCDSWL[0] = TLCSLEN[NEXTSEG];
              END 
            END 
          END 
        ELSE                       # SKIP THE SEARCH, ALL ARE ACTIVE   #
          BEGIN 
          PITOFFSET = PITLENG + DFPITHDR; 
          END 
  
        IF PITOFFSET GQ PITLENG    # IF NO AVAILABLE SLOT ENTRY FOUND  #
        THEN
          BEGIN 
          DB$UAWS(LOC(PITBP),DFMDPITEN);          # ALLOCATE ENTRY     #
          P<PFINFO> = B<42,18>PITBP + TLCHLEN[0];  # POINT TO HEADER   #
          MDPITTOTENT[0] = MDPITTOTENT[0] + 1;  # UPDATE TOTAL ENTRIES #
          END 
        P<VERINFO> = VERINFBP + VPOFFSET; 
        MDVITNAME[AREAORD - 1] = VERSNAM;    # SET VERSION NAME        #
        MDVITFOFF[AREAORD - 1] = PITOFFSET;  # SET PIT OFFSET          #
        P<TLC> = VERINFBP;
        IF TLCHLEN[0] GR DFTLCHL   # IF THERE ARE DISK SEGMENTS AND    #
          AND VPOFFSET LS TLCBSBW[0]  # THE OFFSET IS IN THE DS PORTION#
        THEN
          BEGIN 
          TLCDSMF[0] = TRUE;       # SET DISK SEGMENT MODIFIED FLAG    #
          END 
  
        P<TLC> = B<42,18>PITBP;    # TLC HEADER FOR THE PIT            #
        OFFSET = PITOFFSET - DFPITHDR;
  
        DB$UAOS(OFFSET);           # ADJUST OFFSET FOR SWAPPED SEGMENTS#
  
                                   # SET PERM FILE INFO POINTER        #
        P<PFINFO> = LOC(TLC) + TLCHLEN[0] + DFPITHDR + OFFSET;
        IF TLCHLEN[0] GR DFTLCHL   # IF THERE ARE DISK SEGMENTS AND    #
                                   # THE OFFSET IS IN THE DS PORTION   #
          AND OFFSET + DFPITHDR LS TLCBSBW[0] 
        THEN
          BEGIN 
          TLCDSMF[0] = TRUE;       # SET DISK SEGMENT MODIFIED FLAG    #
          END 
  
        MDPITCHGF[0] = TRUE;                 # SET PIT CHANGED FLAG    #
        MDPITFLAGS[0] = FLAGS[0];            # SET FLAGS               #
        MDPITUSEF[0] = TRUE;                 # SET ENTRY IN USE FLAG   #
        MDPITNOVER[0] = 1;                   # SET NUMBER OF VERSIONS  #
        P<PUTENTRY> = LOC(MDPITPFINFO[0]);
        P<GETENTRY> = LOC(MDPFINFO[CURFILTYP]); 
        FOR I = 0 STEP 1
          UNTIL DFPFENTLEN - 1
        DO
          BEGIN 
          PUTUNSIG[I] = GETUNSIG[I];
          END 
  
#     MUST INCREMENT THE NUMBER OF UNIQUE PFNS FOR THIS AREA.          #
  
        P<ARDIR> = ARDIRBP + 1 + DFMDADCW + (AREAORD - 1) * DFMDADEN; 
        MDADNPFN[0] = MDADNPFN[0] + 1;
        DB$NO;                     # EXIT TO DB$NO                     #
  
        END 
  
#     OLD AREA PF INFO WAS NOT THE SAME AS MASTER.                     #
  
  
      P<TLC> = B<42,18>PITBP;      # TLC HEADER FOR THE PIT            #
      OFFSET = MDVITFOFF[AREAORD -1] - DFPITHDR;
  
      DB$UAOS(OFFSET);             # ADJUST OFFSET FOR SWAPPED SEGMENTS#
  
                                   # SET PERM FILE INFO POINTER        #
      P<PFINFO> = LOC(TLC) + TLCHLEN[0] + DFPITHDR + OFFSET;
      IF OFFSET + DFPITHDR LS TLCBSBW[0]
      THEN
        BEGIN 
        TLCDSMF[0] = TRUE;         # SET DISK SEGMENT MODIFIED FLAG    #
        END 
  
      MDPITCHGF[0] = TRUE;              # SET PIT CHANGED FLAG         #
      MDPITFLAGS[0] = FLAGS[0];         # SET FLAGS                    #
      P<PITPF> = LOC(MDPITPFINFO[0]);   # POSITION PIT PF INFO         #
  
#     CHANGE ARE PF INFO IN THE PFN TABLE.                             #
  
      DB$MDPR(MDPITNAME[0],MDPITUNID[0],MDPITSNPN[0], 
         MDPFINAME[CURFILTYP],MDPFUNID[CURFILTYP],MDPFSNPN[CURFILTYP]); 
  
#     CHANGE ARE PF INFO IN THE PERMANENT FILE INFORMATION TABLE.      #
  
      P<PUTENTRY> = LOC(PITPF); 
      P<GETENTRY> = LOC(MDPFWORD[CURFILTYP]); 
      FOR I = 0 STEP 1
        UNTIL DFPFENTLEN - 1
      DO
        BEGIN 
        PUTUNSIG[I] = GETUNSIG[I];
       END
      DB$NO;                       # EXIT TO DB$NO                     #
  
      END 
      TERM; 
