# 2.11BSD#431 - /usr/src/new/PORT/B/src/bint/b3env.c

##### Functions

    e_delete          X
    e_replace         X
    endenv            X
    envassoc          X
    extbnd_tags       X
    in_env            X
    initenv           X
    lst_ttgs          X
    re_env            X
    set_context       X
    setprmnv          X
    sv_context        X

##### Variables

    bndtglist         X
    bndtgs            X
    cntxt             X
    curnv             X
    f_lino            X
    lino              X
    prmnv             X
    prmnvchain        X
    prmnvtab          X
    resexp            X
    uname             X

       1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
       2:
       3: /*
       4:   $Header: b3env.c,v 1.4 85/08/22 16:57:42 timo Exp $
       5: */
       6:
       7: /* Environments */
       8:
       9: #include "b.h"
      10: #include "b1obj.h"
      11: #include "b3err.h" /*for curline, curlino*/
      12:
      13: Visible envtab prmnvtab;
      14: Visible envchain prmnvchain;
      15: Visible env prmnv;
      16:
      17: /* context: */
      18: /* The bound tags for the current environment are stored in *bndtgs */
      19: /* A new bound tag list is created on evaluating a refined test or expression */
      20:
      21: Visible env curnv;
      22: Visible value *bndtgs;
      23: Hidden value bndtglist;
      24: Visible literal cntxt, resexp;
      25: Visible value uname= Vnil;
      26: Visible intlet lino;
      27: Visible intlet f_lino;
      28:
      29: Visible context read_context;
      30:
      31: Visible Procedure sv_context(sc) context *sc; {
      32:     sc->curnv= curnv;
      33:     sc->bndtgs= bndtgs;
      34:     sc->cntxt= cntxt;
      35:     sc->resexp= resexp;
      36:     sc->uname= copy(uname);
      37:     sc->cur_line= curline;
      38:     sc->cur_lino= curlino;
      39: }
      40:
      41: Visible Procedure set_context(sc) context *sc; {
      42:     curnv= sc->curnv;
      43:     bndtgs= sc->bndtgs;
      44:     cntxt= sc->cntxt;
      45:     resexp= sc->resexp;
      46:     release(uname); uname= sc->uname;
      47:     curline= sc->cur_line;
      48:     curlino= sc->cur_lino;
      49: }
      50:
      51: Visible Procedure initenv() {
      52:     /* The following invariant must be maintained:
      53: 	   EITHER:
      54: 	      the original permanent-environment table resides in prmnv->tab
      55: 	      and prmnvtab == Vnil
      56: 	   OR:
      57: 	      the original permanent-environment table resides in prmnvtab
      58: 	      and prmnv->tab contains a scratch-pad copy.
      59: 	*/
      60:     prmnv= &prmnvchain;
      61:     prmnv->tab= mk_elt(); prmnvtab= Vnil;
      62:     prmnv->inv_env= Enil;
      63:     bndtglist= mk_elt();
      64: }
      65:
      66: Visible Procedure endenv() {
      67:     release(prmnv->tab); prmnv->tab= Vnil;
      68:     release(bndtglist); bndtglist= Vnil;
      69:     release(uname); uname= Vnil;
      70:     release(erruname); erruname= Vnil;
      71: }
      72:
      73: Visible Procedure re_env() {
      74:     setprmnv(); bndtgs= &bndtglist;
      75: }
      76:
      77: Visible Procedure setprmnv() {
      78:     /* the current and permanent environment are reset
      79: 	   to the original permanent environment */
      80:     if (prmnvtab != Vnil) {
      81:         prmnv->tab= prmnvtab;
      82:         prmnvtab= Vnil;
      83:     }
      84:     curnv= prmnv;
      85: }
      86:
      87: Visible Procedure e_replace(v, t, k) value v, *t, k; {
      88:     if (Is_compound(*t)) {
      89:         int n= SmallIntVal(k);
      90:         uniql(t);
      91:         if (*Field(*t, n) != Vnil) release(*Field(*t, n));
      92:         *Field(*t, n)= copy(v);
      93:     }
      94:     else if (!Is_table(*t)) syserr(MESS(2900, "replacing in non-environment"));
      95:     else replace(v, t, k);
      96: }
      97:
      98: Visible Procedure e_delete(t, k) value *t, k; {
      99:     if (Is_compound(*t) && IsSmallInt(k)) {
     100:         int n= SmallIntVal(k);
     101:         if (*Field(*t, n) != Vnil) {
     102:             uniql(t); release(*Field(*t, n));
     103:             *Field(*t, n)= Vnil;
     104:         }
     105:     }
     106:     else if (!Is_table(*t)) syserr(MESS(2901, "deleting from non-environment"));
     107:     else if (in_keys(k, *t)) delete(t, k);
     108: }
     109:
     110: Visible value* envassoc(t, ke) value t, ke; {
     111:     if (Is_compound(t) && IsSmallInt(ke)) {
     112:         int n= SmallIntVal(ke);
     113:         if (*Field(t, n) == Vnil) return Pnil;
     114:         return Field(t, n);
     115:     }
     116:     if (!Is_table(t)) syserr(MESS(2902, "selection on non-environment"));
     117:     return adrassoc(t, ke);
     118: }
     119:
     120: Visible bool in_env(tab, ke, aa) value tab, ke, **aa; {
     121:     /* IF ke in keys tab:
     122: 		PUT tab[ke] IN aa
     123: 		SUCCEED
     124: 	   FAIL
     125: 	*/
     126:     *aa= envassoc(tab, ke);
     127:     return (*aa != Pnil);
     128: }
     129:
     130: Visible Procedure extbnd_tags(btl, et) value btl; envtab et; {
     131:     /* Copy bound targets to the invoking environment */
     132:     /* FOR tag IN btl: \ btl is the bound tag list
     133: 	       IF tag in keys et: \ et is the environment we're just leaving
     134: 	           PUT et[tag] IN curnv[tag] \ curnv is the invoking environment
     135: 	*/
     136:     value *aa, tag;
     137:     int len= length(btl), k;
     138:     for (k= 1; k <= len; k++) {
     139:         tag= thof(k, btl);
     140:         if (in_env(et, tag, &aa)) {
     141:             e_replace(*aa, &(curnv->tab), tag);
     142:             if (*bndtgs != Vnil) insert(tag, bndtgs);
     143:         }
     144:         release(tag);
     145:     }
     146: }
     147:
     148: Visible Procedure lst_ttgs() {
     149:     int k, len;
     150:     len= length(prmnv->tab);
     151:     k_Over_len {
     152:         writ(*key(prmnv->tab, k));
     153:         wri_space();
     154:     }
     155:     newline();
     156: }

