*DECK DB$CARE 
USETEXT UTMPTTX 
USETEXT UTCITTX 
USETEXT UTCDFTX 
USETEXT CUGBATX 
      PROC DB$CARE; 
 #
  *   DB$CARE - BUILD AREA WORK BLOCK IN CORE    PAGE  1
  *   STEVEN P. LEVIN                            DATE  12/02/75 
  *   INDRU J. BHATIA ( CONSTRAINT PROCESSING )  DATE  12/02/78 
  
  DC  PURPOSE 
  
      BUILD A CST AREA WORK BLOCK IN THE WORK BLOCK MANAGED MEMORY
      BLOCK USING SUBSCHEMA, SCHEMA, AND MASTER DIRECTORY INFORMATION.
  
  DC  ENTRY CONDITIONS
  
      THE FOLLOWING COMMON ITEMS SHOULD HAVE BEEN GIVEN VALID VALUES: 
      CALADDR  - CONSTRAINT AREA LIST BLOCK ADDRESS OF WD AFTER HEADER
      CITADDR  - CONSTRAINT INTEGRITY TABLE BLCK ADR OF WD AFTER HEADR
      CONNBEXA - CONSTRAINT-INVOLVED NUMBER OF EXTENDED AREA ENTRIES
      CONSTNUM - CONSTRAINT INTEGRITY TABLE NUMBER OF RELEVANT ENTRIES
      CURORDNL - CURRENT (BASIC OR EXTENDED AREA) WORK BLOCK ORDINAL
      CURTYPE  - CURRENT DB ELEMENT TYPE (1=BASIC AREA, 5=EXTEND AREA)
      EXTNADDR - EXTENSION MEMORY BLOCK ADDRESS OF WD AFTER HEADER WD 
      MASSZARE - MASTER DIRECTORY AREA DIRECTORY SIZE (- CONTROL WORD)
      MCLENARE - MAPPING CAPSULE TABLE LENGTH OF AREA CAPSULE ENTRIES 
      MCNUMARE - MAPPING CAPSULE TABLE NUMBER OF AREA CAPSULE ENTRIES 
      SBCURRAD - SUBSCHEMA CURRENT MAIN ENTRY (AREA HEADER) ADDRESS 
      SBFIRCAP - SUBSCHEMA FIRST MAPPING CAPSULE WORD ADDRESS 
      SBFWADDR - SUBSCHEMA FIRST WORD ADDRESS IN THE SUBSCHEMA FILE 
      SBMAXENT - SUBSCHEMA MAXIMUM SUBENTRY LENGTH IN WORDS 
      SBNEXTAD - SUBSCHEMA NEXT MAIN ENTRY (AREA HEADER) ADDRESS
      SCHEADDR - SCHEMA MEMORY BLOCK ADDRESS OF WORD AFTER HEADER WORD
      SCMAXENT - SCHEMA MAXIMUM SUBENTRY LENGTH IN WORDS
      SCMAXEXT - SCHEMA MAX REC LEN IN CHARS OF RECS IN EXTENDED AREAS
      SCNUMARE - SCHEMA TOTAL NUMBER OF AREA ENTRIES
      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
      ALSO THE SUBSCHEMA, SCHEMA AND MASTER DIRECTORY SHOULD BE VALID.
      THE CONSTRAINT AREA LIST, CONSTRAINT INTEGRITY TABLE, AND 
      EXTENSION MEMORY BLOCKS SHOULD ALL CONTAIN VALID INFORMATION. 
  
  DC  EXIT CONDITIONS 
  
      ON NORMAL DB$CARE RETURN, THE MD FILE WILL CONTAIN A NEW AREA 
      WORK BLOCK AT THE END OF THE PARTIALLY BUILT CST ALREADY THERE. 
      AFTER A BASIC AREA WORK BLOCK IS BUILT (THAT IS, ONE FOR AN 
      EXPLICIT SUBSCHEMA AREA), SBCURRAD WILL CONTAIN THE NEWLY-BUILT 
      AREA"S SUBSCHEMA ADDRESS AND SBNEXTAD WILL CONTAIN THE NEXT 
      SUBSCHEMA (AREA) ENTRY ADDRESS FOR AN EXPLICIT SUBSCHEMA AREA.
      IF AN ERROR IS FOUND DURING DB$CARE 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$CGSC - DB$CGSD ENTRY POINT FOR A SCHEMA DIRECTORY CRM GET
      DB$CLOK - PRIVACY LOCK TABLE BUILDER AND NEW LOCK ENTRY INSERTER
      DB$CNSC - USE AN ENTRY NAME TO GET THAT ENTRY"S SCHEMA HEADER 
      DB$COPT - PROCEDURE OPTION TABLE MANAGER FOR NEW ENTRY INSERTION
      DB$CORD - FUNCTION TO FIND THE ORDINAL OF A DATA BASE PROCEDURE 
      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 
  
      CURIDENT - CURRENT DATA BASE ELEMENT MASTER DIRECTORY IDENTIFIER
      CURNAME  - CURRENT DATA BASE ELEMENT NAME 
      CURSCRAT - CURRENT SCRATCH NAME (USED AS A TEMPORARY AT TIMES)
      LOCKDATA - ARRAY FOR DATA DB$CLOK PUTS IN THE PRIVACY LOCK TABLE
      MCLENARE - MAPPING CAPSULE TABLE LENGTH OF AREA CAPSULE ENTRIES 
      MCNUMARE - MAPPING CAPSULE TABLE NUMBER OF AREA CAPSULE ENTRIES 
      OPTNDATA - ARRAY FOR DATA DB$COPT PUTS IN THE PROC OPTION TABLE 
      SBCURRAD - SUBSCHEMA CURRENT MAIN ENTRY (AREA HEADER) ADDRESS 
      SBGETFWA - SUBSCHEMA FIRST WORD ADDRESS TO BE READ BY A CRM GET 
      SBNEXTAD - SUBSCHEMA NEXT MAIN ENTRY (AREA HEADER) ADDRESS
      SCGETFWA - SCHEMA FIRST WORD ADDRESS TO BE READ BY A CRM GET
      SCMAXEXT - SCHEMA MAX REC LEN IN CHARS OF RECS IN EXTENDED AREAS
      WOCURENT - WORK BLOCK MANAGED MEMORY BLOCK CURRENT WORD LENGTH
      WRKPOARR - ARRAY FOR WORK BLOCK PROC OPTION TABLE POINTER INFO
      IN ADDITION, THE CONTENT OF THE MASTER DIRECTORY FILE WILL BE 
      MODIFIED WHEN THE NEW AREA WORK BLOCK IS WRITTEN TO THE MASTER
      DIRECTORY AT THE END OF THE PARTIALLY BUILT CST ALREADY THERE.
      FURTHERMORE, THE CONTENT OF THE WORK BLOCK MAIN MANAGED MEMORY
      BLOCK WILL CHANGE AS THE AREA WORK BLOCK IS BUILT IN IT IN CORE.
      ALSO, THE CONTENT OF THE CONSTRAINT INTEGRITY TABLE MANAGED 
      MEMORY BLOCK MAY CHANGE AS APPROPRIATE INFORMATION IS INSERTED. 
  
  
  DC  DESCRIPTION 
  
      DB$CARE BUILDS AREA WORK BLOCKS ONE AT A TIME IN MANAGED MEMORY.
      ONE CALL OF DB$CARE FROM DB$CBLD RESULTS IN THE BUILDING OF ONE 
      AREA WORK BLOCK, OF WHICH THERE ARE 2 TYPES: BASIC AND EXTENDED.
      THERE IS ONE AREA WORK BLOCK FOR EACH AREA EXPLICITLY MENTIONED 
      IN THE SUBSCHEMA.  SUCH A WORK BLOCK IS A BASIC AREA WORK BLOCK.
      THERE IS ALSO ONE AREA WORK BLOCK FOR EACH AREA IMPLICITLY
      NEEDED BY CDCS BECAUSE OF INVOLVEMENT OF THE AREA IN A DATA 
      INTEGRITY CONSTRAINT WITH AN AREA EXPLICITLY MENTIONED IN THE 
      SUBSCHEMA.  SUCH A WORK BLOCK IS AN EXTENDED AREA WORK BLOCK. 
      AN AREA SATISFYING THE REQUIREMENTS FOR AN EXTENDED AREA WORK 
      BLOCK MAY BE AN EXPLICIT SUBSCHEMA AREA OR NOT IN THE SUBSCHEMA.
      THOSE AREAS FOR WHICH EXTENDED AREA WORK BLOCKS MUST BE BUILT 
      ARE DETERMINED FROM THE RESULTS OF THE CONSTRAINT PREPROCESSING.
      AFTER EACH AREA WORK BLOCK IS CONSTRUCTED, IT IS WRITTEN TO THE 
      MASTER DIRECTORY FILE FOLLOWING ANY WORK BLOCKS ALREADY WRITTEN.
      IN THE MORE DETAILED DESCRIPTION WHICH FOLLOWS, "B" AND/OR "E"
      APPEARS TO THE LEFT ON EACH LINE.  IF "B" APPEARS, IT MEANS THAT
      PARTICULAR LINE IS APPLICABLE TO BASIC AREA WORK BLOCK BUILDING.
      IF "E" APPEARS, IT MEANS THAT PARTICULAR LINE IS APPLICABLE TO
      EXTENDED AREA WORK BLOCK BUILDING (I.E., FOR AN IMPLICIT AREA). 
  
      BE  IF A BASIC AREA WORK BLOCK, SET BASICBLK TRUE, ELSE FALSE.
      B   CALL DB$CGSB TO GET THE NEXT SUBSCHEMA AREA ENTRY HEADER. 
      B   CALL DB$CNSC TO GET THE RELATED SCHEMA AREA ENTRY HEADER. 
      E   CALL DB$CGSC TO GET THE NEXT SCHEMA AREA ENTRY HEADER.
      BE  FILL IN THE AREA WORK BLOCK USING BASIC/EXTEND INFO IN CORE.
      B   FILL IN THE AREA WORK BLOCK USING BASIC-ONLY INFO IN CORE.
      E   FILL IN THE AREA WORK BLOCK USING EXTEND-ONLY INFO IN CORE. 
      B   IF THERE IS SCHEMA DBP OPTION INFO PROCESS IT USING DB$COPT.
      B   IF THERE IS SUBSCHEMA LOCK INFO, PROCESS IT USING DB$CLOK.
      B   IF THERE IS ONLY SCHEMA LOCK INFO, PROCESS IT USING DB$CLOK.
      BE  PROCESS SCHEMA DATA CONTROL FOR SPECIAL DBPS AND KEY TABLE. 
      E   PROCESS SCHEMA DATA CONTROL FOR MAXIMUM RECORD LENGTH INFO. 
      B   PROCESS SUBSCHEMA DATA CONTROL FOR REC CODE TABLE IF NEEDED.
      B   PROCESS CONSTRAINT INTEGRITY TABLE FOR THE DEPENDENCY TABLE.
      E   PROCESS CONSTRAINT INTEGRITY TABLE FOR INFO TO BE INSERTED. 
      BE  FILL IN THE AREA WORK BLOCK LENGTH IN WORDS. ABORT ON ERROR.
      BE  CALL DB$CPUT TO PUT IN MD. CALL DB$UAWS TO ADJUST WRK SPACE.
      BE  RESET SOME ITEMS IN COMMON WHICH RELATE TO CURRENT ACTIVITY.
      BE  RETURN FROM DB$CARE WITH NEW AREA WORK BLOCK NOW IN THE MD. 
 #
        CONTROL EJECT;
  
        BEGIN                # DB$CARE #
  
