*DECK DB$MDWD 
USETEXT UTMPTTX 
USETEXT MDBCMTX 
  PROC DB$MDWD; 
    BEGIN 
 #
* *   DB$MDWD - WRITE OUT THE NEW MD FILE        PAGE  1
  *   M. D. SAXE                                 DATE  04/06/76 
  *   J. G. SERPA - MDU 2.3 ENHANCEMENTS         DATE  07/28/80 
  
  DC  PURPOSE 
  
      WRITE ALL THE INFORMATION FOR THE SCHEMA CURRENTLY BEING
      PROCESSED TO THE NEW MD.
  
  DC  ENTRY CONDITIONS
  
      SCFATAL FLAG MUST BE 0
      THE TABLES FOR THE SUBJECT SCHEMA MUST BE VALID AND COMPLETE
      PUTWA CONTAINS THE NEXT AVAILABLE WORD ADDRESS IN THE NEW MASTER
      DIRECTORY FILE. 
  
  DC  EXIT CONDITIONS 
  
      THE MD SCHEMA ENTRY HAS BEEN WRITTEN TO THE NEW MD
  
  DC  CALLING ROUTINES
  
      DB$M20M - CONTROLLING ROUTINE FOR WRITING THE NEW MD
  
  DC  CALLED ROUTINES 
  
 #
      XREF
        BEGIN 
 #                                                                     #
        PROC DB$FTMD;        # FIT FOR THE NEW MD                      #
        PROC DB$FTOD;        # FIT FOR THE OLD MD                      #
        PROC DB$ERMD;        # CRM ERROR EXIT FOR THE NEW MD           #
        PROC DB$EROD;        # CRM ERROR EXIT FOR THE OLD MD           #
        PROC DB$MDWS;        # WRITE CONTROLLED LENGTH TABLES          #
        PROC DB$UALC;        # ALLOCATES CMM BLOCK.                    #
        PROC DB$UAWS;        # INCREASES THE SIZE OF THE CMM BLOCK.    #
        PROC DB$UFRE;        # FREE CMM BLOCKS                         #
        PROC DB$WGET;        # READ FROM THE OLD MD FILE               #
        PROC DB$WPUT;        # WRITE TO THE NEW MD FILE                #
 #                                                                     #
        END 
  
      BASED ARRAY MDSCENTRY [0:0] S(1);  # SCHEMA DIRECTORY TABLE      #
        BEGIN 
*CALL MDSCDDCLS 
        END 
  
      BASED ARRAY ARDIR [0] S;
        BEGIN 
*CALL MDARDDCLS 
        END 
  
      BASED ARRAY ARINFO [0] S; 
        BEGIN 
*CALL MDARIDCLS 
        END 
  
      BASED ARRAY DBPROC [0] S; 
        BEGIN 
*CALL MDDPDDCLS 
        END 
  
      BASED ARRAY CSTSSTBL [0] S; 
        BEGIN 
*CALL MDSBDDCLS 
        END 
  
*CALL MD20CDCLS 
#     LOCAL ITEMS                                                      #
  
      DEF DFMAXBUF #1024#;   # MAXIMUM BUFFER SIZE ALLOWED WHEN # 
                             # TRANSFERRING CST FROM OLD MD TO NEW MD#
      ITEM BUFFSIZE;         # CURRENT WORK BUFFER SIZE IN WORDS #
      ITEM CSTNBR;           # USED IN A FOR LOOP WHEN STEPPING THRU   #
                             # THE CST DIRECTORY.                      #
      ITEM CSTPTR;           # POINTER USED WHEN REFERENCING THE CST   #
                             # DIRECTORY.                              #
      ITEM NXTGETLNG;        # NUMBER OF WORDS YET TO READ DURING THE  #
                             # CST TRANSFER.                           #
      ITEM TEMPWA;           # TEMPORARALLY HOLDS THE WA OF THE NEXT   #
                             # AVAILABLE WORD IN THE MD (MASS STORAGE).#
  
  
  
  
