/*
 * File: rstruct.c
 *  Contents: addmem, cplist, cpset, hmake, hchain, hgener, hgrow, hshrink, memb
 */

#include "..\h\config.h"
#include "..\h\rt.h"
#include "rproto.h"

/*
 * addmem - add a new set element block in the correct spot in
 *  the bucket chain.
 */

novalue addmem(ps,pe,pl)
union block **pl;
struct b_set *ps;
struct b_selem *pe;
   {
   ps->size++;
   if (*pl != NULL )
      pe->clink = *pl;
   *pl = (union block *) pe;
   }

/*
 * cplist(dp1,dp2,i,j) - copy sublist dp1[i:j] into dp2.
 */

int cplist(dp1, dp2, i, j)
dptr dp1, dp2;
word i, j;
   {
   register dptr dp;
   word size, nslots;
   struct b_list *lp1, *lp2;
   struct b_lelem *bp1, *bp2;

   /*
    * Calculate the size of the sublist and fail if it's less than 0.
    *  Also round nslots up to the minimum list block size.
    */
   size = nslots = j - i;

   /*
    * Get pointers to the list and list elements for the source list
    *  (bp1, lp1) and the sublist (bp2, lp2).
    */
   if (blkreq(sizeof(struct b_list) + sizeof(struct b_lelem) +
         nslots * sizeof(struct descrip)) == Error)
      return Error;
   lp1 = (struct b_list *) BlkLoc(*dp1);
   bp1 = (struct b_lelem *) lp1->listhead;
   lp2 = (struct b_list *) alclist(size);
   bp2 = (struct b_lelem *) alclstb(nslots, (word)0, size);
   lp2->listhead = lp2->listtail = (union block *) bp2;
   dp = bp2->lslots;

   /*
    * Locate the block containing element i in the source list.
    */
   if (size > 0) {
      while (i > bp1->nused) {
         i -= bp1->nused;
         bp1 = (struct b_lelem *) bp1->listnext;
         }
      }

   /*
    * Copy elements from the source list into the sublist, moving to
    *  the next list block in the source list when all elements in a
    *  block have been copied.
    */
   while (size > 0) {
      j = bp1->first + i - 1;
      if (j >= bp1->nslots)
         j -= bp1->nslots;
      *dp++ = bp1->lslots[j];
      if (++i > bp1->nused) {
         i = 1;
         bp1 = (struct b_lelem *) bp1->listnext;
         }
      size--;
      }

   /*
    * Fix type and location fields for the new list.
    */
   dp2->dword = D_List;
   BlkLoc(*dp2) = (union block *) lp2;
   return Success;
   }

/*
 * cpset(dp1,dp2,n) - copy set dp1 to dp2, reserving memory for n entries.
 */
int cpset(dp1, dp2, n)
dptr dp1, dp2;
word n;
   {
   register union block **tp, *ep, *old, *new;
   register struct b_slots *seg;
   register word i, slotnum;

   /*
    * Make a new set organized like dp1, with room for n elements.
    */
   new = hmake(T_Set, BlkLoc(*dp1)->set.mask + 1, n);
   if (new == NULL)
      return Error;
   /*
    * Copy the header and slot blocks.
    */
   old = BlkLoc(*dp1);
   new->set.size = old->set.size;	/* actual set size */
   new->set.mask = old->set.mask;	/* hash mask */
   for (i = 0; i < HSegs && old->set.hdir[i] != NULL; i++)
      memcopy((char *)new->set.hdir[i], (char *)old->set.hdir[i],
         old->set.hdir[i]->blksize);
   /*
    * Work down the chain of element blocks in each bucket
    *	and create identical chains in new set.
    */
   for (i = 0; i < HSegs && (seg = new->set.hdir[i]) != NULL; i++)
      for (slotnum = segsize[i] - 1; slotnum >= 0; slotnum--)  {
         tp = &seg->hslots[slotnum];
         for (ep = *tp; ep != NULL; ep = *tp) {
            *tp = (union block *)alcselem(&ep->selem.setmem, ep->selem.hashnum);
            (*tp)->selem.clink = ep->selem.clink;
            tp = &(*tp)->selem.clink;
            }
         }
   dp2->dword = D_Set;
   BlkLoc(*dp2) = new;
   if (TooSparse(new))
      hshrink(dp2);
   return Success;
   }

