*DECK DB$CEND 
USETEXT UTMPTTX 
USETEXT UTCITTX 
USETEXT UTCDFTX 
      PROC DB$CEND; 
 #
  *   DB$CEND - END CST BUILD BY WRITING PARTS   PAGE  1
  *   STEVEN P. LEVIN                            DATE  08/29/75 
  
  DC  PURPOSE 
  
      END CST BUILDING BY CHECKING LENGTHS OF CST PARTS, FORMING THE
      CST FIXED PART, AND WRITING IT, THE PROC OPTION AND PRIVACY LOCK
      TABLES, CST CHECKSUM, AND THE MAPPING CAPSULE TABLE TO THE MD.
  
  DC  ENTRY CONDITIONS
  
      THE FOLLOWING ITEMS IN COMMON SHOULD HAVE BEEN GIVEN VALUES:  
      CHECKSUM - EXCLUSIVE-OR CHECKSUM OF WORDS OF THE NEW CST
      CONNBEXA - CONSTRAINT-INVOLVED NUMBER OF EXTENDED AREA ENTRIES
      CONSTNUM - CONSTRAINT INTEGRITY TABLE NUMBER OF RELEVANT ENTRIES
      LENILOCK - RSB (A CDCS TERM) ITEM PRIVACY LOCK TABLE WORD LENGTH
      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
      LENTHCST - WORD LENGTH OF THE CST (SO FAR) IN MASTER DIRECTORY
      LENTOCON - WORD LENGTH TO THE FIRST CONSTRAINT WORK BLOCK 
      LENTOOPT - WORD LENGTH TO THE PROCEDURE OPTION TABLE
      LENTOREC - WORD LENGTH TO THE FIRST RECORD WORK BLOCK 
      LENTOREL - WORD LENGTH TO THE FIRST RELATION WORK BLOCK 
      MCLENARE - MAPPING CAPSULE TABLE LENGTH OF AREA CAPSULE ENTRIES 
      MCLENREC - MAPPING CAPSULE TABLE LENGTH OF REC CAPSULE ENTRIES
      MCNUMARE - MAPPING CAPSULE TABLE NUMBER OF AREA CAPSULE ENTRIES 
      MCNUMREC - MAPPING CAPSULE TABLE NUMBER OF REC CAPSULE ENTRIES
      NAMESCHE - BLANK-FILLED SCHEMA NAME 
      NAMESUBS - BLANK-FILLED SUBSCHEMA NAME
      PLCURENT - PRIVACY LOCK TABLE CURRENT LENGTH IN WORDS 
      PLOKADDR - PRIVACY LOCK BLOCK ADDRESS OF WORD AFTER HEADER WORD 
      PLOPOINT - PRIVACY LOCK TABLE BLOCK MANAGED MEMORY POINTER WORD 
      POCURENT - PROCEDURE OPTION TABLE CURRENT LENGTH IN WORDS 
      POPPOINT - PROC OPTION TABLE BLOCK MANAGED MEMORY POINTER WORD
      POPTADDR - PROC OPTION BLOCK ADDRESS OF WORD AFTER HEADER WORD
      SBCHKSUM - SUBSCHEMA DIRECTORY CHECKSUM DERIVED BY DDL ALGORITHM
      SBDATASV - SUBSCHEMA DATA NAME SAVE BUFFER LENGTH IN WORDS
      SBFIRCAP - SUBSCHEMA FIRST MAPPING CAPSULE WORD ADDRESS 
      SBFWADDR - SUBSCHEMA FIRST WORD ADDRESS IN THE SUBSCHEMA FILE 
      SBJULIAN - SUBSCHEMA JULIAN DATE OF CREATION (FORMAT IS YYDDD)
      SBMAXCAP - SUBSCHEMA MAXIMUM MAPPING CAPSULE LENGTH IN WORDS
      SBMAXENT - SUBSCHEMA MAXIMUM SUBENTRY LENGTH IN WORDS 
      SBMAXREC - SUBSCHEMA MAXIMUM RECORD LENGTH IN CHARACTERS
      SBNUMARE - SUBSCHEMA TOTAL NUMBER OF AREA ENTRIES SPECIFIED 
      SBNUMREC - SUBSCHEMA TOTAL NUMBER OF RECORD ENTRIES SPECIFIED 
      SBNUMREL - SUBSCHEMA TOTAL NUMBER OF RELATION ENTRIES SPECIFIED 
      SBTIME   - SUBSCHEMA TIME OF CREATION (FORMAT IS HH.MM DISPLAY) 
      SCHPOINT - SCHEMA BLOCK MANAGED MEMORY POINTER WORD 
      SCIDENT  - MASTER DIRECTORY UTILITY SCHEMA IDENTIFIER 
      SCMAXENT - SCHEMA MAXIMUM SUBENTRY LENGTH IN WORDS
      SCMAXEXT - SCHEMA MAX REC LEN IN CHARS OF RECS IN EXTENDED AREAS
      SCMAXREC - SCHEMA MAX REC LENGTH IN CHARS OF RECS IN SUBSCHEMA
      SUBPOINT - SUBSCHEMA BLOCK MANAGED MEMORY POINTER WORD
      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, A DUMMY CST FIXED PART SHOULD BE IN THE MASTER DIRECTORY
      BEFORE THE WORK BLOCKS.  (THE REAL CST FIXED PART WILL REPLACE
      IT.)  THE PROCEDURE OPTION TABLE BLOCK SHOULD CONTAIN A COMPLETE
      TABLE.  THE PRIVACY LOCK TABLE BLOCK SHOULD CONTAIN A COMPLETE
      TABLE.  THE SUBSCHEMA SHOULD HAVE VALID MAP CAPSULE INFORMATION.
  
  DC  EXIT CONDITIONS 
  
      UPON NORMAL RETURN FROM DB$CEND, IT WILL HAVE BEEN VERIFIED THAT
      THE LENGTHS OF PARTS OF THE CST ARE WITHIN THE ALLOWABLE LIMITS.
      AN ENTIRE USABLE CST WILL HAVE BEEN PUT IN THE MASTER DIRECTORY.
      THIS NEW CONDENSED SCHEMA/SUBSCHEMA TABLE (CST) WILL BE LOCATED 
      AT THE WORD ADDRESS MASWACST IN THE MASTER DIRECTORY FILE.
      IF AN ERROR IS FOUND DURING DB$CEND 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$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 
  
      LENTHCST - WORD LENGTH OF THE CST (SO FAR) IN MASTER DIRECTORY
      LENTOCAP - WORD LENGTH TO THE MAPPING CAPSULE TABLE 
      MCLENTOT - MAPPING CAPSULE TABLE LENGTH OF TOTAL CAPSULE ENTRIES
      SBGETFWA - SUBSCHEMA FIRST WORD ADDRESS TO BE READ BY A CRM GET 
      STATMAST - MASTER DIRECTORY FILE STATUS (2 IF OK, THROUGH USING)
      IN ADDITION, THE WORK BLOCK MAIN MANAGED MEMORY BLOCK IS CHANGED
      AS THE CST FIXED PART IS BUILT, THE SUBSCHEMA BLOCK IS CHANGED
      AS CAPSULES ARE READ, AND SOME MEMORY BLOCK SIZES ARE DECREASED.
      THE MASTER DIRECTORY FILE IS CHANGED AS PARTS OF THE CST OTHER
      THAN THE WORK BLOCKS ALREADY THERE ARE WRITTEN TO THE MD FILE.
  
  DC  DESCRIPTION 
  
      CHECK IF PARTS OF THE CST EXCEED ALLOWABLE MAXIMA. IF SO, ABORT.
      FILL IN CST AND RSB RECORD BLOCK POINTERS.  ABORT ON TRUNCATION.
      FILL IN CST AND RSB RELATION BLCK POINTERS. ABORT ON TRUNCATION.
      FILL IN CST AND RSB CONSTRAINT POINTERS.  ABORT ON TRUNCATION.
      FILL IN PROC OPTION/PRIVACY LOCK POINTERS.  ABORT ON TRUNCATION.
      FILL IN THE RSB ITEM PRIVACY LOCK POINTER.  ABORT ON TRUNCATION.
      FILL IN RSB RELATION CONNECTED POINTERS.  ABORT ON TRUNCATION.
      FILL IN THE RSB LENGTH IN WORDS IN THE CST. ABORT ON TRUNCATION.
      FILL IN SUBSCHEMA TIME AND DATE OF CREATION AND CHECKSUM FIELDS.
      FILL IN SCHEMA ID, VERSION, AND COUNTS.  ABORT ON TRUNCATION. 
      FILL IN THE RECORD MAXIMUM LENGTH FIELDS.  ABORT ON TRUNCATION. 
      FILL IN MAPPING CAPSULE CONNECTED FIELDS.  ABORT ON TRUNCATION. 
      FILL IN THE SCHEMA AND SUBSCHEMA NAME FIELDS IN THE FIXED PART. 
      CALL DB$CPUT TO PUT THE CST FIXED PART IN THE MASTER DIRECTORY. 
      IF PROC OPTION TABLE IS NON-EMPTY, WRITE IT TO MASTER DIRECTORY.
      IF PRIVACY LOCK TABLE IS NON-EMPTY WRITE IT TO MASTER DIRECTORY.
      CALL DB$CPUT TO WRITE THE CST CHECKSUM (TO NOW) TO THE MD FILE. 
      IF THERE ARE CAPSULES, FORM A MAPPING CAPSULE TABLE IN THE MD.
      SET THE MASTER DIRECTORY STATUS, STATMAST, TO 2 (MD OK, DONE).
      RETURN WITH ALL PARTS OF THE NEW CST NOW WRITTEN TO THE MD FILE.
 #
        CONTROL EJECT;
  
        BEGIN                # DB$CEND #
  
