/*
 * PDPDBW.C - PDB write functionality in PD
 *
 * Source Version: 9.0
 * Software Release #92-0043
 *
 */

#include "cpyright.h"

#include "pdb.h"

#define LINE_SIZE 90

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

#define DISP_DATA(f0, x, nitems, tid)                                        \
    if (nitems == 1L)                                                        \
       {DISP_MODE_1(f0, x, nitems, tid);}                                    \
    else if (nitems < PD_print_controls[3])                        \
       {DISP_MODE_2(f0, x, nitems, tid);}                                    \
    else                                                                     \
       {DISP_MODE_3(f0, x, nitems, tid);}

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

#define DISP_MODE_1(f0, x, nitems, tid)                                      \
    PRINT(f0, "%s%s%s = ", prefix, before, nodename);                        \
    PRINT(f0, PD_print_formats1[tid], *x);                                   \
    PRINT(f0, "\n");

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

#define DISP_MODE_2(f0, x, nitems, tid)                                      \
    i = 0L;                                                                  \
    j = 0L;                                                                  \
    PRINT(f0, "%s%s%s(%s) = ",                                               \
              prefix, before, nodename,                                      \
              PD_index_to_expr(bf, j, dims, mjr, def_off));                  \
    PRINT(f0, PD_print_formats1[tid], x[i]);                                 \
    PRINT(f0, "\n");                                                         \
    j += offset;                                                             \
    for (i = 1L; i < nitems; i++, j += offset)                               \
        {PRINT(f0, "%s%s%s(%s) = ",                                          \
                   prefix, after, nodename,                                  \
                   PD_index_to_expr(bf, j, dims, mjr, def_off));             \
         PRINT(f0, PD_print_formats1[tid], x[i]);                            \
         PRINT(f0, "\n");}

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

#define DISP_MODE_3(f0, x, nitems, tid)                                      \
    i = 0L;                                                                  \
    j = 0L;                                                                  \
    PRINT(f0, "%s%s%s\n", prefix, before, nodename);                         \
    sprintf(s, "  (%s)                              ",                       \
               PD_index_to_expr(bf, j, dims, mjr, def_off));                 \
    s[nn] = '\0';                                                            \
    PRINT(f0, "%s", s);                                                      \
    for (k = 0; i < nitems; i++, j += offset, k++)                           \
        {if (k >= PD_print_controls[4])                            \
            {sprintf(s, "  (%s)                              ",              \
                        PD_index_to_expr(bf, j, dims, mjr, def_off));        \
             s[nn] = '\0';                                                   \
             PRINT(f0, "\n%s", s);                                           \
             k = 0;};                                                        \
         PRINT(f0, PD_print_formats2[tid], x[i]);};                          \
    PRINT(f0, "\n")

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

int
 PD_short_digits,
 PD_int_digits,
 PD_long_digits,
 PD_long_long_digits,
 PD_float_digits,
 PD_double_digits,
 PD_tolerance = 1000;

double
 PD_float_tol,
 PD_double_tol;

/* print controls
 *  0  -  print prefix: 0 = full path, 1 = space, 2 = tree
 *  1  -  0 = print name, 1 = print type and name
 *  2  -  recursion: 0 = yes, 1 = count
 *  3  -  number of items before going to array mode of display
 *  4  -  number of items per line
 */

long
 PD_print_controls[10] = {0L, 0L, 0L, 20L, 2L, 0L, 0L, 0L, 0L, 0L};

char
 *PD_print_formats1[8],
 *PD_print_formats2[8],
 *PD_user_formats1[8],
 *PD_user_formats2[8];

static void
 SC_DECLARE(_PD_print_data,
         (FILE *f0,
          char *prefix, char *before, char *after,
          char *nodename, PDBfile *file, byte *vr,
          long nitems, char *type, dimdes *dims,
          int mjr, int def_off, int irecursion)),
 SC_DECLARE(_PD_print_indirection,
         (FILE *f0,
          char *prefix, char *before, char *after,
          char *nodename, PDBfile *file, char **vr,
          long nitems, char *type, dimdes *dims,
          int mjr, int def_off, int irecursion)),
 SC_DECLARE(_PD_io_print,
         (FILE *f0,
          char *prefix, char *before, char *after,
          char *nodename, PDBfile *file, char *vr, long nitems,
          char *type, dimdes *dims, int mjr, int def_off));

static int
 SC_DECLARE(_PD_test_recursion, (char *type, char *mtype));

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

/* PD_WRITE_EXTRAS - write the extra stuff about a PDBfile */

