Return to b3in2.c CVS log

Up to [CSRG BSD Unix] / 43BSDTahoe / new / B / src / bint

Annotation of 43BSDTahoe/new/B/src/bint/b3in2.c, revision 1.1

1.1     ! root        1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
        !             2: 
        !             3: /*
        !             4:   $Header: b3in2.c,v 1.4 85/08/22 16:58:21 timo Exp $
        !             5: */
        !             6: 
        !             7: /* B interpreter -- independent subroutines */
        !             8: 
        !             9: #include "b.h"
        !            10: #include "b1obj.h"
        !            11: #include "b3env.h"
        !            12: #include "b3in2.h"
        !            13: #include "b3sem.h"
        !            14: #include "b3sou.h"
        !            15: 
        !            16: /* Making ranges */
        !            17: 
        !            18: Hidden value c_range(lo, hi) value lo, hi; {
        !            19:        char a, z;
        !            20:        if (!character(lo))
        !            21:                error(MESS(3400, "in {p..q}, p is a text but not a character"));
        !            22:        else if (!Is_text(hi))
        !            23:                error(MESS(3401, "in {p..q}, p is a text, but q is not"));
        !            24:        else if (!character(hi))
        !            25:                error(MESS(3402, "in {p..q}, q is a text, but not a character"));
        !            26:        else {
        !            27:                a= charval(lo); z= charval(hi);
        !            28:                if (z < a-1) error(MESS(3403, "in {p..q}, character q < x < p"));
        !            29:                else return mk_charrange(lo, hi);
        !            30:        }
        !            31:        return Vnil;
        !            32: }
        !            33: 
        !            34: Hidden value i_range(lo, hi) value lo, hi; {
        !            35:        value entries, res= Vnil;
        !            36:        if (!integral(lo))
        !            37:                error(MESS(3404, "in {p..q}, p is a number but not an integer"));
        !            38:        else if (!Is_number(hi))
        !            39:                error(MESS(3405, "in {p..q}, p is a number but q is not"));
        !            40:        else if (!integral(hi))
        !            41:                error(MESS(3406, "in {p..q}, q is a number but not an integer"));
        !            42:        else {
        !            43:                entries= diff(lo, hi);
        !            44:                if (compare(entries, one)>0)
        !            45:                        error(MESS(3407, "in {p..q}, integer q < x < p"));
        !            46:                else res= mk_numrange(lo, hi);
        !            47:                release(entries);
        !            48:        }
        !            49:        return res;
        !            50: }
        !            51: 
        !            52: Visible value mk_range(v1, v2) value v1, v2; {
        !            53:        value r= Vnil;
        !            54:        if (Is_text(v1)) r= c_range(v1, v2);
        !            55:        else if (Is_number(v1)) r= i_range(v1, v2);
        !            56:        else error(MESS(3408, "in {p..q}, p is neither a text nor a number"));
        !            57:        return r;
        !            58: }
        !            59: 
        !            60: 
        !            61: /* Newlines for WRITE /// */
        !            62: 
        !            63: Visible Procedure nl(n) value n; {
        !            64:        value l= size(n); int c= intval(l); release(l);
        !            65:        while (c--) newline();
        !            66: }
        !            67: 
        !            68: 
        !            69: /* Evaluating basic targets */
        !            70: 
        !            71: Visible value v_local(name, number) value name, number; {
        !            72:        value *aa= envassoc(curnv->tab, number);
        !            73:        if (aa != Pnil && *aa != Vnil) return copy(*aa);
        !            74:        error3(0, name, MESS(3409, " has not yet received a value"));
        !            75:        return Vnil;
        !            76: }
        !            77: 
        !            78: Visible value v_global(name) value name; {
        !            79:        value *aa= envassoc(prmnv->tab, name);
        !            80:        if (aa != Pnil && *aa != Vnil) return copy(tarvalue(name, *aa));
        !            81:        error3(0, name, MESS(3410, " has not yet received a value"));
        !            82:        return Vnil;
        !            83: }
        !            84: 
        !            85: 
        !            86: /* Locating mysteries */
        !            87: 
        !            88: Visible loc l_mystery(name, number) value name, number; {
        !            89:        if (Is_compound(curnv->tab)) return local_loc((basidf) number);
        !            90:        return global_loc(name);
        !            91: }
        !            92: 
        !            93: 
        !            94: /* Rangers */
        !            95: 
        !            96: /* An IN-ranger is represented on the stack as a compound of three fields:
        !            97:    the last index used, the value of the expression after IN, and its length.
        !            98:    (The latter is redundant, but saves save many calls of 'size()'.)
        !            99:    When first called, there is, of course, no compound on the stack, but only
        !           100:    the value of the expression.  As the expression should always be a text,
        !           101:    list or table, this is recognizable as a special case, and then the
        !           102:    compound is created.
        !           103:    Return value is Yes if a new element was available and assigned, No if not.
        !           104: */
        !           105: 
        !           106: Visible bool in_ranger(l, pv) loc l; value *pv; {
        !           107:        value v= *pv, ind, tlt, len, i1, val; bool res;
        !           108:        if (!Is_compound(v) || Nfields(v) != 3) { /* First time */
        !           109:                tlt= v;
        !           110:                if (!Is_tlt(tlt)) {
        !           111:                        error(MESS(3411, "in ... i IN e, e is not a text, list or table"));
        !           112:                        return No;
        !           113:                }
        !           114:                if (empty(tlt)) return No;
        !           115:                *pv= v= mk_compound(3);
        !           116:                *Field(v, 0)= ind= one;
        !           117:                *Field(v, 1)= tlt;
        !           118:                *Field(v, 2)= len= size(tlt);
        !           119:                bind(l);
        !           120:        }
        !           121:        else {
        !           122:                ind= *Field(v, 0); tlt= *Field(v, 1); len= *Field(v, 2);
        !           123:                res= numcomp(ind, len) < 0;
        !           124:                if (!res) { unbind(l); return No; }
        !           125:                *Field(v, 0)= ind= sum(i1= ind, one); release(i1);
        !           126:        }
        !           127:        put(val= th_of(ind, tlt), l); release(val);
        !           128:        return Yes;
        !           129: }
        !           130: 
        !           131: 
        !           132: /* PARSING-rangers are treated similarly to IN-rangers, but here the
        !           133:    compound contains the last parse (i.e., N texts). */
        !           134: 
        !           135: Visible bool pa_ranger(l, pv) loc l; value *pv; {
        !           136:        value v= *pv, e, f; int len, k;
        !           137:        if (!Is_compound(v)) {
        !           138:                if (!Is_text(v)) {
        !           139:                        error(MESS(3412, "in  ... i PARSING e, e is not a text"));
        !           140:                        return No;
        !           141:                }
        !           142:                if (!Is_compound(l)) {
        !           143:                        error(
        !           144:                MESS(3413, "in ... i PARSING e, i is not a collateral identifier"));
        !           145:                        return No;
        !           146:                }
        !           147:                v= mk_compound(len= Nfields(l));
        !           148:                *Field(v, len-1)= *pv;
        !           149:                *Field(v, 0)= e= mk_text("");
        !           150:                for (k= 1; k < len-1; ++k)
        !           151:                        *Field(v, k)= copy(e);
        !           152:                *pv= v;
        !           153:                bind(l);
        !           154:                put(v, l);
        !           155:                return Yes;
        !           156:        }
        !           157:        uniql(pv); v= *pv;
        !           158:        len= Nfields(v);
        !           159:        for (k= len-1; k > 0; --k) {
        !           160:                if (!empty(f= *Field(v, k))) {
        !           161:                        value head, tail, prev, newprev, two= sum(one, one);
        !           162:                        head= curtail(f, one); tail= behead(f, two);
        !           163:                        release(f);
        !           164:                        newprev= concat(prev= *Field(v, k-1), head);
        !           165:                        release(prev); release(head);
        !           166:                        *Field(v, k-1)= newprev;
        !           167:                        if (k < len-1)
        !           168:                                *Field(v, k)= *Field(v, len-1);
        !           169:                        *Field(v, len-1)= tail;
        !           170:                        put(v, l);
        !           171:                        return Yes;
        !           172:                }
        !           173:        }
        !           174:        unbind(l);
        !           175:        return No;
        !           176: }

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