# 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$CGSC;   # DB$CGSD ENTRY POINT FOR SCHEMA CRM GET#
        XREF PROC DB$CLOK;   # PRIVACY LOCK TABLE NEW ENTRY BUILDER # 
        XREF PROC DB$CNSC;   # USE AN ENTRY NAME TO GET SCHEMA HEADER#
        XREF PROC DB$COPT;   # PROC OPTION TABLE NEW ENTRY MANAGER #
        XREF FUNC DB$CORD U; # FIND ORDINAL OF A DATA BASE PROCEDURE #
        XREF PROC DB$CPUT;   # PUT CORE WORDS IN THE MASTER DIRECTORY#
        XREF PROC DB$UAWS;   # ADJUST MANAGED MEMORY BLOCK WORK SPACE#
  
# UNLISTED DCLS: UTCDF UTCIT UTMPT UTCAR UTCCS CUGBA CSTAR CSTOP CSTLK #
  
        CONTROL NOLIST;      # COMDECKS INDICATED ABOVE NOT LISTED #
*CALL UTCARDCLS 
*CALL UTCCSDCLS 
*CALL CSTARDCLS 
*CALL CSTOPDCLS 
*CALL CSTLKDCLS 
        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 THE SUBSCHEMA AREA HEADER ENTRY #
  
          ARRAY SBHEADER[0:0] P(DFSBHEAD);       # SUBSCHEMA HEADER # 
  
          BEGIN              # SBHEADER ARRAY # 
  
*CALL SBAHDDCLS 
  
          END                # SBHEADER ARRAY # 
  
# THE FOLLOWING FIXED ARRAY IS FOR THE SCHEMA AREA HEADER ENTRY # 
  
          ARRAY SCHEADER[0:0] P(DFSCHEAD);       # SCHEMA HEADER #
  
          BEGIN              # SCHEADER ARRAY # 
  
*CALL SCAHDDCLS 
  
          END                # SCHEADER ARRAY # 
  
          END                # DB$CCAH COMMON BLOCK # 
        CONTROL EJECT;
  
# THE FOLLOWING ITEMS ARE LOCAL TO DB$CARE #
  
        ITEM BASICBLK B;     # TRUE=BASIC AREA WORK BLOCK TO BE BUILT # 
                             # FALSE=EXTENDED AREA WORK BLOCK TO BE BLT#
        ITEM CODTBADD U;     # CST REC CODE TABLE CORE ADDRESS OFFSET#
        ITEM CODTBDIF I;     # SUBSCHEMA - CST CODE TABLE HEADER SIZE#
        ITEM CODTBLEN U;     # SUBSCHEMA REC CODE TABLE WORD LENGTH # 
        ITEM CONTBLEN U;     # CONSTRAINT TABLE LENGTH PER CONSTRAINT # 
        ITEM DEPCOUNT U;     # CONSTRAINT DEPENDENCY TABLE COUNTER #
        ITEM INDEX I;        # A GENERAL INDEX AND INDUCTION VARIABLE#
        ITEM LITERLEN U;     # REC CODE TABLE LITERAL PART WRD LENGTH#
        ITEM NAMELENW U;     # AREA NAME LENGTH IN WORDS #
        ITEM SCVAR1   I;     # GENERAL SCRATCH VARIABLE # 
        ITEM SCVAR2   I;     # GENERAL SCRATCH VARIABLE # 
  
# FOLLOWING LOCAL BASED ARRAY FOR SUBSCHEMA AREA PRIVACY LOCK OPTIONS#
  
        BASED ARRAY SBARPRIV;          # SUBSCHEMA AREA PRIVACY LOCK #
  
          BEGIN              # SBARPRIV BASED ARRAY # 
  
*CALL SBAPRDCLS 
  
          END                # SBARPRIV BASED ARRAY # 
        CONTROL EJECT;
  
