```   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: }
```

#### Defined functions

close_stream defined in line 289; used 1 times
fcol defined in line 190; used 2 times
findkw defined in line 150; used 4 times
getline defined in line 202; used 2 times
inistreams defined in line 269; used 3 times
lcol defined in line 196; used 3 times
open_stream defined in line 278; used 1 times
re_streams defined in line 274; used 1 times
start_stream defined in line 283; used 2 times

#### Defined variables

Procedure defined in line 202; never used
Visible defined in line 237; never used
alino defined in line 186; used 1 times
tagbuf defined in line 130; used 9 times
tagbufend defined in line 131; used 2 times
txbuf defined in line 183; used 2 times
• in line 184(2)
txbufstart defined in line 184; used 1 times

#### Defined macros

Interactive defined in line 188; used 3 times
Otherwise defined in line 39; used 5 times
TAGBUFSIZE defined in line 129; used 2 times
TXBUFSIZE defined in line 182; used 2 times
Where_inside defined in line 33; used 5 times
 Last modified: 1985-08-27 Generated: 2016-12-26 Generated by src2html V0.67 page hit count: 1646