/*
 * PDMEMB.C - member handling routines for PDBLib
 *
 * Source Version: 9.0
 * Software Release #92-0043
 *
 */

#include "cpyright.h"

#include "pdb.h"

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

/*                          ACCESSOR FUNCTIONS                              */

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

/* _PD_MEMBER_TYPE - strip off dimensions and member_name by inserting
 *                 - a '\0' after the type specification
 *                 - and return a pointer to the string
 */

char *_PD_member_type(s)
   char *s;
   {char *t, *p, c, bf[MAXLINE], *pt;

    strcpy(bf, s);

/* find a pointer to the last '*' in the string */
    for (p = bf, t = bf; (c = *t) != '\0'; t++)
        if (c == '*')
           p = t;

/* if there was a '*' replace the next character with a '\0' */
    if (p != bf)
       *(++p) = '\0';

/* otherwise the type is not a pointer so return the first token */
    else
       SC_strtok(bf, " \t\n\r", pt);

    return(SC_strsavef(bf, "char*:_PD_MEMBER_TYPE:bf"));}

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

/* _PD_MEMBER_BASE_TYPE - extract the base type (no indirections) of the
 *                      - given member and return a copy of it
 */

char *_PD_member_base_type(s)
   char *s;
   {char *token, bf[MAXLINE];

    strcpy(bf, s);
    token = SC_firsttok(bf, " *");

    return(SC_strsavef(token, "char*:_PD_MEMBER_BASE_TYPE:token"));}

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

/* _PD_HYPER_TYPE - adjust type for dimension expression dereferences */

/* GOTCHA: This function is currently a no-op; it returns the original type */

char *_PD_hyper_type(name, type)
   char *name;
   char *type;
   {return(type);}

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

/* _PD_MEMBER_NAME - given the member description extract the name and
 *                 - return a pointer to it
 *                 - new space is allocated for the name
 */

char *_PD_member_name(s)
   char *s;
   {char *pt, *token, bf[MAXLINE];

    strcpy(bf, s);
    SC_firsttok(bf, " *(");
    for (pt = bf; strchr(" \t*(", *pt) != NULL; pt++);
    token = SC_firsttok(pt, "()[");

    return(SC_strsavef(token, "char*:_PD_MEMBER_NAME:token"));}

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

/* _PD_EX_DIMS - extract the dimension information from the given string
 *             - return dimensions interpreted as definition
 *             - e.g., x(i) interpreted as x(defoff:defoff+i-1)
 *             - if there are no dimensions or bad dimensions, return NULL
 */

dimdes *_PD_ex_dims(memb, defoff)
   char *memb;
   int defoff;
   {char *token, *maxs, bf[MAXLINE];
    long mini, leng;
    dimdes *dims, *next, *prev;

    prev = NULL;
    dims = NULL;
    strcpy(bf, memb);
    token = SC_firsttok(bf, "([\001\n");
    while ((token = SC_firsttok(bf, ",)] ")) != NULL)
       {maxs = strchr(token, ':');
        if (maxs != NULL)
           {*maxs++ = '\0';
            mini = atol(token);
            leng = atol(maxs) - atol(token) + 1L;}
        else
           {mini = defoff;
            leng = atol(token);};

        if (leng <= 0L)
           return(NULL);

        next = _PD_mk_dimensions(mini, leng);

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

        prev = next;};

    return(dims);}

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

/* _PD_ADJ_DIMENSIONS - adjust dimension expressions in name for append.
 *                      For now, indexes for all dimensions must include
 *                      min and max (stride optional) and must match the
 *                      post-append dimensions. All but the most slowly
 *                      varying index must match the pre-append dimensions.
 *                      Because the pre-append dimensions are already known
 *                      the above conditions on the dimensions not changing
 *                      may be relaxed in the future for user convenience
 *                      or to support partial writes in appends.
 */

