*DECK DB$CREL 
USETEXT UTMPTTX 
USETEXT UTCITTX 
USETEXT UTCDFTX 
USETEXT CUGBATX 
      PROC DB$CREL; 
 #
  *   DB$CREL - BUILD A RELATION WORK BLOCK      PAGE  1
  *   STEVEN P. LEVIN                            DATE  06/14/76 
  
  DC  PURPOSE 
  
      BUILD A CST RELATION WORK BLOCK IN THE WORK BLOCK MEMORY BLOCK. 
  
  DC  ENTRY CONDITIONS
  
      THE FOLLOWING COMMON ITEMS SHOULD HAVE BEEN GIVEN VALID VALUES: 
      LENJOINB - RSB (A CDCS TERM) JOIN BUFFER LENGTH IN WORDS
      LENSERCH - RSB (A CDCS TERM) SEARCH/QUALIFICATION TABLE LENGTH
      LENSTACK - RSB (A CDCS TERM) QUALIFICATION STACK BUFFER LENGTH
      SBCURRAD - SUBSCHEMA CURRENT MAIN ENTRY (RELATION HEADR) ADDRESS
      SBMAXENT - SUBSCHEMA MAXIMUM SUBENTRY LENGTH IN WORDS 
      SBNEXTAD - SUBSCHEMA NEXT MAIN ENTRY (RELATION HEADER) ADDRESS
      SUBSADDR - SUBSCHEMA MEMORY BLOCK ADDRESS OF WD AFTER HEADER WD 
      WORKADDR - WORK BLOCK MAIN BLOCK ADDRESS OF WORD AFTER HEADER WD
      WORPOINT - WORK BLOCK MAIN BLOCK MANAGED MEMORY POINTER WORD
      FURTHER, THE SUBSCHEMA SHOULD HAVE VALID INFO FOR THE RELATION. 
  
  DC  EXIT CONDITIONS 
  
      ON NORMAL DB$CREL RETURN THE MD FILE WILL CONTAIN A NEW RELATION
      WORK BLOCK AT THE END OF THE PARTIALLY BUILT CST ALREADY THERE. 
      SBCURRAD WILL CONTAIN THE NEWLY-MADE RELATION SUBSCHEMA ADDRESS.
      SBNEXTAD WILL CONTAIN THE NEXT RELATION ENTRY SUBSCHEMA ADDRESS.
      IF AN ERROR IS FOUND DURING DB$CREL PROCESSING, THE CST BUILDER 
      (AT LEAST) WILL BE ABORTED THROUGH A CALL TO THE MODULE DB$CERR.
  
  DC  CALLING ROUTINES
  
      DB$CBLD - CONDENSED SCHEMA/SUBSCHEMA TABLE BUILDER MAIN MODULE
  
  DC  CALLED ROUTINES 
  
      DB$CERR - ERROR MESSAGE AND RETURN HANDLER FOR FATAL ERRORS 
      DB$CFIL - FUNCTION TO BLANK OR BINARY ZERO CHARACTER FILL STRING
      DB$CGSB - DB$CGSD ENTRY POINT FOR A SUBSCHEMA DIRECTORY CRM GET 
      DB$CPUT - PUT WORDS FROM CORE INTO THE MASTER DIRECTORY FILE
      DB$UAWS - ADJUST THE WORK SPACE USABLE IN A MANAGED MEMORY BLOCK
  
  DC  NON-LOCAL VARIABLES 
  
      CURNAME  - CURRENT DATA BASE ELEMENT NAME 
      CURSCRAT - CURRENT SCRATCH NAME (USED AS A TEMPORARY AT TIMES)
      LENJOINB - RSB (A CDCS TERM) JOIN BUFFER LENGTH IN WORDS
      LENSERCH - RSB (A CDCS TERM) SEARCH/QUALIFICATION TABLE LENGTH
      LENSTACK - RSB (A CDCS TERM) QUALIFICATION STACK BUFFER LENGTH
      SBCURRAD - SUBSCHEMA CURRENT MAIN ENTRY (RELATION HEADR) ADDRESS
      SBGETFWA - SUBSCHEMA FIRST WORD ADDRESS TO BE READ BY A CRM GET 
      SBNEXTAD - SUBSCHEMA NEXT MAIN ENTRY (RELATION HEADER) ADDRESS
      WOCURENT - WORK BLOCK MANAGED MEMORY BLOCK CURRENT WORD LENGTH
      ALSO, BOTH THE WORK BLOCK CORE BLOCK AND THE MD FILE WILL CHANGE
      AS THE RELATION WORK BLOCK IS BUILT AND WRITTEN TO THE MD FILE. 
  
  DC  DESCRIPTION 
  
      CALL DB$CGSB TO GET NEXT SUBSCHEMA RELAT HEADER. ABORT ON ERROR.
      FILL IN RELATION WORK BLOCK USING INFO IN CORE.  ABORT ON ERROR.
      IF THE RELATION HAS A QUALIFICATION TABLE, BEGIN PROCESSING IT. 
      DO FURTHER PROCESSING NEEDED BEFORE LOOPING THROUGH THE RANKS.
      LOOP THROUGH THE RANKS, BUILDING A SEARCH TABLE ENTRY FOR EACH. 
      IF THE RANK IS QUALIFIED, BUILD ITS QUALIFICATION TABLE ENTRY.
      UPDATE THE SEARCH TABLE ENTRY POINTER FOR THE CST FOR NEXT RANK.
      CHECK VALIDITY OF VARIOUS LENGTHS AND VALUES.  ABORT ON ERROR.
      CALL DB$CPUT TO PUT IN MD.  CALL DB$UAWS TO ADJUST WORK SPACE.
      RESET VALUES OF SOME LENGTH AND CURRENT ACTIVITY COMMON ITEMS.
      RETURN FROM DB$CREL WITH THE RELATION WORK BLOCK NOW IN THE MD. 
 #
        CONTROL EJECT;
  
        BEGIN                # DB$CREL #
  