void PD_write_extras(f0, file)
   FILE *f0;
   PDBfile *file;
   {hashel *hp;
    defstr *dp;

    PRINT(f0, "\n");

    PRINT(f0, "File Name: %s\n", file->name);
    if (file->type == NULL)
       PRINT(f0, "File Type: PDB\n");
    else
       PRINT(f0, "File Type: %s\n", file->type);
    PRINT(f0, "File Creation Date: %s\n", file->date);
    PRINT(f0, "PDB Version: %d\n", file->system_version);
    PRINT(f0, "Default Offset: %d\n", file->default_offset);
    if (file->major_order == ROW_MAJOR_ORDER)
       PRINT(f0, "Array Order: ROW MAJOR (C)\n");
    else
       PRINT(f0, "Array Order: COLUMN MAJOR (FORTRAN)\n");

    PRINT(f0, "Types Needing Conversion:");
    for (hp = file->chart->table[0]; hp != NULL; hp = hp->next)
        {dp = (defstr *) hp->def;
         if (dp->convert > 0)
            PRINT(f0, " %s", dp->type);};
    PRINT(f0, "\n");

    if (file->attrtab != NULL)
       PRINT(f0, "Attribute Table: Yes\n");

    if (file->maximum_size != OFF_T_MAX)
       PRINT(f0, "Maximum family member size: %ld\n", file->maximum_size);

    if (file->previous_file != NULL)
       PRINT(f0, "Previous file in family: %s\n", file->previous_file);

    if (file->virtual_internal)
       {PRINT(f0, "Symbol Table Address: 0x%lx\n", file->symtab);
	PRINT(f0, "Structure Chart Address: 0x%lx\n", file->chart);}
    else
#ifdef _LARGE_FILES
       {PRINT(f0, "Header Address: %lld\n", file->headaddr);
	PRINT(f0, "Symbol Table Address: %lld\n", file->symtaddr);
	PRINT(f0, "Structure Chart Address: %lld\n", file->chrtaddr);};
#else
       {PRINT(f0, "Header Address: %ld\n", file->headaddr);
	PRINT(f0, "Symbol Table Address: %ld\n", file->symtaddr);
	PRINT(f0, "Structure Chart Address: %ld\n", file->chrtaddr);};
#endif

    return;}

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

/* PD_PRINT_EXTRAS - print the extra stuff about a PDBfile */

void PD_print_extras(file)
   PDBfile *file;
   {PD_write_extras(stdout, file);}

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

/* PD_WRITE_SYMENT - write a symbol table entry in human readable form */

void PD_write_syment(f0, ep)
   FILE *f0;
   syment *ep;
   {dimdes *dim;

    PRINT(f0, "Type: %s\n", PD_entry_type(ep));
    if (PD_entry_dimensions(ep) != NULL)
       {PRINT(f0, "Dimensions: (");
        for (dim = PD_entry_dimensions(ep); TRUE; )
            {PRINT(f0, "%ld:%ld", dim->index_min, dim->index_max);
             dim = dim->next;
             if (dim != NULL)
                 PRINT(f0, ", ");
             else
                {PRINT(f0, ")\n");
                 break;};};};

    PRINT(f0, "Length: %ld\n", PD_entry_number(ep));
#ifdef _LARGE_FILES
    PRINT(f0, "Address: %lld\n", PD_entry_address(ep));
#else
    PRINT(f0, "Address: %ld\n", PD_entry_address(ep));
#endif

    return;}

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

/* PD_PRINT_SYMENT - print a symbol table entry in human readable form */

void PD_print_syment(ep)
   syment *ep;
   {PD_write_syment(stdout, ep);}

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

/* PD_WRITE_DEFSTR - write a defstr in human readable form */

void PD_write_defstr(f0, dp)
   FILE *f0;
   defstr *dp;
   {memdes *lst, *nxt;
    char bg[80];

    strcpy(bg, "Members: {");

    PRINT(f0, "Type: %s\n", dp->type);
    PRINT(f0, "Alignment: %d\n", dp->alignment);
    if (dp->members != NULL)
       {for (lst = dp->members; lst != NULL; lst = nxt)
            {nxt = lst->next;
             if (lst->cast_offs < 0L)
                {if (nxt == NULL)
                    PRINT(f0, "%s%s;}\n", bg, lst->member);
                 else
                    PRINT(f0, "%s%s;\n", bg, lst->member);}
             else
                {if (nxt == NULL)
                    PRINT(f0, "%s%s;}  (cast by %s)\n",
                          bg, lst->member, lst->cast_memb);
                 else
                    PRINT(f0, "%s%s;  (cast by %s)\n",
                          bg, lst->member, lst->cast_memb);};
             strcpy(bg, "          ");};};

    PRINT(f0, "Size in bytes: %ld\n", dp->size);

    return;}

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

