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

##### Functions

    bind              X
    check_location    X
    choose            X
    content           X
    draw              X
    global_loc        X
    l_del             X
    l_delete          X
    l_exists          X
    l_insert          X
    l_remove          X
    local_loc         X
    location          X
    put               X
    tbsel_loc         X
    trim_loc          X
    uniquify          X

       1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
       2: /* $Header: b2loc.c,v 1.1 84/06/28 00:49:16 timo Exp $ */
       3:
       4: /* B locations and environments */
       5: #include "b.h"
       6: #include "b0con.h"
       7: #include "b1obj.h"
       8: #include "b2env.h" /* for bndtgs */
       9: #include "b2sem.h"
      10:
      11: Hidden value* location(l) loc l; {
      12:     value *ll;
      13:     if (Is_simploc(l)) {
      14:         simploc *sl= Simploc(l);
      15:         if (!in_env(sl->e->tab, sl->i, &ll)) error("target still empty");
      16:         return ll;
      17:     } else if (Is_tbseloc(l)) {
      18:         tbseloc *tl= Tbseloc(l);
      19:         ll= adrassoc(*location(tl->R), tl->K);
      20:         if (ll == Pnil) error("key not in table");
      21:         return ll;
      22:     } else {
      23:         syserr("call of location with improper type");
      24:         return (value *) Dummy;
      25:     }
      26: }
      27:
      28: Hidden Procedure uniquify(l) loc l; {
      29:     if (Is_simploc(l)) {
      30:         simploc *sl= Simploc(l);
      31:         value *ta= &(sl->e->tab), ke= sl->i;
      32:         uniql(ta);
      33:         check_location(l);
      34:         uniq_assoc(*ta, ke);
      35:     } else if (Is_tbseloc(l)) {
      36:         tbseloc *tl= Tbseloc(l);
      37:         value t, ke;
      38:         uniquify(tl->R);
      39:         t= *location(tl->R); ke= tl->K;
      40:         if (!Is_table(t)) error("selection on non-table");
      41:         if (empty(t)) error("selection on empty table");
      42:         check_location(l);
      43:         uniq_assoc(t, ke);
      44:     } else if (Is_trimloc(l)) { syserr("uniquifying trimloc");
      45:     } else if (Is_compound(l)) { syserr("uniquifying comploc");
      46:     } else syserr("uniquifying non-location");
      47: }
      48:
      49: Visible Procedure check_location(l) loc l; {
      50:     VOID location(l);
      51:     /* location may produce an error message */
      52: }
      53:
      54: Visible value content(l) loc l; {
      55:     return copy(*location(l));
      56: }
      57:
      58: Visible loc trim_loc(R, B, C) loc R; intlet B, C; {
      59:     if (Is_trimloc(R)) {
      60:         trimloc *rr= Trimloc(R);
      61:         return mk_trimloc(rr->R, B, C);
      62:     } else if (Is_simploc(R) || Is_tbseloc(R)) {
      63:         return mk_trimloc(R, B, C);
      64:     } else {
      65:         error("trim (@ or |) on target of improper type");
      66:         /* NOTREACHED */
      67:     }
      68: }
      69:
      70: Visible loc tbsel_loc(R, K) loc R; value K; {
      71:     if (Is_simploc(R) || Is_tbseloc(R)) return mk_tbseloc(R, K);
      72:     else error("selection on target of improper type");
      73:     /* NOTREACHED */
      74: }
      75:
      76: Visible loc local_loc(i) basidf i; { return mk_simploc(i, curnv); }
      77:
      78: Visible loc global_loc(i) basidf i; { return mk_simploc(i, prmnv); }
      79:
      80: Visible Procedure put(v, l) value v; loc l; {
      81:     if (Is_simploc(l)) {
      82:         simploc *sl= Simploc(l);
      83:         e_replace(v, &(sl->e->tab), sl->i);
      84:     } else if (Is_trimloc(l)) {
      85:         trimloc *tl= Trimloc(l);
      86:         value rr, nn, head, tail, part;
      87:         intlet B= tl->B, C= tl->C, len;
      88:         rr= *location(tl->R);
      89:         if (!Is_text(rr)) error("trim target contains no text");
      90:         if (!Is_text(v))
      91:             error("putting non-text in trim(@ or|) on text location");
      92:         len= length(rr);
      93:         if (B < 0 || C < 0 || B+C > len)
      94:             error("trim (@ or |) on text location out of bounds");
      95:         head= trim(rr, 0, len-B); /* rr|B */
      96:         tail= trim(rr, len-C, 0); /* rr@(#rr-C+1) */
      97:         part= concat(head, v);
      98:         nn= concat(part, tail);
      99:         put(nn, tl->R);
     100:         release(nn); release(head); release(tail); release(part);
     101:     } else if (Is_compound(l)) {
     102:         intlet k, len= Nfields(l);
     103:         if (!Is_compound(v))
     104:             error("putting non-compound in compound location");
     105:         if (Nfields(v) != Nfields(l))
     106:             error("putting compound in compound location of different length");
     107:         k_Overfields { put(*field(v, k), *field(l, k)); }
     108:     } else if (Is_tbseloc(l)) {
     109:         tbseloc *tl= Tbseloc(l);
     110:         uniquify(tl->R);
     111:         replace(v, location(tl->R), tl->K);
     112:     } else error("putting in non-target");
     113: }
     114:
     115: Hidden bool l_exists(l) loc l; {
     116:     if (Is_simploc(l)) {
     117:         simploc *sl= Simploc(l);
     118:         return in_keys(sl->i, sl->e->tab);
     119:     } else if (Is_trimloc(l)) {
     120:         error("deleting trimmed (@ or |) target");
     121:         return No;
     122:     } else if (Is_compound(l)) {
     123:         intlet k, len= Nfields(l);
     124:         k_Overfields { if (!l_exists(*field(l, k))) return No; }
     125:         return Yes;
     126:     } else if (Is_tbseloc(l)) {
     127:         tbseloc *tl= Tbseloc(l);
     128:         uniquify(tl->R);
     129:         return in_keys(tl->K, *location(tl->R));
     130:     } else {
     131:         error("deleting non-target");
     132:         return No;
     133:     }
     134: }
     135:
     136: Hidden Procedure l_del(l) loc l; {
     137:     if (Is_simploc(l)) {
     138:         simploc *sl= Simploc(l);
     139:         if (in_keys(sl->i, sl->e->tab)) {
     140:             uniql(&(sl->e->tab)); /*no need?: see delete*/
     141:             e_delete(&(sl->e->tab), sl->i);
     142:         }
     143:     } else if (Is_trimloc(l)) {
     144:         error("deleting trimmed (@ or |) target");
     145:     } else if (Is_compound(l)) {
     146:         intlet k, len= Nfields(l);
     147:         k_Overfields { l_del(*field(l, k)); }
     148:     } else if (Is_tbseloc(l)) {
     149:         tbseloc *tl= Tbseloc(l);
     150:         value *lc;
     151:         uniquify(tl->R);
     152:         lc= location(tl->R);
     153:         if (in_keys(tl->K, *lc)) delete(lc, tl->K);
     154:     } else error("deleting non-target");
     155: }
     156:
     157: Visible Procedure l_delete(l) loc l; {
     158:     if (l_exists(l)) l_del(l);
     159:     else error("deleting non-existent target");
     160: }
     161:
     162: Visible Procedure l_insert(v, l) value v; loc l; {
     163:     value *ll;
     164:     uniquify(l);
     165:     ll= location(l);
     166:     insert(v, ll);
     167: }
     168:
     169: Visible Procedure l_remove(v, l) value v; loc l; {
     170:     uniquify(l);
     171:     remove(v, location(l));
     172: }
     173:
     174: Visible Procedure choose(l, v) loc l; value v; {
     175:     value w, s, r;
     176:     if (!Is_tlt(v)) error("choosing from non-text, -list or -table");
     177:     s= size(v);
     178:     if (compare(s, zero) == 0)
     179:         error("choosing from empty text, list or table");
     180:     /* PUT (floor(random*#v) + 1) th'of v IN l */
     181:     r= prod(w= random(), s); release(w); release(s);
     182:     w= floorf(r); release(r);
     183:     r= sum(w, one); release(w);
     184:     put(w= th_of(r, v), l); release(w);
     185: }
     186:
     187: Visible Procedure draw(l) loc l; {
     188:     value r= random();
     189:     put(r, l);
     190:     release(r);
     191: }
     192:
     193: Visible Procedure bind(l) loc l; {
     194:     if (Is_simploc(l)) {
     195:         simploc *ll= Simploc(l);
     196:         if (!in(ll->i, *bndtgs)) /* kludge */
     197:             insert(ll->i, bndtgs);
     198:     } else if (Is_compound(l)) {
     199:         intlet k, len= Nfields(l);
     200:         k_Overfields { bind(*field(l, k)); }
     201:     } else if (Is_trimloc(l)) {
     202:         pprerr("t@p or t|p not allowed in ranger", "");
     203:     } else if (Is_tbseloc(l)) {
     204:         pprerr("t[e] not allowed in ranger", "");
     205:     } else error("binding non-identifier");
     206: }