# FOLLOWING LOCAL BASED ARRAY FOR SUBSCHEMA DATA CONTROL HEADER ENTRY#
  
        BASED ARRAY SBDCHEAD;          # SUBSCHEMA DATA CONTROL HEAD #
  
          BEGIN              # SBDCHEAD BASED ARRAY # 
  
*CALL SBDCHDDCL 
  
          END                # SBDCHEAD BASED ARRAY # 
        CONTROL EJECT;
  
# FOLLOWING LOCAL BASED ARRAY FOR SUBSCHEMA DATA CONTROL RECORD CODE #
  
        BASED ARRAY SBDCRCDE;          # SUBSCHEMA DATA CONT REC CODE#
  
          BEGIN              # SBDCRCDE BASED ARRAY # 
  
*CALL SBDCRCDCL 
  
          END                # SBDCRCDE BASED ARRAY # 
        CONTROL EJECT;
  
# FOLLOWING LOCAL BASED ARRAY FOR SCHEMA AREA CALL PROC OPTION ENTRY #
  
        BASED ARRAY SCARCALL;          # SCHEMA AREA CALL PROC OPTION#
  
          BEGIN              # SCARCALL BASED ARRAY # 
  
*CALL SCACLDCLS 
  
          END                # SCARCALL BASED ARRAY # 
  
# FOLLOWING LOCAL BASED ARRAY FOR SCHEMA AREA PRIVACY LOCK OPTIONS #
  
        BASED ARRAY SCARPRIV;          # SCHEMA AREA PRIVACY LOCK # 
  
          BEGIN                        # SCARPRIV BASED ARRAY # 
  
*CALL SCAPRDCLS 
  
          END                          # SCARPRIV BASED ARRAY # 
  
# FOLLOWING LOCAL BASED ARRAY FOR SCHEMA DATA CONTROL HEADER ENTRY #
  
        BASED ARRAY SCDCHEAD;          # SCHEMA DATA CONTROL HEADER # 
  
          BEGIN              # SCDCHEAD BASED ARRAY # 
  
*CALL SCDCHDDCL 
  
          END                # SCDCHEAD BASED ARRAY # 
  
# FOLLOWING LOCAL BASED ARRAY FOR SCHEMA DATA CONTROL                  #
# COMPRESSION/DECOMPRESSION DBP TABLE.                                 #
  
        BASED ARRAY SCDCCOMP; 
  
          BEGIN 
  
*CALL SCDCCDDCL 
  
          END 
  
# FOLLOWING LOCAL BASED ARRAY FOR SCHEMA AREA FIT # 
  
        BASED ARRAY SCDCFIT;           # SCHEMA DATA CONTROL FIT #
*CALL FITDCLS 
# FOLLOWING BASED ARRAY FOR SCHEMA DATA CONTROL KEY ENTRY # 
  
        BASED ARRAY SCDCKEY;           # SCHEMA DATA CONTROL KEY #
          BEGIN              # SCDCKEY BASED ARRAY #
  
*CALL SCDCKYDCL 
  
          END                # SCDCKEY BASED ARRAY #
  
# FOLLOWING LOCAL BASED ARRAY FOR THE MASTER DIRECTORY AREA DIRECTORY#
  
        BASED ARRAY MDADIREC;          # MASTER DIRECT AREA DIRECTORY#
  
          BEGIN              # MDADIREC BASED ARRAY # 
  
*CALL MDARDDCLS 
  
          END                # MDADIREC BASED ARRAY # 
        CONTROL EJECT;
  
# DETERMINE TYPE OF WORK BLOCK TO BE BUILT - BASIC OR EXTENDED(EXT) # 
  
        IF CURTYPE EQ 1 
          THEN BASICBLK = TRUE;        # BASIC WORK BLOCK TO BE BUILT # 
        ELSE BASICBLK = FALSE;         # EXT WORK BLOCK TO BE BUILT # 
  
# IF A BASIC WORK BLOCK IS TO BE BUILT,GET SUBSCHEMA AREA HEADER AND   #
# THE RELATED SCHEMA AREA HEADER.                                      #
# IF AN EXTENDED AREA WORK BLOCK IS TO BE BUILT,GET SCHEMA AREA HEADER.#
# ABORT ON ERROR.                                                      #
  
      IF BASICBLK 
      THEN
        BEGIN                # BASIC AREA WORK BLOCK TO BE BUILT #
        IF SBCURRAD EQ SBNEXTAD        # CURRENT AND NEXT ADDRESSES # 
          THEN XCALL DB$CERR("7701CARE",SBCURRAD);         # ABORT #
        XCALL DB$CGSB(LOC(SBHEADER),DFSBHEAD,SBNEXTAD);    # GET HEAD#
        SBCURRAD = SBNEXTAD;           # SUBSCHEMA CURRENT ADDRESS #
        SBNEXTAD = SBFWADDR + SBARNEXT[0];       # SUBSCHEMA NEXT ADD#
        NAMELENW = SBARLENGWRDS[0];     # SAVE AREA NAME LENGTH(WORDS) #
        IF SBARTYPE[0] NQ 1  # CHECK IF TYPE OF ENTRY IS NOT 1 (AREA)#
          THEN XCALL DB$CERR("7702CARE",SBARTYPE[0]);      # ABORT #
        XCALL DB$CGSB(SUBSADDR,DFNAMEWD,SBCURRAD + SBARNAMEPTR[0]); 
        P<GETENTRY> = SUBSADDR;        # POINT TO SUBSCHEMA AREA NAME#
        CURSCRAT = GETWDTHR[0];        # AVOID A SYMPL COMPILER ERROR#
        CURNAME = DB$CFIL(CURSCRAT,SBARLENGCHAR[0]," ");   # " "-FILL#
        IF SBARALIASPTR[0] GR 0        # CHECK IF THERE IS AREA ALIAS#
        THEN               # GET THE SCHEMA AREA HEADER USING ALIAS#
          BEGIN 
          XCALL          # GET AREA ALIAS NAME (= NAME IN SCHEMA)#
            DB$CGSB(SUBSADDR,DFNAMEWD,SBCURRAD + SBARALIASPTR[0]);
          XCALL DB$CNSC(3,SBARALIASLW[0]);             # GET HEAD#
          END 
        ELSE XCALL DB$CNSC(3,SBARLENGWRDS[0]);           # GET HEAD#
        IF SCAREADATATY[0] NQ 0        # CHECK IF ENTRY TYPE NOT AREA#
          THEN XCALL DB$CERR("7703CARE",SCAREADATATY[0]);  # ABORT #
        XCALL DB$CGSC(SCHEADDR,DFNAMEWD,SCCURRAD + SCARNAMEPTR[0]); 
        P<GETENTRY> = SCHEADDR;        # POINT TO SCHEMA AREA NAME #
        CURSCRAT = GETWDTHR[0];        # AVOID A SYMPL COMPILER ERROR#
        CURSCRAT = DB$CFIL(CURSCRAT,SCHAREANAMEC[0]," ");  # " "-FILL#
        END 
      ELSE                   # EXTENDED AREA WORK BLOCK TO BE BUILT # 
        BEGIN                # GET SCHEMA AREA HEADER # 
        P<AREALIST> = CALADDR + (CURORDNL - 1); # POINT TO CURRENT EXT #
                                                # AREA INFO IN CORE    #
        XCALL DB$CGSC(LOC(SCHEADER),DFSCHEAD,ALSCWA[0]); # GET AREA HDR#
        IF SCAREADATATY[0] NQ 0    # CHECK IF TYPE OF ENTRY IS NOT AREA#
          THEN XCALL DB$CERR("7703CARE",SCAREADATATY[0]);  # ABORT #
        XCALL DB$CGSC(SCHEADDR,DFNAMEWD,ALSCWA[0] + SCARNAMEPTR[0]);
        P<GETENTRY> = SCHEADDR;    # POINT TO SCHEMA AREA NAME #
        NAMELENW = SCHAREANAMEL[0]; # SAVE AREA NAME LENGTH(WORDS) #
        CURSCRAT = GETWDTHR[0];    # AVOID A SYMPL COMPILER ERROR # 
        CURSCRAT = DB$CFIL(CURSCRAT,SCHAREANAMEC[0]," ");  # " "-FILL # 
        CURNAME = CURSCRAT;          # SAVE CURRENT AREA NAME # 
        END 
  
