/*
 * PDB.C - Portable Data Base Library
 *       - a collection of file manipulation routines with the following
 *       - aims:
 *       -      (1) Portable, therefore written in C
 *       -      (2) Machine Independent, carries information about objects
 *       -          in the file so that the implementation can extract
 *       -          the data even if on a wholely different machine type
 *       -      (3) Simplicity, for ease of implementation and so that
 *       -          linkable modules in another language can use these
 *       -          routines
 *
 * Source Version: 9.0
 * Software Release #92-0043
 *
 */

#include "cpyright.h"

#include "pdb.h"


/* PDB header token to uniquely identify as PDB file */
#define HeadTok              "!<<PDB:II>>!"
#define OldHeadTok           "!<><PDB><>!"
#define PDB_ATTRIBUTE_TABLE  "!pdb_att_tab!"

static int
 _append_flag = FALSE;

int
 PD_DIM = INT_MIN,
 PD_buffer_size = -1;

data_standard
 *REQ_STANDARD = NULL;

data_alignment
 *REQ_ALIGNMENT = NULL;

jmp_buf
 _PD_read_err,
 _PD_write_err,
 _PD_print_err,
 _PD_open_err,
 _PD_trace_err,
 _PD_close_err,
 _PD_create_err;

PFPmemdes
 pdb_wr_hook = NULL,
 pdb_rd_hook = NULL;

PDBfile
 *PD_vif = NULL;

char
 PD_err[MAXLINE];

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

/* PD_OPEN - open an existing PDB file, extract the symbol table and
 *         - structure chart, and return a pointer to the PDB file
 *         - if successful else NULL
 */

PDBfile *PD_open(name, mode)
   char *name, *mode;
   {char str[MAXLINE], *token, *s;
    PDBfile *file;
    static FILE *fp;
    syment *ep;

    file = NULL;

/* if opened in write mode use PD_CREATE instead */
    if (*mode == 'w')
       return(PD_create(name));

    switch (setjmp(_PD_open_err))
       {case ABORT    : io_close(fp);
                        return(NULL);
        case ERR_FREE : return(file);
        default       : memset(PD_err, 0, MAXLINE);
                        break;};

/* open the file */
    strcpy(str, name);

    fp = io_open(str, BINARY_MODE_RPLUS);
    if (fp == NULL)
       {if (*mode == 'r')
           {fp = io_open(str, BINARY_MODE_R);
            if (fp == NULL)
               PD_error("CAN'T OPEN FILE IN READ-ONLY MODE - PD_OPEN",
                        PD_OPEN);}
        else if (*mode == 'a')
	   return(PD_create(name));
        else
           PD_error("CAN'T OPEN FILE - PD_OPEN", PD_OPEN);};

    if (PD_buffer_size != -1)
       if (io_setvbuf(fp, NULL, _IOFBF, (size_t) PD_buffer_size))
          PD_error("CAN'T SET FILE BUFFER - PD_OPEN", PD_OPEN);

    file = _PD_mk_pdb(str);
    if (file == NULL)
       PD_error("CAN'T ALLOCATE PDBFILE - PD_OPEN", PD_OPEN);

    file->stream = fp;
    if (*mode == 'a')
       file->mode = PD_APPEND;
    else
       file->mode = PD_OPEN;

/* attempt to read an ASCII header */
    if (io_seek(fp, 0L, SEEK_SET))
       PD_error("FSEEK FAILED TO FIND ORIGIN - PD_OPEN", PD_OPEN);
    if (_PD_rfgets(str, MAXLINE, fp) == NULL)
       PD_error("CAN'T READ THE FILE HEADER - PD_OPEN", PD_OPEN);

/* the first token should be the identifying header token */
    token = SC_strtok(str, " ", s);
    if (token == NULL)
       PD_error("FILE HEADER NOT ASCII - PD_OPEN", PD_OPEN);

/* check for a PDB_SYSTEM_VERSION 2 or later style file */
    if (strcmp(token, HeadTok) == 0)

/* read the primitive data type formats which set the standard */
       {if (!_PD_rd_format(file))
           PD_error("FAILED TO READ FORMATS - PD_OPEN", PD_OPEN);}

/* check for an pre-PDB_SYSTEM_VERSION 2 style file */
    else if (strcmp(token, OldHeadTok) == 0)

/* the second token is the machine type that wrote the file
 * set the file->std for machine type
 * for PD_open the file->std is always the PDBfile standard
 * alignment issues are not properly handled before PDB_SYSTEM_VERSION 3
 * but do the best that we can
 */
       {token = SC_strtok(NULL, " ", s);
        if (token == NULL)
           PD_error("INCOMPLETE HEADER - PD_OPEN", PD_OPEN);
        switch (atoi(token))
           {case IEEE_32_64 : file->std   = _PD_copy_standard(&IEEEA_STD);
                              file->align = _PD_copy_alignment(&M68000_ALIGNMENT);
                              break;
            case IEEE_32_96 : file->std   = _PD_copy_standard(&IEEEB_STD);
                              file->align = _PD_copy_alignment(&M68000_ALIGNMENT);
                              break;
            case INTEL_X86  : file->std   = _PD_copy_standard(&INTELA_STD);
                              file->align = _PD_copy_alignment(&INTELA_ALIGNMENT);
                              break;
            case CRAY_64    : file->std   = _PD_copy_standard(&CRAY_STD);
                              file->align = _PD_copy_alignment(&UNICOS_ALIGNMENT);
                              break;
            case VAX_11     : file->std   = _PD_copy_standard(&VAX_STD);
                              file->align = _PD_copy_alignment(&DEF_ALIGNMENT);
                              break;
            default         : file->std   = _PD_copy_standard(&DEF_STD);
                              file->align = _PD_copy_alignment(&DEF_ALIGNMENT);
                              break;};

/* to correctly handle the situation in which many PDBfiles are open
 * at the same time always try to latch on to the file->host_std
 * alignment issues are not properly handled before PDB_SYSTEM_VERSION 3
 * but do the best that we can
 */
        if (_PD_compare_std(file->host_std, file->std,
                            file->host_align, file->align))
           {_PD_rl_standard(file->std);
	    file->std   = _PD_copy_standard(file->host_std);
	    _PD_rl_alignment(file->align);
            file->align = _PD_copy_alignment(file->host_align);};}
    else
       PD_error("BAD FILE HEADER - PD_OPEN", PD_OPEN);

/* record the current file position as the location of the symbol table
 * address and sequentially the chart address
 */
    file->headaddr = io_tell(fp);
    if (file->headaddr == -1L)
       PD_error("CAN'T FIND HEADER ADDRESS - PD_OPEN", PD_OPEN);

/* read the address of the symbol table and structure chart */
    if (_PD_rfgets(str, MAXLINE, fp) == NULL)
       PD_error("CAN'T READ SYMBOL TABLE ADDRESS - PD_OPEN", PD_OPEN);

    token = SC_strtok(str, "\001", s);
    if (token == NULL)
       PD_error("BAD STRUCTURE CHART ADDRESS - PD_OPEN", PD_OPEN);
    file->chrtaddr = atol(token);

    token = SC_strtok(NULL, "\001", s);
    if (token == NULL)
       PD_error("BAD SYMBOL TABLE ADDRESS - PD_OPEN", PD_OPEN);
    file->symtaddr = atol(token);

/* read the symbol table first so that the file pointer is positioned
 * to the "extra" information, then read the "extra's" to get the
 * alignment data, and finish with the structure chart which needs
 * the alignment data
 */

/* read the symbol table */
    if (io_seek(fp, file->symtaddr, SEEK_SET))
       PD_error("FSEEK FAILED SYMBOL TABLE - PD_OPEN", PD_OPEN);
    if (!_PD_rd_symt(file))
       PD_error("CAN'T READ SYMBOL TABLE - PD_OPEN", PD_OPEN);

/* read the miscellaneous data */
    if (!_PD_rd_extras(file))
       PD_error("CAN'T READ MISCELLANEOUS DATA - PD_OPEN", PD_OPEN);

/* initialize the pdb system defs and structure chart */
    _PD_init_chrt(file);

/* read the structure chart */
    if (io_seek(fp, file->chrtaddr, SEEK_SET))
       PD_error("FSEEK FAILED STRUCTURE CHART - PD_OPEN", PD_OPEN);
    if (!_PD_rd_chrt(file))
       PD_error("CAN'T READ STRUCTURE CHART - PD_OPEN", PD_OPEN);

    ep = PD_inquire_entry(file, PDB_ATTRIBUTE_TABLE, TRUE, NULL);
    if (ep != NULL)
       {if (!PD_read(file, PDB_ATTRIBUTE_TABLE, &file->attrtab))
           {PD_close(file);
            PD_error("FAILED TO READ ATTRIBUTE TABLE - PD_OPEN", PD_OPEN);};
	_PD_convert_attrtab(file);
        file->chrtaddr = PD_entry_address(ep);
        _PD_rl_syment(ep);

        if (!SC_hash_rem(_PD_fixname(file, PDB_ATTRIBUTE_TABLE), file->symtab))
	   SC_hash_rem(PDB_ATTRIBUTE_TABLE, file->symtab);}

    else
       file->attrtab = NULL;

/* position the file pointer to the location of the structure chart */
    if (io_seek(fp, file->chrtaddr, SEEK_SET))
       PD_error("FSEEK FAILED CHART - PD_OPEN", PD_OPEN);

    return(file);}

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