#### Defined functions

e_delete defined in line 98; used 5 times

- in /usr/src/new/PORT/B/src/bint/b2ana.c line 86
- in /usr/src/new/PORT/B/src/bint/b3loc.c line 260
- in /usr/src/new/PORT/B/src/bint/b3sou.c line 49, 134, 611

e_replace defined in line 87; used 8 times

- in line 141
- in /usr/src/new/PORT/B/src/bint/b2ana.c line 90
- in /usr/src/new/PORT/B/src/bint/b2uni.c line 325
- in /usr/src/new/PORT/B/src/bint/b3loc.c line 157-160(2)
- in /usr/src/new/PORT/B/src/bint/b3sou.c line 42, 122, 604

endenv defined in line 66; used 1 times

- in /usr/src/new/PORT/B/src/bint/b3mai.c line 233

envassoc defined in line 110; used 24 times

- in line 126
- in /usr/src/new/PORT/B/src/bint/b2ana.c line 75-83(5)
- in /usr/src/new/PORT/B/src/bint/b2fix.c line 129
- in /usr/src/new/PORT/B/src/bint/b2gen.c line 445-448(4), 454, 524, 557-565(5)
- in /usr/src/new/PORT/B/src/bint/b3env.h line 11
- in /usr/src/new/PORT/B/src/bint/b3in2.c line 72, 79
- in /usr/src/new/PORT/B/src/bint/b3loc.c line 234
- in /usr/src/new/PORT/B/src/bint/b3sta.c line 411, 489

extbnd_tags defined in line 130; used 1 times

- in /usr/src/new/PORT/B/src/bint/b3sta.c line 397

in_env defined in line 120; used 9 times

- in line 140
- in /usr/src/new/PORT/B/src/bint/b2uni.c line 320
- in /usr/src/new/PORT/B/src/bint/b3env.h line 10
- in /usr/src/new/PORT/B/src/bint/b3loc.c line 19-24(2)
- in /usr/src/new/PORT/B/src/bint/b3sou.c line 35, 113, 597
- in /usr/src/new/PORT/B/src/bint/b3typ.c line 32

initenv defined in line 51; used 1 times

- in /usr/src/new/PORT/B/src/bint/b3mai.c line 196

lst_ttgs defined in line 148; used 1 times

- in /usr/src/new/PORT/B/src/bint/b3mai.c line 263

re_env defined in line 73; used 2 times

- in /usr/src/new/PORT/B/src/bint/b3mai.c line 312
- in /usr/src/new/PORT/B/src/bint/b3sta.c line 401

set_context defined in line 41; used 8 times

- in /usr/src/new/PORT/B/src/bint/b2gen.c line 33
- in /usr/src/new/PORT/B/src/bint/b3err.c line 232-239(3), 371
- in /usr/src/new/PORT/B/src/bint/b3scr.c line 415
- in /usr/src/new/PORT/B/src/bint/b3sou.c line 233, 749

setprmnv defined in line 77; used 3 times

- in line 74
- in /usr/src/new/PORT/B/src/bint/b3mai.c line 221
- in /usr/src/new/PORT/B/src/bint/b3scr.c line 398

sv_context defined in line 31; used 9 times

- in /usr/src/new/PORT/B/src/bint/b2gen.c line 21
- in /usr/src/new/PORT/B/src/bint/b3err.c line 231
- in /usr/src/new/PORT/B/src/bint/b3scr.c line 391-394(2)
- in /usr/src/new/PORT/B/src/bint/b3sou.c line 228, 733
- in /usr/src/new/PORT/B/src/bint/b3sta.c line 416, 426, 500

#### Defined variables

bndtglist defined in line 23; used 4 times

- in line 63-68(3), 74

bndtgs defined in line 22; used 7 times

- in line 33(2), 43(2), 74, 142(2)

cntxt defined in line 24; used 4 times

- in line 34(2), 44(2)

curnv defined in line 21; used 6 times

- in line 32(2), 42(2), 84, 141

f_lino defined in line 27; never used
lino defined in line 26; never used
prmnv defined in line 15; used 9 times

- in line 60-67(5), 81-84(2), 150-152(2)

prmnvchain defined in line 14; used 1 times

- in line 60

prmnvtab defined in line 13; used 4 times

- in line 61, 80-82(3)

resexp defined in line 24; used 4 times

- in line 35(2), 45(2)

uname defined in line 25; used 7 times

- in line 36(2), 46(3), 69(2)

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