/*
 * File: fstruct.c
 *  Contents: delete, get, key, insert, list, member, pop, pull, push, put, set,
 *  table
 */

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


/*
 * delete(X,x) - delete element x from set or table X if it is there
 *  (always succeeds and returns X).
 */

FncDcl(delete,2)
   {
   register union block **pd;
   register uword hn;
   int res;

   if (Qual(Arg1))
      RunErr(122, &Arg1);

   /*
   * The technique and philosophy here are the same
   *  as used in insert - see comment there.
   */
   switch (Type(Arg1)) {
      case T_Set:
      case T_Table:
         hn = hash(&Arg2);
         pd = memb(BlkLoc(Arg1), &Arg2, hn, &res);
         if (res == 1) {
            /*
            * The element is there so delete it.
            */
            *pd = (*pd)->selem.clink;
            (BlkLoc(Arg1)->set.size)--;
            }
         break;

      default:
         RunErr(122, &Arg1);
      }

   Arg0 = Arg1;
   Return;
   }


/*
 * get(x) - get an element from end of list x.
 *  Identical to pop(x).
 */

FncDcl(get,1)
   {
   register word i;
   register struct b_list *hp;
   register struct b_lelem *bp;

   /*
    * Arg1 must be a list.
    */
   if (Arg1.dword != D_List) 
      RunErr(108, &Arg1);

   /*
    * Fail if the list is empty.
    */
   hp = (struct b_list *) BlkLoc(Arg1);
   if (hp->size <= 0)
      Fail;

   /*
    * Point bp at the first list block.  If the first block has no
    *  elements in use, point bp at the next list block.
    */
   bp = (struct b_lelem *) hp->listhead;
   if (bp->nused <= 0) {
      bp = (struct b_lelem *) bp->listnext;
      hp->listhead = (union block *) bp;
      bp->listprev = NULL;
      }
   /*
    * Locate first element and assign it to Arg0 for return.
    */
   i = bp->first;
   Arg0 = bp->lslots[i];
   /*
    * Set bp->first to new first element, or 0 if the block is now
    *  empty.  Decrement the usage count for the block and the size
    *  of the list.
    */
   if (++i >= bp->nslots)
      i = 0;
   bp->first = i;
   bp->nused--;
   hp->size--;
   Return;
   }

/*
 * key(t) - generate successive keys (entry values) from table t.
 */

FncDcl(key,2)
   {
   if (Arg1.dword != D_Table) 
      RunErr(124, &Arg1);
   MakeInt(1, &Arg2);			/* indicate that we want the keys */
   Forward(hgener);			/* go to the hash generator */
   }

/*
 * insert(X,x) - insert element x into set or table X if not already there
 *  (always succeeds and returns X).
 */

FncDcl(insert,3)
   {
   register union block *bp;
   register union block **pd;
   register struct b_telem *pe;
   register uword hn;
   int res;

   if (Qual(Arg1))
      RunErr(122, &Arg1);

   switch (Type(Arg1)) {
      case T_Set:

         /*
         * We may need at most one new element.
         */
         if (blkreq((word)sizeof(struct b_selem)) == Error) 
            RunErr(0, NULL);
         bp = BlkLoc(Arg1);
         hn = hash(&Arg2);
         /*
          * If Arg2 is a member of set Arg1 then res will have the
          *  value 1 and pd will have a pointer to the pointer
          *  that points to that member.
          *  If Arg2 is not a member of the set then res will have
          *  the value 0 and pd will point to the pointer
          *  which should point to the member - thus we know where
          *  to link in the new element without having to do any
          *  repetitive looking.
          */
         pd = memb(bp, &Arg2, hn, &res);
         if (res == 0) {
            /*
            * The element is not in the set - insert it.
            */
            addmem((struct b_set *)bp, alcselem(&Arg2, hn), pd);
            if (TooCrowded(bp))
               hgrow(&Arg1);
            }
         break;

      case T_Table:
         if (blkreq((word)sizeof(struct b_telem)) == Error) 
            RunErr(0, NULL);
         bp = BlkLoc(Arg1);
         hn = hash(&Arg2);
         pd = memb(bp, &Arg2, hn, &res);
         if (res == 0) {
            /*
            * The element is not in the table - insert it.
            */
            bp->table.size++;
            pe = alctelem();
            pe->clink = *pd;
            *pd = (union block *)pe;
            pe->hashnum = hn;
            pe->tref = Arg2;
            pe->tval = Arg3;
            if (TooCrowded(bp))
               hgrow(&Arg1);
            }
         else {
            pe = (struct b_telem *) *pd;
            pe->tval = Arg3;
            }
         break;

      default:
         RunErr(122, &Arg1);
      }

   Arg0 = Arg1;
   Return;
   }

