2.11BSD#431 - /usr/src/new/PORT/B/src/bint/b2cmd.c

   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;
 125:                 *v= node3(READ, t, expr(ceol));
 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

Defined variables