1/* pt::rde::critcl - critcl - layer 3 definitions. 2 * 3 * -> Method functions. 4 * Implementations for all state methods. 5 */ 6 7#include <m.h> /* Our public API */ 8#include <pInt.h> /* State public and internal APIs */ 9#include <ot.h> /* Tcl_Objype for interned strings. */ 10#include <util.h> /* Allocation utilities */ 11#include <string.h> 12 13/* .................................................. */ 14 15int 16param_AMARKED (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 17{ 18 /* Syntax: rde amarked 19 * [0] [1] 20 */ 21 22 long int mc, i; 23 long int* mv; 24 Tcl_Obj** ov; 25 26 if (objc != 2) { 27 Tcl_WrongNumArgs (interp, 2, objv, NULL); 28 return TCL_ERROR; 29 } 30 31 rde_param_query_amark (p->p, &mc, &mv); 32 33 ov = NALLOC (mc, Tcl_Obj*); 34 35 for (i=0; i < mc; i++) { 36 ov [i] = Tcl_NewIntObj (mv [i]); 37 } 38 39 Tcl_SetObjResult (interp, 40 Tcl_NewListObj (mc, ov)); 41 42 ckfree ((char*) ov); 43 44 return TCL_OK; 45} 46 47int 48param_AST (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 49{ 50 /* Syntax: rde ast 51 * [0] [1] 52 */ 53 54 long int ac, i; 55 Tcl_Obj** av; 56 57 if (objc != 2) { 58 Tcl_WrongNumArgs (interp, 2, objv, NULL); 59 return TCL_ERROR; 60 } 61 62 rde_param_query_ast (p->p, &ac, &av); 63 64 Tcl_SetObjResult (interp, av [ac-1]); 65 66 return TCL_OK; 67} 68 69int 70param_ASTS (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 71{ 72 /* Syntax: rde asts 73 * [0] [1] 74 */ 75 76 long int ac, i; 77 Tcl_Obj** av; 78 79 if (objc != 2) { 80 Tcl_WrongNumArgs (interp, 2, objv, NULL); 81 return TCL_ERROR; 82 } 83 84 rde_param_query_ast (p->p, &ac, &av); 85 86 Tcl_SetObjResult (interp, Tcl_NewListObj (ac, av)); 87 88 return TCL_OK; 89} 90 91int 92param_CHAN (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 93{ 94 /* Syntax: rde chan 95 * [0] [1] 96 */ 97 98 if (objc != 2) { 99 Tcl_WrongNumArgs (interp, 2, objv, NULL); 100 return TCL_ERROR; 101 } 102 103 Tcl_SetObjResult (interp, 104 Tcl_NewStringObj (rde_param_query_in (p->p), 105 -1)); 106 107 return TCL_OK; 108} 109 110int 111param_COMPLETE (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 112{ 113 /* Syntax: rde complete 114 * [0] [1] 115 */ 116 117 if (objc != 2) { 118 Tcl_WrongNumArgs (interp, 2, objv, NULL); 119 return TCL_ERROR; 120 } 121 122 if (rde_param_query_st (p->p)) { 123 long int ac; 124 Tcl_Obj** av; 125 126 rde_param_query_ast (p->p, &ac, &av); 127 128 if (ac > 1) { 129 long int lsc; 130 long int* lsv; 131 Tcl_Obj** lv = NALLOC (3+ac, Tcl_Obj*); 132 133 rde_param_query_ls (p->p, &lsc, &lsv); 134 135 memcpy(lv + 3, av, ac * sizeof (Tcl_Obj*)); 136 lv [0] = Tcl_NewObj (); 137 lv [1] = Tcl_NewIntObj (1 + lsv [lsc-1]); 138 lv [2] = Tcl_NewIntObj (rde_param_query_cl (p->p)); 139 140 Tcl_SetObjResult (interp, Tcl_NewListObj (3, lv)); 141 ckfree ((char*) lv); 142 } else { 143 Tcl_SetObjResult (interp, av [0]); 144 } 145 146 return TCL_OK; 147 148 } else { 149 Tcl_Obj* xv [1]; 150 const ERROR_STATE* er = rde_param_query_er (p->p); 151 Tcl_Obj* res = rde_param_query_er_tcl (p->p, er); 152 153 xv [0] = Tcl_NewStringObj ("pt::rde",-1); 154 Tcl_ListObjReplace(interp, res, 0, 1, 1, xv); 155 156 Tcl_SetObjResult (interp, res); 157 return TCL_ERROR; 158 } 159} 160 161int 162param_CURRENT (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 163{ 164 /* Syntax: rde current 165 * [0] [1] 166 */ 167 168 const char* ch; 169 long int len; 170 171 if (objc != 2) { 172 Tcl_WrongNumArgs (interp, 2, objv, NULL); 173 return TCL_ERROR; 174 } 175 176 ch = rde_param_query_cc (p->p, &len); 177 Tcl_SetObjResult (interp, Tcl_NewStringObj (ch, len)); 178 179 return TCL_OK; 180} 181 182int 183param_DATA (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 184{ 185 /* Syntax: rde data DATA 186 * [0] [1] [2] 187 */ 188 189 char* buf; 190 int len; 191 192 if (objc != 3) { 193 Tcl_WrongNumArgs (interp, 2, objv, "data"); 194 return TCL_ERROR; 195 } 196 197 buf = Tcl_GetStringFromObj (objv [2], &len); 198 199 rde_param_data (p->p, buf, len); 200 201 return TCL_OK; 202} 203 204int 205param_DESTROY (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 206{ 207 /* Syntax: rde destroy 208 * [0] [1] 209 */ 210 211 if (objc != 2) { 212 Tcl_WrongNumArgs (interp, 2, objv, NULL); 213 return TCL_ERROR; 214 } 215 216 Tcl_DeleteCommandFromToken(interp, p->c); 217 return TCL_OK; 218} 219 220int 221param_EMARKED (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 222{ 223 /* Syntax: rde emarked 224 * [0] [1] 225 */ 226 227 long int ec, i; 228 ERROR_STATE** ev; 229 Tcl_Obj** ov; 230 231 if (objc != 2) { 232 Tcl_WrongNumArgs (interp, 2, objv, NULL); 233 return TCL_ERROR; 234 } 235 236 rde_param_query_es (p->p, &ec, &ev); 237 238 ov = NALLOC (ec, Tcl_Obj*); 239 240 for (i=0; i < ec; i++) { 241 ov [i] = rde_param_query_er_tcl (p->p, ev [i]); 242 } 243 244 Tcl_SetObjResult (interp, Tcl_NewListObj (ec, ov)); 245 246 ckfree ((char*) ov); 247 248 return TCL_OK; 249} 250 251int 252param_ERROR (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 253{ 254 /* Syntax: rde error 255 * [0] [1] 256 */ 257 258 if (objc != 2) { 259 Tcl_WrongNumArgs (interp, 2, objv, NULL); 260 return TCL_ERROR; 261 } 262 263 Tcl_SetObjResult (interp, 264 rde_param_query_er_tcl (p->p, 265 rde_param_query_er (p->p))); 266 return TCL_OK; 267} 268 269int 270param_LMARKED (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 271{ 272 /* Syntax: rde lmarked 273 * [0] [1] 274 */ 275 276 long int lc, i; 277 long int* lv; 278 Tcl_Obj** ov; 279 280 if (objc != 2) { 281 Tcl_WrongNumArgs (interp, 2, objv, NULL); 282 return TCL_ERROR; 283 } 284 285 rde_param_query_ls (p->p, &lc, &lv); 286 287 ov = NALLOC (lc, Tcl_Obj*); 288 289 for (i=0; i < lc; i++) { 290 ov [i] = Tcl_NewIntObj (lv [i]); 291 } 292 293 Tcl_SetObjResult (interp, Tcl_NewListObj (lc, ov)); 294 295 ckfree ((char*) ov); 296 return TCL_OK; 297} 298 299int 300param_LOCATION (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 301{ 302 /* Syntax: rde location 303 * [0] [1] 304 */ 305 306 if (objc != 2) { 307 Tcl_WrongNumArgs (interp, 2, objv, NULL); 308 return TCL_ERROR; 309 } 310 311 Tcl_SetObjResult (interp, 312 Tcl_NewIntObj (rde_param_query_cl (p->p))); 313 314 return TCL_OK; 315} 316 317int 318param_OK (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 319{ 320 /* Syntax: rde ok 321 * [0] [1] 322 */ 323 324 if (objc != 2) { 325 Tcl_WrongNumArgs (interp, 2, objv, NULL); 326 return TCL_ERROR; 327 } 328 329 Tcl_SetObjResult (interp, 330 Tcl_NewIntObj (rde_param_query_st (p->p))); 331 332 return TCL_OK; 333} 334 335int 336param_RESET (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 337{ 338 /* Syntax: rde reset ?CHAN? 339 * [0] [1] [2] 340 */ 341 342 int mode; 343 Tcl_Channel chan; 344 345 if ((objc != 3) && (objc != 2)) { 346 Tcl_WrongNumArgs (interp, 2, objv, "?chan?"); 347 return TCL_ERROR; 348 } 349 350 /* 351 * Can't use TclGetChannelFromObj, nice as it would be. This fucntion is 352 * not part of Tcl's public C API. 353 */ 354 355 if (objc == 2) { 356 chan = NULL; 357 } else { 358 chan = Tcl_GetChannel(interp, 359 Tcl_GetString (objv[2]), 360 &mode); 361 362 if (!chan) { 363 return TCL_ERROR; 364 } 365 } 366 367 rde_param_reset (p->p, chan); 368 369 return TCL_OK; 370} 371 372int 373param_SCACHED (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 374{ 375 /* Syntax: rde scached 376 * [0] [1] 377 */ 378 379 Tcl_HashTable* nc; 380 Tcl_Obj* res; 381 Tcl_HashSearch hs; 382 Tcl_HashEntry* he; 383 Tcl_HashTable* tablePtr; 384 Tcl_Obj* kv [2]; 385 386 if (objc != 2) { 387 Tcl_WrongNumArgs (interp, 2, objv, NULL); 388 return TCL_ERROR; 389 } 390 391 nc = rde_param_query_nc (p->p); 392 res = Tcl_NewListObj (0, NULL); 393 394 for(he = Tcl_FirstHashEntry(nc, &hs); 395 he != NULL; 396 he = Tcl_NextHashEntry(&hs)) { 397 398 Tcl_HashSearch hsc; 399 Tcl_HashEntry* hec; 400 int loc = (int) Tcl_GetHashKey (nc, he); 401 402 kv [0] = Tcl_NewIntObj (loc); 403 tablePtr = (Tcl_HashTable*) Tcl_GetHashValue (he); 404 405 for(hec = Tcl_FirstHashEntry(tablePtr, &hsc); 406 hec != NULL; 407 hec = Tcl_NextHashEntry(&hsc)) { 408 409 int symid = (int) Tcl_GetHashKey (tablePtr, hec); 410 const char* sym = rde_param_query_string (p->p, symid); 411 412 kv [1] = Tcl_NewStringObj (sym,-1); 413 414 Tcl_ListObjAppendElement (interp, res, 415 Tcl_NewListObj (2, kv)); 416 } 417 } 418 419 Tcl_SetObjResult (interp, res); 420 return TCL_OK; 421} 422 423int 424param_SYMBOLS (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 425{ 426 /* Syntax: rde symbols 427 * [0] [1] 428 */ 429 430 Tcl_HashTable* nc; 431 Tcl_Obj* res; 432 Tcl_HashSearch hs; 433 Tcl_HashEntry* he; 434 Tcl_HashTable* tablePtr; 435 Tcl_Obj* kv [2]; 436 Tcl_Obj* vv [4]; 437 438 if (objc != 2) { 439 Tcl_WrongNumArgs (interp, 2, objv, NULL); 440 return TCL_ERROR; 441 } 442 443 nc = rde_param_query_nc (p->p); 444 res = Tcl_NewListObj (0, NULL); 445 446 for(he = Tcl_FirstHashEntry(nc, &hs); 447 he != NULL; 448 he = Tcl_NextHashEntry(&hs)) { 449 450 Tcl_HashSearch hsc; 451 Tcl_HashEntry* hec; 452 int loc = (int) Tcl_GetHashKey (nc, he); 453 454 kv [0] = Tcl_NewIntObj (loc); 455 tablePtr = (Tcl_HashTable*) Tcl_GetHashValue (he); 456 457 for(hec = Tcl_FirstHashEntry(tablePtr, &hsc); 458 hec != NULL; 459 hec = Tcl_NextHashEntry(&hsc)) { 460 461 NC_STATE* scs = Tcl_GetHashValue (hec); 462 int symid = (int) Tcl_GetHashKey (tablePtr, hec); 463 const char* sym = rde_param_query_string (p->p, symid); 464 465 kv [1] = Tcl_NewStringObj (sym,-1); 466 467 vv [0] = Tcl_NewIntObj (scs->CL); 468 vv [1] = Tcl_NewIntObj (scs->ST); 469 vv [2] = rde_param_query_er_tcl (p->p, scs->ER); 470 vv [3] = (scs->SV ? scs->SV : Tcl_NewObj ()); 471 472 Tcl_ListObjAppendElement (interp, res, Tcl_NewListObj (2, kv)); 473 Tcl_ListObjAppendElement (interp, res, Tcl_NewListObj (4, vv)); 474 } 475 } 476 477 Tcl_SetObjResult (interp, res); 478 479 return TCL_OK; 480} 481 482int 483param_TOKENS (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 484{ 485 /* Syntax: rde tokens ?FROM ?TO?? 486 * [0] [1] [2] [3] 487 */ 488 489 long int num, from, to; 490 491 if ((objc < 2) || (objc > 4)) { 492 Tcl_WrongNumArgs (interp, 2, objv, "?from? ?to?"); 493 return TCL_ERROR; 494 } 495 496 num = rde_param_query_tc_size (p->p); 497 498 if (objc == 2) { 499 from = 0; 500 to = num - 1; 501 } else if (objc == 3) { 502 503 if (Tcl_GetLongFromObj (interp, objv [2], &from) != TCL_OK) { 504 return TCL_ERROR; 505 } 506 to = from; 507 508 } else { /* objc == 4 */ 509 if (Tcl_GetLongFromObj (interp, objv [2], &from) != TCL_OK) { 510 return TCL_ERROR; 511 } 512 if (Tcl_GetLongFromObj (interp, objv [3], &to) != TCL_OK) { 513 return TCL_ERROR; 514 } 515 } 516 517 if (from < 0) { from = 0; } 518 if (to >= num) { to = num-1; } 519 520 if (to < from) { 521 Tcl_SetObjResult (interp, Tcl_NewObj ()); 522 } else { 523 long int len; 524 char* buf; 525 526 rde_param_query_tc_get_s (p->p, from, to, &buf, &len); 527 528 Tcl_SetObjResult (interp, Tcl_NewStringObj (buf,len)); 529 } 530 531 return TCL_OK; 532} 533 534int 535param_VALUE (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 536{ 537 /* Syntax: rde value 538 * [0] [1] 539 */ 540 541 Tcl_Obj* sv; 542 543 if (objc != 2) { 544 Tcl_WrongNumArgs (interp, 2, objv, NULL); 545 return TCL_ERROR; 546 } 547 548 sv = rde_param_query_sv (p->p); 549 if (!sv) { 550 sv = Tcl_NewObj (); 551 } 552 553 Tcl_SetObjResult (interp, sv); 554 555 return TCL_OK; 556} 557 558/* .................................................. */ 559 560int 561param_F_continue (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 562{ 563 /* Syntax: rde i:fail_continue 564 * [0] [1] 565 */ 566 567 if (objc != 2) { 568 Tcl_WrongNumArgs (interp, 2, objv, NULL); 569 return TCL_ERROR; 570 } 571 572 if (!rde_param_query_st (p->p)) { 573 return TCL_CONTINUE; 574 } 575 576 return TCL_OK; 577} 578 579int 580param_F_return (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 581{ 582 /* Syntax: rde i:fail_return 583 * [0] [1] 584 */ 585 586 if (objc != 2) { 587 Tcl_WrongNumArgs (interp, 2, objv, NULL); 588 return TCL_ERROR; 589 } 590 591 if (!rde_param_query_st (p->p)) { 592 return TCL_RETURN; 593 } 594 595 return TCL_OK; 596} 597 598int 599param_O_continue (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 600{ 601 /* Syntax: rde i:ok_continue 602 * [0] [1] 603 */ 604 605 if (objc != 2) { 606 Tcl_WrongNumArgs (interp, 2, objv, NULL); 607 return TCL_ERROR; 608 } 609 610 if (rde_param_query_st (p->p)) { 611 return TCL_CONTINUE; 612 } 613 614 return TCL_OK; 615} 616 617int 618param_O_return (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 619{ 620 /* Syntax: rde i:ok_return 621 * [0] [1] 622 */ 623 624 if (objc != 2) { 625 Tcl_WrongNumArgs (interp, 2, objv, NULL); 626 return TCL_ERROR; 627 } 628 629 if (rde_param_query_st (p->p)) { 630 return TCL_RETURN; 631 } 632 633 return TCL_OK; 634} 635 636int 637param_I_st_fail (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 638{ 639 /* Syntax: rde i_status_fail 640 * [0] [1] 641 */ 642 643 if (objc != 2) { 644 Tcl_WrongNumArgs (interp, 2, objv, NULL); 645 return TCL_ERROR; 646 } 647 648 rde_param_i_status_fail (p->p); 649 650 return TCL_OK; 651} 652 653int 654param_I_st_neg (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 655{ 656 /* Syntax: rde i_status_negate 657 * [0] [1] 658 */ 659 660 if (objc != 2) { 661 Tcl_WrongNumArgs (interp, 2, objv, NULL); 662 return TCL_ERROR; 663 } 664 665 rde_param_i_status_negate (p->p); 666 667 return TCL_OK; 668} 669 670int 671param_I_st_ok (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 672{ 673 /* Syntax: rde i_status_ok 674 * [0] [1] 675 */ 676 677 if (objc != 2) { 678 Tcl_WrongNumArgs (interp, 2, objv, NULL); 679 return TCL_ERROR; 680 } 681 682 rde_param_i_status_ok (p->p); 683 684 return TCL_OK; 685} 686 687int 688param_I_er_clear (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 689{ 690 /* Syntax: rde i_error_clear 691 * [0] [1] 692 */ 693 694 if (objc != 2) { 695 Tcl_WrongNumArgs (interp, 2, objv, NULL); 696 return TCL_ERROR; 697 } 698 699 rde_param_i_error_clear (p->p); 700 701 return TCL_OK; 702} 703 704int 705param_I_er_clear_push (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 706{ 707 /* Syntax: rde i_error_clear 708 * [0] [1] 709 */ 710 711 if (objc != 2) { 712 Tcl_WrongNumArgs (interp, 2, objv, NULL); 713 return TCL_ERROR; 714 } 715 716 rde_param_i_error_clear (p->p); 717 rde_param_i_error_push (p->p); 718 719 return TCL_OK; 720} 721 722int 723param_I_er_nt (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 724{ 725 /* Syntax: rde i_error_nonterminal SYMBOL 726 * [0] [1] [2] 727 */ 728 729 int sym; 730 731 if (objc != 3) { 732 Tcl_WrongNumArgs (interp, 2, objv, "symbol"); 733 return TCL_ERROR; 734 } 735 736 /* 737 * interning: n + space + symbol 738 * 739 * The obj literal here is very likely shared with the arguments of 740 * i_symbol_save/restore, and i_value_leaf/reduce, and derivatives. This 741 * here is the only point between these where we save the string id in the 742 * Tcl_Obj*. 743 */ 744 745 sym = rde_ot_intern (objv [2], p, "n", NULL); 746 rde_param_i_error_nonterminal (p->p, sym); 747 748 return TCL_OK; 749} 750 751int 752param_I_er_popmerge (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 753{ 754 /* Syntax: rde i_error_pop_merge 755 * [0] [1] 756 */ 757 758 if (objc != 2) { 759 Tcl_WrongNumArgs (interp, 2, objv, NULL); 760 return TCL_ERROR; 761 } 762 763 rde_param_i_error_pop_merge (p->p); 764 765 return TCL_OK; 766} 767 768int 769param_I_er_push (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 770{ 771 /* Syntax: rde i_error_push 772 * [0] [1] 773 */ 774 775 if (objc != 2) { 776 Tcl_WrongNumArgs (interp, 2, objv, NULL); 777 return TCL_ERROR; 778 } 779 780 rde_param_i_error_push (p->p); 781 782 return TCL_OK; 783} 784 785int 786param_F_loc_pop_rewind (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 787{ 788 /* Syntax: rde i:fail_loc_pop_rewind 789 * [0] [1] 790 */ 791 792 if (objc != 2) { 793 Tcl_WrongNumArgs (interp, 2, objv, NULL); 794 return TCL_ERROR; 795 } 796 797 if (!rde_param_query_st (p->p)) { 798 rde_param_i_loc_pop_rewind (p->p); 799 } 800 801 return TCL_OK; 802} 803 804int 805param_I_loc_pop_discard (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 806{ 807 /* Syntax: rde i_loc_pop_discard 808 * [0] [1] 809 */ 810 811 if (objc != 2) { 812 Tcl_WrongNumArgs (interp, 2, objv, NULL); 813 return TCL_ERROR; 814 } 815 816 rde_param_i_loc_pop_discard (p->p); 817 818 return TCL_OK; 819} 820 821int 822param_O_loc_pop_discard (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 823{ 824 /* Syntax: rde i_loc_pop_discard 825 * [0] [1] 826 */ 827 828 if (objc != 2) { 829 Tcl_WrongNumArgs (interp, 2, objv, NULL); 830 return TCL_ERROR; 831 } 832 833 if (rde_param_query_st (p->p)) { 834 rde_param_i_loc_pop_discard (p->p); 835 } 836 837 return TCL_OK; 838} 839 840int 841param_I_loc_pop_rewdis (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 842{ 843 /* Syntax: rde i_loc_pop_rewind/discard 844 * [0] [1] 845 */ 846 847 if (objc != 2) { 848 Tcl_WrongNumArgs (interp, 2, objv, NULL); 849 return TCL_ERROR; 850 } 851 852 if (!rde_param_query_st (p->p)) { 853 rde_param_i_loc_pop_rewind (p->p); 854 } else { 855 rde_param_i_loc_pop_discard (p->p); 856 } 857 858 return TCL_OK; 859} 860 861int 862param_I_loc_pop_rewind (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 863{ 864 /* Syntax: rde i_loc_pop_rewind 865 * [0] [1] 866 */ 867 868 if (objc != 2) { 869 Tcl_WrongNumArgs (interp, 2, objv, NULL); 870 return TCL_ERROR; 871 } 872 873 rde_param_i_loc_pop_rewind (p->p); 874 875 return TCL_OK; 876} 877 878int 879param_I_loc_rewind (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 880{ 881 /* Syntax: rde i_loc_pop_rewind 882 * [0] [1] 883 */ 884 885 if (objc != 2) { 886 Tcl_WrongNumArgs (interp, 2, objv, NULL); 887 return TCL_ERROR; 888 } 889 890 rde_param_i_loc_rewind (p->p); 891 892 return TCL_OK; 893} 894 895int 896param_I_loc_push (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 897{ 898 /* Syntax: rde i_loc_pop_push 899 * [0] [1] 900 */ 901 902 if (objc != 2) { 903 Tcl_WrongNumArgs (interp, 2, objv, NULL); 904 return TCL_ERROR; 905 } 906 907 rde_param_i_loc_push (p->p); 908 909 return TCL_OK; 910} 911 912int 913param_F_ast_pop_rewind (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 914{ 915 /* Syntax: rde i:fail_ast_pop_rewind 916 * [0] [1] 917 */ 918 919 if (objc != 2) { 920 Tcl_WrongNumArgs (interp, 2, objv, NULL); 921 return TCL_ERROR; 922 } 923 924 if (!rde_param_query_st (p->p)) { 925 rde_param_i_ast_pop_rewind (p->p); 926 } 927 928 return TCL_OK; 929} 930 931int 932param_I_ast_pop_discard (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 933{ 934 /* Syntax: rde i_ast_pop_discard 935 * [0] [1] 936 */ 937 938 if (objc != 2) { 939 Tcl_WrongNumArgs (interp, 2, objv, NULL); 940 return TCL_ERROR; 941 } 942 943 rde_param_i_ast_pop_discard (p->p); 944 945 return TCL_OK; 946} 947 948int 949param_O_ast_pop_discard (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 950{ 951 /* Syntax: rde i_ast_pop_discard 952 * [0] [1] 953 */ 954 955 if (objc != 2) { 956 Tcl_WrongNumArgs (interp, 2, objv, NULL); 957 return TCL_ERROR; 958 } 959 960 if (rde_param_query_st (p->p)) { 961 rde_param_i_ast_pop_discard (p->p); 962 } 963 964 return TCL_OK; 965} 966 967int 968param_I_ast_pop_disrew (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 969{ 970 /* Syntax: rde i_ast_pop_discard/rewind 971 * [0] [1] 972 */ 973 974 if (objc != 2) { 975 Tcl_WrongNumArgs (interp, 2, objv, NULL); 976 return TCL_ERROR; 977 } 978 979 if (!rde_param_query_st (p->p)) { 980 rde_param_i_ast_pop_discard (p->p); 981 } else { 982 rde_param_i_ast_pop_rewind (p->p); 983 } 984 985 return TCL_OK; 986} 987 988int 989param_I_ast_pop_rewdis (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 990{ 991 /* Syntax: rde i_ast_pop_rewind/discard 992 * [0] [1] 993 */ 994 995 if (objc != 2) { 996 Tcl_WrongNumArgs (interp, 2, objv, NULL); 997 return TCL_ERROR; 998 } 999 1000 if (!rde_param_query_st (p->p)) { 1001 rde_param_i_ast_pop_rewind (p->p); 1002 } else { 1003 rde_param_i_ast_pop_discard (p->p); 1004 } 1005 1006 return TCL_OK; 1007} 1008 1009int 1010param_I_ast_pop_rewind (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1011{ 1012 /* Syntax: rde i_ast_pop_rewind 1013 * [0] [1] 1014 */ 1015 1016 if (objc != 2) { 1017 Tcl_WrongNumArgs (interp, 2, objv, NULL); 1018 return TCL_ERROR; 1019 } 1020 1021 rde_param_i_ast_pop_rewind (p->p); 1022 1023 return TCL_OK; 1024} 1025 1026int 1027param_I_ast_rewind (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1028{ 1029 /* Syntax: rde i_ast_pop_rewind 1030 * [0] [1] 1031 */ 1032 1033 if (objc != 2) { 1034 Tcl_WrongNumArgs (interp, 2, objv, NULL); 1035 return TCL_ERROR; 1036 } 1037 1038 rde_param_i_ast_rewind (p->p); 1039 1040 return TCL_OK; 1041} 1042 1043int 1044param_I_ast_push (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1045{ 1046 /* Syntax: rde i_ast_push 1047 * [0] [1] 1048 */ 1049 1050 if (objc != 2) { 1051 Tcl_WrongNumArgs (interp, 2, objv, NULL); 1052 return TCL_ERROR; 1053 } 1054 1055 rde_param_i_ast_push (p->p); 1056 1057 return TCL_OK; 1058} 1059 1060int 1061param_O_ast_value_push (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1062{ 1063 /* Syntax: rde i_ast_value_push 1064 * [0] [1] 1065 */ 1066 1067 if (objc != 2) { 1068 Tcl_WrongNumArgs (interp, 2, objv, NULL); 1069 return TCL_ERROR; 1070 } 1071 1072 if (rde_param_query_st (p->p)) { 1073 rde_param_i_ast_value_push (p->p); 1074 } 1075 1076 return TCL_OK; 1077} 1078 1079int 1080param_I_symbol_restore (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1081{ 1082 /* Syntax: rde i_symbol_restore SYMBOL 1083 * [0] [1] [2] 1084 */ 1085 1086 int sym, found; 1087 1088 if (objc != 3) { 1089 Tcl_WrongNumArgs (interp, 2, objv, "symbol"); 1090 return TCL_ERROR; 1091 } 1092 1093 /* 1094 * We cannot save the interned string id in the Tcl_Obj*, because this is 1095 * already taken by the argument of param_I_er_nt aka i_error_nonterminal, 1096 * due to literal sharing in procedure bodies. 1097 */ 1098 1099 sym = param_intern (p, Tcl_GetString (objv [2])); 1100 found = rde_param_i_symbol_restore (p->p, sym); 1101 Tcl_SetObjResult (interp, Tcl_NewIntObj (found)); 1102 1103 return TCL_OK; 1104} 1105 1106int 1107param_I_symbol_save (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1108{ 1109 /* Syntax: rde i_symbol_save SYMBOL 1110 * [0] [1] [2] 1111 */ 1112 1113 int sym; 1114 1115 if (objc != 3) { 1116 Tcl_WrongNumArgs (interp, 2, objv, "symbol"); 1117 return TCL_ERROR; 1118 } 1119 1120 /* 1121 * We cannot save the interned string id in the Tcl_Obj*, because this is 1122 * already taken by the argument of param_I_er_nt aka i_error_nonterminal, 1123 * due to literal sharing in procedure bodies. 1124 */ 1125 1126 sym = param_intern (p, Tcl_GetString (objv [2])); 1127 rde_param_i_symbol_save (p->p, sym); 1128 1129 return TCL_OK; 1130} 1131 1132int 1133param_I_value_cleaf (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1134{ 1135 /* Syntax: rde i_value_clear/leaf SYMBOL 1136 * [0] [1] [2] 1137 */ 1138 1139 if (objc != 3) { 1140 Tcl_WrongNumArgs (interp, 2, objv, "symbol"); 1141 return TCL_ERROR; 1142 } 1143 1144 if (!rde_param_query_st (p->p)) { 1145 rde_param_i_value_clear (p->p); 1146 } else { 1147 int sym; 1148 1149 /* 1150 * We cannot save the interned string id in the Tcl_Obj*, because this 1151 * is already taken by the argument of param_I_er_nt aka 1152 * i_error_nonterminal, due to literal sharing in procedure bodies. 1153 */ 1154 1155 sym = param_intern (p, Tcl_GetString (objv [2])); 1156 rde_param_i_value_leaf (p->p, sym); 1157 } 1158 1159 return TCL_OK; 1160} 1161 1162int 1163param_I_value_clear (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1164{ 1165 /* Syntax: rde i_value_clear 1166 * [0] [1] 1167 */ 1168 1169 if (objc != 2) { 1170 Tcl_WrongNumArgs (interp, 2, objv, NULL); 1171 return TCL_ERROR; 1172 } 1173 1174 rde_param_i_value_clear (p->p); 1175 1176 return TCL_OK; 1177} 1178 1179int 1180param_I_value_creduce (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1181{ 1182 /* Syntax: rde i_value_clear/reduce SYMBOL 1183 * [0] [1] [2] 1184 */ 1185 1186 if (objc != 3) { 1187 Tcl_WrongNumArgs (interp, 2, objv, "symbol"); 1188 return TCL_ERROR; 1189 } 1190 1191 if (!rde_param_query_st (p->p)) { 1192 rde_param_i_value_clear (p->p); 1193 } else { 1194 int sym; 1195 1196 /* 1197 * We cannot save the interned string id in the Tcl_Obj*, because this 1198 * is already taken by the argument of param_I_er_nt aka 1199 * i_error_nonterminal, due to literal sharing in procedure bodies. 1200 */ 1201 1202 sym = param_intern (p, Tcl_GetString (objv [2])); 1203 rde_param_i_value_reduce (p->p, sym); 1204 } 1205 1206 return TCL_OK; 1207} 1208 1209int 1210param_I_input_next (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1211{ 1212 /* Syntax: rde i_input_next MSG 1213 * [0] [1] [2] 1214 */ 1215 1216 int msg; 1217 1218 if (objc != 3) { 1219 Tcl_WrongNumArgs (interp, 2, objv, "msg"); 1220 return TCL_ERROR; 1221 } 1222 1223 /* 1224 * interning: msg as is. Already has PE operator in the message. 1225 */ 1226 1227 msg = rde_ot_intern (objv [2], p, NULL, NULL); 1228 rde_param_i_input_next (p->p, msg); 1229 1230 return TCL_OK; 1231} 1232 1233int 1234param_I_test_alnum (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1235{ 1236 /* Syntax: rde i_test_alnum 1237 * [0] [1] 1238 */ 1239 1240 if (objc != 2) { 1241 Tcl_WrongNumArgs (interp, 2, objv, NULL); 1242 return TCL_ERROR; 1243 } 1244 1245 rde_param_i_test_alnum (p->p); 1246 1247 return TCL_OK; 1248} 1249 1250int 1251param_I_test_alpha (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1252{ 1253 /* Syntax: rde i_test_alpha 1254 * [0] [1] 1255 */ 1256 1257 if (objc != 2) { 1258 Tcl_WrongNumArgs (interp, 2, objv, NULL); 1259 return TCL_ERROR; 1260 } 1261 1262 rde_param_i_test_alpha (p->p); 1263 1264 return TCL_OK; 1265} 1266 1267int 1268param_I_test_ascii (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1269{ 1270 /* Syntax: rde i_test_ascii 1271 * [0] [1] 1272 */ 1273 1274 if (objc != 2) { 1275 Tcl_WrongNumArgs (interp, 2, objv, NULL); 1276 return TCL_ERROR; 1277 } 1278 1279 rde_param_i_test_ascii (p->p); 1280 1281 return TCL_OK; 1282} 1283 1284int 1285param_I_test_char (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1286{ 1287 int msg; 1288 char* ch; 1289 1290 /* Syntax: rde i_test_char CHAR 1291 * [0] [1] [2] 1292 */ 1293 1294 if (objc != 3) { 1295 Tcl_WrongNumArgs (interp, 2, objv, "tok"); 1296 return TCL_ERROR; 1297 } 1298 1299 /* 1300 * interning: t + space + char 1301 */ 1302 1303 ch = Tcl_GetString (objv [2]); 1304 msg = rde_ot_intern (objv [2], p, "t", NULL); 1305 1306 rde_param_i_test_char (p->p, ch, msg); 1307 return TCL_OK; 1308} 1309 1310int 1311param_I_test_ddigit (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1312{ 1313 /* Syntax: rde i_test_ddigit 1314 * [0] [1] 1315 */ 1316 1317 if (objc != 2) { 1318 Tcl_WrongNumArgs (interp, 2, objv, NULL); 1319 return TCL_ERROR; 1320 } 1321 1322 rde_param_i_test_ddigit (p->p); 1323 1324 return TCL_OK; 1325} 1326 1327int 1328param_I_test_digit (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1329{ 1330 /* Syntax: rde i_test_digit 1331 * [0] [1] 1332 */ 1333 1334 if (objc != 2) { 1335 Tcl_WrongNumArgs (interp, 2, objv, NULL); 1336 return TCL_ERROR; 1337 } 1338 1339 rde_param_i_test_digit (p->p); 1340 1341 return TCL_OK; 1342} 1343 1344int 1345param_I_test_graph (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1346{ 1347 /* Syntax: rde i_test_graph 1348 * [0] [1] 1349 */ 1350 1351 if (objc != 2) { 1352 Tcl_WrongNumArgs (interp, 2, objv, NULL); 1353 return TCL_ERROR; 1354 } 1355 1356 rde_param_i_test_graph (p->p); 1357 1358 return TCL_OK; 1359} 1360 1361int 1362param_I_test_lower (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1363{ 1364 /* Syntax: rde i_test_lower 1365 * [0] [1] 1366 */ 1367 1368 if (objc != 2) { 1369 Tcl_WrongNumArgs (interp, 2, objv, NULL); 1370 return TCL_ERROR; 1371 } 1372 1373 rde_param_i_test_lower (p->p); 1374 1375 return TCL_OK; 1376} 1377 1378int 1379param_I_test_print (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1380{ 1381 /* Syntax: rde i_test_print 1382 * [0] [1] 1383 */ 1384 1385 if (objc != 2) { 1386 Tcl_WrongNumArgs (interp, 2, objv, NULL); 1387 return TCL_ERROR; 1388 } 1389 1390 rde_param_i_test_print (p->p); 1391 1392 return TCL_OK; 1393} 1394 1395int 1396param_I_test_punct (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1397{ 1398 /* Syntax: rde i_test_punct 1399 * [0] [1] 1400 */ 1401 1402 if (objc != 2) { 1403 Tcl_WrongNumArgs (interp, 2, objv, NULL); 1404 return TCL_ERROR; 1405 } 1406 1407 rde_param_i_test_punct (p->p); 1408 1409 return TCL_OK; 1410} 1411 1412int 1413param_I_test_range (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1414{ 1415 int msg; 1416 char* chs; 1417 char* che; 1418 1419 /* Syntax: rde i_test_range START END 1420 * [0] [1] [2] [3] 1421 */ 1422 1423 if (objc != 4) { 1424 Tcl_WrongNumArgs (interp, 2, objv, "toks toke"); 1425 return TCL_ERROR; 1426 } 1427 1428 /* 1429 * interning: .. + space + char + space + char 1430 */ 1431 1432 chs = Tcl_GetString (objv [2]); 1433 che = Tcl_GetString (objv [2]); 1434 msg = rde_ot_intern (objv [2], p, "..", che); 1435 1436 rde_param_i_test_range (p->p, chs, che, msg); 1437 1438 return TCL_OK; 1439} 1440 1441int 1442param_I_test_space (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1443{ 1444 /* Syntax: rde i_test_space 1445 * [0] [1] 1446 */ 1447 1448 if (objc != 2) { 1449 Tcl_WrongNumArgs (interp, 2, objv, NULL); 1450 return TCL_ERROR; 1451 } 1452 1453 rde_param_i_test_space (p->p); 1454 1455 return TCL_OK; 1456} 1457 1458int 1459param_I_test_upper (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1460{ 1461 /* Syntax: rde i_test_upper 1462 * [0] [1] 1463 */ 1464 1465 if (objc != 2) { 1466 Tcl_WrongNumArgs (interp, 2, objv, NULL); 1467 return TCL_ERROR; 1468 } 1469 1470 rde_param_i_test_upper (p->p); 1471 1472 return TCL_OK; 1473} 1474 1475int 1476param_I_test_wordchar (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1477{ 1478 /* Syntax: rde i_test_wordchar 1479 * [0] [1] 1480 */ 1481 1482 if (objc != 2) { 1483 Tcl_WrongNumArgs (interp, 2, objv, NULL); 1484 return TCL_ERROR; 1485 } 1486 1487 rde_param_i_test_wordchar (p->p); 1488 1489 return TCL_OK; 1490} 1491 1492int 1493param_I_test_xdigit (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1494{ 1495 /* Syntax: rde i_test_xdigit 1496 * [0] [1] 1497 */ 1498 1499 if (objc != 2) { 1500 Tcl_WrongNumArgs (interp, 2, objv, NULL); 1501 return TCL_ERROR; 1502 } 1503 1504 rde_param_i_test_xdigit (p->p); 1505 1506 return TCL_OK; 1507} 1508 1509int 1510param_SI_void_state_push (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1511{ 1512 /* Syntax: rde si:void_state_push 1513 * [0] [1] 1514 */ 1515 1516 if (objc != 2) { 1517 Tcl_WrongNumArgs (interp, 2, objv, NULL); 1518 return TCL_ERROR; 1519 } 1520 1521 rde_param_i_loc_push (p->p); 1522 rde_param_i_error_clear (p->p); 1523 rde_param_i_error_push (p->p); 1524 1525 return TCL_OK; 1526} 1527 1528int 1529param_SI_value_state_push (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1530{ 1531 /* Syntax: rde si:value_state_push 1532 * [0] [1] 1533 */ 1534 1535 if (objc != 2) { 1536 Tcl_WrongNumArgs (interp, 2, objv, NULL); 1537 return TCL_ERROR; 1538 } 1539 1540 rde_param_i_ast_push (p->p); 1541 rde_param_i_loc_push (p->p); 1542 rde_param_i_error_clear (p->p); 1543 rde_param_i_error_push (p->p); 1544 1545 return TCL_OK; 1546} 1547 1548int 1549param_SI_void_state_merge (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1550{ 1551 /* Syntax: rde si:void_state_merge 1552 * [0] [1] 1553 */ 1554 1555 if (objc != 2) { 1556 Tcl_WrongNumArgs (interp, 2, objv, NULL); 1557 return TCL_ERROR; 1558 } 1559 1560 rde_param_i_error_pop_merge (p->p); 1561 if (!rde_param_query_st (p->p)) { 1562 rde_param_i_loc_pop_rewind (p->p); 1563 } else { 1564 rde_param_i_loc_pop_discard (p->p); 1565 } 1566 1567 return TCL_OK; 1568} 1569 1570int 1571param_SI_value_state_merge (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1572{ 1573 /* Syntax: rde si:value_state_merge 1574 * [0] [1] 1575 */ 1576 1577 if (objc != 2) { 1578 Tcl_WrongNumArgs (interp, 2, objv, NULL); 1579 return TCL_ERROR; 1580 } 1581 1582 rde_param_i_error_pop_merge (p->p); 1583 if (!rde_param_query_st (p->p)) { 1584 rde_param_i_ast_pop_rewind (p->p); 1585 rde_param_i_loc_pop_rewind (p->p); 1586 } else { 1587 rde_param_i_ast_pop_discard (p->p); 1588 rde_param_i_loc_pop_discard (p->p); 1589 } 1590 1591 return TCL_OK; 1592} 1593 1594int 1595param_SI_voidvoid_branch (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1596{ 1597 /* Syntax: rde si:voidvoid_branch 1598 * [0] [1] 1599 */ 1600 1601 if (objc != 2) { 1602 Tcl_WrongNumArgs (interp, 2, objv, NULL); 1603 return TCL_ERROR; 1604 } 1605 1606 rde_param_i_error_pop_merge (p->p); 1607 if (rde_param_query_st (p->p)) { 1608 rde_param_i_loc_pop_discard (p->p); 1609 return TCL_RETURN; 1610 } 1611 rde_param_i_loc_rewind (p->p); 1612 rde_param_i_error_push (p->p); 1613 1614 return TCL_OK; 1615} 1616 1617int 1618param_SI_voidvalue_branch (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1619{ 1620 /* Syntax: rde si:voidvalue_branch 1621 * [0] [1] 1622 */ 1623 1624 if (objc != 2) { 1625 Tcl_WrongNumArgs (interp, 2, objv, NULL); 1626 return TCL_ERROR; 1627 } 1628 1629 rde_param_i_error_pop_merge (p->p); 1630 if (rde_param_query_st (p->p)) { 1631 rde_param_i_loc_pop_discard (p->p); 1632 return TCL_RETURN; 1633 } 1634 rde_param_i_ast_push (p->p); 1635 rde_param_i_loc_rewind (p->p); 1636 rde_param_i_error_push (p->p); 1637 1638 return TCL_OK; 1639} 1640 1641int 1642param_SI_valuevoid_branch (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1643{ 1644 /* Syntax: rde si:valuevoid_branch 1645 * [0] [1] 1646 */ 1647 1648 if (objc != 2) { 1649 Tcl_WrongNumArgs (interp, 2, objv, NULL); 1650 return TCL_ERROR; 1651 } 1652 1653 rde_param_i_error_pop_merge (p->p); 1654 if (rde_param_query_st (p->p)) { 1655 rde_param_i_ast_pop_discard (p->p); 1656 rde_param_i_loc_pop_discard (p->p); 1657 return TCL_RETURN; 1658 } 1659 rde_param_i_ast_pop_rewind (p->p); 1660 rde_param_i_loc_rewind (p->p); 1661 rde_param_i_error_push (p->p); 1662 1663 return TCL_OK; 1664} 1665 1666int 1667param_SI_valuevalue_branch (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1668{ 1669 /* Syntax: rde si:valuevalue:branch 1670 * [0] [1] 1671 */ 1672 1673 if (objc != 2) { 1674 Tcl_WrongNumArgs (interp, 2, objv, NULL); 1675 return TCL_ERROR; 1676 } 1677 1678 rde_param_i_error_pop_merge (p->p); 1679 if (rde_param_query_st (p->p)) { 1680 rde_param_i_ast_pop_discard (p->p); 1681 rde_param_i_loc_pop_discard (p->p); 1682 return TCL_RETURN; 1683 } 1684 rde_param_i_ast_rewind (p->p); 1685 rde_param_i_loc_rewind (p->p); 1686 rde_param_i_error_push (p->p); 1687 1688 return TCL_OK; 1689} 1690 1691int 1692param_SI_voidvoid_part (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1693{ 1694 /* Syntax: rde si:voidvoid_part 1695 * [0] [1] 1696 */ 1697 1698 if (objc != 2) { 1699 Tcl_WrongNumArgs (interp, 2, objv, NULL); 1700 return TCL_ERROR; 1701 } 1702 1703 rde_param_i_error_pop_merge (p->p); 1704 if (!rde_param_query_st (p->p)) { 1705 rde_param_i_loc_pop_rewind (p->p); 1706 return TCL_RETURN; 1707 } 1708 rde_param_i_error_push (p->p); 1709 1710 return TCL_OK; 1711} 1712 1713int 1714param_SI_voidvalue_part (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1715{ 1716 /* Syntax: rde si:voidvalue_part 1717 * [0] [1] 1718 */ 1719 1720 if (objc != 2) { 1721 Tcl_WrongNumArgs (interp, 2, objv, NULL); 1722 return TCL_ERROR; 1723 } 1724 1725 rde_param_i_error_pop_merge (p->p); 1726 if (!rde_param_query_st (p->p)) { 1727 rde_param_i_loc_pop_rewind (p->p); 1728 return TCL_RETURN; 1729 } 1730 rde_param_i_ast_push (p->p); 1731 rde_param_i_error_push (p->p); 1732 1733 return TCL_OK; 1734} 1735 1736int 1737param_SI_valuevalue_part (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1738{ 1739 /* Syntax: rde si:valuevalue_part 1740 * [0] [1] 1741 */ 1742 1743 if (objc != 2) { 1744 Tcl_WrongNumArgs (interp, 2, objv, NULL); 1745 return TCL_ERROR; 1746 } 1747 1748 rde_param_i_error_pop_merge (p->p); 1749 if (!rde_param_query_st (p->p)) { 1750 rde_param_i_ast_pop_rewind (p->p); 1751 rde_param_i_loc_pop_rewind (p->p); 1752 return TCL_RETURN; 1753 } 1754 rde_param_i_error_push (p->p); 1755 1756 return TCL_OK; 1757} 1758 1759int 1760param_SI_next_char (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1761{ 1762 int msg; 1763 char* ch; 1764 1765 /* Syntax: rde i_next_char CHAR 1766 * [0] [1] [2] 1767 */ 1768 1769 if (objc != 3) { 1770 Tcl_WrongNumArgs (interp, 2, objv, "tok"); 1771 return TCL_ERROR; 1772 } 1773 1774 /* 1775 * interning: t + space + char 1776 */ 1777 1778 ch = Tcl_GetString (objv [2]); 1779 msg = rde_ot_intern (objv [2], p, "t", NULL); 1780 1781 rde_param_i_input_next (p->p, msg); 1782 if (rde_param_query_st (p->p)) { 1783 rde_param_i_test_char (p->p, ch, msg); 1784 } 1785 return TCL_OK; 1786} 1787 1788int 1789param_SI_next_range (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1790{ 1791 int msg; 1792 char* chs; 1793 char* che; 1794 1795 /* Syntax: rde i_next_range START END 1796 * [0] [1] [2] [3] 1797 */ 1798 1799 if (objc != 4) { 1800 Tcl_WrongNumArgs (interp, 2, objv, "toks toke"); 1801 return TCL_ERROR; 1802 } 1803 1804 /* 1805 * interning: .. + space + char + space + char 1806 */ 1807 1808 chs = Tcl_GetString (objv [2]); 1809 che = Tcl_GetString (objv [2]); 1810 msg = rde_ot_intern (objv [2], p, "..", che); 1811 1812 rde_param_i_input_next (p->p, msg); 1813 if (rde_param_query_st (p->p)) { 1814 rde_param_i_test_range (p->p, chs, che, msg); 1815 } 1816 return TCL_OK; 1817} 1818 1819int 1820param_SI_next_alnum (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1821{ 1822 /* Syntax: rde si:next_alnum 1823 * [0] [1] 1824 */ 1825 1826 int msg; 1827 1828 if (objc != 2) { 1829 Tcl_WrongNumArgs (interp, 2, objv, NULL); 1830 return TCL_ERROR; 1831 } 1832 1833 msg = param_intern (p, "alnum"); 1834 1835 rde_param_i_input_next (p->p, msg); 1836 if (rde_param_query_st (p->p)) { 1837 rde_param_i_test_alnum (p->p); 1838 } 1839 return TCL_OK; 1840} 1841 1842int 1843param_SI_next_alpha (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1844{ 1845 /* Syntax: rde si:next_alpha 1846 * [0] [1] 1847 */ 1848 1849 int msg; 1850 1851 if (objc != 2) { 1852 Tcl_WrongNumArgs (interp, 2, objv, NULL); 1853 return TCL_ERROR; 1854 } 1855 1856 msg = param_intern (p, "alpha"); 1857 1858 rde_param_i_input_next (p->p, msg); 1859 if (rde_param_query_st (p->p)) { 1860 rde_param_i_test_alpha (p->p); 1861 } 1862 return TCL_OK; 1863} 1864 1865int 1866param_SI_next_ascii (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1867{ 1868 /* Syntax: rde si:next_ascii 1869 * [0] [1] 1870 */ 1871 1872 int msg; 1873 1874 if (objc != 2) { 1875 Tcl_WrongNumArgs (interp, 2, objv, NULL); 1876 return TCL_ERROR; 1877 } 1878 1879 msg = param_intern (p, "ascii"); 1880 1881 rde_param_i_input_next (p->p, msg); 1882 if (rde_param_query_st (p->p)) { 1883 rde_param_i_test_ascii (p->p); 1884 } 1885 return TCL_OK; 1886} 1887 1888int 1889param_SI_next_ddigit (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1890{ 1891 /* Syntax: rde si:next_ddigit 1892 * [0] [1] 1893 */ 1894 1895 int msg; 1896 1897 if (objc != 2) { 1898 Tcl_WrongNumArgs (interp, 2, objv, NULL); 1899 return TCL_ERROR; 1900 } 1901 1902 msg = param_intern (p, "ddigit"); 1903 1904 rde_param_i_input_next (p->p, msg); 1905 if (rde_param_query_st (p->p)) { 1906 rde_param_i_test_ddigit (p->p); 1907 } 1908 return TCL_OK; 1909} 1910 1911int 1912param_SI_next_digit (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1913{ 1914 /* Syntax: rde si:next_digit 1915 * [0] [1] 1916 */ 1917 1918 int msg; 1919 1920 if (objc != 2) { 1921 Tcl_WrongNumArgs (interp, 2, objv, NULL); 1922 return TCL_ERROR; 1923 } 1924 1925 msg = param_intern (p, "digit"); 1926 1927 rde_param_i_input_next (p->p, msg); 1928 if (rde_param_query_st (p->p)) { 1929 rde_param_i_test_digit (p->p); 1930 } 1931 return TCL_OK; 1932} 1933 1934int 1935param_SI_next_graph (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1936{ 1937 /* Syntax: rde si:next_graph 1938 * [0] [1] 1939 */ 1940 1941 int msg; 1942 1943 if (objc != 2) { 1944 Tcl_WrongNumArgs (interp, 2, objv, NULL); 1945 return TCL_ERROR; 1946 } 1947 1948 msg = param_intern (p, "graph"); 1949 1950 rde_param_i_input_next (p->p, msg); 1951 if (rde_param_query_st (p->p)) { 1952 rde_param_i_test_graph (p->p); 1953 } 1954 return TCL_OK; 1955} 1956 1957int 1958param_SI_next_lower (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1959{ 1960 /* Syntax: rde si:next_lower 1961 * [0] [1] 1962 */ 1963 1964 int msg; 1965 1966 if (objc != 2) { 1967 Tcl_WrongNumArgs (interp, 2, objv, NULL); 1968 return TCL_ERROR; 1969 } 1970 1971 msg = param_intern (p, "lower"); 1972 1973 rde_param_i_input_next (p->p, msg); 1974 if (rde_param_query_st (p->p)) { 1975 rde_param_i_test_lower (p->p); 1976 } 1977 return TCL_OK; 1978} 1979 1980int 1981param_SI_next_print (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1982{ 1983 /* Syntax: rde si:next_print 1984 * [0] [1] 1985 */ 1986 1987 int msg; 1988 1989 if (objc != 2) { 1990 Tcl_WrongNumArgs (interp, 2, objv, NULL); 1991 return TCL_ERROR; 1992 } 1993 1994 msg = param_intern (p, "print"); 1995 1996 rde_param_i_input_next (p->p, msg); 1997 if (rde_param_query_st (p->p)) { 1998 rde_param_i_test_print (p->p); 1999 } 2000 return TCL_OK; 2001} 2002 2003int 2004param_SI_next_punct (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 2005{ 2006 /* Syntax: rde si:next_punct 2007 * [0] [1] 2008 */ 2009 2010 int msg; 2011 2012 if (objc != 2) { 2013 Tcl_WrongNumArgs (interp, 2, objv, NULL); 2014 return TCL_ERROR; 2015 } 2016 2017 msg = param_intern (p, "punct"); 2018 2019 rde_param_i_input_next (p->p, msg); 2020 if (rde_param_query_st (p->p)) { 2021 rde_param_i_test_punct (p->p); 2022 } 2023 return TCL_OK; 2024} 2025 2026int 2027param_SI_next_space (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 2028{ 2029 /* Syntax: rde si:next_space 2030 * [0] [1] 2031 */ 2032 2033 int msg; 2034 2035 if (objc != 2) { 2036 Tcl_WrongNumArgs (interp, 2, objv, NULL); 2037 return TCL_ERROR; 2038 } 2039 2040 msg = param_intern (p, "space"); 2041 2042 rde_param_i_input_next (p->p, msg); 2043 if (rde_param_query_st (p->p)) { 2044 rde_param_i_test_space (p->p); 2045 } 2046 return TCL_OK; 2047} 2048 2049int 2050param_SI_next_upper (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 2051{ 2052 /* Syntax: rde si:next_upper 2053 * [0] [1] 2054 */ 2055 2056 int msg; 2057 2058 if (objc != 2) { 2059 Tcl_WrongNumArgs (interp, 2, objv, NULL); 2060 return TCL_ERROR; 2061 } 2062 2063 msg = param_intern (p, "upper"); 2064 2065 rde_param_i_input_next (p->p, msg); 2066 if (rde_param_query_st (p->p)) { 2067 rde_param_i_test_upper (p->p); 2068 } 2069 return TCL_OK; 2070} 2071 2072int 2073param_SI_next_wordchar (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 2074{ 2075 /* Syntax: rde si:next_wordchar 2076 * [0] [1] 2077 */ 2078 2079 int msg; 2080 2081 if (objc != 2) { 2082 Tcl_WrongNumArgs (interp, 2, objv, NULL); 2083 return TCL_ERROR; 2084 } 2085 2086 msg = param_intern (p, "wordchar"); 2087 2088 rde_param_i_input_next (p->p, msg); 2089 if (rde_param_query_st (p->p)) { 2090 rde_param_i_test_wordchar (p->p); 2091 } 2092 return TCL_OK; 2093} 2094 2095int 2096param_SI_next_xdigit (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 2097{ 2098 /* Syntax: rde si:next_xdigit 2099 * [0] [1] 2100 */ 2101 2102 int msg; 2103 2104 if (objc != 2) { 2105 Tcl_WrongNumArgs (interp, 2, objv, NULL); 2106 return TCL_ERROR; 2107 } 2108 2109 msg = param_intern (p, "xdigit"); 2110 2111 rde_param_i_input_next (p->p, msg); 2112 if (rde_param_query_st (p->p)) { 2113 rde_param_i_test_xdigit (p->p); 2114 } 2115 return TCL_OK; 2116} 2117 2118int 2119param_SI_void2_state_push (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 2120{ 2121 /* Syntax: rde si:void2_state_push 2122 * [0] [1] 2123 */ 2124 2125 if (objc != 2) { 2126 Tcl_WrongNumArgs (interp, 2, objv, NULL); 2127 return TCL_ERROR; 2128 } 2129 2130 rde_param_i_loc_push (p->p); 2131 rde_param_i_error_push (p->p); 2132 2133 return TCL_OK; 2134} 2135 2136int 2137param_SI_void_state_merge_ok (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 2138{ 2139 /* Syntax: rde si:void_state_merge_ok 2140 * [0] [1] 2141 */ 2142 2143 if (objc != 2) { 2144 Tcl_WrongNumArgs (interp, 2, objv, NULL); 2145 return TCL_ERROR; 2146 } 2147 2148 rde_param_i_error_pop_merge (p->p); 2149 if (!rde_param_query_st (p->p)) { 2150 rde_param_i_loc_pop_rewind (p->p); 2151 rde_param_i_status_ok (p->p); 2152 } else { 2153 rde_param_i_loc_pop_discard (p->p); 2154 } 2155 2156 return TCL_OK; 2157} 2158 2159int 2160param_SI_value_notahead_start (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 2161{ 2162 /* Syntax: rde si:void_notahead_start 2163 * [0] [1] 2164 */ 2165 2166 if (objc != 2) { 2167 Tcl_WrongNumArgs (interp, 2, objv, NULL); 2168 return TCL_ERROR; 2169 } 2170 2171 rde_param_i_loc_push (p->p); 2172 rde_param_i_ast_push (p->p); 2173 2174 return TCL_OK; 2175} 2176 2177int 2178param_SI_void_notahead_exit (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 2179{ 2180 /* Syntax: rde si:void_notahead_exit 2181 * [0] [1] 2182 */ 2183 2184 if (objc != 2) { 2185 Tcl_WrongNumArgs (interp, 2, objv, NULL); 2186 return TCL_ERROR; 2187 } 2188 2189 rde_param_i_loc_pop_rewind (p->p); 2190 rde_param_i_status_negate (p->p); 2191 2192 return TCL_OK; 2193} 2194 2195int 2196param_SI_value_notahead_exit (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 2197{ 2198 /* Syntax: rde si:value_notahead_exit 2199 * [0] [1] 2200 */ 2201 2202 if (objc != 2) { 2203 Tcl_WrongNumArgs (interp, 2, objv, NULL); 2204 return TCL_ERROR; 2205 } 2206 2207 rde_param_i_loc_pop_rewind (p->p); 2208 if (rde_param_query_st (p->p)) { 2209 rde_param_i_ast_pop_rewind (p->p); 2210 } else { 2211 rde_param_i_ast_pop_discard (p->p); 2212 } 2213 rde_param_i_status_negate (p->p); 2214 2215 return TCL_OK; 2216} 2217 2218int 2219param_SI_kleene_abort (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 2220{ 2221 /* Syntax: rde si:kleene_abort 2222 * [0] [1] 2223 */ 2224 2225 if (objc != 2) { 2226 Tcl_WrongNumArgs (interp, 2, objv, NULL); 2227 return TCL_ERROR; 2228 } 2229 2230 if (rde_param_query_st (p->p)) { 2231 rde_param_i_loc_pop_discard (p->p); 2232 return TCL_OK; 2233 } else { 2234 rde_param_i_loc_pop_rewind (p->p); 2235 return TCL_RETURN; 2236 } 2237} 2238 2239int 2240param_SI_kleene_close (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 2241{ 2242 /* Syntax: rde si:kleene_close 2243 * [0] [1] 2244 */ 2245 2246 if (objc != 2) { 2247 Tcl_WrongNumArgs (interp, 2, objv, NULL); 2248 return TCL_ERROR; 2249 } 2250 2251 rde_param_i_error_pop_merge (p->p); 2252 if (rde_param_query_st (p->p)) { 2253 rde_param_i_loc_pop_discard (p->p); 2254 return TCL_OK; 2255 } else { 2256 rde_param_i_loc_pop_rewind (p->p); 2257 rde_param_i_status_ok (p->p); 2258 return TCL_RETURN; 2259 } 2260} 2261 2262int 2263param_SI_value_symbol_start (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 2264{ 2265 /* Syntax: rde si:value_symbol_start SYMBOL 2266 * [0] [1] [2] 2267 */ 2268 2269 int sym, found; 2270 2271 if (objc != 3) { 2272 Tcl_WrongNumArgs (interp, 2, objv, "symbol"); 2273 return TCL_ERROR; 2274 } 2275 2276 /* 2277 * We cannot save the interned string id in the Tcl_Obj*, because this is 2278 * already taken by the argument of param_I_er_nt aka i_error_nonterminal, 2279 * due to literal sharing in procedure bodies. 2280 */ 2281 2282 sym = param_intern (p, Tcl_GetString (objv [2])); 2283 2284 found = rde_param_i_symbol_restore (p->p, sym); 2285 if (found) { 2286 if (rde_param_query_st (p->p)) { 2287 rde_param_i_ast_value_push (p->p); 2288 } 2289 return TCL_RETURN; 2290 } 2291 2292 rde_param_i_loc_push (p->p); 2293 rde_param_i_ast_push (p->p); 2294 return TCL_OK; 2295} 2296 2297int 2298param_SI_value_void_symbol_start (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 2299{ 2300 /* Syntax: rde si:value_void_symbol_start SYMBOL 2301 * [0] [1] [2] 2302 */ 2303 2304 int sym, found; 2305 2306 if (objc != 3) { 2307 Tcl_WrongNumArgs (interp, 2, objv, "symbol"); 2308 return TCL_ERROR; 2309 } 2310 2311 /* 2312 * We cannot save the interned string id in the Tcl_Obj*, because this is 2313 * already taken by the argument of param_I_er_nt aka i_error_nonterminal, 2314 * due to literal sharing in procedure bodies. 2315 */ 2316 2317 sym = param_intern (p, Tcl_GetString (objv [2])); 2318 2319 found = rde_param_i_symbol_restore (p->p, sym); 2320 if (found) { 2321 return TCL_RETURN; 2322 } 2323 2324 rde_param_i_loc_push (p->p); 2325 rde_param_i_ast_push (p->p); 2326 return TCL_OK; 2327} 2328 2329int 2330param_SI_void_symbol_start (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 2331{ 2332 /* Syntax: rde si:void_symbol_start SYMBOL 2333 * [0] [1] [2] 2334 */ 2335 2336 int sym, found; 2337 2338 if (objc != 3) { 2339 Tcl_WrongNumArgs (interp, 2, objv, "symbol"); 2340 return TCL_ERROR; 2341 } 2342 2343 /* 2344 * We cannot save the interned string id in the Tcl_Obj*, because this is 2345 * already taken by the argument of param_I_er_nt aka i_error_nonterminal, 2346 * due to literal sharing in procedure bodies. 2347 */ 2348 2349 sym = param_intern (p, Tcl_GetString (objv [2])); 2350 2351 found = rde_param_i_symbol_restore (p->p, sym); 2352 if (found) { 2353 if (rde_param_query_st (p->p)) { 2354 rde_param_i_ast_value_push (p->p); 2355 } 2356 return TCL_RETURN; 2357 } 2358 2359 rde_param_i_loc_push (p->p); 2360 return TCL_OK; 2361} 2362 2363int 2364param_SI_void_void_symbol_start (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 2365{ 2366 /* Syntax: rde si:void_void_symbol_start SYMBOL 2367 * [0] [1] [2] 2368 */ 2369 2370 int sym, found; 2371 2372 if (objc != 3) { 2373 Tcl_WrongNumArgs (interp, 2, objv, "symbol"); 2374 return TCL_ERROR; 2375 } 2376 2377 /* 2378 * We cannot save the interned string id in the Tcl_Obj*, because this is 2379 * already taken by the argument of param_I_er_nt aka i_error_nonterminal, 2380 * due to literal sharing in procedure bodies. 2381 */ 2382 2383 sym = param_intern (p, Tcl_GetString (objv [2])); 2384 2385 found = rde_param_i_symbol_restore (p->p, sym); 2386 if (found) { 2387 return TCL_RETURN; 2388 } 2389 2390 rde_param_i_loc_push (p->p); 2391 return TCL_OK; 2392} 2393 2394int 2395param_SI_reduce_symbol_end (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 2396{ 2397 /* Syntax: rde si:reduce_symbol_end SYMBOL 2398 * [0] [1] [2] 2399 */ 2400 2401 int sym, msg; 2402 2403 if (objc != 3) { 2404 Tcl_WrongNumArgs (interp, 2, objv, "symbol"); 2405 return TCL_ERROR; 2406 } 2407 2408 /* 2409 * We cannot save the interned string id in the Tcl_Obj*, because this is 2410 * already taken by the argument of param_I_er_nt aka i_error_nonterminal, 2411 * due to literal sharing in procedure bodies. 2412 */ 2413 2414 sym = param_intern (p, Tcl_GetString (objv [2])); 2415 2416 if (!rde_param_query_st (p->p)) { 2417 rde_param_i_value_clear (p->p); 2418 } else { 2419 rde_param_i_value_reduce (p->p, sym); 2420 } 2421 2422 rde_param_i_symbol_save (p->p, sym); 2423 2424 /* 2425 * interning: n + space + symbol 2426 * 2427 * The obj literal here is very likely shared with the arguments of 2428 * i_symbol_save/restore, and i_value_leaf/reduce, and derivatives. This 2429 * here is the only point between these where we save the string id in the 2430 * Tcl_Obj*. 2431 */ 2432 2433 msg = rde_ot_intern (objv [2], p, "n", NULL); 2434 2435 rde_param_i_error_nonterminal (p->p, msg); 2436 rde_param_i_ast_pop_rewind (p->p); 2437 rde_param_i_loc_pop_discard (p->p); 2438 2439 if (rde_param_query_st (p->p)) { 2440 rde_param_i_ast_value_push (p->p); 2441 } 2442 2443 return TCL_OK; 2444} 2445 2446int 2447param_SI_void_leaf_symbol_end (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 2448{ 2449 /* Syntax: rde si:void_leaf_symbol_end SYMBOL 2450 * [0] [1] [2] 2451 */ 2452 2453 int sym, msg; 2454 2455 if (objc != 3) { 2456 Tcl_WrongNumArgs (interp, 2, objv, "symbol"); 2457 return TCL_ERROR; 2458 } 2459 2460 /* 2461 * We cannot save the interned string id in the Tcl_Obj*, because this is 2462 * already taken by the argument of param_I_er_nt aka i_error_nonterminal, 2463 * due to literal sharing in procedure bodies. 2464 */ 2465 2466 sym = param_intern (p, Tcl_GetString (objv [2])); 2467 2468 if (!rde_param_query_st (p->p)) { 2469 rde_param_i_value_clear (p->p); 2470 } else { 2471 rde_param_i_value_leaf (p->p, sym); 2472 } 2473 2474 rde_param_i_symbol_save (p->p, sym); 2475 2476 /* 2477 * interning: n + space + symbol 2478 * 2479 * The obj literal here is very likely shared with the arguments of 2480 * i_symbol_save/restore, and i_value_leaf/reduce, and derivatives. This 2481 * here is the only point between these where we save the string id in the 2482 * Tcl_Obj*. 2483 */ 2484 2485 msg = rde_ot_intern (objv [2], p, "n", NULL); 2486 2487 rde_param_i_error_nonterminal (p->p, msg); 2488 rde_param_i_loc_pop_discard (p->p); 2489 2490 if (rde_param_query_st (p->p)) { 2491 rde_param_i_ast_value_push (p->p); 2492 } 2493 2494 return TCL_OK; 2495} 2496 2497int 2498param_SI_value_leaf_symbol_end (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 2499{ 2500 /* Syntax: rde si:value_leaf_symbol_end SYMBOL 2501 * [0] [1] [2] 2502 */ 2503 2504 int sym, msg; 2505 2506 if (objc != 3) { 2507 Tcl_WrongNumArgs (interp, 2, objv, "symbol"); 2508 return TCL_ERROR; 2509 } 2510 2511 /* 2512 * We cannot save the interned string id in the Tcl_Obj*, because this is 2513 * already taken by the argument of param_I_er_nt aka i_error_nonterminal, 2514 * due to literal sharing in procedure bodies. 2515 */ 2516 2517 sym = param_intern (p, Tcl_GetString (objv [2])); 2518 2519 if (!rde_param_query_st (p->p)) { 2520 rde_param_i_value_clear (p->p); 2521 } else { 2522 rde_param_i_value_leaf (p->p, sym); 2523 } 2524 2525 rde_param_i_symbol_save (p->p, sym); 2526 2527 /* 2528 * interning: n + space + symbol 2529 * 2530 * The obj literal here is very likely shared with the arguments of 2531 * i_symbol_save/restore, and i_value_leaf/reduce, and derivatives. This 2532 * here is the only point between these where we save the string id in the 2533 * Tcl_Obj*. 2534 */ 2535 2536 msg = rde_ot_intern (objv [2], p, "n", NULL); 2537 2538 rde_param_i_error_nonterminal (p->p, msg); 2539 rde_param_i_ast_pop_rewind (p->p); 2540 rde_param_i_loc_pop_discard (p->p); 2541 2542 if (rde_param_query_st (p->p)) { 2543 rde_param_i_ast_value_push (p->p); 2544 } 2545 2546 return TCL_OK; 2547} 2548 2549int 2550param_SI_value_clear_symbol_end (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 2551{ 2552 /* Syntax: rde si:value_clear_symbol_end SYMBOL 2553 * [0] [1] [2] 2554 */ 2555 2556 int sym, msg; 2557 2558 if (objc != 3) { 2559 Tcl_WrongNumArgs (interp, 2, objv, "symbol"); 2560 return TCL_ERROR; 2561 } 2562 2563 /* 2564 * We cannot save the interned string id in the Tcl_Obj*, because this is 2565 * already taken by the argument of param_I_er_nt aka i_error_nonterminal, 2566 * due to literal sharing in procedure bodies. 2567 */ 2568 2569 sym = param_intern (p, Tcl_GetString (objv [2])); 2570 2571 rde_param_i_value_clear (p->p); 2572 rde_param_i_symbol_save (p->p, sym); 2573 2574 /* 2575 * interning: n + space + symbol 2576 * 2577 * The obj literal here is very likely shared with the arguments of 2578 * i_symbol_save/restore, and i_value_leaf/reduce, and derivatives. This 2579 * here is the only point between these where we save the string id in the 2580 * Tcl_Obj*. 2581 */ 2582 2583 msg = rde_ot_intern (objv [2], p, "n", NULL); 2584 2585 rde_param_i_error_nonterminal (p->p, msg); 2586 rde_param_i_ast_pop_rewind (p->p); 2587 rde_param_i_loc_pop_discard (p->p); 2588 2589 return TCL_OK; 2590} 2591 2592int 2593param_SI_void_clear_symbol_end (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 2594{ 2595 /* Syntax: rde si:void_clear_symbol_end SYMBOL 2596 * [0] [1] [2] 2597 */ 2598 2599 int sym, msg; 2600 2601 if (objc != 3) { 2602 Tcl_WrongNumArgs (interp, 2, objv, "symbol"); 2603 return TCL_ERROR; 2604 } 2605 2606 /* 2607 * We cannot save the interned string id in the Tcl_Obj*, because this is 2608 * already taken by the argument of param_I_er_nt aka i_error_nonterminal, 2609 * due to literal sharing in procedure bodies. 2610 */ 2611 2612 sym = param_intern (p, Tcl_GetString (objv [2])); 2613 2614 rde_param_i_value_clear (p->p); 2615 rde_param_i_symbol_save (p->p, sym); 2616 2617 /* 2618 * interning: n + space + symbol 2619 * 2620 * The obj literal here is very likely shared with the arguments of 2621 * i_symbol_save/restore, and i_value_leaf/reduce, and derivatives. This 2622 * here is the only point between these where we save the string id in the 2623 * Tcl_Obj*. 2624 */ 2625 2626 msg = rde_ot_intern (objv [2], p, "n", NULL); 2627 2628 rde_param_i_error_nonterminal (p->p, msg); 2629 rde_param_i_loc_pop_discard (p->p); 2630 2631 return TCL_OK; 2632} 2633 2634int 2635param_SI_next_str (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 2636{ 2637 int msg, len, i; 2638 char* str; 2639 2640 /* Syntax: rde i_next_char CHAR 2641 * [0] [1] [2] 2642 */ 2643 2644 if (objc != 3) { 2645 Tcl_WrongNumArgs (interp, 2, objv, "tok"); 2646 return TCL_ERROR; 2647 } 2648 2649 /* 2650 * interning: str + space + char 2651 */ 2652 2653 str = Tcl_GetStringFromObj (objv [2], &len); 2654 msg = rde_ot_intern (objv [2], p, "str", NULL); 2655 2656 rde_param_i_next_str (p->p, str, msg); 2657 return TCL_OK; 2658} 2659 2660int 2661param_SI_next_class (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 2662{ 2663 int msg, len, i; 2664 char* class; 2665 2666 /* Syntax: rde i_next_char CHAR 2667 * [0] [1] [2] 2668 */ 2669 2670 if (objc != 3) { 2671 Tcl_WrongNumArgs (interp, 2, objv, "tok"); 2672 return TCL_ERROR; 2673 } 2674 2675 /* 2676 * interning: cl + space + char 2677 */ 2678 2679 class = Tcl_GetStringFromObj (objv [2], &len); 2680 msg = rde_ot_intern (objv [2], p, "cl", NULL); 2681 2682 rde_param_i_next_class (p->p, class, msg); 2683 return TCL_OK; 2684} 2685 2686 2687/* 2688 * Local Variables: 2689 * mode: c 2690 * c-basic-offset: 4 2691 * fill-column: 78 2692 * End: 2693 */ 2694