/*
 * list(n,x) - create a list of size n, with initial value x.
 */

FncDcl(list,2)
   {
   register word i, size;
   word nslots;
   register struct b_list *hp;
   register struct b_lelem *bp;

   if (defshort(&Arg1, 0) == Error) 
      RunErr(0, NULL);

   nslots = size = IntVal(Arg1);


   /*
    * Ensure that the size is positive and that the list-element block 
    *  has MinListSlots slots if its size is zero.
    */
   if (size < 0) 
      RunErr(205, &Arg1);
   if (nslots == 0)
      nslots = MinListSlots;

   /*
    * Ensure space for a list-header block, and a list-element block
    * with nslots slots.
    */
   if (blkreq(sizeof(struct b_list) + sizeof(struct b_lelem) +
         (nslots - 1) * sizeof(struct descrip)) == Error) 
      RunErr(0, NULL);

   /*
    * Allocate the list-header block and a list-element block.
    *  Note that nslots is the number of slots in the list-element
    *  block while size is the number of elements in the list.
    */
   hp = alclist(size);
   bp = alclstb(nslots, (word)0, size);
   hp->listhead = hp->listtail = (union block *) bp;

   /*
    * Initialize each slot.
    */
   for (i = 0; i < size; i++)
      bp->lslots[i] = Arg2;

   /*
    * Return the new list.
    */
   Arg0.dword = D_List;
   BlkLoc(Arg0) = (union block *) hp;
   Return;
   }

/*
 * member(X,x) - returns x if x is a member of set or table X otherwise fails.
 */

FncDcl(member,2)
   {
   int res;
   register uword hn;

   if (Qual(Arg1))
      RunErr(122, &Arg1);

   switch (Type(Arg1)) {
      case T_Set:
      case T_Table:
         hn = hash(&Arg2);
         memb(BlkLoc(Arg1), &Arg2, hn, &res);
         break;

      default:
         RunErr(122, &Arg1);
      }

   /* If Arg2 is a member of Arg1 then "res" will have the
    * value 1 otherwise it will have the value 0.
    */
   if (res == 1) {		/* It is a member. */
      Arg0 = Arg2;		/* Return the member if it is in Arg1. */
      Return;
      }
   Fail;
   }


/*
 * pop(x) - pop an element from beginning of list x.
 */

FncDcl(pop,1)
   {
   register word i;
   register struct b_list *hp;
   register struct b_lelem *bp;

   /*
    * Arg1 must be a list.
    */
   if (Arg1.dword != D_List) 
      RunErr(108, &Arg1);

   /*
    * Fail if the list is empty.
    */
   hp = (struct b_list *) BlkLoc(Arg1);
   if (hp->size <= 0)
      Fail;

   /*
    * Point bp to the first list-element block.  If the first block has
    *  no slots in use, point bp at the next list-element block.
    */
   bp = (struct b_lelem *) hp->listhead;
   if (bp->nused <= 0) {
      bp = (struct b_lelem *) bp->listnext;
      hp->listhead = (union block *) bp;
      bp->listprev = NULL;
      }
   /*
    * Locate first element and assign it to Arg0 for return.
    */
   i = bp->first;
   Arg0 = bp->lslots[i];

   /*
    * Set bp->first to new first element, or 0 if the block is now
    *  empty.  Decrement the usage count for the block and the size
    *  of the list.
    */
   if (++i >= bp->nslots)
      i = 0;
   bp->first = i;
   bp->nused--;
   hp->size--;
   Return;
   }