# THE FOLLOWING ARE EXTERNALLY REFERENCED PROCEDURES AND FUNCTIONS #
  
        XREF PROC DB$CERR;   # ERROR HANDLER FOR FATAL ERRORS # 
        XREF FUNC DB$CFIL C(30);       # BLANK OR ZERO CHARACTER FILL#
        XREF PROC DB$CGSB;   # DB$CGSD ENTRY POINT FOR SUBSCHEMA GET #
        XREF PROC DB$CPUT;   # PUT CORE WORDS IN THE MASTER DIRECTORY#
        XREF PROC DB$UAWS;   # ADJUST MANAGED MEMORY BLOCK WORK SPACE#
  
        CONTROL NOLIST;      # DCLS: UTCDF UTCIT UTMPT CUGBA CSTRN #
*CALL CSTRNDCLS 
        CONTROL LIST;        # RESUME THE LISTING OF THE SOURCE CODE #
        CONTROL EJECT;
  
# THE FOLLOWING COMMON IS FOR DDL SUBSCHEMA AND SCHEMA HEADER ARRAYS #
  
        COMMON DB$CCAH; 
  
        BEGIN                # DB$CCAH COMMON BLOCK # 
  
# THE FOLLOWING FIXED ARRAY IS FOR A SUBSCHEMA RELATION HEADER ENTRY #
  
          ARRAY SBHEADER[0:0] P(DFSBHEAD);       # SUBSCHEMA HEADER # 
  
          BEGIN              # SBHEADER ARRAY # 
  
*CALL SBRLHDDCL 
  
          END                # SBHEADER ARRAY # 
        CONTROL EJECT;
  
# THE FOLLOWING FIXED ARRAY IS FOR THE SCHEMA RELATION HEADER ENTRY # 
  
          ARRAY SCHEADER[0:0] P(DFSCHEAD);       # SCHEMA HEADER #
  
          BEGIN              # SCHEADER ARRAY # 
  
*CALL SCRLHDDCL 
  
          END                # SCHEADER ARRAY # 
  
          END                # DB$CCAH COMMON BLOCK # 
  