#     B E G I N   D B $ M D W D   E X E C U T A B L E   C O D E .      #
  
  
 #
  
  DC  DESCRIPTION 
  
      POINT THE WSA BASED ARRAY TO THE FIRST WORD OF THE SCHEMA INFO
      TABLE 
 #
      P<PUTENTRY> = LOC(MDSCINFO);
      P<MDSCENTRY> = SCDRBP + 1;
  
 #
      STORE THE LENGTH IN WORDS OF THE SCHEMA INFO TABLE INTO A PUT 
      PARAMETER ITEM. 
 #
      PUTLNG = MDSCSISZ[SCHDIRP]; 
  
 #
      STORE THE WORD ADRESS OF THE SCH INFO TBL INTO THE SCHEMA DIR.
 #
      MDSCWASC[SCHDIRP] = PUTWA;
 #
      CALL THE PUT ROUTINE. 
 #
      DBPUT;
  
#***  WRITE OUT THE KEY INFORMATION TABLE (KIT)                     ***#
  
 #
      POINT THE WSA BASED ARRAY TO THE KEY INFORMATION TABLE. 
 #
      P<PUTENTRY> = KEYINFOBP + 1;  # KEY INFORMATION TABLE            #
      P<MDSCENTRY> = SCDRBP + 1;    # SCHEMA DIRECTORY TABLE           #
 #
      STORE THE WORD ADDRESS OF THE KEY INFORMATION TABLE INTO THE
      SCHEMA DIRECTORY TABLE. 
 #
      MDSCKITWA[SCHDIRP] = PUTWA;  # WA OF KEY INFO TABLE              #
      PUTLNG = MDSCKITSZ[SCHDIRP]; # LENGTH OF KEY INFORMATION TABLE   #
      DBPUT;                       # WRITE OUT KEY INFORMATION TABLE   #
  
  
#***  WRITE OUT THE AREA DIRECTORY AND AREA INFO TABLE.             ***#
  
 #
      POINT THE WSA BASED ARRAY TO THE AREA DIRECTORY CONTROL WORD. 
 #
      P<PUTENTRY> = ARDIRBP + 1;
      P<MDSCENTRY> = SCDRBP + 1;
  
 #
      CALC THE LENGTH IN WORDS OF THE ARDIR AND STORE INTO THE PUT
      PARAMETER CELLS 
 #
      PUTLNG  = (AREACNT * DFMDADEN) + DFMDADCW;
 #
      STORE THE WA AND WORD LENGTH OF THE AREA DIR INTO THE SCHEMA DIR. 
 #
      MDSCWAAD[SCHDIRP] = PUTWA;
      MDSCADSZ[SCHDIRP] = PUTLNG; 
 #
      CALL THE PUT ROUTINE. 
 #
      DBPUT;
 #
      POINT THE WSA BASED ARRAY TO THE FIRST AREA INFO ENTRY
 #
      P<PUTENTRY> = ARINFOBP + 1; 
      P<MDSCENTRY> = SCDRBP + 1;
 #
      CALC THE LENGTH IN WORDS OF THE AREA INFO TABLE.
 #
      PUTLNG  =  AREACNT * DFMDAIEN;
 #
      STORE THE LENGTH IN WRDS OF THE AREA INFO TBL INTO THE SCHEMA DIR 
 #
      MDSCAISZ[SCHDIRP] = PUTLNG; 
 #
      CALL THE PUT ROUTINE
 #
      DBPUT;
  
#***  WRITE OUT THE DATA BASE PROCEDURE TABLE                       ***#
  
 #
      POINT THE WSA BASED ARRAY TO THE DATA BASE PROCEDURE CONTROL WORD.
 #
      P<MDSCENTRY> = SCDRBP + 1;
      P<PUTENTRY> = DBPROCBP + 1; 
      P<DBPROC> = DBPROCBP + 1; 
      IF MDDPNBEN[0] GR 0 THEN
        BEGIN 
 #
      CALC THE LENGTH IN WORDS OF THE DATA BASE PROCEDURE TABLE.
 #
  
      PUTLNG = MDDPNBEN[0] + DFMDDPCW;
 #
      STORE THE WA AND LENG OF THE DBP TBLE INTO THE SCHEMA DIR.
 #
      MDSCWADP[SCHDIRP] = PUTWA;
      MDSCDPSZ[SCHDIRP] = PUTLNG; 
      DBPUT;
        END 
 #
      WRITE OUT THE CHECKSUM LIST 
 #
      P<MDSCENTRY> = SCDRBP + 1;
      P<PUTENTRY> = B<42,18> MDCHKSMBP + 1; 
      P<MDSCCKSUM> = B<42,18> MDCHKSMBP + 1;
      PUTLNG = (MDHDRNUMAR[0] + MDHDRNUMREL[0])*DFCKSMSZ + 1; 
      MDSCCSLWA[SCHDIRP] = PUTWA; 
      MDSCCSLSZ[SCHDIRP] = PUTLNG;
      DBPUT;
  
