*DECK NAVICHK 
USETEXT TBASCTB 
USETEXT TIMF
USETEXT TPSTACK 
USETEXT TSBASIC 
#----------------------------------------------------------------------#
#                                                                      #
#     N A V I C H K                                                    #
#                                                                      #
#  THIS PROCEDURE VERIFIES THE CORRECTNESS OF THE NAVIGATION STRATEGY. #
#  1.  WHEN ONLY ONE RECORD TYPE IS INVOLVED, -FOLLOW- IS NOT REQUIRED.#
#      IF -FOLLOW- IS NOT GIVEN, NAVICHK SETS IN THE ARRAY THREAD THE  #
#      ORDINAL OF THE FIRST ACCESS PATH DEFINED FOR THAT RECORD TYPE.  #
#  2.  WHEN MORE THAN ONE RECORD TYPE IS INVOLVED, -FOLLOW- IS REQUIRED#
#      NAVICHK INSURES THAT                                            #
#      - THERE ARE NO MISSING LINKS, I.E. EVERY RECORD TYPE SEEN IN THE#
#        ARRAY RECORDS IS POINTED TO BY AN ENTRY IN THE ARRAY THREAD.  #
#      - THERE ARE NO LOOPS OR RETRACING, I.E. EACH RECORD TYPE SEEN   #
#        IN THE ARRAY RECORDS IS POINTED TO ONLY ONCE BY AN ENTRY IN   #
#        THE ARRAY THREAD.                                             #
#  3.  FOR ALL RECORD TYPES, NAVICHK ALSO CHECKS THAT PERMISSION TO    #
#      OBTAIN, STORE, MODIFY OR REMOVE IS GRANTED.                     #
#                                                                      #
#----------------------------------------------------------------------#
  
      PROC NAVICHK; 
      BEGIN 
  
      XREF PROC DIAG;        # TO ISSUE THE TEXT OF A DIAGNOSTIC       #
      XREF PROC STDNO;
      XREF PROC STDYES; 
      XREF PROC RECYES; 
      XREF ITEM FOLLOWON B;        # TRUE IF -FOLLOW- DIR IN EFFECT    #
      ITEM ABOVE, BELOW I;   # TWO LOOP VARIABLES TO COMPARE ENTRIES   #
                             # IN THE ARRAY THREAD                     #
      ITEM DIRTIVE U;              # BASCODE OF CURRENT DIRECTIVE      #
      ITEM J, K  I;          # WORKING VARIABLES                       #
      ITEM COUNT I;          # TO ACCUMULATE TOTALS                    #
      ITEM ERROR  B;         # TO NOTE IF AN ERROR HAS OCCURRED        #
  
  
      DEF CALL #  # ; 
      DEF MAXREC      #SICRCTN#;   # NO OF RECORD ENTRIES IN SCHEMA    #
      DEF MODIFYING   #(DIRTIVE EQ MODCODE OR DIRTIVE EQ MODUCODE)#;
      DEF OBTAINING   #(DIRTIVE EQ DISPCODE OR DIRTIVE EQ EXTRCODE
                      OR (DIRTIVE GQ MODCODE AND DIRTIVE LQ REMUCODE))#;
      DEF REMOVING    #(DIRTIVE EQ REMCODE OR DIRTIVE EQ REMUCODE)#;
      DEF STORING     #(DIRTIVE EQ STORCODE OR DIRTIVE EQ STRSCODE)#; 
      BASED ARRAY EVALDATA;        # EVALUATE TABLE                    #
        BEGIN 
        ITEM DATACNVT  I(00,06,18);   # POINTER TO MOVETABLE           #
        ITEM DATASTACK I(00,24,18);   # POINTER TO PROGRAM STACK       #
        ITEM EVALWD    I(00,00,60);   # ENTIRE EVALUATE ENTRY          #
        END 
      BASED ARRAY DTABLE S(3);     # DISPLAY TABLE                     #
        BEGIN 
        ITEM CPFROMADDR  I(01,24,18);  # RECORD ID OF DATABASE ITEM    #
        END 