/* PD_PRINT_DEFSTR - print a defstr in human readable form */

void PD_print_defstr(dp)
   defstr *dp;
   {PD_write_defstr(stdout, dp);}

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

/* PD_WRITE_ENTRY - write a data item from a PDB file in a formated way */

void PD_write_entry(f0, file, name, vr, ep)
   FILE *f0;
   PDBfile *file;
   char *name;
   byte *vr;
   syment *ep;
   {char prefix[80], pathname[180];
    char before[2], after[2];
    SC_THREAD_ID(_t_index);

    switch (setjmp(_PD_PRINT_ERR(_t_index)))
       {case ABORT :
	     return;
        case ERR_FREE :
	     return;
        default :
	     memset(PD_err, 0, MAXLINE);
	     break;};

    _PD_set_digits(file);
    _PD_set_format_defaults();
    _PD_set_user_formats();

    strcpy(pathname, name);
    *prefix = '\0';
    *before = '\0';
    *after  = '\0';

    _PD_print_data(f0,
                   prefix, before, after, pathname, file, vr,
                   PD_entry_number(ep), PD_entry_type(ep),
		   PD_entry_dimensions(ep),
                   file->major_order, file->default_offset, 0);

    return;}

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

/* PD_PRINT_ENTRY - print a data item from a PDB file in a formated way */

void PD_print_entry(file, name, vr, ep)
   PDBfile *file;
   char *name;
   byte *vr;
   syment *ep;
   {PD_write_entry(stdout, file, name, vr, ep);}

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

/* _PD_PRINT_DATA - print out variables in a nicely formatted way  */

static void _PD_print_data(f0,
                           prefix, before, after, nodename, file, vr, nitems,
                           type, dims, mjr, def_off, irecursion)
   FILE *f0;
   char *prefix, *before, *after, *nodename;
   PDBfile *file;
   byte *vr;
   long nitems;
   char *type;
   dimdes *dims;
   int mjr, def_off, irecursion;
   {

/* if the type is an indirection, follow the pointer */
    if (_PD_indirection(type))
       _PD_print_indirection(f0,
                             prefix, before, after, nodename,
                             file, (char **) vr, nitems, type, 
                             dims, mjr, def_off, irecursion);
    else
       _PD_print_leaf(f0,
                      prefix, before, after, nodename,
                      file,  vr, nitems, type,
                      dims, mjr, def_off, irecursion);

    return;}

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

/* _PD_PRINT_INDIRECTION - handle the indirects for the print process */

static void _PD_print_indirection(f0,
                                  prefix, before, after, nodename, file, vr,
				  nitems, type, dims, mjr, def_off,
				  irecursion)
   FILE *f0;
   char *prefix, *before, *after, *nodename;
   PDBfile *file;
   char **vr;
   long nitems;
   char *type;
   dimdes *dims;
   int mjr, def_off, irecursion;
   {long i, ditems;
    int min_index;
    char *dtype, *s;
    char field[80], bf[MAXLINE];

    dtype = PD_dereference(SC_strsavef(type,
                           "char*:_PD_PRINT_INDIRECTION:dtype"));

    strcpy(field, nodename);
    s = field + strlen(field);

    if (dims != NULL)
       min_index = dims->index_min;
    else
       min_index = def_off;

    for (i = 0L; i < nitems; i++, vr++)
        {if (nitems > 1)
            sprintf(s, "(%ld)", i + min_index);
         ditems = _PD_number_refd(DEREF(vr), dtype, file->host_chart);
         if (ditems == -2L)
            {sprintf(bf,
                     "UNKNOWN TYPE %s - _PD_PRINT_INDIRECTION",
                     dtype);
             PD_error(bf, PD_PRINT);};

/* if the type is an indirection, follow the pointer */
         if (ditems > 0)
            {if (_PD_indirection(dtype))
                _PD_print_indirection(f0,
                                      prefix, before, after, field, file,
                                      (char **) DEREF(vr), ditems, dtype, 
                                      dims, mjr, def_off, irecursion);
             else
                _PD_print_leaf(f0,
                               prefix, before, after, field, file,
                               DEREF(vr), ditems, dtype,
                               dims, mjr, def_off, irecursion);}
         else
            PRINT(f0, "%s%s%s = (nil)\n", prefix, before, field);

         before = after;};

    SFREE(dtype);

    return;}

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