/*
 * pull(x) - pull an element from end of list x.
 */

FncDcl(pull,1)
   {
   register word i;
   register struct b_list *hp;
   register struct b_lelem *bp;

   /*
    * Arg1 must be a list.
    */
   if (Arg1.dword != D_List) 
      RunErr(108, &Arg1);

   /*
    * Point at list header block and fail if the list is empty.
    */
   hp = (struct b_list *) BlkLoc(Arg1);
   if (hp->size <= 0)
      Fail;
   /*
    * Point bp at the last list element block.  If the last block has no
    *  elements in use, point bp at the previous list element block.
    */
   bp = (struct b_lelem *) hp->listtail;
   if (bp->nused <= 0) {
      bp = (struct b_lelem *) bp->listprev;
      hp->listtail = (union block *) bp;
      bp->listnext = NULL;
      }
   /*
    * Set i to position of last element and assign the element to
    *  Arg0 for return.  Decrement the usage count for the block
    *  and the size of the list.
    */
   i = bp->first + bp->nused - 1;
   if (i >= bp->nslots)
      i -= bp->nslots;
   Arg0 = bp->lslots[i];
   bp->nused--;
   hp->size--;
   Return;
   }


/*
 * push(x,val) - push val onto beginning of list x.
 */
FncDcl(push,2)
   {
   register word i;
   register struct b_list *hp;
   register struct b_lelem *bp;
   static two = 2;		/* some compilers generat bad code for
				   division by a constant that's a power of 2 */


   /*
    * Arg1 must be a list.
    */
   if (Arg1.dword != D_List) 
      RunErr(108, &Arg1);

   /*
    * Point hp at the list-header block and bp at the first
    *  list-element block.
    */
   hp = (struct b_list *) BlkLoc(Arg1);
   bp = (struct b_lelem *) hp->listhead;

   /*
    * If the first list-element block is full, allocate a new
    *  list-element block, make it the first list-element block,
    *  and make it the previous block of the former first list-element
    *  block.
    */
   if (bp->nused >= bp->nslots) {
      /*
       * Set i to the size of block to allocate.
       */
      i = hp->size / two;
      if (i < MinListSlots)
         i = MinListSlots;

      /*
       * Ensure space for a new list element block.  If the block can't
       *  be allocated, try smaller blocks.
       */
      while (blkreq((word)sizeof(struct b_lelem) +
		    i * sizeof(struct descrip)) == Error) {
	    i /= 4;
	    if (i < MinListSlots)
	       RunErr(0, NULL);
	    }
      /*
       * Reset hp in case there was a garbage collection.
       */
      hp = (struct b_list *) BlkLoc(Arg1);

      bp = alclstb(i, (word)0, (word)0);
      hp->listhead->lelem.listprev = (union block *) bp;
      bp->listnext = hp->listhead;
      hp->listhead = (union block *) bp;
      }

   /*
    * Set i to position of new first element and assign val (Arg2) to
    *  that element.
    */
   i = bp->first - 1;
   if (i < 0)
      i = bp->nslots - 1;
   bp->lslots[i] = Arg2;
   /*
    * Adjust value of location of first element, block usage count,
    *  and current list size.
    */
   bp->first = i;
   bp->nused++;
   hp->size++;
   /*
    * Return the list.
    */
   Arg0 = Arg1;
   Return;
   }


/*
 * put(x,val) - put val onto end of list x.
 */

