|
|
1.1 root 1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
2: /* $Header: b2syn.c,v 1.1 84/06/28 00:49:21 timo Exp $ */
3:
4: /* General parsing routines for B interpreter */
5: #include "b.h"
6: #include "b1obj.h"
7: #include "b0con.h" /*for CLEAR_EOF*/
8: #include "b2env.h"
9: #include "b2scr.h"
10: #include "b2syn.h"
11:
12: Visible Procedure upto(q, ff) txptr q; string ff; {
13: Skipsp(tx);
14: if (tx < q) parerr("something unexpected following ", ff);
15: }
16:
17: Visible Procedure nothing(q, xp) txptr q; string xp; {
18: if (tx >= q) {
19: if (Char(tx-1) == ' ') tx--;
20: parerr("nothing instead of expected ", xp);
21: }
22: }
23:
24: Visible bool ateol() {
25: Skipsp(tx);
26: if (Ceol(tx)) {
27: To_eol(tx);
28: return Yes;
29: }
30: return No;
31: }
32:
33: #define Where_inside(r, t) \
34: register txptr ttx= tx; char lc= '+', q; \
35: register intlet parcnt= 0; register bool outs= Yes; bool kw= No; \
36: while (r) \
37: if (outs) { \
38: if (parcnt == 0 && (t))
39: #define Otherwise \
40: if (Char(ttx) == '(' || Char(ttx) == '[' || Char(ttx) == '{') \
41: parcnt++; \
42: else if (Char(ttx) == ')' || Char(ttx) == ']' || Char(ttx) == '}') { \
43: if (parcnt > 0) parcnt--; \
44: } else if ((Char(ttx) == '\'' || Char(ttx) == '"') && !Keytagmark(lc)) { \
45: outs= No; q= Char(ttx); \
46: } \
47: lc= Char(ttx++); kw= kw ? Keymark(lc) : Cap(lc); \
48: } else { \
49: if (Char(ttx) == q) { \
50: outs= Yes; kw= No; lc= '+'; \
51: } else if (!outs && Char(ttx) == '`') { \
52: txptr tx0= tx, yx, zx; \
53: tx= ttx+1; \
54: req("`", lcol(), &yx, &zx); \
55: ttx= yx; tx= tx0; \
56: } \
57: ttx++; \
58: }
59:
60: Visible Procedure findceol() {
61: Where_inside (!Eol(ttx), Char(ttx) == '\\') {
62: ceol= ttx;
63: return;
64: } Otherwise ceol= ttx;
65: }
66:
67: Visible bool atkw(ss) register string ss; {
68: register txptr tp= tx;
69: while (*ss) if (*ss++ != Char(tp++)) return No;
70: if (Keymark(Char(tp))) return No;
71: tx= tp;
72: return Yes;
73: }
74:
75: Visible Procedure need(ss) string ss; {
76: register string sp= ss;
77: Skipsp(tx);
78: while (*sp) if (*sp++ != Char(tx++))
79: pprerr("according to the syntax I expected ", ss);
80: }
81:
82: Visible Procedure thought(c) register char c; {
83: Skipsp(tx);
84: if (Char(tx++) != c) syserr("I'm confused; can't trust me own eyes");
85: }
86:
87: Visible Procedure reqkw(ss, ptx, qtx) string ss; txptr *ptx, *qtx; {
88: Where_inside (!Eol(ttx), Char(ttx) == *ss && !kw) {
89: string sp= ss+1;
90: *qtx= (*ptx= ttx)+1;
91: while (*sp) if (*sp++ != Char((*qtx)++)) goto isnt;
92: if (Keymark(Char(*qtx))) goto isnt;
93: return;
94: }
95: isnt: Otherwise parerr("cannot find expected ", ss);
96: }
97:
98: Visible Procedure req(ss, utx, ptx, qtx) string ss; txptr utx, *ptx, *qtx; {
99: Where_inside (ttx < utx && !Eol(ttx), Char(ttx) == *ss) {
100: string sp= ss+1;
101: *qtx= (*ptx= ttx)+1;
102: while (*sp && *qtx < utx) if (*sp++ != Char((*qtx)++)) goto isnt;
103: return;
104: }
105: isnt: Otherwise parerr("cannot find expected ", ss);
106: }
107:
108: Visible bool find(ss, utx, ptx, qtx) string ss; txptr utx, *ptx, *qtx; {
109: Where_inside (ttx < utx, Char(ttx) == *ss && !(kw && Cap(*ss))) {
110: string sp= ss+1;
111: *qtx= (*ptx= ttx)+1;
112: while (*sp && *qtx < utx) if (*sp++ != Char((*qtx)++)) goto isnt;
113: if (Cap(*ss) && Keymark(Char(*qtx))) goto isnt;
114: return Yes;
115: }
116: isnt: Otherwise return No;
117: }
118:
119: Visible intlet count(ss, utx) string ss; txptr utx; {
120: intlet cnt= 0;
121: Where_inside (ttx < utx, Char(ttx) == *ss) {
122: string sp= ss+1; txptr tp= ttx+1;
123: while (*sp && tp < utx) if (*sp++ != Char(tp++)) goto isnt;
124: cnt++;
125: }
126: isnt: Otherwise return cnt;
127: }
128:
129: #define TAGBUFSIZE 100
130: char tagbuf[TAGBUFSIZE];
131: txptr tagbufend= &tagbuf[TAGBUFSIZE];
132:
133: Visible value tag() {
134: txptr tp= tagbuf; value res= Vnil;
135: Skipsp(tx);
136: if (!Letter(Char(tx))) return Vnil;
137: while (Tagmark(Char(tx))) {
138: *tp++= Char(tx++);
139: if (tp+1 >= tagbufend) {
140: *tp= '\0';
141: concat_to(&res, tagbuf);
142: tp= tagbuf;
143: }
144: }
145: *tp= '\0';
146: concat_to(&res, tagbuf);
147: return(res);
148: }
149:
150: Visible value findkw(u, f, t) txptr u, *f, *t; {
151: txptr sp= tx, kp= tagbuf; value word= Vnil;
152: while (sp < u && !Cap(Char(sp))) sp++;
153: *f= sp;
154: while (sp < u && Keymark(Char(sp))) {
155: *kp++= Char(sp++);
156: if (kp+1 >= tagbufend) {
157: *kp= '\0';
158: concat_to(&word, tagbuf);
159: kp= tagbuf;
160: }
161: }
162: *kp= '\0';
163: concat_to(&word, tagbuf);
164: *t= sp; /* if no keyword is found, f and t are set to u */
165: return(word);
166: }
167:
168: Visible value keyword(u) txptr u; {
169: txptr f;
170: Skipsp(tx);
171: if (!Cap(Char(tx))) parerr("no keyword where expected", "");
172: return findkw(u, &f, &tx);
173: }
174:
175: /* Stream handling */
176: /* Txbuf holds streams of incoming characters from a file or the keyboard */
177: /* The current stream is marked by txstart and txend, */
178: /* with tx pointing somewhere in the middle */
179: /* The main stream is for immediate commands, but new ones are created */
180: /* for reading units, and for the read command (when this is implemented) */
181:
182: #define TXBUFSIZE (1<<13)
183: char txbuf[TXBUFSIZE];
184: txptr txbufstart= &txbuf[1], txstart, txend, txbufend= &txbuf[TXBUFSIZE];
185:
186: intlet alino;
187:
188: #define Interactive (interactive && sv_ifile == ifile)
189:
190: Visible txptr fcol() { /* the first position of the current line */
191: txptr ax= tx;
192: while (!Eol(ax-1) && Char(ax-1) != Eotc) ax--;
193: return(ax);
194: }
195:
196: Visible txptr lcol() { /* the position beyond the last character of the line */
197: txptr ax= tx;
198: while (!Eol(ax)) ax++;
199: return(ax);
200: }
201:
202: Visible Procedure getline() {
203: intlet k; bool got;
204: if (Eof0) {
205: *txend++= Eouc; *txend= Eotc;
206: Eof= Yes;
207: return;
208: }
209: alino++;
210: got= No;
211: while (!got) {
212: if (Interactive) {
213: if (outeractive) {
214: line();
215: at_nwl= No;
216: }
217: fprintf(stderr, cmd_prompt);
218: }
219: got= Yes;
220: while ((k= getc(ifile)) != EOF && k != '\n') {
221: *txend++= k;
222: if (txend > txbufend-5) syserr("text buffer overflow");
223: }
224: if (k == EOF && Interactive) {
225: if (filtered) bye(0); /* Editor has died */
226: fprintf(stderr, "\r*** use QUIT to end session\n");
227: CLEAR_EOF;
228: if (outeractive) at_nwl= Yes;
229: got= No;
230: }
231: }
232: if (Interactive && outeractive && k == '\n') at_nwl= Yes;
233: *txend++= '\n'; *txend= Eotc;
234: Eof0= k == EOF;
235: }
236:
237: Visible intlet ilev(new) bool new; {
238: register intlet i;
239: lino++;
240: if (Char(tx) == Eouc) {
241: ++tx; /* veli() */
242: if(!new)debug("ilev saw Eouc and returns since new == No");
243: if (!new) return cur_ilev= 0;
244: debug("ilev saw Eouc but proceeds since new == Yes");
245: } else if (Char(tx++) != '\n')
246: syserr("ilev called when not at end of line");
247: if(Char(tx-1)!=Eouc)debug("ilev saw no Eouc");
248: if (Char(tx) == Eotc) getline();
249: i= 0;
250: while (Char(tx) == ' ' || Char(tx) == '\t') {
251: if (Char(tx) == ' ') i++;
252: else i= (i/4+1)*4;
253: tx++;
254: }
255: if (Char(tx) == '\n') return cur_ilev= 0;
256: if (i%4 == 2)
257: parerr("cannot make out indentation; use tab to indent", "");
258: return cur_ilev= (i+1)/4; /* small deviation accepted */
259: }
260:
261: Visible Procedure veli() {
262: /* resets tx after look-ahead call of ilev */
263: debug("calling veli");
264: while (Char(--tx) != '\n' && Char(tx) != Eouc);
265: lino--;
266: debug("leaving veli");
267: }
268:
269: Visible Procedure inistreams() {
270: txstart= txbufstart;
271: start_stream();
272: }
273:
274: Visible Procedure re_streams() {
275: if (Char(tx+1) == Eotc) inistreams();
276: }
277:
278: Visible Procedure open_stream() {
279: txstart= txend+2;
280: start_stream();
281: }
282:
283: Hidden Procedure start_stream() {
284: *(txend= txstart)= Eotc;
285: tx= txend-1;
286: *tx= Eouc;
287: }
288:
289: Visible Procedure close_stream(otx, otxstart) txptr otx, otxstart; {
290: txend= txstart-2;
291: tx= otx;
292: txstart= otxstart;
293: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.