#***  WRITE OUT THE VERSION DIRECTORY AND INFORMATION TABLES        ***#
  
 #
      POINT THE WSA BASED ARRAY TO THE VERSION DIRECTORY TABLE. 
      STORE THE WORD ADDRESS OF THE VDT INTO THE SDT. CALL DBPUT TO 
      WRITE THE VDT.
 #
      P<PUTENTRY> = VERDIRBP + 1;  # VERSION DIRECTORY TABLE           #
      P<MDSCENTRY> = SCDRBP + 1;   # SCHEMA DIRECTORY TABLE            #
      MDSCWAVD[SCHDIRP] = PUTWA;   # WA OF VERSION DIRECTORY TABLE     #
      PUTLNG = MDSCNOVER[SCHDIRP] * DFMDVDEN; # LENGTH IN WORDS OF VDT #
      DBPUT;                       # WRITE OUT VERSION DIRECTORY TABLE #
 #
      POINT THE WSA BASED ARRAY TO THE VERSION INFORMATION TABLE, AND 
      CALL DBPUT TO WRITE THE VIT.
 #
      P<MDSCENTRY> = SCDRBP + 1;   # POSITION SCHEMA DIRECTORY TABLE   #
      PUTLNG = MDSCNOVER[SCHDIRP] * MDSCNBARS[SCHDIRP] * DFMDVIEN;
      DB$MDWS(LOC(VERINFBP));      # WRITE OUT VERSION INFO TABLE      #
  
#***  WRITE OUT THE PERMANENT FILE INFORMATION TABLE (PIT).         ***#
  
 #
      POINT THE WSA BASED ARRAY TO THE PIT CONTROL WORD, AND CALL 
      DBPUT TO WRITE OUT THE PERMANENT FILE INFORMATION TABLE.
 #
      P<MDSCENTRY> = SCDRBP + 1;   # POSITION SCHEMA DIRECTORY TABLE   #
      MDSCWAPIT[SCHDIRP] = PUTWA;  # WA OF PERMANENT FILE INFO TABLE   #
      PUTLNG = MDSCPITSZ[SCHDIRP]  # LENGTH OF PERM FILE INFO TABLE    #
               +  MDSCPITSX[SCHDIRP] * 2**18; 
  
      DB$MDWS(LOC(PITBP));         # WRITE OUT THE PF INFO TABLE       #
  
#***  WRITE OUT THE CONSTRAINT USE TABLE IF IT HAS BEEN GENERATED   ***#
  
 #
      POINT THE WSA BASED ARRAY TO THE CONSTRAINT USE TABLE, STORE
      THE CONSTRAINT USE TABLE WA AND LENGTH INTO THE SDT AND CALL
      DBPUT TO WRITE OUT THE CONSTRAINT USE TABLE.
 #
  
      IF CUTBP NQ 0                # IF THE CUT EXISTS                 #
      THEN
        BEGIN 
        P<PUTENTRY> = CUTBP + 1;      # POSITION TO WRITE THE CUT      #
        P<MDSCENTRY> = SCDRBP + 1;    # POSITION SCHEMA DIRECTORY TABLE#
        MDSCCUTWA[SCHDIRP] = PUTWA;   # WORD ADDRESS OF THE CUT        #
        PUTLNG = MDSCCUTSZ[SCHDIRP];  # LENGTH IN WORDS OF THE CUT     #
        DBPUT;                        # WRITE OUT THE CUT              #
        END 
 #
      FREE UP SOME OF THE TABLES JUST WRITTEN TO THE NEW MD FILE. 
 #
      DB$UFRE(LOC(ARDIRBP));
      DB$UFRE(LOC(ARINFOBP)); 
      DB$UFRE(LOC(KEYINFOBP));
      DB$UFRE(LOC(VERDIRBP)); 
      DB$UFRE(LOC(VERINFBP)); 
      DB$UFRE(LOC(PITBP));
      IF CUTBP NQ 0                # IF THE CONSTRAINT USE TABLE HAS   #
                                   # BEEN SPECIFIED                    #
      THEN
        BEGIN 
        DB$UFRE(LOC(CUTBP));       # FREE IT                           #
        END 
  
