/*
 * PDLOW.C - low level routines for PDBlib
 *
 * Source Version: 9.0
 * Software Release #92-0043
 *
 */

#include "cpyright.h"

#include "pdb.h"

#define BUFINCR   4096
#define N_CASTS_INCR 30


#define PD_COMPARE_PTR_STD(eq, a, b, c, d)                                   \
    eq = (a->ptr_bytes != b->ptr_bytes) ||                                   \
         (c->ptr_alignment != d->ptr_alignment)

#define PD_COMPARE_CHAR_STD(eq, a, b, c, d)                                  \
    eq = (c->char_alignment != d->char_alignment)

#define PD_COMPARE_SHORT_STD(eq, a, b, c, d)                                 \
   PD_COMPARE_FIX_STD(eq,                                                    \
		      a->short_bytes,     b->short_bytes,                    \
		      a->short_order,     b->short_order,                    \
		      c->short_alignment, d->short_alignment)

#define PD_COMPARE_INT_STD(eq, a, b, c, d)                                   \
   PD_COMPARE_FIX_STD(eq,                                                    \
		      a->int_bytes,     b->int_bytes,                        \
		      a->int_order,     b->int_order,                        \
		      c->int_alignment, d->int_alignment)

#define PD_COMPARE_LONG_STD(eq, a, b, c, d)                                  \
   PD_COMPARE_FIX_STD(eq,                                                    \
		      a->long_bytes,     b->long_bytes,                      \
		      a->long_order,     b->long_order,                      \
		      c->long_alignment, d->long_alignment)

#define PD_COMPARE_LONGLONG_STD(eq, a, b, c, d)                              \
   PD_COMPARE_FIX_STD(eq,                                                    \
		      a->longlong_bytes,     b->longlong_bytes,              \
		      a->longlong_order,     b->longlong_order,              \
		      c->longlong_alignment, d->longlong_alignment)

#define PD_COMPARE_FIX_STD(eq, na, nb, oa, ob, la, lb)                       \
    eq = (na != nb) || (oa != ob) || (la != lb)

#define PD_COMPARE_FLT_STD(eq, a, b, c, d)                                   \
   PD_COMPARE_FP_STD(eq,                                                     \
		     a->float_bytes,     b->float_bytes,                     \
		     a->float_order,     b->float_order,                     \
		     a->float_format,    b->float_format,                    \
		     c->float_alignment, d->float_alignment)

#define PD_COMPARE_DBL_STD(eq, a, b, c, d)                                   \
   PD_COMPARE_FP_STD(eq,                                                     \
		     a->double_bytes,     b->double_bytes,                   \
		     a->double_order,     b->double_order,                   \
		     a->double_format,    b->double_format,                  \
		     c->double_alignment, d->double_alignment)

#define PD_COMPARE_FP_STD(eq, na, nb, oa, ob, fa, fb, la, lb)                \
   {int j, *poa, *pob;                                                       \
    long *pfa, *pfb;                                                         \
    poa = oa;                                                                \
    pob = ob;                                                                \
    pfa = fa;                                                                \
    pfb = fb;                                                                \
    eq  = (na != nb) || (la != lb);                                          \
    if (!eq)                                                                 \
       {for (j = 0; j < na; j++, eq |= (*(poa++) != *(pob++)));              \
        for (j = 0; j < FORMAT_FIELDS; j++, eq |= (*(pfa++) != *(pfb++)));};}

struct s_file_static
   {long _PD_n_casts;
    int _PD_has_dirs;
    char **_PD_cast_lst;
    char local[LRG_TXT_BUFFER];
    char *tbf;
    char *_PD_tbuffer;
    long ncx;
    long nc;
    char *spl;};

typedef struct s_file_static FILE_STATIC;

#ifdef HAVE_THREADS

#define _PD_N_CASTS(x)  (_PD_low_static[x]._PD_n_casts)
#define _PD_HAS_DIRS(x) (_PD_low_static[x]._PD_has_dirs)
#define _PD_CAST_LST(x) (_PD_low_static[x]._PD_cast_lst)
#define LOCAL(x)        (_PD_low_static[x].local)
#define TBF(x)          (_PD_low_static[x].tbf)
#define _PD_TBUFFER(x)  (_PD_low_static[x]._PD_tbuffer)
#define NCX(x)          (_PD_low_static[x].ncx)
#define NC(x)           (_PD_low_static[x].nc)
#define SPL(x)          (_PD_low_static[x].spl)

static FILE_STATIC
 *_PD_low_static = NULL;

#else

#define _PD_N_CASTS(x)  _PD_n_casts
#define _PD_HAS_DIRS(x) _PD_has_dirs
#define _PD_CAST_LST(x) _PD_cast_lst
#define LOCAL(x)        local
#define TBF(x)          tbf
#define _PD_TBUFFER(x)  _PD_tbuffer
#define NCX(x)          ncx
#define NC(x)           nc
#define SPL(x)          spl

static long
 ncx = 0L,
 nc = 0L,
 _PD_n_casts = 0L;

static int
 _PD_has_dirs = FALSE;

static char
 **_PD_cast_lst,
 *tbf = NULL,
 *spl = NULL,
 local[LRG_TXT_BUFFER];

char
 *_PD_tbuffer = NULL;

#endif

char
 *PD_ALIGNMENT_S = NULL,
 *PD_DEFSTR_S = NULL,
 *PD_STANDARD_S = NULL,
 *PD_SYMENT_S = NULL;

void
 SC_DECLARE(_PD_check_casts, (HASHTAB *chrt, char **lst, long n));

static char
 *SC_DECLARE(_PD_get_tok, (char *s, int n, FILE *fp, int ch)),
 *SC_DECLARE(_PD_get_token, (char *bf, char *s, int n, int ch));

static int
 SC_DECLARE(_PD_put_string, (int reset, char *fmt, ...)),
 SC_DECLARE(_PD_consistent_dims, 
            (PDBfile *file, syment *ep, dimdes *ndims));

static defstr
 *SC_DECLARE(_PD_defstr, 
             (HASHTAB *chart, char *name, int align, long sz,
	       int flg, int conv, int *ordr, long *formt, int unsgned, int onescmp));

/*--------------------------------------------------------------------------*/

/*                           FORMAT ROUTINES                                */

/*--------------------------------------------------------------------------*/

/* _PD_RD_FORMAT - read the primitive data format information from 
 *               - the file header block
 *               -
 *               - Floating Point Format Descriptor
 *               -   format[0] = # of bits per number
 *               -   format[1] = # of bits in exponent
 *               -   format[2] = # of bits in mantissa
 *               -   format[3] = start bit of sign
 *               -   format[4] = start bit of exponent
 *               -   format[5] = start bit of mantissa
 *               -   format[6] = high order mantissa bit (CRAY needs this)
 *               -   format[7] = bias of exponent
 */

