```   1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1985. */
2:
3: /*
4:   \$Header: b2cmd.c,v 1.4 85/08/22 16:54:17 timo Exp \$
5: */
6:
7: #include "b.h"
8: #include "b0fea.h"
9: #include "b1obj.h"
10: #include "b2par.h"
11: #include "b2key.h"
12: #include "b2syn.h"
13: #include "b2nod.h"
14: #include "b3env.h"
15: #include "b3err.h"
16: #include "b3ext.h"
17:
18: /* ******************************************************************** */
19: /*		command_suite						*/
20: /* ******************************************************************** */
21:
22: Forward parsetree cmd_seq();
23:
24: Visible parsetree cmd_suite(cil, first) intlet cil; bool first; {
25:     if (ateol())
26:         return cmd_seq(cil, first);
27:     else {
28:         parsetree v; value c; intlet l= lino;
29:         suite_command(&v, &c);
30:         return node5(SUITE, mk_integer(l), v, c, NilTree);
31:     }
32: }
33:
34: Hidden parsetree cmd_seq(cil, first) intlet cil; bool first; {
35:     value c; intlet level, l;
36:     level= ilev(); l= lino;
37:     if (is_comment(&c))
38:         return node5(SUITE, mk_integer(l), NilTree, c,
39:                 cmd_seq(cil, first));
40:     if ((level == cil && !first) || (level > cil && first)) {
41:         parsetree v;
42:         findceol();
43:         suite_command(&v, &c);
44:         return node5(SUITE, mk_integer(l), v, c, cmd_seq(level, No));
45:     }
46:     veli();
47:     return NilTree;
48: }
49:
50: Visible Procedure suite_command(v, c) parsetree *v; value *c; {
51:     *v= NilTree; *c= Vnil;
52:     if (!(control_command(v) || simple_command(v, c)))
53:         parerr(MESS(2000, "no command where expected"));
54: }
55:
56: /* ******************************************************************** */
57: /*		is_comment, tail_line					*/
58: /* ******************************************************************** */
59:
60: Visible bool is_comment(v) value *v; {
61:     txptr tx0= tx;
62:     skipsp(&tx);
63:     if (comment_sign()) {
64:         while (Space(Char(tx0-1))) tx0--;
65:         while (!Eol(tx)) tx++;
66:         *v= cr_text(tx0, tx);
67:         return Yes;
68:     }
69:     tx= tx0;
70:     return No;
71: }
72:
73: Visible value tail_line() {
74:     value v;
75:     if (is_comment(&v)) return v;
76:     if (!ateol()) parerr(MESS(2001, "something unexpected following this line"));
77:     return Vnil;
78: }
79:
80: /* ******************************************************************** */
81: /*		simple_command						*/
82: /*									*/
83: /* ******************************************************************** */
84:
85: Forward bool bas_com(), term_com(), udr_com();
86:
87: Visible bool simple_command(v, c) parsetree *v; value *c; {
88:     return bas_com(v) || term_com(v) || udr_com(v)
89:         ? (*c= tail_line(), Yes) : No;
90: }
91:
92: /* ******************************************************************** */
93: /*		basic_command						*/
94: /* ******************************************************************** */
95:
96: Forward value cr_newlines();
97:
98: Hidden bool bas_com(v) parsetree *v; {
99:     txptr ftx, ttx; parsetree e, t;
100:     if (check_keyword()) {
101:             *v= node2(CHECK, test(ceol));
102:     } else if (choose_keyword()) {
103:             req(K_FROM_choose, ceol, &ftx, &ttx);
104:             t= targ(ftx); tx= ttx;
105:             *v= node3(CHOOSE, t, expr(ceol));
106:     } else if (delete_keyword()) {
107:             *v= node2(DELETE, targ(ceol));
108:     } else if (draw_keyword()) {
109:             *v= node2(DRAW, targ(ceol));
110:     } else if (insert_keyword()) {
111:             req(K_IN_insert, ceol, &ftx, &ttx);
112:             e= expr(ftx); tx= ttx;
113:             *v= node3(INSERT, e, targ(ceol));
114:     } else if (put_keyword()) {
115:             req(K_IN_put, ceol, &ftx, &ttx);
116:             e= expr(ftx); tx= ttx;
117:             *v= node3(PUT, e, targ(ceol));
118:     } else if (read_keyword()) {
119:             if (find(K_RAW, ceol, &ftx, &ttx)) {
120:                 *v= node2(READ_RAW, targ(ftx)); tx= ttx;
121:                 upto(ceol, K_RAW);
122:             } else {
123:                 req(K_EG, ceol, &ftx, &ttx);
124:                 t= targ(ftx); tx= ttx;
126:             }
127:     } else if (remove_keyword()) {
128:             req(K_FROM_remove, ceol, &ftx, &ttx);
129:             e= expr(ftx); tx= ttx;
130:             *v= node3(REMOVE, e, targ(ceol));
131:     } else if (setrandom_keyword()) {
132:             *v= node2(SET_RANDOM, expr(ceol));
133:     } else if (write_keyword()) {
134:             intlet b_cnt= 0, a_cnt= 0;
135:             skipsp(&tx);
136:             if (Ceol(tx))
137:                 parerr(MESS(2002, "no parameter where expected"));
138:             while (nwl_sign()) {b_cnt++; skipsp(&tx); }
139:             if (Ceol(tx)) e= NilTree;
140:             else {
141:                 ftx= ceol;
142:                 while (Space(Char(ftx-1)) || Char(ftx-1) == '/')
143:                     if (Char(--ftx) == '/') a_cnt++;
144:                 skipsp(&tx);
145:                 e= ftx > tx ? expr(ftx) : NilTree;
146:             }
147:             *v= node4(WRITE,
148:                   cr_newlines(b_cnt), e, cr_newlines(a_cnt));
149:             tx= ceol;
150:     } else return No;
151:     return Yes;
152: }
153:
154: Hidden value cr_newlines(cnt) intlet cnt; {
155:     value v, t= mk_text("/"), n= mk_integer(cnt);
156:     v= repeat(t, n);
157:     release(t); release(n);
158:     return v;
159: }
160:
161: /* ******************************************************************** */
162: /*		terminating_command					*/
163: /* ******************************************************************** */
164:
165: Visible bool term_com(v) parsetree *v; {
166:     if (fail_keyword()) {
167:         upto(ceol, K_FAIL);
168:         *v= node1(FAIL);
169:     } else if (quit_keyword()) {
170:         upto(ceol, K_QUIT);
171:         *v= node1(QUIT);
172:     } else if (return_keyword())
173:         *v= node2(RETURN, expr(ceol));
174:     else if (report_keyword())
175:         *v= node2(REPORT, test(ceol));
176:     else if (succeed_keyword()) {
177:         upto(ceol, K_SUCCEED);
178:         *v= node1(SUCCEED);
179:     } else return No;
180:     return Yes;
181: }
182:
183: /* ******************************************************************** */
184: /*		user_defined_command; refined_command			*/
185: /* ******************************************************************** */
186:
187: Forward value hu_actuals();
188: #ifdef EXT_COMMAND
189: Forward bool extended_command();
190: #endif
191:
192: Hidden bool udr_com(v) parsetree *v; {
193:     value w;
194:     if (is_keyword(&w)) {
195: #ifdef EXT_COMMAND
196:         if (extended_command(w, v))
197:             return Yes;
198: #endif
199:         if (!in(w, kwlist)) {
200:             *v= node4(USER_COMMAND,
201:                 copy(w), hu_actuals(ceol, w), Vnil);
202:             return Yes;
203:         }
204:         release(w);
205:     }
206:     return No;
207: }
208:
209: Hidden value hu_actuals(q, kw) txptr q; value kw; {
210:     parsetree e; value v, w;
211:     txptr ftx;
212:     skipsp(&tx);
213:     if (!findkw(q, &ftx)) ftx= q;
214:     e= Text(ftx) ? expr(ftx) : NilTree;
215:     v= Text(q) ? hu_actuals(q, keyword()) : Vnil;
216:     w= node5(ACTUAL, kw, e, v, Vnil);
217:     return w;
218: }
219:
220: #ifdef EXT_COMMAND
221:
222: /* ******************************************************************** */
223: /*		extended_command					*/
224: /* ******************************************************************** */
225:
226: Hidden bool extended_command(w, v) value w, *v; {
227:     string name, arg; ext *e; int i; value args[MAXEARGS], a;
228:     txptr ftx, ttx;
229:     extern bool extcmds; /* Flag set in main by -E option */
230:     if (!extcmds) return No;
231:     name= strval(w);
232:     for (e= extensions; e->e_name != 0; ++e) {
233:         if (strcmp(e->e_name, name) == 0) break;
234:     }
235:     if (e->e_name == 0) return No;
236:     for (i= 0; i < MAXEARGS && (arg= e->e_args[i]) != 0; ++i) {
237:         if (arg[1] != '\0') req(arg+1, ceol, &ftx, &ttx);
238:         else ftx= ceol;
239:         switch (arg[0]) {
240:         case 'e': args[i]= expr(ftx); break;
241:         case 't': args[i]= targ(ftx); break;
242:         default: psyserr(MESS(2003, "bad entry in extended_command table"));
243:         }
244:         if (arg[1] != '\0') tx= ttx;
245:     }
246:     if (i == 0) arg= e->e_name;
247:     else {
248:         arg= e->e_args[i-1];
249:         if (arg[1] != '\0') ++arg;
250:         else switch (arg[0]) {
251:         case 'e': arg= "expression"; break;
252:         case 't': arg= "target"; break;
253:         }
254:     }
255:     upto(ceol, arg);
256:     if (i == 0) a= Vnil;
257:     else {
258:         a= mk_compound(i);
259:         while (--i >= 0) *Field(a, i)= args[i];
260:     }
261:     *v= node3(EXTENDED_COMMAND, w, a);
262:     return Yes;
263: }
264:
265: #endif EXT_COMMAND
266:
267: /* ******************************************************************** */
268: /*		control_command						*/
269: /* ******************************************************************** */
270:
271: Forward parsetree alt_suite();
272:
273: Visible bool control_command(v) parsetree *v; {
274:     parsetree e, t; value c;
275:     txptr ftx, ttx, utx, vtx;
276:     skipsp(&tx);
277:     if (if_keyword()) {
278:             req(":", ceol, &utx, &vtx);
279:             t= test(utx); tx= vtx;
280:             if (!is_comment(&c)) c= Vnil;
281:             *v= node4(IF, t, c, cmd_suite(cur_ilev, Yes));
282:     } else if (select_keyword()) {
283:             need(":");
284:             c= tail_line();
285:             *v= node3(SELECT, c, alt_suite());
286:     } else if (while_keyword()) {
287:             req(":", ceol, &utx, &vtx);
288:             t= test(utx); tx= vtx;
289:             if (!is_comment(&c)) c= Vnil;
290:             *v= node4(WHILE, t, c, cmd_suite(cur_ilev, Yes));
291:     } else if (for_keyword()) {
292:             req(":", ceol, &utx, &vtx);
293:             req(K_IN_for, ceol, &ftx, &ttx);
294:             if (ttx > utx) {
295:                 parerr(MESS(2004, "IN after colon"));
296:                 ftx= utx= tx; ttx= vtx= ceol;
297:             }
298:             idf_cntxt= In_ranger;
299:             t= idf(ftx); tx= ttx;
300:             e= expr(utx); tx= vtx;
301:             if (!is_comment(&c)) c= Vnil;
302:             *v= node5(FOR, t, e, c, cmd_suite(cur_ilev, Yes));
303:     } else return No;
304:     return Yes;
305: }
306:
307: /* ******************************************************************** */
308: /*		alternative_suite					*/
309: /* ******************************************************************** */
310:
311: Forward parsetree alt_seq();
312:
313: Hidden parsetree alt_suite() {
314:     parsetree v; bool empty= Yes;
315:     v= alt_seq(&empty, cur_ilev, Yes, No);
316:     if (empty) parerr(MESS(2005, "no alternative suite where expected"));
317:     return v;
318: }
319:
320: Hidden parsetree
321: alt_seq(empty, cil, first, else_encountered)
322:     bool *empty, first, else_encountered; intlet cil;
323: {
324:     value c; intlet level, l;
325:     level= ilev(); l= lino;
326:     if (is_comment(&c))
327:         return node6(TEST_SUITE, mk_integer(l), NilTree, c, NilTree,
328:                 alt_seq(empty, cil, first, else_encountered));
329:     if ((level == cil && !first) || (level > cil && first)) {
330:         parsetree v, s; txptr ftx, ttx;
331:         if (else_encountered)
332:             parerr(MESS(2006, "after ELSE no more alternatives allowed"));
333:         findceol();
334:         req(":", ceol, &ftx, &ttx);
335:         *empty= No;
336:         if (else_keyword()) {
337:             upto(ftx, K_ELSE); tx= ttx;
338:             if (!is_comment(&c)) c= Vnil;
339:             s= cmd_suite(level, Yes);
340:             release(alt_seq(empty, level, No, Yes));
341:             return node4(ELSE, mk_integer(l), c, s);
342:         }
343:         v= test(ftx); tx= ttx;
344:         if (!is_comment(&c)) c= Vnil;
345:         s= cmd_suite(level, Yes);
346:         return node6(TEST_SUITE, mk_integer(l), v, c, s,
347:                 alt_seq(empty, level, No, else_encountered));
348:     }
349:     veli();
350:     return NilTree;
351: }
```

#### Defined functions

alt_seq defined in line 320; used 5 times
alt_suite defined in line 313; used 2 times
bas_com defined in line 98; used 2 times
cmd_seq defined in line 34; used 4 times
cmd_suite defined in line 24; used 8 times
cr_newlines defined in line 154; used 3 times
extended_command defined in line 226; used 2 times
hu_actuals defined in line 209; used 3 times
is_comment defined in line 60; used 14 times
suite_command defined in line 50; used 3 times
tail_line defined in line 73; used 4 times
term_com defined in line 165; used 4 times
udr_com defined in line 192; used 2 times

#### Defined variables

Forward defined in line 85; never used
Hidden defined in line 320; never used
 Last modified: 1985-08-27 Generated: 2016-12-26 Generated by src2html V0.67 page hit count: 3475