/* PD_FAMILY - return the next member of the file family if the given
 *           - file excedes its maximum size
 */

PDBfile *PD_family(of, flag)
   PDBfile *of;
   int flag;
   {PDBfile *nf;
    FILE *fp;
    hashel *hp;
    defstr *dp;
    memdes *lst;
    long msz, csz;
    char name[MAXLINE];

/* if the size is effectively infinite stop ASAP */
    msz = PD_get_max_file_size(of);
    if (msz == LONG_MAX)
       return(of);

    fp  = of->stream;
    csz = SC_filelen(fp);    
    if (msz < csz)
       {strcpy(name, of->name);
        SC_advance_name(name);

/* create the new file - being sure to get the target right */
        REQ_STANDARD  = of->std;
        REQ_ALIGNMENT = of->align;
        nf = PD_open(name, "w");
        PD_set_max_file_size(nf, msz);

        nf->previous_file = SC_strsavef(of->name, "char*:PD_FAMILY:fname");

/* copy the types over */
	for (hp = of->chart->table[0]; hp != NULL; hp = hp->next)
	    {dp  = (defstr *) (hp->def);
             lst = PD_copy_members(dp->members);
	     _PD_defstr_inst(dp->type, lst, -1, NULL, NULL,
			     nf->chart, nf->host_chart,
			     nf->align, nf->host_align,
			     FALSE);};

/* copy the attributes over? */

/* close the old file */
        if (flag)
           PD_close(of);}

    else
       nf = of;

    return(nf);}

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

/* PD_CREATE - create a PDB file and return an initialized PDBfile
 *           - if successful else NULL
 */

