home *** CD-ROM | disk | FTP | other *** search
/ APDL Public Domain 1 / APDL_PD1A.iso / program / language / icon / Source / Iconx / C / Fstruct < prev    next >
Encoding:
Text File  |  1990-07-19  |  14.0 KB  |  625 lines
  1. /*
  2.  * File: fstruct.c
  3.  *  Contents: delete, get, key, insert, list, member, pop, pull, push, put, set,
  4.  *  table
  5.  */
  6.  
  7. #include "../h/config.h"
  8. #include "../h/rt.h"
  9. #include "rproto.h"
  10.  
  11.  
  12. /*
  13.  * delete(X,x) - delete element x from set or table X if it is there
  14.  *  (always succeeds and returns X).
  15.  */
  16.  
  17. FncDcl(delete,2)
  18.    {
  19.    register union block **pd;
  20.    register uword hn;
  21.    int res;
  22.  
  23.    if (Qual(Arg1))
  24.       RunErr(122, &Arg1);
  25.  
  26.    /*
  27.    * The technique and philosophy here are the same
  28.    *  as used in insert - see comment there.
  29.    */
  30.    switch (Type(Arg1)) {
  31.       case T_Set:
  32.       case T_Table:
  33.          hn = hash(&Arg2);
  34.          pd = memb(BlkLoc(Arg1), &Arg2, hn, &res);
  35.          if (res == 1) {
  36.             /*
  37.             * The element is there so delete it.
  38.             */
  39.             *pd = (*pd)->selem.clink;
  40.             (BlkLoc(Arg1)->set.size)--;
  41.             }
  42.          break;
  43.  
  44.       default:
  45.          RunErr(122, &Arg1);
  46.       }
  47.  
  48.    Arg0 = Arg1;
  49.    Return;
  50.    }
  51.  
  52.  
  53. /*
  54.  * get(x) - get an element from end of list x.
  55.  *  Identical to pop(x).
  56.  */
  57.  
  58. FncDcl(get,1)
  59.    {
  60.    register word i;
  61.    register struct b_list *hp;
  62.    register struct b_lelem *bp;
  63.  
  64.    /*
  65.     * Arg1 must be a list.
  66.     */
  67.    if (Arg1.dword != D_List) 
  68.       RunErr(108, &Arg1);
  69.  
  70.    /*
  71.     * Fail if the list is empty.
  72.     */
  73.    hp = (struct b_list *) BlkLoc(Arg1);
  74.    if (hp->size <= 0)
  75.       Fail;
  76.  
  77.    /*
  78.     * Point bp at the first list block.  If the first block has no
  79.     *  elements in use, point bp at the next list block.
  80.     */
  81.    bp = (struct b_lelem *) hp->listhead;
  82.    if (bp->nused <= 0) {
  83.       bp = (struct b_lelem *) bp->listnext;
  84.       hp->listhead = (union block *) bp;
  85.       bp->listprev = NULL;
  86.       }
  87.    /*
  88.     * Locate first element and assign it to Arg0 for return.
  89.     */
  90.    i = bp->first;
  91.    Arg0 = bp->lslots[i];
  92.    /*
  93.     * Set bp->first to new first element, or 0 if the block is now
  94.     *  empty.  Decrement the usage count for the block and the size
  95.     *  of the list.
  96.     */
  97.    if (++i >= bp->nslots)
  98.       i = 0;
  99.    bp->first = i;
  100.    bp->nused--;
  101.    hp->size--;
  102.    Return;
  103.    }
  104.  
  105. /*
  106.  * key(t) - generate successive keys (entry values) from table t.
  107.  */
  108.  
  109. FncDcl(key,2)
  110.    {
  111.    if (Arg1.dword != D_Table) 
  112.       RunErr(124, &Arg1);
  113.    MakeInt(1, &Arg2);            /* indicate that we want the keys */
  114.    Forward(hgener);            /* go to the hash generator */
  115.    }
  116.  
  117. /*
  118.  * insert(X,x) - insert element x into set or table X if not already there
  119.  *  (always succeeds and returns X).
  120.  */
  121.  
  122. FncDcl(insert,3)
  123.    {
  124.    register union block *bp;
  125.    register union block **pd;
  126.    register struct b_telem *pe;
  127.    register uword hn;
  128.    int res;
  129.  
  130.    if (Qual(Arg1))
  131.       RunErr(122, &Arg1);
  132.  
  133.    switch (Type(Arg1)) {
  134.       case T_Set:
  135.  
  136.          /*
  137.          * We may need at most one new element.
  138.          */
  139.          if (blkreq((word)sizeof(struct b_selem)) == Error) 
  140.             RunErr(0, NULL);
  141.          bp = BlkLoc(Arg1);
  142.          hn = hash(&Arg2);
  143.          /*
  144.           * If Arg2 is a member of set Arg1 then res will have the
  145.           *  value 1 and pd will have a pointer to the pointer
  146.           *  that points to that member.
  147.           *  If Arg2 is not a member of the set then res will have
  148.           *  the value 0 and pd will point to the pointer
  149.           *  which should point to the member - thus we know where
  150.           *  to link in the new element without having to do any
  151.           *  repetitive looking.
  152.           */
  153.          pd = memb(bp, &Arg2, hn, &res);
  154.          if (res == 0) {
  155.             /*
  156.             * The element is not in the set - insert it.
  157.             */
  158.             addmem((struct b_set *)bp, alcselem(&Arg2, hn), pd);
  159.             if (TooCrowded(bp))
  160.                hgrow(&Arg1);
  161.             }
  162.          break;
  163.  
  164.       case T_Table:
  165.          if (blkreq((word)sizeof(struct b_telem)) == Error) 
  166.             RunErr(0, NULL);
  167.          bp = BlkLoc(Arg1);
  168.          hn = hash(&Arg2);
  169.          pd = memb(bp, &Arg2, hn, &res);
  170.          if (res == 0) {
  171.             /*
  172.             * The element is not in the table - insert it.
  173.             */
  174.             bp->table.size++;
  175.             pe = alctelem();
  176.             pe->clink = *pd;
  177.             *pd = (union block *)pe;
  178.             pe->hashnum = hn;
  179.             pe->tref = Arg2;
  180.             pe->tval = Arg3;
  181.             if (TooCrowded(bp))
  182.                hgrow(&Arg1);
  183.             }
  184.          else {
  185.             pe = (struct b_telem *) *pd;
  186.             pe->tval = Arg3;
  187.             }
  188.          break;
  189.  
  190.       default:
  191.          RunErr(122, &Arg1);
  192.       }
  193.  
  194.    Arg0 = Arg1;
  195.    Return;
  196.    }
  197.  
  198. /*
  199.  * list(n,x) - create a list of size n, with initial value x.
  200.  */
  201.  
  202. FncDcl(list,2)
  203.    {
  204.    register word i, size;
  205.    word nslots;
  206.    register struct b_list *hp;
  207.    register struct b_lelem *bp;
  208.  
  209.    if (defshort(&Arg1, 0) == Error) 
  210.       RunErr(0, NULL);
  211.  
  212.    nslots = size = IntVal(Arg1);
  213.  
  214.  
  215.    /*
  216.     * Ensure that the size is positive and that the list-element block 
  217.     *  has MinListSlots slots if its size is zero.
  218.     */
  219.    if (size < 0) 
  220.       RunErr(205, &Arg1);
  221.    if (nslots == 0)
  222.       nslots = MinListSlots;
  223.  
  224.    /*
  225.     * Ensure space for a list-header block, and a list-element block
  226.     * with nslots slots.
  227.     */
  228.    if (blkreq(sizeof(struct b_list) + sizeof(struct b_lelem) +
  229.          (nslots - 1) * sizeof(struct descrip)) == Error) 
  230.       RunErr(0, NULL);
  231.  
  232.    /*
  233.     * Allocate the list-header block and a list-element block.
  234.     *  Note that nslots is the number of slots in the list-element
  235.     *  block while size is the number of elements in the list.
  236.     */
  237.    hp = alclist(size);
  238.    bp = alclstb(nslots, (word)0, size);
  239.    hp->listhead = hp->listtail = (union block *) bp;
  240.  
  241.    /*
  242.     * Initialize each slot.
  243.     */
  244.    for (i = 0; i < size; i++)
  245.       bp->lslots[i] = Arg2;
  246.  
  247.    /*
  248.     * Return the new list.
  249.     */
  250.    Arg0.dword = D_List;
  251.    BlkLoc(Arg0) = (union block *) hp;
  252.    Return;
  253.    }
  254.  
  255. /*
  256.  * member(X,x) - returns x if x is a member of set or table X otherwise fails.
  257.  */
  258.  
  259. FncDcl(member,2)
  260.    {
  261.    int res;
  262.    register uword hn;
  263.  
  264.    if (Qual(Arg1))
  265.       RunErr(122, &Arg1);
  266.  
  267.    switch (Type(Arg1)) {
  268.       case T_Set:
  269.       case T_Table:
  270.          hn = hash(&Arg2);
  271.          memb(BlkLoc(Arg1), &Arg2, hn, &res);
  272.          break;
  273.  
  274.       default:
  275.          RunErr(122, &Arg1);
  276.       }
  277.  
  278.    /* If Arg2 is a member of Arg1 then "res" will have the
  279.     * value 1 otherwise it will have the value 0.
  280.     */
  281.    if (res == 1) {        /* It is a member. */
  282.       Arg0 = Arg2;        /* Return the member if it is in Arg1. */
  283.       Return;
  284.       }
  285.    Fail;
  286.    }
  287.  
  288.  
  289. /*
  290.  * pop(x) - pop an element from beginning of list x.
  291.  */
  292.  
  293. FncDcl(pop,1)
  294.    {
  295.    register word i;
  296.    register struct b_list *hp;
  297.    register struct b_lelem *bp;
  298.  
  299.    /*
  300.     * Arg1 must be a list.
  301.     */
  302.    if (Arg1.dword != D_List) 
  303.       RunErr(108, &Arg1);
  304.  
  305.    /*
  306.     * Fail if the list is empty.
  307.     */
  308.    hp = (struct b_list *) BlkLoc(Arg1);
  309.    if (hp->size <= 0)
  310.       Fail;
  311.  
  312.    /*
  313.     * Point bp to the first list-element block.  If the first block has
  314.     *  no slots in use, point bp at the next list-element block.
  315.     */
  316.    bp = (struct b_lelem *) hp->listhead;
  317.    if (bp->nused <= 0) {
  318.       bp = (struct b_lelem *) bp->listnext;
  319.       hp->listhead = (union block *) bp;
  320.       bp->listprev = NULL;
  321.       }
  322.    /*
  323.     * Locate first element and assign it to Arg0 for return.
  324.     */
  325.    i = bp->first;
  326.    Arg0 = bp->lslots[i];
  327.  
  328.    /*
  329.     * Set bp->first to new first element, or 0 if the block is now
  330.     *  empty.  Decrement the usage count for the block and the size
  331.     *  of the list.
  332.     */
  333.    if (++i >= bp->nslots)
  334.       i = 0;
  335.    bp->first = i;
  336.    bp->nused--;
  337.    hp->size--;
  338.    Return;
  339.    }
  340.  
  341. /*
  342.  * pull(x) - pull an element from end of list x.
  343.  */
  344.  
  345. FncDcl(pull,1)
  346.    {
  347.    register word i;
  348.    register struct b_list *hp;
  349.    register struct b_lelem *bp;
  350.  
  351.    /*
  352.     * Arg1 must be a list.
  353.     */
  354.    if (Arg1.dword != D_List) 
  355.       RunErr(108, &Arg1);
  356.  
  357.    /*
  358.     * Point at list header block and fail if the list is empty.
  359.     */
  360.    hp = (struct b_list *) BlkLoc(Arg1);
  361.    if (hp->size <= 0)
  362.       Fail;
  363.    /*
  364.     * Point bp at the last list element block.  If the last block has no
  365.     *  elements in use, point bp at the previous list element block.
  366.     */
  367.    bp = (struct b_lelem *) hp->listtail;
  368.    if (bp->nused <= 0) {
  369.       bp = (struct b_lelem *) bp->listprev;
  370.       hp->listtail = (union block *) bp;
  371.       bp->listnext = NULL;
  372.       }
  373.    /*
  374.     * Set i to position of last element and assign the element to
  375.     *  Arg0 for return.  Decrement the usage count for the block
  376.     *  and the size of the list.
  377.     */
  378.    i = bp->first + bp->nused - 1;
  379.    if (i >= bp->nslots)
  380.       i -= bp->nslots;
  381.    Arg0 = bp->lslots[i];
  382.    bp->nused--;
  383.    hp->size--;
  384.    Return;
  385.    }
  386.  
  387.  
  388. /*
  389.  * push(x,val) - push val onto beginning of list x.
  390.  */
  391. FncDcl(push,2)
  392.    {
  393.    register word i;
  394.    register struct b_list *hp;
  395.    register struct b_lelem *bp;
  396.    static two = 2;        /* some compilers generat bad code for
  397.                    division by a constant that's a power of 2 */
  398.  
  399.  
  400.    /*
  401.     * Arg1 must be a list.
  402.     */
  403.    if (Arg1.dword != D_List) 
  404.       RunErr(108, &Arg1);
  405.  
  406.    /*
  407.     * Point hp at the list-header block and bp at the first
  408.     *  list-element block.
  409.     */
  410.    hp = (struct b_list *) BlkLoc(Arg1);
  411.    bp = (struct b_lelem *) hp->listhead;
  412.  
  413.    /*
  414.     * If the first list-element block is full, allocate a new
  415.     *  list-element block, make it the first list-element block,
  416.     *  and make it the previous block of the former first list-element
  417.     *  block.
  418.     */
  419.    if (bp->nused >= bp->nslots) {
  420.       /*
  421.        * Set i to the size of block to allocate.
  422.        */
  423.       i = hp->size / two;
  424.       if (i < MinListSlots)
  425.          i = MinListSlots;
  426.  
  427.       /*
  428.        * Ensure space for a new list element block.  If the block can't
  429.        *  be allocated, try smaller blocks.
  430.        */
  431.       while (blkreq((word)sizeof(struct b_lelem) +
  432.             i * sizeof(struct descrip)) == Error) {
  433.         i /= 4;
  434.         if (i < MinListSlots)
  435.            RunErr(0, NULL);
  436.         }
  437.       /*
  438.        * Reset hp in case there was a garbage collection.
  439.        */
  440.       hp = (struct b_list *) BlkLoc(Arg1);
  441.  
  442.       bp = alclstb(i, (word)0, (word)0);
  443.       hp->listhead->lelem.listprev = (union block *) bp;
  444.       bp->listnext = hp->listhead;
  445.       hp->listhead = (union block *) bp;
  446.       }
  447.  
  448.    /*
  449.     * Set i to position of new first element and assign val (Arg2) to
  450.     *  that element.
  451.     */
  452.    i = bp->first - 1;
  453.    if (i < 0)
  454.       i = bp->nslots - 1;
  455.    bp->lslots[i] = Arg2;
  456.    /*
  457.     * Adjust value of location of first element, block usage count,
  458.     *  and current list size.
  459.     */
  460.    bp->first = i;
  461.    bp->nused++;
  462.    hp->size++;
  463.    /*
  464.     * Return the list.
  465.     */
  466.    Arg0 = Arg1;
  467.    Return;
  468.    }
  469.  
  470.  
  471. /*
  472.  * put(x,val) - put val onto end of list x.
  473.  */
  474.  
  475. FncDcl(put,2)
  476.    {
  477.    register word i;
  478.    register struct b_list *hp;
  479.    register struct b_lelem *bp;
  480.    static two = 2;        /* some compilers generate bad code for
  481.                    division by a constant that's a power of 2 */
  482.  
  483.    /*
  484.     * Arg1 must be a list.
  485.     */
  486.    if (Arg1.dword != D_List) 
  487.       RunErr(108, &Arg1);
  488.  
  489.    /*
  490.     * Point hp at the list-header block and bp at the last
  491.     *  list-element block.
  492.     */
  493.    hp = (struct b_list *) BlkLoc(Arg1);
  494.    bp = (struct b_lelem *) hp->listtail;
  495.  
  496.    /*
  497.     * If the last list-element block is full, allocate a new
  498.     *  list-element block, make it the first list-element block,
  499.     *  and make it the next block of the former last list-element
  500.     *  block.
  501.     */
  502.    if (bp->nused >= bp->nslots) {
  503.       /*
  504.        * Set i to the size of block to allocate.
  505.        */
  506.       i = hp->size / two;
  507.       if (i < MinListSlots)
  508.          i = MinListSlots;
  509.  
  510.       /*
  511.        * Ensure space for a new list element block.  If the block can't
  512.        *  be allocated, try smaller blocks.
  513.        */
  514.       while (blkreq((word)sizeof(struct b_lelem) +
  515.             i * sizeof(struct descrip)) == Error) {
  516.         i /= 4;
  517.         if (i < MinListSlots)
  518.            RunErr(0, NULL);
  519.         }
  520.       /*
  521.        * Reset hp in case there was a garbage collection.
  522.        */
  523.       hp = (struct b_list *) BlkLoc(Arg1);
  524.  
  525.       bp = alclstb(i, (word)0, (word)0);
  526.       hp->listtail->lelem.listnext = (union block *) bp;
  527.       bp->listprev = hp->listtail;
  528.       hp->listtail = (union block *) bp;
  529.       }
  530.  
  531.    /*
  532.     * Set i to position of new last element and assign Arg2 to
  533.     *  that element.
  534.     */
  535.    i = bp->first + bp->nused;
  536.    if (i >= bp->nslots)
  537.       i -= bp->nslots;
  538.    bp->lslots[i] = Arg2;
  539.  
  540.    /*
  541.     * Adjust block usage count and current list size.
  542.     */
  543.    bp->nused++;
  544.    hp->size++;
  545.  
  546.    /*
  547.     * Return the list.
  548.     */
  549.    Arg0 = Arg1;
  550.    Return;
  551.    }
  552.  
  553. /*
  554.  * set(list) - create a set with members in list.
  555.  *  The members are linked into hash chains which are
  556.  *  arranged in increasing order by hash number.
  557.  */
  558. FncDcl(set,1)
  559.    {
  560.    register uword hn;
  561.    register dptr pd;
  562.    register union block *ps, *pb;
  563.    struct b_selem *ne;
  564.    union block **pe;
  565.    int res;
  566.    word i, j;
  567.  
  568.    if (ChkNull(Arg1)) {        /* Create empty set */
  569.       ps = hmake(T_Set, (word)0, (word)0);
  570.       if (ps == NULL)
  571.          RunErr(0,NULL);
  572.       Arg0.dword = D_Set;
  573.       BlkLoc(Arg0) = ps;
  574.       Return;
  575.       }
  576.  
  577.    if (Arg1.dword != D_List) 
  578.       RunErr(108, &Arg1);
  579.  
  580.    /*
  581.     * Make a set of the appropriate size.
  582.     */
  583.    ps = hmake(T_Set, (word)0, BlkLoc(Arg1)->list.size);
  584.    if (ps == NULL)
  585.       RunErr(0, NULL);
  586.  
  587.    /*
  588.     * Chain through each list block and for
  589.     *  each element contained in the block
  590.     *  insert the element into the set if not there.
  591.     */
  592.    for (pb = BlkLoc(Arg1)->list.listhead; pb != NULL; pb = pb->lelem.listnext) {
  593.       for (i = 0; i < pb->lelem.nused; i++) {
  594.          j = pb->lelem.first + i;
  595.          if (j >= pb->lelem.nslots)
  596.             j -= pb->lelem.nslots;
  597.          pd = &pb->lelem.lslots[j];
  598.          pe = memb(ps, pd, hn = hash(pd), &res);
  599.          if (res == 0) {
  600.             ne = alcselem(pd,hn);
  601.             addmem((struct b_set *)ps, ne, pe);
  602.             }
  603.          }
  604.       }
  605.    Arg0.dword = D_Set;
  606.    BlkLoc(Arg0) = ps;
  607.    Return;
  608.    }
  609.  
  610. /*
  611.  * table(x) - create a table with default value x.
  612.  */
  613. FncDcl(table,1)
  614.    {
  615.    union block *bp;
  616.  
  617.    bp = hmake(T_Table, (word)0, (word)0);
  618.    if (bp == NULL)
  619.       RunErr(0, NULL);
  620.    bp->table.defvalue = Arg1;
  621.    Arg0.dword = D_Table;
  622.    BlkLoc(Arg0) = bp;
  623.    Return;
  624.    }
  625.