![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to b2cmd.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDTahoe / new / B / src / bsmall|
Return to b2cmd.c CVS log | Up to [CSRG BSD Unix] / 43BSDTahoe / new / B / src / bsmall |
1.1 root 1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
2: /* $Header: b2cmd.c,v 1.1 84/06/28 00:49:04 timo Exp $ */
3:
4: /* B commands */
5: #include "b.h"
6: #include "b0con.h"
7: #include "b1obj.h"
8: #include "b2env.h"
9: #include "b2scr.h"
10: #include "b2err.h"
11: #include "b2key.h"
12: #include "b2syn.h"
13: #include "b2sem.h"
14: #include "b2typ.h"
15:
16: #define Nex if (!xeq) {tx= ceol; return Yes;}
17:
18: char rdbuf[RDBUFSIZE];
19: txptr rdbufend= &rdbuf[RDBUFSIZE];
20:
21: #define USE_QUIT "\r*** use QUIT or interrupt to abort READ command\n"
22:
23: Hidden Procedure read_line(l, t, eg) loc l; btype t; bool eg; {
24: context c; txptr tx0= tx, rp; intlet k; value r; btype rt;
25: envtab svprmnvtab= Vnil; bool must_sv= eg, got;
26: sv_context(&c);
27: if (active_reads >= MAX_NMB_ACT_READS)
28: error("too many READs simultaneously active");
29: if (setjmp(reading[active_reads++]) != 0) /* long jump occurred */
30: set_context(&c);
31: if (cntxt != In_read) sv_context(&read_context);
32: if (must_sv) svprmnvtab= prmnvtab == Vnil ? Vnil : prmnv->tab;
33: /* save scratch-pad copy because of following setprmnv() */
34: if (eg) setprmnv(); must_sv= No;
35: cntxt= In_read;
36: got= No;
37: while (!got) {
38: tx= rp= rdbuf;
39: if (read_interactive) {
40: fprintf(stderr, eg ? eg_prompt : raw_prompt);
41: }
42: got= Yes;
43: while ((k= getchar()) != EOF && k != '\n') {
44: *rp++= k;
45: if (rp > rdbufend-1) syserr("read buffer overflow");
46: }
47: if (k == EOF) {
48: if (read_interactive) {
49: fprintf(stderr, USE_QUIT);
50: CLEAR_EOF;
51: if (outeractive) at_nwl= Yes;
52: got= No;
53: } else error("End of file encountered during READ command");
54: }
55: }
56: if (read_interactive && outeractive && k == '\n') at_nwl= Yes;
57: *rp= '\n';
58: Skipsp(tx);
59: if (atkw(QUIT)) int_signal(Yes);
60: if (eg) {
61: r= expr(rp); rt= valtype(r);
62: if (svprmnvtab != Vnil) {
63: prmnvtab= prmnv->tab;
64: prmnv->tab= svprmnvtab;
65: }
66: must_sv= Yes;
67: set_context(&c);
68: must_agree(t, rt,
69: "type of expression does not agree with that of EG sample");
70: release(rt);
71: } else {
72: *rp= '\0';
73: r= mk_text(rdbuf);
74: set_context(&c);
75: }
76: put(r, l);
77: active_reads--;
78: release(r);
79: tx= tx0;
80: }
81:
82: Hidden Procedure check(o) outcome o; {
83: if (o == Fail) checkerr();
84: }
85:
86: Hidden bool sim_com() {
87: txptr ftx, ttx;
88: switch (Char(tx)) {
89: case 'C': if (atkw(CHECK)) {
90: env e0= curnv; outcome o;
91: Nex;
92: o= test(ceol);
93: if (xeq) {
94: check(o);
95: restore_env(e0);
96: }
97: return Yes;
98: } else if (atkw(CHOOSE)) {
99: loc l; value v;
100: reqkw(FROM_choose, &ftx, &ttx);
101: Nex;
102: l= targ(ftx);
103: tx= ttx; v= expr(ceol);
104: if (xeq) choose(l, v);
105: release(v); release(l);
106: return Yes;
107: }
108: return No;
109: case 'D': if (atkw(DELETE)) {
110: loc l;
111: Nex;
112: l= targ(ceol);
113: if (xeq) l_delete(l);
114: release(l);
115: return Yes;
116: } else if (atkw(DRAW)) {
117: loc l;
118: Nex;
119: l= targ(ceol);
120: if (xeq) draw(l);
121: release(l);
122: return Yes;
123: }
124: return No;
125: case 'E': if (atkw(ELSE)) {
126: pprerr("ELSE only allowed as alternative test after SELECT", "");
127: }
128: return No;
129: case 'I': if (atkw(INSERT)) {
130: value v; loc l;
131: reqkw(IN_insert, &ftx, &ttx);
132: Nex;
133: v= expr(ftx);
134: tx= ttx; l= targ(ceol);
135: if (xeq) l_insert(v, l);
136: release(v); release(l);
137: return Yes;
138: }
139: return No;
140: case 'P': if (atkw(PUT)) {
141: value v; loc l;
142: reqkw(IN_put, &ftx, &ttx);
143: Nex;
144: v= expr(ftx);
145: tx= ttx; l= targ(ceol);
146: if (xeq) put(v, l);
147: release(v); release(l);
148: return Yes;
149: }
150: return No;
151: case 'R': if (atkw(READ)) {
152: value v; loc l; btype vt, lt; bool eg= Yes;
153: if (find(RAW, ceol, &ftx, &ttx)) {
154: eg= No;
155: vt= mk_text("");
156: } else reqkw(EG, &ftx, &ttx);
157: Nex;
158: l= targ(ftx); lt= loctype(l);
159: tx= ttx;
160: if (eg) {
161: v= expr(ceol);
162: vt= valtype(v); release(v);
163: }
164: must_agree(vt, lt,
165: eg ? "this sample could not lawfully be put in the target"
166: : "in READ x RAW, x must be a simple textual target");
167: release(lt);
168: if (xeq) read_line(l, vt, eg);
169: release(l); release(vt);
170: return Yes;
171: } else if (atkw(REMOVE)) {
172: value v; loc l;
173: reqkw(FROM_remove, &ftx, &ttx);
174: Nex;
175: v= expr(ftx);
176: tx= ttx; l= targ(ceol);
177: if (xeq) l_remove(v, l);
178: release(v); release(l);
179: return Yes;
180: }
181: return No;
182: case 'S': if (atkw(SET_RANDOM)) {
183: value v;
184: Nex;
185: v= expr(ceol);
186: if (xeq) set_random(v);
187: release(v);
188: return Yes;
189: } else if (atkw(SHARE)) pprerr(
190: "SHARE only allowed following HOW'TO-, YIELD- or TEST-heading", "");
191: return No;
192: case 'W': if (atkw(WRITE)) {
193: txptr tx0; value v; intlet nwlc;
194: Nex;
195: Skipsp(tx);
196: while (Char(tx) == '/' && (Char(tx+1) == '/')) {
197: if (xeq) newline();
198: tx++;
199: }
200: tx0= tx;
201: loop: if (Char(tx++) != '/') {tx= tx0; goto postnl;}
202: if (Char(tx++) == '*') goto loop;
203: if (xeq) newline();
204: tx= tx0+1;
205: postnl: ftx= ceol;
206: while (Space(Char(ftx-1))) ftx--;
207: nwlc= 0;
208: while (ftx > tx && Char(ftx-1) == '/') {
209: nwlc++;
210: ftx--;
211: }
212: if (ftx > tx) {
213: v= expr(ftx);
214: if (xeq) writ(v);
215: release(v);
216: }
217: while (nwlc-- > 0) {
218: if (xeq) newline();
219: }
220: return Yes;
221: }
222: return No;
223: default: return No;
224: }
225: }
226:
227: #define Reqcol {req(":", ceol, &utx, &vtx); \
228: if (!xeq) {tx= vtx; comm_suite(); return Yes;}}
229: #define Resetx(tx0) {tx= (tx0); lino= lino0; cur_ilev= cil;}
230:
231: Hidden bool con_com() {
232: intlet lino0= lino, cil= cur_ilev;
233: txptr ftx, ttx, utx, vtx;
234: switch (Char(tx)) {
235: case 'I': if (atkw(IF)) {
236: env e0= curnv; bool xeq0= xeq;
237: outcome o;
238: Reqcol;
239: o= test(utx);
240: xeq= o == Succ;
241: tx= vtx; comm_suite();
242: xeq= xeq0; restore_env(e0);
243: return Yes;
244: }
245: return No;
246: case 'S': if (atkw(SELECT)) {
247: need(":");
248: upto(ceol, "SELECT:");
249: alt_suite();
250: return Yes;
251: }
252: return No;
253: case 'W': if (atkw(WHILE)) {
254: env e0= curnv; bool xeq0= xeq; txptr tx0= tx;
255: outcome o;
256: Reqcol;
257: loop: o= test(utx);
258: if (xeq0) xeq= o == Succ;
259: tx= vtx; comm_suite();
260: xeq= xeq0; restore_env(e0);
261: if (xeq && o == Succ && !terminated) {
262: Resetx(tx0); goto loop;
263: }
264: return Yes;
265: }
266: return No;
267: case 'F': if (atkw(FOR)) {
268: env e0= curnv; bool xeq0= xeq; loc l; value v, w;
269: Reqcol;
270: if (find(PARSING, utx, &ftx, &ttx)) {
271: tx= ttx; pprerr("PARSING not allowed in FOR ...", "");
272: }
273: reqkw(IN_for, &ftx, &ttx);
274: if (ttx > ceol) {
275: tx= ceol;
276: parerr("IN after colon", "");
277: }
278: l= targ(ftx);
279: if (!Is_simploc(l) && !Is_compound(l)) /*to bloc.c?*/
280: pprerr("inappropriate identifier after FOR", "");
281: bind(l);
282: tx= ttx; v= expr(utx);
283: {value k, k1, len= xeq ? size(v) : copy(one);
284: if (compare(len, zero) == 0) {
285: xeq= No; release(len); len= copy(one);
286: }
287: k= copy(one);
288: while (!terminated && compare(k, len) <= 0) {
289: Resetx(utx);
290: if (xeq) {
291: w= th_of(k, v);
292: put(w, l);
293: release(w);
294: }
295: k= sum(k1= k, one); release(k1);
296: tx= vtx; comm_suite();
297: }
298: release(k); release(len);
299: }
300: xeq= xeq0; restore_env(e0);
301: release(v); release(l);
302: return Yes;
303: }
304: return No;
305: default: return No;
306: }
307: }
308:
309: Hidden bool term_com() {
310: switch (Char(tx)) {
311: case 'F': if (atkw(FAIL)) {
312: upto(ceol, "FAIL");
313: if (xeq) {
314: chckvtc(Rep);
315: resout= Fail;
316: terminated= Yes;
317: } else tx= ceol;
318: return Yes;
319: }
320: return No;
321: case 'Q': if (atkw(QUIT)) {
322: upto(ceol, "QUIT");
323: if (xeq) {
324: if (cur_ilev == 0) bye(0);
325: chckvtc(Voi);
326: terminated= Yes;
327: }
328: return Yes;
329: }
330: return No;
331: case 'R': if (atkw(RETURN)) {
332: if (xeq) {
333: chckvtc(Ret);
334: resval= expr(ceol);
335: terminated= Yes;
336: } else tx= ceol;
337: return Yes;
338: } else if (atkw(REPORT)) {
339: if (xeq) {
340: chckvtc(Rep);
341: resout= test(ceol);
342: terminated= Yes;
343: } else tx= ceol;
344: return Yes;
345: }
346: return No;
347: case 'S': if (atkw(SUCCEED)) {
348: upto(ceol, "SUCCEED");
349: if (xeq) {
350: chckvtc(Rep);
351: resout= Succ;
352: terminated= Yes;
353: } else tx= ceol;
354: return Yes;
355: }
356: return No;
357: default: return No;
358: }
359: }
360:
361: Hidden bool secret_com() {
362: switch (Char(tx)) {
363: case 'D': if (atkw("DEBUG")) {
364: Nex;
365: bugs= Yes;
366: return Yes;
367: }
368: return No;
369: case 'G': if (atkw("GR")) {
370: Nex;
371: prgr();
372: return Yes;
373: }
374: return No;
375: case 'N': if (atkw("NO'DEBUG")) {
376: Nex;
377: bugs= No;
378: return Yes;
379: } else if (atkw("NO'TRACE")) {
380: Nex;
381: tracing= No;
382: return Yes;
383: }
384: return No;
385: case 'T': if (atkw("TRACE")) {
386: Nex;
387: tracing= Yes;
388: return Yes;
389: }
390: return No;
391: default: return No;
392: }
393: }
394:
395: Hidden Procedure chckvtc(re) literal re; {
396: if (cntxt != In_unit || resexp == Voi) {
397: if (re == Ret)
398: pprerr("RETURN e only allowed inside YIELD-unit or\n",
399: " expression-refinement");
400: else if (re == Rep)
401: pprerr("REPORT t only allowed inside TEST-unit",
402: " or test-refinement");
403: }
404: if (re != resexp) {
405: if (resexp == Ret)
406: pprerr(
407: "RETURN e must terminate YIELD-unit or expression-refinement", "");
408: if (resexp == Rep)
409: pprerr(
410: "REPORT t must terminate TEST-unit or test-refinement", "");
411: }
412: }
413:
414: Hidden bool expr_s() {
415: char c;
416: Skipsp(tx);
417: if (tx >= ceol) return No;
418: c= Char(tx);
419: return Letter(c) || Montormark(c) || Dig(c) || c == '.' || c == 'E' ||
420: c == '(' || c == '{' || c == '\'' || c == '"';
421: }
422:
423: intlet comcnt= 0;
424:
425: Visible Procedure command() {
426: if (++comcnt > 10000) {
427: putprmnv();
428: comcnt= 1;
429: }
430: if (Char(tx) == Eotc) getline();
431: debug("analyzing command");
432: if (tracing) trace();
433: if (Ceol(tx));
434: else if (sim_com() || con_com() ||
435: unit() || term_com() || ref_com() || udc() ||
436: secret_com()) skipping= No;
437: else if (Char(tx) == ':' || Char(tx) == '=' || Char(tx) == '!') {
438: if (!interactive) parerr("special commands only interactively", "");
439: if (!(cntxt == In_command && cur_ilev == 0)) parerr(
440: "special commands only on outermost level (no indentation)", "");
441: special();
442: } else if (cntxt == In_command && cur_ilev == 0 && expr_s()) {
443: value w= expr(ceol);
444: wri(w, Yes, No, No);
445: release(w);
446: } else {txptr tx0= tx; value uc= keyword(ceol);
447: tx= tx0; parerr("you have not told me HOW'TO ", strval(uc));
448: }
449: To_eol(tx);
450: debug("command treated");
451: }
452:
453: Visible Procedure comm_suite() {
454: intlet cil= cur_ilev;
455: if (ateol()) {
456: txptr tx0= tx; bool xeq0= xeq;
457: if (Char(tx+1) == Eotc) xeq= No;
458: while (ilev(No) > cil) {
459: findceol();
460: command();
461: if (terminated) return;
462: if (cur_ilev <= cil) goto brk1;
463: }
464: veli();
465: brk1: if (xeq0 && !xeq) {
466: tx= tx0; xeq= Yes;
467: cur_ilev= cil;
468: while (ilev(No) > cil) {
469: findceol();
470: command();
471: if (terminated) return;
472: if (cur_ilev <= cil) goto brk2;
473: }
474: veli();
475: brk2: ;
476: }
477: } else command();
478: }
479:
480: Hidden Procedure alt_suite() {
481: intlet cil= cur_ilev; env e0= curnv; txptr utx, vtx;
482: bool xeq0= xeq, succ= !xeq, Else= No;
483: if (!ateol()) syserr("alt_suite not at end of line");
484: while (ilev(No) > cil) {
485: findceol();
486: if (Else)
487: parerr("after ELSE: ... no more alternatives are allowed", "");
488: req(":", ceol, &utx, &vtx);
489: if (atkw(ELSE)) {
490: succ= Else= Yes;
491: upto(utx, "ELSE");
492: tx= vtx; comm_suite();
493: if (terminated) return;
494: } else {
495: if (xeq) succ= test(utx) == Succ;
496: xeq= xeq && succ;
497: tx= vtx; comm_suite();
498: if (terminated) return;
499: xeq= !succ;
500: }
501: if (cur_ilev <= cil) goto brk;
502: }
503: veli();
504: brk: if (!succ) error("none of the alternative tests of SELECT succeeds");
505: xeq= xeq0; if (xeq) restore_env(e0);
506: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.