# THE FOLLOWING ARE EXTERNALLY REFERENCED PROCEDURES #
  
        XREF PROC DB$CERR;   # ERROR HANDLER FOR FATAL ERRORS # 
        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 CSTFX CSTCP #
*CALL CSTFXDCLS 
*CALL CSTCPDCLS 
        CONTROL LIST;        # RESUME THE LISTING OF THE SOURCE CODE #
  
# THE FOLLOWING ITEMS ARE LOCAL TO DB$CEND #
  
        ITEM INDEX I;        # A GENERAL INDEX AND INDUCTION VARIABLE#
        ITEM POINTER U;      # POINTER DISPLACEMENTS INTO THE RSB # 
        ITEM TEMPUNS U;      # A TEMPORARY UNSIGNED INTEGER VARIABLE #
        CONTROL EJECT;
  
# CHECK IF PARTS OF THE CST EXCEED ALLOWABLE MAXIMUMS.  IF SO, ABORT.#
  
        LENTOCAP = LENTHCST + POCURENT + PLCURENT + 1;     #1=CHECKSM#
        IF LENTOCAP GR DFCSTMAX        # CST MAX EXCLUDING CAPSULES # 
          THEN XCALL DB$CERR("7601CEND",LENTOCAP - DFCSTMAX);  #ABORT#
        MCLENTOT = MCLENARE + MCLENREC;          # CAPSULE LEN TOTAL #
        IF MCLENTOT GR DFCAPMAX        # MAPPING CAPSULE MAXIMUM SIZE#
          THEN XCALL DB$CERR("7602CEND",MCLENTOT - DFCAPMAX);  #ABORT#
  
