/* (C) Copyright International Business Machines Corporation 23 January */
/* 1990.  All Rights Reserved. */
/*  */
/* See the file USERAGREEMENT distributed with this software for full */
/* terms and conditions of use. */
/* File: t_vector.cc */
/* Author: David F. Bacon */
#ifndef lint
static char sccsinfo[] = "@(#)t_vector.cc	1.17 3/13/90";
#endif

#define PRAGMA_TABLE

#ifdef vec_TABLE
#define ELEMTYPE valcell
#define DEFAULT_INIT_SIZE 8
#define DEFAULT_HUNK_SIZE 16
#define FUDGE_FACTOR 0
#define VALCAST(x) x
#else
#include <string.h>
#define ELEMTYPE char
#define DEFAULT_INIT_SIZE 16
#define DEFAULT_HUNK_SIZE 64
#define FUDGE_FACTOR 1
#define VALCAST(x) (x).enumeration
#define null_terminate(table,tbl) ((tbl)->elements[(table)->size] = nil)
#endif

#include <varargs.h>

#include "ops.h"
#include "ops_parm.h"
#include "recursiv.h"
#include "storage.h"
#include "tablefuncs.h"
#include "accessors.h"

#include "interpform.cd"

extern tbldes *tbldescriptors[];

extern datarep dr_table, dr_integer, dr_bottom, dr_ord_enumeration,
               dr_record;

#define vtbl(t, tblnum) ((t)->tbls[tblnum].rep.PRAGMA)

struct alignedelem {ELEMTYPE elem[ARBSIZE];};
#define WASTE (sizeof(struct alignedelem)-sizeof(ELEMTYPE)*ARBSIZE)
#define tbl_bytesize(nelem) (sizeof(PRAGMA_trep) \
	+ (sizeof(ELEMTYPE) * (nelem + FUDGE_FACTOR - ARBSIZE)) - WASTE)
#define tbl_alloc(nelem) ((PRAGMA_trep *) getmain(tbl_bytesize(nelem)))

#define etoh(ne, tbl) ( ( ((counter)(ne)) / (tbl->hunksize) ) + 1 )
#define htoe(nh, tbl) ( (nh) * (tbl->hunksize) )


position selector_position();
void set_selector_position();

#define REC_INIT_SIZE 0
#define REC_HUNK_SIZE 1


/* PRAGMA_alloc
*/


status
PRAGMA_alloc(tbl, repnum, newinfo)
dfd_table *tbl;
trepnum repnum;
valcell newinfo;		/* supplementary information for NEW */
{
    PRAGMA_trep *table;
    counter nelem;
    counter hsize;

    if (newinfo.record) {
	nelem = dot(newinfo, integer_pair__int_one).integer;
	hsize = dot(newinfo, integer_pair__int_two).integer;
    }
    else {
	nelem = DEFAULT_INIT_SIZE;
	hsize = DEFAULT_HUNK_SIZE;
    }

    if ((table = tbl_alloc(nelem)) is nil)
      return(FAILURE);

    table->maxsize = nelem;
    table->hunksize = hsize;

#ifdef chs_TABLE
    table->elements[0] = nil;
#endif

    vtbl(tbl, repnum) = table;

    return(SUCCESS);
}


/* PRAGMA_alloc_to_size - alternative to PRAGMA_alloc for code that
   knows precisely the initial number of elements but wants to use
   the default hunk size (to avoid having to create and deal with
   an integer_pair record, which would allow the same effect to be
   accomplished via the standard PRAGMA_alloc routine).
*/

status
PRAGMA_alloc_to_size(tbl, repnum, size)
dfd_table *tbl;
trepnum repnum;
counter size;
{
  PRAGMA_trep *table;
  
  if ((table = tbl_alloc(size)) is nil)
    return(FAILURE);

  table->maxsize = size;
  table->hunksize = DEFAULT_HUNK_SIZE;

#ifdef chs_TABLE
  table->elements[size] = nil;
#endif

  vtbl(tbl, repnum) = table;

  return(SUCCESS);
}

/* PRAGMA_finalize - finalizes all objects in a table and releases */
/* header storage */

/*ARGSUSED*/
void
PRAGMA_finalize(tbl, repnum, depth, f_op, sched)
dfd_table *tbl;
trepnum repnum;
flag depth;
finalize_op f_op;
schedblock *sched;
{
    PRAGMA_trep *table;
#ifdef vec_TABLE
    register counter i;
#endif

    table = vtbl(tbl, repnum);

#ifdef vec_TABLE
    if (depth is DEEP)
      for (i=0; i < tbl->size; i++) {
	(*tbl->tsdr->finalize)(table->elements[i], f_op, sched);
      }
#endif

    { freemain(table, tbl_bytesize(table->maxsize)); }

}