# THE FOLLOWING LOCAL ITEMS ARE COUNTS, FLAGS, LENGTHS, AND POINTERS #
  
        ITEM ATTRENTR U;     # QUALIFICATION ATTRIBUTE ENTRY POINTER #
        ITEM ATTRLENG U;     # QUALIFICATION ATTRIBUTE ENTRY LENGTH # 
        ITEM ATTRPNTR U;     # QUALIFICATION TABLE ATTRIBUTE POINTER #
        ITEM ATTRTOTL U;     # QUALIFICATION ATTRIBUTE TOTAL LENGTH # 
        ITEM INDEX I;        # A GENERAL INDEX AND INDUCTION VARIABLE#
        ITEM INNER I;        # A GENERAL INDEX AND INDUCTION VARIABLE#
        ITEM NOMAPING B;     # TRUE IFF NO RECORD MAPPING FOR RANK #
        ITEM QUALLENG U;     # QUALIFICATION TABLE LENGTH IN WORDS #
        ITEM QUALPNTR U;     # QUALIFICATION TABLE POINTER IN THE CST#
        ITEM RANKCURR I;     # CURRENT RANK IN THE RELATION # 
        ITEM RANKMAX U;      # MAXIMUM (HIGHEST) RANK IN THE RELATION#
        ITEM RANKQUAL U;     # QUALIFICATION TABLE MAXIMUM RANK # 
        ITEM SERCSTEN U;     # SEARCH TABLE ENTRY POINTER FOR THE CST#
        ITEM SERSUBEN U;     # SEARCH TABLE ENTRY SUBSCHEMA POINTER # 
        ITEM STAKENTR U;     # QUALIFICATION STACK ENTRY POINTER #
        ITEM STAKEOLD U;     # QUALIFICATION STACK OLD ENTRY POINTER #
        ITEM STAKLENG U;     # QUALIFICATION STACK RANK WORD LENGTH # 
  
# FOLLOWING LOCAL FIXED ARRAY IS FOR NEXT QUALIFICATION STACK ENTRY # 
  
        ARRAY NEXTSTAK[0:0] P(1);      # NEXT QUALIFY STACK ENTRY # 
  
          ITEM NEXTSTWD U(0,0,60);     # NEXT QUALIFY STACK ENTRY WRD#
  
# FOLLOWING LOCAL BASED ARRAY FOR RELATION QUALIFY TABLE ATTRIBUTES # 
  
        BASED ARRAY RQTATRIB;          # REL QUALIFY TABLE ATTRIBUTES#
  
          BEGIN              # RQTATRIB BASED ARRAY # 
  
*CALL SBRQATDCL 
  
          END                # RQTATRIB BASED ARRAY # 
  
# FOLLOWING LOCAL BASED ARRAY FOR RELATION QUALIFY TABLE HEADER ENTRY#
  
        BASED ARRAY RQTHEADR;          # RELATION QUALIFY TABLE HEADR#
  
          BEGIN              # RQTHEADR BASED ARRAY # 
  
*CALL SBRQHDDCL 
  
          END                # RQTHEADR BASED ARRAY # 
  
# FOLLOWING LOCAL BASED ARRAY FOR RELATION QUALIFY TABLE STACK ENTRY #
  
        BASED ARRAY RQTSTACK;          # RELATION QUALIFY TABLE STACK#
  
          BEGIN              # RQTSTACK BASED ARRAY # 
  
*CALL SBRQSTDCL 
  
          END                # RQTSTACK BASED ARRAY # 
  
# FOLLOWING LOCAL BASED ARRAY IS FOR SUBSCEHMA RELATION SEARCH TABLE #
  
        BASED ARRAY RSTENTRY;          # RELATION SEARCH TABLE ENTRY #
  
          BEGIN              # RSTENTRY BASED ARRAY # 
  
*CALL SBRLDBDCL 
  
          END                # RSTENTRY BASED ARRAY # 
        CONTROL EJECT;
  
# CALL DB$CGSB TO GET NEXT SUBSCHEMA RELATION HEADER. ABORT ON ERROR.#
  
        IF SBCURRAD EQ SBNEXTAD        # CURRENT AND NEXT ADDRESSES # 
          THEN XCALL DB$CERR("7901CREL",SBCURRAD);         # ABORT #
        XCALL DB$CGSB(LOC(SBHEADER),DFSBHEAD,SBNEXTAD);    # GET HEAD#
        SBCURRAD = SBNEXTAD;           # SUBSCHEMA CURRENT ADDRESS #
        SBNEXTAD = SBNEXTAD + RSTNXTRSTPTR[0];   # SUBSCHEMA NEXT ADD#
        IF RSTENTRYTYPE[0] NQ 4        # IF ENTRY TYPE IS NOT 4 (REL)#
          THEN XCALL DB$CERR("7902CREL",RSTENTRYTYPE[0]);  # ABORT #
        CURSCRAT = RSTRELNAME30[0];    # AVOID A SYMPL COMPILER ERROR#
        CURNAME = DB$CFIL(CURSCRAT,RSTRELNMELC[0]," ");    # " "-FILL#
  