# FILL IN CST AND RSB RECORD BLOCK POINTERS.  ABORT ON TRUNCATION. #
  
        XCALL DB$UAWS(LOC(WORPOINT),DFCSTFIX);   # ADJUST WORK SPACE #
        P<CSFIXED> = WORKADDR;                   # POINT TO WORK BLCK#
        POINTER = DFRSBFIX + (SBNUMARE + CONNBEXA) * DFARECON;
        IF SBNUMREC GR 0     # CHECK IF THERE ARE ANY RECORD BLOCKS # 
          THEN               # RECORD BLOCK POINTERS WILL BE NON-ZERO#
            BEGIN 
              CSFRECPT[0] = LENTOREC;            # REC WORK BLOCK PNT#
              CSFRRECP[0] = POINTER;             # RSB REC CONTROL PT#
              IF CSFRECPT[0] NQ LENTOREC         # CHECK IF TRUNCATED#
                THEN XCALL DB$CERR("7603CEND",LENTOREC);   # ABORT #
              IF CSFRRECP[0] NQ POINTER          # CHECK IF TRUNCATED#
                THEN XCALL DB$CERR("7604CEND",POINTER);    # ABORT #
              POINTER = POINTER + SBNUMREC * DFRECCON;     # FOR RSB #
            END 
  