status
PRAGMA_precopy(tbl, repnum, source)
dfd_table *tbl;
trepnum repnum;
dfd_table *source;
{
    PRAGMA_trep *nt, *srctable;
    

    srctable = vtbl(source, repnum);

    if ((nt = tbl_alloc(srctable->maxsize)) is nil)
      return(FAILURE);
    nt->maxsize = srctable->maxsize;
    nt->hunksize = srctable->hunksize;

#ifdef chs_TABLE
    bzero(nt->elements, (int) nt->maxsize);
#endif

    vtbl(tbl, repnum) = nt;

    return(SUCCESS);
}


/******************************************************************************
 *                 support functions for space management                     *
 *****************************************************************************/

/* PRAGMA_make_space - opens a gap in the middle of a table by copying
   (in-place) elements from the end of the table upwards.  The table's
   current allocated size must be large enough to accomodate the
   expansion.
*/

void
PRAGMA_make_space(tbl, tblnum, p, amount)
dfd_table *tbl;
trepnum tblnum;
counter p;
counter amount;
{
    PRAGMA_trep *t;
    counter amount_to_move;
    register counter i;
    register ELEMTYPE *src;
    register ELEMTYPE *dst;
  
    t = vtbl(tbl, tblnum);

    src = t->elements + tbl->size - 1; /* current end */
    dst = src + amount;		/* new end */
    amount_to_move = tbl->size - p;

    for (i=0; i < amount_to_move; i++)
      *dst-- = *src--;

#ifdef chs_TABLE
    t->elements[tbl->size + amount] = nil;
#endif
}  
  


/* PRAGMA_add_space - increases size of table storage (in units of
   TABLE_HUNK_SIZE).  Leaves the empty space in a gap at a specified
   position within the table (not necessarily at the end)
*/

status
PRAGMA_add_space(tbl, tblnum, p, amount)
dfd_table *tbl;
trepnum tblnum;
counter p;			/* position where space needed */
counter amount;			/* amount of space needed */
{
    PRAGMA_trep *t, *newt;
    register counter i;
    counter newmax;
    register ELEMTYPE *src;
    register ELEMTYPE *dst;
    
    t = vtbl(tbl, tblnum);

    newmax = htoe(etoh(tbl->size + amount, t), t);
    if ((newt = tbl_alloc(newmax)) is nil)
      return(FAILURE);
    newt->maxsize = newmax;
    newt->hunksize = t->hunksize;

    /* move part before the gap we want to open */
    src = t->elements;
    dst = newt->elements;
    for (i=0; i<p; i++)
      *dst++ = *src++;

    dst += amount;
    for (i = p; i < tbl->size; i++) /* move part after gap */
      *dst++ = *src++;

    { freemain(t, tbl_bytesize(t->maxsize)); }

#ifdef chs_TABLE
    newt->elements[tbl->size + amount] = nil;
#endif

    vtbl(tbl, tblnum) = newt;

    return(SUCCESS);
}

  
/******************************************************************************
 *                insertion operations (insert, uninsert)                     *
 *****************************************************************************/

predef_exception
PRAGMA_insert(tbl, repnum, val)
dfd_table *tbl;
trepnum repnum;
valcell val;
{
    PRAGMA_trep *table;


    table = vtbl(tbl, repnum);

    if (tbl->size is table->maxsize) {
	if (!PRAGMA_add_space(tbl, repnum, tbl->size, 1))
	  return(Depletion);
	table = vtbl(tbl, repnum);
    }

    table->elements[tbl->size] = VALCAST(val);
#ifdef chs_TABLE
    table->elements[tbl->size+1] = nil;
#endif

    return(Normal);
}


/*ARGSUSED*/
void
PRAGMA_uninsert(tbl, repnum, val)
dfd_table *tbl;
trepnum repnum;
valcell val;
{
#ifdef chs_TABLE
    null_terminate(tbl, vtbl(tbl, repnum));
#endif
}



int
PRAGMA_foreach(va_alist)
va_dcl
{
    PRAGMA_trep *table;
    valcell val;
    int rc;


    va_tableargs(argv, thetable, tblnum, func, elemcounter, expectedval)


    table = vtbl(thetable, tblnum);

    for (*elemcounter = 0; *elemcounter < thetable->size; (*elemcounter)++) {
	VALCAST(val) = table->elements[*elemcounter];

	rc = (*func)(thetable, tblnum, val, *elemcounter, argv);
	if (rc isnt expectedval)
	  return(rc);
    }

    va_end(argv);

    return(expectedval);
}
      


