home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v92.tgz / v92.tar / v92 / src / runtime / fstruct.r < prev    next >
Text File  |  1996-03-22  |  22KB  |  881 lines
  1. /*
  2.  * File: fstruct.r
  3.  *  Contents: delete, get, key, insert, list, member, pop, pull, push, put,
  4.  *  set, table
  5.  */
  6.  
  7. "delete(x1,x2) - delete element x2 from set or table x1 if it is there"
  8. " (always succeeds and returns x1)."
  9.  
  10. function{1} delete(s,x)
  11.    abstract {
  12.       return type(s) ** (set ++ table)
  13.       }
  14.  
  15.    /*
  16.     * The technique and philosophy here are the same
  17.     *  as used in insert - see comment there.
  18.     */
  19.    type_case s of {
  20.       set:
  21.          body {
  22.             register uword hn;
  23.             register union block **pd;
  24.             union block *bp;     /* does not need to be tended. */
  25.             int res;
  26.  
  27.             hn = hash(&x);
  28.  
  29.             pd = memb(BlkLoc(s), &x, hn, &res);
  30.             if (res == 1) {
  31.                /*
  32.                * The element is there so delete it.
  33.                */
  34.                *pd = (*pd)->selem.clink;
  35.                (BlkLoc(s)->set.size)--;
  36.                }
  37.  
  38.             EVValD(&s, E_Sdelete);
  39.             EVValD(&x, E_Sval);
  40.             return s;
  41.         }
  42.       table:
  43.          body {
  44.             union block *bp;     /* does not need to be tended. */
  45.             register union block **pd;
  46.             register uword hn;
  47.             int res;
  48.  
  49.             hn = hash(&x);
  50.             pd = memb(BlkLoc(s), &x, hn, &res);
  51.             if (res == 1) {
  52.                /*
  53.                 * The element is there so delete it.
  54.                 */
  55.                *pd = (*pd)->telem.clink;
  56.                (BlkLoc(s)->table.size)--;
  57.                }
  58.  
  59.             EVValD(&s, E_Tdelete);
  60.             EVValD(&x, E_Tsub);
  61.             return s;
  62.             }
  63.       default:
  64.          runerr(122, s)
  65.       }
  66. end
  67.  
  68.  
  69. /*
  70.  * c_get - convenient C-level access to the get function
  71.  *  returns 0 on failure, otherwise fills in res
  72.  */
  73. int c_get(hp, res)
  74. struct b_list *hp;
  75. struct descrip *res;
  76. {
  77.    register word i;
  78.    register struct b_lelem *bp;
  79.  
  80.    /*
  81.     * Fail if the list is empty.
  82.     */
  83.    if (hp->size <= 0)
  84.       return 0;
  85.  
  86.    /*
  87.     * Point bp at the first list block.  If the first block has no
  88.     *  elements in use, point bp at the next list block.
  89.     */
  90.    bp = (struct b_lelem *) hp->listhead;
  91.    if (bp->nused <= 0) {
  92.       bp = (struct b_lelem *) bp->listnext;
  93.       hp->listhead = (union block *) bp;
  94.       bp->listprev = NULL;
  95.       }
  96.  
  97.    /*
  98.     * Locate first element and assign it to result for return.
  99.     */
  100.    i = bp->first;
  101.    *res = bp->lslots[i];
  102.  
  103.    /*
  104.     * Set bp->first to new first element, or 0 if the block is now
  105.     *  empty.  Decrement the usage count for the block and the size
  106.     *  of the list.
  107.     */
  108.    if (++i >= bp->nslots)
  109.       i = 0;
  110.    bp->first = i;
  111.    bp->nused--;
  112.    hp->size--;
  113.  
  114.    return 1;
  115. }
  116.  
  117. #begdef GetOrPop(get_or_pop)
  118. #get_or_pop "(x) - " #get_or_pop " an element from the left end of list x."
  119. /*
  120.  * get(L) - get an element from end of list L.
  121.  *  Identical to pop(L).
  122.  */
  123. function{0,1} get_or_pop(x)
  124.    if !is:list(x) then
  125.       runerr(108, x)
  126.  
  127.    abstract {
  128.       return store[type(x).lst_elem]
  129.       }
  130.  
  131.    body {
  132.       EVValD(&x, E_Lget);
  133.       if (!c_get((struct b_list *)BlkLoc(x),&result)) fail;
  134.       return result;
  135.       }
  136. end
  137. #enddef
  138.  
  139. GetOrPop(get) /* get(x) - get an element from the left end of list x. */
  140. GetOrPop(pop) /* pop(x) - pop an element from the left end of list x. */
  141.  
  142.  
  143. "key(T) - generate successive keys (entry values) from table T."
  144.  
  145. function{*} key(t)
  146.    if !is:table(t) then
  147.          runerr(124, t)
  148.  
  149.    abstract {
  150.       return store[type(t).tbl_key]
  151.       }
  152.  
  153.    inline {
  154.       tended union block *ep;
  155.       struct hgstate state;
  156.  
  157.       EVValD(&t, E_Tkey);
  158.       for (ep = hgfirst(BlkLoc(t), &state); ep != 0;
  159.      ep = hgnext(BlkLoc(t), &state, ep)) {
  160.             EVValD(&ep->telem.tref, E_Tsub);
  161.             suspend ep->telem.tref;
  162.             }
  163.       fail;
  164.       }
  165. end
  166.  
  167.  
  168. "insert(x1, x2, x3) - insert element x2 into set or table x1 if not already there"
  169. " if x1 is a table, the assigned value for element x2 is x3."
  170. " (always succeeds and returns x1)."
  171.  
  172. function{1} insert(s, x, y)
  173.    type_case s of {
  174.  
  175.       set: {
  176.          abstract {
  177.             store[type(s).set_elem] = type(x)
  178.             return type(s)
  179.             }
  180.  
  181.          body {
  182.             tended union block *bp, *bp2;
  183.             register uword hn;
  184.             int res;
  185.             struct b_selem *se;
  186.             register union block **pd;
  187.  
  188.             bp = BlkLoc(s);
  189.             hn = hash(&x);
  190.             /*
  191.              * If x is a member of set s then res will have the value 1,
  192.              *  and pd will have a pointer to the pointer
  193.              *  that points to that member.
  194.              *  If x is not a member of the set then res will have
  195.              *  the value 0 and pd will point to the pointer
  196.              *  which should point to the member - thus we know where
  197.              *  to link in the new element without having to do any
  198.              *  repetitive looking.
  199.              */
  200.  
  201.         /* get this now because can't tend pd */
  202.             Protect(se = alcselem(&x, hn), runerr(0));
  203.  
  204.             pd = memb(bp, &x, hn, &res);
  205.             if (res == 0) {
  206.                /*
  207.                * The element is not in the set - insert it.
  208.                */
  209.                addmem((struct b_set *)bp, se, pd);
  210.                if (TooCrowded(bp))
  211.                   hgrow(bp);
  212.                }
  213.         else
  214.            deallocate((union block *)se);
  215.  
  216.             EVValD(&s, E_Sinsert);
  217.             EVValD(&x, E_Sval);
  218.             return s;
  219.             }
  220.          }
  221.  
  222.       table: {
  223.          abstract {
  224.             store[type(s).tbl_key] = type(x)
  225.             store[type(s).tbl_val] = type(y)
  226.             return type(s)
  227.             }
  228.  
  229.          body {
  230.             tended union block *bp, *bp2;
  231.             union block **pd;
  232.             struct b_telem *te;
  233.             register uword hn;
  234.             int res;
  235.  
  236.             bp = BlkLoc(s);
  237.             hn = hash(&x);
  238.  
  239.         /* get this now because can't tend pd */
  240.             Protect(te = alctelem(), runerr(0));
  241.  
  242.             pd = memb(bp, &x, hn, &res);    /* search table for key */
  243.             if (res == 0) {
  244.                /*
  245.                * The element is not in the table - insert it.
  246.                */
  247.                bp->table.size++;
  248.                te->clink = *pd;
  249.                *pd = (union block *)te;
  250.                te->hashnum = hn;
  251.                te->tref = x;
  252.                te->tval = y;
  253.                if (TooCrowded(bp))
  254.                   hgrow(bp);
  255.                }
  256.             else {
  257.            /*
  258.         * We found an existing entry; just change its value.
  259.         */
  260.            deallocate((union block *)te);
  261.                te = (struct b_telem *) *pd;
  262.                te->tval = y;
  263.                }
  264.  
  265.             EVValD(&s, E_Tinsert);
  266.             EVValD(&x, E_Tsub);
  267.             return s;
  268.             }
  269.          }
  270.  
  271.       default:
  272.          runerr(122, s);
  273.       }
  274. end
  275.  
  276.  
  277. "list(i, x) - create a list of size i, with initial value x."
  278.  
  279. function{1} list(n, x)
  280.    if !def:C_integer(n, 0L) then
  281.       runerr(101, n)
  282.  
  283.    abstract {
  284.       return new list(type(x))
  285.       }
  286.  
  287.    body {
  288.       tended struct b_list *hp;
  289.       register word i, size;
  290.       word nslots;
  291.       register struct b_lelem *bp; /* does not need to be tended */
  292.  
  293.       nslots = size = n;
  294.  
  295.       /*
  296.        * Ensure that the size is positive and that the list-element block 
  297.        *  has at least MinListSlots slots.
  298.        */
  299.       if (size < 0) {
  300.          irunerr(205, n);
  301.          errorfail;
  302.          }
  303.       if (nslots == 0)
  304.          nslots = MinListSlots;
  305.  
  306.       /*
  307.        * Allocate the list-header block and a list-element block.
  308.        *  Note that nslots is the number of slots in the list-element
  309.        *  block while size is the number of elements in the list.
  310.        */
  311.       Protect(hp = alclist(size), runerr(0));
  312.       Protect(bp = alclstb(nslots, (word)0, size), runerr(0));
  313.       hp->listhead = hp->listtail = (union block *) bp;
  314.  
  315.       /*
  316.        * Initialize each slot.
  317.        */
  318.       for (i = 0; i < size; i++)
  319.          bp->lslots[i] = x;
  320.  
  321.       Desc_EVValD(hp, E_Lcreate, D_List);
  322.  
  323.       /*
  324.        * Return the new list.
  325.        */
  326.       return list(hp);
  327.       }
  328. end
  329.  
  330.  
  331. "member(x1, x2) - returns x1 if x2 is a member of set or table x2 but fails"
  332. " otherwise."
  333.  
  334. function{0,1} member(s, x)
  335.    type_case s of {
  336.  
  337.       set: {
  338.          abstract {
  339.             return type(x) ** store[type(s).set_elem]
  340.             }
  341.          inline {
  342.             int res;
  343.             register uword hn;
  344.  
  345.             EVValD(&s, E_Smember);
  346.             EVValD(&x, E_Sval);
  347.  
  348.             hn = hash(&x);
  349.             memb(BlkLoc(s), &x, hn, &res);
  350.             if (res==1)
  351.                return x;
  352.             else
  353.                fail;
  354.             }
  355.          }
  356.       table: {
  357.          abstract {
  358.             return type(x) ** store[type(s).tbl_key]
  359.             }
  360.          inline {
  361.             int res;
  362.             register uword hn;
  363.  
  364.             EVValD(&s, E_Tmember);
  365.             EVValD(&x, E_Tsub);
  366.  
  367.             hn = hash(&x);
  368.             memb(BlkLoc(s),&x,hn,&res);
  369.             if (res == 1)
  370.                return x;
  371.             else
  372.                fail;
  373.             }
  374.          }
  375.       default:
  376.          runerr(122, s)
  377.       }
  378. end
  379.  
  380.  
  381. "pull(L) - pull an element from end of list L."
  382.  
  383. function{0,1} pull(x)
  384.    /*
  385.     * x must be a list.
  386.     */
  387.    if !is:list(x) then
  388.       runerr(108, x)
  389.    abstract {
  390.       return store[type(x).lst_elem]
  391.       }
  392.  
  393.    body {
  394.       register word i;
  395.       register struct b_list *hp;
  396.       register struct b_lelem *bp;
  397.  
  398.       EVValD(&x, E_Lpull);
  399.  
  400.       /*
  401.        * Point at list header block and fail if the list is empty.
  402.        */
  403.       hp = (struct b_list *) BlkLoc(x);
  404.       if (hp->size <= 0)
  405.          fail;
  406.  
  407.       /*
  408.        * Point bp at the last list element block.  If the last block has no
  409.        *  elements in use, point bp at the previous list element block.
  410.        */
  411.       bp = (struct b_lelem *) hp->listtail;
  412.       if (bp->nused <= 0) {
  413.          bp = (struct b_lelem *) bp->listprev;
  414.          hp->listtail = (union block *) bp;
  415.          bp->listnext = NULL;
  416.          }
  417.  
  418.       /*
  419.        * Set i to position of last element and assign the element to
  420.        *  result for return.  Decrement the usage count for the block
  421.        *  and the size of the list.
  422.        */
  423.       i = bp->first + bp->nused - 1;
  424.       if (i >= bp->nslots)
  425.          i -= bp->nslots;
  426.       result = bp->lslots[i];
  427.       bp->nused--;
  428.       hp->size--;
  429.       return result;
  430.       }
  431. end
  432.  
  433. #ifdef Graphics
  434. /*
  435.  * c_push - C-level, nontending push operation
  436.  */
  437. int c_push(l, val)
  438. dptr l;
  439. dptr val;
  440. {
  441.    register word i;
  442.    register struct b_lelem *bp; /* does not need to be tended */
  443.    static two = 2;        /* some compilers generate bad code for
  444.                    division by a constant that's a power of 2*/
  445.    /*
  446.     * Point bp at the first list-element block.
  447.     */
  448.    bp = (struct b_lelem *) BlkLoc(*l)->list.listhead;
  449.  
  450. #ifdef EventMon     /* initialize i so it's 0 if first list-element */
  451.    i = 0;            /* block isn't full */
  452. #endif                /* EventMon */
  453.  
  454.    /*
  455.     * If the first list-element block is full, allocate a new
  456.     *  list-element block, make it the first list-element block,
  457.     *  and make it the previous block of the former first list-element
  458.     *  block.
  459.     */
  460.    if (bp->nused >= bp->nslots) {
  461.       /*
  462.        * Set i to the size of block to allocate.
  463.        */
  464.       i = BlkLoc(*l)->list.size / two;
  465.       if (i < MinListSlots)
  466.          i = MinListSlots;
  467. #ifdef MaxListSlots
  468.       if (i > MaxListSlots)
  469.          i = MaxListSlots;
  470. #endif                    /* MaxListSlots */
  471.  
  472.       /*
  473.        * Allocate a new list element block.  If the block can't
  474.        *  be allocated, try smaller blocks.
  475.        */
  476.       while ((bp = alclstb(i, (word)0, (word)0)) == NULL) {
  477.          i /= 4;
  478.          if (i < MinListSlots)
  479.             fatalerr(0, NULL);
  480.          }
  481.  
  482.       BlkLoc(*l)->list.listhead->lelem.listprev = (union block *) bp;
  483.       bp->listnext = BlkLoc(*l)->list.listhead;
  484.       BlkLoc(*l)->list.listhead = (union block *) bp;
  485.       }
  486.  
  487.    /*
  488.     * Set i to position of new first element and assign val to
  489.     *  that element.
  490.     */
  491.    i = bp->first - 1;
  492.    if (i < 0)
  493.       i = bp->nslots - 1;
  494.    bp->lslots[i] = *val;
  495.    /*
  496.     * Adjust value of location of first element, block usage count,
  497.     *  and current list size.
  498.     */
  499.    bp->first = i;
  500.    bp->nused++;
  501.    BlkLoc(*l)->list.size++;
  502.    }
  503. #endif                    /* Graphics */
  504.  
  505.  
  506. "push(L, x1, ..., xN) - push x onto beginning of list L."
  507.  
  508. function{1} push(x, vals[n])
  509.    /*
  510.     * x must be a list.
  511.     */
  512.    if !is:list(x) then
  513.       runerr(108, x)
  514.    abstract {
  515.       store[type(x).lst_elem] = type(vals)
  516.       return type(x)
  517.       }
  518.  
  519.    body {
  520.       tended struct b_list *hp;
  521.       dptr dp;
  522.       register word i, val, num;
  523.       register struct b_lelem *bp; /* does not need to be tended */
  524.       static two = 2;        /* some compilers generate bad code for
  525.                    division by a constant that's a power of 2*/
  526.  
  527.       if (n == 0) {
  528.      dp = &nulldesc;
  529.      num = 1;
  530.      }
  531.       else {
  532.      dp = vals;
  533.      num = n;
  534.      }
  535.  
  536.       for (val = 0; val < num; val++) {
  537.      /*
  538.       * Point hp at the list-header block and bp at the first
  539.       *  list-element block.
  540.       */
  541.      hp = (struct b_list *) BlkLoc(x);
  542.      bp = (struct b_lelem *) hp->listhead;
  543.  
  544. #ifdef EventMon     /* initialize i so it's 0 if first list-element */
  545.      i = 0;            /* block isn't full */
  546. #endif                /* EventMon */
  547.  
  548.      /*
  549.       * If the first list-element block is full, allocate a new
  550.       *  list-element block, make it the first list-element block,
  551.       *  and make it the previous block of the former first list-element
  552.       *  block.
  553.       */
  554.      if (bp->nused >= bp->nslots) {
  555.         /*
  556.          * Set i to the size of block to allocate.
  557.          */
  558.         i = hp->size / two;
  559.         if (i < MinListSlots)
  560.            i = MinListSlots;
  561. #ifdef MaxListSlots
  562.         if (i > MaxListSlots)
  563.            i = MaxListSlots;
  564. #endif                    /* MaxListSlots */
  565.  
  566.         /*
  567.          * Allocate a new list element block.  If the block can't
  568.          *  be allocated, try smaller blocks.
  569.          */
  570.         while ((bp = alclstb(i, (word)0, (word)0)) == NULL) {
  571.            i /= 4;
  572.            if (i < MinListSlots)
  573.           runerr(0);
  574.            }
  575.  
  576.         hp->listhead->lelem.listprev = (union block *) bp;
  577.         bp->listnext = hp->listhead;
  578.         hp->listhead = (union block *) bp;
  579.         }
  580.  
  581.      /*
  582.       * Set i to position of new first element and assign val to
  583.       *  that element.
  584.       */
  585.      i = bp->first - 1;
  586.      if (i < 0)
  587.         i = bp->nslots - 1;
  588.      bp->lslots[i] = dp[val];
  589.      /*
  590.       * Adjust value of location of first element, block usage count,
  591.       *  and current list size.
  592.       */
  593.      bp->first = i;
  594.      bp->nused++;
  595.      hp->size++;
  596.      }
  597.  
  598.       EVValD(&x, E_Lpush);
  599.  
  600.       /*
  601.        * Return the list.
  602.        */
  603.       return x;
  604.       }
  605. end
  606.  
  607. #ifdef Graphics
  608. /*
  609.  * c_put - C-level, nontending list put function
  610.  */
  611. void c_put(l, val)
  612. struct descrip *l;
  613. struct descrip *val;
  614. {
  615.    register word i;
  616.    register struct b_lelem *bp;  /* does not need to be tended */
  617.    static two = 2;        /* some compilers generate bad code for
  618.                    division by a constant that's a power of 2*/
  619.  
  620.    /*
  621.     * Point hp at the list-header block and bp at the last
  622.     *  list-element block.
  623.     */
  624.    bp = (struct b_lelem *) BlkLoc(*l)->list.listtail;
  625.    
  626. #ifdef EventMon     /* initialize i so it's 0 if last list-element */
  627.    i = 0;            /* block isn't full */
  628. #endif                /* EventMon */
  629.  
  630.    /*
  631.     * If the last list-element block is full, allocate a new
  632.     *  list-element block, make it the last list-element block,
  633.     *  and make it the next block of the former last list-element
  634.     *  block.
  635.     */
  636.    if (bp->nused >= bp->nslots) {
  637.       /*
  638.        * Set i to the size of block to allocate.
  639.        */
  640.       i = ((struct b_list *)BlkLoc(*l))->size / two;
  641.       if (i < MinListSlots)
  642.          i = MinListSlots;
  643. #ifdef MaxListSlots
  644.       if (i > MaxListSlots)
  645.          i = MaxListSlots;
  646. #endif                    /* MaxListSlots */
  647.  
  648.       /*
  649.        * Allocate a new list element block.  If the block can't
  650.        *  be allocated, try smaller blocks.
  651.        */
  652.       while ((bp = alclstb(i, (word)0, (word)0)) == NULL) {
  653.          i /= 4;
  654.          if (i < MinListSlots)
  655.             fatalerr(0, NULL);
  656.          }
  657.  
  658.       ((struct b_list *)BlkLoc(*l))->listtail->lelem.listnext =
  659.     (union block *) bp;
  660.       bp->listprev = ((struct b_list *)BlkLoc(*l))->listtail;
  661.       ((struct b_list *)BlkLoc(*l))->listtail = (union block *) bp;
  662.       }
  663.  
  664.    /*
  665.     * Set i to position of new last element and assign val to
  666.     *  that element.
  667.     */
  668.    i = bp->first + bp->nused;
  669.    if (i >= bp->nslots)
  670.       i -= bp->nslots;
  671.    bp->lslots[i] = *val;
  672.  
  673.    /*
  674.     * Adjust block usage count and current list size.
  675.     */
  676.    bp->nused++;
  677.    ((struct b_list *)BlkLoc(*l))->size++;
  678. }
  679. #endif                    /* Graphics */
  680.  
  681.  
  682. "put(L, x1, ..., xN) - put elements onto end of list L."
  683.  
  684. function{1} put(x, vals[n])
  685.    /*
  686.     * x must be a list.
  687.     */
  688.    if !is:list(x) then
  689.       runerr(108, x)
  690.    abstract {
  691.       store[type(x).lst_elem] = type(vals)
  692.       return type(x)
  693.       }
  694.  
  695.    body {
  696.       tended struct b_list *hp;
  697.       dptr dp;
  698.       register word i, val, num;
  699.       register struct b_lelem *bp;  /* does not need to be tended */
  700.       static two = 2;        /* some compilers generate bad code for
  701.                    division by a constant that's a power of 2*/
  702.       if (n == 0) {
  703.      dp = &nulldesc;
  704.      num = 1;
  705.      }
  706.       else {
  707.      dp = vals;
  708.      num = n;
  709.      }
  710.  
  711.       /*
  712.        * Point hp at the list-header block and bp at the last
  713.        *  list-element block.
  714.        */
  715.       for(val = 0; val < num; val++) {
  716.  
  717.      hp = (struct b_list *)BlkLoc(x);
  718.      bp = (struct b_lelem *) hp->listtail;
  719.    
  720. #ifdef EventMon     /* initialize i so it's 0 if last list-element */
  721.      i = 0;            /* block isn't full */
  722. #endif                /* EventMon */
  723.  
  724.      /*
  725.       * If the last list-element block is full, allocate a new
  726.       *  list-element block, make it the last list-element block,
  727.       *  and make it the next block of the former last list-element
  728.       *  block.
  729.       */
  730.      if (bp->nused >= bp->nslots) {
  731.         /*
  732.          * Set i to the size of block to allocate.
  733.          */
  734.         i = hp->size / two;
  735.         if (i < MinListSlots)
  736.            i = MinListSlots;
  737. #ifdef MaxListSlots
  738.         if (i > MaxListSlots)
  739.            i = MaxListSlots;
  740. #endif                    /* MaxListSlots */
  741.         /*
  742.          * Allocate a new list element block.  If the block can't
  743.          *  be allocated, try smaller blocks.
  744.          */
  745.         while ((bp = alclstb(i, (word)0, (word)0)) == NULL) {
  746.            i /= 4;
  747.            if (i < MinListSlots)
  748.           runerr(0);
  749.            }
  750.  
  751.         hp->listtail->lelem.listnext = (union block *) bp;
  752.         bp->listprev = hp->listtail;
  753.         hp->listtail = (union block *) bp;
  754.         }
  755.  
  756.      /*
  757.       * Set i to position of new last element and assign val to
  758.       *  that element.
  759.       */
  760.      i = bp->first + bp->nused;
  761.      if (i >= bp->nslots)
  762.         i -= bp->nslots;
  763.      bp->lslots[i] = dp[val];
  764.  
  765.      /*
  766.       * Adjust block usage count and current list size.
  767.       */
  768.      bp->nused++;
  769.      hp->size++;
  770.  
  771.      }
  772.  
  773.       EVValD(&x, E_Lput);
  774.  
  775.       /*
  776.        * Return the list.
  777.        */
  778.       return x;
  779.       }
  780. end
  781.  
  782.  
  783. "set(L) - create a set with members in list L."
  784. "  The members are linked into hash chains which are"
  785. " arranged in increasing order by hash number."
  786.  
  787. function{1} set(l)
  788.  
  789.    type_case l of {
  790.       null: {
  791.          abstract {
  792.             return new set(empty_type)
  793.             }
  794.          inline {
  795.             register union block * ps;
  796.             ps = hmake(T_Set, (word)0, (word)0);
  797.             if (ps == NULL)
  798.                runerr(0);
  799.             return set(ps);
  800.             }
  801.          }
  802.  
  803.       list: {
  804.          abstract {
  805.             return new set(store[type(l).lst_elem])
  806.             }
  807.  
  808.          body {
  809.             tended union block *pb;
  810.             register uword hn;
  811.             dptr pd;
  812.             struct b_selem *ne;      /* does not need to be tended */
  813.             int res;
  814.             word i, j;
  815.             tended union block *ps;
  816.             union block **pe;
  817.  
  818.             /*
  819.              * Make a set of the appropriate size.
  820.              */
  821.             pb = BlkLoc(l);
  822.             ps = hmake(T_Set, (word)0, pb->list.size);
  823.             if (ps == NULL)
  824.                runerr(0);
  825.  
  826.             /*
  827.              * Chain through each list block and for
  828.              *  each element contained in the block
  829.              *  insert the element into the set if not there.
  830.          *
  831.          * ne always has a new element ready for use.  We must get one
  832.          *  in advance, and stay one ahead, because pe can't be tended.
  833.          */
  834.         Protect(ne = alcselem(&nulldesc, (uword)0), runerr(0));
  835.  
  836.             for (pb = pb->list.listhead; pb != NULL; pb = pb->lelem.listnext) {
  837.                for (i = 0; i < pb->lelem.nused; i++) {
  838.                   j = pb->lelem.first + i;
  839.                   if (j >= pb->lelem.nslots)
  840.                      j -= pb->lelem.nslots;
  841.                   pd = &pb->lelem.lslots[j];
  842.                   pe = memb(ps, pd, hn = hash(pd), &res);
  843.                   if (res == 0) {
  844.              ne->setmem = *pd;            /* add new element */
  845.              ne->hashnum = hn;
  846.                      addmem((struct b_set *)ps, ne, pe);
  847.                             /* get another blk */
  848.                  Protect(ne = alcselem(&nulldesc, (uword)0), runerr(0));
  849.                      }
  850.                   }
  851.                }
  852.         deallocate((union block *)ne);
  853.             Desc_EVValD(ps, E_Screate, D_Set);
  854.             return set(ps);
  855.             }
  856.          }
  857.  
  858.       default :
  859.          runerr(108, l)
  860.       }
  861. end
  862.  
  863.  
  864. "table(x) - create a table with default value x."
  865.  
  866. function{1} table(x)
  867.    abstract {
  868.       return new table(empty_type, empty_type, type(x))
  869.       }
  870.    inline {
  871.       union block *bp;
  872.    
  873.       bp = hmake(T_Table, (word)0, (word)0);
  874.       if (bp == NULL)
  875.          runerr(0);
  876.       bp->table.defvalue = x;
  877.       Desc_EVValD(bp, E_Tcreate, D_Table);
  878.       return table(bp);
  879.       }
  880. end
  881.