# SEARCH THRU MASTER DIRECTORY AREA DIRECTORY FOR CURRENT AREA INFO # 
  
      P<MDADIREC> = EXTNADDR;      # POINT TO THE EXTENSION BLOCK # 
      INDEX = 1;             # EXPLICITLY SET FOR BETTER LOOP CONTROL # 
      LOOP WHILE INDEX LQ SCNUMARE AND CURSCRAT NQ MDADARNM[0] DO 
        BEGIN 
        P<MDADIREC> = LOC(MDADIREC) + DFMDADEN;    # NEXT AREA #
        INDEX = INDEX + 1;         # SET FOR BETTER LOOP CONTROL #
        END 
      IF INDEX GR SCNUMARE         # IF CURRENT AREA INFO NOT FOUND # 
        THEN XCALL DB$CERR("7704CARE",DFNAMECH);   # ABORT #
      CURIDENT = MDADIDNT[0];      # CURRENT MD AREA IDENTIFIER  #
  
# FILL IN BASIC/EXTENDED AREA WORK BLOCK FIELDS. ABORT ON ERROR. #
  
      WOCURENT = DFAREWRK + NAMELENW;     # WORK BLOCK LENGTH # 
      XCALL DB$UAWS(LOC(WORPOINT),WOCURENT);   # ADJUST WORK SPACE #
      P<CSAREBLK> = WORKADDR;      # POINT TO WORK BLOCK IN CORE #
      CSAIMPLC[0] = FALSE;         # INITIALIZE CONSTRAINT IMPLICIT FLG#
      CSAIDENT[0] = MDADIDNT[0];   # MASTER DIRECTORY AREA IDENT. # 
      CSANAMLW[0] = NAMELENW;   # AREA NAME LENGTH(WORDS) # 
      C<0,NAMELENW * DFCHARWD>CSANAME[0] = CURNAME;  # AREA NAME# 
      IF CSANAMLW[0] NQ NAMELENW   # IF LENGTH TRUNCATION # 
        THEN XCALL DB$CERR("7705CARE",NAMELENW);    # ABORT # 
  