/* _PD_PRINT_LEAF - if 'type' is a primitive type, display the data,
 *                - otherwise, lookup the type, and display each member.
 */

void _PD_print_leaf(f0,
                    prefix, before, after, nodename, file, vr, nitems,
                    type, dims, mjr, def_off, irecursion)
   FILE *f0;
   char *prefix, *before, *after, *nodename;
   PDBfile *file;
   char *vr;
   long nitems;
   char *type;
   dimdes *dims;
   int mjr, def_off, irecursion;
   {long ii;
    char *s, *s1, *s2, *svr, *mvr;
    defstr *defp;
    dimdes *mdims;
    memdes *desc, *mem_lst, *next;
    char field[80], mfield[80];
    char *mtype;
    int size, min_index, nchars;
    long mitems;
    char *mbefore, *mafter;
    static char before_2[5] = "|__ ";
    static char after_2[5]  = "|   ";
    static char spaces[5]   = "    ";
    static char blank[2]    = "";
    

/* print out the type */
    defp = PD_inquire_host_type(file, type);
    if (defp == NULL)
       PD_error("VARIABLE NOT IN STRUCTURE CHART - _PD_PRINT_LEAF",
                PD_PRINT);

    mem_lst = defp->members;
    if (mem_lst == NULL)
       _PD_io_print(f0,
                    prefix, before, after, nodename, file, vr, nitems,
                    type, dims, mjr, file->default_offset);

    else
       {s2 = SC_strsavef(prefix, "char*:_PD_PRINT_LEAF:s2");
        nchars = strlen(prefix) + strlen(before) + 1;
        if (nchars > 80)
           {s = prefix + strlen(prefix) - (nchars - 80) - 3;
            strcpy(s, "...");}

        s = prefix + strlen(prefix);     /* save end of prefix */
        strcpy(s, before);

        if (pdb_wr_hook != NULL)
           mem_lst = (*pdb_wr_hook)(file, vr, defp);

        size = defp->size;
        for (svr = vr, ii = 0L; ii < nitems; ii++)
            {if ((nitems > 1) || (dims != NULL))
	        {if (dims != NULL)
		    min_index = dims->index_min;
		 else
		    min_index = def_off;
		 sprintf(field, "%s(%ld)", nodename, ii + min_index);}
             else
                strcpy(field, nodename);

/* compute prefix */
             switch (PD_print_controls[0])
                {case 0 : strcat(field, ".");
                          mbefore = field;
                          mafter = field;
                          break;
                 case 1 : mbefore = spaces;
                          mafter  = spaces;
                          PRINT(f0, "%s%s\n", prefix, field);
                          break;
                 case 2 : mbefore = before_2;
                          mafter  = after_2;
                          if (ii > 0L)
                             PRINT(f0, "%s%s\n", prefix, mafter);
                          PRINT(f0, "%s%s\n", prefix, field);
                          if (irecursion > 0)
                             {PRINT(f0, "%s ___|\n", s2);
                              PRINT(f0, "%s%s\n", s2, mafter);};
                          break;};

             strcpy(s, after);

             for (desc = mem_lst; desc != NULL; desc = desc->next)
                 {mvr = svr + desc->member_offs;

                  if (PD_print_controls[1] == 0)
                     strcpy(mfield, desc->name);
                  else
                     strcpy(mfield, desc->member);
                  mitems = desc->number;

		  PD_CAST_TYPE(mtype, desc, mvr, svr,
			       PD_error, "BAD CAST - _PD_PRINT_LEAF", PD_PRINT);

                  mdims = desc->dimensions;

                  if (PD_print_controls[2] == 0)
                     _PD_print_data(f0,
                                    prefix, mbefore, mafter, mfield,
                                    file, mvr, mitems,
                                    mtype, mdims, mjr, def_off, 0);
                  else
                     {if (_PD_test_recursion(type, mtype))
                         {s1 = mfield + strlen(mfield);
                          sprintf(s1,"<%d>", irecursion);
                          _PD_print_data(f0,
                                         prefix, mbefore, blank, mfield,
                                         file, mvr, mitems,
                                         mtype, mdims,
                                         mjr, def_off, ++irecursion);}
                      else
                         {_PD_print_data(f0,
                                         prefix, mbefore, mafter, mfield,
                                         file, mvr, mitems,
                                         mtype, mdims,
                                         mjr, def_off, 0);};};

                  next = desc->next;
                  if (next != NULL)
                     if ((PD_print_controls[0] == 2) && (next->next == NULL))
                         mafter = spaces;};
             svr += size;};

        SFREE(s2);
        *s = '\0';};

    return;}

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