PDBfile *PD_create(name)
   char *name;
   {int nstr;
    char str[MAXLINE];
    PDBfile *file;
    static FILE *fp;

    file = NULL;

    switch (setjmp(_PD_create_err))
       {case ABORT    : io_close(fp);
                        return(NULL);
        case ERR_FREE : return(file);
        default       : memset(PD_err, 0, MAXLINE);
                        break;};

/* open the file */
    strcpy(str, name);
        
    fp = io_open(str, BINARY_MODE_WPLUS);

    if (fp == NULL)
       PD_error("CAN'T CREATE FILE - PD_CREATE", PD_CREATE);

    if (PD_buffer_size != -1)
       if (io_setvbuf(fp, NULL, _IOFBF, (size_t) PD_buffer_size))
          PD_error("CAN'T SET FILE BUFFER - PD_CREATE", PD_OPEN);

/* make the PDBfile */
    file = _PD_mk_pdb(str);
    if (file == NULL)
       PD_error("CAN'T ALLOCATE PDBFILE - PD_CREATE", PD_OPEN);

    file->stream = fp;
    file->mode   = PD_CREATE;

/* set the file data conversion standard - and yes someone might pick
 * a target standard which is the current standard
 */
    file->std   = _PD_copy_standard(file->host_std);
    file->align = _PD_copy_alignment(file->host_align);
    if (REQ_STANDARD != NULL)
       {if (!_PD_compare_std(REQ_STANDARD, file->std,
                             REQ_ALIGNMENT, file->align))
           {_PD_rl_standard(file->std);
	    file->std   = _PD_copy_standard(REQ_STANDARD);
	    _PD_rl_alignment(file->align);
            file->align = _PD_copy_alignment(REQ_ALIGNMENT);};

        REQ_STANDARD = NULL;};

/* write the ASCII header */
    io_printf(fp, "%s\n", HeadTok);
    if (io_flush(fp))
       PD_error("FFLUSH FAILED BEFORE HEADER - PD_CREATE", PD_CREATE);

/* write the primitive data type formats */
    if (!_PD_wr_format(file))
       PD_error("FAILED TO WRITE FORMATS - PD_CREATE", PD_CREATE);

/* record the current file position as the location of the symbol table
 * address and sequentially the chart address
 */
    if ((file->headaddr = io_tell(fp)) == -1L)
       PD_error("CAN'T FIND HEADER ADDRESS - PD_CREATE", PD_CREATE);

    sprintf(str, "%22ld\001%22ld\001\n", 0L, 0L);
    nstr = strlen(str);

    if (io_write(str, (size_t) 1, nstr, fp) != nstr)
       PD_error("FAILED TO WRITE ADDRESSES - PD_CREATE", PD_CREATE);

    file->chrtaddr = file->headaddr + nstr;

    if (io_flush(fp))
       PD_error("FFLUSH FAILED AFTER HEADER - PD_CREATE", PD_CREATE);

/* initialize the pdb system defs and structure chart */
    _PD_init_chrt(file);

    if (io_seek(fp, file->chrtaddr, SEEK_SET))
       PD_error("FAILED TO FIND START OF DATA - PD_CREATE", PD_CREATE);

    file->system_version = PDB_SYSTEM_VERSION;
    file->date           = SC_date();

    return(file);}

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

/* PD_OPEN_VIF - open a virtual internal PDB file
 *             - return the VIF iff successful
 */

PDBfile *PD_open_vif(name)
   char *name;
   {PDBfile *file;

    file                   = _PD_mk_pdb(name);
    file->system_version   = PDB_SYSTEM_VERSION;
    file->date             = SC_date();
    file->virtual_internal = TRUE;

    file->std   = _PD_copy_standard(file->host_std);
    file->align = _PD_copy_alignment(file->host_align);
    if (REQ_STANDARD != NULL)
       {if (!_PD_compare_std(REQ_STANDARD, file->std,
                             REQ_ALIGNMENT, file->align))
           {_PD_rl_standard(file->std);
	    file->std   = _PD_copy_standard(REQ_STANDARD);
	    _PD_rl_alignment(file->align);
            file->align = _PD_copy_alignment(REQ_ALIGNMENT);};

        REQ_STANDARD = NULL;};

    _PD_init_chrt(file);

    return(file);}

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

/* PD_CLOSE - close a PDB file after writing out the symbol table and
 *          - structure chart and completing the header
 *          - return TRUE if successful and FALSE otherwise
 */

int PD_close(file)
   PDBfile *file;
   {FILE *fp;
    int ret;

    switch (setjmp(_PD_close_err))
       {case ABORT    : return(FALSE);
        case ERR_FREE : return(TRUE);
        default       : memset(PD_err, 0, MAXLINE);
                        break;};

    fp  = file->stream;
    ret = TRUE;

/* position the file pointer at the greater of the current position and
 * the location of the chart
 */
    if ((file->mode == PD_CREATE) || (file->mode == PD_APPEND))
       {ret = PD_flush(file);};

    if (!file->virtual_internal)
       {if (io_close(fp) != 0)
	   PD_error("CAN'T CLOSE FILE - PD_CLOSE", PD_CLOSE);};

/* free the space */
    _PD_rl_pdb(file);

    return(ret);}

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

/* PD_FLUSH - dump the data description tables containing the current
 *          - state of the PDB file
 *          - the tables are:
 *          -    structure chart
 *          -    symbol table
 *          -    extras table
 *          - the table addresses are also updated
 */

int PD_flush(file)
   PDBfile *file;
   {FILE *fp;

    if (file->flushed)
       return(TRUE);

    if (file->attrtab != NULL)
       {PD_cd(file, NULL);
	PD_reset_ptr_list(file);
        if (!PD_write(file, PDB_ATTRIBUTE_TABLE, "HASHTAB *", &file->attrtab))
	   return(FALSE);};

    switch (setjmp(_PD_write_err))
       {case ABORT    : return(FALSE);
        case ERR_FREE : return(TRUE);
        default       : memset(PD_err, 0, MAXLINE);
                        break;};

    fp = file->stream;
    if (io_flush(fp))
       PD_error("FFLUSH FAILED BEFORE CHART - PD_FLUSH", PD_WRITE);

/* seek the place to write the structure chart */
    if (io_seek(fp, file->chrtaddr, SEEK_SET))
       PD_error("FSEEK FAILED TO FIND CHART  - PD_FLUSH", PD_WRITE);

/* write the structure chart */
    file->chrtaddr = _PD_wr_chrt(file);
    if (file->chrtaddr == -1L)
       PD_error("CAN'T WRITE STRUCTURE CHART - PD_FLUSH", PD_WRITE);

/* write the symbol table */
    file->symtaddr = _PD_wr_symt(file);
    if (file->symtaddr == -1L)
       PD_error("CAN'T WRITE SYMBOL TABLE - PD_FLUSH", PD_WRITE);

/* write the extras table */
    if (!_PD_wr_extras(file))
       PD_error("CAN'T WRITE MISCELLANEOUS DATA - PD_FLUSH", PD_WRITE);

    if (io_tell(fp) == -1L)
       PD_error("CAN'T FIND HEADER ADDRESS - PD_FLUSH", PD_WRITE);

    if (io_flush(fp))
       PD_error("FFLUSH FAILED AFTER CHART - PD_FLUSH", PD_WRITE);

/* update the header */
    if (io_seek(fp, file->headaddr, SEEK_SET))
       PD_error("FSEEK FAILED - PD_FLUSH", PD_WRITE);

    if (file->headaddr != io_tell(fp))
       PD_error("FSEEK FAILED TO FIND HEADER - PD_FLUSH", PD_WRITE);

    io_printf(fp, "%22ld\001%22ld\001\n", file->chrtaddr, file->symtaddr);

    if (io_flush(fp))
       PD_error("FFLUSH FAILED AFTER HEADER - PD_FLUSH", PD_WRITE);

    file->flushed = TRUE;

    return(TRUE);}

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