# FILL IN BASIC AREA WORK BLOCK FIELDS. ABORT ON ERROR #
  
      IF BASICBLK 
      THEN                   # BASIC WORK BLOCK TO BE BUILT # 
        BEGIN 
        CSALOCK[0] = LNO 0;  # LOCK DEFAULT INITIALIZED TO ALL 1 BITS # 
        IF SBARKEYCAPA[0] GR 0     # CHECK KEY CAPSULE POINTER #
        THEN                 # PROCESS SUBSCHEMA CAPSULE INFORMATION #
          BEGIN 
          CSAKCAPL[0] = SBARKEYCAPL[0];  # CAPSULE LENGTH IN WORDS #
          CSAKCAPP[0] = 1 + SBARKEYCAPA[0] - SBFIRCAP; # CAP. POINTER # 
          MCLENARE = MCLENARE + SBARKEYCAPL[0];        # LENGTH # 
          MCNUMARE = MCNUMARE + 1;               # AREA CAPSULE COUNT # 
          IF CSAKCAPL[0] NQ SBARKEYCAPL[0]
            THEN XCALL DB$CERR("7706CARE",SBARKEYCAPL[0]);   # ABORT #
          IF CSAKCAPP[0] NQ 1 + SBARKEYCAPA[0] - SBFIRCAP 
            THEN XCALL DB$CERR("7707CARE",SBARKEYCAPA[0]);   # ABORT #
          END 
  
        IF SCHARCALLPTR[0] GR 0        # SCHEMA CALL DBP LIST POINTER#
        THEN               # PROCESS SCHEMA DB PROC OPTION INFO # 
          BEGIN 
          XCALL          # GET SCHEMA CALL DB PROC OPTION LIST #
            DB$CGSC(SCHEADDR,SCMAXENT,SCCURRAD + SCHARCALLPTR[0]);
          WRKPOWRD[0] = 0;         # WORK BLOCK PROC OPTION POINT#
          P<CSOPTTBL> = LOC(OPTNDATA);       # PROC OPTION ARRAY #
          INDEX = 0;     # IN THE NEXT LOOP, INDEX IS AN OFFSET # 
          LOOP WHILE INDEX GQ 0 DO           # LOOP IS A FOR DEF #
            BEGIN 
            P<CSAREBLK> = WORKADDR;        #POINT TO WORK BLOCK#
            P<SCARCALL> = SCHEADDR + INDEX;          # SCHEMA # 
            CSAPOACL[0] = CSAPOACL[0] OR   # AFTER CLOSE FLAG # 
                          (SCARCALLAFT[0] AND SCARCALLCLS[0]);
            CSAPOBCL[0] = CSAPOBCL[0] OR   # BEFORE CLOSE FLAG #
                          (SCARCALLBEF[0] AND SCARCALLCLS[0]);
            CSAPOECL[0] = CSAPOECL[0] OR   # ERROR CLOSE FLAG # 
                          (SCARCALLERR[0] AND SCARCALLCLS[0]);
            CSAPOAER[0] = CSAPOAER[0] OR   # AFTER EXCLUS RETRI#
                          (SCARCALLAFT[0] AND SCARCALLREXC[0]); 
            CSAPOBER[0] = CSAPOBER[0] OR   # BEFORE EXCLU RETRI#
                          (SCARCALLBEF[0] AND SCARCALLREXC[0]); 
            CSAPOEER[0] = CSAPOEER[0] OR   # ERROR EXCLUS RETRI#
                          (SCARCALLERR[0] AND SCARCALLREXC[0]); 
            CSAPOAEU[0] = CSAPOAEU[0] OR   # AFTER EXCLUS UPDAT#
                          (SCARCALLAFT[0] AND SCARCALLUEXC[0]); 
            CSAPOBEU[0] = CSAPOBEU[0] OR   # BEFORE EXCLU UPDAT#
                          (SCARCALLBEF[0] AND SCARCALLUEXC[0]); 
            CSAPOEEU[0] = CSAPOEEU[0] OR   # ERROR EXCLUS UPDAT#
                          (SCARCALLERR[0] AND SCARCALLUEXC[0]); 
            CSAPOAPR[0] = CSAPOAPR[0] OR   # AFTER PROTEC RETRI#
                          (SCARCALLAFT[0] AND SCARCALLRPRT[0]); 
            CSAPOBPR[0] = CSAPOBPR[0] OR   # BEFORE PROTE RETRI#
                          (SCARCALLBEF[0] AND SCARCALLRPRT[0]); 
            CSAPOEPR[0] = CSAPOEPR[0] OR   # ERROR PROTEC RETRI#
                          (SCARCALLERR[0] AND SCARCALLRPRT[0]); 
            CSAPOAPU[0] = CSAPOAPU[0] OR   # AFTER PROTEC UPDAT#
                          (SCARCALLAFT[0] AND SCARCALLUPRT[0]); 
            CSAPOBPU[0] = CSAPOBPU[0] OR   # BEFORE PROTE UPDAT#
                          (SCARCALLBEF[0] AND SCARCALLUPRT[0]); 
            CSAPOEPU[0] = CSAPOEPU[0] OR   # ERROR PROTEC UPDAT#
                          (SCARCALLERR[0] AND SCARCALLUPRT[0]); 
            CSAPOANR[0] = CSAPOANR[0] OR   # AFTER NONEXC RETRI#
                          (SCARCALLAFT[0] AND SCARCALLRNEX[0]); 
            CSAPOBNR[0] = CSAPOBNR[0] OR   # BEFORE NONEX RETRI#
                          (SCARCALLBEF[0] AND SCARCALLRNEX[0]); 
            CSAPOENR[0] = CSAPOENR[0] OR   # ERROR NONEXC RETRI#
                          (SCARCALLERR[0] AND SCARCALLRNEX[0]); 
            CSAPOANU[0] = CSAPOANU[0] OR   # AFTER NONEXC UPDAT#
                          (SCARCALLAFT[0] AND SCARCALLUNEX[0]); 
            CSAPOBNU[0] = CSAPOBNU[0] OR   # BEFORE NONEX UPDAT#
                          (SCARCALLBEF[0] AND SCARCALLUNEX[0]); 
            CSAPOENU[0] = CSAPOENU[0] OR   # ERROR NONEXC UPDAT#
                          (SCARCALLERR[0] AND SCARCALLUNEX[0]); 
            CSOWORD[0] = 0;      # PROC OPTION TABLE ENTRY WORD#
            CSORPORD[0] = DB$CORD(SCAREAONNAME[0],DFSCFLAG);
            CSORARAF[0] = SCARCALLAFT[0];  # AFTER FLAG # 
            CSORARBE[0] = SCARCALLBEF[0];  # BEFORE FLAG #
            CSORAROE[0] = SCARCALLERR[0];  # ON ERROR FLAG #
            CSORARCL[0] = SCARCALLCLS[0];  # CLOSE FLAG # 
            CSORARER[0] = SCARCALLREXC[0]; # EXCLUSIVE RETRIEVL#
            CSORAREU[0] = SCARCALLUEXC[0]; # EXCLUSIVE UPDATE # 
            CSORARPR[0] = SCARCALLRPRT[0]; # PROTECTED RETRIEVL#
            CSORARPU[0] = SCARCALLUPRT[0]; # PROTECTED UPDATE # 
            CSORARNR[0] = SCARCALLRNEX[0]; # NONEXCLUS RETRIEVL#
            CSORARNU[0] = SCARCALLUNEX[0]; # NONEXCLUS UPDATE # 
            IF SCAREANEXTON[0]             # IF ANOTHER ENTRY # 
              THEN INDEX = INDEX + 1;      # NEXT ENTRY OFFSET #
            ELSE INDEX = -1;             # TERMINATE DBP LOOP#
            XCALL DB$COPT;       # PROC OPTION TABLE MANAGER #
            END 
          P<CSAREBLK> = WORKADDR;  # POINT TO WORK BLOCK IN CORE #
          CSAPOPNT[0] = WRKPOPNT[0];         # PROC OPTION POINTR#
          END 
  
        IF SBARPRIVPTR[0] GR 0         # CHECK SUBSCHEMA LOCK POINTER#
        THEN               # PROCESS SUBSCHEMA PRIVACY LOCK INFO #
          BEGIN 
          SBGETFWA = SBCURRAD + SBARPRIVPTR[0];        # LOCK FWA#
          P<CSLOKTBL> = LOC(LOCKDATA);       # PRIVACY LOCK ARRAY#
          LOOP WHILE SBGETFWA GR 0 DO        # DB$CLOK RESETS FWA#
            BEGIN 
            XCALL DB$CGSB(SUBSADDR,SBMAXENT,SBGETFWA);
            P<SBARPRIV> = SUBSADDR;        # POINT TO SUBSCHEMA#
            CSLKWORD[0] = 0;     # PRIVACY LOCK TABLE WORD #
            CSLKAROP[0] = LNO 0; # LOCK DEFAULT IS ALL ONE BITS#
            CSLKARER[0] = NOT SBARPRIVREXC[0];       # EXCL RET#
            CSLKAREU[0] = NOT SBARPRIVUEXC[0];       # EXCL UPD#
            CSLKARPR[0] = NOT SBARPRIVRPRT[0];       # PROT RET#
            CSLKARPU[0] = NOT SBARPRIVUPRT[0];       # PROT UPD#
            CSLKARNR[0] = NOT SBARPRIVRNEX[0];       # NOEX RET#
            CSLKARNU[0] = NOT SBARPRIVUNEX[0];       # NOEX UPD#
            CSLKTYPE[0] = CURTYPE;         # AREA ELEMENT TYPE #
            CSLKGORD[0] = CURORDNL;        # ORDINAL OF AREA #
            P<CSAREBLK> = WORKADDR;        #POINT TO WORK BLOCK#
            CSALOCK[0] = CSALOCK[0] LAN CSLKAROP[0]; #LOGIC AND#
            XCALL DB$CLOK(DFSBFLAG);       # SUBSCHEMA LOCK # 
            END 
          END 
  
        IF SBARPRIVPTR[0] EQ 0 AND SCAREAPRVPTR[0] GR 0    # ONLY SCH#
        THEN               # PROCESS SCHEMA PRIVACY LOCK INFORMATN.#
          BEGIN 
          SCGETFWA = SCCURRAD + SCAREAPRVPTR[0];       # LOCK FWA#
          P<CSLOKTBL> = LOC(LOCKDATA);       # PRIVACY LOCK ARRAY#
          LOOP WHILE SCGETFWA GR 0 DO        # DB$CLOK RESETS FWA#
            BEGIN 
            XCALL DB$CGSC(SCHEADDR,SCMAXENT,SCGETFWA);
            P<SCARPRIV> = SCHEADDR;        # POINT TO SCHEMA #
            CSLKWORD[0] = 0;     # PRIVACY LOCK TABLE WORD #
            CSLKAROP[0] = LNO 0; # LOCK DEFAULT IS ALL ONE BITS#
            CSLKARER[0] = NOT SCARPRIVREXC[0];       # EXCL RET#
            CSLKAREU[0] = NOT SCARPRIVUEXC[0];       # EXCL UPD#
            CSLKARPR[0] = NOT SCARPRIVRPRT[0];       # PROT RET#
            CSLKARPU[0] = NOT SCARPRIVUPRT[0];       # PROT UPD#
            CSLKARNR[0] = NOT SCARPRIVRNEX[0];       # NOEX RET#
            CSLKARNU[0] = NOT SCARPRIVUNEX[0];       # NOEX UPD#
            CSLKTYPE[0] = CURTYPE;         # AREA ELEMENT TYPE #
            CSLKGORD[0] = CURORDNL;        # ORDINAL OF AREA #
            P<CSAREBLK> = WORKADDR;        #POINT TO WORK BLOCK#
            CSALOCK[0] = CSALOCK[0] LAN CSLKAROP[0]; #LOGIC AND#
            XCALL DB$CLOK(DFSCFLAG);       # SCHEMA LOCK ENTRY #
            END 
          END 
        END 
      CONTROL EJECT;
  