/* _PD_IO_PRINT - display a primitive type */

static void _PD_io_print(f0,
                         prefix, before, after, nodename, file, vr, nitems,
			 type, dims, mjr, def_off)
   FILE *f0;
   char *prefix, *before, *after, *nodename;
   PDBfile *file;
   char *vr;
   long nitems;
   char *type;
   dimdes *dims;
   int mjr, def_off;
   {long offset, i, j;
    char bf[MAXLINE], s[MAXLINE], **t;
    char *cp;
    short *sp;
    int k, m, nn, *ip, max1, max2, ityp, ind;
    long *lp;
#ifdef ANSI
#ifndef NO_LONG_LONG
    long long *llp;
#endif
#endif
    float *fp;
    double *dp;
    defstr *pd;
    

    offset = 1L;

    nn = 0;
    j  = 0L;
    k  = 0;
    for (i = 0L; i < nitems; i++, j += offset, k++)
        {if (k > PD_print_controls[4])
            {m  = strlen(PD_index_to_expr(bf, j, dims, mjr, def_off));
             nn = max(nn, m);
             k  = 0;};};
    nn += 7;

    memset(s, ' ', LINE_SIZE);

    pd   = PD_inquire_host_type(file, type);
    ityp = pd->size;

/* check for floating point types */
    if (pd->format != NULL)
       {if (strcmp(type, "float") == 0)
	   {fp = (float *) vr;
	    DISP_DATA(f0, fp, nitems, 2);}

       else if (strcmp(type, "double") == 0)
	  {dp = (double *) vr;
	   DISP_DATA(f0, dp, nitems, 3);}

       else if (strcmp(type, "REAL") == 0)
	  {if (sizeof(REAL) == sizeof(double))
	      {dp = (double *) vr;
	       DISP_DATA(f0, dp, nitems, 3);}
	   else
	      {fp = (float *) vr;
	       DISP_DATA(f0, fp, nitems, 2);};};}

/* only non-floating point types remain
 * user defined integral primitive types
 * can go off the byte size
 */
    else if (pd->convert >= 0)
       {if (strcmp(type, "short") == 0)
	   {sp = (short *) vr;
	    DISP_DATA(f0, sp, nitems, 4);}

	else if (strcmp(type, "int") == 0)
	   {ip = (int *) vr;
	    DISP_DATA(f0, ip, nitems, 0);}

	else if (strcmp(type, "integer") == 0)
	   {ip = (int *) vr;
	    DISP_DATA(f0, ip, nitems, 0);}

	else if (strcmp(type, "long") == 0)
	   {lp = (long *) vr;
	    DISP_DATA(f0, lp, nitems, 1);}
#ifdef ANSI
#ifndef NO_LONG_LONG
	else if (strcmp(type, "long_long") == 0)
	   {llp = (long long *) vr;
	    DISP_DATA(f0, llp, nitems, 6);}
#endif
#endif
/* GOTCHA: This is a feeble first step toward a generalized
 *         print capability for user defined types
 */
	else if (strcmp(type, "char_8") == 0)
	   {if (SC_strstr(PD_print_formats1[5], "%s") != NULL)
	       {cp = (char *) vr;
		t  = FMAKE_N(char *, nitems, "_PD_IO_PRINT:t");
		for (i = 0; i < nitems; i++, cp += ityp)
		    {t[i] = FMAKE_N(char, ityp + 1,
                                          "_PD_IO_PRINT:t[]");
		     memcpy(t[i], cp, ityp);
		     t[i][ityp] = '\0';};
		DISP_DATA(f0, t, nitems, 5);
		for (i = 0; i < nitems; i++)
		    SFREE(t[i]);
		SFREE(t);}
	    else
	       {cp = (char *) vr;
		DISP_DATA(f0, cp, ityp*nitems, 5);};}

	else if (strcmp(type, "function") == 0)
	   {PRINT(f0, "%s%s%s = ", prefix, before, nodename);
	    PRINT(f0, "<function>\n");}

	else if (ityp == sizeof(char))
	   {if (strcmp(type, "char") == 0)
               ind = 5;
            else
               ind = 7;
            if (SC_strstr(PD_print_formats1[ind], "%s") != NULL)
	       {if ((nitems == 1L) && (offset == 0L))
		   PRINT(f0, "%s%s%s = %c\n", prefix, before,
			 nodename, *(char *) vr);
	        else
		   {max1 = MAXLINE - 7 - strlen(prefix) -
		           strlen(before) - strlen(nodename);
		    max2 = max1 + strlen(before) - strlen(after);
		    cp = (char *) vr;

		    i = min(nitems, max1);
		    nitems -= i;
		    strncpy(bf, cp, i);
		    bf[i] = '\0';
		    cp += i;
		    PRINT(f0, "%s%s%s = \"%s\"\n", prefix, before,
			  nodename, bf);
		    while (nitems > 0L)
		       {i = min(nitems, max2);
			nitems -= i;
			strncpy(bf, cp, i);
			bf[i] = '\0';
			cp += i;
			PRINT(f0, "%s%s%s = \"%s\"\n", prefix, after,
			      nodename, bf);};};}
	   else
	      {cp = (char *) vr;
	       DISP_DATA(f0, cp, nitems, ind);};}

        else if (ityp == sizeof(short))
	   {sp = (short *) vr;
	    DISP_DATA(f0, sp, nitems, 7);}

	else if (ityp == sizeof(int))
	   {ip = (int *) vr;
	    DISP_DATA(f0, ip, nitems, 7);}

	else if (ityp == sizeof(long))
	   {lp = (long *) vr;
	    DISP_DATA(f0, lp, nitems, 7);}

	else
	   {PRINT(f0, "%s%s%s = ", prefix, before, nodename);
	    PRINT(f0, "<type %s unprintable>\n", type);};}
    else
       {PRINT(f0, "%s%s%s = ", prefix, before, nodename);
	PRINT(f0, "<type %s unprintable>\n", type);};

    return;}

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

