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

   1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
   2: /* $Header: b2env.c,v 1.1 84/06/28 00:49:06 timo Exp $ */
   3: 
   4: /* Environments */
   5: #include "b.h"
   6: #include "b1obj.h"
   7: 
   8: envtab prmnvtab;
   9: envchain prmnvchain;
  10: env prmnv;
  11: 
  12: /* context: */
  13: env curnv; value *bndtgs; value bndtglist;
  14: literal cntxt, resexp; value uname; literal utype;
  15: intlet cur_ilev, lino; txptr tx, ceol;
  16: 
  17: context read_context;
  18: context how_context;
  19: 
  20: bool xeq= Yes;
  21: 
  22: Visible Procedure sv_context(sc) context *sc; {
  23:     sc->curnv= curnv;
  24:     sc->bndtgs= bndtgs;
  25:     sc->cntxt= cntxt;
  26:     sc->resexp= resexp;
  27:     sc->uname= uname;
  28:     sc->utype= utype;
  29:     sc->cur_ilev= cur_ilev;
  30:     sc->lino= lino;
  31:     sc->tx= tx;
  32:     sc->ceol= ceol;
  33: }
  34: 
  35: Visible Procedure set_context(sc) context *sc; {
  36:     curnv= sc->curnv;
  37:     bndtgs= sc->bndtgs;
  38:     cntxt= sc->cntxt;
  39:     resexp= sc->resexp;
  40:     uname= sc->uname;
  41:     utype= sc->utype;
  42:     cur_ilev= sc->cur_ilev;
  43:     lino= sc->lino;
  44:     tx= sc->tx;
  45:     ceol= sc->ceol;
  46: }
  47: 
  48: Visible Procedure initenv() {
  49:     /* The following invariant must be maintained:
  50: 	   EITHER:
  51: 	      the original permanent-environment table resides in prmnv->tab
  52: 	      and prmnvtab == Vnil
  53: 	   OR:
  54: 	      the original permanent-environment table resides in prmnvtab
  55: 	      and prmnv->tab contains a scratch-pad copy.
  56: 	*/
  57:     prmnv= &prmnvchain;
  58:     prmnv->tab= mk_elt(); prmnvtab= Vnil;
  59:     prmnv->inv_env= Enil;
  60:     bndtglist= mk_elt();
  61: }
  62: 
  63: Visible Procedure re_env() {
  64:     setprmnv(); bndtgs= &bndtglist;
  65: }
  66: 
  67: Visible Procedure setprmnv() {
  68:     /* the current and permanent environment are reset
  69: 	   to the original permanent environment */
  70:     if (prmnvtab != Vnil) {
  71:         prmnv->tab= prmnvtab;
  72:         prmnvtab= Vnil;
  73:     }
  74:     curnv= prmnv;
  75: }
  76: 
  77: Visible Procedure e_replace(v, t, k) value v, *t, k; {
  78:     if (!Is_table(*t)) syserr("replacing in non-environment");
  79:     else replace(v, t, k);
  80: }
  81: 
  82: Visible Procedure e_delete(t, k) value *t, k; {
  83:     if (!Is_table(*t)) syserr("deleting from non-environment");
  84:     if (in_keys(k, *t)) delete(t, k);
  85: }
  86: 
  87: Visible value* envassoc(t, ke) value t, ke; {
  88:     if (!Is_table(t)) syserr("selection on non-environment");
  89:     return adrassoc(t, ke);
  90: }
  91: 
  92: Visible bool in_env(tab, ke, aa) value tab, ke, **aa; {
  93:     /* IF ke in keys tab:
  94: 		PUT tab[ke] IN aa
  95: 		SUCCEED
  96: 	   FAIL
  97: 	*/
  98:     *aa= envassoc(tab, ke);
  99:     return (*aa != Pnil);
 100: }
 101: 
 102: Visible Procedure extbnd_tags(btl, en, et) value btl; envtab *en, et; {
 103:     /* FOR v IN btl:
 104: 	       IF v in keys et:
 105: 	           PUT et[v] IN en[v]
 106: 	*/
 107:     value *aa, v;
 108:     int len= length(btl), k;
 109:     for (k= 1; k <= len; k++) {
 110:         v= thof(k, btl);
 111:         if (in_env(et, v, &aa)) e_replace(*aa, en, v);
 112:         release(v);
 113:     }
 114: }
 115: 
 116: Visible Procedure restore_env(e0) env e0; {
 117:     /*not yet implemented*/
 118: }
 119: 
 120: Visible value* lookup(t) value t; {
 121:     return envassoc(curnv->tab, t);
 122: }

Defined functions

Defined variables