Annotation of 43BSD/contrib/B/src/bsmall/B1lis.c, revision 1.1.1.1

1.1       root        1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
                      2: /* $Header: B1lis.c,v 1.1 84/06/28 00:48:55 timo Exp $ */
                      3: 
                      4: /* B lists */
                      5: #include "b.h"
                      6: #include "b1obj.h"
                      7: #include "B1tlt.h"
                      8: #include "b0con.h"
                      9: 
                     10: Visible value list_elem(l, i) value l; intlet i; {
                     11:        return List_elem(l, i);
                     12: }
                     13: 
                     14: Visible insert(v, ll) value v, *ll; {
                     15:        intlet len= Length(*ll); register value *lp, *lq;
                     16:        intlet k; register intlet kk;
                     17:        if (!Is_list(*ll)) error("inserting in non-list");
                     18:        VOID found(list_elem, *ll, v, &k);
                     19:        if (Unique(*ll) && !Is_ELT(*ll)) {
                     20:                xtndlt(ll, 1);
                     21:                lq= Ats(*ll)+len; lp= lq-1;
                     22:                for (kk= len; kk > k; kk--) *lq--= *lp--;
                     23:                *lq= copy(v);
                     24:        } else {
                     25:                lp= Ats(*ll);
                     26:                release(*ll);
                     27:                *ll= grab_lis(++len);
                     28:                lq= Ats(*ll);
                     29:                for (kk= 0; kk < len; kk++) *lq++= copy (kk == k ? v : *lp++);
                     30:        }
                     31: }
                     32: 
                     33: Visible remove(v, ll) value v; value *ll; {
                     34:        register value *lp, *lq;
                     35:        intlet len; intlet k;
                     36:        if (!Is_list(*ll)) error("removing from non-list");
                     37:        lp= Ats(*ll); len= Length(*ll);
                     38:        if (len == 0) error("removing from empty list");
                     39:        if (!found(list_elem, *ll, v, &k))
                     40:                error("removing non-existing list entry");
                     41:        /* lp[k] = v */
                     42:        if (Unique(*ll)) {
                     43:                release(*(lp+=k));
                     44:                for (k= k; k < len; k++) {*lp= *(lp+1); lp++;}
                     45:                xtndlt(ll, -1);
                     46:        } else {
                     47:                intlet kk= k;
                     48:                lq= Ats(*ll);
                     49:                release(*ll);
                     50:                *ll= grab_lis(--len);
                     51:                lp= Ats(*ll);
                     52:                Overall {
                     53:                        *lp++= copy (*lq++);
                     54:                        if (k == kk) lq++;
                     55:                }
                     56:        }
                     57: }
                     58: 
                     59: Visible value mk_numrange(a, z) value a, z; {
                     60:        value l= mk_elt(), m= copy(a), n;
                     61: 
                     62:        while (compare(m, z)<=0) {
                     63:                insert(m, &l);
                     64:                m= sum(n=m, one);
                     65:                release(n);
                     66:        }
                     67:        release(m);
                     68:        return l;
                     69: }
                     70: 
                     71: Visible value mk_charrange(av, zv) value av, zv; {
                     72:        char a= charval(av), z= charval(zv);
                     73:        value l= grab_lis((intlet) (z-a+1)); register value *ep= Ats(l);
                     74:        char m[2];
                     75:        m[1]= '\0';
                     76:        for (m[0]= a; m[0] <= z; m[0]++) {
                     77:                *ep++= mk_text(m);
                     78:        }
                     79:        return l;
                     80: }

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.