![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to b3in2.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSD / contrib / B / src / bint|
Return to b3in2.c CVS log | Up to [CSRG BSD Unix] / 43BSD / contrib / B / src / bint |
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.