*DECK RETSYN
USETEXT TAREATB 
USETEXT TCMMDEF 
USETEXT TCRMDEF 
USETEXT TDESATT 
USETEXT TENVIRN 
USETEXT TFIT
USETEXT TPSTACK 
USETEXT TRELTBL 
USETEXT TSBASIC 
USETEXT TXSTD 
      PROC RETSYN;                 # RETURN SUBSCHEMA, RELATION, AREA  #
                                   # OR LOCAL FILE NAME                #
      BEGIN 
  
      XREF ITEM SAVELFNAME;        # LOCAL FILE NAME                   #
      XREF ITEM AREATBLPTR;        # POINTER TO FIRST AREA TABLE       #
      XREF ITEM RELATBLPTR;        # POINTER TO FIRST RELATION TABLE   #
      XREF ITEM RA0;               # ZERO FOR END OF PARAMETER LIST    #
      XREF ITEM DBP$FWA;           # DATA BASE PROCEDURE CM FWA        #
      XREF ITEM TARGETAREA;        # P<AREA$TABLE> OF AREA TO BE       #
                                   # UPDATED IF UPDATE AREA IN EFFECT  #
      XREF ITEM UPDATEAREA B;      # TRUE IF UPDATE AREA IN EFFECT     #
      XREF ITEM VIAPOINT I;        # PTR TO RELATION TABLE ENTRY       #
                                   # WITH VIA SPECIFIED NAME           #
      XREF ITEM DEFLIST;           # POINTER TO DEFINE LIST            #
      XREF ITEM DESLIST;           # POINTER TO DESCRIBE LIST          #
      XREF ITEM CDCSCAT B;         # TRUE IF CDCS VERSION              #
      XREF ITEM CDCSDBM B;         # TRUE IF CDCS USE/CREATE           #
      XREF ITEM CDCSUP B;          # TRUE IF ACTUALLY CALL CDCS        #
      XREF ITEM INVOKED B;         # TRUE IF CDCS INVOKED              #
  
      XREF BASED ARRAY DBSTAT;;    # DATA BASE STATUS BLOCK            #
      XREF BASED ARRAY SAVDAREA;        # SAVED AREA TABLE ADDRESSES   #
        BEGIN 
        ITEM AREASAVE     U(00,42,18);  # AREA TABLE ADDRESSES         #
        ITEM AREASAVEWD   U(00,00,60);  # WHOLE WORD                   #
        ITEM AREAINUSE    B(00,00,01);  # TRUE - THIS AREA IN USE      #
        END 
  
      ARRAY TMPNAME[0:3];          # ARRAY FOR ZERO-FILLED FILE NAME   #
        BEGIN 
        ITEM TNAME U(0,0,60); 
        END 
  
      XREF PROC DIAG;              # ISSUE ERROR DIAGNOSTIC            #
      XREF PROC CHECKFORLFN;       # RELEASE CM FOR LFN IN LFNLIST     #
      XREF PROC RETURNM;           # ISSUE CIO REQUEST TO RETURN       #
      XREF PROC CLOSEM;            # ISSUE CIO REQUEST TO CLOSE        #
      XREF PROC RECNO;
      XREF PROC RECYES; 
      XREF PROC DB$CLS;            # CDCS CLOSE FILE                   #
      XREF PROC DB$END;            # CDCS TERMINATE                    #
  
  
      ITEM  THISENTRY;             # FORWARD LINK                      #
      ITEM  LASTENTRY;             # BACKWARD LINK                     #
      ITEM NEXT   I;               # SAVED FORWARD POINTER             #
      ITEM DUMMY1 I;               # FOR LOOP COUNTER                  #
      ITEM  DUMMY;                 # FOR LOOP COUNTER                  #
      ITEM  I;                     # FOR LOOP COUNTER                  #
      ITEM  FORWARD;               # FORWARD LINK                      #
      ITEM  BACKWARD;              # BACKWARD LINK                     #
      ITEM TMPBITPOS  I;           # HOLDS BIT POSITION                #
      ITEM TMPCHAR    I;           # HOLDS CURRENT CHARACTER           #
      ITEM TMPCOUNT   I;           # DO LOOP COUNTER                   #
      ITEM TMPWRDNUM  I;           # HOLDS CURRENT WORD POSITION       #
  
      BASED ARRAY GETA;            # ARRAY FOR COMPARING NAMES         #
        BEGIN 
        ITEM GETITEM U(0,0,60); 
        END 
