Return to b2tar.c CVS log

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

Annotation of 43BSD/contrib/B/src/bsmall/b2tar.c, revision 1.1

1.1     ! root        1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
        !             2: /* $Header: b2tar.c,v 1.1 84/06/28 00:49:23 timo Exp $ */
        !             3: 
        !             4: /* B target locating */
        !             5: #include "b.h"
        !             6: #include "b1obj.h"
        !             7: #include "b2env.h"
        !             8: #include "b2syn.h"
        !             9: #include "b2sem.h"
        !            10: 
        !            11: Visible loc statrimloc(l, v) loc l; value v; {
        !            12:        /* temporary, while no static type check */
        !            13:        return (loc) mk_elt();
        !            14: }
        !            15: 
        !            16: Visible loc statbseloc(l, k) loc l; value k; {
        !            17:        /* temporary, while no static type check */
        !            18:        return (loc) mk_elt();
        !            19: }
        !            20: 
        !            21: Visible loc targ(q) txptr q; {
        !            22:        value c; loc l; txptr i, j; intlet len, k;
        !            23:        if ((len= 1+count(",", q)) == 1) return bastarg(q);
        !            24:        c= mk_compound(len);
        !            25:        k_Overfields {
        !            26:                if (!Lastfield(k)) req(",", q, &i, &j);
        !            27:                else i= q;
        !            28:                l= bastarg(i);
        !            29:                put_in_field(l, &c, k);
        !            30:                if (!Lastfield(k)) tx= j;
        !            31:        }
        !            32:        return (loc) c;
        !            33: }
        !            34: 
        !            35: Visible loc bastarg(q) txptr q; {
        !            36:        loc l; txptr i, j; value k;
        !            37:        Skipsp(tx);
        !            38:        nothing(q, "target");
        !            39:        if (Char(tx) == '(') {
        !            40:                tx++; req(")", q, &i, &j);
        !            41:                l= targ(i); tx= j;
        !            42:        } else if (Letter(Char(tx))) {
        !            43:                value t= tag(), *aa;
        !            44:                aa= lookup(t);
        !            45:                if (aa == Pnil) l= local_loc(t);
        !            46:                else if (Is_refinement(*aa))
        !            47:                        pprerr("refined targets are not allowed", "");
        !            48:                else if (Is_formal(*aa)) {
        !            49:                        l= loc_formal(*aa);
        !            50:                } else if (Is_shared(*aa))
        !            51:                        l= global_loc(t);
        !            52:                else l= local_loc(t);
        !            53:                release(t);
        !            54:        } else parerr("no target where expected", "");
        !            55:        Skipsp(tx);
        !            56:        while (tx < q && Char(tx) == '[') {
        !            57:                if (xeq) check_location(l);
        !            58:                tx++; req("]", q, &i, &j);
        !            59:                k= expr(i); tx= j;
        !            60:                if (xeq) {
        !            61:                        loc ll= l;
        !            62:                        l= tbsel_loc(l, k);
        !            63:                        release(k); release(ll);
        !            64:                } else l= statbseloc(l, k);
        !            65:                Skipsp(tx);
        !            66:        }
        !            67:        if (tx < q && (Char(tx) == '@' || Char(tx) == '|')) {
        !            68:                value v= xeq ? content(l) : Vnil; intlet B, C;
        !            69:                if (xeq && !Is_text(v))
        !            70:                  error("in the target t@p or t|p, t does not contain a text");
        !            71:                trimbc(q, xeq ? length(v) : 0, &B, &C);
        !            72:                release(v);
        !            73:                if (xeq) l= trim_loc(l, B, C);
        !            74:                else l= statrimloc(l, k);
        !            75:                Skipsp(tx);
        !            76:        }
        !            77:        if (tx < q) parerr(Char(tx) == ',' ? "comma not allowed here" :
        !            78:                                        "garbage following target", "");
        !            79:        return l;
        !            80: }

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