/*
 * hmake - make a hash structure (Set or Table) with a given number of slots.
 *  hmake also ensures adequate storage for *nelem* elements, but does not
 *  allocate then.  If *nslots* is zero, a value appropriate for *nelem*
 *  elements is chosen.
 */
union block *hmake(tcode, nslots, nelem)
int tcode;
word nslots, nelem;
   {
   word seg, t, nbytes, blksize, elemsize;
   union block *blk;

   if (nslots == 0)
      nslots = (nelem + MaxHLoad - 1) / MaxHLoad;
   for (seg = t = 0; seg < (HSegs - 1) && (t += segsize[seg]) < nslots; seg++)
      ;
   nslots = ((word)HSlots) << seg;	/* ensure legal power of 2 */
   if (tcode == T_Table) {
      blksize = sizeof(struct b_table);
      elemsize = sizeof(struct b_telem);
      }
   else {	/* T_Set */
      blksize = sizeof(struct b_set);
      elemsize = sizeof(struct b_selem);
      }
   nbytes = blksize + (seg + 1) * (sizeof(struct b_slots) - (HSlots*WordSize)) +
      nslots * WordSize + nelem * elemsize;
   if (blkreq(nbytes) == Error)
      return NULL;				/* sorry, no memory */
   blk = alchash(tcode);
   for (; seg >= 0; seg--)
      blk->set.hdir[seg] = alcsegment(segsize[seg]);
   blk->set.mask = nslots - 1;
   return blk;
   }

/*
 * hchain - return a pointer to the word that points to the head of the hash
 *  chain for hash number hn in hashed structure s.
 */

/*
 * lookup table for log to base 2; must have powers of 2 through (HSegs-1)/2.
 */
static unsigned char log2[] = {
   0,1,2,2, 3,3,3,3, 4,4,4,4, 4,4,4,4, 5,5,5,5, 5,5,5,5, 5,5,5,5, 5,5,5,5,
   };

union block **hchain(pb, hn)
union block *pb;
register uword hn;
   {
   register struct b_set *ps;
   register word slotnum, segnum, segslot;

   ps = (struct b_set *)pb;
   slotnum = hn & ps->mask;
   if (slotnum >= HSlots * sizeof(log2))
      segnum = log2[slotnum >> (LogHSlots + HSegs/2)] + HSegs/2;
   else
      segnum = log2[slotnum >> LogHSlots];
   segslot = hn & (segsize[segnum] - 1);
   return &ps->hdir[segnum]->hslots[segslot];
   }

/*
 * hgener - agent function to generate the elements of a hashed structure.
 *
 *  Arg1 = set or table to enumerate
 *  Arg2 = integer value indicating desired action:
 *     0   generate set elements
 *     1   generate table keys
 *     2   generate table values
 *
 *  Carefully generate each element exactly once, even if the hash chains
 *  split while suspended.  Do this by recording the state of things at the
 *  time of the split and checking past history when starting to process a
 *  new chain.
 *
 *  Elements inserted or deleted while the generator is suspended may or
 *  may not be generated. 
 *
 *  We assume that no structure *shrinks* after its initial creation; they
 *  only *grow*.
 */