CONTROL EJECT;
      RECYES; 
  
      P<BASICTABLE> = BASCPTR;
      DIRTIVE = BASCODE[BASTABIND];  # STORE CODE FOR EASY REFERENCE   #
                                   # IF *EVALUATE*, SET *RECORDSEEN*   #
                                   # FOR ANY DATABASE ITEM IN EXPRESSN #
      IF DIRTIVE EQ EVALCODE
      THEN
        BEGIN 
  
        P<EVALDATA> = BASCADDR[BASTABIND];
  
        FOR J = 0 STEP 1           # FOR EACH *EVALUATE* IN TRANSMISSN #
          WHILE EVALWD[J] NQ 0
        DO
          BEGIN 
          IF DATASTACK [J] EQ 0     # IF THERE ISN'T A PROGRAMSTACK    #
          THEN
            BEGIN 
                                   # IT'S A SINGLE ITEM EXPRESSN, SO   #
            P<DTABLE> = DATACNVT[J];  # INFO IS IN THE DISPLAY TABLE   #
  
            IF CPFROMADDR[0] GR 0  # IF THE RECORD ORDINAL IS STORED   #
              AND CPFROMADDR[0] LQ MAXREC 
            THEN
              BEGIN 
              RECORDSEEN[CPFROMADDR[0]] = TRUE;  # FLAG RECORD AS SEEN #
              REFERFILE = 1;       # INDICATE DATABASE ACCESS          #
              END 
  
            END 
          ELSE                     # IF THERE IS A PROGRAMSTACK        #
            BEGIN 
  
            P<PROGRAMSTACK> = DATASTACK[J]; 
  
            FOR K = 0 STEP 1
              WHILE PSTKWORD[K] NQ 0   # CHECK EACH ELEMENT IN EXPRESSN#
            DO
              BEGIN 
              IF TOWORDBASE[K] GR 0   # IF THE RECORD ORDINAL IS STORED#
                AND TOWORDBASE[K] LQ MAXREC 
              THEN
                BEGIN 
                RECORDSEEN[TOWORDBASE[K]] = TRUE;  # SET RECORD AS SEEN#
                REFERFILE = 1;     # INDICATE DATABASE ACCESS          #
                END 
              END                  # END LOOP THROUGH PROGRAMSTACK     #
  
            END 
          END                      # END MULTIPLE EVALUATE LOOP        #
  
        END                        # END EVALUATE PROCESSING           #
      IF REFERFILE EQ 0            # IF IMF DATA BASE NOT ACCESSED     #
      THEN
        BEGIN 
        STDYES; 
        END 
  
      ERROR = FALSE;         # WE INITIALLY ASSUME THAT THE NAVIGATION #
                             # STRATEGY WILL BE CORRECT.               #
  
                             # SEE IF THERE IS ONLY ONE RECORD TYPE    #
                             # INVOLVED AND NO -VIA-.                  #
      COUNT = 0;             # TO START COUNTING THE NUMBER OF RECORD  #
                             # TYPES SEEN IN THE ARRAY RECORDS.        #
      FOR J=1 STEP 1 WHILE RECORDENTRY [J] NQ 0  DO 
        BEGIN 
        IF RECORDSEEN [J] THEN
          BEGIN 
          P<SRAT> = RECORDSYMBOL [J];  # POINT TO SYMBOLIC TABLE       #
          COUNT = COUNT + 1;
          K = J;             # SAVE THE RECORD ID FOR LATER USE,       #
                             # IN CASE THAT RECORD IS THE ONLY ONE     #
                             # AND NO -VIA- IS GIVEN.                  #
          IF   (OBTAINING              # TRYING TO OBTAIN A RECORD     #
                AND RECOBTF EQ 0)      # BUT NOT ALLOWED TO DO SO      #
            OR (STORING                # TRYING TO STORE               #
                AND RECSTDF EQ 0)      # BUT NOT ALLOWED TO DO SO      #
            OR (REMOVING               # TRYING TO REMOVE              #
                AND RECDELF EQ 0)      # BUT NOT ALLOWED TO DO SO      #
            OR (MODIFYING              # TRYING TO MODIFY              #
                AND RECMODF EQ 0)      # BUT NOT ALLOWED TO DO SO      #
          THEN                         # PERMISSION TO PROCESS NOT GIVN#
            BEGIN 
            CALL DIAG (531, RECNAME); 
            ERROR = TRUE; 
            END 
          END 
        END 
  
      IF    (COUNT GR 1)           # MORE THAN ONE RECORD TYPE         #
        AND (   STORING 
             OR MODIFYING 
             OR REMOVING) 
      THEN
        BEGIN 
        DIAG ( 532 ); 
        ERROR = TRUE; 
        END 
  
      IF COUNT EQ 1          # ONLY ONE RECORD TYPE INVOLVED           #
        AND THREADENTRY[1] EQ 0    # -FOLLOW- NOT IN EFFECT            #
      THEN
        BEGIN 
        THISRECORDID [1] = K;      # USE ORDINAL OF ONLY RECORD SEEN   #
        PATHCOSETID [1] = FIRSTPATH [K];   # USE FIRST PATH ORDINAL OF #
                                           # ONLY RECORD SEEN.         #
        END 
                                   # RETURN IF PROCESSING -IF-. FOR    #
                                   # MULTI-RECORD TYPE QUERY, NAVICHK  #
                                   # IS CALLED FROM THE FOLLOWING      #
                                   # DISPLAY OR EXTRACT                #
      IF DIRTIVE EQ IFCODE
      THEN
        BEGIN 
        STDYES; 
        END 
  
  
  
      IF COUNT GR 1          # WE HAVE A MULTI-RECORD TYPE QUERY       #
      THEN
      BEGIN 
                             # SEARCH FOR LOOPS AND MISSING LINKS.     #
      FOR J=1 STEP 1 WHILE RECORDENTRY [J] NQ 0  DO 
        BEGIN 
        IF NOT RECORDSEEN [J] THEN TEST J; # SKIP EMPTY ENTRIES        #
        P<SRAT> = RECORDSYMBOL [J];      # POINT TO SYMBOLIC TABLE     #
        COUNT = 0;           # TO START COUNTING THE NUMBER OF TIMES   #
                             # THE RECORD ENTRY IS POINTED TO.         #
        FOR K=1 STEP 1 WHILE THREADENTRY [K] NQ 0  DO 
          BEGIN 
          IF THISRECORDID [K] EQ J
          THEN               # THREAD ENTRY POINTS TO RECORD ENTRY     #
            COUNT = COUNT + 1;
          END 
  
        IF COUNT NQ 1 THEN   # THE COUNT SHOULD BE 1 EXACTLY           #
          BEGIN 
          ERROR = TRUE;      # FLAG THE ERROR                          #
          IF COUNT GR 1 
          THEN               # THERE IS A LOOP                         #
            BEGIN 
            CALL DIAG (528, RECNAME); 
            END 
          ELSE               # THERE IS A MISSING LINK                 #
            BEGIN 
            CALL DIAG (529, RECNAME); 
            END 
          END 
        END 
      END                          # END MULTI-RECORD QUERY TEST       #
  
      IF ERROR                     # IF ERRORS IN NAV. STRATEGY        #
      THEN
        BEGIN 
        STDNO;                     # RETURN VIA STDNO                  #
        END 
      ELSE                         # IF GOOD NAV. STRATEGY             #
        BEGIN 
        STDYES;                    # RETURN VIA STDYES                 #
        END 
  
