2.11BSD#431 - /usr/src/new/PORT/B/src/bsmall/B1tab.c

   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: }

Defined functions