CONTROL EJECT;
#----------------------------------------------------------------------#
#     PROC RTNAREA                                                     #
# IF *RETURN AREA-NAME* AND AREA NOT REFERENCED BY A RELATION, RELEASE #
# ALL CM USED BY AREA FILE AND DELINK AREA TABLE FROM CHAIN            #
#                                                                      #
# ON ENTRY NAME TO RETURN LEFT JUSTIFIED, ZERO FILL, IN ARRAY TEMPNAME #
# ON EXIT IF NAME EQ AN AREA NAME WHICH IS NOT USED IN A RELATION,     #
#         CM RELEASED, AREA TABLE DELINKED, EXIT TO STDYES             #
#         IF NAME EQ AN AREA NAME WHICH IS USED IN A RELATION, ISSUE   #
#           DIAG 342, EXIT TO STDYES                                   #
#         IF NAME NQ AREA NAME, EXIT TO STDNO                          #
#----------------------------------------------------------------------#
      XDEF PROC RTNAREA;
      PROC RTNAREA; 
      BEGIN 
      RECNO;                       # RETURN TO STDNO IF RECORDING      #
      IF AREATBLPTR EQ 0 THEN      #IF NO SUBSCHEMA TABLE              #
        BEGIN 
        STDNO;                     #NAME IS NOT AREA-NAME              #
        END 
      P<AREA$TABLE> = AREATBLPTR;  #POSITION TO SUBSCHEMA TABLE        #
      THISENTRY = AT$FORWARD;      #ADDRESS OF FIRST AREA TABLE        #
  
                                   #SEARCH ALL AREA TABLES FOR MATCH   #
                                   #ON TEMPNAME                        #
  
      FOR DUMMY = 0 STEP 1 WHILE THISENTRY NQ 0 DO
        BEGIN 
        P<AREA$TABLE> = THISENTRY;  #POSITION TO NEXT AREA TABLE IN CHN#
        THISENTRY = AT$FORWARD;    #SAVE FORWARD POINTER               #
        P<GETA> = LOC(AT$AFDB$NAME);  #POSITION TO AREA NAME           #
        FOR I = 0 STEP 1 UNTIL 2 DO  #COMPARE TNAME TO AREA NAME       #
          BEGIN 
          IF GETITEM[I] NQ TNAME[I] THEN  #IF NAMES ARE NOT THE SAME   #
            BEGIN 
            TEST DUMMY;            #LOOP BACK FOR NEXT AREA TABLE      #
            END 
          END 
  
                                   #LOGICAL END OF FIRST LOOP ON DUMMY #
                                   #MATCHING AREA TABLE FOUND          #
        IF CDCSDBM                 # IF CDCS DATABASE MODE             #
        THEN
          BEGIN 
          DIAG (402);              # AREA OR RELATION CAN-T BE RETURNED#
                                   # WHILE CDCS IS INVOKED             #
          STDYES;                  # COMPLETED PROCESSING OF THIS NAME #
          END 
  
                                   #IS THIS AREA REFERENCED BY RELATION#
  
        THISENTRY = RELATBLPTR;    #ADDRESS OF FIRST RELATION TABLE    #
                                   #OR ZERO IF NO RELATION TABLES EXIST#
        FOR DUMMY = 0 STEP 1 WHILE THISENTRY NQ 0 DO
          BEGIN 
          P<REL$TABLE> = THISENTRY;  #POSITION TO RELATION TABLE       #
          THISENTRY = RT$FORWARD;  #SAVE FORWARD POINTER               #
                                   #IS AREA REFERENCED BY THIS RELATION#
          IF B<RT$PATHBIT,1>AT$PATHFLAGS EQ 1 THEN
            BEGIN 
            DIAG(342,TNAME[0]);    #CANNOT RETURN AREA REF BY RELATION #
            STDYES;                #COMPLETED PROCESSING OF THIS NAME  #
            END 
          END                      #END SCAN OF RELATION TABLES        #
        RTNCMAREA;                 #RELEASE AREA TABLE CM              #
        STDYES;                    #AREA RETURNED                      #
        END                        #END SCAN OF AREA TABLES            #
      STDNO;                       #NO MATCH FOUND ON NAME             #
      END 