/* _PD_TEST_RECURSION - test if this is a recursive definition */

static int _PD_test_recursion(type, mtype)
   char *type;
   char *mtype;
   {int irec;
    char *dtype;

    if (_PD_indirection(mtype))
       {dtype = PD_dereference(SC_strsavef(mtype,
                               "char*:_PD_TEST_RECURSION:dtype"));
        if (strcmp(dtype, type) == 0)
           irec = TRUE;
        else
           irec = FALSE;

        SFREE(dtype);}
    else
       irec = FALSE;

    return(irec);}

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

/* _PD_SET_USER_FORMATS - replace edit formats with user specified formats  */

void _PD_set_user_formats()
   {if (PD_user_formats1[0] != NULL)
       {SFREE(PD_print_formats1[0]);
        PD_print_formats1[0] = SC_strsavef(PD_user_formats1[0],
                               "char*:_PD_SET_USER_FORMATS:format1(0)");};

    if (PD_user_formats2[0] != NULL)
       {SFREE(PD_print_formats2[0]);
        PD_print_formats2[0] = SC_strsavef(PD_user_formats2[0],
                               "char*:_PD_SET_USER_FORMATS:format2(0)");};

    if (PD_user_formats1[1] != NULL)
       {SFREE(PD_print_formats1[1]);
        PD_print_formats1[1] = SC_strsavef(PD_user_formats1[1],
                               "char*:_PD_SET_USER_FORMATS:format1(1)");};

    if (PD_user_formats2[1] != NULL)
       {SFREE(PD_print_formats2[1]);
        PD_print_formats2[1] = SC_strsavef(PD_user_formats2[1],
                               "char*:_PD_SET_USER_FORMATS:format2(1)");};

    if (PD_user_formats1[2] != NULL)
       {SFREE(PD_print_formats1[2]);
        PD_print_formats1[2] = SC_strsavef(PD_user_formats1[2],
                               "char*:_PD_SET_USER_FORMATS:format1(2)");};

    if (PD_user_formats2[2] != NULL)
       {SFREE(PD_print_formats2[2]);
        PD_print_formats2[2] = SC_strsavef(PD_user_formats2[2],
                               "char*:_PD_SET_USER_FORMATS:format2(2)");};

    if (PD_user_formats1[3] != NULL)
       {SFREE(PD_print_formats1[3]);
        PD_print_formats1[3] = SC_strsavef(PD_user_formats1[3],
                               "char*:_PD_SET_USER_FORMATS:format1(3)");};

    if (PD_user_formats2[3] != NULL)
       {SFREE(PD_print_formats2[3]);
        PD_print_formats2[3] = SC_strsavef(PD_user_formats2[3],
                               "char*:_PD_SET_USER_FORMATS:format2(3)");};

    if (PD_user_formats1[4] != NULL)
       {SFREE(PD_print_formats1[4]);
        PD_print_formats1[4] = SC_strsavef(PD_user_formats1[4],
                               "char*:_PD_SET_USER_FORMATS:format1(4)");};

    if (PD_user_formats2[4] != NULL)
       {SFREE(PD_print_formats2[4]);
        PD_print_formats2[4] = SC_strsavef(PD_user_formats2[4],
                               "char*:_PD_SET_USER_FORMATS:format2(4)");};

    if (PD_user_formats1[5] != NULL)
       {SFREE(PD_print_formats1[5]);
        PD_print_formats1[5] = SC_strsavef(PD_user_formats1[5],
                               "char*:_PD_SET_USER_FORMATS:format1(5)");};

    if (PD_user_formats2[5] != NULL)
       {SFREE(PD_print_formats2[5]);
        PD_print_formats2[5] = SC_strsavef(PD_user_formats2[5],
                               "char*:_PD_SET_USER_FORMATS:format2(5)");};

    if (PD_user_formats1[7] != NULL)
       {SFREE(PD_print_formats1[7]);
        PD_print_formats1[7] = SC_strsavef(PD_user_formats1[7],
                               "char*:_PD_SET_USER_FORMATS:format1(7)");};

    if (PD_user_formats2[7] != NULL)
       {SFREE(PD_print_formats2[7]);
        PD_print_formats2[7] = SC_strsavef(PD_user_formats2[7],
                               "char*:_PD_SET_USER_FORMATS:format2(7)");};
    return;}

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