# FILL IN THE RELATION WORK BLOCK USING INFO IN CORE. ABORT ON ERROR.#
  
        RANKMAX = RSTHIGHRANK[0];      # MAXIMUM RANK IN THE RELATION#
        SERCSTEN = DFRELWRK + RSTRELNMELW[0];    # FIXED + NAME SIZE #
        WOCURENT = SERCSTEN + RANKMAX * DFCSTSER;          # + SEARCH#
        XCALL DB$UAWS(LOC(WORPOINT),WOCURENT);   # ADJUST WORK SPACE #
        P<CSRLNBLK> = WORKADDR;        # POINT TO WORK BLOCK IN CORE #
        CSNMAXRK[0] = RANKMAX;         # MAXIMUM RANK IN THE RELATION#
        CSNNAMLW[0] = RSTRELNMELW[0];  # RELATION NAME LENGTH IN WRDS#
        CSNSERPT[0] = SERCSTEN;        # RELATION SEARCH TABLE POINTR#
        C<0,RSTRELNMELW[0] * DFCHARWD> CSNNAME[0] = CURNAME;
        IF CSNMAXRK[0] NQ RANKMAX      # IF MAXIMUM RANK IS TRUNCATED#
          THEN XCALL DB$CERR("7903CREL",RANKMAX);          # ABORT #
        IF CSNNAMLW[0] NQ RSTRELNMELW[0]         # IF LENGTH TRUNCATE#
          THEN XCALL DB$CERR("7904CREL",RSTRELNMELW[0]);   # ABORT #
        IF CSNSERPT[0] NQ SERCSTEN     # IF SEARCH POINTER TRUNCATED #
          THEN XCALL DB$CERR("7905CREL",SERCSTEN);         # ABORT #
  
# IF THE RELATION HAS A QUALIFICATION TABLE, BEGIN PROCESSING IT #
  
        IF RSTRQTPTR[0] NQ 0           # IF RELAT QUALIFICATION TABLE#
          THEN               # BEGIN PROCESSING QUALIFICATION TABLE # 
            BEGIN 
              SBGETFWA = SBCURRAD + RSTRQTPTR[0];          # RQT FWA #
              XCALL DB$CGSB(SUBSADDR,SBMAXENT,SBGETFWA);   # GET RQT #
              P<RQTHEADR> = SUBSADDR;            # POINT TO SUBSCHEMA#
              IF RQTENTRYTYPE[0] NQ 5            # IF ENTRY NOT 5 # 
                THEN XCALL DB$CERR("7906CREL",RQTENTRYTYPE[0]);#ABORT#
              ATTRPNTR = RQTATTRIBPTR[0];        # ATTRIBUTE POINTER #
              QUALLENG = RQTTBLLENG[0];          # RQT WORD LENGTH #
              RANKQUAL = RQTHIGHRANK[0];         # RQT MAXIMUM RANK # 
              XCALL DB$UAWS(LOC(WORPOINT),QUALLENG);       # ADJUST # 
              QUALPNTR = WOCURENT;     # QUALIFY TABLE POINTER IN CST#
              WOCURENT = WOCURENT + QUALLENG;    # WORK BLOCK LENGTH #
              P<CSRLNBLK> = WORKADDR;            #POINT TO WORK BLOCK#
              P<CSRLNQUL> = WORKADDR + QUALPNTR; #POINT IN WORK BLOCK#
              CSNQULPT[0] = QUALPNTR;            # QUALIFY TABLE PNTR#
              CSNQMXRK[0] = RANKQUAL;            # QUALIFY MAXIM RANK#
              CSNQLENG[0] = QUALLENG;            # QUALIFY TABLE SIZE#
              IF CSNQULPT[0] NQ QUALPNTR         # IF POINTR TRUNCATE#
                THEN XCALL DB$CERR("7907CREL",QUALPNTR);   # ABORT #
              IF CSNQMXRK[0] NQ RANKQUAL         # IF RANK TRUNCATED #
                THEN XCALL DB$CERR("7908CREL",RANKQUAL);   # ABORT #
              IF CSNQLENG[0] NQ QUALLENG         # IF LENGTH TRUNCATE#
                THEN XCALL DB$CERR("7909CREL",QUALLENG);   # ABORT #
              STAKENTR = 1;            # QUALIFY STACK ENTRY POINTER #
              SBGETFWA = SBGETFWA + STAKENTR;              #STACK FWA#
              XCALL DB$CGSB(LOC(NEXTSTAK),1,SBGETFWA);     # GET NEXT#
            END 
          ELSE               # THERE IS NO RELATION QUALIFY TABLE # 
            BEGIN 
              ATTRPNTR = 0;            # QUALIFY ATTRIBUTE POINTER #
              QUALLENG = 0;            # QUALIFY TABLE WORD LENGTH #
              RANKQUAL = 0;            # QUALIFY TABLE MAXIMUM RANK # 
              QUALPNTR = 0;            # QUALIFY TABLE POINTER IN CST#
              STAKENTR = 0;            # QUALIFY STACK ENTRY POINTER #
              NEXTSTWD[0] = 0;         # NEXT QUALIFY STACK ENTRY WRD#
            END 
  