int _PD_adj_dimensions(file, name, ep)
   PDBfile *file;
   char *name;
   syment *ep;
   {char *token, *smax, *sinc;
    char head[MAXLINE], expr[MAXLINE], tail[MAXLINE], bf[MAXLINE];
    long imin, imax, istep, i;
    dimdes *dims;
    
    expr[0] = '\0';
    dims = ep->dimensions;
    strcpy(bf, name);
    strcpy(head, SC_firsttok(bf, "([\001\n"));
    tail[0] = '\0';

    while ((token = SC_firsttok(bf, ",)] ")) != NULL)
       {if (token[0] == '.')
	   {strcpy(tail, token);
	    break;};
	smax = strchr(token, ':');
	if (smax == NULL)
	   PD_error("MAXIMUM INDEX MISSING - _PD_ADJ_DIMENSIONS", PD_WRITE);
	*smax++ = '\0';
	sinc = strchr(smax, ':');
	if (sinc != NULL)
	   *sinc++ = '\0';

	imin = atol(token);
	imax = atol(smax);
	if (sinc != NULL)
	   istep = atol(sinc);
	else
	   istep = 1;

	if (imin == file->default_offset)
	   if (((file->major_order == ROW_MAJOR_ORDER) &&
		(dims == ep->dimensions)) ||
	       ((file->major_order == COLUMN_MAJOR_ORDER) &&
		(dims->next == NULL)))
	      {i = dims->index_max + 1 - imin;
	       imin += i;
	       imax += i;};

	sprintf(expr, "%s%ld:%ld:%ld,", expr, imin, imax, istep);
        dims = dims->next;};

    if (expr[0] != '\0')
       {if (strchr(head, '.') != NULL)
	   PD_error("APPEND TO TOP LEVEL OF STRUCT ONLY - _PD_ADJ_DIMENSIONS",
		    PD_WRITE);
	expr[strlen(expr) - 1] = '\0';
	sprintf(name, "%s[%s]%s", head, expr, tail);};

    return(TRUE);}

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

/* _PD_MEMBER_ITEMS - return the total number of items as specified by
 *                  - the dimensions in the given member
 *                  - return -1 on error
 */

long _PD_member_items(s)
   char *s;
   {char *token, bf[MAXLINE], *t;
    long acc;

    strcpy(bf, s);
    token = SC_strtok(bf, "(\001\n", t);
    acc = 1L;
    while ((token = SC_strtok(NULL, ",) ", t)) != NULL)
       if ((acc *= atol(token)) <= 0)
          return(-1L);

    return(acc);}

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

/* _PD_COMP_NUM - compute the number of elements implied by the dimensions
 *              - of a variable
 */

long _PD_comp_num(dims)
   dimdes *dims;
   {long acc;
    dimdes *lst;

    for (acc = 1L, lst = dims; lst != NULL; lst = lst->next)
        {acc *= (long) (lst->number);};

    return(acc);}

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

/* _PD_STR_SIZE - compute sizeof for the defstruct specified
 *              - return -1 iff some member of the struct is undefined
 */

long _PD_str_size(str, tab)
   memdes *str;
   HASHTAB *tab;
   {int align, al_max, lal;
    long i, sz, number;
    memdes *desc;

    sz     = 0L;
    al_max = 0;

#ifdef AIX
    {defstr *dp;

     dp = PD_inquire_table_type(tab, str->type);

     if (dp->members == NULL)
        al_max = _PD_lookup_size(str->type, tab);};
#endif

    for (desc = str; desc != NULL; desc = desc->next)
        {number = desc->number;
         i = _PD_lookup_size(desc->type, tab);
         if (i == -1L)
            return(-1L);

         align = _PD_align(sz, desc->type, tab, &lal);
         if (align == -1)
            return(-1L);

         al_max = max(al_max, lal);

         desc->member_offs = sz + align;

         sz += align + i*number;};

    if (al_max != 0)
       {i  = (sz + al_max - 1)/al_max;
        sz = al_max*i;};

    return(sz);}

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

/* _PD_ALIGN - return the number of bytes needed to put an object of TYPE
 *           - on the proper byte boundary
 */

int _PD_align(n, type, tab, palign)
   long n;
   char *type;
   HASHTAB *tab;
   int *palign;
   {long offset, align, nword;
    defstr *dp;

    if (type == NULL)
       {*palign = 0;
        return(0);};

    if (_PD_indirection(type))
       dp = PD_inquire_table_type(tab, "*");
    else
       dp = PD_inquire_table_type(tab, type);

    if (dp == NULL)
       {*palign = -1;
        return(-1);}
    else
       align = dp->alignment;

    if (align != 0)
       {nword  = (n + align - 1)/align;
        offset = align*nword - n;}
    else
       offset = 0;

    *palign = align;

    return(offset);}

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

/* _PD_LOOKUP_TYPE - look up the type given in structure chart and
 *                 - return the defstr
 */

