*DECK DB$MDWS 
USETEXT MDBCMTX 
USETEXT MDDEFTX 
USETEXT UTMPTTX 
      PROC DB$MDWS((PTRLOC)); 
      BEGIN 
 #
* *   DB$MDWS - WRITE A CONTROLLED TABLE TO MD   PAGE  1
* *   BOB MCALLESTER                             DATE  03/30/84 
* 
* DC  PURPOSE 
* 
*     WRITE A TABLE LENGTH CONTROLLED (TLC) TABLE TO THE
*     MASTER DIRECTORY. 
* 
* DC  ENTRY CONDITIONS
* 
* D   PARAMETERS
# 
      ITEM PTRLOC;                 # LOCATION OF THE POINTER TO THE    #
                                   # TABLE THAT IS TO BE WRITTEN       #
# 
* D   ASSUMPTIONS 
* 
*     THE TABLE TO BE WRITTEN HAS A TLC HEADER. 
* 
*     COMMON ITEMS
*       PUTWA   - WORD ADDRESS ON MASTER DIRECTORY WHERE TABLE WILL 
*                 BE WRITTEN
*       PUTLNG  - LENGTH OF THE TABLE.
* 
* DC  EXIT CONDITIONS 
* 
*     THE TABLE (INCLUDING ALL DISK SEGMENTS) HAS BEEN WRITTEN TO THE 
*     MASTER DIRECTORY. 
* 
* DC  CALLING ROUTINES
* 
*     DB$MDWD - WRITE OUT THE NEW MD FILE 
*     DB$MDWU - WRITE OUT CONTROL WORDS AND SDT 
* 
* DC  CALLED ROUTINES 
# 
      XREF PROC DB$ERMD;           # CRM ERROR EXIT ROUTINE, NEW MD    #
      XREF PROC DB$EROD;           # CRM ERROR EXIT ROUTINE, OLD MD    #
      XREF PROC DB$FTMD;           # FIT FOR NEW MD                    #
      XREF PROC DB$FTOD;           # FIT FOR OLD MD                    #
      XREF PROC DB$MABI;           # DBMSTRD INTERNAL ERROR ABORT      #
      XREF PROC DB$MDPG;           # GET INDEXED DISK SEGMENT          #
      XREF ARRAY DB$RNFT;;         # FET FOR RANDOM I/O                #
      XREF PROC DB$RNRD;           # RANDOM READ                       #
      XREF PROC DB$RNRW;           # RANDOM REWRITE                    #
      XREF PROC DB$WGET;           # READ OLD MD                       #
      XREF PROC DB$WPUT;           # WRITE NEW MD                      #
# 
* DC  NON-LOCAL VARIABLES MODIFIED
# 
*CALL MD20CDCLS 
# 
* DC  DESCRIPTION 
* 
 #
# 
*     LOCAL VARIABLES 
# 
      ITEM BUFFSIZE;         # CURRENT WORK BUFFER SIZE IN WORDS       #
      ITEM BUFLOC;           # LOCATION OF BUFFER FOR RANDOM I/O       #
      ITEM PRUNUM;           # PRU NUMBER FOR RANDOM I/O               #
      ITEM REMLNG;           # REMAINING LENGTH TO TRANSFER            #
      ITEM SEGORD;           # SEGMENT ORDINAL                         #
  
  
  
  
#     B E G I N   D B $ M D W S   E X E C U T A B L E   C O D E .      #
  
  
  
      P<GETENTRY> = PTRLOC; 
      P<TLC> = B<42,18>GETUNSIG[0]; 
      P<PUTENTRY> = P<TLC> + TLCHLEN[0];
      REMLNG = PUTLNG;             # REMAINING LENGTH IS FULL LENGTH   #
      IF TLCDSOR NQ 0 
      THEN                         # THERE ARE SEGMENTS ON DISK        #
        BEGIN 
 #