CONTROL EJECT;
#----------------------------------------------------------------------#
#     PROC RTNCMAREA                                                   #
# RETURN CM USED BY AREA TABLE AND DELINK AREA TABLE                   #
# REMOVE ALL AREA ITEMS FROM DEFINE LIST                               #
# ON ENTRY P<AREA$TABLE> = ADDRESS OF AREA TABLE TO RELEASE            #
#                                                                      #
#----------------------------------------------------------------------#
      PROC RTNCMAREA; 
      BEGIN 
      IF VERAREATBL EQ P<AREA$TABLE>  # IF RETURNING AREA WHICH HAS    #
                                      # ACTIVE VERIFY LIST             #
      THEN
        BEGIN 
        P<AREA$TABLE> = VERAREATBL;  # POSITION AREA TABLE             #
        CMM$FGR(AT$VERGRPID);      # RELEASE VERIFY CM                 #
        VERAREATBL = 0;            # INDICATE NO ACTIVE VERIFY LIST    #
        END 
      IF UPDATEAREA                # IF *UPDATE AREA* IN EFFECT        #
        AND P<AREA$TABLE> EQ TARGETAREA  # IF *UPDATE AREA-TO-BE-      #
                                         # RETURNED*                   #
      THEN
        BEGIN 
        UPDATEAREA = FALSE;        # DISCARD LAST UPDATE AREA          #
        TARGETAREA = 0; 
        END 
  
      # REMOVE ALL AREA ITEMS FROM DEFINE LIST                         #
      P<DESATT1> = DEFLIST;        # START OF DEFINE ENTRIES           #
      FORWARD = DEFLIST;           # SAVE THE WORKED ON ENTRY          #
      BACKWARD = 0;                # NO PREVIOUS YET                   #
      FOR DUMMY1 = 1 STEP 1        # GO THRU ENTIRE LIST               #
        WHILE FORWARD NQ 0
      DO
        BEGIN 
        NEXT = DABSPTR;            # SAVE FORWARD POINTER              #
        P<PROGRAMSTACK> = DEXPPTR;  # EXPRESSION STACK POINTER         #
        IF C<0>DDATNAM EQ ","      # SEE IF AREA ITEM FOR THIS AREA    #
          AND AREASAVE[AREAORD] EQ P<AREA$TABLE>
        THEN
          BEGIN 
          IF BACKWARD EQ 0         # IF THIS IS FIRST ENTRY            #
          THEN
            BEGIN 
            DEFLIST = NEXT;        # JUST RESET LIST POINTER           #
            END 
          ELSE
            BEGIN 
            P<DESATT1> = BACKWARD;  # OTHERWISE REMOVE FROM CHAIN      #
            DABSPTR = NEXT; 
            BACKWARD = FORWARD; 
            END 
          END 
          ELSE
            BEGIN 
            BACKWARD = FORWARD; 
            END 
        FORWARD = DABSPTR;         # POINT TO NEXT ENTRY               #
        P<DESATT1> = FORWARD; 
        END                        # END FOR LOOP                      #
  
      FORWARD = AT$FORWARD;        #SAVE FORWARD LINK                  #
      BACKWARD = AT$BACKWARD;      #SAVE BACKWARD LINK                 #
      CMM$FGR (AT$GROUPID);        #RELEASE AREA TABLE CM BY GROUP ID  #
      IF FORWARD NQ 0 THEN         #IF NOT LAST IN CHAIN               #
        BEGIN 
        P<AREA$TABLE> = FORWARD;   #POSITION TO NEXT FORWARD ENTRY     #
        AT$BACKWARD=BACKWARD;      #BACKWARD LINK OVER DELETED TABLE   #
        END 
                                   #AREA TABLE CANNOT BE FIRST IN CHAIN#
                                   #BECAUSE SUBSCHEMA TABLE IS FIRST   #
      P<AREA$TABLE> = BACKWARD;    #POSITION TO NEXT BACKWARD ENTRY    #
      AT$FORWARD = FORWARD;        #FORWARD LINK OVER DELETED ENTRY    #
      RETURN; 
      END 