/* PD_READ - read an entry from the PDB file pointed to by the
 *         - symbol table into the location pointed to by vr
 *         - return the number of item successfully read
 *         -
 *         - NOTE: VR must be a pointer to an object with the type
 *         - given by TYPE (PDBLib will allocated space if necessary)!
 */

int PD_read(file, name, vr)
   PDBfile *file;
   char *name;
   byte *vr;
   {return(PD_read_as(file, name, NULL, vr));}

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

/* PD_READ_AS - read an entry from the PDB file pointed to by the
 *            - symbol table into the location pointed to by vr
 *            - convert to type TYPE regardless of symbol entry type
 *            - return the number of item successfully read
 *            -
 *            - NOTE: VR must be a pointer to an object with the type
 *            - given by TYPE (PDBLib will allocate space if necessary)!
 */

int PD_read_as(file, name, type, vr)
   PDBfile *file;
   char *name, *type;
   byte *vr;
   {int err;
    syment *ep;
    char msg[MAXLINE], fullpath[MAXLINE];

    switch (setjmp(_PD_read_err))
       {case ABORT    : return(FALSE);
        case ERR_FREE : return(TRUE);
        default       : memset(PD_err, 0, MAXLINE);
                        break;};

/* find the effective symbol table entry for the named item */
    ep = _PD_effective_ep(file, name, TRUE, fullpath);
    if (ep == NULL)
       {sprintf(msg, "UNREADABLE OR MISSING ENTRY \"%s\" - PD_READ_AS",
                     fullpath);
        PD_error(msg, PD_READ);};

    if (type == NULL)
       type = PD_entry_type(ep);

    err = _PD_hyper_read(file, fullpath, type, ep, vr);

    _PD_rl_syment_d(ep);

    return(err);}

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

/* PD_READ_ALT - read part of an entry from the PDB file pointed to by
 *             - the symbol table into the location pointed to by VR
 *             - IND contains one triplet of long ints per variable
 *             - dimension specifying start, stop, and step for the index
 *             - return the number of item successfully read
 *             -
 *             - NOTE: VR must be a pointer to an object with the type
 *             - given by TYPE (PDBLib will allocated space if necessary)!
 */

int PD_read_alt(file, name, vr, ind)
   PDBfile *file;
   char *name;
   byte *vr;
   long *ind;
   {return(PD_read_as_alt(file, name, NULL, vr, ind));}

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

/* PD_READ_AS_ALT - read part of an entry from the PDB file pointed to by
 *                - the symbol table into the location pointed to by VR
 *                - IND contains one triplet of long ints per variable
 *                - dimension specifying start, stop, and step for the index
 *                - return the number of item successfully read
 *                -
 *                - NOTE: the entry MUST be an array (either a static
 *                - array or a pointer)
 *                -
 *                - NOTE: VR must be a pointer to an object with the type
 *                - of the object associated with NAME (PDBLib will
 *                - allocated space if necessary)!
 */

int PD_read_as_alt(file, name, type, vr, ind)
   PDBfile *file;
   char *name, *type;
   byte *vr;
   long *ind;
   {char fullpath[MAXLINE];
    dimdes *pd, *dims;
    syment *ep;
    int nd;

    switch (setjmp(_PD_read_err))
       {case ABORT    : return(FALSE);
        case ERR_FREE : return(TRUE);
        default       : memset(PD_err, 0, MAXLINE);
                        break;};

/* look up the variable name and return FALSE if it is not there */
    ep = _PD_effective_ep(file, name, TRUE, fullpath);
    if (ep == NULL)
       PD_error("ENTRY NOT IN SYMBOL TABLE - PD_READ_AS_ALT", PD_READ);

    dims = PD_entry_dimensions(ep);
    for (nd = 0, pd = dims; pd != NULL; pd = pd->next, nd++);

    return(_PD_indexed_read_as(file, fullpath, type, vr, nd, ind, ep));}

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

/* _PD_DEFENT - do the work of defining an entry in the PDB file
 *            - symbol table and stake out the disk space
 *            - but write nothing
 *            - return the new symbol table entry if successful, and
 *            - return NULL otherwise
 */

syment *_PD_defent(file, name, outtype, number, dims)
   PDBfile *file;
   char *name, *outtype;
   long number;
   dimdes *dims;
   {long addr, bytespitem;
    defstr *dp;
    syment *ep;
    char bf[MAXLINE], *lname;

    ep = NULL;

    switch (setjmp(_PD_write_err))
       {case ABORT    : return(NULL);
        case ERR_FREE : return(ep);
        default       : memset(PD_err, 0, MAXLINE);
                        break;};

/* if there are pointers involved it is an error */
    dp = PD_inquire_type(file, outtype);
    if (dp == NULL)
       PD_error("UNKNOWN FILE TYPE - _PD_DEFENT", PD_WRITE);

    if (dp->n_indirects)
       PD_error("CAN'T DEFINE ENTRY WITH INDIRECTS - _PD_DEFENT",
                PD_WRITE);

    ep = PD_inquire_entry(file, name, TRUE, NULL);

/* if this is a new entry */
    if (ep == NULL)
       {addr = file->chrtaddr;
        ep   = _PD_mk_syment(outtype, number, addr, NULL, dims);

        strcpy(bf, _PD_fixname(file, name));
        lname = SC_firsttok(bf, ".([ ");
        _PD_e_install(lname, ep, file->symtab);

	bytespitem = _PD_lookup_size(outtype, file->chart);

	ep = _PD_extend_file(file, number*bytespitem) ? ep : NULL;}

/* if this is only a new block */
    else
       ep = _PD_add_block(file, ep, dims) ? ep : NULL;

    return(ep);}

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

/* PD_DEFENT - define an entry in the PDB file symbol table and
 *           - stake out the disk space but write nothing
 *           - any dimensional information is the NAME string
 *           - return the new symbol table entry if successful, and
 *           - return NULL otherwise
 */

syment *PD_defent(file, name, outtype)
   PDBfile *file;
   char *name, *outtype;
   {long number;
    dimdes *dims;

    dims   = _PD_ex_dims(name, file->default_offset);
    number = _PD_comp_num(dims);

    return(_PD_defent(file, name, outtype, number, dims));}

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

