Return to B1tab.c CVS log

Up to [CSRG BSD Unix] / 43BSD / contrib / B / src / bsmall

Annotation of 43BSD/contrib/B/src/bsmall/B1tab.c, revision 1.1

1.1     ! root        1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
        !             2: /* $Header: B1tab.c,v 1.1 84/06/28 00:48:58 timo Exp $ */
        !             3: 
        !             4: /* B tables */
        !             5: #include "b.h"
        !             6: #include "b1obj.h"
        !             7: #include "B1tlt.h"
        !             8: 
        !             9: Visible value* key(v, k) value v; intlet k; { /* k in {0..size-1}; no copy */
        !            10:        return Key(v, k);
        !            11: }
        !            12: 
        !            13: Visible value* assoc(v, k) value v; intlet k; { /* k in {0..size-1}; no copy */
        !            14:        return Assoc(v, k);
        !            15: }
        !            16: 
        !            17: Visible value keys(ta) value ta; {
        !            18:        value li= grab_lis(Length(ta)), *le, *te= (value *)Ats(ta);
        !            19:        int k, len= Length(ta);
        !            20:        if(!Is_table(ta)) error("in keys t, t is not a table");
        !            21:        le= (value *)Ats(li);
        !            22:        Overall { *le++= copy(Cts(*te++)); }
        !            23:        return li;
        !            24: }
        !            25: 
        !            26: Visible value key_elem(t, i) value t; intlet i; { /*The key of the i-th entry*/
        !            27:        return *Key(t, i);
        !            28: }
        !            29: 
        !            30: /* adrassoc returns a pointer to the associate, rather than
        !            31:    the associate itself, so that the caller can decide if a copy
        !            32:    should be taken or not. If the key is not found, Pnil is returned. */
        !            33: Visible value* adrassoc(t, ke) value t, ke; {
        !            34:        intlet where;
        !            35:        if (t->type != Tab && t->type != ELT) error("selection on non-table");
        !            36:        return found(key_elem, t, ke, &where) ? Assoc(t, where) : Pnil;
        !            37: }
        !            38: 
        !            39: Visible Procedure uniq_assoc(ta, ke) value ta, ke; {
        !            40:        intlet k;
        !            41:        if (found(key_elem, ta, ke, &k)) {
        !            42:                uniql(Ats(ta)+k);
        !            43:                uniql(Assoc(ta,k));
        !            44:        } else syserr("uniq_assoc called for non-existent table entry");
        !            45: }
        !            46: 
        !            47: Visible Procedure replace(v, ta, ke) value *ta, ke, v; {
        !            48:        intlet len= Length(*ta); value *tp, *tq;
        !            49:        intlet k, kk;
        !            50:        uniql(ta);
        !            51:        if ((*ta)->type == ELT) (*ta)->type = Tab;
        !            52:        else if ((*ta)->type != Tab) error("replacing in non-table");
        !            53:        if (found(key_elem, *ta, ke, &k)) {
        !            54:                value *a;
        !            55:                uniql(Ats(*ta)+k);
        !            56:                a= Assoc(*ta, k);
        !            57:                uniql(a);
        !            58:                release(*a);
        !            59:                *a= copy(v);
        !            60:                return;
        !            61:        } else {
        !            62:                xtndlt(ta, 1);
        !            63:                tq= Ats(*ta)+len; tp= tq-1;
        !            64:                for (kk= len; kk > k; kk--) *tq--= *tp--;
        !            65:                *tq= grab_com(2);
        !            66:                Cts(*tq)= copy(ke);
        !            67:                Dts(*tq)= copy(v);
        !            68:        }
        !            69: }
        !            70: 
        !            71: Visible bool in_keys(ke, tl) value ke, tl; {
        !            72:        intlet dummy;
        !            73:        if (tl->type == ELT) return No;
        !            74:        if (tl->type != Tab) syserr("in_keys applied to non-table");
        !            75:        return found(key_elem, tl, ke, &dummy);
        !            76: }
        !            77: 
        !            78: Visible Procedure delete(tl, ke) value *tl, ke; {
        !            79:        intlet len, k; value *tp;
        !            80:        if ((*tl)->type == ELT) syserr("deleting table entry from empty table");
        !            81:        if ((*tl)->type != Tab) syserr("deleting table entry from non-table");
        !            82:        tp= Ats(*tl); len= Length(*tl);
        !            83:        if (!found(key_elem, *tl, ke, &k))
        !            84:                syserr("deleting non-existent table entry");
        !            85:        if (Unique(*tl)) {
        !            86:                release(*(tp+=k));
        !            87:                for (k= k; k < len; k++) {*tp= *(tp+1); tp++;}
        !            88:                xtndlt(tl, -1);
        !            89:        } else {
        !            90:                intlet kk; value *tq= Ats(*tl);
        !            91:                release(*tl);
        !            92:                *tl= grab_tab(--len);
        !            93:                tp= Ats(*tl);
        !            94:                for (kk= 0; kk < len; kk++) {
        !            95:                        *tp++= copy (*tq++);
        !            96:                        if (kk == k) tq++;
        !            97:                }
        !            98:        }
        !            99: }
        !           100: 

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