#----------------------------------------------------------------------#
      CONTROL EJECT;
  
#----------------------------------------------------------------------#
#                                                                      #
#     S E G M C H K                                                    #
#                                                                      #
#     THIS PROCEDURE CHECKS THAT SEGMENTATION DOES NOT OCCUR IN        #
#     THE NAVIGATION PATH.  THE ACCESS PATH, MEMBER AND OWNER          #
#     COSETS MUST BE LINKED TOGETHER WITHOUT GAPS OR LOOPS.            #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC SEGMCHK;
      PROC SEGMCHK; 
      BEGIN 
  
      RECYES;                      # RETURN TO STDYES IF RECORDING     #
  
        ERROR = FALSE;             # ASSUME STRATEGY IS CORRECT        #
  
                             # SEARCH FOR SEGMENTATION.                #
                             # THE INDEX -BELOW- STARTS AT 2, SO THAT  #
                             # THERE IS ONE ENTRY ABOVE IT FOR         #
                             # THE INDEX -ABOVE-.                      #
      FOR BELOW=2 STEP 1 WHILE THREADENTRY [BELOW] NQ 0 DO
        BEGIN 
        FOR ABOVE=1 STEP 1 UNTIL BELOW - 1  DO
          BEGIN 
          IF THISRECORDID [ABOVE] EQ ORIGRECORDID [BELOW] 
          THEN TEST BELOW;   # RECORD BELOW IS REFERENCED ABOVE        #
          END 
        ERROR = TRUE;        # NO REFERENCE ABOVE WAS FOUND.           #
        P<SRAT> = RECORDSYMBOL [ ORIGRECORDID [BELOW]]; 
        CALL DIAG (530, RECNAME);  # THERE IS A GAP                    #
        END 
  
                             # SEARCH FOR RETRACED COSETS, THAT IS     #
                             # COSET NAMES APPEARING MORE THAN ONCE    #
                             # IN THE NAVIGATION ROUTE.                #
      FOR BELOW=3 STEP 1 WHILE THREADENTRY [BELOW] NQ 0  DO 
        BEGIN 
        FOR ABOVE = 2 STEP 1 UNTIL BELOW - 1  DO
          BEGIN 
          IF PATHCOSETID [ABOVE] EQ PATHCOSETID [BELOW] THEN
            BEGIN 
            ERROR = TRUE;    # COSET BEING RETRACED                    #
            P<SRAT> = RECORDSYMBOL [ THISRECORDID [BELOW]]; 
            CALL DIAG (528, RECNAME); 
            TEST BELOW; 
            END 
          END 
        END 
  
      IF ERROR
      THEN
        BEGIN 
        CALL STDNO; 
        END 
      ELSE
        BEGIN 
        CALL STDYES;
        END 
  
      END                          # END SEGMCHK                       #
  
#----------------------------------------------------------------------#
END 
TERM
