home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / src / runtime / rstruct.r < prev    next >
Text File  |  2001-12-12  |  20KB  |  666 lines
  1. /*
  2.  * File: rstruct.r
  3.  *  Contents: addmem, cpslots, cplist, cpset, hmake, hchain, hfirst, hnext,
  4.  *  hgrow, hshrink, memb
  5.  */
  6.  
  7. /*
  8.  * addmem - add a new set element block in the correct spot in
  9.  *  the bucket chain.
  10.  */
  11.  
  12. void addmem(ps,pe,pl)
  13. union block **pl;
  14. struct b_set *ps;
  15. struct b_selem *pe;
  16.    {
  17.    ps->size++;
  18.    if (*pl != NULL )
  19.       pe->clink = *pl;
  20.    *pl = (union block *) pe;
  21.    }
  22.  
  23. /*
  24.  * cpslots(dp1, slotptr, i, j) - copy elements of sublist dp1[i:j]
  25.  *  into an array of descriptors.
  26.  */
  27.  
  28. void cpslots(dp1, slotptr, i, j)
  29. dptr dp1, slotptr;
  30. word i, j;
  31.    {
  32.    word size;
  33.    tended struct b_list *lp1;
  34.    tended struct b_lelem *bp1;
  35.    /*
  36.     * Get pointers to the list and list elements for the source list
  37.     *  (bp1, lp1).
  38.     */
  39.    lp1 = (struct b_list *) BlkLoc(*dp1);
  40.    bp1 = (struct b_lelem *) lp1->listhead;
  41.    size = j - i;
  42.  
  43.    /*
  44.     * Locate the block containing element i in the source list.
  45.     */
  46.    if (size > 0) {
  47.       while (i > bp1->nused) {
  48.          i -= bp1->nused;
  49.          bp1 = (struct b_lelem *) bp1->listnext;
  50.          }
  51.       }
  52.  
  53.    /*
  54.     * Copy elements from the source list into the sublist, moving to
  55.     *  the next list block in the source list when all elements in a
  56.     *  block have been copied.
  57.     */
  58.    while (size > 0) {
  59.       j = bp1->first + i - 1;
  60.       if (j >= bp1->nslots)
  61.          j -= bp1->nslots;
  62.       *slotptr++ = bp1->lslots[j];
  63.       if (++i > bp1->nused) {
  64.          i = 1;
  65.          bp1 = (struct b_lelem *) bp1->listnext;
  66.          }
  67.       size--;
  68.       }
  69.    }
  70.  
  71.  
  72. /*
  73.  * cplist(dp1,dp2,i,j) - copy sublist dp1[i:j] into dp2.
  74.  */
  75.  
  76. int cplist(dp1, dp2, i, j)
  77. dptr dp1, dp2;
  78. word i, j;
  79.    {
  80.    word size, nslots;
  81.    tended struct b_list *lp2;
  82.    tended struct b_lelem *bp2;
  83.  
  84.    /*
  85.     * Calculate the size of the sublist.
  86.     */
  87.    size = nslots = j - i;
  88.    if (nslots == 0)
  89.       nslots = MinListSlots;
  90.  
  91.    Protect(lp2 = (struct b_list *) alclist(size), return Error);
  92.    Protect(bp2 = (struct b_lelem *)alclstb(nslots,(word)0,size), return Error);
  93.    lp2->listhead = lp2->listtail = (union block *) bp2;
  94. #ifdef ListFix
  95.    bp2->listprev = bp2->listnext = (union block *) lp2;
  96. #endif                    /* ListFix */
  97.  
  98.    cpslots(dp1, bp2->lslots, i, j);
  99.  
  100.    /*
  101.     * Fix type and location fields for the new list.
  102.     */
  103.    dp2->dword = D_List;
  104.    BlkLoc(*dp2) = (union block *) lp2;
  105.    EVValD(dp2, E_Lcreate);
  106.    return Succeeded;
  107.    }
  108.  
  109. #ifdef TableFix
  110. /*
  111.  * cpset(dp1,dp2,n) - copy set dp1 to dp2, reserving memory for n entries.
  112.  */
  113. int cpset(dp1, dp2, n)
  114. dptr dp1, dp2;
  115. word n;
  116.    {
  117.    int i = cphash(dp1, dp2, n, T_Set);
  118.    EVValD(dp2, E_Screate);
  119.    return i;
  120.    }
  121.  
  122. int cptable(dp1, dp2, n)
  123. dptr dp1, dp2;
  124. word n;
  125.    {
  126.    int i = cphash(dp1, dp2, n, T_Table);
  127.    BlkLoc(*dp2)->table.defvalue = BlkLoc(*dp1)->table.defvalue;
  128.    EVValD(dp2, E_Tcreate);
  129.    return i;
  130.    }
  131.  
  132. int cphash(dp1, dp2, n, tcode)
  133. dptr dp1, dp2;
  134. word n;
  135. int tcode;
  136.    {
  137.    union block *src;
  138.    tended union block *dst;
  139.    tended struct b_slots *seg;
  140.    tended struct b_selem *ep, *prev;
  141.    struct b_selem *se;
  142.    register word slotnum;
  143.    register int i;
  144.  
  145.    /*
  146.     * Make a new set organized like dp1, with room for n elements.
  147.     */
  148.    dst = hmake(tcode, BlkLoc(*dp1)->set.mask + 1, n);
  149.    if (dst == NULL)
  150.       return Error;
  151.    /*
  152.     * Copy the header and slot blocks.
  153.     */
  154.    src = BlkLoc(*dp1);
  155.    dst->set.size = src->set.size;    /* actual set size */
  156.    dst->set.mask = src->set.mask;    /* hash mask */
  157.    for (i = 0; i < HSegs && src->set.hdir[i] != NULL; i++)
  158.       memcpy((char *)dst->set.hdir[i], (char *)src->set.hdir[i],
  159.          src->set.hdir[i]->blksize);
  160.    /*
  161.     * Work down the chain of element blocks in each bucket
  162.     *    and create identical chains in new set.
  163.     */
  164.    for (i = 0; i < HSegs && (seg = dst->set.hdir[i]) != NULL; i++)
  165.       for (slotnum = segsize[i] - 1; slotnum >= 0; slotnum--)  {
  166.      prev = NULL;
  167.          for (ep = (struct b_selem *)seg->hslots[slotnum];
  168.           ep != NULL && BlkType(ep) != T_Table;
  169.           ep = (struct b_selem *)ep->clink) {
  170.         if (tcode == T_Set) {
  171.                Protect(se = alcselem(&ep->setmem, ep->hashnum), return Error);
  172.                se->clink = ep->clink;
  173.            }
  174.         else {
  175.            Protect(se = (struct b_selem *)alctelem(), return Error);
  176.            *(struct b_telem *)se = *(struct b_telem *)ep; /* copy table entry */
  177.            if (BlkType(se->clink) == T_Table)
  178.           se->clink = dst;
  179.            }
  180.         if (prev == NULL)
  181.         seg->hslots[slotnum] = (union block *)se;
  182.         else
  183.         prev->clink = (union block *)se;
  184.         prev = se;
  185.             }
  186.          }
  187.    dp2->dword = tcode | D_Typecode | F_Ptr;
  188.    BlkLoc(*dp2) = dst;
  189.    if (TooSparse(dst))
  190.       hshrink(dst);
  191.    return Succeeded;
  192.    }
  193. #else                    /* TableFix */
  194. /*
  195.  * cpset(dp1,dp2,n) - copy set dp1 to dp2, reserving memory for n entries.
  196.  */
  197. int cpset(dp1, dp2, n)
  198. dptr dp1, dp2;
  199. word n;
  200.    {
  201.    union block *src;
  202.    tended union block *dst;
  203.    tended struct b_slots *seg;
  204.    tended struct b_selem *ep, *prev;
  205.    struct b_selem *se;
  206.    register word slotnum;
  207.    register int i;
  208.  
  209.    /*
  210.     * Make a new set organized like dp1, with room for n elements.
  211.     */
  212.    dst = hmake(T_Set, BlkLoc(*dp1)->set.mask + 1, n);
  213.    if (dst == NULL)
  214.       return Error;
  215.    /*
  216.     * Copy the header and slot blocks.
  217.     */
  218.    src = BlkLoc(*dp1);
  219.    dst->set.size = src->set.size;    /* actual set size */
  220.    dst->set.mask = src->set.mask;    /* hash mask */
  221.    for (i = 0; i < HSegs && src->set.hdir[i] != NULL; i++)
  222.       memcpy((char *)dst->set.hdir[i], (char *)src->set.hdir[i],
  223.          src->set.hdir[i]->blksize);
  224.    /*
  225.     * Work down the chain of element blocks in each bucket
  226.     *    and create identical chains in new set.
  227.     */
  228.    for (i = 0; i < HSegs && (seg = dst->set.hdir[i]) != NULL; i++)
  229.       for (slotnum = segsize[i] - 1; slotnum >= 0; slotnum--)  {
  230.      prev = NULL;
  231.          for (ep = (struct b_selem *)seg->hslots[slotnum];
  232.            ep != NULL; ep = (struct b_selem *)ep->clink) {
  233.             Protect(se = alcselem(&ep->setmem, ep->hashnum), return Error);
  234.         if (prev == NULL)
  235.         seg->hslots[slotnum] = (union block *)se;
  236.         else
  237.         prev->clink = (union block *)se;
  238.             se->clink = ep->clink;
  239.         prev = se;
  240.             }
  241.          }
  242.    dp2->dword = D_Set;
  243.    BlkLoc(*dp2) = dst;
  244.    if (TooSparse(dst))
  245.       hshrink(dst);
  246.    Desc_EVValD(dst, E_Screate, D_Set);
  247.    return Succeeded;
  248.    }
  249. #endif                    /* TableFix */
  250.  
  251. /*
  252.  * hmake - make a hash structure (Set or Table) with a given number of slots.
  253.  *  If *nslots* is zero, a value appropriate for *nelem* elements is chosen.
  254.  *  A return of NULL indicates allocation failure.
  255.  */
  256. union block *hmake(tcode, nslots, nelem)
  257. int tcode;
  258. word nslots, nelem;
  259.    {
  260.    word seg, t, blksize, elemsize;
  261.    tended union block *blk;
  262.    struct b_slots *segp;
  263.  
  264.    if (nslots == 0)
  265.       nslots = (nelem + MaxHLoad - 1) / MaxHLoad;
  266.    for (seg = t = 0; seg < (HSegs - 1) && (t += segsize[seg]) < nslots; seg++)
  267.       ;
  268.    nslots = ((word)HSlots) << seg;    /* ensure legal power of 2 */
  269.    if (tcode == T_Table) {
  270.       blksize = sizeof(struct b_table);
  271.       elemsize = sizeof(struct b_telem);
  272.       }
  273.    else {    /* T_Set */
  274.       blksize = sizeof(struct b_set);
  275.       elemsize = sizeof(struct b_selem);
  276.       }
  277.    if (!reserve(Blocks, (word)(blksize + (seg + 1) * sizeof(struct b_slots)
  278.       + (nslots - HSlots * (seg + 1)) * sizeof(union block *)
  279.       + nelem * elemsize))) return NULL;
  280.    Protect(blk = alchash(tcode), return NULL);
  281.    for (; seg >= 0; seg--) {
  282.       Protect(segp = alcsegment(segsize[seg]), return NULL);
  283.       blk->set.hdir[seg] = segp;
  284. #ifdef TableFix
  285.       if (tcode == T_Table) {
  286.      int j;
  287.      for (j = 0; j < segsize[seg]; j++)
  288.         segp->hslots[j] = blk;
  289.          }
  290. #endif                    /* TableFix */
  291.       }
  292.    blk->set.mask = nslots - 1;
  293.    return blk;
  294.    }
  295.  
  296. /*
  297.  * hchain - return a pointer to the word that points to the head of the hash
  298.  *  chain for hash number hn in hashed structure s.
  299.  */
  300.  
  301. /*
  302.  * lookup table for log to base 2; must have powers of 2 through (HSegs-1)/2.
  303.  */
  304. static unsigned char log2h[] = {
  305.    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,
  306.    6,6,6,6, 6,6,6,6, 6,6,6,6, 6,6,6,6, 6,6,6,6, 6,6,6,6, 6,6,6,6, 6,6,6,6,
  307.    7,7,7,7, 7,7,7,7, 7,7,7,7, 7,7,7,7, 7,7,7,7, 7,7,7,7, 7,7,7,7, 7,7,7,7,
  308.    7,7,7,7, 7,7,7,7, 7,7,7,7, 7,7,7,7, 7,7,7,7, 7,7,7,7, 7,7,7,7, 7,7,7,7,
  309.    8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8,
  310.    8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8,
  311.    8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8,
  312.    8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8, 8,8,8,8,
  313.    9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9,
  314.    9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9,
  315.    9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9,
  316.    9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9,
  317.    9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9,
  318.    9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9,
  319.    9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9,
  320.    9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9, 9,9,9,9,
  321.    };
  322.  
  323. union block **hchain(pb, hn)
  324. union block *pb;
  325. register uword hn;
  326.    {
  327.    register struct b_set *ps;
  328.    register word slotnum, segnum, segslot;
  329.  
  330.    ps = (struct b_set *)pb;
  331.    slotnum = hn & ps->mask;
  332.    if (slotnum >= HSlots * sizeof(log2h))
  333.       segnum = log2h[slotnum >> (LogHSlots + HSegs/2)] + HSegs/2;
  334.    else
  335.       segnum = log2h[slotnum >> LogHSlots];
  336.    segslot = hn & (segsize[segnum] - 1);
  337.    return &ps->hdir[segnum]->hslots[segslot];
  338.    }
  339.  
  340. /*
  341.  * hgfirst - initialize for generating set or table, and return first element.
  342.  */
  343.  
  344. union block *hgfirst(bp, s)
  345. union block *bp;
  346. struct hgstate *s;
  347.    {
  348.    int i;
  349.  
  350.    s->segnum = 0;                /* set initial state */
  351.    s->slotnum = -1;
  352.    s->tmask = bp->table.mask;
  353.    for (i = 0; i < HSegs; i++)
  354.       s->sghash[i] = s->sgmask[i] = 0;
  355.    return hgnext(bp, s, (union block *)0);    /* get and return first value */
  356.    }
  357.  
  358. /*
  359.  * hgnext - return the next element of a set or table generation sequence.
  360.  *
  361.  *  We carefully generate each element exactly once, even if the hash chains
  362.  *  are split between calls.  We do this by recording the state of things at
  363.  *  the time of the split and checking past history when starting to process
  364.  *  a new chain.
  365.  *
  366.  *  Elements inserted or deleted between calls may or may not be generated.
  367.  *
  368.  *  We assume that no structure *shrinks* after its initial creation; they
  369.  *  can only *grow*.
  370.  */
  371.  
  372. union block *hgnext(bp, s, ep)
  373. union block *bp;
  374. struct hgstate *s;
  375. union block *ep;
  376.    {
  377.    int i;
  378.    word d, m;
  379.    uword hn;
  380.  
  381.    /*
  382.     * Check to see if the set or table's hash buckets were split (once or
  383.     *  more) since the last call.  We notice this unless the next entry
  384.     *  has same hash value as the current one, in which case we defer it
  385.     *  by doing nothing now.
  386.     */
  387. #ifdef TableFix
  388.    if (bp->table.mask != s->tmask &&
  389.       (ep->selem.clink == NULL || BlkType(ep->telem.clink) == T_Table ||
  390.       ep->telem.clink->telem.hashnum != ep->telem.hashnum)) {
  391. #else                    /* TableFix */
  392.    if (bp->table.mask != s->tmask &&
  393.       (ep->selem.clink == NULL ||
  394.       ep->telem.clink->telem.hashnum != ep->telem.hashnum)) {
  395. #endif                    /* TableFix */
  396.       /*
  397.        * Yes, they did split.  Make a note of the current state.
  398.        */
  399.       hn = ep->telem.hashnum;
  400.       for (i = 1; i < HSegs; i++)
  401.          if ((((word)HSlots) << (i - 1)) > s->tmask) {
  402.      /*
  403.       * For the newly created segments only, save the mask and
  404.       *  hash number being processed at time of creation.
  405.       */
  406.      s->sgmask[i] = s->tmask;
  407.      s->sghash[i] = hn;
  408.          }
  409.       s->tmask = bp->table.mask;
  410.       /*
  411.        * Find the next element in our original segment by starting
  412.        *  from the beginning and skipping through the current hash
  413.        *  number.  We can't just follow the link from the current
  414.        *  element, because it may have moved to a new segment.
  415.        */
  416.       ep = bp->table.hdir[s->segnum]->hslots[s->slotnum];
  417. #ifdef TableFix
  418.       while (ep != NULL && BlkType(ep) != T_Table &&
  419.          ep->telem.hashnum <= hn)
  420. #else                    /* TableFix */
  421.       while (ep != NULL && ep->telem.hashnum <= hn)
  422. #endif                    /* TableFix */
  423.          ep = ep->telem.clink;
  424.       }
  425.  
  426.    else {
  427.       /*
  428.        * There was no split, or else if there was we're between items
  429.        *  that have identical hash numbers.  Find the next element in
  430.        *  the current hash chain.
  431.        */
  432. #ifdef TableFix
  433.       if (ep != NULL && BlkType(ep) != T_Table)    /* NULL on very first call */
  434. #else                    /* TableFix */
  435.       if (ep != NULL)            /* already NULL on very first call */
  436. #endif                    /* TableFix */
  437.          ep = ep->telem.clink;        /* next element in chain, if any */
  438.    }
  439.  
  440.    /*
  441.     * If we don't yet have an element, search successive slots.
  442.     */
  443. #ifdef TableFix
  444.    while (ep == NULL || BlkType(ep) == T_Table) {
  445. #else                    /* TableFix */
  446.    while (ep == NULL) {
  447. #endif                    /* TableFix */
  448.       /*
  449.        * Move to the next slot and pick the first entry.
  450.        */
  451.       s->slotnum++;
  452.       if (s->slotnum >= segsize[s->segnum]) {
  453.      s->slotnum = 0;        /* need to move to next segment */
  454.      s->segnum++;
  455.      if (s->segnum >= HSegs || bp->table.hdir[s->segnum] == NULL)
  456.         return 0;            /* return NULL at end of set/table */
  457.          }
  458.       ep = bp->table.hdir[s->segnum]->hslots[s->slotnum];
  459.       /*
  460.        * Check to see if parts of this hash chain were already processed.
  461.        *  This could happen if the elements were in a different chain,
  462.        *  but a split occurred while we were suspended.
  463.        */
  464.       for (i = s->segnum; (m = s->sgmask[i]) != 0; i--) {
  465.          d = (word)(m & s->slotnum) - (word)(m & s->sghash[i]);
  466.          if (d < 0)            /* if all elements processed earlier */
  467.             ep = NULL;            /* skip this slot */
  468.          else if (d == 0) {
  469.             /*
  470.              * This chain was split from its parent while the parent was
  471.              *  being processed.  Skip past elements already processed.
  472.              */
  473. #ifdef TableFix
  474.             while (ep != NULL && BlkType(ep) != T_Table &&
  475.            ep->telem.hashnum <= s->sghash[i])
  476. #else                    /* TableFix */
  477.             while (ep != NULL && ep->telem.hashnum <= s->sghash[i])
  478. #endif                    /* TableFix */
  479.                ep = ep->telem.clink;
  480.             }
  481.          }
  482.       }
  483.  
  484.    /*
  485.     * Return the element.
  486.     */
  487. #ifdef TableFix
  488.    if (ep && BlkType(ep) == T_Table) ep = NULL;
  489. #endif                    /* TableFix */
  490.    return ep;
  491.    }
  492.  
  493. /*
  494.  * hgrow - split a hashed structure (doubling the buckets) for faster access.
  495.  */
  496.  
  497. void hgrow(bp)
  498. union block *bp;
  499.    {
  500.    register union block **tp0, **tp1, *ep;
  501.    register word newslots, slotnum, segnum;
  502.    tended struct b_set *ps;
  503.    struct b_slots *seg, *newseg;
  504.    union block **curslot;
  505.  
  506.    ps = (struct b_set *) bp;
  507.    if (ps->hdir[HSegs-1] != NULL)
  508.       return;                /* can't split further */
  509.    newslots = ps->mask + 1;
  510.    Protect(newseg = alcsegment(newslots), return);
  511. #ifdef TableFix
  512.    if (BlkType(bp) == T_Table) {
  513.       int j;
  514.       for(j=0; j<newslots; j++) newseg->hslots[j] = bp;
  515.       }
  516. #endif                    /* TableFix */
  517.  
  518.    curslot = newseg->hslots;
  519.    for (segnum = 0; (seg = ps->hdir[segnum]) != NULL; segnum++)
  520.       for (slotnum = 0; slotnum < segsize[segnum]; slotnum++)  {
  521.          tp0 = &seg->hslots[slotnum];    /* ptr to tail of old slot */
  522.          tp1 = curslot++;        /* ptr to tail of new slot */
  523. #ifdef TableFix
  524.          for (ep = *tp0;
  525.           ep != NULL && BlkType(ep) != T_Table;
  526.           ep = ep->selem.clink) {
  527. #else                    /* TableFix */
  528.          for (ep = *tp0; ep != NULL; ep = ep->selem.clink) {
  529. #endif                    /* TableFix */
  530.             if ((ep->selem.hashnum & newslots) == 0) {
  531.                *tp0 = ep;        /* element does not move */
  532.                tp0 = &ep->selem.clink;
  533.                }
  534.             else {
  535.                *tp1 = ep;        /* element moves to new slot */
  536.                tp1 = &ep->selem.clink;
  537.                }
  538.             }
  539. #ifdef TableFix
  540.          if ( BlkType(bp) == T_Table )
  541.         *tp0 = *tp1 = bp;
  542.          else
  543.             *tp0 = *tp1 = NULL;
  544. #else                    /* TableFix */
  545.          *tp0 = *tp1 = NULL;
  546. #endif                    /* TableFix */
  547.          }
  548.    ps->hdir[segnum] = newseg;
  549.    ps->mask = (ps->mask << 1) | 1;
  550.    }
  551.  
  552. /*
  553.  * hshrink - combine buckets in a set or table that is too sparse.
  554.  *
  555.  *  Call this only for newly created structures.  Shrinking an active structure
  556.  *  can wreak havoc on suspended generators.
  557.  */
  558. void hshrink(bp)
  559. union block *bp;
  560.    {
  561.    register union block **tp, *ep0, *ep1;
  562.    int topseg, curseg;
  563.    word slotnum;
  564.    tended struct b_set *ps;
  565.    struct b_slots *seg;
  566.    union block **uppslot;
  567.  
  568.    ps = (struct b_set *)bp;
  569.    topseg = 0;
  570.    for (topseg = 1; topseg < HSegs && ps->hdir[topseg] != NULL; topseg++)
  571.       ;
  572.    topseg--;
  573.    while (TooSparse(ps)) {
  574.       uppslot = ps->hdir[topseg]->hslots;
  575.       ps->hdir[topseg--] = NULL;
  576.       for (curseg = 0; (seg = ps->hdir[curseg]) != NULL; curseg++)
  577.          for (slotnum = 0; slotnum < segsize[curseg]; slotnum++)  {
  578.             tp = &seg->hslots[slotnum];        /* tail pointer */
  579.             ep0 = seg->hslots[slotnum];        /* lower slot entry pointer */
  580.             ep1 = *uppslot++;            /* upper slot entry pointer */
  581. #ifdef TableFix
  582.             while (ep0 != NULL && BlkType(ep0) != T_Table &&
  583.            ep1 != NULL && BlkType(ep1) != T_Table)
  584. #else                    /* TableFix */
  585.             while (ep0 != NULL && ep1 != NULL)
  586. #endif                    /* TableFix */
  587.                if (ep0->selem.hashnum < ep1->selem.hashnum) {
  588.                   *tp = ep0;
  589.                   tp = &ep0->selem.clink;
  590.                   ep0 = ep0->selem.clink;
  591.                   }
  592.                else {
  593.                   *tp = ep1;
  594.                   tp = &ep1->selem.clink;
  595.                   ep1 = ep1->selem.clink;
  596.                   }
  597. #ifdef TableFix
  598.             while (ep0 != NULL && BlkType(ep0) != T_Table) {
  599. #else                    /* TableFix */
  600.             while (ep0 != NULL) {
  601. #endif                    /* TableFix */
  602.                *tp = ep0;
  603.                tp = &ep0->selem.clink;
  604.                ep0 = ep0->selem.clink;
  605.                }
  606. #ifdef TableFix
  607.             while (ep1 != NULL && BlkType(ep1) != T_Table) {
  608. #else                    /* TableFix */
  609.             while (ep1 != NULL) {
  610. #endif                    /* TableFix */
  611.                *tp = ep1;
  612.                tp = &ep1->selem.clink;
  613.                ep1 = ep1->selem.clink;
  614.                }
  615.             }
  616.       ps->mask >>= 1;
  617.       }
  618.    }
  619.  
  620. /*
  621.  * memb - sets res flag to 1 if x is a member of a set or table, or to 0 if not.
  622.  *  Returns a pointer to the word which points to the element, or which
  623.  *  would point to it if it were there.
  624.  */
  625.  
  626. union block **memb(pb, x, hn, res)
  627. union block *pb;
  628. dptr x;
  629. register uword hn;
  630. int *res;                /* pointer to integer result flag */
  631.    {
  632.    struct b_set *ps;
  633.    register union block **lp;
  634.    register struct b_selem *pe;
  635.    register uword eh;
  636.  
  637.    ps = (struct b_set *)pb;
  638.    lp = hchain(pb, hn);
  639.    /*
  640.     * Look for x in the hash chain.
  641.     */
  642.    *res = 0;
  643. #ifdef TableFix
  644.    while ((pe = (struct b_selem *)*lp) != NULL && BlkType(pe) != T_Table) {
  645. #else                    /* TableFix */
  646.    while ((pe = (struct b_selem *)*lp) != NULL) {
  647. #endif                    /* TableFix */
  648.       eh = pe->hashnum;
  649.       if (eh > hn)            /* too far - it isn't there */
  650.          return lp;
  651.       else if ((eh == hn) && (equiv(&pe->setmem, x)))  {
  652.          *res = 1;
  653.          return lp;
  654.          }
  655.       /*
  656.        * We haven't reached the right hashnumber yet or
  657.        *  the element isn't the right one so keep looking.
  658.        */
  659.       lp = &(pe->clink);
  660.       }
  661.    /*
  662.     *  At end of chain - not there.
  663.     */
  664.    return lp;
  665.    }
  666.