#### Defined functions

bind defined in line 193; used 3 times

- in line 200
- in /usr/src/new/PORT/B/src/bsmall/b2cmd.c line 281
- in /usr/src/new/PORT/B/src/bsmall/b2tes.c line 160

check_location defined in line 49; used 3 times

- in line 33, 42
- in /usr/src/new/PORT/B/src/bsmall/b2tar.c line 57

choose defined in line 174; used 1 times

- in /usr/src/new/PORT/B/src/bsmall/b2cmd.c line 104

content defined in line 54; used 3 times

- in /usr/src/new/PORT/B/src/bsmall/b2sem.h line 23
- in /usr/src/new/PORT/B/src/bsmall/b2tar.c line 68
- in /usr/src/new/PORT/B/src/bsmall/b2uni.c line 481

draw defined in line 187; used 1 times

- in /usr/src/new/PORT/B/src/bsmall/b2cmd.c line 120

global_loc defined in line 78; used 3 times

- in /usr/src/new/PORT/B/src/bsmall/b2sem.h line 21
- in /usr/src/new/PORT/B/src/bsmall/b2tar.c line 51
- in /usr/src/new/PORT/B/src/bsmall/b2uni.c line 480

l_del defined in line 136; used 2 times

- in line 147, 158

l_delete defined in line 157; used 1 times

