Return to b2env.c CVS log

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

Annotation of 43BSD/contrib/B/src/bsmall/b2env.c, revision 1.1.1.1

1.1       root        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: }
                    123: 

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