FncDcl(put,2)
   {
   register word i;
   register struct b_list *hp;
   register struct b_lelem *bp;
   static two = 2;		/* some compilers generate bad code for
				   division by a constant that's a power of 2 */

   /*
    * Arg1 must be a list.
    */
   if (Arg1.dword != D_List) 
      RunErr(108, &Arg1);

   /*
    * Point hp at the list-header block and bp at the last
    *  list-element block.
    */
   hp = (struct b_list *) BlkLoc(Arg1);
   bp = (struct b_lelem *) hp->listtail;

   /*
    * If the last list-element block is full, allocate a new
    *  list-element block, make it the first list-element block,
    *  and make it the next block of the former last list-element
    *  block.
    */
   if (bp->nused >= bp->nslots) {
      /*
       * Set i to the size of block to allocate.
       */
      i = hp->size / two;
      if (i < MinListSlots)
         i = MinListSlots;

      /*
       * Ensure space for a new list element block.  If the block can't
       *  be allocated, try smaller blocks.
       */
      while (blkreq((word)sizeof(struct b_lelem) +
		    i * sizeof(struct descrip)) == Error) {
	    i /= 4;
	    if (i < MinListSlots)
	       RunErr(0, NULL);
	    }
      /*
       * Reset hp in case there was a garbage collection.
       */
      hp = (struct b_list *) BlkLoc(Arg1);

      bp = alclstb(i, (word)0, (word)0);
      hp->listtail->lelem.listnext = (union block *) bp;
      bp->listprev = hp->listtail;
      hp->listtail = (union block *) bp;
      }

   /*
    * Set i to position of new last element and assign Arg2 to
    *  that element.
    */
   i = bp->first + bp->nused;
   if (i >= bp->nslots)
      i -= bp->nslots;
   bp->lslots[i] = Arg2;

   /*
    * Adjust block usage count and current list size.
    */
   bp->nused++;
   hp->size++;

   /*
    * Return the list.
    */
   Arg0 = Arg1;
   Return;
   }

/*
 * set(list) - create a set with members in list.
 *  The members are linked into hash chains which are
 *  arranged in increasing order by hash number.
 */
FncDcl(set,1)
   {
   register uword hn;
   register dptr pd;
   register union block *ps, *pb;
   struct b_selem *ne;
   union block **pe;
   int res;
   word i, j;

   if (ChkNull(Arg1)) {		/* Create empty set */
      ps = hmake(T_Set, (word)0, (word)0);
      if (ps == NULL)
         RunErr(0,NULL);
      Arg0.dword = D_Set;
      BlkLoc(Arg0) = ps;
      Return;
      }

   if (Arg1.dword != D_List) 
      RunErr(108, &Arg1);

   /*
    * Make a set of the appropriate size.
    */
   ps = hmake(T_Set, (word)0, BlkLoc(Arg1)->list.size);
   if (ps == NULL)
      RunErr(0, NULL);

   /*
    * Chain through each list block and for
    *  each element contained in the block
    *  insert the element into the set if not there.
    */
   for (pb = BlkLoc(Arg1)->list.listhead; pb != NULL; pb = pb->lelem.listnext) {
      for (i = 0; i < pb->lelem.nused; i++) {
         j = pb->lelem.first + i;
         if (j >= pb->lelem.nslots)
            j -= pb->lelem.nslots;
         pd = &pb->lelem.lslots[j];
         pe = memb(ps, pd, hn = hash(pd), &res);
         if (res == 0) {
            ne = alcselem(pd,hn);
            addmem((struct b_set *)ps, ne, pe);
            }
         }
      }
   Arg0.dword = D_Set;
   BlkLoc(Arg0) = ps;
   Return;
   }

/*
 * table(x) - create a table with default value x.
 */
FncDcl(table,1)
   {
   union block *bp;

   bp = hmake(T_Table, (word)0, (word)0);
   if (bp == NULL)
      RunErr(0, NULL);
   bp->table.defvalue = Arg1;
   Arg0.dword = D_Table;
   BlkLoc(Arg0) = bp;
   Return;
   }