defstr *_PD_lookup_type(s, tab)
   char *s;
   HASHTAB *tab;
   {char *token, bf[MAXLINE], *t;

/* if it's a POINTER handle it now */
    if (strchr(s, '*') != NULL)
       strcpy(bf, "*");
    else
       strcpy(bf, s);

    token = SC_strtok(bf, " ", t);
    return(PD_inquire_table_type(tab, token));}

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

/* _PD_LOOKUP_SIZE - THREADSAFE
 *                 - look up the type given in structure chart and
 *                 - return the size
 */

long _PD_lookup_size(s, tab)
   char *s;
   HASHTAB *tab;
   {char *token, bf[MAXLINE], *t;
    defstr *dp;

/* if it's a POINTER handle it now */
    if (strchr(s, '*') != NULL)
       strcpy(bf, "*");
    else
       strcpy(bf, s);

    token = SC_strtok(bf, " ", t);
    dp    = PD_inquire_table_type(tab, token);
    if (dp != NULL)
       return(dp->size);
    else
       return(-1L);}

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

/* _PD_MEMBER_LOCATION - return the byte offset (0 based) of the given
 *                     - member from the beginning of the struct
 *                     - don't get rid of this (some applications use it!)
 */

long _PD_member_location(s, tab, dp, pdesc)
   char *s;
   HASHTAB *tab;
   defstr *dp;
   memdes **pdesc;
   {long addr;
    char *token, name[MAXLINE];
    memdes *desc, *nxt;

    strcpy(name, s);
    token = SC_firsttok(name, ".\001");

    for (addr = 0L, desc = dp->members; desc != NULL; desc = nxt)
        {nxt = desc->next;
         if (strcmp(desc->name, token) == 0)
            {addr  += desc->member_offs;
	     *pdesc = desc;
             dp = PD_inquire_table_type(tab, desc->base_type);
             if (dp != NULL)
                {token = SC_firsttok(name, ".\001");
                 if (token == NULL)
                    return(addr);
                 else
                    nxt = dp->members;};};};

    return(-1L);}
                 
/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PD_INQUIRE_SYMBOL - look up the entry for the named quantity */

hashel *PD_inquire_symbol(file, name, flag, fullname, tab)
   PDBfile *file;
   char *name;
   int flag;
   char *fullname;
   HASHTAB *tab;
   {char s[MAXLINE], t[MAXLINE];
    hashel *hp;

    if (flag)
       strcpy(s, _PD_fixname(file, name));
    else
       strcpy(s, name);

    if (fullname != NULL)
       strcpy(fullname, s);

    hp = SC_lookup(s, tab);

/* if the file has directories and the entry is not "/",
 * treat entry with and without initial slash as equivalent, 
 */
    if ((hp == NULL) &&
	(PD_has_directories(file)) &&
	(strcmp(s, "/") != 0))
       {if (strrchr(s, '/') == s)
	   hp = SC_lookup(s + 1, tab);

        else if (strrchr(s, '/') == NULL)
	   {sprintf(t, "/%s", s);
	    hp = SC_lookup(t, tab);};};

    return(hp);}
	  
/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* PD_INQUIRE_ENTRY - look up the symbol table entry for the named quantity */

syment *PD_inquire_entry(file, name, flag, fullname)
   PDBfile *file;
   char *name;
   int flag;
   char *fullname;
   {hashel *hp;

    hp = PD_inquire_symbol(file, name, flag,
			   fullname, file->symtab);
    
    return((hp == NULL) ? NULL : (syment *) hp->def);}
	  
/*--------------------------------------------------------------------------*/
/*--------------------------------------------------------------------------*/

/* _PD_WR_ITAG - write an itag to the file
 *             - for a NULL pointer do:
 *             -     _PD_wr_itag(file, 0L, type, -1L, 0)
 *             - for a pointer to data elsewhere do:
 *             -     _PD_wr_itag(file, nitems, type, addr, 0)
 *             - for a pointer to data here do:
 *             -     _PD_wr_itag(file, nitems, type, addr, 1)
 *             - for a pointer to discontiguous data do:
 *             -     _PD_wr_itag(file, nitems, type, addr, 2)
 *             -     then addr is interpreted as the address of the next
 *             -     block of data
 */

