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     ! 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.