CONTROL EJECT;
#----------------------------------------------------------------------#
#     PROC RTNLFN                                                      #
# RETURN FILE OF GIVEN NAME.  IF FILE IN LFNLIST, RELEASE ALL CM       #
# ON ENTRY NAME TO RETURN LEFT JUSTIFIED, ZERO FILL, IN TNAME[0]       #
#                                                                      #
#----------------------------------------------------------------------#
      XDEF PROC RTNLFN; 
      PROC RTNLFN;
      BEGIN 
      IF RECORDFLAG THEN           #IF RECORDING                       #
        BEGIN 
        STDYES;                    #DO NOT RETURN FILE IF RECORDING    #
        END 
      IF C<0,5>TNAME[0] EQ "ZZZZZ" THEN  #IF SYSTEM FILE               #
        BEGIN 
        STDYES;                    #DO NOT RETURN SYSTEM FILE          #
        END 
      SAVELFNAME = TNAME[0];       #PASS FILE NAME TO CHECKFORLFN      #
      CHECKFORLFN;                 #RELEASE CM IF FILE IN LFNLIST      #
      DESLIST = 0;                 # DESCRIBE LIST WAS RELEASED        #
      RETURNM (SAVELFNAME,RA0);    #RETURN FILE                        #
      STDYES; 
      END 
CONTROL EJECT;
#----------------------------------------------------------------------#
#     PROC RTNRELN                                                     #
# IF *RETURN RELATION-NAME* RELEASE ALL CM USED BY RELATION AND DELINK #
# RELATION TABLE.  RELEASE CM AND DELINK ALL AREA TABLES REFERENCED    #
# BY THIS RELATION ONLY.  CLEAR THIS RELATION BIT IN ALL AREA TABLES   #
# REFERENCED BY THIS AND ANOTHER RELATION                              #
#                                                                      #
# ON ENTRY NAME TO RETURN LEFT JUSTIFIED, BLANK FILL, IN WORDS ICWI    #
# EXIT TO STDYES IF RELATION RETURNED                                  #
# EXIT TO STDNO IF NAME MATCHES NO EXISTING RELATION                   #
#----------------------------------------------------------------------#
      XDEF PROC RTNRELN;
      PROC RTNRELN; 
      BEGIN 
      RECYES;                      # RETURN TO STDYES IF RECORDING     #
      THISENTRY = RELATBLPTR;      #ADDRESS OF FIRST RELATION TABLE    #
                                   #OR ZERO IF NO RELATION TABLE EXISTS#
                                   #SCAN RELATION TABLE CHAIN SEARCHING#
                                   #FOR MATCH ON NAMES                 #
      FOR DUMMY = 0 STEP 1 WHILE THISENTRY NQ 0 DO
        BEGIN 
        P<REL$TABLE> = THISENTRY;  #POSITION TO RELATION TABLE         #
        THISENTRY = RT$FORWARD;    #SAVE THE FORWARD POINTER           #
        LASTENTRY = P<REL$TABLE>;  #SAVE CURRENT BLOCK ADDRESS         #
        P<GETA> = LOC(RT$RELNAME);  #POSITION TO RELATION NAME         #
        FOR I = 0 STEP 1 UNTIL 2 DO  #COMPARE NAMES                    #
          BEGIN 
          IF GETITEM[I] NQ ICWI[I] THEN  #IF NAMES ARE NOT THE SAME    #
            BEGIN 
            TEST DUMMY;            #LOOP BACK FOR NEXT RELATION TABLE  #
            END 
          END 
  
        IF CDCSDBM                 # IF CDCS DATABASE MODE             #
        THEN
          BEGIN 
          DIAG (402);              # AREA OR RELATION CAN-T BE RETURNED#
                                   # WHILE CDCS IS INVOKED             #
          STDYES;                  # COMPLETED PROCESSING OF THIS NAME #
          END 
  
        IF P<REL$TABLE> EQ VIAPOINT  # IF *VIA* THIS RELATION          #
        THEN
          BEGIN 
          VIAPOINT = 0;            # DISCARD LAST VIA                  #
          END 
                                   #RELATION NAME FOUND.  CHECK        #
                                   #RANK ENTRIES AND RELEASE AREA      #
                                   #TABLES IF POSSIBLE                 #
  
                                   #PREPARE TO POSITION TO FIRST       #
                                   #RANK ENTRY                         #
        P<REL$RANKINFO> = LOC(RT$RANKPOS) - RANKSIZE; 
        FOR I = 1 STEP 1 UNTIL (RT$NORANKS * 2) DO  # SCAN RANK ENTRIES#
          BEGIN 
                                   #POSITION TO NEXT RANK ENTRY        #
          P<REL$RANKINFO> = P<REL$RANKINFO> + RANKSIZE; 
                                   #POSITION TO AREA TABLE POINTED     #
                                   #TO BY THIS RANK ENTRY              #
          P<AREA$TABLE> = RR$AREAPTR; 
          IF AT$PATHFLAGS NQ 0 THEN  # IF AREA ACTIVE IN SOME RELATION #
            BEGIN 
            B<RT$PATHBIT>AT$PATHFLAGS = 0;  # CLEAR BIT FOR THIS RELATN#
            IF AT$PATHFLAGS EQ 0 THEN  # IF AREA NOT IN OTHER RELATIONS#
              BEGIN 
              RTNCMAREA;           # RELEASE THE AREA TABLE CM         #
              END 
            END 
          END 
  
  
                                   #RELEASE CM OF RELATION TABLE AND   #
                                   #DELINK RELATION TABLE FROM CHAIN   #
  
        CMM$FGR(RT$GROUPID);       # RELEASE ALL RELATION TBL CM       #
        LASTENTRY = RT$BACKWARD;   #SAVE BACKWARD LINK                 #
        IF THISENTRY NQ 0 THEN     #IF NOT LAST IN CHAIN               #
          BEGIN 
          P<REL$TABLE> = THISENTRY;  #POSITION TO NEXT FORWARD ENTRY   #
          RT$BACKWARD = LASTENTRY; #BACKWARD LINK OVER DELETED TABLE   #
          END 
        IF LASTENTRY NQ 0 THEN     #IF NOT FIRST IN CHAIN              #
          BEGIN 
          P<REL$TABLE> = LASTENTRY;  #POSITION TO NEXT BACKWARD ENTRY  #
          RT$FORWARD = THISENTRY;  #FORWARD LINK OVER DELETED ENTRY    #
          END 
        ELSE                       #IF FIRST IN CHAIN                  #
          BEGIN 
          RELATBLPTR = THISENTRY;  #SET PTR TO NEW 1ST IN CHAIN OR 0   #
          END 
        STDYES;                    #RELATION RETURNED                  #
        END                        #END SCAN OF RELATION TABLES (DUMMY)#
      STDNO;                       #NO MATCH ON NAME                   #
      END 