int _PD_wr_itag(file, nitems, type, addr, flag)
   PDBfile *file;
   long nitems;
   char *type;
   long addr;
   int flag;
   {long ad, count;
    char name[MAXLINE];
    syment *ep;
    FILE *fp;

    if (file->virtual_internal == TRUE)
       return(TRUE);

    fp = file->stream;

/* must have a definite large number of digits in address field
 * in order to support relocation
 */
    io_printf(fp,
	      "%ld\001%s\001%32ld\001%d\001\n",
	      nitems, type, addr, flag);

    if ((nitems > 0) && (flag == 1))
       {count = file->n_dyn_spaces;

        sprintf(name, "/&ptrs/ia_%ld", count++);
	ad = io_tell(fp);
	ep = _PD_mk_syment(type, nitems, ad, NULL, NULL);
	_PD_e_install(name, ep, file->symtab);

	file->n_dyn_spaces = count;};

    return(TRUE);}

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

/* _PD_RD_ITAG - fill an itag from the file */

int _PD_rd_itag(file, pi)
   PDBfile *file;
   PD_itag *pi;
   {FILE *fp;
    char *token, *s;
    static char bf[MAXLINE];

    fp = file->stream;

    _PD_rfgets(bf, MAXLINE, fp);

    token = SC_strtok(bf, "\001", s);
    if (token == NULL)
       return(FALSE);
    pi->nitems = atol(token);

    pi->type = SC_strtok(NULL, "\001\n", s);
    if (pi->type == NULL)
       return(FALSE);

    token = SC_strtok(NULL, "\001\n", s);
    if (token == NULL)
       {pi->addr = -1L;
        pi->flag = TRUE;}
    else
       {pi->addr  = atol(token);
        token = SC_strtok(NULL, "\001\n", s);
        if (token == NULL)
           pi->flag = TRUE;
        else
           pi->flag = atoi(token);};

    return(TRUE);}

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

/* _PD_ROW_MAJOR_EXPR - compute and return an index expression given a
 *                    - string BF to store it in, a list PD containing the
 *                    - limits of each dimension, and an offset index,
 *                    - INDX, which is to be converted
 *                    - assume ROW_MAJOR_ORDER
 */

static char *_PD_row_major_expr(bf, pd, indx, def_off)
   char *bf;
   dimdes *pd;
   long indx;
   int def_off;
   {char tmp[80];
    long ix, m, stride;
    dimdes *pt;

    if (pd == NULL)
       sprintf(bf, "%ld", indx + def_off);
    else
       {bf[0] = '\0';

        stride = 1L;
        for (pt = pd; pt != NULL; pt = pt->next)
            stride *= pt->number;

        while (pd != NULL)
           {stride /= pd->number;

            m  = indx / stride;
            ix = m + pd->index_min;

            sprintf(tmp, "%ld,", ix);
            strcat(bf, tmp);

            indx -= m*stride;
            pd    = pd->next;};

        m     = strlen(bf) - 1;
        bf[m] = '\0';};

    return(bf);}

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

/* _PD_COL_MAJOR_EXPR - compute and return an index expression given a
 *                    - string BF to store it in, a list PD containing the
 *                    - limits of each dimension, and an offset index,
 *                    - INDX, which is to be converted
 *                    - assume COLUMN_MAJOR_ORDER
 */

static char *_PD_col_major_expr(bf, pd, indx, def_off)
   char *bf;
   dimdes *pd;
   long indx;
   int def_off;
   {char tmp[80];
    long ix, m, stride;

    if (pd == NULL)
       sprintf(bf, "%ld", indx + def_off);
    else
       {bf[0] = '\0';

        while (pd != NULL)
           {stride = pd->number;
            m  = indx - (indx/stride)*stride;
            ix = m + pd->index_min;
            sprintf(tmp, "%ld,", ix);
            strcat(bf, tmp);

            indx = (indx - m)/stride;
            pd = pd->next;};

        m     = strlen(bf) - 1;
        bf[m] = '\0';};

    return(bf);}

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

/* PD_INDEX_TO_EXPR - convert a linear index into
 *                  - an ASCII index expression
 */

char *PD_index_to_expr(bf, indx, dim, major_order, def_off)
   char *bf;
   long indx;
   dimdes *dim;
   int major_order, def_off;
   {bf[0] = '\0';

    if (major_order == COLUMN_MAJOR_ORDER)
       return(_PD_col_major_expr(bf, dim, indx, def_off));
    else if (major_order == ROW_MAJOR_ORDER)
       return(_PD_row_major_expr(bf, dim, indx, def_off));
    else
       return(NULL);}

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