# PROCESS SCHEMA DATA CONTROL, BUILDING THE AREA KEY TABLE FOR BOTH    #
# BASIC AND EXTENDED WORK BLOCKS.                                      #
  
      XCALL DB$CGSC(SCHEADDR,SCMAXENT,SCAREADCNTLA[0]);  # GET DC # 
      P<CSAREBLK> = WORKADDR;        # POINT TO WORK BLOCK IN CORE #
      P<SCDCHEAD> = SCHEADDR;        # POINT TO SCHEMA MEMORY BLOCK#
      SCVAR1 = SCDCALTRKYPT[0];      # SAVE KEY ENTRY POINTER # 
      SCVAR2 = SCDCFITPTR[0];        # SAVE FIT POINTER # 
      CSACOLAT[0] = SCDCSEQOPT[0];   # COLLATING SEQUENCE OPTIONS # 
      IF SCDCSDAPRCN[0] NQ 0       # CHECK IF DA DBP NAME SPECIFIED # 
        THEN CSAHSORD[0] = DB$CORD(SCDCSDAPRCN[0],DFSCFLAG);
      CSASYSTM[0] = SCDCCDSYSFLG[0]; # STORE SYSTEM C/D FLAG #
      IF SCDCCDTBLPTR[0] NQ 0      # CHECK FOR COMP/DECOMP DBPS # 
      THEN                         # PROCESS COMP/DECOMP DBPS # 
        BEGIN 
        SCGETFWA = SCAREADCNTLA[0] + SCDCCDTBLPTR[0]; # FWA OF TABLE #
        XCALL DB$CGSC(SCHEADDR,SCDCCDTBLENG[0],SCGETFWA); # GET C/D TBL#
        P<CSAREBLK> = WORKADDR;        # POINT TO AREA WORK BLOCK # 
        INDEX = 0;                     # INITIALIZE FOR LOOP CONTROL #
        LOOP WHILE INDEX LS SCDCCDTBLENG[0] DO  # LOOP THRU C/D TABLE, #
          BEGIN              # STORING DBP ORDINALS IN AREA WORK BLOCK #
          P<SCDCCOMP> = SCHEADDR + INDEX;    # POINT TO COMP-DECOMP TBL#
          IF SCDCCDCMPFLG[0]       # CHECK FOR COMPRESSION FLAG # 
            THEN CSACMORD[0] = DB$CORD(SCDCCDDBPNME[0],DFSCFLAG); 
          IF SCDCCDDCMPFG[0]       # CHECK FOR DECOMPRESSION FLAG # 
            THEN CSADEORD[0] = DB$CORD(SCDCCDDBPNME[0],DFSCFLAG); 
          INDEX = INDEX + 1;
          END 
        END 
      IF NOT BASICBLK     # CHECK FOR AN EXTENDED AREA #
      THEN
        BEGIN             # PROCESS MAX RECORD SIZE, USING FIT #
        SCGETFWA = SCAREADCNTLA[0] + SCVAR2;  # FWA OF FIT #
        XCALL DB$CGSC(SCHEADDR,SCMAXENT,SCGETFWA);  # GET FIT # 
        P<SCDCFIT> = SCHEADDR;    # POINT TO FIT #
        IF FITMRL[0] GR SCMAXEXT  # CHECK IF CUR MRL EXCEEDES PREV MAX #
          THEN SCMAXEXT = FITMRL[0];  # SAVE CURRENT MRL AS MAXIMUM # 
        END 
  
      IF SCVAR1 GR 0       # CHECK KEY ENTRY POINTER #
      THEN                 # PROCESS SCHEMA DATA CONTROL KEY ENTRY #
        BEGIN 
        SCGETFWA = SCAREADCNTLA[0] + SCVAR1;   # FWA OF KEY ENTRIES # 
        XCALL DB$CGSC(SCHEADDR,SCMAXENT,SCGETFWA);   # GET KEY #
        P<SCDCKEY> = SCHEADDR + 1;         # SCHEMA BLOCK + ONE#
        IF SCDCKEYNITM[0] GR 0 OR SCDCKEYIMBED[0]    #ALT/IMBED#
        THEN         # AREA KEY TABLE IS NEEDED, SO BUILD IT #
          BEGIN 
          P<CSAREBLK> = WORKADDR;      #POINT TO WORK BLOCK#
          CSAKEYPT[0] = WOCURENT;      # KEY TABLE POINTER #
          IF CSAKEYPT[0] NQ WOCURENT   # CHECK TRUNCATION # 
            THEN XCALL DB$CERR("7708CARE",WOCURENT); #ABORT#
          INDEX = -1;        # KEY COUNT EXCLUDES PRIMARY # 
          LOOP WHILE SCGETFWA GR 0 DO  # LOOP IS A FOR DEF #
            BEGIN 
            INDEX = INDEX + 1;       #ALTERNATE KEY COUNT#
            XCALL DB$UAWS(LOC(WORPOINT),DFAREKEY);
            P<CSAKEYTB> = WORKADDR + WOCURENT; #KEY TABLE#
            WOCURENT = WOCURENT + DFAREKEY;    # LENGTH # 
            P<SCDCKEY> = SCHEADDR;             # SCHEMA # 
            CSAKRGSZ[0] = SCDCKEYGRPSZ[0];     #GROUP SIZ#
            CSAKOCUR[0] = SCDCKEYMAXOC[0];     #MAX OCCUR#
            CSAKTYPE[0] = SCDCKEYTYPE[0];      # KEY TYPE#
            P<SCDCKEY> = SCHEADDR + 1;         #NEXT WORD#
            CSAKPRIM[0] = SCDCKEYPRI[0];       # PRIMARY #
            CSAKCONC[0] = SCDCKEYCONCT[0];     # CONCATEN#
            CSAKIMBD[0] = SCDCKEYIMBED[0];     # IMBEDDED#
            CSAKBWP[0] = SCDCKEYBWP[0];        # WORD POS#
            CSAKBCP[0] = SCDCKEYBCP[0];        # CHAR POS#
            CSAKLENC[0] = SCDCKEYSIZ[0];       # KEY SIZE#
            IF SCDCKEYDUPS [0] AND (NOT SCDCKEYNOT [0]) 
            THEN                      # DUPLICATES ARE ALLOWED      # 
              BEGIN 
              IF SCDCKEYFIRST[0]           # IF FIRST#
                THEN CSAKDUPL[0] = O"06";  #DUPS FIFO#
              ELSE CSAKDUPL[0] = O"11";  #INDEX SEQ#
              END 
            ELSE                      # DUPLICATES ARE NOT ALLOWED  # 
              CSAKDUPL[0] = O"25";
            IF SCDCKEYNITM[0] GR 0   # CHECK NEXT OFFSET #
            THEN         # THERE IS ANOTHER KEY ENTRY # 
              BEGIN 
              CSAKNEXT[0] = TRUE;          #NEXT FLAG#
              SCGETFWA = SCGETFWA + SCDCKEYNITM[0]; 
              XCALL    # GET NEXT SCHEMA KEY ENTRY #
                DB$CGSC(SCHEADDR,SCMAXENT,SCGETFWA);
              END 
            ELSE         # THERE IS NO OTHER KEY ENTRY #
              BEGIN 
              CSAKNEXT[0] = FALSE;         #NEXT FLAG#
              SCGETFWA = 0;      # TO TERMINATE LOOP #
              END 
            END 
          P<CSAREBLK> = WORKADDR;      #POINT TO WORK BLOCK#
          CSAALTNO[0] = INDEX;         #ALTERNATE KEY COUNT#
          END 
        END 
  