status
PRAGMA_equal(t1, tblnum, t2)
dfd_table *t1;
trepnum tblnum;
dfd_table *t2;
{
    register ELEMTYPE *ep1, *ep2;
#ifdef vec_TABLE
    register counter i;
    status (*eqtest)();
#endif

    ep1 = vtbl(t1, tblnum)->elements;
    ep2 = vtbl(t2, tblnum)->elements;

#ifdef vec_TABLE

    eqtest = t1->tsdr->equal;
    for (i=0; i < t1->size; i++)
      if ((*eqtest)(*ep1++, *ep2++) is FAILURE)
	return(FAILURE);

    return(SUCCESS);

#else

    if (bcmp(ep1, ep2, (int) t1->size) is 0)
      return(SUCCESS);
    else
      return(FAILURE);

#endif

}


comparison
PRAGMA_comparekeys(t1, tblnum, t2)
dfd_table *t1;
trepnum tblnum;
dfd_table *t2;
{
    register counter i;
    register ELEMTYPE *ep1, *ep2;
#ifdef vec_TABLE
    register comparison (*cmpfunc)() = t1->tsdr->comparekeys;
    register comparison cmp;
#endif

    ep1 = vtbl(t1, tblnum)->elements;
    ep2 = vtbl(t2, tblnum)->elements;

    for (i = 0; i < t1->size; i++, ep1++, ep2++) {

#ifdef chs_TABLE
	if (*ep1 < *ep2)
	  return(CMP_LESS);
	else if (*ep1 > *ep2)
	  return(CMP_GREATER);
#else
	if ((cmp = (*cmpfunc)(*ep1, *ep2)) isnt CMP_EQUAL)
	  return(cmp);
#endif

    }

    return(CMP_EQUAL);		/* all elements equal?  then the tables are. */
}




/******************************************************************************
 *                             Ordered Operations                             *
 *****************************************************************************/

/* PRAGMA_insert_at - inserts an object (actually just the object's valcell)
   at a particular position within the table.  grows the table by one
   hunk if it won't fit.
*/

predef_exception
PRAGMA_insert_at(tbl, tblnum, val, pos)
dfd_table *tbl;
trepnum tblnum;
valcell val;
counter pos;
{
    PRAGMA_trep *t;

    t = vtbl(tbl, tblnum);

    if (tbl->size is t->maxsize) {
				/* no more space? */
	if (!PRAGMA_add_space(tbl, tblnum, pos, 1))
	  return(Depletion);
	t = vtbl(tbl, tblnum);
    }
    else
      PRAGMA_make_space(tbl, tblnum, pos, 1);
				/* if we have space, we just shift things  */
  
    t->elements[pos] = VALCAST(val);

    return(Normal);
}  

/*ARGSUSED*/
void
PRAGMA_remove_at(tbl, tblnum, val, pos)
dfd_table *tbl;
trepnum tblnum;
valcell *val;
counter pos;
{
    void PRAGMA_unmerge_at();

    PRAGMA_trep *t;


    t = vtbl(tbl, tblnum);

    VALCAST(*val) = t->elements[pos]; /* "remove" the element */

    PRAGMA_unmerge_at(tbl, tblnum, val, pos, 1);
}


predef_exception
PRAGMA_merge_at(tbl, tblnum, mergetbl, intpos)
dfd_table *tbl;
trepnum tblnum;
dfd_table *mergetbl;
int intpos;
{
    PRAGMA_trep *t, *mt;
    register ELEMTYPE *src, *dst;
    register int i;


    t = vtbl(tbl, tblnum);
    mt = vtbl(mergetbl, tblnum);

    if (t->maxsize < tbl->size + mergetbl->size) {
	if (!PRAGMA_add_space(tbl, tblnum, (counter) intpos, mergetbl->size))
	  return(Depletion);
	t = vtbl(tbl, tblnum);
    }
    else
      PRAGMA_make_space(tbl, tblnum, (counter) intpos, mergetbl->size);
  
    src = mt->elements;
    dst = t->elements + intpos;
    for (i = 0; i < mergetbl->size; i++)
      *dst++ = *src++;
    return(Normal);
}


/* PRAGMA_unmerge_at - gets rid of a given number of elements at the
   given position in the table... called when an insert_at or merge_at
   operation failed on some other table representation.  Table size is
   assumed to reflect the original table size, prior to the insert or
   merge operation that crapped out (so there are currently extra
   elements "hanging" off the end of the vector in this
   representation).
*/

/*ARGSUSED*/
void
PRAGMA_unmerge_at(tbl, repnum, val, pos, count)
dfd_table *tbl;
trepnum repnum;
valcell val;
counter pos;
counter count;
{
    register ELEMTYPE *src, *dst;
    register int i;

    dst = vtbl(tbl, repnum)->elements + pos;
    src = dst+count;

    for (i = pos; i < tbl->size; i++)
      *dst++ = *src++;

#ifdef chs_TABLE
    *dst = nil;
#endif

}