/* PD_DEFENT_ALT - define an entry in the PDB file symbol table and
 *               - stake out the disk space but write nothing
 *               - dimensional information is specified by the number
 *               - of dimensions, ND, and the array of (min, max)
 *               - pairs of long ints in IND
 *               - return the new symbol table entry if successful, and
 *               - return NULL otherwise
 */

syment *PD_defent_alt(file, name, outtype, nd, ind)
   PDBfile *file;
   char *name, *outtype;
   int nd;
   long *ind;
   {int i;
    long number, maxi, mini, leng;
    dimdes *dims, *next, *prev;

/* compute the disk address, the number of items, and the dimensions */
    number = 1L;
    dims   = NULL;
    for (i = 0; i < nd; i++)
        {mini = ind[0];
         maxi = ind[1];
         ind += 2;

         leng    = maxi - mini + 1L;
         number *= leng;

         next = _PD_mk_dimensions(mini, leng);
         if (dims == NULL)
            dims = next;
         else
            {prev->next = next;
	     SC_mark(next, 1);};

         prev = next;};

    return(_PD_defent(file, name, outtype, number, dims));}

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

/* _PD_WRITE - primitive write to PDBfile which is used by 
 *           - PD_WRITE and PD_WRITE_AS
 *           -
 *           - NOTE: VR must be a pointer to an object with the type
 *           - given by TYPE!!!!
 */

syment *_PD_write(file, name, intype, outtype, vr, dims, appnd, pnew)
   PDBfile *file;
   char *name, *intype, *outtype;
   byte *vr;
   dimdes *dims;
   int appnd, *pnew;
   {int c, new;
    syment *ep;
    long number, addr;
    char bf[MAXLINE], *lname, *fullpath;
    SC_address ad;

    _append_flag = FALSE;

    ep  = NULL;
    new = TRUE;

    switch (setjmp(_PD_write_err))
       {case ABORT :
	     *pnew = new;
	     return(NULL);
        case ERR_FREE :
	     *pnew = new;
	     return(ep);
        default :
	     memset(PD_err, 0, MAXLINE);
	     break;};

    if (file->mode == PD_OPEN)
       PD_error("FILE OPENED IN READ-ONLY MODE - _PD_WRITE", PD_WRITE);

/* append a new block to an existing entry if TRUE */
    if (appnd)
       {strcpy(bf, name);

/* do this so that things such as a[20:20].b work properly
 * NOTE: this also implies that a[20:20].b.c works while
 *       a.b[20:20].c doesn't
 *       for now this defines the semantics of append (10/6/93)
 */
	lname = strpbrk(bf, ".()[]");
	if (lname != NULL)
           {c      = *lname;
	    *lname = '\0';
	    ep     = PD_inquire_entry(file, bf, FALSE, NULL);
	    *lname = c;}
	else
	    ep = PD_inquire_entry(file, bf, FALSE, NULL);

        if (ep == NULL)
           PD_error("CAN'T APPEND TO NON-EXISTING ENTRY - _PD_WRITE",
                    PD_WRITE);

	_PD_adj_dimensions(file, bf, ep);

/* extend the syment */
        _PD_add_block(file, ep, dims);

	fullpath = bf;}

    else
       fullpath = name;

    addr = file->chrtaddr;
    ep   = _PD_effective_ep(file, fullpath, FALSE, NULL);

/* if the variable already exists use the existing file info */
    if (ep != NULL)
       {addr  = PD_entry_address(ep);
	lname = fullpath;
        new   = FALSE;}

/* if the variable doesn't exist define it to the file */
    else
       {if (appnd)
	   {if (lname != NULL)
	       *lname = '\0';
	    lname  = bf;}

	else
	   {strcpy(bf, fullpath);
	    lname  = SC_firsttok(bf, ".([ ");};

	number = _PD_comp_num(dims);
	ep     = _PD_mk_syment(outtype, number, addr, NULL, dims);
	_PD_e_install(lname, ep, file->symtab);

/* with the first entry with pointers add a directory to hold the
 * symbol table entries generated for the pointees
 */
	if ((file->n_dyn_spaces == 0) &&
	    (_PD_num_indirects(outtype, file->chart) > 0))
	   PD_mkdir(file, "/&ptrs");

	new = TRUE;};

    if (file->virtual_internal)
       {if (new)
	   {ad.memaddr = vr;
	    ep->blocks->diskaddr = ad.diskaddr;
	    SC_mark(vr, 1);}

/* do the low level write */
	else
	   {if (!_PD_hyper_write(file, lname, ep, vr, intype))
	       PD_error("CAN'T WRITE VIRTUAL VARIABLE - _PD_WRITE",
			PD_WRITE);};}

    else
       {if (outtype == NULL)
	   outtype = PD_entry_type(ep);

	if (intype == NULL)
	   intype = outtype;

/* go to the correct address */
        if (io_seek(file->stream, addr, SEEK_SET))
	   PD_error("FSEEK FAILED TO FIND CURRENT ADDRESS - _PD_WRITE",
		    PD_WRITE);

/* do the low level write */
	if (!_PD_hyper_write(file, lname, ep, vr, intype))
	   PD_error("CAN'T WRITE VARIABLE - _PD_WRITE", PD_WRITE);

/* if the variable didn't previously exist we're at the end of the file */
	if (new)
	   {file->chrtaddr = io_tell(file->stream);
	    if (file->chrtaddr == -1L)
	       PD_error("CAN'T FIND ADDRESS OF NEXT VARIABLE - _PD_WRITE",
			PD_WRITE);};};

    *pnew = new;

    return(ep);}

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

/* PD_WRITE - write NUMBER VAR's of type TYPE to the PDB file, FILE
 *          - make an entry in the file's symbol table
 *          - return TRUE iff successful
 *          -
 *          - NOTE: VR must be a pointer to an object with the type
 *          - given by TYPE!!!!
 */

int PD_write(file, name, type, vr)
   PDBfile *file;
   char *name, *type;
   byte *vr;
   {return(PD_write_as(file, name, type, type, vr));}

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