# FILL IN CST AND RSB RELATION BLOCK POINTERS.  ABORT ON TRUNCATION. #
  
        IF SBNUMREL GR 0     # CHECK IF THERE ARE ANY RELATION BLOCKS#
          THEN               # RELATION BLOCK POINTERS WILL BE NON-0 #
            BEGIN 
              CSFRELPT[0] = LENTOREL;            # REL WORK BLOCK PNT#
              CSFRRELP[0] = POINTER;             # RSB REL CONTROL PT#
              IF CSFRELPT[0] NQ LENTOREL         # CHECK IF TRUNCATED#
                THEN XCALL DB$CERR("7605CEND",LENTOREL);   # ABORT #
              IF CSFRRELP[0] NQ POINTER          # CHECK IF TRUNCATED#
                THEN XCALL DB$CERR("7606CEND",POINTER);    # ABORT #
              POINTER = POINTER + SBNUMREL * DFRELCON;     # FOR RSB #
            END 
  
# FILL IN CST AND RSB CONSTRAINT BLOCK POINTERS. ABORT ON TRUNCATION.#
  
        IF CONSTNUM GR 0     # IF THERE ARE CONSTRAINTS                #
          THEN               # CONSTRAINT BLOCK POINTERS WILL BE NON-0 #
            BEGIN 
            CSFCONPT[0] = LENTOCON;    # CONSTRAINT WORK BLOCK POINTER #
            CSFRCONP[0] = POINTER;     # RSB CONSTRAINT CONTROL POINTER#
            IF CSFCONPT[0] NQ LENTOCON    # IF TRUNCATED               #
              THEN                        # ABORT                      #
                XCALL DB$CERR("7624CEND",LENTOCON); 
            IF CSFRCONP[0] NQ POINTER     # IF TRUNCATED               #
              THEN                        # ABORT                      #
                XCALL DB$CERR("7625CEND",POINTER);
            POINTER = POINTER + CONSTNUM * DFCONCON;
            END 
  
# FILL IN PROC OPTION AND PRIVACY LOCK POINTERS. ABORT ON TRUNCATION.#
  
        IF POCURENT GR 0     # CHECK IF PROC OPTION TABLE NON-EMPTY # 
          THEN               # PROC OPTION POINTER WILL BE NON-ZERO # 
            BEGIN 
              CSFOPTPT[0] = LENTOOPT;            # PROC OPTN TABLE PT#
              IF CSFOPTPT[0] NQ LENTOOPT         # CHECK IF TRUNCATED#
                THEN XCALL DB$CERR("7607CEND",LENTOOPT);   # ABORT #
            END 
        IF PLCURENT GR 0     # CHECK IF PRIVACY LOCK TABLE NON-ENPTY #
          THEN               # PRIVACY LOCK POINTER WILL BE NON-ZERO #
            BEGIN 
              CSFLOKPT[0] = LENTOOPT + POCURENT;           # LOCK PNT#
              IF CSFLOKPT[0] NQ LENTOOPT + POCURENT        # TRUNCATE#
                THEN XCALL DB$CERR("7608CEND",LENTOOPT + POCURENT); 
            END 
  
# FILL IN THE RSB ITEM PRIVACY LOCK POINTER.  ABORT ON TRUNCATION. #
  
        IF LENILOCK GR 0     # IF AN RSB ITEM LOCK TABLE WILL EXIST # 
          THEN               # RSB ITEM LOCK POINTER WILL BE NON-ZERO#
            BEGIN 
              CSFRLOKP[0] = POINTER;             # RSB ITEM LOCK PNTR#
              IF CSFRLOKP[0] NQ POINTER          # CHECK IF TRUNCATED#
                THEN XCALL DB$CERR("7609CEND",POINTER);    # ABORT #
              POINTER = POINTER + LENILOCK;      # UPDATE RSB POINTER#
            END 
  