CONTROL EJECT;
#----------------------------------------------------------------------#
#     PROC RTNSCHEM                                                    #
# IF *RETURN SUBSCHEMA NAME*, RETURN SUBSCHEMA FILE AND RELEASE ALL    #
# CM USED BY THE LAST USE DIRECTIVE                                    #
#                                                                      #
# ON ENTRY NAME TO RETURN LEFT JUSTIFIED, ZERO FILL, IN ARRAY TEMPNAME #
# ON EXIT IF NAME EQ CURRENT SUBSCHEMA NAME, SUBSCHEMA FILE RETURNED,  #
#                                           CM RELEASED, EXIT TO STDYES#
#         IF NAME NQ CURRENT SUBSCHEMA NAME, EXIT TO STDNO             #
#                                                                      #
#----------------------------------------------------------------------#
      XDEF PROC RTNSCHEM; 
      PROC RTNSCHEM;
      BEGIN 
      RECYES;                      # RETURN TO STDYES IF RECORDING     #
      IF AREATBLPTR EQ 0 THEN      #IF NO SUBSCHEMA TABLE              #
        BEGIN 
        STDNO;                     #NAME IS NOT SUBSCHEMA NAME         #
        END 
      P<AREA$TABLE> = AREATBLPTR;   #POSITION TO SUBSCHEMA TABLE       #
      P<GETA> = AREATBLPTR + AT$SBSCNAME;  # POSITION TO SUBSCHEMA NAME#
      FOR I = 0 STEP 1 UNTIL 2 DO  #COMPARE NAMES                      #
        BEGIN 
        IF GETITEM[I] NQ TNAME[I] THEN  #IF NAMES ARE NOT THE SAME     #
          BEGIN 
          STDNO;                   #EXIT, DO NOT RETURN SUB-SCHEMA     #
          END 
        END 
  
                                   #SUBSCHEMA NAME FOUND.  RETURN      #
                                   #CM FROM VERIFY LIST (IF ACTIVE),   #
                                   #SUBSCHEMA FILE, CM FROM SUBSCHEMA  #
                                   #TABLE AND ALL AREA TABLES          #
                                   # REMOVE AREAITEMS FROM DEFINE LIST #
      P<DESATT1> = DEFLIST;        # START OF ENTRIES                  #
      THISENTRY = DEFLIST;         # SAVE THE WORKED ON ENTRY          #
      LASTENTRY = 0;               # NO PREVIOUS ENTRY AS YET          #
      FOR DUMMY1 = 1 STEP 1 
        WHILE THISENTRY NQ 0       # GO THRU CHAIN                     #
      DO
        BEGIN 
        NEXT = DABSPTR; 
        IF C<0>DDATNAM EQ ","      # SEE IF AREA ITEM                  #
        THEN
          BEGIN 
          IF LASTENTRY EQ 0        # IF THIS IS FIRST ENTRY            #
          THEN
            BEGIN 
            DEFLIST = NEXT;        # JUST RESET POINTER                #
            END 
          ELSE
            BEGIN 
            P<DESATT1> = LASTENTRY;  # REMOVE FROM CHAIN               #
            DABSPTR = NEXT; 
            LASTENTRY = THISENTRY;
            END 
          END                      # END FOUND AREA ITEM               #
          ELSE
            BEGIN 
            LASTENTRY = THISENTRY;  # ALWAYS SAVE BACKWARD PTR         #
            END 
        THISENTRY = DABSPTR;       # POINT TO NEXT ENTRY               #
        P<DESATT1> = THISENTRY; 
        END                        # END FOR LOOP                      #
  
      IF VERAREATBL NQ 0           # IF ACTIVE VERIFY LIST             #
      THEN
        BEGIN 
        P<AREA$TABLE> = VERAREATBL;  # POSITION AREA TABLE             #
        CMM$FGR (AT$VERGRPID);       # RELEASE VERIFY CM               #
        VERAREATBL = 0;              # INDICATE NO ACTIVE VERIFY LIST  #
        END 
  
      P<AREA$TABLE> = AREATBLPTR;  # POSITION TO SUBSCHEMA TABLE       #
      P<FIT> = LOC(AT$AFITPOS);                                          RETSYN 
      THISENTRY = AT$FORWARD;      # SAVE FORWARD POINTER              #
      IF NOT CDCSCAT               # IF CRM DATABASE MODE OR CDCS DATA-#
                                   # BASE MODE WITHOUT CDCS CATALG MODE#
      THEN
        BEGIN 
        IF FITOC EQ OC$OPEN        # IF SUBSCHEMA FILE IS OPEN         #
        THEN
          BEGIN 
          CLOSEM (FIT, $DET$, RA0);  # CLOSE FILE, RELEASE BUFFERS     #
          END 
        RETURNM (FIT, RA0);        # RETURN SUBSCHEMA FILE             #
        CMM$FGR (AT$GROUPID);      # RETURN SUBSCHEMA TABLE CM         #
        AREATBLPTR = 0;            # CLEAR POINTER TO STRING           #
        END 
      ELSE
                                   # CDCS CATALOG MODE                 #
        BEGIN 
        AT$FORWARD = 0;            # CLEAR POINTER TO NEXT ENTRY       #
        END 
      UPDATEAREA = FALSE;          # DISCARD LAST UPDATE AREA          #
      TARGETAREA = 0; 
      VIAPOINT = 0;                # DISCARD LAST VIA                  #
      IF DBP$FWA NQ 0 THEN         #IF CM RESERVED FOR DATA BASE PROCS #
        BEGIN 
        CMM$FRF (DBP$FWA);         #RELEASE CM FOR DATA BASE PROCEDURES#
        DBP$FWA = 0;               #CLEAR THE POINTER TO D B PROC CM   #
        END 
      FOR DUMMY = 0 STEP 1 WHILE THISENTRY NQ 0 DO
        BEGIN 
        P<AREA$TABLE> = THISENTRY;  #POSITION TO THIS ENTRY            #
        THISENTRY = AT$FORWARD;    #SAVE POINTER TO NEXT ENTRY         #
        P<FIT> = LOC (AT$AFITPOS);  # POSITION TO FIT                  #
        IF CDCSDBM                 # IF CDCS DATABASE MODE             #
          AND FITOC EQ OC$OPEN     # AND AREA LEFT OPEN (BY CDCS)      #
        THEN
          BEGIN 