/* PD_WRITE_AS - write NUMBER VAR's of type INTYPE to the PDB file, FILE
 *             - as type OUTTYPE
 *             - make an entry in the file's symbol table
 *             - return TRUE iff successful
 *             -
 *             - NOTE: VR must be a pointer to an object with the type
 *             - given by TYPE!!!!
 */

int PD_write_as(file, name, intype, outtype, vr)
   PDBfile *file;
   char *name, *intype, *outtype;
   byte *vr;
   {syment *ep;
    dimdes *dims;
    char *s, *t, *lname, fullpath[MAXLINE];
    int appnd, new;

    if (PD_has_directories(file))
       {lname = _PD_fixname(file, name);
	strcpy(fullpath, lname);
	t = strchr(lname, '.');
	if (t != NULL)
	   *t = '\0';
        s = fullpath;}
    else
       {strcpy(fullpath, name);
	lname = fullpath;
	t = strchr(fullpath, '.');
	if (t != NULL)
	   *t = '\0';
	s = name;};

    appnd = _append_flag;
    dims  = _PD_ex_dims(lname, file->default_offset);
    ep    = _PD_write(file, s, intype, outtype, vr, dims, appnd, &new);
    if (ep != NULL)
       {if (!new)
	   {if (!appnd)
	       _PD_rl_dimensions(dims);
	    _PD_rl_syment_d(ep);};
	return(TRUE);}
    else
       return(FALSE);}

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

/* PD_WRITE_ALT - write an entry of type TYPE to the PDB file, FILE
 *              - make an entry in the file's symbol table
 *              - return TRUE iff successful
 *              - the entry is named by NAME has ND dimensions and IND
 *              - contains the min and max (pairwise) of each dimensions
 *              - range
 *              - return the new syment if successful and NULL otherwise
 *              -
 *              - NOTE: VR must be a pointer to an object with the type
 *              - given by TYPE!!!!
 */

int PD_write_alt(file, name, type, vr, nd, ind)
   PDBfile *file;
   char *name, *type;
   byte *vr;
   int nd;
   long *ind;
   {return(PD_write_as_alt(file, name, type, type, vr, nd, ind));}

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

/* PD_WRITE_AS_ALT - write an entry of type INTYPE to the PDB file, FILE
 *                 - as type OUTTYPE
 *                 - make an entry in the file's symbol table
 *                 - return TRUE iff successful
 *                 - the entry has name, NAME, ND dimensions, and the ranges
 *                 - of the dimensions are given (min, max) pairwise in  IND
 *                 - if successful and otherwise
 *                 - return NULL
 *                 -
 *                 - NOTE: VR must be a pointer to an object with the type
 *                 - given by TYPE!!!!
 */

int PD_write_as_alt(file, name, intype, outtype, vr, nd, ind)
   PDBfile *file;
   char *name, *intype, *outtype;
   byte *vr;
   int nd;
   long *ind;
   {int i, new, appnd;
    long start, stop, step, leng;
    char expr[MAXLINE], index[MAXLINE], hname[MAXLINE], fullpath[MAXLINE];
    dimdes *dims, *next, *prev;
    syment *ep;

    prev = NULL;
    dims = NULL;

    strcpy(index, "(");

    for (i = 0; i < nd; i++)
        {start = ind[0];
         stop  = ind[1];
         step  = ind[2];
         ind += 3;

	 sprintf(expr, "%ld:%ld:%ld,", start, stop, step);
         strcat(index, expr);

         leng = stop - start + 1L;
         next = _PD_mk_dimensions(start, leng);
         if (dims == NULL)
            dims = next;
         else
            {prev->next = next;
	     SC_mark(next, 1);};

         prev = next;};

    if (strlen(index) > 1)
       {index[strlen(index)-1] = ')';
        sprintf(hname, "%s%s", name, index);}
    else
       strcpy(hname, name);

    appnd = _append_flag;
    strcpy(fullpath, _PD_fixname(file, hname));
    ep = _PD_write(file, fullpath, intype, outtype,
		   vr, dims, _append_flag, &new);

    if (ep != NULL)
       {if (!new)
	   {if (!appnd)
	       _PD_rl_dimensions(dims);
	    _PD_rl_syment_d(ep);};
	return(TRUE);}
    else
       return(FALSE);}

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

/* PD_APPEND - append a new block of data to an existing entry
 *           - NOTE: VR must be a pointer to an object with the type
 *           - of the existing entry
 */

int PD_append(file, name, vr)
   PDBfile *file;
   char *name;
   byte *vr;
   {_append_flag = TRUE;
    return(PD_write_as(file, name, NULL, NULL, vr));}

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

/* PD_APPEND_AS - append a new block of data to an existing entry
 *              - convert from INTYPE to the type of the existing data
 *              - NOTE: VR must be a pointer to an object with the type
 *              - of the existing entry
 */

int PD_append_as(file, name, intype, vr)
   PDBfile *file;
   char *name, *intype;
   byte *vr;
   {_append_flag = TRUE;
    return(PD_write_as(file, name, intype, NULL, vr));}

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

/* PD_APPEND_ALT - append a new block of data to an existing entry
 *               - NOTE: VR must be a pointer to an object with the type
 *               - of the existing entry
 */

int PD_append_alt(file, name, vr, nd, ind)
   PDBfile *file;
   char *name;
   byte *vr;
   int nd;
   long *ind;
   {_append_flag = TRUE;
    return(PD_write_as_alt(file, name, NULL, NULL, vr, nd, ind));}

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

/* PD_APPEND_AS_ALT - append a new block of data to an existing entry
 *                  - convert from INTYPE to the type of the existing data
 *                  - NOTE: VR must be a pointer to an object with the type
 *                  - of the existing entry
 */

int PD_append_as_alt(file, name, intype, vr, nd, ind)
   PDBfile *file;
   char *name, *intype;
   byte *vr;
   int nd;
   long *ind;
   {_append_flag = TRUE;
    return(PD_write_as_alt(file, name, intype, NULL, vr, nd, ind));}

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

/* PD_TYPEDEF - define an alias for a type which exists in the host chart
 *            - the intended use is to provide a correspondence
 *            - between a type that has been defined to PDBLib (ONAME)
 *            - and a typedef'd type in programs (TNAME)
 *            - can be used in conjunction with PD_defix and PD_defloat
 *            - to have a primitive type known to both charts
 *            - return a pointer to the original type's defstr if
 *            - successful and NULL otherwise
 */