# FILL IN THE RSB RELATION CONNECTED POINTERS.  ABORT ON TRUNCATION. #
  
        IF LENSERCH GR 0     # IF RSB SEARCH/QUALIFY TABLE WILL EXIST#
          THEN               # RSB SEARCH/QUALIFY TABLE POINTER NON-0#
            BEGIN 
              CSFRSERP[0] = POINTER;             # RSB SEARCH/QUAL PT#
              IF CSFRSERP[0] NQ POINTER          # CHECK IF TRUNCATED#
                THEN XCALL DB$CERR("7610CEND",POINTER);    # ABORT #
              POINTER = POINTER + LENSERCH;      # UPDATE RSB POINTER#
            END 
        IF SBDATASV GR 0     # IF RSB DATA NAME SAVE BUFFR WILL EXIST#
          THEN               # RSB DATA NAME SAVE BUFFR POINTER NON-0#
            BEGIN 
              CSFRDATP[0] = POINTER;             # RSB DN SAVE BUF PT#
              IF CSFRDATP[0] NQ POINTER          # CHECK IF TRUNCATED#
                THEN XCALL DB$CERR("7611CEND",POINTER);    # ABORT #
              POINTER = POINTER + SBDATASV;      # UPDATE RSB POINTER#
            END 
        IF LENJOINB GR 0     # IF AN RSB JOIN BUFFER WILL EXIST # 
          THEN               # RSB JOIN BUFFER POINTER WILL BE NON-0 #
            BEGIN 
              CSFRJONP[0] = POINTER;             # RSB JOIN BUFFER PT#
              IF CSFRJONP[0] NQ POINTER          # CHECK IF TRUNCATED#
                THEN XCALL DB$CERR("7612CEND",POINTER);    # ABORT #
              POINTER = POINTER + LENJOINB;      # UPDATE RSB POINTER#
            END 
        IF LENSTACK GR 0     # IF RSB QUALIFY STACK BUFFER WILL EXIST#
          THEN               # RSB QUALIFY STACK BUFFER POINTER NON-0#
            BEGIN 
              CSFRSTAP[0] = POINTER;             # RSB QUAL STACK PNT#
              IF CSFRSTAP[0] NQ POINTER          # CHECK IF TRUNCATED#
                THEN XCALL DB$CERR("7613CEND",POINTER);    # ABORT #
              POINTER = POINTER + (LENSTACK + 8) / 3;      # FOR RSB #
            END 
  
# FILL IN THE RSB LENGTH IN WORDS IN THE CST.  ABORT ON TRUNCATION. # 
  
        CSFRSBLN[0] = POINTER;         # WORD LENGTH OF RELATED RSB"S#
        IF CSFRSBLN[0] NQ POINTER      # IF RSB LENGTH IS TRUNCATED # 
          THEN XCALL DB$CERR("7614CEND",POINTER);          # ABORT #
  
# FILL IN THE SUBSCHEMA TIME AND DATE OF CREATION AND CHECKSUM FIELDS#
  
        CSFSBTIM[0] = SBTIME;          # SUBSCHEMA TIME OF CREATION # 
        CSFSBJUL[0] = SBJULIAN;        # SUBSCHEMA CREATE JULIAN DATE#
        CSFSBCHK[0] = SBCHKSUM;        # SUBSCHEMA DIRECTORY CHECKSUM#
  
# FILL IN SCHEMA ID, VERSION, AND COUNTS.  ABORT ON FIELD TRUNCATION.#
  
        CSFSCIDN[0] = SCIDENT;         # MASTER DIRECT SCHEMA IDENTIF#
        CSFVERSN[0] = DFCSTVER;        # VERSION NUMBER OF THIS CST # 
        CSFARENO[0] = SBNUMARE + CONNBEXA;       # NUMBER OF AREAS #
        CSFEXTNO[0] = CONNBEXA;        # CST NUMBER OF EXTENDED AREAS#
        CSFRECNO[0] = SBNUMREC;        # CST/SUBSCHEMA NUMBER OF RECS#
        CSFRELNO[0] = SBNUMREL;        # CST/SUBSCHEMA NUMBER OF RELS#
        CSFCONNO[0] = CONSTNUM;        # CST NUMBER OF CONSTRAINTS #
        IF CSFARENO[0] NQ SBNUMARE + CONNBEXA    # IF AREAS TRUNCATED#
          THEN XCALL DB$CERR("7615CEND",SBNUMARE + CONNBEXA); # ABORT#
        IF CSFEXTNO[0] NQ CONNBEXA     # IF EXTENDED AREAS TRUNCATED #
          THEN XCALL DB$CERR("7626CEND",CONNBEXA);         # ABORT #
        IF CSFRECNO[0] NQ SBNUMREC     # IF NUMBER OF RECS TRUNCATED #
          THEN XCALL DB$CERR("7616CEND",SBNUMREC);         # ABORT #
        IF CSFRELNO[0] NQ SBNUMREL     # IF NUMBER OF RELS TRUNCATED #
          THEN XCALL DB$CERR("7617CEND",SBNUMREL);         # ABORT #
        IF CSFCONNO[0] NQ CONSTNUM     # IF TRUNCATED                  #
          THEN                         # ABORT                         #
            XCALL DB$CERR("7627CEND",CONSTNUM); 
  
