|
|
1.1 ! root 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: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.