IF CDCSUP THEN
          DB$CLS (FIT, AT$AREAORD[0]);  # CDCS CLOSE FILE              #
          END 
        CMM$FGR (AT$GROUPID);      #RETURN AREA TABLE CM               #
        END 
  
                                   #RELEASE CM FROM RELATION TABLES    #
  
      THISENTRY = RELATBLPTR;      #ADDRESS OF FIRST RELATION TABLE    #
      RELATBLPTR = 0;              #CLEAR RELATION TABLE POINTER       #
      FOR DUMMY = 0 STEP 1 WHILE THISENTRY NQ 0 DO
        BEGIN 
        P<REL$TABLE> = THISENTRY;  #POSITION TO NEXT RELATION TABLE    #
        THISENTRY = RT$FORWARD;    #SAVE THE FORWARD POINTER           #
        LASTENTRY = P<REL$TABLE>;  #SAVE CURRENT BLOCK ADDRESS         #
        CMM$FGR(RT$GROUPID);       # RELEASE ALL RELATION TABLE CM     #
        END 
      IF CDCSDBM                   # IF CDCS DATABASE MODE             #
        AND NOT CDCSCAT            # AND NOT CDCS CATALOG MODE         #
      THEN
        BEGIN 
IF CDCSUP THEN
        DB$END;                    # CDCS *TERMINATE*                  #
        INVOKED = FALSE;           # CDCS NO LONGER INVOKED            #
        IF P<DBSTAT> NQ 0          # IF CDCS STATUS BLOCK ALLOCATED    #
        THEN
          BEGIN 
          CMM$FRF (P<DBSTAT>);     # FREE IT                           #
          P<DBSTAT> = 0;           # CLEAR POINTER                     #
          END 
        END 
      CDCSDBM = FALSE;             # CLEAR CDCS DATABASE MODE FLAG     #
      STDYES; 
      END 
CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#         PROC SVENAME                                                 #
#     SAVE THE NAME OF THE AREA OR RELATION                            #
#                                                                      #
#----------------------------------------------------------------------#
      XDEF PROC SVENAME;
      PROC SVENAME; 
      BEGIN 
                                   # THE NAME IS IN THE ARRAY ICW      #
                                   # ZERO FILL FILE NAME ARRAY         #
      FOR TMPCOUNT = 0 STEP 1 
        UNTIL 3 
      DO
        BEGIN 
        TNAME[TMPCOUNT] = 0;       # ZERO OUT CURRENT WORD             #
        END 
                                   # NOW MOVE THE CHARACTER STRING     #
                                   # MOVING WILL STOP ON THE FIRST     #
                                   # BLANK CHARACTER                   #
      FOR TMPWRDNUM = 0 STEP 1
      DO
        BEGIN 
        FOR TMPBITPOS = 0 STEP 6
          UNTIL 54
        DO
          BEGIN 
          TMPCHAR = B<TMPBITPOS,6>ICW[TMPWRDNUM];  # FETCH ONE CHARACTR#
          IF TMPCHAR EQ O"55"                      # IF CHAR IS A BLANK#
          THEN
            BEGIN 
            STDYES;                                # RETURN TO YES SIDE#
            END 
                                   # PLACE THE CHAR IN THE TEMPORARY   #
                                   # AREA FOR BUILDING THE NAME        #
          B<TMPBITPOS,6>TNAME[TMPWRDNUM] = TMPCHAR; 
          END 
        END 
      END 
      END 
      TERM