# FILL IN THE RECORD MAXIMUM LENGTH FIELDS.  ABORT ON TRUNCATION. # 
  
        CSFSBREC[0] = SBMAXREC;        # SUBSCHEMA REC MAX CHAR SIZE #
        CSFSCREC[0] = SCMAXREC;        # SCHEMA REC MAXIMUM CHAR SIZE#
        CSFEXREC[0] = SCMAXEXT;        # EXTENDED AREA MAX REC LENGTH  #
        IF CSFSBREC[0] NQ SBMAXREC     # IF SUBSCHEMA REC TRUNCATED # 
          THEN XCALL DB$CERR("7618CEND",SBMAXREC);         # ABORT #
        IF CSFSCREC[0] NQ SCMAXREC     # IF SCHEMA REC MAX TRUNCATED #
          THEN XCALL DB$CERR("7619CEND",SCMAXREC);         # ABORT #
        IF CSFEXREC[0] NQ SCMAXEXT      # IF TRUNCATED                 #
          THEN                          # ABORT                        #
            XCALL DB$CERR("7628CEND",SCMAXEXT); 
  
# FILL IN THE MAPPING CAPSULE CONNECTED FIELDS.  ABORT ON TRUNCATION.#
  
        IF MCLENTOT GR 0     # CHECK IF MAP CAPSULE TABLE NON-EMPTY # 
          THEN               # MAPPING CAPSULE FIELDS WILL BE NON-0 # 
            BEGIN 
              CSFCAPPT[0] = LENTOCAP;            # MAP CAPSULE POINTR#
              CSFCAPLN[0] = MCLENTOT;            # CAPSULE LEN TOTAL #
              CSFCAPMX[0] = SBMAXCAP;            # CAPSULE MAX LENGTH#
              CSFCAPNO[0] = MCNUMARE + MCNUMREC; # NUMBER OF CAPSULES#
              IF CSFCAPPT[0] NQ LENTOCAP         # CHECK IF TRUNCATED#
                THEN XCALL DB$CERR("7620CEND",LENTOCAP);   # ABORT #
              IF CSFCAPLN[0] NQ MCLENTOT         # CHECK IF TRUNCATED#
                THEN XCALL DB$CERR("7621CEND",MCLENTOT);   # ABORT #
              IF CSFCAPMX[0] NQ SBMAXCAP         # CHECK IF TRUNCATED#
                THEN XCALL DB$CERR("7622CEND",SBMAXCAP);   # ABORT #
              IF CSFCAPNO[0] NQ MCNUMARE + MCNUMREC        # TRUNCATE#
                THEN XCALL DB$CERR("7623CEND",MCNUMARE + MCNUMREC); 
            END 
  
# FILL IN THE SCHEMA AND SUBSCHEMA NAME FIELDS IN THE CST FIXED PART #
  
        CSFSCNAM[0] = NAMESCHE;        # BLANK-FILLED SCHEMA NAME # 
        CSFSBNAM[0] = NAMESUBS;        # BLANK-FILLED SUBSCHEMA NAME #
  
# CALL DB$CPUT TO WRITE THE CST FIXED PART TO THE MASTER DIRECTORY #
  
        TEMPUNS = LENTHCST;  # SAVE LENGTH OF THE CST (IN MD SO FAR) #
        LENTHCST = 0;        # USED BY DB$CPUT TO TELL WHERE TO WRITE#
        XCALL DB$CPUT(WORKADDR,DFCSTFIX);        # WRITE TO MD FILE # 
        LENTHCST = TEMPUNS;  # RESTORE LENGTH OF CST (WRITTEN SO FAR)#
        XCALL DB$UAWS(LOC(WORPOINT),-DFCSTFIX);  # ADJUST WORK SPACE #
  
# IF PROC OPTION TABLE IS NON-EMPTY, WRITE IT TO THE MASTER DIRECTORY#
  
        IF POCURENT GR 0     # IF PROCEDURE OPTION TABLE IS NON-EMPTY#
          THEN               # WRITE IT TO MD AND DECREASE BLOCK SIZE#
            BEGIN 
              XCALL DB$CPUT(POPTADDR,POCURENT);            # WRITE #
              XCALL DB$UAWS(LOC(POPPOINT),-POCURENT);      # ADJUST # 
            END 
  