# PROCESS SUBSCHEMA DATA CONTROL, BUILDING THE RECORD CODE TABLE ONLY  #
# FOR A BASIC AREA WORK BLOCK, IF NEEDED.                              #
  
      IF BASICBLK 
      THEN                   # BASIC WORK BLOCK BEING BUILT # 
        BEGIN 
        SBGETFWA = SBFWADDR + SBARDCONTRLA[0];   # DATA CONTROL ADDR.#
        XCALL DB$CGSB(SUBSADDR,SBMAXENT,SBGETFWA);         # GET DC # 
        P<CSAREBLK> = WORKADDR;        # POINT TO WORK BLOCK IN CORE #
        P<SBDCHEAD> = SUBSADDR;        # POINT TO THE SUBSCHEMA BLOCK#
        CSAONERC[0] = SBDCRECCDFLG[0]; # T = 1 REC, NO REC CODE TABLE#
        CODTBLEN = SBDCRECCDLEN[0];    # SAVE REC CODE ENTRY LENGTH # 
        XCALL DB$CGSB(SUBSADDR,CODTBLEN,SBGETFWA + SBDCRECCDPTR[0]);
        P<CSAREBLK> = WORKADDR;        # POINT TO WORK BLOCK IN CORE #
        IF CSAONERC[0]       # IF ONLY ONE REC AND NO REC CODE TABLE #
        THEN               # RECORD CODE TABLE NEED NOT BE BUILT #
          BEGIN 
          P<SBDCRCDE> = SUBSADDR + 1;        # POINT TO SUBSCHEMA#
          CSARCORD[0] = SBDCRCDERECO[0];     # RECORD ORDINAL # 
          END 
        ELSE               # RECORD CODE TABLE MUST BE BUILT #
          BEGIN 
          CSACODPT[0] = WOCURENT;            # REC CODE TABLE PNT#
          IF CSACODPT[0] NQ WOCURENT         # CHECK TRUNCATION # 
            THEN XCALL DB$CERR("7709CARE",WOCURENT);   # ABORT #
          P<SBDCRCDE> = SUBSADDR;  # POINT TO THE SUBSCHEMA BLOCK#
          IF SBDCRCDETYP[0]        # CHECK IF PROC REC CODE TABLE#
            THEN INDEX = 1;        # PROC REC CODE HEADER 1 WORD #
          ELSE INDEX = 2;        # ITEM REC CODE HEADER 2 WORDS#
          CODTBDIF = INDEX - 1;    # SUBSCHEMA - CST HEADER SIZE #
          XCALL DB$UAWS(LOC(WORPOINT),CODTBLEN - CODTBDIF); 
          P<CSACODTB> = WORKADDR + WOCURENT; # POINT TO CORE TABL#
          P<SBDCRCDE> = SUBSADDR;            # POINT TO SUBSCHEMA#
          CSACTYPE[0] = SBDCRCDETYP[0];      # F=DATA NAME, T=DBP#
          CODTBADD = WORKADDR + WOCURENT - CODTBDIF;   # CODE TAB#
          WOCURENT = WOCURENT + CODTBLEN - CODTBDIF;   #BLOCK LEN#
          IF SBDCRCDETYP[0]        # CHECK IF PROC REC CODE TABLE#
          THEN         # PROCESS DATA BASE PROC REC CODE TABLE #
            BEGIN 
            CSACPORD[0] = DB$CORD(SBDCRCDEPROC[0],DFSBFLAG);
            LOOP WHILE INDEX GR 0 AND INDEX LS CODTBLEN DO
              BEGIN 
              P<CSACODTB> = CODTBADD + INDEX;    #CST TABLE#
              P<SBDCRCDE> = SUBSADDR + INDEX;    #SUBSCHEMA#
              CSACRORD[0] = SBDCRCDERECO[0];     #REC ORDNL#
              CSACINTG[0] = SBDCRCDEINTV[0];     # INTEGER #
              CSACNEXT[0] = SBDCRCDENEXT[0];     #NEXT FLAG#
              IF SBDCRCDENEXT[0]       # IF ANOTHER ENTRY # 
                THEN INDEX = INDEX + 1;          # DO NEXT #
              ELSE         # NO OTHER ENTRIES SO END LOOP#
                IF 1 + INDEX EQ CODTBLEN       #ALL ENTRY#
                  THEN INDEX = 0;              # GOOD END#
                ELSE INDEX = CODTBLEN;       #ERROR END#
              END 
            END 
          ELSE         # PROCESS ITEM RECORD CODE TABLE # 
            BEGIN 
            CSACBWP[0] = SBDCRCCDEBWP[0];          # BEGIN WD#
            CSACBCP[0] = SBDCRCCDEBCP[0];          # BEGIN CH#
            CSACLENC[0] = SBDCRCCDESIZ[0];         # LEN CHAR#
            CSACCLAS[0] = SBDCRCDECLAS[0];         # CLASS #
            LITERLEN = 0;      # LITERAL PART LENGTH IN WORDS#
            LOOP WHILE INDEX GR 0 AND INDEX LS CODTBLEN DO
              BEGIN 
              P<CSACODTB> = CODTBADD + INDEX;    #CST TABLE#
              P<SBDCRCDE> = SUBSADDR + INDEX;    #SUBSCHEMA#
              CSACLITL[0] = SBDCRCDELITL[0];     #LITER LEN#
              CSACLITP[0] = SBDCRCDELITP[0] - CODTBDIF; 
              CSACRORD[0] = SBDCRCDERECO[0];     #REC ORDNL#
              CSACNEXT[0] = SBDCRCDENEXT[0];     #NEXT FLAG#
              LITERLEN = LITERLEN + (SBDCRCDELITL[0]
                           + (DFCHARWD - 1)) / DFCHARWD;
              IF SBDCRCDENEXT[0]       # IF ANOTHER ENTRY # 
                THEN INDEX = INDEX + 1;          # DO NEXT #
              ELSE         # NO OTHER ENTRIES SO END LOOP#
                IF 1 + INDEX + LITERLEN EQ CODTBLEN 
                THEN     # RECORD CODE TABLE LENGTH OK #
                  BEGIN 
                  IF CSACLITP[0] # CHECK IF TRUNCATED#
                    NQ SBDCRCDELITP[0] - CODTBDIF 
                      THEN       # SUBSCHEMA ABORT #
                        XCALL DB$CERR("7710CARE", 
                          SBDCRCDELITP[0] - CODTBDIF);
                  P<GETENTRY> = SUBSADDR + INDEX; 
                  P<PUTENTRY> = CODTBADD + INDEX; 
                  FOR INDEX = 1 THRU LITERLEN DO
                    PUTUNSIG[INDEX] = GETUNSIG[INDEX];
                  INDEX = 0;     # NORMAL END OF LOOP#
                  END 
                ELSE INDEX = CODTBLEN;       #ERROR END#
              END 
            END 
          IF INDEX NQ 0 
            THEN XCALL DB$CERR("7711CARE",CODTBLEN);
          END 
        END 
  