defstr *PD_typedef(file, oname, tname)
   PDBfile *file;
   char *oname, *tname;
   {defstr *dp;

    dp = PD_inquire_host_type(file, oname);
    if (dp == NULL)
       sprintf(PD_err, "ERROR: HOST TYPE %s UNKNOWN - PD_TYPEDEF\n", oname);
    else
       {if (PD_inquire_host_type(file, tname) == NULL)
	   _PD_d_install(tname, dp, file->host_chart);};

    dp = PD_inquire_type(file, oname);
    if (dp == NULL)
       sprintf(PD_err, "ERROR: FILE TYPE %s UNKNOWN - PD_TYPEDEF\n", oname);

    else
       {if (PD_inquire_type(file, tname) == NULL)
           _PD_d_install(tname, dp, file->chart);};

    return(dp);}

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

/* PD_DEFNCV - define a primitive type that will not be format converted
 *           - do it in both charts
 */

defstr *PD_defncv(file, name, bytespitem, align)
   PDBfile *file;
   char *name;
   long bytespitem;
   int align;
   {defstr *dp;
    HASHTAB *chrt;

    chrt = file->chart;

    dp = _PD_mk_defstr(chrt, name, NULL, bytespitem, align, -1, FALSE,
                       NULL, NULL, FALSE, FALSE);
    if (dp == NULL)
       sprintf(PD_err, "ERROR: DEFINITION FAILED - PD_DEFNCV\n");

    else
       {_PD_d_install(name, dp, chrt);

	chrt = file->host_chart;

/* install an independent copy in the host chart - garbage collection! */
        dp = _PD_mk_defstr(chrt, name, NULL, bytespitem, align, -1,
			   -1, NULL, NULL, FALSE, FALSE);
        _PD_d_install(name, dp, chrt);};

    return(dp);}

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

/* PD_DEFIXNUM - define an new integer primitive type for the file chart */

defstr *PD_defixnum(file, name, bytespitem, align, flg, unsgned, onescmp)
   PDBfile *file;
   char *name;
   long bytespitem;
   int align, flg, unsgned;
   {defstr *dp;
    HASHTAB *chrt;

    chrt = file->chart;

    dp = _PD_mk_defstr(chrt, name, NULL, bytespitem, align, flg,
		       TRUE, NULL, NULL, unsgned, onescmp);

    if (dp == NULL)
       sprintf(PD_err, "ERROR: DEFINITION FAILED - PD_DEFIX\n");
    else
       _PD_d_install(name, dp, chrt);

    return(dp);}

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

/* PD_DEFIX - define an new integer primitive type for the file chart */

defstr *PD_defix(file, name, bytespitem, align, flg)
   PDBfile *file;
   char *name;
   long bytespitem;
   int align, flg;
   {return(PD_defixnum(file, name, bytespitem, align, flg, FALSE, FALSE));}

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

/* PD_DEFLOAT - define an new floating point primitive type
 *            - for the file chart
 */

defstr *PD_defloat(file, name, bytespitem, align, ordr,
                   expb, mantb, sbs, sbe, sbm, hmb, bias)
   PDBfile *file;
   char *name;
   long bytespitem;
   int align, *ordr;
   long expb, mantb, sbs, sbe, sbm, hmb, bias;
   {defstr *dp;
    long *formt;
    HASHTAB *fchrt;

    formt = FMAKE_N(long, 8, "PD_DEFLOAT:long");
    formt[0] = bytespitem*8;
    formt[1] = expb;
    formt[2] = mantb;
    formt[3] = sbs;
    formt[4] = sbe;
    formt[5] = sbm;
    formt[6] = hmb;
    formt[7] = bias;

    fchrt = file->chart;

    dp = _PD_mk_defstr(fchrt, name, NULL, bytespitem, align, -1,
		       TRUE, ordr, formt, FALSE, FALSE);

    if (dp == NULL)
       sprintf(PD_err, "ERROR: DEFINITION FAILED - PD_DEFLOAT\n");
    else
       _PD_d_install(name, dp, fchrt);

    return(dp);}

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

/* PD_DEFSTR - a structure definition mechanism for PDBLib
 *           -
 *           - sample syntax:
 *           -
 *           -   PD_defstr(<PDB file>, "<struct name>",
 *           -                         "<member1>", "<member2>",
 *           -                 ...     "<membern>", LAST);
 *           -
 *           - where
 *           - 
 *           -   <member> := <primitive type> <member name>[(<dimensions>)] |
 *           -               <derived type> <member name>[(<dimensions>)]
 *           -
 *           -   <dimensions> := <non-negative int> |
 *           -                   <non-negative int>,<dimensions> |
 *           -                   <non-negative int>, <dimensions> |
 *           -                   <non-negative int> <dimensions>
 *           -
 *           -   <primitive type> := short | integer | long | float |
 *           -                       double | char | short * | integer *
 *           -                       long * | float * | double * | char *
 *           - 
 *           -   <derived type> := any defstr'd type | any defstr'd type *
 *           -
 *           - LAST is a pointer to a integer zero and is specifically
 *           - allocated by PDBLib to be used to terminate argument lists
 *           - which consist of pointers
 *           -
 *           - Returns NULL if member types are unknown
 */

#ifdef PCC

defstr *PD_defstr(file, name, va_alist)
   PDBfile *file;
   char *name;
   va_dcl

#endif

#ifdef ANSI

defstr *PD_defstr(PDBfile *file, char *name, ...)