# DO FURTHER PROCESSING NEEDED BEFORE LOOPING THROUGH THE RANKS # 
  
        P<RQTSTACK> = LOC(NEXTSTAK);   # POINT TO NEXT STACK ENTRY #
        P<CSRLNBLK> = WORKADDR;        # POINT TO WORK BLOCK IN CORE #
        CSNLENTH[0] = WOCURENT;        # LENGTH OF RELATION WORK BLCK#
        IF CSNLENTH[0] NQ WOCURENT     # CHECK IF LENGTH IS TRUNCATED#
          THEN XCALL DB$CERR("7910CREL",WOCURENT);         # ABORT #
        SERSUBEN = 2 + RSTRELNMELW[0]; # RST FIXED + REL NAME LENGTH #
        ATTRTOTL = 0;        # QUALIFICATION ATTRIBUTE TOTAL LENGTH # 
  
# LOOP THROUGH THE RANKS, BUILDING A SEARCH TABLE ENTRY FOR EACH RANK#
  
        FOR RANKCURR = 1 THRU RANKMAX DO         # LOOP THROUGH RANKS#
          BEGIN              # LOOP THROUGH THE RANKS # 
            SBGETFWA = SBCURRAD + SERSUBEN;      # SEARCH ENTRY ADDR.#
            XCALL DB$CGSB(SUBSADDR,SBMAXENT,SBGETFWA);     #GET ENTRY#
            P<RSTENTRY> = SUBSADDR;              # POINT TO SUBSCHEMA#
            P<CSRLNSER> = WORKADDR + SERCSTEN;   # POINT TO SEARCH  # 
            IF RANKCURR EQ 1 # ROOT (FIRST) RANK IS A SPECIAL CASE #
              THEN           # PROCESS SEARCH FIELDS FOR ROOT RANK #
                BEGIN 
                  NOMAPING = RSTNOMAPIND[0];     # NO RECORD MAP FLAG#
                  CSNSJNPT[0] = LENJOINB;        # JOIN BUFFER POINTR#
                  LENJOINB = LENJOINB + (RSTMAXKEYLG[0] 
                               + (DFCHARWD - 1)) / DFCHARWD;
                END 
              ELSE           # PROCESS SEARCH FIELDS FOR NONROOT RANK#
                BEGIN 
                  CSNSSIZE[0] = RSTITEMSIZE[0];            #ITEM SIZE#
                  CSNSSBCP[0] = RSTITEMBCP[0];             #SOURC BCP#
                  CSNSSBWP[0] = RSTITEMBWP[0];             #SOURC BWP#
                  CSNSTYPE[0] = RSTCLASSCDE[0];            #DATA TYPE#
                  P<RSTENTRY> = SUBSADDR + 2;              # NEXT # 
                  CSNSSTRA[0] = RSTKEYIND[0];              # STRATEGY#
                  CSNSTBCP[0] = RSTITEMBCP[0];             #TARGT BCP#
                  CSNSTBWP[0] = RSTITEMBWP[0];             #TARGT BWP#
                  CSNSNMAP[0] = NOMAPING;        # NO RECORD MAP FLAG#
                  NOMAPING = RSTNOMAPIND[0];     # NO RECORD MAP FLAG#
                  IF CSNSSTRA[0] LS 5            # SEARCH STRATEGY <5#
                    THEN               # JOIN BUFFER SPACE IS NEEDED #
                      BEGIN 
                        CSNSJNPT[0] = LENJOINB;            # JOIN BUF#
                        LENJOINB = LENJOINB + (CSNSSIZE[0]
                                     + (DFCHARWD - 1)) / DFCHARWD;
                      END 
                  SERSUBEN = SERSUBEN + 4;       # NEXT RANK SEARCH # 
                END 
            CSNSFRST[0] = TRUE;        # FIRST RETRIEVAL FOR THE RANK#
            CSNSRETR[0] = FALSE;       # QUALIFIED CHILD REC RETURNED#
            CSNSBREK[0] = FALSE;       # CONTROL BREAK AT THIS RANK # 
            CSNSCOLA[0] = RSTSEQOPT[0];          # COLLATING SEQUENCE#
            CSNSAORD[0] = RSTAREAORD[0];         # RANK AREA ORDINAL #
  