# USING THE NEW CONSTRAINT INTEGRITY TABLE(CIT) AND THE CONSTRAINT AREA#
# LIST, BUILD THE CONSTRAINT DEPENDENCY TABLE IF NEEDED. THIS IS BUILT #
# FOR BASIC AREA WORK BLOCKS ONLY.                                     #
  
      IF BASICBLK AND CONSTNUM GR 0   # CHECK IF BASIC WORK BLOCK AND  #
      THEN                            # CONSTRAINTS PRESENT.           #
        BEGIN                         # BUILD CONSTRAINT DEPEND. TABLE #
        P<CSAREBLK> = WORKADDR;       # POINT TO AREA WRK BLOCK IN CORE#
        P<AREALIST> = CALADDR + (CURORDNL - 1); # POINT TO CURRENT     #
                                                # AREA INFO IN AREALIST#
        CSAMEMBR[0] = ALMEMFLG[0];    # CONSTRAINT MEMBER FLAG #
        CSAOWNER[0] = ALOWNFLG[0];    # CONSTRAINT OWNER FLAG # 
        INDEX = ALFIRCON[0];       # INITIALIZE TO FIRST ENTRY IN CIT # 
        IF NOT ALMEMFLG[0] AND NOT ALOWNFLG[0]
          THEN INDEX = -1;         # CUR AREA HAS NO CONSTR,SET STATUS #
        ELSE
          BEGIN                      # CUR AREA HAS CONSTRAINTS # 
          CSADEPPT[0] = WOCURENT;    # STORE CONSTR DEP TABLE POINTER # 
          IF CSADEPPT[0] NQ WOCURENT    # CHECK TRUNCATION #
            THEN XCALL DB$CERR("7713CARE",WOCURENT);    # ABORT # 
          END 
        DEPCOUNT = 0;              # INITIALIZE DEPENDENCY COUNTER #
        LOOP WHILE INDEX GQ 0 DO            # LOOP THRU NEW CIT # 
          BEGIN              # USE NEW CIT TO BUILD CON DEP TABLE # 
          P<SCCSLIST> = CITADDR + INDEX;      # CIT ENTRY FOR CURR AREA#
          IF SCCSSUBTYP[0] EQ DFCONTRA     # CHECK IF INTRA-REC CONSTR.#
            THEN CONTBLEN = DFAREDEP * 2;  # CONSTR DEP TABLE LENGTH #
          ELSE CONTBLEN = DFAREDEP;        # INTER-REC CON DEP TBL LENG#
          XCALL DB$UAWS(LOC(WORPOINT),CONTBLEN); # ADJUST WK BLOCK LENG#
          P<CSADEPTB> = WORKADDR + WOCURENT; # POINT TO CON DEP TABLE  #
          WOCURENT = WOCURENT + CONTBLEN;  # AREA WORK BLOCK LENGTH # 
          P<SCCSLIST> = CITADDR + INDEX;  # CIT ENTRY FOR CURRENT AREA #
          IF CURORDNL EQ SCCSBAORD[DFNCITMEM] 
          THEN                     # CURRENT AREA IS A MEMBER(CHILD) IN#
            BEGIN                  # PRESENT CIT.                      #
            CSADTYPE[0] = SCCSSUBTYP[0];  # STORE CONSTRAINT SUB-TYPE # 
            CSADMEMB[0] = TRUE;           # SET MEMBER FLAG # 
            CSADCORD[0] = SCCSNCITORD[DFNCITORD];# NCIT ENTRY ORDINAL  #
            CSADBKEY[0] = SCCSKEYORD[DFNCITMEM]; # STORE BASIC KEY ORD.#
            CSADAORD[0] = SCCSEXORD[DFNCITOWN];  # STORE EXT AREA ORD. #
            CSADEKEY[0] = SCCSKEYORD[DFNCITOWN]; # STORE EXT KEY ORD. # 
            INDEX = SCCSBANXT[DFNCITMEMNXT];       # NEXT CIT ENTRY # 
            SCCSARID[DFNCITMEM] = CURIDENT; # STORE MD AREA ID IN CIT # 
            DEPCOUNT = DEPCOUNT + 1;        # UPDATE DEPENDENCY COUNTER#
            END 
          IF CURORDNL EQ SCCSBAORD[DFNCITOWN] 
          THEN                     # CURRENT AREA IS AN OWNER(PARENT)  #
            BEGIN                  # IN PRESENT CIT.                   #
            IF SCCSSUBTYP[0] EQ DFCONTRA   # CHECK IF INTRA-REC CONSTR.#
              THEN P<CSADEPTB> = LOC(CSADEPTB) + DFAREDEP;
            CSADTYPE[0] = SCCSSUBTYP[0];   # STORE CONSTRAINT SUB-TYPE #
            CSADOWNR[0] = TRUE;            # SET OWNER FLAG # 
            CSADCORD[0] = SCCSNCITORD[DFNCITORD];# NCIT ENTRY ORDINAL  #
            CSADBKEY[0] = SCCSKEYORD[DFNCITOWN]; # STORE BASIC KEY ORD #
            CSADAORD[0] = SCCSEXORD[DFNCITMEM];  # STORE EXT AREA ORD. #
            CSADEKEY[0] = SCCSKEYORD[DFNCITMEM]; # STORE EXT KEY ORD. # 
            INDEX = SCCSBANXT[DFNCITOWNNXT];       # NEXT CIT ENTRY # 
            SCCSARID[DFNCITOWN] = CURIDENT;  # STORE MD AREA ID IN CIT #
            DEPCOUNT = DEPCOUNT + 1;       # UPDATE DEPENDENCY COUNTER #
            END 
          END 
          P<CSAREBLK> = WORKADDR;      # POINT TO AREA WK BLOCK IN CORE#
          CSADEPNO[0] = DEPCOUNT;      # STORE NUMBER OF DEP ENTRIES #
        END 
  
# PROCESS CONSTRAINT INTEGRITY TABLE FOR INSERTION OF MD AREA IDENT    #
# IN EXTENDED AREA WORK BLOCKS.                                        #
  
      IF NOT BASICBLK              # CHECK FOR EXTENDED WORK BLOCK #
      THEN
        BEGIN 
        P<CSAREBLK> = WORKADDR;   # POINT TO AREA WORK BLOCK IN CORE #
        P<AREALIST> = CALADDR + (CURORDNL - 1);  # POINT TO CURRENT    #
                                                 # AREA INFO IN AREALST#
        CSAIMPLC[0] = TRUE;        # SET CONSTRAINT IMPLICIT FLAG # 
        CSAMEMBR[0] = ALMEMFLG[0]; # SET CONSTRAINT MEMBER FLAG # 
        CSAOWNER[0] = ALOWNFLG[0]; # SET CONSTRAINT OWNER FLAG #
        INDEX = ALFIRCON[0];       # OFFSET TO FIRST ENTRY IN CIT # 
        LOOP WHILE INDEX GQ 0 DO           # LOOP THRU NEW CIT #
          BEGIN                    # INSERT MD AREA IDENTIFIERS # 
          P<SCCSLIST> = CITADDR + INDEX; # POINT TO CIT ENTRY # 
          IF CURORDNL EQ SCCSEXORD[DFNCITMEM] 
          THEN                     # CHECK MEM AREA INFO IN CIT # 
            BEGIN                  # CURRENT AREA ORD MATCHES EXT ORD # 
            SCCSARID[DFNCITMEM] = CURIDENT;  # STORE MD AREA ID # 
            INDEX = SCCSEXNXT[DFNCITMEMNXT]; # NEXT CIT ENTRY # 
            END 
          IF CURORDNL EQ SCCSEXORD[DFNCITOWN] 
          THEN                     # CHECK OWN AREA INFO IN CIT # 
            BEGIN                  # CURRENT AREA ORD MATCHES EXT ORD # 
            SCCSARID[DFNCITOWN] = CURIDENT;  # STORE MD AREA ID # 
            INDEX = SCCSEXNXT[DFNCITOWNNXT]; # NEXT CIT ENTRY # 
            END 
          END 
        END 
  
# FILL IN THE AREA WORK BLOCK LENGTH IN WORDS.  ABORT ON ERROR.#
  
      P<CSAREBLK> = WORKADDR;        # POINT TO WORK BLOCK IN CORE #
      CSALENTH[0] = WOCURENT;        # LENGTH OF AREA WORK BLOCK #
      IF CSALENTH[0] NQ WOCURENT     # CHECK IF LENGTH IS TRUNCATED#
        THEN XCALL DB$CERR("7712CARE",WOCURENT);         # ABORT #
  
# 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 SOME ITEMS IN COMMON WHICH RELATE TO THE CURRENT ACTIVITY # 
  
      CURIDENT = 0;        # CURRENT MASTER DIRECTORY IDENTIFIER #
      CURNAME = " ";       # CURRENT DATA BASE ELEMENT NAME - NONE #
      CURSCRAT = " ";      # CURRENT SCRATCH USE NAME # 
  
# RETURN FROM DB$CARE WITH THE NEW AREA WORK BLOCK NOW IN THE MD FILE#
  
      RETURN;              # NEW AREA WORK BLOCK NOW IN THE MD FILE#
  
      END                  # DB$CARE #
  
      TERM