*       IF THE TABLE IS AN INDEXED TABLE, DB$MDPG IS CALLED TO BE SURE
*       THAT DISK SPACE IS PROPERLY ALLOCATED BEFORE A RESIDENT 
*       SEGMENT IS WRITTEN. 
*       BE SURE THE SEGMENT SPECIFIED IS NOT THE ONE CURRENTLY RESIDENT.
*       THIS IS NECESSARY TO FORCE THE ADJUSTMENT OF THE SEGMENT TABLES.
 #
        IF TLCXT[0] 
        THEN
          BEGIN 
          SEGORD = DFTLCHL;        # SPECIFY THE FIRST SEGMENT         #
          IF SEGORD EQ TLCDSOR[0]  # UNLESS THE FIRST SEGMENT IS       #
                                   # ALREADY RESIDENT,                 #
          THEN                     # THEN SPECIFY THE SECOND SEGMENT.  #
            BEGIN 
            SEGORD = SEGORD +1; 
            END 
          DB$MDPG(SEGORD);
          END 
  
        BUFLOC = LOC(TLC) + TLCHLEN[0] + TLCDSBW[0];
        IF TLCDSMF[0]              # IF THE SEGMENT IN MEMORY HAS BEEN #
        THEN                       # MODIFIED, REWRITE IT TO DISK      #
          BEGIN 
          SEGORD = TLCDSOR[0];
          BUFFSIZE = TLCDSWL[0];
          PRUNUM = TLCSPRU[SEGORD]; 
          DB$RNRW(LOC(DB$RNFT),BUFLOC,BUFFSIZE,PRUNUM); 
          TLCDSMF[0] = FALSE; 
          END 
 #
*       STEP THROUGH THE DISK SEGMENTS, COPYING THEM TO THE MD. 
 #
        PUTLNG = TLCSLEN[DFTLCHL] + TLCDSBW[0];  # LENGTH OF 1ST WRITE #
        I = TLCHLEN -1; 
        FOR SEGORD = DFTLCHL STEP 1 UNTIL I 
        DO
          BEGIN 
          IF SEGORD NQ TLCDSOR[0]  # IF NOT ALREADY LOADED             #
          THEN                     # READ IN THE SEGMENT               #
            BEGIN 
            BUFFSIZE = TLCSLEN[SEGORD]; 
            TLCDSWL[0] = BUFFSIZE;
            PRUNUM = TLCSPRU[SEGORD]; 
            TLCDSOR[0] = SEGORD;
            DB$RNRD(LOC(DB$RNFT),BUFLOC,BUFFSIZE,PRUNUM); 
            END 
          DBPUT;
          P<TLC> = B<42,18>GETUNSIG[0]; 
          REMLNG = REMLNG - PUTLNG;    # REMAINING LENGTH              #
          PUTLNG = TLCSLEN[SEGORD+1];  # LENGTH OF NEXT SEGMENT        #
          P<PUTENTRY> = LOC(TLC) + TLCHLEN[0] + TLCDSBW[0]; 
          END 
 #
*       IF IT IS AN INDEXED TABLE THERE SHOULD NOT BE ANY BUILD SEGMENT.
*         IF THERE IS, ABORT FOR AN INTERNAL ERROR. 
 #
        IF TLCXT[0] 
        THEN
          BEGIN 
          IF REMLNG NQ 0
          THEN
            BEGIN 
            DB$MABI("DB$MDWS 1"); 
            END 
          RETURN; 
          END 
 #
*       IF PUTLNG IS NOT THE SAME AS THE ALLOCATED LENGTH, ABORT. 
 #
        IF REMLNG NQ TLCUSED[0] - TLCBSBW[0]
        THEN
          BEGIN 
          DB$MABI("DB$MDWS 2"); 
          END 
 #
*       SET UP LENGTH AND LOCATION TO WRITE THE BUILD SEGMENT.
 #
        PUTLNG = REMLNG;
        P<PUTENTRY> = LOC(TLC) + TLCHLEN[0] + TLCBSBW[0]; 
        END 
      IF PUTLNG GR 0
      THEN
        BEGIN 
        DBPUT;                     # WRITE OUT THE REMAINDER OF TABLE  #
        P<TLC> = B<42,18>GETUNSIG[0]; 
        END 
      END 
      TERM; 