#endif

   {char *nxt, *ptype;
    int doffs;
    HASHTAB *fchrt;
    memdes *desc, *lst, *prev;
    defstr *dp, *dp2;

    SC_VA_START(name);

    prev  = NULL;
    lst   = NULL;
    fchrt = file->chart;
    doffs = file->default_offset;
    for (nxt = SC_VA_ARG(char *); (int) *nxt != 0;
         nxt = SC_VA_ARG(char *))
        {desc  = _PD_mk_descriptor(nxt, doffs);
         ptype = desc->base_type;
         if (SC_lookup(ptype, fchrt) == NULL)
            if ((strcmp(ptype, name) != 0) || !_PD_indirection(nxt))
               {sprintf(PD_err, "ERROR: %s BAD MEMBER TYPE - PD_DEFSTR\n",
                                nxt);
                return(NULL);};
         
         dp2 = PD_inquire_table_type(fchrt, ptype);
         if ((dp2 != NULL)  && !(_PD_indirection(desc->type)))
            if (dp2->n_indirects > 0)
               {sprintf(PD_err, "ERROR: STATIC MEMBER STRUCT %s CANNOT CONTAIN INDIRECTS\n",
                                 ptype);
                return(NULL);};

         if (lst == NULL)
            lst = desc;
         else
            prev->next = desc;
         prev = desc;};

    SC_VA_END;

/* install the type in both charts */
    dp = _PD_defstr_inst(name, lst, -1, NULL, NULL,
                         fchrt, file->host_chart,
                         file->align, file->host_align, FALSE);
    if (dp == NULL)
       sprintf(PD_err, "ERROR: CAN'T HANDLE PRIMITIVE TYPE - PD_DEFSTR\n");

    return(dp);}

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

/* PD_DEFSTR_ALT - an alternate structure definition mechanism for PDBLib
 *               -
 *               - sample syntax:
 *               -
 *               -   PD_defstr_alt(<PDB file>, "<struct name>", n_members,
 *               -                 <member-array>);
 *               - the member array elements have the same syntax as for
 *               - PD_defstr
 */

defstr *PD_defstr_alt(file, name, nmemb, members)
   PDBfile *file;
   char *name;
   int nmemb;
   char **members;
   {char *nxt, *ptype, *type;
    int i, doffs;
    HASHTAB *fchrt;
    memdes *desc, *lst, *prev;
    defstr *dp, *dp2;

    prev  = NULL;
    lst   = NULL;
    fchrt = file->chart;
    doffs = file->default_offset;
    for (i = 0; i < nmemb; i++)
        {nxt   = members[i];
         desc  = _PD_mk_descriptor(nxt, doffs);
         type  = SC_strsavef(nxt, "char*:PD_DEFSTR_ALT:type");
         ptype = SC_firsttok(type, " \n");
         if (SC_lookup(ptype, fchrt) == NULL)
            if ((strcmp(ptype, name) != 0) || !_PD_indirection(nxt))
               {sprintf(PD_err, "ERROR: %s BAD MEMBER TYPE - PD_DEFSTR_ALT\n",
                                nxt);
                return(NULL);};

         dp2 = PD_inquire_table_type(fchrt, ptype);
         if ((dp2 != NULL)  && !(_PD_indirection(desc->type)))
            if (dp2->n_indirects > 0)
               {sprintf(PD_err, "ERROR: STATIC MEMBER STRUCT %s CANNOT CONTAIN INDIRECTS\n",
                                 ptype);
                return(NULL);};

         SFREE(type);
         if (lst == NULL)
            lst = desc;
         else
            prev->next = desc;
         prev = desc;};

/* install the type in both charts */
    dp = _PD_defstr_inst(name, lst, -1, NULL, NULL,
                         fchrt, file->host_chart,
                         file->align, file->host_align, FALSE);
    if (dp == NULL)
       sprintf(PD_err,
               "ERROR: CAN'T HANDLE PRIMITIVE TYPE - PD_DEFSTR_ALT\n");

    return(dp);}

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

/* PD_TARGET - setup for the target machine data formats and alignments
 *           - this information is recorded in the PDBfiles to correctly
 *           - handle things when many files are open at once
 *           -
 *           - to correctly handle the situation in which there are
 *           - PD_OPEN'd files around (this may reset previously set
 *           - file->std), remember a standard specifically requested
 *           - with PD_TARGET
 *           - (note that PD_OPEN sets file->std and file->align)
 */

int PD_target(data, align)
   data_standard *data;
   data_alignment *align;
   {REQ_STANDARD  = data;
    REQ_ALIGNMENT = align;

    return(TRUE);}

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

/* PD_CAST - tell PDBLib that the type of a particular member (which must
 *         - be a pointer) is specified by another member (which must
 *         - be a character pointer)
 *         - return TRUE iff successful
 */

int PD_cast(file, type, memb, contr)
   PDBfile *file;
   char *type, *memb, *contr;
   {HASHTAB *tab;
    hashel *hp;
    defstr *dp;
    memdes *desc, *lst;

/* add the cast to the file->chart */
    tab = file->chart;
    for (hp = *(tab->table); hp != NULL; hp = hp->next)
        {dp = (defstr *) hp->def;
         if (strcmp(type, dp->type) != 0)
            continue;

/* check that the contr is right */
         for (desc = dp->members; desc != NULL; desc = desc->next)
             {if (strcmp(contr, desc->name) != 0)
                 continue;

/* Do this once, don't repeat in other chart */
              if ((strcmp(desc->base_type, "char") != 0) ||
                  !_PD_indirection(desc->type))
                 {sprintf(PD_err, "BAD CAST CONTROLLER - PD_CAST");
                  return(FALSE);};
              break;};};

/* add the cast to the file->host_chart */
    tab = file->host_chart;
    for (hp = *(tab->table); hp != NULL; hp = hp->next)
        {dp = (defstr *) hp->def;
         if (strcmp(type, dp->type) != 0)
            continue;
         for (desc = dp->members; desc != NULL; desc = desc->next)
             {if (strcmp(memb, desc->name) != 0)
                 continue;

/* Make an independent copy in case the one in the file chart is released */
              desc->cast_memb = SC_strsavef(contr,
                                            "char*:PD_CAST:membh");
              desc->cast_offs = _PD_member_location(contr, tab, dp,
                                                    &lst);};};
    return(TRUE);}

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

/* PD_ERROR - signal an error */

void PD_error(s, n)
   char *s;
   int n;
   {

    if (PD_err[0] == '\0')
       sprintf(PD_err, "ERROR: %s\n", s);

    switch (n)
       {case PD_OPEN   : longjmp(_PD_open_err, ABORT);
        case PD_CREATE : longjmp(_PD_create_err, ABORT);   
        case PD_TRACE  : longjmp(_PD_trace_err, ABORT);   
        case PD_CLOSE  : longjmp(_PD_close_err, ABORT);   
        case PD_READ   : longjmp(_PD_read_err, ABORT);   
        case PD_PRINT  : longjmp(_PD_print_err, ABORT);   
        case PD_WRITE  : longjmp(_PD_write_err, ABORT);};}

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