/* _PD_SET_FORMAT_DEFAULTS - set the defaults for the edit formats 
 *                         -   0 = int
 *                         -   1 = long
 *                         -   2 = float
 *                         -   3 = double
 *                         -   4 = short
 *                         -   5 = char
 *                         -   6 = long long
 *                         -   7 = bit
 */

void _PD_set_format_defaults()
   {int i;
    char tmp[80];
    

/* used for scalars */
    if (PD_print_formats1[0] != NULL)
       SFREE(PD_print_formats1[0]);
    sprintf(tmp, " %%%dd", PD_int_digits);
    PD_print_formats1[0] = SC_strsavef(tmp,
                           "char*:_PD_SET_FORMAT_DEFAULTS:format1(0)");

    if (PD_print_formats1[1] != NULL)
       SFREE(PD_print_formats1[1]);
    sprintf(tmp, " %%%dld", PD_long_digits);
    PD_print_formats1[1] = SC_strsavef(tmp,
                           "char*:_PD_SET_FORMAT_DEFAULTS:format1(1)");

    if (PD_print_formats1[2] != NULL)
       SFREE(PD_print_formats1[2]);
    sprintf(tmp, " %%# .%de", PD_float_digits);
    PD_print_formats1[2] = SC_strsavef(tmp,
                           "char*:_PD_SET_FORMAT_DEFAULTS:format1(2)");

    if (PD_print_formats1[3] != NULL)
       SFREE(PD_print_formats1[3]);
    sprintf(tmp, " %%# .%de", PD_double_digits);
    PD_print_formats1[3] = SC_strsavef(tmp,
                           "char*:_PD_SET_FORMAT_DEFAULTS:format1(3)");

    if (PD_print_formats1[4] != NULL)
       SFREE(PD_print_formats1[4]);
    sprintf(tmp, " %%%dd", PD_short_digits);
    PD_print_formats1[4] = SC_strsavef(tmp,
                           "char*:_PD_SET_FORMAT_DEFAULTS:format1(4)");

    if (PD_print_formats1[5] != NULL)
       SFREE(PD_print_formats1[5]);
    PD_print_formats1[5] = SC_strsavef("%s",
                           "char*:_PD_SET_FORMAT_DEFAULTS:format1(5)");

    if (PD_print_formats1[6] != NULL)
       SFREE(PD_print_formats1[6]);
    sprintf(tmp, " %%%dlld", PD_long_long_digits);
    PD_print_formats1[6] = SC_strsavef(tmp,
                           "char*:_PD_SET_FORMAT_DEFAULTS:format1(6)");

    if (PD_print_formats1[7] != NULL)
       SFREE(PD_print_formats1[7]);
    PD_print_formats1[7] = SC_strsavef("%x ",
                           "char*:_PD_SET_FORMAT_DEFAULTS:format1(7)");

/* used for arrays */
    for (i = 0; i < 8; i++)
        {if (PD_print_formats2[i] != NULL)
            SFREE(PD_print_formats2[i]);
         PD_print_formats2[i] = SC_strsavef(PD_print_formats1[i],
                                "char*:_PD_SET_FORMAT_DEFAULTS:formats2");};

/*
    PD_print_formats2[0] = SC_strsavef(" %20.1d",
                           "char*:_PD_SET_FORMAT_DEFAULTS:format2(0)");
    PD_print_formats2[1] = SC_strsavef(" %20.1ld",
                           "char*:_PD_SET_FORMAT_DEFAULTS:format2(1)");
    PD_print_formats2[2] = SC_strsavef(" %20.5g",
                           "char*:_PD_SET_FORMAT_DEFAULTS:format2(2)");
    PD_print_formats2[3] = SC_strsavef(" %20.5g",
                           "char*:_PD_SET_FORMAT_DEFAULTS:format2(3)");
    PD_print_formats2[4] = SC_strsavef(" %20.1d",
                           "char*:_PD_SET_FORMAT_DEFAULTS:format2(4)");
    PD_print_formats2[5] = SC_strsavef("%s",
                           "char*:_PD_SET_FORMAT_DEFAULTS:format2(5)");
*/
    return;}

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