# IF THERE IS NOTHING NEW ABOUT THE SCHEMA MOVE CST ENTRIES TO NEW MD#
  
      IF NEWSCH EQ 0 THEN 
        BEGIN 
          DB$UFRE(LOC(DBPROCBP)); 
          DB$UFRE (LOC(MDCHKSMBP)); 
          CSTPTR = 0; 
          DB$UALC(LOC(WRKBUFBP),0,DFPRUSIZ);     # ALLOCATE WORK BUFF#
          BUFFSIZE  = 0;                         # WORK BUFFER SIZE # 
          P<MDSCENTRY> = SCDRBP + 1;             # POINT SCHEMA DIREC#
          MDSCWASB[SCHDIRP] = PUTWA;             # SUBSCHEMA DIREC WA#
          TEMPWA = PUTWA;                        # SAVE SUBSCH DIR WA#
          PUTWA = PUTWA + DFCSTSSHD + (CSTDCNT * DFCSTSSEN);
  
# LOOP THROUGH THE SUBSCHEMA/CST DIRECTORY SO EACH CST CAN BE MOVED # 
  
          FOR CSTNBR=1 STEP 1 UNTIL CSTDCNT DO
            BEGIN 
              P<CSTSSTBL> = CSTDIRBP + 2; 
              GETLNG = MDSBSZCS[CSTPTR] + MDSBCPLN[CSTPTR]; 
              GETWA = MDSBWACS[CSTPTR]; 
              MDSBWACS[CSTPTR] = PUTWA; 
  
# IF CST SIZE EXCEEDS MAXIMUM BLOCK SIZE, PROCESS ONE BLOCK AT A TIME#
  
              IF GETLNG GR DFMAXBUF              # IF CST EXCEEDS MAX#
                THEN                             # USE MAX SIZE BLOCK#
                  BEGIN 
                    NXTGETLNG = GETLNG - DFMAXBUF;         # WDS LEFT#
                    GETLNG = DFMAXBUF;           # OLD MD WDS TO GET #
                  END 
                ELSE NXTGETLNG = 0;              # ALL WDS IN ONE GET#
              IF BUFFSIZE LS GETLNG              # IF BUFFER IS SMALL#
                THEN                             # INCREASE BUFFER #
                  BEGIN 
                    DB$UAWS(LOC(WRKBUFBP),GETLNG - BUFFSIZE); 
                    BUFFSIZE = GETLNG;           # WORK BUFFER SIZE # 
                  END 
              FOR I = I WHILE NXTGETLNG GQ 0 DO  # DO A GET AND A PUT # 
                BEGIN 
                  P<GETENTRY> = WRKBUFBP + 1;    # POINT TO WORK BUFF#
                  DBGET;                         # GET FROM OLD MD #
                  PUTLNG = GETLNG;               # NEW MD WDS TO PUT #
                  P<PUTENTRY> = WRKBUFBP + 1;    # POINT TO WORK BUFF#
                  DBPUT;                         # PUT WDS IN NEW MD #
                  IF NXTGETLNG GR DFMAXBUF       # IF WORDS LEFT BIG #
                    THEN NXTGETLNG = NXTGETLNG - DFMAXBUF; # WDS LEFT#
                    ELSE                         # WORDS LEFT NOT BIG#
                      IF NXTGETLNG GR 0          # IF WORDS ARE LEFT #
                        THEN                     # RESET LENGTHS #
                          BEGIN 
                            GETLNG = NXTGETLNG;  # GET ALL WORDS LEFT#
                            NXTGETLNG = 0;       # NO MORE WDS TO GET#
                          END 
                        ELSE NXTGETLNG = -1;     # END THE FOR-LOOP # 
                END 
            CSTPTR = CSTPTR + DFCSTSSEN;
            END 
          I = PUTWA;
          PUTWA = TEMPWA; 
          P<PUTENTRY> = CSTDIRBP + 1; 
          PUTLNG = (DFCSTSSEN * CSTDCNT) + DFCSTSSHD; 
          DBPUT;
          PUTWA = I;
          DB$UFRE(LOC(WRKBUFBP));                # FREE WORK BUFFER # 
          DB$UFRE(LOC(CSTDIRBP)); 
        END 
       ELSE 
        NEWSCH = 0; 
      RETURN; 
    END 
  TERM; 
