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

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.