# IF THE RANK IS QUALIFIED, BUILD ITS CST QUALIFICATION TABLE ENTRY # 
  
            IF RANKCURR EQ RQTAREARANK[0]        # IF RANK QUALIFIED #
              THEN           # BUILD CST QUALIFICATION TABLE ENTRY #
                BEGIN 
                  STAKEOLD = STAKENTR;           # OLD STACK ENTRY PT#
                  CSNSQLPT[0] = STAKENTR;        # QUALIFY ENTRY PNTR#
                  STAKLENG = RQTSTACKLEN[0];     # STACK LEN FOR RANK#
                  SBGETFWA = SBCURRAD + RSTRQTPTR[0] + STAKENTR + 1;
                  XCALL DB$CGSB(SUBSADDR,STAKLENG,SBGETFWA);
                  FOR INDEX = 1 THRU STAKLENG DO           # LOOP # 
                    BEGIN 
                      P<CSRLNQUL> = WORKADDR + QUALPNTR + STAKENTR; 
                      CSNQTYPE[0] = RQTSTACKTYPE[0];       # TYPE # 
                      IF CSNQTYPE[0] EQ 1 OR CSNQTYPE[0] EQ 2 
                        THEN CSNQORDN[0] = RQTITEMORD[0]; 
                        ELSE IF CSNQTYPE[0] EQ 3 OR CSNQTYPE[0] EQ 4
                               THEN CSNQOPOR[0] = 0;       # 0/UNUSED#
                               ELSE IF CSNQTYPE[0] EQ 5    # OPERATOR#
                                      THEN       # OP CODE AND ORDINL#
                                        BEGIN 
                                          CSNQOPER[0] = RQTOPCDE[0];
                                          CSNQORDN[0] = 
                                            RQTRECORDORD[0];
                                        END 
                                      ELSE XCALL DB$CERR("7911CREL",
                                                   RQTSTACKTYPE[0]);
                      CSNQSLEN[0] = RQTSTACKLEN[0];        # LENGTH # 
                      CSNQRANK[0] = RQTAREARANK[0];        # RANK # 
                      CSNQATPT[0] = RQTATRIBTEWA[0];       # ATRIB PT#
                      IF CSNQSLEN[0] NQ RQTSTACKLEN[0]     # TRUNCATE#
                        THEN XCALL DB$CERR("7912CREL",RQTSTACKLEN[0]);
                      IF CSNQATPT[0] NQ RQTATRIBTEWA[0]    # TRUNCATE#
                        THEN           # POINTER TURNCATED, SO ABORT #
                          XCALL DB$CERR("7913CREL",RQTATRIBTEWA[0]);
                      P<RQTSTACK> = SUBSADDR + INDEX - 1; 
                      STAKENTR = STAKENTR + 1;             # ENTRY PT#
                    END 
                  P<GETENTRY> = SUBSADDR + STAKLENG - 1;   #NEXT RANK#
                  NEXTSTWD[0] = GETUNSIG[0];               # SAVE IT #
                  FOR INDEX = 1 THRU STAKLENG DO           # LOOP # 
                    BEGIN 
                      P<CSRLNQUL> = WORKADDR + QUALPNTR + STAKEOLD; 
                      ATTRENTR = CSNQATPT[0];              #ATTRIBUTE#
                      SBGETFWA = SBCURRAD + RSTRQTPTR[0] + ATTRENTR;
                      XCALL DB$CGSB(SUBSADDR,SBMAXENT,SBGETFWA);
                      P<RQTATRIB> = SUBSADDR;              #SUBSCHEMA#
                      ATTRLENG = RQTATTRLENG[0];           # LENGTH # 
                      ATTRTOTL = ATTRTOTL + ATTRLENG;      # TOTAL #
                      P<GETENTRY> = SUBSADDR - 1;          #SUBSCHEMA#
                      P<PUTENTRY> = WORKADDR + QUALPNTR    # WORK BLK#
                                             + ATTRENTR - 1;
                      FOR INNER = 1 THRU ATTRLENG DO       # LOOP # 
                        PUTUNSIG[INNER] = GETUNSIG[INNER]; # MOVE WDS#
                      STAKEOLD = STAKEOLD + 1;             # ENTRY PT#
                    END 
                  P<RQTSTACK> = LOC(NEXTSTAK);   # NEXT STACK ENTRY # 
                  IF RANKCURR LS RANKQUAL        # MAXIMUM QUALIFIED #
                    THEN               # CURRENT NOT MAXIMUM QUALIFY #
                      BEGIN 
                        IF RQTAREARANK[0] LS RANKCURR      #NEXT RANK#
                          THEN         # BAD RQT AREA RANK, SO ABORT #
                            XCALL DB$CERR("7914CREL",RQTAREARANK[0]); 
                      END 
                    ELSE               # MAXIMUM QUALIFIED PROCESSED #
                      BEGIN 
                        IF RANKCURR NQ RANKQUAL            # ABORT #
                          THEN XCALL DB$CERR("7915CREL",RANKCURR);
                        NEXTSTWD[0] = 0;         # NO MORE ENTRIES #
                  END 
               END
  