void
PRAGMA_lookup_at(t, tblnum, val, intpos)
dfd_table *t;
trepnum tblnum;
valcell *val;
int intpos;
{
    VALCAST(*val) = vtbl(t, tblnum)->elements[intpos];
}


/*ARGSUSED*/
predef_exception
PRAGMA_conc_at(t, tblnum, conctable, result)
dfd_table *t;
trepnum tblnum;
dfd_table *conctable;
dfd_table **result;
{
    return(Depletion);		/* concat currently implemented using merge */
}

/******************************************************************************
 *                        operations for get-loops                            *
 *****************************************************************************/

/*ARGSUSED*/
status
PRAGMA_initget(tbl, tblnum, pos, intpos)
dfd_table *tbl;
trepnum tblnum;
position *pos;
int intpos;
{
    pos->PRAGMA = intpos;
    return(SUCCESS);
}


/*ARGSUSED*/
int
PRAGMA_position_of(tbl, tblnum, pos)
dfd_table *tbl;
trepnum tblnum;
position pos;
{
    return(pos.PRAGMA-1);	/* pos always points to the *next* element, */
				/*  so we have to adjust by 1. */
}



predef_exception
PRAGMA_get(tbl, tblnum, pos, val)
dfd_table *tbl;
trepnum tblnum;
position *pos;
valcell *val;
{
    if (pos->PRAGMA >= tbl->size)
      return(NotFound);		/* do range check */

    VALCAST(*val) = vtbl(tbl, tblnum)->elements[pos->PRAGMA];
				/* extract current element value */

    pos->PRAGMA++;		/* advance to next element */

    return(Normal);
}


/*ARGSUSED*/
void
PRAGMA_remove(tbl, tblnum, val, keynum, seltblnum, pos)
dfd_table *tbl;
trepnum tblnum;
valcell val;
trepnum keynum;
trepnum seltblnum;
position *pos;
{
    PRAGMA_trep *t;
    int rempos;


    t = vtbl(tbl, tblnum);

    if (tblnum is seltblnum)
      rempos = --(pos->PRAGMA);	/* position of currently get'ed element */
				/*  is actually pos - 1, since pos always */
				/*  points to the NEXT element. */

    else			/* if we aren't selecting on the order, */
				/*  find an element which matches the */
				/*  value and remove that one (there must be */
				/*  at least one, since val is from the  */
				/*  table). */
      for (rempos = tbl->size - 1; rempos >= 0; rempos--) {

#ifdef vec_TABLE
	  if (t->elements[rempos].nominal is val.nominal)
	    break;
#else
	  if (t->elements[rempos] is val.enumeration)
	    break;
#endif

      }

    /* actually remove the element from the table */
    PRAGMA_unmerge_at(tbl, tblnum, val, rempos, 1);
}


/*ARGSUSED*/
void
PRAGMA_endget(tbl, tblnum, pos)
dfd_table *tbl;
trepnum tblnum;
position *pos;
{
}


#ifdef chs_TABLE

NILOP(o_chs_lit)
{
    void re_finalize();
    predef_exception cp_table();

    predef_exception retcode;
    valcell newchs;
    extern flag cherm_flag;

    if ((retcode = cp_table(&newchs, args->qualifiers)) is Normal) {
      if (not cherm_flag)
	re_finalize(DstObj, F_DISCARD, args->sched);
				 /* finalize the value of the destination; */
      Dst = newchs;
      set_init(DstObj, dr_table);
    }
    else
      raise(retcode);
}


status
chs_lit(obj, str)
objectp obj;
char *str;
{
    counter len;
    dfd_table *table;
    chs_trep *chstable;

    if ((table = new(dfd_table)) is nil)
      return(FAILURE);
    len = strlen(str);
    if ((chstable = tbl_alloc(len)) is nil) {
	{ dispose(table, dfd_table); }
	return(FAILURE);
    }

    table->refcount = 1;
    table->size = len;
    table->ordered = TRUE;
    table->tblcount = 1;
    table->tsdr = & dr_ord_enumeration; /* this is what chars really are */
    table->keyset.table = nil;
    table->indexset.table = nil;

    chstable->maxsize = len;
    chstable->hunksize = 64;
    (void) strcpy(chstable->elements, str);

    table->tbls[0].des = tbldescriptors[table_rep_type__charstring];
    table->tbls[0].rep.chs = chstable;

    obj->value.table = table;
    obj->tsdr = & dr_table;

    return(SUCCESS);
}

#else

/* only for vector pragma: return default size of a vector; this is used by */
/* the quickcell management routines in lib/storage.c. */

int
get_default_vector_size()
{
    return(tbl_bytesize(DEFAULT_INIT_SIZE));
}

/* another one only for vectors: return allocation size required for a */
/* vector of the given size */
int
get_vector_size(nelem)
{
  return(tbl_bytesize(nelem));
}
#endif