/* _PD_SET_DIGITS - set the decimal printing precision parameters */

void _PD_set_digits(file)
   PDBfile *file;
   {int d;
    long *f;
    double log2;
    data_standard *std;
    

    log2 = log10(2.0);

    std = file->std;

    if (std->short_bytes < 0)
       d = -std->short_bytes;
    else
       d = 8*std->short_bytes;
    PD_short_digits = log2*d + 1; 

    if (std->int_bytes < 0)
       d = -std->int_bytes;
    else
       d = 8*std->int_bytes;
    PD_int_digits   = log2*d + 1; 

    if (std->long_bytes < 0)
       d = -std->long_bytes;
    else
       d = 8*std->long_bytes;
    PD_long_digits  = log2*d + 1; 

    if (std->longlong_bytes < 0)
       d = -std->longlong_bytes;
    else
       d = 8*std->longlong_bytes;
    PD_long_long_digits  = log2*d + 1; 

    f = std->float_format;
    d = min(f[2], PD_tolerance);
    PD_float_tol    = POW(2.0, -((double) d));
    PD_float_digits = log2*d + 1;

    f = std->double_format;
    d = min(f[2], PD_tolerance);
    PD_double_tol    = POW(2.0, -((double) d));
    PD_double_digits = log2*d + 1;

    return;}

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

/* PD_DIGITS_TOL - compute the number of decimal digits for printing and
 *               - the comparison tolerances for floating point numbers
 */

void _PD_digits_tol(file_a, file_b)
   PDBfile *file_a, *file_b;
   {int nmb, da, db;
    long *fa, *fb;
    double log2;
    data_standard *stda, *stdb;
    

    log2 = log10(2.0);

    stda = file_a->std;
    stdb = file_b->std;

    if (stda->short_bytes < 0)
       da = -stda->short_bytes;
    else
       da = 8*stda->short_bytes;
    if (stdb->short_bytes < 0)
       db = -stdb->short_bytes;
    else
       db = 8*stdb->short_bytes;
    nmb = max(da, db);
    PD_short_digits = log2*nmb + 1; 

    if (stda->int_bytes < 0)
       da = -stda->int_bytes;
    else
       da = 8*stda->int_bytes;
    if (stdb->int_bytes < 0)
       db = -stdb->int_bytes;
    else
       db = 8*stdb->int_bytes;
    nmb = max(da, db);
    PD_int_digits   = log2*nmb + 1; 

    if (stda->long_bytes < 0)
       da = -stda->long_bytes;
    else
       da = 8*stda->long_bytes;
    if (stdb->long_bytes < 0)
       db = -stdb->long_bytes;
    else
       db = 8*stdb->long_bytes;
    nmb = max(da, db);
    PD_long_digits  = log2*nmb + 1; 

    if (stda->longlong_bytes < 0)
       da = -stda->longlong_bytes;
    else
       da = 8*stda->longlong_bytes;
    if (stdb->longlong_bytes < 0)
       db = -stdb->longlong_bytes;
    else
       db = 8*stdb->longlong_bytes;
    nmb = max(da, db);
    PD_long_long_digits  = log2*nmb + 1; 

    fa  = stda->float_format;
    fb  = stdb->float_format;
    nmb = max(fa[2], fb[2]);
    nmb = min(nmb, PD_tolerance);
    PD_float_tol    = POW(2.0, -((double) nmb));
    PD_float_digits = log2*nmb + 1;

    fa  = stda->double_format;
    fb  = stdb->double_format;
    nmb = max(fa[2], fb[2]);
    nmb = min(nmb, PD_tolerance);
    PD_double_tol    = POW(2.0, -((double) nmb));
    PD_double_digits = log2*nmb + 1;

    return;}

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