# IF PRIVACY LOCK TABLE IS NON-EMPTY WRITE IT TO THE MASTER DIRECTORY#
  
        IF PLCURENT GR 0     # IF THE PRIVACY LOCK TABLE IS NON-EMPTY#
          THEN               # WRITE IT TO MD AND DECREASE BLOCK SIZE#
            BEGIN 
              XCALL DB$CPUT(PLOKADDR,PLCURENT);            # WRITE #
              XCALL DB$UAWS(LOC(PLOPOINT),-PLCURENT);      # ADJUST # 
            END 
  
# CALL DB$CPUT TO WRITE THE CST CHECKSUM (UP TILL NOW) TO THE MD FILE#
  
        TEMPUNS = CHECKSUM;            # CHECKSUM CHANGE BEFORE WRITE#
        XCALL DB$CPUT(LOC(TEMPUNS),1);           # WRITE TO MD FILE # 
  
# IF THERE ARE CAPSULES, FORM A MAPPING CAPSULE TABLE IN THE MD FILE #
  
        IF MCLENTOT GR 0     # CHECK IF MAP CAPSULE TABLE NON-EMPTY # 
          THEN               # FORM MAPPING CAPSULE TABLE IN MD FILE #
            BEGIN 
              IF SBMAXCAP GR SBMAXENT  # IF MAXIMUM CAPSULE IS BIGGER#
                THEN         # SUBSCHEMA BLOCK SIZE MUST BE INCREASED#
                  BEGIN 
                    XCALL DB$UAWS(LOC(SCHPOINT),-SCMAXENT); 
                    XCALL DB$UAWS(LOC(SUBPOINT),SBMAXCAP - SBMAXENT); 
                  END 
              TEMPUNS = 0;             # USE FOR CAPSULE TABLE HEADER#
              P<CSCAPHDR> = LOC(TEMPUNS);        # POINT TO TEMPORARY#
              CSCLENTH[0] = MCLENTOT;            # CAPSULE LEN TOTAL #
              CSCMAXIM[0] = SBMAXCAP;            # CAPSULE MAX LENGTH#
              CSCNUMBR[0] = MCNUMARE + MCNUMREC; # NUMBER OF CAPSULES#
              XCALL DB$CPUT(LOC(TEMPUNS),1);     # WRITE TO MD FILE # 
              SBGETFWA = SBFWADDR + SBFIRCAP;    # FIRST CAPSULE ADDR#
              TEMPUNS = MCLENTOT / SBMAXCAP;     # MAX CAP MULTIPLES #
              FOR INDEX = 1 THRU TEMPUNS DO      # READ AND WRITE # 
                BEGIN 
                  XCALL DB$CGSB(SUBSADDR,SBMAXCAP,SBGETFWA);
                  XCALL DB$CPUT(SUBSADDR,SBMAXCAP);        # WRITE #
                  SBGETFWA = SBGETFWA + SBMAXCAP;          # NEXT ADD#
                END 
              TEMPUNS = MCLENTOT - SBMAXCAP * TEMPUNS;     # REMAIN # 
              IF TEMPUNS GR 0          # IF SOME CAPSULE WORDS REMAIN#
                THEN         # READ AND WRITE REMAINING CAPSULE WORDS#
                  BEGIN 
                    XCALL DB$CGSB(SUBSADDR,TEMPUNS,SBGETFWA); 
                    XCALL DB$CPUT(SUBSADDR,TEMPUNS);       # WRITE #
                  END 
              TEMPUNS = CHECKSUM;      # CHECKSUM CHANGE BEFORE WRITE#
              XCALL DB$CPUT(LOC(TEMPUNS),1);     # WRITE TO MD FILE # 
            END 
  
# SET THE MASTER DIRECTORY STATUS, STATMAST, TO 2 (MD OK, DONE USING)#
  
        STATMAST = 2;        # MASTER DIRECTORY STATUS - DONE USING # 
  
# RETURN WITH ALL PARTS OF THE NEW CST NOW WRITTEN TO THE MD FILE # 
  
        RETURN;              # ALL PARTS OF THE NEW CST NOW WRITTEN # 
  
        END                  # DB$CEND #
  
      TERM