AgtDcl(hgener)
   {
   int i, segnum;
   word d, m, func, slotnum;
   uword hn;
   union block *ep;

   word tmask;		/* structure mask before suspension */
   word sgmask[HSegs];	/* mask being used when the segment was created */
   uword sghash[HSegs];	/* hashnum in process when the segment was created */

   for (i = 0; i < HSegs; i++)
      sghash[i] = sgmask[i] = 0;		/* set initial state */
   tmask = BlkLoc(Arg1)->table.mask;

   func = IntVal(Arg2);				/* save function code */
   Arg2.dword = D_Telem;			/* use Arg2 to tend address */

   for (segnum = 0; segnum < HSegs; segnum++) {
      if (BlkLoc(Arg1)->table.hdir[segnum] == NULL)
         break;
      for (slotnum = 0; slotnum < segsize[segnum]; slotnum++) {
         ep = BlkLoc(Arg1)->table.hdir[segnum]->hslots[slotnum];
         /*
          * Check to see if parts of this hash chain were already processed.
          *  This could happen if the elements were in a different chain,
          *  but a split occurred while we were suspended.
          */
         for (i = segnum; (m = sgmask[i]) != 0; i--) {
            d = (word)(m & slotnum) - (word)(m & sghash[i]);
            if (d < 0)			/* if all elements processed earlier */
               ep = NULL;		/* skip this slot */
            else if (d == 0) {
               /*
                * This chain was split from its parent while the parent was
                *  being processed.  Skip past elements already processed.
                */
               while (ep != NULL && ep->telem.hashnum <= sghash[i])
                  ep = ep->telem.clink;
               }
            }
         /*
          * Process the elements of the hash chain, in turn.
          */
         while (ep != NULL) {
            switch ((int)func) {
               case 0:  Arg0 = ep->selem.setmem;  break;
               case 1:  Arg0 = ep->telem.tref;    break;
               case 2:  Arg0 = ep->telem.tval;    break;
               }
            BlkLoc(Arg2) = ep;		/* save pointer, so it gets tended */
            Suspend;			/* suspend, returning current element */
            ep = BlkLoc(Arg2);		/* restore pointer */

            if (BlkLoc(Arg1)->table.mask != tmask &&
                  (ep->telem.clink == NULL ||
                  ep->telem.clink->telem.hashnum != ep->telem.hashnum)) {
               /*
                * The set or table's hash buckets split, once or more, while
                *  we were suspended.  (We notice this unless the next entry
                *  has same hash value as the current one.  In that case we
                *  ignore it for now and will pick it up on the next pass.)
                *
                * Make a note of the current state.
                */
               hn = ep->telem.hashnum;
               for (i = 1; i < HSegs; i++)
                  if ((((word)HSlots) << (i - 1)) > tmask) {
                     /*
                      * For the newly created segments only, save the mask and
                      *  hash number being processed at time of creation.
                      */
                     sgmask[i] = tmask;
                     sghash[i] = hn;
                  }
               tmask = BlkLoc(Arg1)->table.mask;
               /*
                * Find the next element in our original segment by starting
                *  from the beginning and skipping through the current hash
                *  number.  We can't just follow the link from the current
                *  element, because it may have moved to a new segment.
                */
               ep = BlkLoc(Arg1)->table.hdir[segnum]->hslots[slotnum];
               while (ep != NULL && ep->telem.hashnum <= hn)
                  ep = ep->telem.clink;
               }

            else {
               /*
                * Nothing happened during the suspend, or else if it did we're
                *  between items with identical hash numbers.  Just move on.
                */
               ep = ep->telem.clink;
               }
            }
         }
      }
   Fail;
   }

/*
 * hgrow - split a hashed structure (doubling the buckets) for faster access.
 */