int _PD_rd_format(file)
   PDBfile *file;
   {int j, n, *order;
    long *format;
    char infor[MAXLINE], *p, *s;
    data_standard *std;
    SC_THREAD_ID(_t_index);
    
/* read the number of bytes worth of format data */
    if (pio_read(infor, (size_t) 1, (size_t) 1, file->stream) != 1)
       PD_error("FAILED TO READ FORMAT HEADER - _PD_RD_FORMAT", PD_OPEN);
    
    n = infor[0] - 1;

/* read the format data */
    if (pio_read(infor+1, (size_t) 1, (size_t) n, file->stream) != n)
       PD_error("FAILED TO READ FORMAT DATA - _PD_RD_FORMAT", PD_OPEN);
    
/* decipher the format data */
    p             = infor + 1;
    std           = _PD_mk_standard();

/* get the byte lengths in */
    std->ptr_bytes    = *(p++);
    std->short_bytes  = *(p++);
    std->int_bytes    = *(p++);
    std->long_bytes   = *(p++);
    std->float_bytes  = *(p++);
    std->double_bytes = *(p++);

/* get the integral types byte order in */
    std->short_order = (char) *(p++);
    std->int_order   = (char) *(p++);
    std->long_order  = (char) *(p++);

/* get the float byte order in */
    n     = std->float_bytes;
    order = std->float_order = FMAKE_N(int, n,
                                       "_PD_RD_FORMAT:float_order");
    SC_mark(std->float_order, 1);
    for (j = 0; j < n; j++, *(order++) = *(p++));

/* get the double byte order in */
    n     = std->double_bytes;
    order = std->double_order = FMAKE_N(int, n,
                                        "_PD_RD_FORMAT:double_order");
    SC_mark(std->double_order, 1);
    for (j = 0; j < n; j++, *(order++) = *(p++));

/* get the float format data in */
    n = FORMAT_FIELDS;
    format = std->float_format = FMAKE_N(long, n,
                                         "_PD_RD_FORMAT:float_format");
    SC_mark(std->float_format, 1);
    n--;
    for (j = 0; j < n; j++, *(format++) = *(p++));

/* get the double format data in */
    n = FORMAT_FIELDS;
    format = std->double_format = FMAKE_N(long, n,
                                          "_PD_RD_FORMAT:double_format");
    SC_mark(std->double_format, 1);
    n--;
    for (j = 0; j < n; j++, *(format++) = *(p++));

/* read the biases */
    if (_PD_rfgets(infor, MAXLINE, file->stream) == NULL)
       PD_error("CAN'T READ THE BIASES - _PD_RD_FORMAT", PD_OPEN);

    format    = std->float_format;
    format[7] = SC_stol(SC_strtok(infor, "\001", s));
    format    = std->double_format;
    format[7] = SC_stol(SC_strtok(NULL, "\001", s));

    file->std = std;

    return(TRUE);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_WR_FORMAT - write the primitive data format information to
 *               - the file header block
 *               -
 *               - Floating Point Format Descriptor
 *               -   format[0] = # of bits per number
 *               -   format[1] = # of bits in exponent
 *               -   format[2] = # of bits in mantissa
 *               -   format[3] = start bit of sign
 *               -   format[4] = start bit of exponent
 *               -   format[5] = start bit of mantissa
 *               -   format[6] = high order mantissa bit (CRAY needs this)
 *               -   format[7] = bias of exponent
 */

int _PD_wr_format(file)
   PDBfile *file;
   {int j, n, *order;
    long *format, float_bias, double_bias;
    char outfor[MAXLINE], *p;
    data_standard *std;
    SC_THREAD_ID(_t_index);

    p   = outfor + 1;
    std = file->std;

/* get the byte lengths in */
    *(p++) = std->ptr_bytes;
    *(p++) = std->short_bytes;
    *(p++) = std->int_bytes;
    *(p++) = std->long_bytes;
    *(p++) = std->float_bytes;
    *(p++) = std->double_bytes;

/* get the integral types byte order in */
    *(p++) = std->short_order;
    *(p++) = std->int_order;
    *(p++) = std->long_order;

/* get the float byte order in */
    order = std->float_order;
    n     = std->float_bytes;
    for (j = 0; j < n; j++, *(p++) = *(order++));

/* get the double byte order in */
    order = std->double_order;
    n     = std->double_bytes;
    for (j = 0; j < n; j++, *(p++) = *(order++));

/* get the float format data in */
    format = std->float_format;
    n = FORMAT_FIELDS - 1;
    for (j = 0; j < n; j++, *(p++) = *(format++));

/* get the float bias in */
    float_bias = *format;

/* get the double format data in */
    format = std->double_format;
    n      = FORMAT_FIELDS - 1;
    for (j = 0; j < n; j++, *(p++) = *(format++));

/* get the double bias in */
    double_bias = *format;

    n         = (int) (p - outfor);
    outfor[0] = n;

    if (pio_write(outfor, (size_t) 1, (size_t) n, file->stream) != n)
       PD_error("FAILED TO WRITE FORMAT DATA - _PD_WR_FORMAT", PD_CREATE);
    
/* write out the biases */
    sprintf(outfor, "%ld\001%ld\001\n", float_bias, double_bias);
    n = strlen(outfor);
    if (pio_write(outfor, (size_t) 1, (size_t) n, file->stream) != n)
       PD_error("FAILED TO WRITE BIASES - _PD_WR_FORMAT", PD_CREATE);
    
    return(TRUE);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_COMPARE_STD - compare two data_standards
 *                 - and the associated alignments
 *                 - return TRUE if all elements are equal in value
 */

int _PD_compare_std(a, b, c, d)
   data_standard *a, *b;
   data_alignment *c, *d;
   {int j, n, *oa, *ob;
    long *fa, *fb;
    int eq;

    eq = (a->ptr_bytes        == b->ptr_bytes) &&
         (a->short_bytes      == b->short_bytes) &&
         (a->int_bytes        == b->int_bytes) &&
         (a->long_bytes       == b->long_bytes) &&
         (a->longlong_bytes   == b->longlong_bytes) &&
         (a->float_bytes      == b->float_bytes) &&
         (a->double_bytes     == b->double_bytes) &&
         (a->short_order      == b->short_order) &&
         (a->int_order        == b->int_order) &&
         (a->long_order       == b->long_order) &&
         (a->longlong_order   == b->longlong_order);

    if (!eq)
       return(FALSE);

/* check the float byte order */
    n  = a->float_bytes;
    oa = a->float_order;
    ob = b->float_order;
    for (j = 0; j < n; j++, eq &= (*(oa++) == *(ob++)));

/* check the double byte order */
    n  = a->double_bytes;
    oa = a->double_order;
    ob = b->double_order;
    for (j = 0; j < n; j++, eq &= (*(oa++) == *(ob++)));

/* check the float format data */
    n  = FORMAT_FIELDS;
    fa = a->float_format;
    fb = b->float_format;
    for (j = 0; j < n; j++, eq &= (*(fa++) == *(fb++)));

/* check the double format data */
    n  = FORMAT_FIELDS;
    fa = a->double_format;
    fb = b->double_format;
    for (j = 0; j < n; j++, eq &= (*(fa++) == *(fb++)));

/* check alignments */
    eq &= ((c->char_alignment       == d->char_alignment) &&
           (c->ptr_alignment        == d->ptr_alignment) &&
           (c->short_alignment      == d->short_alignment) &&
           (c->int_alignment        == d->int_alignment) &&
           (c->long_alignment       == d->long_alignment) &&
           (c->longlong_alignment   == d->longlong_alignment) &&
           (c->float_alignment      == d->float_alignment) &&
           (c->double_alignment     == d->double_alignment));

    return(eq);}

/*--------------------------------------------------------------------------*/

/*                            READ ROUTINES                                 */

/*--------------------------------------------------------------------------*/

/* _PD_RD_SYMT - read the symbol table from the PDB file into a
 *             - hash table of the PDB for future lookup
 *             - return TRUE if successful
 *             - return FALSE on error
 */

int _PD_rd_symt(file)
   PDBfile *file;
   {char *name, *type, *tmp, *pbf, *s;
    long mini, leng, symt_sz;
    off_t addr, numb;
    FILE *fp;
    syment *ep;
    HASHTAB *tab;
    dimdes *dims, *next, *prev;
    SC_THREAD_ID(_t_index);

    fp = file->stream;

/* find the overall file length */
    addr = pio_tell(fp);
    pio_seek(fp, (off_t)0, SEEK_END);
    numb = pio_tell(fp);
    pio_seek(fp, addr, SEEK_SET);

/* read in the symbol table and extras table as a single block */
    symt_sz     = numb - file->symtaddr + 1;
    _PD_TBUFFER(_t_index) = FMAKE_N(char, symt_sz, "_PD_RD_SYMT:tbuffer");
    numb        = pio_read(_PD_TBUFFER(_t_index), 1, symt_sz, fp) + 1;
    if (numb != symt_sz)
       return(FALSE);
    _PD_TBUFFER(_t_index)[symt_sz-1] = (char) EOF;

    pbf  = _PD_TBUFFER(_t_index);
    prev = NULL;
    tab  = file->symtab;
    while (_PD_get_token(pbf, LOCAL(_t_index), LRG_TXT_BUFFER, '\n'))
       {pbf  = NULL;
        name = SC_strtok(LOCAL(_t_index), "\001", s);
        if (name == NULL)
           break;
        type = SC_strtok(NULL, "\001", s);
        numb = SC_stol(SC_strtok(NULL, "\001", s));
        addr = SC_STOADD(SC_strtok(NULL, "\001", s));
        dims = NULL;
        while ((tmp = SC_strtok(NULL, "\001\n", s)) != NULL)
           {mini = SC_stol(tmp);
            leng = SC_stol(SC_strtok(NULL, "\001\n", s));
            next = _PD_mk_dimensions(mini, leng);
            if (dims == NULL)
               dims = next;

            else
               {prev->next = next;
		SC_mark(next, 1);};

            prev = next;};

        ep = _PD_mk_syment(type, numb, addr, NULL, dims);
        _PD_e_install(name, ep, tab, FALSE);};

    return(TRUE);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_RD_CHRT - read the structure chart from the PDB file into
 *             - the internal structure chart
 *             - return TRUE if successful
 *             - return FALSE on error
 */

int _PD_rd_chrt(file)
   PDBfile *file;
   {char *nxt, type[MAXLINE], *pbf;
    FILE *fp;
    memdes *desc, *lst, *prev;
    long i, sz, chrt_sz;
    SC_THREAD_ID(_t_index);

    fp = file->stream;

/* read the entire chart into memory to speed processing */
    chrt_sz     = file->symtaddr - file->chrtaddr + 1;
    _PD_TBUFFER(_t_index) = FMAKE_N(char, chrt_sz, "_PD_RD_CHRT:tbuffer");
    if (pio_read(_PD_TBUFFER(_t_index), 1, chrt_sz, fp) != chrt_sz)
       return(FALSE);
    _PD_TBUFFER(_t_index)[chrt_sz-1] = (char) EOF;

    prev = NULL;
    pbf  = _PD_TBUFFER(_t_index);
    while (_PD_get_token(pbf, type, MAXLINE, '\001'))
       {pbf = NULL;
	if (type[0] == '\002')
           break;
        sz   = SC_stol(_PD_get_token(pbf, LOCAL(_t_index), MAXLINE, '\001'));
        lst  = NULL;
        while ((nxt = _PD_get_token(pbf, LOCAL(_t_index), MAXLINE, '\001')) != NULL)
           {if (*nxt == '\0')
               break;
            desc = _PD_mk_descriptor(nxt, file->default_offset);
            if (lst == NULL)
               lst = desc;
            else
               prev->next = desc;
            prev = desc;};

/* install the type in both charts */
        _PD_defstr_inst(type, lst, -1, NULL, NULL,
                        file->chart, file->host_chart,
                        file->align, file->host_align,
                        FALSE);};

/* complete the setting of the directory indicator */
    if (_PD_HAS_DIRS(_t_index))
       {PD_defncv(file, "Directory", 1, 0);
	file->current_prefix = SC_strsavef("/", "char*:_PD_RD_CHRT:slash");};
    _PD_HAS_DIRS(_t_index) = FALSE;

/* check the casts for the file->chart */
    _PD_check_casts(file->chart, _PD_CAST_LST(_t_index), _PD_N_CASTS(_t_index));

/* check the casts for the file->host_chart */
    _PD_check_casts(file->host_chart, _PD_CAST_LST(_t_index), _PD_N_CASTS(_t_index));

/* clean up the mess */
    for (i = 0L; i < _PD_N_CASTS(_t_index); i += 3)
        {SFREE(_PD_CAST_LST(_t_index)[i]);
         SFREE(_PD_CAST_LST(_t_index)[i+1]);};
    SFREE(_PD_CAST_LST(_t_index));
    _PD_N_CASTS(_t_index) = 0L;

    SFREE(_PD_TBUFFER(_t_index));

    return(TRUE);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_CHECK_CASTS - complete the set up of the casts in the given chart */

void _PD_check_casts(chrt, lst, n)
   HASHTAB *chrt;
   char **lst;
   long n;
   {memdes *memb, *desc;
    long i;
    hashel *hp;
    defstr *dp;

    for (hp = *(chrt->table); hp != NULL; hp = hp->next)
        {dp = (defstr *) hp->def;
         for (desc = dp->members; desc != NULL; desc = desc->next)
             {for (i = 0L; i < n; i += 3)
                  {if ((strcmp(dp->type, lst[i]) == 0) &&
                       (strcmp(desc->member, lst[i+1]) == 0))
                      {desc->cast_memb = lst[i+2];
                       desc->cast_offs = _PD_member_location(desc->cast_memb,
                                                             chrt,
                                                             dp,
                                                             &memb);};};};};

    return;}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_RD_EXTRAS - read any extraneous data from the file
 *               - this is essentially a place for expansion of the file
 */

int _PD_rd_extras(file)
   PDBfile *file;
   {char *token, *s;
    data_alignment *pa;
    data_standard *ps;
    SC_THREAD_ID(_t_index);

    _PD_N_CASTS(_t_index) = 0L;

    file->default_offset = 0;
    file->system_version = 0;
    file->date           = NULL;

/* read the default offset */
    while (_PD_get_token(NULL, LOCAL(_t_index), LRG_TXT_BUFFER, '\n'))
       {token = SC_firsttok(LOCAL(_t_index), ":\n");
        if (token == NULL)
           break;

/* get the default offset */
        if (strcmp(token, "Offset") == 0)
           {token = SC_firsttok(LOCAL(_t_index), "\n");
            if (token != NULL)
               file->default_offset = atoi(token);}

        else if (strcmp(token, "Alignment") == 0)
           {token = SC_firsttok(LOCAL(_t_index), "\n");
            if (token != NULL)
               pa = _PD_mk_alignment(token);
	    else
	       return(FALSE);}

        else if (strcmp(token, "Struct-Alignment") == 0)
           {token = SC_firsttok(LOCAL(_t_index), "\n");
            if (token != NULL)
	       pa->struct_alignment = atoi(token);}

        else if (strcmp(token, "Longlong-Format-Alignment") == 0)
           {token = SC_firsttok(LOCAL(_t_index), "\n");
            if (token != NULL)
               {ps = file->std;
                ps->longlong_bytes = token[0];
                ps->longlong_order = token[1];
                pa->longlong_alignment = token[2];};}

        else if (strcmp(token, "Casts") == 0)
           {long n_casts, i;
            char **pl;

            n_casts = N_CASTS_INCR;
            pl      = FMAKE_N(char *, N_CASTS_INCR, "_PD_RD_EXTRAS:cast-list");
            i       = 0L;
            while (_PD_get_token(NULL, LOCAL(_t_index), LRG_TXT_BUFFER, '\n'))
               {if (*LOCAL(_t_index) == '\002')
                   break;
                pl[i++] = SC_strsavef(SC_strtok(LOCAL(_t_index), "\001\n", s),
                                      "char*:_PD_RD_EXTRAS:LOCAL(_t_index)1");
                pl[i++] = SC_strsavef(SC_strtok(NULL, "\001\n", s),
                                      "char*:_PD_RD_EXTRAS:LOCAL(_t_index)2");
                pl[i++] = SC_strsavef(SC_strtok(NULL, "\001\n", s),
                                      "char*:_PD_RD_EXTRAS:LOCAL(_t_index)3");
                if (i >= n_casts)
                   {n_casts += N_CASTS_INCR;
                    REMAKE_N(pl, char *, n_casts);};};
            _PD_CAST_LST(_t_index) = pl;
            _PD_N_CASTS(_t_index)  = i;}

        else if (strcmp(token, "Blocks") == 0)
           {long j, n, nt, numb, stride;
            off_t addr;
            char *name;
            symblock *sp;
            syment *ep;
            dimdes *dim;

            while (_PD_get_token(NULL, LOCAL(_t_index), LRG_TXT_BUFFER, '\n'))
               {if (*LOCAL(_t_index) == '\002')
                   break;

                name = SC_strtok(LOCAL(_t_index), "\001\n", s);
                n    = SC_stoi(SC_strtok(NULL, " \n", s));
                ep   = PD_inquire_entry(file, name, FALSE, NULL);
                sp   = REMAKE_N(PD_entry_blocks(ep), symblock, n);
                nt   = 0L;
                for (j = 0L; j < n; j++)
                    {addr = SC_stoi(SC_strtok(NULL, " \n", s));
                     numb = SC_stoi(SC_strtok(NULL, " \n", s));
                     if ((addr == 0) || (numb == 0L))
		        {_PD_get_token(NULL, LOCAL(_t_index), LRG_TXT_BUFFER, '\n');
                         addr = SC_stoi(SC_strtok(LOCAL(_t_index), " \n", s));
                         numb = SC_stoi(SC_strtok(NULL, " \n", s));};
                         
                     sp[j].diskaddr = addr;
                     sp[j].number   = numb;

                     nt += numb;};

/* adjust the slowest varying dimension to reflect the entire entry */
                dim = PD_entry_dimensions(ep);
                if (PD_get_major_order(file) == COLUMN_MAJOR_ORDER)
		   for (; dim->next != NULL; dim = dim->next);

                stride = PD_entry_number(ep)/dim->number;
		stride = nt/stride;
                dim->number    = stride;
		dim->index_max = dim->index_min + stride - 1L;

/* adjust the number to reflect the entire entry */
                PD_entry_number(ep) = nt;

                PD_entry_blocks(ep) = sp;};}

/* read in the primitives */
        else if (strcmp(token, "Primitive-Types") == 0)
           _PD_rd_prim_extras(file, '\001', '\002', NULL);

        else if (strcmp(token, "Major-Order") == 0)
           {token = SC_firsttok(LOCAL(_t_index), "\n");
            if (token != NULL)
               file->major_order = atoi(token);}

        else if (strcmp(token, "Has-Directories") == 0)
           {if (SC_stoi(SC_firsttok(LOCAL(_t_index), "\n")))
               _PD_HAS_DIRS(_t_index) = TRUE;}

        else if (strcmp(token, "Dynamic Spaces") == 0)
           {token = SC_firsttok(LOCAL(_t_index), "\n");
            if (token != NULL)
	       file->n_dyn_spaces = SC_stoi(token);}

        else if (strcmp(token, "Previous-File") == 0)
           {token = SC_firsttok(LOCAL(_t_index), "\n");
            if (token != NULL)
               file->previous_file = SC_strsavef(token,
                                        "char*:_PD_RD_EXTRAS:prev");}

        else if (strcmp(token, "Version") == 0)
           {token = SC_firsttok(LOCAL(_t_index), "|");
            if (token != NULL)
               file->system_version = atoi(token);

            token = SC_firsttok(LOCAL(_t_index), "\n");
            if (token != NULL)
               file->date = SC_strsavef(token,
                                        "char*:_PD_RD_EXTRAS:date");};};

/* set the file->align (if pre-PDB_SYSTEM_VERSION 3 use the default
 * alignment
 */
    if (pa != NULL)
       file->align = pa;
    else
       file->align = _PD_copy_alignment(&DEF_ALIGNMENT);

/* release the buffer which held both the symbol table and the extras */
    SFREE(_PD_TBUFFER(_t_index));

    return(TRUE);}

/*--------------------------------------------------------------------------*/

/*                              WRITE ROUTINES                              */

/*--------------------------------------------------------------------------*/

/* _PD_WR_SYMT - write out the symbol table (a hash table) into the
 *             - PDB file
 *             - return the disk address if successful
 *             - return -1L on error
 */

off_t _PD_wr_symt(file)
   PDBfile *file;
   {long nt, ne, nb, stride;
    off_t addr;
    int i, n, size, flag;
    FILE *fp;
    hashel **s_tab, *hp;
    syment *ep;
    dimdes *lst;
    SC_THREAD_ID(_t_index);

    fp   = file->stream;
    addr = pio_tell(fp);
    if (addr == -1)
       return(-1);

    if (_PD_TBUFFER(_t_index) != NULL)
       SFREE(_PD_TBUFFER(_t_index));

    n     = 0;
    s_tab = file->symtab->table;
    size  = file->symtab->size;
    for (i = 0; i < size; i++)
        {for (hp = s_tab[i]; hp != NULL; hp = hp->next)
             {ep = (syment *) (hp->def);
              nt = PD_entry_number(ep);
	      nb = PD_block_number(ep, 0);
              if (nb == 0)
                 {if (PD_n_blocks(ep) == 1)
                     nb = nt;
                  else
                     {sprintf(PD_ERR(_t_index), "ERROR: BAD BLOCK LIST - _PD_WR_SYMT\n");
                      return(-1L);};};
#ifdef _LARGE_FILES
              _PD_put_string(n++, "%s\001%s\001%ld\001%lld\001",
#else
              _PD_put_string(n++, "%s\001%s\001%ld\001%ld\001",
#endif
			     hp->name,
			     PD_entry_type(ep),
			     nb,
			     PD_entry_address(ep));

/* adjust the slowest varying dimension to reflect only the first block */
              flag = PD_get_major_order(file);
              for (lst = PD_entry_dimensions(ep);
                   lst != NULL;
                   lst = lst->next)
                  {if ((flag == ROW_MAJOR_ORDER) ||
		       ((flag == COLUMN_MAJOR_ORDER) && (lst->next == NULL)))
                      {stride = nt/(lst->number);
                       ne     = nb/stride;
		       flag   = FALSE;}
		   else
		      ne = lst->number;

		   _PD_put_string(n++, "%ld\001%ld\001",
				  lst->index_min, ne);};

              _PD_put_string(n++, "\n");};};

/* pad an extra newline to mark the end of the symbol table for _PD_rd_symt */
    _PD_put_string(n++, "\n");

    return(addr);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_WR_CHRT - write out the structure chart into the PDB file
 *             - return a disk address if successful
 *             - return -1L on error
 */

off_t _PD_wr_chrt(file)
   PDBfile *file;
   {int n;
    off_t addr;
    FILE *fp;
    hashel *hp;
    defstr *dp;
    memdes *desc;
    SC_THREAD_ID(_t_index);

    fp   = file->stream;
    addr = pio_tell(fp);
    if (addr == -1)
       return(-1);

    if (_PD_TBUFFER(_t_index) != NULL)
       SFREE(_PD_TBUFFER(_t_index));

    _PD_rev_chrt(file);

/* the hash array for the structure chart is one element long */
    n = 0;
    for (hp = file->chart->table[0]; hp != NULL; hp = hp->next)
        {dp = (defstr *) (hp->def);

/* use hp->name instead of dp->type or PD_typedef's will not work */
         _PD_put_string(n++, "%s\001%ld\001", hp->name, dp->size);

         for (desc = dp->members; desc != NULL; desc = desc->next)
             _PD_put_string(n++, "%s\001", desc->member);

         _PD_put_string(n++, "\n");};

    _PD_put_string(n++, "\002\n");

/* restore the chart because this may be a PD_flush and more types
 * may be added later
 */
    _PD_rev_chrt(file);

/* write the entire chart to the file now */
    pio_write(_PD_TBUFFER(_t_index), 1, strlen(_PD_TBUFFER(_t_index)), fp);
    pio_flush(fp);
    SFREE(_PD_TBUFFER(_t_index));

    return(addr);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_WR_EXTRAS - write any extraneous data to the file
 *               - this is essentially a place for expansion of the file
 *               - to complete the definition of a PDB file the following
 *               - rule applies to extensions in the EXTRAS table:
 *               -
 *               -     An extension shall have one of two formats:
 *               -
 *               -        1) <name>:<text>\n
 *               -
 *               -        2) <name>:\n
 *               -           <text1>\n
 *               -           <text2>\n
 *               -              .
 *               -              .
 *               -              .
 *               -           <textn>\n
 *               -           [^B]\n
 *               -
 *               -     anything else is strictly illegal!!!!!!
 *               -     NOTE: the optional ^B is for backward compatibility
 *               -     and is not recommmended.
 */

int _PD_wr_extras(file)
   PDBfile *file;
   {FILE *fp;
    data_alignment *pa;
    data_standard *ps;
    char al[MAXLINE];
    int has_dirs;
     SC_THREAD_ID(_t_index);

    fp = file->stream;

/* write the default offset */
    _PD_put_string(1, "Offset:%d\n", file->default_offset);

/* write the alignment data */
    pa    = file->align;
    al[0] = pa->char_alignment;
    al[1] = pa->ptr_alignment;
    al[2] = pa->short_alignment;
    al[3] = pa->int_alignment;
    al[4] = pa->long_alignment;
    al[5] = pa->float_alignment;
    al[6] = pa->double_alignment;
    al[7] = '\0';

    if (al[0]*al[1]*al[3]*al[4]*al[5]*al[6] == 0)
       return(FALSE);

    _PD_put_string(1, "Alignment:%s\n", al);
    _PD_put_string(1, "Struct-Alignment:%d\n",
		   file->align->struct_alignment);

/* write out the long long standard and alignment */
    ps = file->std;
    al[0] = ps->longlong_bytes;
    al[1] = ps->longlong_order;
    al[2] = pa->longlong_alignment;
    al[3] = '\0';

    _PD_put_string(1, "Longlong-Format-Alignment:%s\n", al);

/* write out the date and version data */
    _PD_put_string(1, "Version:%d|%s\n",
		   file->system_version, file->date);

/* write out the casts */
    {hashel *hp;
     defstr *dp;
     memdes *desc;

     _PD_put_string(1, "Casts:\n");
     for (hp = *(file->host_chart->table); hp != NULL; hp = hp->next)
         {dp = (defstr *) hp->def;
          for (desc = dp->members; desc != NULL; desc = desc->next)
              if (desc->cast_memb != NULL)
                 _PD_put_string(1, "%s\001%s\001%s\001\n",
                                hp->name, desc->member, desc->cast_memb);};
/*                                dp->type, desc->member, desc->cast_memb);}; */

     _PD_put_string(1, "\002\n");};

/* write out the major order */
    _PD_put_string(1, "Major-Order:%d\n", file->major_order);

/* write out the previous file name (family) */
    if (file->previous_file != NULL)
       {_PD_put_string(1, "Previous-File:%s\n", file->previous_file);};

/* write out the directory indicator flag */
    has_dirs = PD_has_directories(file);
    _PD_put_string(1, "Has-Directories:%d\n", has_dirs);

    _PD_put_string(1, "Dynamic Spaces:%ld\n", file->n_dyn_spaces);

/* write out the primitives */
    _PD_rev_chrt(file);

    _PD_wr_prim_extras(fp, file->chart, '\001', '\002');

    _PD_rev_chrt(file);

/* write out the blocks - this MUST follow at least the Major-Order extra
 * or else the read may improperly reconstruct the dimensions
 */
    {long i, j, n, sz;
     syment *ep;
     hashel *hp, **tb;
     HASHTAB *tab;

     _PD_put_string(1, "Blocks:\n");
     tab = file->symtab;
     sz  = tab->size;
     tb  = tab->table;
     for (i = 0L; i < sz; i++)
         for (hp = tb[i]; hp != NULL; hp = hp->next)
             {ep = (syment *) hp->def;
              n  = PD_n_blocks(ep);
              if (n > 1)
                {symblock *sp;

                 sp = PD_entry_blocks(ep);
                 _PD_put_string(1, "%s\001%ld", hp->name, n);
                 for (j = 0L; j < n; j++)
                     {if ((j > 0) && ((j % 50) == 0))
                         _PD_put_string(1, "\n");
#ifdef _LARGE_FILES
                      _PD_put_string(1, " %lld %ld",
#else
                      _PD_put_string(1, " %ld %ld",
#endif
				     sp[j].diskaddr, sp[j].number);};

                 _PD_put_string(1, "\n");};};

     _PD_put_string(1, "\002\n");};

/* pad the end of the file with some newlines to smooth over the
 * end of binary file problems on different (ie CRAY) systems
 */
    _PD_put_string(1, "\n\n");

/* write the symbol table and the extras table to the file now */

    pio_write(_PD_TBUFFER(_t_index), 1, strlen(_PD_TBUFFER(_t_index)), fp);
    pio_flush(fp);
    SFREE(_PD_TBUFFER(_t_index));

    return(TRUE);}

/*--------------------------------------------------------------------------*/

/*                     PRIMITIVE TYPE I/O ROUTINES                          */

/*--------------------------------------------------------------------------*/

/* _PD_RD_PRIM_EXTRAS - read the primitive types from the extras table */

void _PD_rd_prim_extras(file, dc, rec, bf)
   PDBfile *file;
   int dc, rec;
   char *bf;
   {char *token, *type, delim[10], *s;
    int align, flg;
    long i, size, conv;
    int *ordr, unsgned, onescmp;
    long *formt;
    SC_THREAD_ID(_t_index);

    sprintf(delim, "%c\n", dc);

    if (bf != NULL)
       _PD_get_token(bf, LOCAL(_t_index), LRG_TXT_BUFFER, '\n');

    while (_PD_get_token(NULL, LOCAL(_t_index), LRG_TXT_BUFFER, '\n'))
       {if (*LOCAL(_t_index) == rec)
           break;
        type  = SC_strsavef(SC_strtok(LOCAL(_t_index), delim, s),
                            "char*:_PD_RD_PRIM_EXTRAS:type");
        size    = SC_stol(SC_strtok(NULL, delim, s));
        align   = SC_stol(SC_strtok(NULL, delim, s));
        flg     = SC_stol(SC_strtok(NULL, delim, s));
        ordr    = NULL;
        formt   = NULL;
        unsgned = FALSE;
        onescmp = FALSE;
        conv    = TRUE;

        token = SC_strtok(NULL, delim, s);
        if (strcmp(token, "ORDER") == 0)
           {ordr = FMAKE_N(int, size, "_PD_RD_PRIM_EXTRAS:order");
            for (i = 0L; i < size; i++)
                ordr[i] = SC_stol(SC_strtok(NULL, delim, s));};
                    
        token = SC_strtok(NULL, delim, s);
        if (strcmp(token, "FLOAT") == 0)
           {formt = FMAKE_N(long, 8, "_PD_RD_PRIM_EXTRAS:format");
            for (i = 0L; i < 8; i++)
                formt[i] = SC_stol(SC_strtok(NULL, delim, s));}

        else if (strcmp(token, "NO-CONV") == 0)
           conv = FALSE;

        token = SC_strtok(NULL, delim, s);
        if (token != NULL)
           if ((strcmp(token, "UNSGNED") == 0))
              {unsgned = SC_stol(SC_strtok(NULL, delim, s));
               token = SC_strtok(NULL, delim, s);}

        if (token != NULL)
           if ((strcmp(token, "ONESCMP") == 0))
              {unsgned = SC_stol(SC_strtok(NULL, delim, s));
               token = SC_strtok(NULL, delim, s);}

        if (conv == FALSE)
           _PD_defstr(file->host_chart, type, align, size, flg, FALSE,
                      ordr, formt, unsgned, onescmp);

        _PD_defstr(file->chart, type, align, size, flg, TRUE, ordr, formt,
                   unsgned, onescmp);

        SFREE(type);};

    return;}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_WR_PRIM_EXTRAS - write the primitive data types from the given
 *                    - structure chart in a form suitable to the
 *                    - extras table
 */

void _PD_wr_prim_extras(fp, tab, dc, rec)
   FILE *fp;
   HASHTAB *tab;
   int dc, rec;
   {long i, n;
    hashel *hp, **tb;
    defstr *dp;
    long *formt;
    int *ordr;

    _PD_put_string(1, "Primitive-Types:\n");

    tb = tab->table;
    for (hp = *tb; hp != NULL; hp = hp->next)
        {dp = (defstr *) hp->def;
         if (dp->members != NULL)
            continue;

/* use hp->name instead of dp->type or PD_typedef's won't work!!! */
         _PD_put_string(1, "%s%c%ld%c%d%c%d%c",
			hp->name, dc,
			dp->size, dc,
			dp->alignment, dc,
			dp->order_flag, dc);

/* write the byte order */
         ordr = dp->order;
         if (ordr !=  NULL)
            {_PD_put_string(1, "ORDER%c", dc);
             n = dp->size;
             for (i = 0L; i < n; i++)
                 _PD_put_string(1, "%d%c", ordr[i], dc);}
         else
            _PD_put_string(1, "DEFORDER%c", dc);

/* write the floating point format */
         formt = dp->format;
         if (formt != NULL)
            {_PD_put_string(1, "FLOAT%c", dc);
             for (i = 0L; i < 8; i++)
                 _PD_put_string(1, "%ld%c", formt[i], dc);}

         else if (dp->order_flag == -1)
            _PD_put_string(1, "NO-CONV%c", dc);

         else
            _PD_put_string(1, "FIX%c", dc);

/* write the unsgned flag */
         _PD_put_string(1, "UNSGNED%c", dc);
         _PD_put_string(1, "%d%c", dp->unsgned, dc);

/* write the ones complement flag */
         _PD_put_string(1, "ONESCMP%c", dc);
         _PD_put_string(1, "%d%c", dp->onescmp, dc);

         _PD_put_string(1, "\n");};

    _PD_put_string(1, "%c\n", rec);

    return;}

/*--------------------------------------------------------------------------*/

/*                            SUPPORT ROUTINES                              */

/*--------------------------------------------------------------------------*/

/* _PD_E_INSTALL - install a syment in the given hash table */

void _PD_e_install(name, entr, tab, lookup)
   char *name;
   syment *entr;
   HASHTAB *tab;
   int lookup;
   {syment *ep;

/* we can leak a lot of memory if we don't check this!! */
    if (lookup)
       {ep = (syment *) SC_def_lookup(name, tab);
        if (ep != NULL)
           {SC_hash_rem(name, tab);
            _PD_rl_syment_d(ep);};};

    _SC_install(name, entr, PD_SYMENT_S, tab, TRUE, FALSE);

    return;}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_D_INSTALL - install a defstr in the given hash table */

void _PD_d_install(name, def, tab)
   char *name;
   defstr *def;
   HASHTAB *tab;
   {defstr *dp;
    hashel *hp;

/* we can leak a lot of memory if we don't check this!! */
/* purify complains of free memory read if hp->def not nulled before SC_hash_rem */
    hp = SC_lookup(name, tab);
    dp = (hp != NULL) ? (defstr *) hp->def : NULL;
    if (dp != NULL)
       {if (strcmp(name, dp->type) == 0)
	   {_PD_rl_defstr(dp);
	    hp->def = NULL;};
        SC_hash_rem(name, tab);};

    SC_install(name, def, PD_DEFSTR_S, tab);

    return;}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_DEFSTR - primitive defstruct used to install the primitive types
 *            - in the specified chart
 */

static defstr *_PD_defstr(chart, name, align, sz, flg, conv,
			  ordr, formt, unsgned, onescmp)
   HASHTAB *chart;
   char *name;
   int align;
   long sz;
   int flg, conv, *ordr;
   long *formt;
   int unsgned, onescmp;
   {defstr *dp;

    dp = _PD_mk_defstr(chart, name, NULL, sz, align, flg, conv,
		       ordr, formt, unsgned, onescmp);
    _PD_d_install(name, dp, chart);

    return(dp);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_DEFSTR_INST - install the defstr in both charts
 *                 - if FLAG is TRUE return the file defstr
 *                 - if FLAG is FALSE return the file host_chart defstr
 */

defstr *_PD_defstr_inst(name, desc, flg, ordr, formt,
                        chrt, host_chart, align, host_align, flag)
   char *name;
   memdes *desc;
   int flg, *ordr;
   long *formt;
   HASHTAB *chrt, *host_chart;
   data_alignment *align, *host_align;
   int flag;
   {int algn, conv;
    long sz;
    defstr *dp, *Sdp;
    memdes *pd, *memb;

    if (desc == NULL)
       return(NULL);

    dp = flag ? PD_inquire_table_type(chrt, name) :
                PD_inquire_table_type(host_chart, name);
    if (dp != NULL)
       return(dp);

/* install the type in the file->chart */
    sz   = _PD_str_size(desc, chrt);
    conv = FALSE;
    algn = align->struct_alignment;
    for (pd = desc; pd != NULL; pd = pd->next)
        {dp = PD_inquire_table_type(chrt, pd->base_type);
         if (_PD_indirection(pd->type) || (dp == NULL))
            {algn = max(algn, align->ptr_alignment);
	     conv = TRUE;}
         else
            {algn  = max(algn, dp->alignment);
             conv |= (dp->convert > 0);};

/* in case we are installing this defstr having read it from
 * another file (as in a copy type operation) redo the cast offsets
 */
         if (pd->cast_memb != NULL)
            pd->cast_offs = _PD_member_location(pd->cast_memb,
						chrt,
						dp,
						&memb);};

    dp = _PD_mk_defstr(chrt, name, desc, sz, algn, flg,
		       conv, ordr, formt, FALSE, FALSE);
    _PD_d_install(name, dp, chrt);

/* install the type in the host_chart */
    desc = PD_copy_members(desc);
    sz   = _PD_str_size(desc, host_chart);

    algn = host_align->struct_alignment;
    for (pd = desc; pd != NULL; pd = pd->next)
        {dp = PD_inquire_table_type(host_chart, pd->base_type);
         if (_PD_indirection(pd->type) || (dp == NULL))
            algn = max(algn, host_align->ptr_alignment);
         else
            algn = max(algn, dp->alignment);

/* in case we are installing this defstr having read it from
 * another file (as in a copy type operation) redo the cast offsets
 */
         if (pd->cast_memb != NULL)
            pd->cast_offs =  _PD_member_location(pd->cast_memb,
						 host_chart,
						 dp,
						 &memb);};

/* NOTE: ordr, formt, and conv apply only to the file chart
 *       never to the host chart!!!
 *       these are for non-default primitive types which
 *       have no host representation
 */
    Sdp = _PD_mk_defstr(host_chart, name, desc, sz, algn, -1,
			FALSE, NULL, NULL, FALSE, FALSE);
    _PD_d_install(name, Sdp, host_chart);

    return(flag ? dp : Sdp);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PD_TYPEDEF_PRIMITIVE_TYPES - make typedefs for user-defined primitives
 *                            - in the file chart
 */

void PD_typedef_primitive_types(file)
   PDBfile *file;
   {hashel *hp;
    defstr *dp, *ndp;
    char *type;

    for (hp = file->chart->table[0]; hp != NULL; hp = hp->next)
        {dp   = (defstr *) hp->def;
	 type = dp->type;
	 if (PD_inquire_host_type(file, type) == NULL)
	    {ndp = _PD_container_type(file, dp);
	     if (ndp != NULL)
	        PD_typedef(file, ndp->type, type);};};

    return;}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_CONTAINER_TYPE - return the smallest container type in which the
 *                    - specified user-defined primitive type will fit
 *                    - if the specified type is a struct or one of the
 *                    - standard primitive types, return NULL
 */

defstr *_PD_container_type(file, dp)
   PDBfile *file;
   defstr *dp;   
   {char *type;
    defstr *ndp;
    int i, n;
    long size;
    static char *std_types[] = { "REAL", "*", "char", "short", "int",
				 "integer", "long", "float", "double",
				 "function", "Directory" };

    ndp  = NULL;

    if ((dp == NULL) || (dp->members != NULL))
       return(ndp);

    type = dp->type;
    n    = sizeof(std_types)/sizeof(char *);
    for (i = 0; i < n; i++)
        if (strncmp(type, std_types[i], strlen(std_types[i])) == 0)
	   return(ndp);

    size = dp->size;
    if (dp->format != NULL)
       {if (size <= sizeof(float))
	   ndp = PD_inquire_host_type(file, "float");
        else if (size <= sizeof(double))
	   ndp = PD_inquire_host_type(file, "double");}

    else if ((dp->format == NULL) && (dp->order_flag != -1))
       {if (size <= sizeof(char))
	   ndp = PD_inquire_host_type(file, "char");
        else if (size <= sizeof(short))
	   ndp = PD_inquire_host_type(file, "short");
        else if (size <= sizeof(int))
	   ndp = PD_inquire_host_type(file, "int");
        else if (size <= sizeof(long))
	   ndp = PD_inquire_host_type(file, "long");};

    return(ndp);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_ADD_BLOCK - add a new block to an entry
 *               - this does nothing to the file, only the syment
 *               - the file extension operations are left to _PD_write
 *               - or to _PD_defent
 */

int _PD_add_block(file, ep, dims, addr)
   PDBfile *file;
   syment *ep;
   dimdes *dims;
   off_t addr;
   {symblock *sp;
    int n;
    long bytespitem;
    SC_THREAD_ID(_t_index);

    if (!_PD_consistent_dims(file, ep, dims))
       PD_error("INCONSISTENT DIMENSION CHANGE - _PD_ADD_BLOCK", PD_WRITE);

    bytespitem = _PD_lookup_size(PD_entry_type(ep), file->chart);

    sp = PD_entry_blocks(ep);
    n  = PD_n_blocks(ep);
    REMAKE_N(sp, symblock, n+1);

    sp[n].number   = _PD_comp_num(dims);

#ifdef HAVE_THREADS
    file->chrtaddr = addr;
    pio_seek(file->stream, addr+(sp[n].number*bytespitem), SEEK_SET);
#endif

    sp[n].diskaddr = addr;
    PD_entry_blocks(ep) = sp;

/* we are through with the dimensions
 * their information has been moved into the entry dimensions
 */
    _PD_rl_dimensions(dims);

    return(_PD_extend_file(file, sp[n].number*bytespitem));}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_EXTEND_FILE - extend the file by the given number of bytes */

int _PD_extend_file(file, nb)
   PDBfile *file;
   long nb;
   {FILE *fp;
    off_t addr;
    char bf[1];
    SC_THREAD_ID(_t_index);

    fp   = file->stream;
    addr = file->chrtaddr + nb;

/* expand the file or the space will not be there */
#ifndef HAVE_THREADS
    if (pio_seek(fp, addr, SEEK_SET))
       {sprintf(PD_ERR(_t_index), "ERROR: FSEEK FAILED - _PD_EXTEND_FILE");
        return(FALSE);};
#endif

    bf[0] = ' ';
    nb    = pio_write(bf, (size_t) 1, (size_t) 1, fp);
    if (nb != 1L)
       {sprintf(PD_ERR(_t_index), "ERROR: CAN'T SET FILE SIZE - _PD_EXTEND_FILE");
        return(FALSE);};

    file->chrtaddr = addr;

    return(TRUE);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_GET_NEXT_ADDRESS - reserve the appropriate amount of space in FILE
 *                      - defined by TYPE, NUMBER, and VR
 *                      - and return the starting address of it
 *                      - in threaded mode seek to the appropriate
 *                      - place in the file iff SEEKF is TRUE
 *                      - in non-threaded mode use tell to specify
 *                      - the available address iff TELLF is TRUE
 */

off_t _PD_get_next_address(file, type, number, vr, seekf, tellf)
   PDBfile *file;
   char *type;
   long number;
   byte *vr;
   int seekf, tellf;
   {off_t addr;
    FILE *fp;
    SC_THREAD_ID(_t_index);

    fp = file->stream;

#ifdef HAVE_THREADS

    {size_t nb, bpi;

     if (vr == NULL)
        {bpi  = _PD_lookup_size(type, file->chart);
	 nb   = number*bpi;
	 addr = _PD_pfm_getspace(file, nb);

	 if (seekf)
	    pio_seek(fp, addr+nb, SEEK_SET);}

     else
        {nb   =  PD_sizeof(file, type, number, vr);
	 addr = _PD_pfm_getspace(file, nb);};};

#else

    if (tellf)
       addr = io_tell(fp);
    else
       addr = file->chrtaddr;

#endif

    return(addr);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_EOD - mark the end of data in the file
 *         - that is set the chart address to the current file position
 */

off_t _PD_eod(file)
   PDBfile *file;
   {off_t addr;

    FILE *fp;
     off_t old, new;
     SC_THREAD_ID(_t_index);

     fp  = file->stream;
     old = file->chrtaddr;
     new = pio_tell(fp);

     addr = max(old, new);

#ifdef HAVE_THREADS

    addr = _PD_pfm_getspace(file, 0);

#else


#endif

    return(addr);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_CONSISTENT_DIMS - check two sets of dimensions for consistency of
 *                     - the non-changing sector and proper updating of
 *                     - the changing dimension
 */
   
static int _PD_consistent_dims(file, ep, ndims)
   PDBfile *file;
   syment *ep;
   dimdes *ndims;
   {dimdes *odims, *od, *nd;

    odims = PD_entry_dimensions(ep);

/* check the dimensions for consistency */
    if (file->major_order == COLUMN_MAJOR_ORDER)
       {for (od = odims, nd = ndims;
	     (od != NULL) && (nd != NULL) && (nd->next != NULL);
	     od = od->next, nd = nd->next)
            {if ((od->index_min != nd->index_min) ||
                 (od->index_max != nd->index_max) ||
                 (od->number != nd->number))
                return(FALSE);};}

    else if (file->major_order == ROW_MAJOR_ORDER)
       {for (od = odims->next, nd = ndims->next;
             (od != NULL) && (nd != NULL);
	     od = od->next, nd = nd->next)
            {if ((od->index_min != nd->index_min) ||
                 (od->index_max != nd->index_max) ||
                 (od->number != nd->number))
                return(FALSE);};

        nd = ndims;
        od = odims;};

    if (nd->index_min == file->default_offset)
       od->index_max += nd->index_max - nd->index_min + 1;

    else if (nd->index_min == od->index_max + 1L)
       od->index_max = nd->index_max;

    else
       return(FALSE);

    od->number = od->index_max - od->index_min + 1L;

    PD_entry_number(ep) = _PD_comp_num(odims);

    return(TRUE);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_RFGETS - our fgets looks for specified line separator in addition to
 *            - the given system version
 *            - it is also guaranteed to not split tokens in the input
 *            - stream
 */

char *_PD_rfgets(s, n, fp)
   char *s;
   int n;
   FILE *fp;
   {return(_PD_get_tok(s, n, fp, '\n'));}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_GET_TOK - an fgets clone looks for specified char in addition to
 *             - the newline
 *             - it is also guaranteed to not split tokens in the input
 *             - stream
 */

static char *_PD_get_tok(s, n, fp, ch)
   char *s;
   int n;
   FILE *fp;
   int ch;
   {int i, c, LineSep;
    long nb;
    off_t loc;
    char *ps;
    SC_THREAD_ID(_t_index);

/* this is for old NLTSS generated files - sigh! */
    LineSep = 0x1f;
    
/* find the current location and remember it */
    loc = pio_tell(fp);
    nb  = pio_read(s, (size_t) 1, (size_t) n, fp);
    ps  = s;

/* check for EOF and reset the file pointer if at EOF */
    if (((c = *(ps++)) == EOF) || (nb == 0))
       {pio_seek(fp, loc, SEEK_SET);
        *s = '\0';
        return(NULL);};
    ps--;

/* search for \n, EOF, LineSep, or given delimiter */
    n = nb - 1;
    for (i = 0; i < n; i++)
        {c = *(ps++);
         if ((c == '\n') || (c == LineSep) || (c == ch))
            {ps--;
             *ps++ = '\0';
             loc += (long) (ps - s);
             break;}
         else if (c == EOF)
            {ps--;
             *ps++ = '\0';
             loc += (long) (ps - s + 1);
             break;};};

/* if we got a full buffer backup to the last space so as to not split
 * a token
 */
   if ((i >= n) && (c != '\n') && (c != LineSep) && (c == ch))
      {ps--;
       n >>= 1;
       for (; i > n; i--)
           {c = *(--ps);
            loc--;
	    if ((c == '\t') || (c == ' '))
               {*ps = '\0';
                break;};};};

/* reset the file pointer to the end of the string */
    pio_seek(fp, loc, SEEK_SET);

    return(s);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_GET_TOKEN - get a token from a buffer which is handled like strtok
 *               - each time BF is non-NULL it is remembered for the next
 *               - call
 *               - the return buffer is handled like fgets with the space
 *               - and maximum size being passed in
 *               - this function is guaranteed to not split tokens in the
 *               - input buffer
 */

static char *_PD_get_token(bf, s, n, ch)
   char *bf, *s;
   int n;
   int ch;
   {int i, c;
    char *ps;

/* this is for old NLTSS generated files - sigh! */
    static int LineSep = 0x1f;
    SC_THREAD_ID(_t_index);

    if (bf != NULL)
       TBF(_t_index) = bf;

    ps = s;

/* check for EOF and reset the file pointer if at EOF */
    c = *ps++ = *TBF(_t_index)++;
    if ((c == EOF) || (n == 0))
       {TBF(_t_index)--;
        *s = '\0';
        return(NULL);};
    ps--;
    TBF(_t_index)--;

/* search for \n, EOF, LineSep, or given delimiter */
    n--;
    for (i = 0; i < n; i++)
        {c = *ps++ = *TBF(_t_index)++;
         if ((c == '\n') || (c == LineSep) || (c == ch))
            {ps--;
             *ps++ = '\0';
             break;}
         else if (c == EOF)
            {ps--;
             TBF(_t_index)--;
             *ps++ = '\0';
             break;};};

/* if we got a full buffer backup to the last space so as to not split
 * a token
 */
   if ((i >= n) && (c != '\n') && (c != LineSep) && (c == ch))
      {ps--;
       TBF(_t_index)--;
       n >>= 1;
       for (; i > n; i--)
           {c = *(--ps) = *(--TBF(_t_index));
	    if ((c == '\t') || (c == ' '))
               {*ps = '\0';
                break;};};};

    return(s);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_GET_TBUFFER - Return a copy of the current output buffer
 *
 */

char *_PD_get_tbuffer()
   {char *ret;
    SC_THREAD_ID(_t_index);    

    ret = FMAKE_N(char, strlen(_PD_TBUFFER(_t_index) + 1),
                  "_PD_GET_TBUFFER:ret");
    strcpy(ret, _PD_TBUFFER(_t_index));

    return(ret);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_PUT_STRING - build up the contents of the current output buffer
 *                - in an fprintf style
 */

#ifdef PCC

static int _PD_put_string(reset, fmt, va_alist)
   int reset;
   char *fmt;
   va_dcl

#endif

#ifdef ANSI

static int _PD_put_string(int reset, char *fmt, ...)

#endif

   {long ns;
    char s[MAXLINE];
    SC_THREAD_ID(_t_index);    

    SC_VA_START(fmt);
    SC_VSPRINTF(s, fmt);
    SC_VA_END;

    ns = strlen(s);

    if (_PD_TBUFFER(_t_index) == NULL)
       {NCX(_t_index) = BUFINCR;
	_PD_TBUFFER(_t_index) = FMAKE_N(char, NCX(_t_index), "_PD_PUT_STRING:tbuffer");
	SPL(_t_index) = _PD_TBUFFER(_t_index);
        NC(_t_index) = 0;}

    else if (!reset)
       {SPL(_t_index) = _PD_TBUFFER(_t_index);
        NC(_t_index) = 0;
        memset(_PD_TBUFFER(_t_index), 0, NCX(_t_index));};
    
    if (NC(_t_index) + ns >= NCX(_t_index))
       {NCX(_t_index) += BUFINCR;
	REMAKE_N(_PD_TBUFFER(_t_index), char, NCX(_t_index));
	SPL(_t_index) = _PD_TBUFFER(_t_index) + strlen(_PD_TBUFFER(_t_index));};

    strcpy(SPL(_t_index), s);
    SPL(_t_index) += ns;
    NC(_t_index) += ns;

    return(TRUE);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_INIT_CHRT - initialize the charts with the primitives
 *               - NOTE: define both int and integer!!!!!!!!!!!!!!!!!!!!
 */

void _PD_init_chrt(file)
   PDBfile *file;
   {HASHTAB *fchrt, *hchrt;
    defstr *ret, *dp;
    data_standard *fstd, *hstd;
    data_alignment *falign, *halign;

/* if the first time initialize some PDBLib stuff */
    if (PD_DEFSTR_S == NULL)
       {LAST        = FMAKE(int, "_PD_INIT_CHART:LAST");
        *LAST       = 0;

        if (pio_close_hook == (PFfclose) fclose)
            pio_close_hook = (PFfclose) _PD_pio_close;

        if ((pio_seek_hook == (PFfseek) fseek) || 
            (pio_seek_hook == (PFfseek) F_SEEK))
            pio_seek_hook = (PFfseek) _PD_pio_seek;

        if (pio_printf_hook == (PFfprintf) SC_fprintf)
            pio_printf_hook = (PFfprintf) _PD_pio_printf;

        PD_DEFSTR_S = SC_strsavef("defstr *",
                      "char*:_PD_INIT_CHRT:defstr");
        PD_SYMENT_S = SC_strsavef("syment *",
                      "char*:_PD_INIT_CHRT:syment");};

    fchrt  = file->chart;
    fstd   = file->std;
    falign = file->align;

    hchrt  = file->host_chart;
    hstd   = file->host_std;
    halign = file->host_align;

    _PD_setup_chart(fchrt, fstd, hstd, falign, halign, TRUE);
    _PD_setup_chart(hchrt, hstd, NULL, halign, NULL, FALSE);

    if (sizeof(REAL) == sizeof(double))
       PD_typedef(file, "double", "REAL");
    else
       PD_typedef(file, "float", "REAL");

/* NOTE: function MUST be handled this way - PD_DEFNCV does NOT
 *       sequence the two charts properly and death can result
 *       when reading on a different machine, (e.g. 32 bit pointer
 *       in file and 64 bit pointer in host
 */
    ret = PD_inquire_type(file, "function");
    if (ret == NULL)
       {ret = PD_inquire_type(file, "*");
	dp  = _PD_mk_defstr(fchrt, "function", NULL, ret->size, ret->alignment,
			    -1, FALSE, NULL, NULL, FALSE, FALSE);
	if (dp == NULL)
	   PD_error("FILE FUNCTION DEFINITION FAILED - _PD_INIT_CHART",
		    PD_OPEN);

	_PD_d_install("function", dp, fchrt);};

    ret = PD_inquire_host_type(file, "*");
    dp  = _PD_mk_defstr(hchrt, "function", NULL, ret->size, ret->alignment,
			-1, FALSE, NULL, NULL, FALSE, FALSE);
    if (dp == NULL)
       PD_error("HOST FUNCTION DEFINITION FAILED - _PD_INIT_CHART",
		PD_OPEN);

    _PD_d_install("function", dp, hchrt);

    return;}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_SETUP_CHART - setup a structure chart with the conversions selected
 *                 - and the types installed
 */

void _PD_setup_chart(chart, fstd, hstd, falign, halign, flag)
   HASHTAB *chart;
   data_standard *fstd, *hstd;
   data_alignment *falign, *halign;
   int flag;
   {int conv;

    if (flag)
       {PD_COMPARE_PTR_STD(conv, fstd, hstd, falign, halign);}
    else
       conv = FALSE;
    _PD_defstr(chart, "*", falign->ptr_alignment,
	       (long) fstd->ptr_bytes, -1, conv, NULL, NULL, 0, 0);

    if (flag)
       {PD_COMPARE_CHAR_STD(conv, fstd, hstd, falign, halign);}
    else
       conv = FALSE;
    _PD_defstr(chart, "char", falign->char_alignment,
	       1L, -1, conv, NULL, NULL, FALSE, FALSE);

    if (flag)
       {PD_COMPARE_SHORT_STD(conv, fstd, hstd, falign, halign);}
    else
       conv = FALSE;
    _PD_defstr(chart, "short", falign->short_alignment,
	       (long) fstd->short_bytes, fstd->short_order,
	       conv, NULL, NULL, FALSE, FALSE);

    _PD_defstr(chart, "u_short", falign->short_alignment,
	       (long) fstd->short_bytes, fstd->short_order,
	       conv, NULL, NULL, TRUE, FALSE);

    if (flag)
       {PD_COMPARE_INT_STD(conv, fstd, hstd, falign, halign);}
    else
       conv = FALSE;
    _PD_defstr(chart, "int", falign->int_alignment,
	       (long) fstd->int_bytes, fstd->int_order,
	       conv, NULL, NULL, FALSE, FALSE);

    _PD_defstr(chart, "u_int", falign->int_alignment,
	       (long) fstd->int_bytes, fstd->int_order,
	       conv, NULL, NULL, TRUE, FALSE);

    if (flag)
       {PD_COMPARE_INT_STD(conv, fstd, hstd, falign, halign);}
    else
       conv = FALSE;
    _PD_defstr(chart, "integer", falign->int_alignment,
	       (long) fstd->int_bytes, fstd->int_order,
	       conv, NULL, NULL, FALSE, FALSE);

    _PD_defstr(chart, "u_integer", falign->int_alignment,
	       (long) fstd->int_bytes, fstd->int_order,
	       conv, NULL, NULL, TRUE, FALSE);

    if (flag)
       {PD_COMPARE_LONG_STD(conv, fstd, hstd, falign, halign);}
    else
       conv = FALSE;
    _PD_defstr(chart, "long", falign->long_alignment,
	       (long) fstd->long_bytes, fstd->long_order,
	       conv, NULL, NULL, FALSE, FALSE);

    _PD_defstr(chart, "u_long", falign->long_alignment,
	       (long) fstd->long_bytes, fstd->long_order,
	       conv, NULL, NULL, TRUE, FALSE);

    if (flag)
       {PD_COMPARE_LONGLONG_STD(conv, fstd, hstd, falign, halign);}
    else
       conv = FALSE;
    _PD_defstr(chart, "long_long", falign->longlong_alignment,
	       (long) fstd->longlong_bytes, fstd->longlong_order,
	       conv, NULL, NULL, FALSE, FALSE);
    _PD_defstr(chart, "u_long_long", falign->longlong_alignment,
	       (long) fstd->longlong_bytes, fstd->longlong_order,
	       conv, NULL, NULL, TRUE, FALSE);

    if (flag)
       {PD_COMPARE_FLT_STD(conv, fstd, hstd, falign, halign);}
    else
       conv = FALSE;
    _PD_defstr(chart, "float", falign->float_alignment,
	       (long) fstd->float_bytes, -1, conv, fstd->float_order,
	       fstd->float_format, FALSE, FALSE);

    if (flag)
       {PD_COMPARE_DBL_STD(conv, fstd, hstd, falign, halign);}
    else
       conv = FALSE;
    _PD_defstr(chart, "double", falign->double_alignment,
	       (long) fstd->double_bytes, -1, conv, fstd->double_order,
	       fstd->double_format, FALSE, FALSE);

    return;}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_REV_CHRT - reverse the list of structures in the single element hash
 *              - table that makes up the chart
 */

int _PD_rev_chrt(file)
   PDBfile *file;
   {

    SC_REVERSE_LIST(hashel, *(file->chart->table), next);

    return(TRUE);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PD_GET_ERROR - fetch PD_err */

char *PD_get_error()
   {SC_THREAD_ID(_t_index);

    return(PD_ERR(_t_index));}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PD_GET_BUFFER_SIZE - fetch PD_buffer_size */

int PD_get_buffer_size()
   {SC_THREAD_ID(_t_index);

    return(PD_BUFFER_SIZE(_t_index));}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PD_SET_BUFFER_SIZE - set PD_buffer_size */

int PD_set_buffer_size(v)
   int v;
   {SC_THREAD_ID(_t_index);

    return(PD_BUFFER_SIZE(_t_index) = v);}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_LOW_PINIT - initialize the file static variables for
 *                 parallel execution.
 */

void _PD_low_pinit()
  {
#ifdef HAVE_THREADS
   int i;

   if (_PD_low_static == NULL)
      {_PD_low_static = NMAKE_N(FILE_STATIC, _PD_nthreads,
                                "PDLOW.C:_PD_low_static");
       for (i = 0; i < _PD_nthreads; i++)
           {_PD_low_static[i]._PD_n_casts  = 0L;
            _PD_low_static[i]._PD_has_dirs = FALSE;
            _PD_low_static[i].tbf          = NULL;
            _PD_low_static[i]._PD_tbuffer  = NULL;
            _PD_low_static[i].ncx          = 0L;
            _PD_low_static[i].nc           = 0L;
            _PD_low_static[i].spl          = NULL;};}
#endif
    return;}

/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