# UPDATE THE SEARCH TABLE ENTRY POINTER FOR THE CST FOR THE NEXT RANK#
  
            SERCSTEN = SERCSTEN + DFCSTSER;      # CST SEARCH ENTRY # 
          END      # LOOP THROUGH THE RANKS # 
  
# CHECK THE VALIDITY OF VARIOUS LENGTHS AND VALUES.  ABORT ON ERROR. #
  
        IF STAKENTR NQ ATTRPNTR        # IF ALL ENTRIES NOT PROCESSED#
          THEN XCALL DB$CERR("7916CREL",STAKENTR);         # ABORT #
        IF STAKENTR + ATTRTOTL NQ QUALLENG       # IF LENGTH ERROR #
          THEN XCALL DB$CERR("7917CREL",QUALLENG);         # ABORT #
        IF NEXTSTWD[0] NQ 0 THEN XCALL DB$CERR("7918CREL",RANKQUAL);
  
# CALL DB$CPUT TO PUT IN THE MD.  CALL DB$UAWS TO ADJUST WORK SPACE. #
  
        XCALL DB$CPUT(WORKADDR,WOCURENT);        # WRITE TO MD FILE # 
        XCALL DB$UAWS(LOC(WORPOINT),-WOCURENT);  # ADJUST WORK SPACE #
        WOCURENT = 0;        # WORK BLOCK CURRENT LENGTH IN WORDS # 
  
# RESET THE VALUES OF SOME LENGTH AND CURRENT ACTIVITY COMMON ITEMS # 
  
        LENSERCH = LENSERCH + RANKMAX * DFRSBSER + STAKENTR;
        IF LENSTACK LS STAKENTR THEN LENSTACK = STAKENTR; 
        CURNAME = " ";       # CURRENT DATA BASE ELEMENT NAME - NONE #
        CURSCRAT = " ";      # CURRENT SCRATCH USE NAME # 
  
# RETURN FROM DB$CREL WITH THE NEW RELATION WORK BLOCK NOW IN THE MD #
  
        RETURN;              # NEW RELATION WORK BLOCK NOW IN THE MD #
  
        END                  # DB$CREL #
  
      TERM