novalue hgrow(dp)
dptr dp;
   {
   register union block **tp0, **tp1, *ep;
   register word newslots, slotnum, segnum;
   struct b_set *ps;
   struct b_slots *seg, *newseg;
   union block **curslot;

   ps = (struct b_set *)BlkLoc(*dp);
   if (ps->hdir[HSegs-1] != NULL)
      return;				/* can't split further */
   newslots = ps->mask + 1;
   if (blkreq(sizeof(struct b_slots) + (newslots - HSlots) * WordSize) == Error)
      return;				/* sorry, no memory */
   ps = (struct b_set *)BlkLoc(*dp);	/* refresh address -- may have moved */
   newseg = alcsegment(newslots);

   curslot = newseg->hslots;
   for (segnum = 0; (seg = ps->hdir[segnum]) != NULL; segnum++)
      for (slotnum = 0; slotnum < segsize[segnum]; slotnum++)  {
         tp0 = &seg->hslots[slotnum];	/* ptr to tail of old slot */
         tp1 = curslot++;		/* ptr to tail of new slot */
         for (ep = *tp0; ep != NULL; ep = ep->selem.clink) {
            if ((ep->selem.hashnum & newslots) == 0) {
               *tp0 = ep;		/* element does not move */
               tp0 = &ep->selem.clink;
               }
            else {
               *tp1 = ep;		/* element moves to new slot */
               tp1 = &ep->selem.clink;
               }
            }
         *tp0 = *tp1 = NULL;
         }
   ps->hdir[segnum] = newseg;
   ps->mask = (ps->mask << 1) | 1;
   }

/*
 * hshrink - combine buckets in a set or table that is too sparse.
 *
 *  Call this only for newly created structures.  Shrinking an active structure
 *  can wreak havoc on suspended generators.
 */
novalue hshrink(dp)
dptr dp;
   {
   register union block **tp, *ep0, *ep1;
   int topseg, curseg;
   word slotnum;
   struct b_set *ps;
   struct b_slots *seg;
   union block **uppslot;

   ps = (struct b_set *)BlkLoc(*dp);
   topseg = 0;
   for (topseg = 1; topseg < HSegs && ps->hdir[topseg] != NULL; topseg++)
      ;
   topseg--;
   while (TooSparse(ps)) {
      uppslot = ps->hdir[topseg]->hslots;
      ps->hdir[topseg--] = NULL;
      for (curseg = 0; (seg = ps->hdir[curseg]) != NULL; curseg++)
         for (slotnum = 0; slotnum < segsize[curseg]; slotnum++)  {
            tp = &seg->hslots[slotnum];		/* tail pointer */
            ep0 = seg->hslots[slotnum];		/* lower slot entry pointer */
            ep1 = *uppslot++;			/* upper slot entry pointer */
            while (ep0 != NULL && ep1 != NULL)
               if (ep0->selem.hashnum < ep1->selem.hashnum) {
                  *tp = ep0;
                  tp = &ep0->selem.clink;
                  ep0 = ep0->selem.clink;
                  }
               else {
                  *tp = ep1;
                  tp = &ep1->selem.clink;
                  ep1 = ep1->selem.clink;
                  }
            while (ep0 != NULL) {
               *tp = ep0;
               tp = &ep0->selem.clink;
               ep0 = ep0->selem.clink;
               }
            while (ep1 != NULL) {
               *tp = ep1;
               tp = &ep1->selem.clink;
               ep1 = ep1->selem.clink;
               }
            }
      ps->mask >>= 1;
      }
   }

/*
 * memb - sets res flag to 1 if x is a member of a set or table, or to 0 if not.
 *  Returns a pointer to the word which points to the element, or which
 *  would point to it if it were there.
 */

union block **memb(pb, x, hn, res)
union block *pb;
dptr x;
register uword hn;
int *res;				/* pointer to integer result flag */
   {
   struct b_set *ps;
   register union block **lp;
   register struct b_selem *pe;
   register uword eh;

   ps = (struct b_set *)pb;
   lp = hchain(pb, hn);
   /*
    * Look for x in the hash chain.
    */
   *res = 0;
   while ((pe = (struct b_selem *)*lp) != NULL) {
      eh = pe->hashnum;
      if (eh > hn)			/* too far - it isn't there */
         return lp;
      else if ((eh == hn) && (equiv(&pe->setmem, x)))  {
         *res = 1;
         return lp;
         }
      /*
       * We haven't reached the right hashnumber yet or
       *  the element isn't the right one so keep looking.
       */
      lp = &(pe->clink);
      }
   /*
    *  At end of chain - not there.
    */
   return lp;
   }