- in /usr/src/new/PORT/B/src/bsmall/b2cmd.c line 113

l_exists defined in line 115; used 2 times

- in line 124, 158

l_insert defined in line 162; used 1 times

- in /usr/src/new/PORT/B/src/bsmall/b2cmd.c line 135

l_remove defined in line 169; used 1 times

- in /usr/src/new/PORT/B/src/bsmall/b2cmd.c line 177

local_loc defined in line 76; used 6 times

- in /usr/src/new/PORT/B/src/bsmall/b2sem.h line 20
- in /usr/src/new/PORT/B/src/bsmall/b2tar.c line 45, 52
- in /usr/src/new/PORT/B/src/bsmall/b2uni.c line 424, 476, 483

location defined in line 11; used 10 times

- in line 19, 39, 50-55(2), 88, 111, 129, 152, 165, 171

put defined in line 80; used 15 times

- in line 99, 107, 184-189(2)
- in /usr/src/new/PORT/B/src/bsmall/b2cmd.c line 76, 146, 292
- in /usr/src/new/PORT/B/src/bsmall/b2tes.c line 175, 193
- in /usr/src/new/PORT/B/src/bsmall/b2uni.c line 189, 282-287(3), 476, 483

tbsel_loc defined in line 70; used 2 times

- in /usr/src/new/PORT/B/src/bsmall/b2sem.h line 26
- in /usr/src/new/PORT/B/src/bsmall/b2tar.c line 62

trim_loc defined in line 58; used 2 times

- in /usr/src/new/PORT/B/src/bsmall/b2sem.h line 25
- in /usr/src/new/PORT/B/src/bsmall/b2tar.c line 73

uniquify defined in line 28; used 6 times

- in line 38, 110, 128, 151, 164, 170

Last modified: 1985-08-27 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 1037 |