1## -*- tcl -*- 2## 3## Critcl-based C/PARAM implementation of the parsing 4## expression grammar 5## 6## TEMPLATE 7## 8## Generated from file TEST 9## for user unknown 10## 11# # ## ### ##### ######## ############# ##################### 12## Requirements 13 14package require Tcl 8.4 15package require critcl 16# @sak notprovided PACKAGE 17package provide PACKAGE 1 18 19# Note: The implementation of the PARAM virtual machine 20# underlying the C/PARAM code used below is inlined 21# into the generated parser, allowing for direct access 22# and manipulation of the RDE state, instead of having 23# to dispatch through the Tcl interpreter. 24 25# # ## ### ##### ######## ############# ##################### 26## 27 28namespace eval ::PARSER { 29 # # ## ### ##### ######## ############# ##################### 30 ## Supporting code for the main command. 31 32 catch { 33 #critcl::cflags -g 34 #critcl::debug memory symbols 35 } 36 37 # # ## ### ###### ######## ############# 38 ## RDE runtime, inlined, and made static. 39 40 # This is the C code for the RDE, i.e. the implementation 41 # of pt::rde. Only the low-level engine is imported, the 42 # Tcl interface layer is ignored. This generated parser 43 # provides its own layer for that. 44 45 critcl::ccode { 46 /* -*- c -*- */ 47 48 #include <stdint.h> 49 #include <stdlib.h> 50 #include <string.h> 51 #define SCOPE static 52 53#line 1 "rde_critcl/util.h" 54 55 #ifndef _RDE_UTIL_H 56 #define _RDE_UTIL_H 1 57 #ifndef SCOPE 58 #define SCOPE 59 #endif 60 #define ALLOC(type) (type *) ckalloc (sizeof (type)) 61 #define NALLOC(n,type) (type *) ckalloc ((n) * sizeof (type)) 62 #undef RDE_DEBUG 63 #define RDE_DEBUG 1 64 #undef RDE_TRACE 65 #ifdef RDE_DEBUG 66 #define STOPAFTER(x) { static int count = (x); count --; if (!count) { Tcl_Panic ("stop"); } } 67 #define XSTR(x) #x 68 #define STR(x) XSTR(x) 69 #define RANGEOK(i,n) ((0 <= (i)) && (i < (n))) 70 #define ASSERT(x,msg) if (!(x)) { Tcl_Panic (msg " (" #x "), in file " __FILE__ " @line " STR(__LINE__));} 71 #define ASSERT_BOUNDS(i,n) ASSERT (RANGEOK(i,n),"array index out of bounds: " STR(i) " >= " STR(n)) 72 #else 73 #define STOPAFTER(x) 74 #define ASSERT(x,msg) 75 #define ASSERT_BOUNDS(i,n) 76 #endif 77 #ifdef RDE_TRACE 78 SCOPE void trace_enter (const char* fun); 79 SCOPE void trace_return (const char *pat, ...); 80 SCOPE void trace_printf (const char *pat, ...); 81 #define ENTER(fun) trace_enter (fun) 82 #define RETURN(format,x) trace_return (format,x) ; return x 83 #define RETURNVOID trace_return ("%s","(void)") ; return 84 #define TRACE0(x) trace_printf0 x 85 #define TRACE(x) trace_printf x 86 #else 87 #define ENTER(fun) 88 #define RETURN(f,x) return x 89 #define RETURNVOID return 90 #define TRACE0(x) 91 #define TRACE(x) 92 #endif 93 #endif 94 95 96#line 1 "rde_critcl/stack.h" 97 98 #ifndef _RDE_DS_STACK_H 99 #define _RDE_DS_STACK_H 1 100 typedef void (*RDE_STACK_CELL_FREE) (void* cell); 101 typedef struct RDE_STACK_* RDE_STACK; 102 static const int RDE_STACK_INITIAL_SIZE = 256; 103 #endif 104 105 106#line 1 "rde_critcl/tc.h" 107 108 #ifndef _RDE_DS_TC_H 109 #define _RDE_DS_TC_H 1 110 typedef struct RDE_TC_* RDE_TC; 111 #endif 112 113 114#line 1 "rde_critcl/param.h" 115 116 #ifndef _RDE_DS_PARAM_H 117 #define _RDE_DS_PARAM_H 1 118 typedef struct RDE_PARAM_* RDE_PARAM; 119 typedef struct ERROR_STATE { 120 int refCount; 121 long int loc; 122 RDE_STACK msg; 123 } ERROR_STATE; 124 typedef struct NC_STATE { 125 long int CL; 126 long int ST; 127 Tcl_Obj* SV; 128 ERROR_STATE* ER; 129 } NC_STATE; 130 #endif 131 132 133#line 1 "rde_critcl/util.c" 134 135 #ifdef RDE_TRACE 136 typedef struct F_STACK { 137 const char* str; 138 struct F_STACK* down; 139 } F_STACK; 140 static F_STACK* top = 0; 141 static int level = 0; 142 static void 143 push (const char* str) 144 { 145 F_STACK* new = ALLOC (F_STACK); 146 new->str = str; 147 new->down = top; 148 top = new; 149 level += 4; 150 } 151 static void 152 pop (void) 153 { 154 F_STACK* next = top->down; 155 level -= 4; 156 ckfree ((char*)top); 157 top = next; 158 } 159 static void 160 indent (void) 161 { 162 int i; 163 for (i = 0; i < level; i++) { 164 fwrite(" ", 1, 1, stdout); 165 fflush (stdout); 166 } 167 if (top) { 168 fwrite(top->str, 1, strlen(top->str), stdout); 169 fflush (stdout); 170 } 171 fwrite(" ", 1, 1, stdout); 172 fflush (stdout); 173 } 174 SCOPE void 175 trace_enter (const char* fun) 176 { 177 push (fun); 178 indent(); 179 fwrite("ENTER\n", 1, 6, stdout); 180 fflush (stdout); 181 } 182 static char msg [1024*1024]; 183 SCOPE void 184 trace_return (const char *pat, ...) 185 { 186 int len; 187 va_list args; 188 indent(); 189 fwrite("RETURN = ", 1, 9, stdout); 190 fflush (stdout); 191 va_start(args, pat); 192 len = vsprintf(msg, pat, args); 193 va_end(args); 194 msg[len++] = '\n'; 195 msg[len] = '\0'; 196 fwrite(msg, 1, len, stdout); 197 fflush (stdout); 198 pop(); 199 } 200 SCOPE void 201 trace_printf (const char *pat, ...) 202 { 203 int len; 204 va_list args; 205 indent(); 206 va_start(args, pat); 207 len = vsprintf(msg, pat, args); 208 va_end(args); 209 msg[len++] = '\n'; 210 msg[len] = '\0'; 211 fwrite(msg, 1, len, stdout); 212 fflush (stdout); 213 } 214 SCOPE void 215 trace_printf0 (const char *pat, ...) 216 { 217 int len; 218 va_list args; 219 va_start(args, pat); 220 len = vsprintf(msg, pat, args); 221 va_end(args); 222 msg[len++] = '\n'; 223 msg[len] = '\0'; 224 fwrite(msg, 1, len, stdout); 225 fflush (stdout); 226 } 227 #endif 228 229 230#line 1 "rde_critcl/stack.c" 231 232 typedef struct RDE_STACK_ { 233 long int max; 234 long int top; 235 RDE_STACK_CELL_FREE freeCellProc; 236 void** cell; 237 } RDE_STACK_; 238 239 SCOPE RDE_STACK 240 rde_stack_new (RDE_STACK_CELL_FREE freeCellProc) 241 { 242 RDE_STACK s = ALLOC (RDE_STACK_); 243 s->cell = NALLOC (RDE_STACK_INITIAL_SIZE, void*); 244 s->max = RDE_STACK_INITIAL_SIZE; 245 s->top = 0; 246 s->freeCellProc = freeCellProc; 247 return s; 248 } 249 SCOPE void 250 rde_stack_del (RDE_STACK s) 251 { 252 if (s->freeCellProc && s->top) { 253 long int i; 254 for (i=0; i < s->top; i++) { 255 ASSERT_BOUNDS(i,s->max); 256 s->freeCellProc ( s->cell [i] ); 257 } 258 } 259 ckfree ((char*) s->cell); 260 ckfree ((char*) s); 261 } 262 SCOPE void 263 rde_stack_push (RDE_STACK s, void* item) 264 { 265 if (s->top >= s->max) { 266 long int new = s->max ? (2 * s->max) : RDE_STACK_INITIAL_SIZE; 267 void** cell = (void**) ckrealloc ((char*) s->cell, new * sizeof(void*)); 268 ASSERT (cell,"Memory allocation failure for RDE stack"); 269 s->max = new; 270 s->cell = cell; 271 } 272 ASSERT_BOUNDS(s->top,s->max); 273 s->cell [s->top] = item; 274 s->top ++; 275 } 276 SCOPE void* 277 rde_stack_top (RDE_STACK s) 278 { 279 ASSERT_BOUNDS(s->top-1,s->max); 280 return s->cell [s->top - 1]; 281 } 282 SCOPE void 283 rde_stack_pop (RDE_STACK s, long int n) 284 { 285 ASSERT (n >= 0, "Bad pop count"); 286 if (n == 0) return; 287 if (s->freeCellProc) { 288 while (n) { 289 s->top --; 290 ASSERT_BOUNDS(s->top,s->max); 291 s->freeCellProc ( s->cell [s->top] ); 292 n --; 293 } 294 } else { 295 s->top -= n; 296 } 297 } 298 SCOPE void 299 rde_stack_trim (RDE_STACK s, long int n) 300 { 301 ASSERT (n >= 0, "Bad trimsize"); 302 if (s->freeCellProc) { 303 while (s->top > n) { 304 s->top --; 305 ASSERT_BOUNDS(s->top,s->max); 306 s->freeCellProc ( s->cell [s->top] ); 307 } 308 } else { 309 s->top = n; 310 } 311 } 312 SCOPE void 313 rde_stack_drop (RDE_STACK s, long int n) 314 { 315 ASSERT (n >= 0, "Bad pop count"); 316 if (n == 0) return; 317 s->top -= n; 318 } 319 SCOPE void 320 rde_stack_move (RDE_STACK dst, RDE_STACK src) 321 { 322 ASSERT (dst->freeCellProc == src->freeCellProc, "Ownership mismatch"); 323 324 while (src->top > 0) { 325 src->top --; 326 ASSERT_BOUNDS(src->top,src->max); 327 rde_stack_push (dst, src->cell [src->top] ); 328 } 329 } 330 SCOPE void 331 rde_stack_get (RDE_STACK s, long int* cn, void*** cc) 332 { 333 *cn = s->top; 334 *cc = s->cell; 335 } 336 SCOPE long int 337 rde_stack_size (RDE_STACK s) 338 { 339 return s->top; 340 } 341 342 343#line 1 "rde_critcl/tc.c" 344 345 typedef struct RDE_TC_ { 346 int max; 347 int num; 348 char* str; 349 RDE_STACK off; 350 } RDE_TC_; 351 352 SCOPE RDE_TC 353 rde_tc_new (void) 354 { 355 RDE_TC tc = ALLOC (RDE_TC_); 356 tc->max = RDE_STACK_INITIAL_SIZE; 357 tc->num = 0; 358 tc->str = NALLOC (RDE_STACK_INITIAL_SIZE, char); 359 tc->off = rde_stack_new (NULL); 360 return tc; 361 } 362 SCOPE void 363 rde_tc_del (RDE_TC tc) 364 { 365 rde_stack_del (tc->off); 366 ckfree (tc->str); 367 ckfree ((char*) tc); 368 } 369 SCOPE long int 370 rde_tc_size (RDE_TC tc) 371 { 372 return rde_stack_size (tc->off); 373 } 374 SCOPE void 375 rde_tc_clear (RDE_TC tc) 376 { 377 tc->num = 0; 378 rde_stack_trim (tc->off, 0); 379 } 380 SCOPE char* 381 rde_tc_append (RDE_TC tc, char* string, long int len) 382 { 383 long int base = tc->num; 384 long int off = tc->num; 385 char* ch; 386 int clen; 387 Tcl_UniChar uni; 388 if (len < 0) { 389 len = strlen (string); 390 } 391 392 if (!len) { 393 return tc->str + base; 394 } 395 396 if ((tc->num + len) >= tc->max) { 397 int new = len + (tc->max ? (2 * tc->max) : RDE_STACK_INITIAL_SIZE); 398 char* str = ckrealloc (tc->str, new * sizeof(char)); 399 ASSERT (str,"Memory allocation failure for token character array"); 400 tc->max = new; 401 tc->str = str; 402 } 403 tc->num += len; 404 ASSERT_BOUNDS(tc->num,tc->max); 405 ASSERT_BOUNDS(off,tc->max); 406 ASSERT_BOUNDS(off+len-1,tc->max); 407 ASSERT_BOUNDS(off+len-1,tc->num); 408 memcpy (tc->str + off, string, len); 409 410 ch = string; 411 while (ch < (string + len)) { 412 ASSERT_BOUNDS(off,tc->num); 413 rde_stack_push (tc->off, (void*) off); 414 clen = Tcl_UtfToUniChar (ch, &uni); 415 off += clen; 416 ch += clen; 417 } 418 return tc->str + base; 419 } 420 SCOPE void 421 rde_tc_get (RDE_TC tc, int at, char** ch, long int* len) 422 { 423 long int oc, off, end; 424 void** ov; 425 rde_stack_get (tc->off, &oc, &ov); 426 ASSERT_BOUNDS(at,oc); 427 off = (long int) ov [at]; 428 if ((at+1) == oc) { 429 end = tc->num; 430 } else { 431 end = (long int) ov [at+1]; 432 } 433 TRACE (("rde_tc_get (RDE_TC %p, @ %d) => %d.[%d ... %d]/%d",tc,at,end-off,off,end-1,tc->num)); 434 ASSERT_BOUNDS(off,tc->num); 435 ASSERT_BOUNDS(end-1,tc->num); 436 *ch = tc->str + off; 437 *len = end - off; 438 } 439 SCOPE void 440 rde_tc_get_s (RDE_TC tc, int at, int last, char** ch, long int* len) 441 { 442 long int oc, off, end; 443 void** ov; 444 rde_stack_get (tc->off, &oc, &ov); 445 ASSERT_BOUNDS(at,oc); 446 ASSERT_BOUNDS(last,oc); 447 off = (long int) ov [at]; 448 if ((last+1) == oc) { 449 end = tc->num; 450 } else { 451 end = (long int) ov [last+1]; 452 } 453 TRACE (("rde_tc_get_s (RDE_TC %p, @ %d .. %d) => %d.[%d ... %d]/%d",tc,at,last,end-off,off,end-1,tc->num)); 454 ASSERT_BOUNDS(off,tc->num); 455 ASSERT_BOUNDS(end-1,tc->num); 456 *ch = tc->str + off; 457 *len = end - off; 458 } 459 460 461#line 1 "rde_critcl/param.c" 462 463 typedef struct RDE_PARAM_ { 464 Tcl_Channel IN; 465 Tcl_Obj* readbuf; 466 char* CC; 467 long int CC_len; 468 RDE_TC TC; 469 long int CL; 470 RDE_STACK LS; 471 ERROR_STATE* ER; 472 RDE_STACK ES; 473 long int ST; 474 Tcl_Obj* SV; 475 Tcl_HashTable NC; 476 477 RDE_STACK ast ; 478 RDE_STACK mark ; 479 480 long int numstr; 481 char** string; 482 483 ClientData clientData; 484 } RDE_PARAM_; 485 typedef int (*UniCharClass) (int); 486 typedef enum test_class_id { 487 tc_alnum, 488 tc_alpha, 489 tc_ascii, 490 tc_control, 491 tc_ddigit, 492 tc_digit, 493 tc_graph, 494 tc_lower, 495 tc_printable, 496 tc_punct, 497 tc_space, 498 tc_upper, 499 tc_wordchar, 500 tc_xdigit 501 } test_class_id; 502 static void ast_node_free (void* n); 503 static void error_state_free (void* es); 504 static void error_set (RDE_PARAM p, long int s); 505 static void nc_clear (RDE_PARAM p); 506 static int UniCharIsAscii (int character); 507 static int UniCharIsHexDigit (int character); 508 static int UniCharIsDecDigit (int character); 509 static void test_class (RDE_PARAM p, UniCharClass class, test_class_id id); 510 static int er_int_compare (const void* a, const void* b); 511 #define SV_INIT(p) \ 512 p->SV = NULL; \ 513 TRACE (("SV_INIT (%p => %p)", (p), (p)->SV)) 514 #define SV_SET(p,newsv) \ 515 if (((p)->SV) != (newsv)) { \ 516 TRACE (("SV_CLEAR/set (%p => %p)", (p), (p)->SV)); \ 517 if ((p)->SV) { \ 518 Tcl_DecrRefCount ((p)->SV); \ 519 } \ 520 (p)->SV = (newsv); \ 521 TRACE (("SV_SET (%p => %p)", (p), (p)->SV)); \ 522 if ((p)->SV) { \ 523 Tcl_IncrRefCount ((p)->SV); \ 524 } \ 525 } 526 #define SV_CLEAR(p) \ 527 TRACE (("SV_CLEAR (%p => %p)", (p), (p)->SV)); \ 528 if ((p)->SV) { \ 529 Tcl_DecrRefCount ((p)->SV); \ 530 } \ 531 (p)->SV = NULL 532 #define ER_INIT(p) \ 533 p->ER = NULL; \ 534 TRACE (("ER_INIT (%p => %p)", (p), (p)->ER)) 535 #define ER_CLEAR(p) \ 536 error_state_free ((p)->ER); \ 537 (p)->ER = NULL 538 SCOPE RDE_PARAM 539 rde_param_new (long int nstr, char** strings) 540 { 541 RDE_PARAM p; 542 ENTER ("rde_param_new"); 543 TRACE (("\tINT %d strings @ %p", nstr, strings)); 544 p = ALLOC (RDE_PARAM_); 545 p->numstr = nstr; 546 p->string = strings; 547 p->readbuf = Tcl_NewObj (); 548 Tcl_IncrRefCount (p->readbuf); 549 TRACE (("\tTcl_Obj* readbuf %p used %d", p->readbuf,p->readbuf->refCount)); 550 Tcl_InitHashTable (&p->NC, TCL_ONE_WORD_KEYS); 551 p->IN = NULL; 552 p->CL = -1; 553 p->ST = 0; 554 ER_INIT (p); 555 SV_INIT (p); 556 p->CC = NULL; 557 p->CC_len = 0; 558 p->TC = rde_tc_new (); 559 p->ES = rde_stack_new (error_state_free); 560 p->LS = rde_stack_new (NULL); 561 p->ast = rde_stack_new (ast_node_free); 562 p->mark = rde_stack_new (NULL); 563 RETURN ("%p", p); 564 } 565 SCOPE void 566 rde_param_del (RDE_PARAM p) 567 { 568 ENTER ("rde_param_del"); 569 TRACE (("RDE_PARAM %p",p)); 570 ER_CLEAR (p); TRACE (("\ter_clear")); 571 SV_CLEAR (p); TRACE (("\tsv_clear")); 572 nc_clear (p); TRACE (("\tnc_clear")); 573 Tcl_DeleteHashTable (&p->NC); TRACE (("\tnc hashtable delete")); 574 rde_tc_del (p->TC); TRACE (("\ttc clear")); 575 rde_stack_del (p->ES); TRACE (("\tes clear")); 576 rde_stack_del (p->LS); TRACE (("\tls clear")); 577 rde_stack_del (p->ast); TRACE (("\tast clear")); 578 rde_stack_del (p->mark); TRACE (("\tmark clear")); 579 TRACE (("\tTcl_Obj* readbuf %p used %d", p->readbuf,p->readbuf->refCount)); 580 Tcl_DecrRefCount (p->readbuf); 581 ckfree ((char*) p); 582 RETURNVOID; 583 } 584 SCOPE void 585 rde_param_reset (RDE_PARAM p, Tcl_Channel chan) 586 { 587 ENTER ("rde_param_reset"); 588 TRACE (("RDE_PARAM %p",p)); 589 TRACE (("Tcl_Channel %p",chan)); 590 p->IN = chan; 591 p->CL = -1; 592 p->ST = 0; 593 p->CC = NULL; 594 p->CC_len = 0; 595 ER_CLEAR (p); 596 SV_CLEAR (p); 597 nc_clear (p); 598 rde_tc_clear (p->TC); 599 rde_stack_trim (p->ES, 0); 600 rde_stack_trim (p->LS, 0); 601 rde_stack_trim (p->ast, 0); 602 rde_stack_trim (p->mark, 0); 603 TRACE (("\tTcl_Obj* readbuf %p used %d", p->readbuf,p->readbuf->refCount)); 604 RETURNVOID; 605 } 606 SCOPE void 607 rde_param_update_strings (RDE_PARAM p, long int nstr, char** strings) 608 { 609 ENTER ("rde_param_update_strings"); 610 TRACE (("RDE_PARAM %p", p)); 611 TRACE (("INT %d strings", nstr)); 612 p->numstr = nstr; 613 p->string = strings; 614 RETURNVOID; 615 } 616 SCOPE void 617 rde_param_data (RDE_PARAM p, char* buf, long int len) 618 { 619 (void) rde_tc_append (p->TC, buf, len); 620 } 621 SCOPE void 622 rde_param_clientdata (RDE_PARAM p, ClientData clientData) 623 { 624 p->clientData = clientData; 625 } 626 static void 627 nc_clear (RDE_PARAM p) 628 { 629 Tcl_HashSearch hs; 630 Tcl_HashEntry* he; 631 Tcl_HashTable* tablePtr; 632 for(he = Tcl_FirstHashEntry(&p->NC, &hs); 633 he != NULL; 634 he = Tcl_FirstHashEntry(&p->NC, &hs)) { 635 Tcl_HashSearch hsc; 636 Tcl_HashEntry* hec; 637 tablePtr = (Tcl_HashTable*) Tcl_GetHashValue (he); 638 for(hec = Tcl_FirstHashEntry(tablePtr, &hsc); 639 hec != NULL; 640 hec = Tcl_NextHashEntry(&hsc)) { 641 NC_STATE* scs = Tcl_GetHashValue (hec); 642 error_state_free (scs->ER); 643 if (scs->SV) { Tcl_DecrRefCount (scs->SV); } 644 ckfree ((char*) scs); 645 } 646 Tcl_DeleteHashTable (tablePtr); 647 ckfree ((char*) tablePtr); 648 Tcl_DeleteHashEntry (he); 649 } 650 } 651 SCOPE ClientData 652 rde_param_query_clientdata (RDE_PARAM p) 653 { 654 return p->clientData; 655 } 656 SCOPE void 657 rde_param_query_amark (RDE_PARAM p, long int* mc, void*** mv) 658 { 659 rde_stack_get (p->mark, mc, mv); 660 } 661 SCOPE void 662 rde_param_query_ast (RDE_PARAM p, long int* ac, Tcl_Obj*** av) 663 { 664 rde_stack_get (p->ast, ac, (void***) av); 665 } 666 SCOPE const char* 667 rde_param_query_in (RDE_PARAM p) 668 { 669 return p->IN 670 ? Tcl_GetChannelName (p->IN) 671 : ""; 672 } 673 SCOPE const char* 674 rde_param_query_cc (RDE_PARAM p, long int* len) 675 { 676 *len = p->CC_len; 677 return p->CC; 678 } 679 SCOPE int 680 rde_param_query_cl (RDE_PARAM p) 681 { 682 return p->CL; 683 } 684 SCOPE const ERROR_STATE* 685 rde_param_query_er (RDE_PARAM p) 686 { 687 return p->ER; 688 } 689 SCOPE Tcl_Obj* 690 rde_param_query_er_tcl (RDE_PARAM p, const ERROR_STATE* er) 691 { 692 Tcl_Obj* res; 693 if (!er) { 694 695 res = Tcl_NewStringObj ("", 0); 696 } else { 697 Tcl_Obj* ov [2]; 698 Tcl_Obj** mov; 699 long int mc, i, j; 700 void** mv; 701 int lastid; 702 const char* msg; 703 rde_stack_get (er->msg, &mc, &mv); 704 705 qsort (mv, mc, sizeof (void*), er_int_compare); 706 707 mov = NALLOC (mc, Tcl_Obj*); 708 lastid = -1; 709 for (i=0, j=0; i < mc; i++) { 710 ASSERT_BOUNDS (i,mc); 711 if (((long int) mv [i]) == lastid) continue; 712 lastid = (long int) mv [i]; 713 ASSERT_BOUNDS((long int) mv[i],p->numstr); 714 msg = p->string [(long int) mv[i]]; 715 ASSERT_BOUNDS (j,mc); 716 mov [j] = Tcl_NewStringObj (msg, -1); 717 j++; 718 } 719 720 ov [0] = Tcl_NewIntObj (er->loc); 721 ov [1] = Tcl_NewListObj (j, mov); 722 res = Tcl_NewListObj (2, ov); 723 ckfree ((char*) mov); 724 } 725 return res; 726 } 727 SCOPE void 728 rde_param_query_es (RDE_PARAM p, long int* ec, ERROR_STATE*** ev) 729 { 730 rde_stack_get (p->ES, ec, (void***) ev); 731 } 732 SCOPE void 733 rde_param_query_ls (RDE_PARAM p, long int* lc, void*** lv) 734 { 735 rde_stack_get (p->LS, lc, lv); 736 } 737 SCOPE long int 738 rde_param_query_lstop (RDE_PARAM p) 739 { 740 return (long int) rde_stack_top (p->LS); 741 } 742 SCOPE Tcl_HashTable* 743 rde_param_query_nc (RDE_PARAM p) 744 { 745 return &p->NC; 746 } 747 SCOPE int 748 rde_param_query_st (RDE_PARAM p) 749 { 750 return p->ST; 751 } 752 SCOPE Tcl_Obj* 753 rde_param_query_sv (RDE_PARAM p) 754 { 755 TRACE (("SV_QUERY %p => (%p)", (p), (p)->SV)); \ 756 return p->SV; 757 } 758 SCOPE long int 759 rde_param_query_tc_size (RDE_PARAM p) 760 { 761 return rde_tc_size (p->TC); 762 } 763 SCOPE void 764 rde_param_query_tc_get_s (RDE_PARAM p, long int at, long int last, char** ch, long int* len) 765 { 766 rde_tc_get_s (p->TC, at, last, ch, len); 767 } 768 SCOPE const char* 769 rde_param_query_string (RDE_PARAM p, long int id) 770 { 771 TRACE (("rde_param_query_string (RDE_PARAM %p, %d/%d)", p, id, p->numstr)); 772 ASSERT_BOUNDS(id,p->numstr); 773 return p->string [id]; 774 } 775 SCOPE void 776 rde_param_i_ast_pop_discard (RDE_PARAM p) 777 { 778 rde_stack_pop (p->mark, 1); 779 } 780 SCOPE void 781 rde_param_i_ast_pop_rewind (RDE_PARAM p) 782 { 783 long int trim = (long int) rde_stack_top (p->mark); 784 ENTER ("rde_param_i_ast_pop_rewind"); 785 TRACE (("RDE_PARAM %p",p)); 786 rde_stack_pop (p->mark, 1); 787 rde_stack_trim (p->ast, trim); 788 TRACE (("SV = (%p rc%d '%s')", 789 p->SV, 790 p->SV ? p->SV->refCount : -1, 791 p->SV ? Tcl_GetString (p->SV) : "")); 792 RETURNVOID; 793 } 794 SCOPE void 795 rde_param_i_ast_rewind (RDE_PARAM p) 796 { 797 long int trim = (long int) rde_stack_top (p->mark); 798 ENTER ("rde_param_i_ast_rewind"); 799 TRACE (("RDE_PARAM %p",p)); 800 rde_stack_trim (p->ast, trim); 801 TRACE (("SV = (%p rc%d '%s')", 802 p->SV, 803 p->SV ? p->SV->refCount : -1, 804 p->SV ? Tcl_GetString (p->SV) : "")); 805 RETURNVOID; 806 } 807 SCOPE void 808 rde_param_i_ast_push (RDE_PARAM p) 809 { 810 rde_stack_push (p->mark, (void*) rde_stack_size (p->ast)); 811 } 812 SCOPE void 813 rde_param_i_ast_value_push (RDE_PARAM p) 814 { 815 ENTER ("rde_param_i_ast_value_push"); 816 TRACE (("RDE_PARAM %p",p)); 817 ASSERT(p->SV,"Unable to push undefined semantic value"); 818 TRACE (("rde_param_i_ast_value_push %p => (%p)", p, p->SV)); 819 TRACE (("SV = (%p rc%d '%s')", p->SV, p->SV->refCount, Tcl_GetString (p->SV))); 820 rde_stack_push (p->ast, p->SV); 821 Tcl_IncrRefCount (p->SV); 822 RETURNVOID; 823 } 824 static void 825 ast_node_free (void* n) 826 { 827 Tcl_DecrRefCount ((Tcl_Obj*) n); 828 } 829 SCOPE void 830 rde_param_i_error_clear (RDE_PARAM p) 831 { 832 ER_CLEAR (p); 833 } 834 SCOPE void 835 rde_param_i_error_nonterminal (RDE_PARAM p, long int s) 836 { 837 838 return; 839 #if 0 840 long int pos; 841 if (!p->ER) return; 842 pos = 1 + (long int) rde_stack_top (p->LS); 843 if (p->ER->loc != pos) return; 844 error_set (p, s); 845 p->ER->loc = pos; 846 #endif 847 } 848 SCOPE void 849 rde_param_i_error_pop_merge (RDE_PARAM p) 850 { 851 ERROR_STATE* top = (ERROR_STATE*) rde_stack_top (p->ES); 852 853 if (top == p->ER) { 854 rde_stack_pop (p->ES, 1); 855 return; 856 } 857 858 if (!top) { 859 rde_stack_pop (p->ES, 1); 860 return; 861 } 862 863 if (!p->ER) { 864 rde_stack_drop (p->ES, 1); 865 p->ER = top; 866 867 return; 868 } 869 870 if (top->loc < p->ER->loc) { 871 rde_stack_pop (p->ES, 1); 872 return; 873 } 874 875 if (top->loc > p->ER->loc) { 876 rde_stack_drop (p->ES, 1); 877 error_state_free (p->ER); 878 p->ER = top; 879 880 return; 881 } 882 883 rde_stack_move (p->ER->msg, top->msg); 884 rde_stack_pop (p->ES, 1); 885 } 886 SCOPE void 887 rde_param_i_error_push (RDE_PARAM p) 888 { 889 rde_stack_push (p->ES, p->ER); 890 if (p->ER) { p->ER->refCount ++; } 891 } 892 static void 893 error_set (RDE_PARAM p, long int s) 894 { 895 error_state_free (p->ER); 896 p->ER = ALLOC (ERROR_STATE); 897 p->ER->refCount = 1; 898 p->ER->loc = p->CL; 899 p->ER->msg = rde_stack_new (NULL); 900 ASSERT_BOUNDS(s,p->numstr); 901 rde_stack_push (p->ER->msg, (void*)(intptr_t)s); 902 } 903 static void 904 error_state_free (void* esx) 905 { 906 ERROR_STATE* es = esx; 907 if (!es) return; 908 es->refCount --; 909 if (es->refCount > 0) return; 910 rde_stack_del (es->msg); 911 ckfree ((char*) es); 912 } 913 SCOPE void 914 rde_param_i_loc_pop_discard (RDE_PARAM p) 915 { 916 rde_stack_pop (p->LS, 1); 917 } 918 SCOPE void 919 rde_param_i_loc_pop_rewind (RDE_PARAM p) 920 { 921 p->CL = (long int) rde_stack_top (p->LS); 922 rde_stack_pop (p->LS, 1); 923 } 924 SCOPE void 925 rde_param_i_loc_push (RDE_PARAM p) 926 { 927 rde_stack_push (p->LS, (void*) p->CL); 928 } 929 SCOPE void 930 rde_param_i_loc_rewind (RDE_PARAM p) 931 { 932 p->CL = (long int) rde_stack_top (p->LS); 933 } 934 SCOPE void 935 rde_param_i_input_next (RDE_PARAM p, long int m) 936 { 937 int leni; 938 char* ch; 939 ASSERT_BOUNDS(m,p->numstr); 940 p->CL ++; 941 if (p->CL < rde_tc_size (p->TC)) { 942 943 rde_tc_get (p->TC, p->CL, &p->CC, &p->CC_len); 944 945 ASSERT_BOUNDS (p->CC_len-1, TCL_UTF_MAX); 946 p->ST = 1; 947 ER_CLEAR (p); 948 return; 949 } 950 if (!p->IN || 951 Tcl_Eof (p->IN) || 952 (Tcl_ReadChars (p->IN, p->readbuf, 1, 0) <= 0)) { 953 954 p->ST = 0; 955 error_set (p, m); 956 return; 957 } 958 959 ch = Tcl_GetStringFromObj (p->readbuf, &leni); 960 ASSERT_BOUNDS (leni, TCL_UTF_MAX); 961 p->CC = rde_tc_append (p->TC, ch, leni); 962 p->CC_len = leni; 963 p->ST = 1; 964 ER_CLEAR (p); 965 } 966 SCOPE void 967 rde_param_i_status_fail (RDE_PARAM p) 968 { 969 p->ST = 0; 970 } 971 SCOPE void 972 rde_param_i_status_ok (RDE_PARAM p) 973 { 974 p->ST = 1; 975 } 976 SCOPE void 977 rde_param_i_status_negate (RDE_PARAM p) 978 { 979 p->ST = !p->ST; 980 } 981 SCOPE int 982 rde_param_i_symbol_restore (RDE_PARAM p, long int s) 983 { 984 NC_STATE* scs; 985 Tcl_HashEntry* hPtr; 986 Tcl_HashTable* tablePtr; 987 988 hPtr = Tcl_FindHashEntry (&p->NC, (char*) p->CL); 989 if (!hPtr) { return 0; } 990 tablePtr = (Tcl_HashTable*) Tcl_GetHashValue (hPtr); 991 hPtr = Tcl_FindHashEntry (tablePtr, (void*)(intptr_t)s); 992 if (!hPtr) { return 0; } 993 994 scs = Tcl_GetHashValue (hPtr); 995 p->CL = scs->CL; 996 p->ST = scs->ST; 997 error_state_free (p->ER); 998 p->ER = scs->ER; 999 if (p->ER) { p->ER->refCount ++; } 1000 TRACE (("SV_RESTORE (%p) '%s'",scs->SV, scs->SV ? Tcl_GetString (scs->SV):"")); 1001 SV_SET (p, scs->SV); 1002 return 1; 1003 } 1004 SCOPE void 1005 rde_param_i_symbol_save (RDE_PARAM p, long int s) 1006 { 1007 long int at = (long int) rde_stack_top (p->LS); 1008 NC_STATE* scs; 1009 Tcl_HashEntry* hPtr; 1010 Tcl_HashTable* tablePtr; 1011 int isnew; 1012 ENTER ("rde_param_i_symbol_save"); 1013 TRACE (("RDE_PARAM %p",p)); 1014 TRACE (("INT %d",s)); 1015 1016 hPtr = Tcl_CreateHashEntry (&p->NC, (void*)(intptr_t)at, &isnew); 1017 if (isnew) { 1018 tablePtr = ALLOC (Tcl_HashTable); 1019 Tcl_InitHashTable (tablePtr, TCL_ONE_WORD_KEYS); 1020 Tcl_SetHashValue (hPtr, tablePtr); 1021 } else { 1022 tablePtr = (Tcl_HashTable*) Tcl_GetHashValue (hPtr); 1023 } 1024 hPtr = Tcl_CreateHashEntry (tablePtr, (void *)(intptr_t)s, &isnew); 1025 if (isnew) { 1026 1027 scs = ALLOC (NC_STATE); 1028 scs->CL = p->CL; 1029 scs->ST = p->ST; 1030 TRACE (("SV_CACHE (%p '%s')", p->SV, p->SV ? Tcl_GetString(p->SV) : "")); 1031 scs->SV = p->SV; 1032 if (scs->SV) { Tcl_IncrRefCount (scs->SV); } 1033 scs->ER = p->ER; 1034 if (scs->ER) { scs->ER->refCount ++; } 1035 Tcl_SetHashValue (hPtr, scs); 1036 } else { 1037 1038 scs = (NC_STATE*) Tcl_GetHashValue (hPtr); 1039 scs->CL = p->CL; 1040 scs->ST = p->ST; 1041 TRACE (("SV_CACHE/over (%p '%s')", p->SV, p->SV ? Tcl_GetString(p->SV) : "" )); 1042 if (scs->SV) { Tcl_DecrRefCount (scs->SV); } 1043 scs->SV = p->SV; 1044 if (scs->SV) { Tcl_IncrRefCount (scs->SV); } 1045 error_state_free (scs->ER); 1046 scs->ER = p->ER; 1047 if (scs->ER) { scs->ER->refCount ++; } 1048 } 1049 TRACE (("SV = (%p rc%d '%s')", 1050 p->SV, 1051 p->SV ? p->SV->refCount : -1, 1052 p->SV ? Tcl_GetString (p->SV) : "")); 1053 RETURNVOID; 1054 } 1055 SCOPE void 1056 rde_param_i_test_alnum (RDE_PARAM p) 1057 { 1058 test_class (p, Tcl_UniCharIsAlnum, tc_alnum); 1059 } 1060 SCOPE void 1061 rde_param_i_test_alpha (RDE_PARAM p) 1062 { 1063 test_class (p, Tcl_UniCharIsAlpha, tc_alpha); 1064 } 1065 SCOPE void 1066 rde_param_i_test_ascii (RDE_PARAM p) 1067 { 1068 test_class (p, UniCharIsAscii, tc_ascii); 1069 } 1070 SCOPE void 1071 rde_param_i_test_control (RDE_PARAM p) 1072 { 1073 test_class (p, Tcl_UniCharIsControl, tc_control); 1074 } 1075 SCOPE void 1076 rde_param_i_test_char (RDE_PARAM p, const char* c, long int msg) 1077 { 1078 ASSERT_BOUNDS(msg,p->numstr); 1079 p->ST = Tcl_UtfNcmp (p->CC, c, 1) == 0; 1080 if (p->ST) { 1081 ER_CLEAR (p); 1082 } else { 1083 error_set (p, msg); 1084 p->CL --; 1085 } 1086 } 1087 SCOPE void 1088 rde_param_i_test_ddigit (RDE_PARAM p) 1089 { 1090 test_class (p, UniCharIsDecDigit, tc_ddigit); 1091 } 1092 SCOPE void 1093 rde_param_i_test_digit (RDE_PARAM p) 1094 { 1095 test_class (p, Tcl_UniCharIsDigit, tc_digit); 1096 } 1097 SCOPE void 1098 rde_param_i_test_graph (RDE_PARAM p) 1099 { 1100 test_class (p, Tcl_UniCharIsGraph, tc_graph); 1101 } 1102 SCOPE void 1103 rde_param_i_test_lower (RDE_PARAM p) 1104 { 1105 test_class (p, Tcl_UniCharIsLower, tc_lower); 1106 } 1107 SCOPE void 1108 rde_param_i_test_print (RDE_PARAM p) 1109 { 1110 test_class (p, Tcl_UniCharIsPrint, tc_printable); 1111 } 1112 SCOPE void 1113 rde_param_i_test_punct (RDE_PARAM p) 1114 { 1115 test_class (p, Tcl_UniCharIsPunct, tc_punct); 1116 } 1117 SCOPE void 1118 rde_param_i_test_range (RDE_PARAM p, const char* s, const char* e, long int msg) 1119 { 1120 ASSERT_BOUNDS(msg,p->numstr); 1121 p->ST = 1122 (Tcl_UtfNcmp (s, p->CC, 1) <= 0) && 1123 (Tcl_UtfNcmp (p->CC, e, 1) <= 0); 1124 if (p->ST) { 1125 ER_CLEAR (p); 1126 } else { 1127 error_set (p, msg); 1128 p->CL --; 1129 } 1130 } 1131 SCOPE void 1132 rde_param_i_test_space (RDE_PARAM p) 1133 { 1134 test_class (p, Tcl_UniCharIsSpace, tc_space); 1135 } 1136 SCOPE void 1137 rde_param_i_test_upper (RDE_PARAM p) 1138 { 1139 test_class (p, Tcl_UniCharIsUpper, tc_upper); 1140 } 1141 SCOPE void 1142 rde_param_i_test_wordchar (RDE_PARAM p) 1143 { 1144 test_class (p, Tcl_UniCharIsWordChar, tc_wordchar); 1145 } 1146 SCOPE void 1147 rde_param_i_test_xdigit (RDE_PARAM p) 1148 { 1149 test_class (p, UniCharIsHexDigit, tc_xdigit); 1150 } 1151 static void 1152 test_class (RDE_PARAM p, UniCharClass class, test_class_id id) 1153 { 1154 Tcl_UniChar ch; 1155 Tcl_UtfToUniChar(p->CC, &ch); 1156 ASSERT_BOUNDS(id,p->numstr); 1157 p->ST = !!class (ch); 1158 1159 if (p->ST) { 1160 ER_CLEAR (p); 1161 } else { 1162 error_set (p, id); 1163 p->CL --; 1164 } 1165 } 1166 static int 1167 UniCharIsAscii (int character) 1168 { 1169 return (character >= 0) && (character < 0x80); 1170 } 1171 static int 1172 UniCharIsHexDigit (int character) 1173 { 1174 return UniCharIsDecDigit(character) || 1175 (character >= 'a' && character <= 'f') || 1176 (character >= 'A' && character <= 'F'); 1177 } 1178 static int 1179 UniCharIsDecDigit (int character) 1180 { 1181 return (character >= '0') && (character <= '9'); 1182 } 1183 SCOPE void 1184 rde_param_i_value_clear (RDE_PARAM p) 1185 { 1186 SV_CLEAR (p); 1187 } 1188 SCOPE void 1189 rde_param_i_value_leaf (RDE_PARAM p, long int s) 1190 { 1191 Tcl_Obj* newsv; 1192 Tcl_Obj* ov [3]; 1193 long int pos = 1 + (long int) rde_stack_top (p->LS); 1194 ASSERT_BOUNDS(s,p->numstr); 1195 ov [0] = Tcl_NewStringObj (p->string[s], -1); 1196 ov [1] = Tcl_NewIntObj (pos); 1197 ov [2] = Tcl_NewIntObj (p->CL); 1198 newsv = Tcl_NewListObj (3, ov); 1199 TRACE (("rde_param_i_value_leaf => '%s'",Tcl_GetString (newsv))); 1200 SV_SET (p, newsv); 1201 } 1202 SCOPE void 1203 rde_param_i_value_reduce (RDE_PARAM p, long int s) 1204 { 1205 Tcl_Obj* newsv; 1206 int i, j; 1207 Tcl_Obj** ov; 1208 long int ac; 1209 Tcl_Obj** av; 1210 long int pos = 1 + (long int) rde_stack_top (p->LS); 1211 long int mark = (long int) rde_stack_top (p->mark); 1212 long int asize = rde_stack_size (p->ast); 1213 long int new = asize - mark; 1214 ASSERT (new >= 0, "Bad number of elements to reduce"); 1215 ov = NALLOC (3+new, Tcl_Obj*); 1216 ASSERT_BOUNDS(s,p->numstr); 1217 ov [0] = Tcl_NewStringObj (p->string[s], -1); 1218 ov [1] = Tcl_NewIntObj (pos); 1219 ov [2] = Tcl_NewIntObj (p->CL); 1220 rde_stack_get (p->ast, &ac, (void***) &av); 1221 for (i = 3, j = mark; j < asize; i++, j++) { 1222 ASSERT_BOUNDS (i, 3+new); 1223 ASSERT_BOUNDS (j, ac); 1224 ov [i] = av [j]; 1225 } 1226 ASSERT (i == 3+new, "Reduction result incomplete"); 1227 newsv = Tcl_NewListObj (3+new, ov); 1228 TRACE (("rde_param_i_value_reduce => '%s'",Tcl_GetString (newsv))); 1229 SV_SET (p, newsv); 1230 ckfree ((char*) ov); 1231 } 1232 static int 1233 er_int_compare (const void* a, const void* b) 1234 { 1235 1236 const void** ael = (const void**) a; 1237 const void** bel = (const void**) b; 1238 long int avalue = (long int) *ael; 1239 long int bvalue = (long int) *bel; 1240 if (avalue < bvalue) { return -1; } 1241 if (avalue > bvalue) { return 1; } 1242 return 0; 1243 } 1244 SCOPE int 1245 rde_param_i_symbol_start (RDE_PARAM p, long int s) 1246 { 1247 if (rde_param_i_symbol_restore (p, s)) { 1248 if (p->ST) { 1249 rde_stack_push (p->ast, p->SV); 1250 Tcl_IncrRefCount (p->SV); 1251 } 1252 return 1; 1253 } 1254 rde_stack_push (p->LS, (void*) p->CL); 1255 return 0; 1256 } 1257 SCOPE int 1258 rde_param_i_symbol_start_d (RDE_PARAM p, long int s) 1259 { 1260 if (rde_param_i_symbol_restore (p, s)) { 1261 if (p->ST) { 1262 rde_stack_push (p->ast, p->SV); 1263 Tcl_IncrRefCount (p->SV); 1264 } 1265 return 1; 1266 } 1267 rde_stack_push (p->LS, (void*) p->CL); 1268 rde_stack_push (p->mark, (void*) rde_stack_size (p->ast)); 1269 return 0; 1270 } 1271 SCOPE int 1272 rde_param_i_symbol_void_start (RDE_PARAM p, long int s) 1273 { 1274 if (rde_param_i_symbol_restore (p, s)) return 1; 1275 rde_stack_push (p->LS, (void*) p->CL); 1276 return 0; 1277 } 1278 SCOPE int 1279 rde_param_i_symbol_void_start_d (RDE_PARAM p, long int s) 1280 { 1281 if (rde_param_i_symbol_restore (p, s)) return 1; 1282 rde_stack_push (p->LS, (void*) p->CL); 1283 rde_stack_push (p->mark, (void*) rde_stack_size (p->ast)); 1284 return 0; 1285 } 1286 SCOPE void 1287 rde_param_i_symbol_done_d_reduce (RDE_PARAM p, long int s, long int m) 1288 { 1289 if (p->ST) { 1290 rde_param_i_value_reduce (p, s); 1291 } else { 1292 SV_CLEAR (p); 1293 } 1294 rde_param_i_symbol_save (p, s); 1295 rde_param_i_error_nonterminal (p, m); 1296 rde_param_i_ast_pop_rewind (p); 1297 rde_stack_pop (p->LS, 1); 1298 if (p->ST) { 1299 rde_stack_push (p->ast, p->SV); 1300 Tcl_IncrRefCount (p->SV); 1301 } 1302 } 1303 SCOPE void 1304 rde_param_i_symbol_done_leaf (RDE_PARAM p, long int s, long int m) 1305 { 1306 if (p->ST) { 1307 rde_param_i_value_leaf (p, s); 1308 } else { 1309 SV_CLEAR (p); 1310 } 1311 rde_param_i_symbol_save (p, s); 1312 rde_param_i_error_nonterminal (p, m); 1313 rde_stack_pop (p->LS, 1); 1314 if (p->ST) { 1315 rde_stack_push (p->ast, p->SV); 1316 Tcl_IncrRefCount (p->SV); 1317 } 1318 } 1319 SCOPE void 1320 rde_param_i_symbol_done_d_leaf (RDE_PARAM p, long int s, long int m) 1321 { 1322 if (p->ST) { 1323 rde_param_i_value_leaf (p, s); 1324 } else { 1325 SV_CLEAR (p); 1326 } 1327 rde_param_i_symbol_save (p, s); 1328 rde_param_i_error_nonterminal (p, m); 1329 rde_param_i_ast_pop_rewind (p); 1330 rde_stack_pop (p->LS, 1); 1331 if (p->ST) { 1332 rde_stack_push (p->ast, p->SV); 1333 Tcl_IncrRefCount (p->SV); 1334 } 1335 } 1336 SCOPE void 1337 rde_param_i_symbol_done_void (RDE_PARAM p, long int s, long int m) 1338 { 1339 SV_CLEAR (p); 1340 rde_param_i_symbol_save (p, s); 1341 rde_param_i_error_nonterminal (p, m); 1342 rde_stack_pop (p->LS, 1); 1343 } 1344 SCOPE void 1345 rde_param_i_symbol_done_d_void (RDE_PARAM p, long int s, long int m) 1346 { 1347 SV_CLEAR (p); 1348 rde_param_i_symbol_save (p, s); 1349 rde_param_i_error_nonterminal (p, m); 1350 rde_param_i_ast_pop_rewind (p); 1351 rde_stack_pop (p->LS, 1); 1352 } 1353 SCOPE void 1354 rde_param_i_next_char (RDE_PARAM p, const char* c, long int m) 1355 { 1356 rde_param_i_input_next (p, m); 1357 if (!p->ST) return; 1358 rde_param_i_test_char (p, c, m); 1359 } 1360 SCOPE void 1361 rde_param_i_next_range (RDE_PARAM p, const char* s, const char* e, long int m) 1362 { 1363 rde_param_i_input_next (p, m); 1364 if (!p->ST) return; 1365 rde_param_i_test_range (p, s, e, m); 1366 } 1367 SCOPE void 1368 rde_param_i_next_alnum (RDE_PARAM p, long int m) 1369 { 1370 rde_param_i_input_next (p, m); 1371 if (!p->ST) return; 1372 rde_param_i_test_alnum (p); 1373 } 1374 SCOPE void 1375 rde_param_i_next_alpha (RDE_PARAM p, long int m) 1376 { 1377 rde_param_i_input_next (p, m); 1378 if (!p->ST) return; 1379 rde_param_i_test_alpha (p); 1380 } 1381 SCOPE void 1382 rde_param_i_next_ascii (RDE_PARAM p, long int m) 1383 { 1384 rde_param_i_input_next (p, m); 1385 if (!p->ST) return; 1386 rde_param_i_test_ascii (p); 1387 } 1388 SCOPE void 1389 rde_param_i_next_control (RDE_PARAM p, long int m) 1390 { 1391 rde_param_i_input_next (p, m); 1392 if (!p->ST) return; 1393 rde_param_i_test_control (p); 1394 } 1395 SCOPE void 1396 rde_param_i_next_ddigit (RDE_PARAM p, long int m) 1397 { 1398 rde_param_i_input_next (p, m); 1399 if (!p->ST) return; 1400 rde_param_i_test_ddigit (p); 1401 } 1402 SCOPE void 1403 rde_param_i_next_digit (RDE_PARAM p, long int m) 1404 { 1405 rde_param_i_input_next (p, m); 1406 if (!p->ST) return; 1407 rde_param_i_test_digit (p); 1408 } 1409 SCOPE void 1410 rde_param_i_next_graph (RDE_PARAM p, long int m) 1411 { 1412 rde_param_i_input_next (p, m); 1413 if (!p->ST) return; 1414 rde_param_i_test_graph (p); 1415 } 1416 SCOPE void 1417 rde_param_i_next_lower (RDE_PARAM p, long int m) 1418 { 1419 rde_param_i_input_next (p, m); 1420 if (!p->ST) return; 1421 rde_param_i_test_lower (p); 1422 } 1423 SCOPE void 1424 rde_param_i_next_print (RDE_PARAM p, long int m) 1425 { 1426 rde_param_i_input_next (p, m); 1427 if (!p->ST) return; 1428 rde_param_i_test_print (p); 1429 } 1430 SCOPE void 1431 rde_param_i_next_punct (RDE_PARAM p, long int m) 1432 { 1433 rde_param_i_input_next (p, m); 1434 if (!p->ST) return; 1435 rde_param_i_test_punct (p); 1436 } 1437 SCOPE void 1438 rde_param_i_next_space (RDE_PARAM p, long int m) 1439 { 1440 rde_param_i_input_next (p, m); 1441 if (!p->ST) return; 1442 rde_param_i_test_space (p); 1443 } 1444 SCOPE void 1445 rde_param_i_next_upper (RDE_PARAM p, long int m) 1446 { 1447 rde_param_i_input_next (p, m); 1448 if (!p->ST) return; 1449 rde_param_i_test_upper (p); 1450 } 1451 SCOPE void 1452 rde_param_i_next_wordchar (RDE_PARAM p, long int m) 1453 { 1454 rde_param_i_input_next (p, m); 1455 if (!p->ST) return; 1456 rde_param_i_test_wordchar (p); 1457 } 1458 SCOPE void 1459 rde_param_i_next_xdigit (RDE_PARAM p, long int m) 1460 { 1461 rde_param_i_input_next (p, m); 1462 if (!p->ST) return; 1463 rde_param_i_test_xdigit (p); 1464 } 1465 SCOPE void 1466 rde_param_i_notahead_start_d (RDE_PARAM p) 1467 { 1468 rde_stack_push (p->LS, (void*) p->CL); 1469 rde_stack_push (p->mark, (void*) rde_stack_size (p->ast)); 1470 } 1471 SCOPE void 1472 rde_param_i_notahead_exit_d (RDE_PARAM p) 1473 { 1474 if (p->ST) { 1475 rde_param_i_ast_pop_rewind (p); 1476 } else { 1477 rde_stack_pop (p->mark, 1); 1478 } 1479 p->CL = (long int) rde_stack_top (p->LS); 1480 rde_stack_pop (p->LS, 1); 1481 p->ST = !p->ST; 1482 } 1483 SCOPE void 1484 rde_param_i_notahead_exit (RDE_PARAM p) 1485 { 1486 p->CL = (long int) rde_stack_top (p->LS); 1487 rde_stack_pop (p->LS, 1); 1488 p->ST = !p->ST; 1489 } 1490 SCOPE void 1491 rde_param_i_state_push_2 (RDE_PARAM p) 1492 { 1493 1494 rde_stack_push (p->LS, (void*) p->CL); 1495 rde_stack_push (p->ES, p->ER); 1496 if (p->ER) { p->ER->refCount ++; } 1497 } 1498 SCOPE void 1499 rde_param_i_state_push_void (RDE_PARAM p) 1500 { 1501 rde_stack_push (p->LS, (void*) p->CL); 1502 ER_CLEAR (p); 1503 rde_stack_push (p->ES, p->ER); 1504 1505 } 1506 SCOPE void 1507 rde_param_i_state_push_value (RDE_PARAM p) 1508 { 1509 rde_stack_push (p->mark, (void*) rde_stack_size (p->ast)); 1510 rde_stack_push (p->LS, (void*) p->CL); 1511 ER_CLEAR (p); 1512 rde_stack_push (p->ES, p->ER); 1513 1514 } 1515 SCOPE void 1516 rde_param_i_state_merge_ok (RDE_PARAM p) 1517 { 1518 rde_param_i_error_pop_merge (p); 1519 if (!p->ST) { 1520 p->ST = 1; 1521 p->CL = (long int) rde_stack_top (p->LS); 1522 } 1523 rde_stack_pop (p->LS, 1); 1524 } 1525 SCOPE void 1526 rde_param_i_state_merge_void (RDE_PARAM p) 1527 { 1528 rde_param_i_error_pop_merge (p); 1529 if (!p->ST) { 1530 p->CL = (long int) rde_stack_top (p->LS); 1531 } 1532 rde_stack_pop (p->LS, 1); 1533 } 1534 SCOPE void 1535 rde_param_i_state_merge_value (RDE_PARAM p) 1536 { 1537 rde_param_i_error_pop_merge (p); 1538 if (!p->ST) { 1539 long int trim = (long int) rde_stack_top (p->mark); 1540 rde_stack_trim (p->ast, trim); 1541 p->CL = (long int) rde_stack_top (p->LS); 1542 } 1543 rde_stack_pop (p->mark, 1); 1544 rde_stack_pop (p->LS, 1); 1545 } 1546 SCOPE int 1547 rde_param_i_kleene_close (RDE_PARAM p) 1548 { 1549 int stop = !p->ST; 1550 rde_param_i_error_pop_merge (p); 1551 if (stop) { 1552 p->ST = 1; 1553 p->CL = (long int) rde_stack_top (p->LS); 1554 } 1555 rde_stack_pop (p->LS, 1); 1556 return stop; 1557 } 1558 SCOPE int 1559 rde_param_i_kleene_abort (RDE_PARAM p) 1560 { 1561 int stop = !p->ST; 1562 if (stop) { 1563 p->CL = (long int) rde_stack_top (p->LS); 1564 } 1565 rde_stack_pop (p->LS, 1); 1566 return stop; 1567 } 1568 SCOPE int 1569 rde_param_i_seq_void2void (RDE_PARAM p) 1570 { 1571 rde_param_i_error_pop_merge (p); 1572 if (p->ST) { 1573 rde_stack_push (p->ES, p->ER); 1574 if (p->ER) { p->ER->refCount ++; } 1575 return 0; 1576 } else { 1577 p->CL = (long int) rde_stack_top (p->LS); 1578 rde_stack_pop (p->LS, 1); 1579 return 1; 1580 } 1581 } 1582 SCOPE int 1583 rde_param_i_seq_void2value (RDE_PARAM p) 1584 { 1585 rde_param_i_error_pop_merge (p); 1586 if (p->ST) { 1587 rde_stack_push (p->mark, (void*) rde_stack_size (p->ast)); 1588 rde_stack_push (p->ES, p->ER); 1589 if (p->ER) { p->ER->refCount ++; } 1590 return 0; 1591 } else { 1592 p->CL = (long int) rde_stack_top (p->LS); 1593 rde_stack_pop (p->LS, 1); 1594 return 1; 1595 } 1596 } 1597 SCOPE int 1598 rde_param_i_seq_value2value (RDE_PARAM p) 1599 { 1600 rde_param_i_error_pop_merge (p); 1601 if (p->ST) { 1602 rde_stack_push (p->ES, p->ER); 1603 if (p->ER) { p->ER->refCount ++; } 1604 return 0; 1605 } else { 1606 long int trim = (long int) rde_stack_top (p->mark); 1607 rde_stack_pop (p->mark, 1); 1608 rde_stack_trim (p->ast, trim); 1609 p->CL = (long int) rde_stack_top (p->LS); 1610 rde_stack_pop (p->LS, 1); 1611 return 1; 1612 } 1613 } 1614 SCOPE int 1615 rde_param_i_bra_void2void (RDE_PARAM p) 1616 { 1617 rde_param_i_error_pop_merge (p); 1618 if (p->ST) { 1619 rde_stack_pop (p->LS, 1); 1620 } else { 1621 p->CL = (long int) rde_stack_top (p->LS); 1622 rde_stack_push (p->ES, p->ER); 1623 if (p->ER) { p->ER->refCount ++; } 1624 } 1625 return p->ST; 1626 } 1627 SCOPE int 1628 rde_param_i_bra_void2value (RDE_PARAM p) 1629 { 1630 rde_param_i_error_pop_merge (p); 1631 if (p->ST) { 1632 rde_stack_pop (p->LS, 1); 1633 } else { 1634 rde_stack_push (p->mark, (void*) rde_stack_size (p->ast)); 1635 p->CL = (long int) rde_stack_top (p->LS); 1636 rde_stack_push (p->ES, p->ER); 1637 if (p->ER) { p->ER->refCount ++; } 1638 } 1639 return p->ST; 1640 } 1641 SCOPE int 1642 rde_param_i_bra_value2void (RDE_PARAM p) 1643 { 1644 rde_param_i_error_pop_merge (p); 1645 if (p->ST) { 1646 rde_stack_pop (p->mark, 1); 1647 rde_stack_pop (p->LS, 1); 1648 } else { 1649 long int trim = (long int) rde_stack_top (p->mark); 1650 rde_stack_pop (p->mark, 1); 1651 rde_stack_trim (p->ast, trim); 1652 p->CL = (long int) rde_stack_top (p->LS); 1653 rde_stack_push (p->ES, p->ER); 1654 if (p->ER) { p->ER->refCount ++; } 1655 } 1656 return p->ST; 1657 } 1658 SCOPE int 1659 rde_param_i_bra_value2value (RDE_PARAM p) 1660 { 1661 rde_param_i_error_pop_merge (p); 1662 if (p->ST) { 1663 rde_stack_pop (p->mark, 1); 1664 rde_stack_pop (p->LS, 1); 1665 } else { 1666 long int trim = (long int) rde_stack_top (p->mark); 1667 rde_stack_trim (p->ast, trim); 1668 p->CL = (long int) rde_stack_top (p->LS); 1669 rde_stack_push (p->ES, p->ER); 1670 if (p->ER) { p->ER->refCount ++; } 1671 } 1672 return p->ST; 1673 } 1674 SCOPE void 1675 rde_param_i_next_str (RDE_PARAM p, const char* str, long int m) 1676 { 1677 int at = p->CL; 1678 1679 while (*str) { 1680 rde_param_i_input_next (p, m); 1681 if (!p->ST) { 1682 p->ER->loc = at+1; 1683 p->CL = at; 1684 return; 1685 } 1686 rde_param_i_test_char (p, str, m); 1687 if (!p->ST) { 1688 p->ER->loc = at+1; 1689 p->CL = at; 1690 return; 1691 } 1692 str = Tcl_UtfNext (str); 1693 } 1694 } 1695 SCOPE void 1696 rde_param_i_next_class (RDE_PARAM p, const char* class, long int m) 1697 { 1698 rde_param_i_input_next (p, m); 1699 if (!p->ST) return; 1700 while (*class) { 1701 p->ST = Tcl_UtfNcmp (p->CC, class, 1) == 0; 1702 if (p->ST) { 1703 ER_CLEAR (p); 1704 return; 1705 } 1706 class = Tcl_UtfNext (class); 1707 } 1708 error_set (p, m); 1709 p->CL --; 1710 } 1711 1712 1713 } 1714 1715 # # ## ### ###### ######## ############# 1716 ## BEGIN of GENERATED CODE. DO NOT EDIT. 1717 1718 critcl::ccode { 1719 /* -*- c -*- */ 1720 1721 /* 1722 * Declaring the parse functions 1723 */ 1724 1725 static void sym_Expression (RDE_PARAM p); 1726 static void sym_Function (RDE_PARAM p); 1727 static void sequence_9 (RDE_PARAM p); 1728 static void sym_Sinus (RDE_PARAM p); 1729 1730 /* 1731 * Precomputed table of strings (symbols, error messages, etc.). 1732 */ 1733 1734 static char const* p_string [22] = { 1735 /* 0 = */ "alnum", 1736 /* 1 = */ "alpha", 1737 /* 2 = */ "ascii", 1738 /* 3 = */ "control", 1739 /* 4 = */ "ddigit", 1740 /* 5 = */ "digit", 1741 /* 6 = */ "graph", 1742 /* 7 = */ "lower", 1743 /* 8 = */ "print", 1744 /* 9 = */ "punct", 1745 /* 10 = */ "space", 1746 /* 11 = */ "upper", 1747 /* 12 = */ "wordchar", 1748 /* 13 = */ "xdigit", 1749 /* 14 = */ "n Expression", 1750 /* 15 = */ "Expression", 1751 /* 16 = */ "n Function", 1752 /* 17 = */ "Function", 1753 /* 18 = */ "str sin(", 1754 /* 19 = */ "t )", 1755 /* 20 = */ "n Sinus", 1756 /* 21 = */ "Sinus" 1757 }; 1758 1759 /* 1760 * Grammar Start Expression 1761 */ 1762 1763 static void MAIN (RDE_PARAM p) { 1764 sym_Expression (p); 1765 return; 1766 } 1767 1768 /* 1769 * value Symbol 'Expression' 1770 */ 1771 1772 static void sym_Expression (RDE_PARAM p) { 1773 /* 1774 * (Function) 1775 */ 1776 1777 if (rde_param_i_symbol_start_d (p, 15)) return ; 1778 sym_Function (p); 1779 rde_param_i_symbol_done_d_reduce (p, 15, 14); 1780 return; 1781 } 1782 1783 /* 1784 * value Symbol 'Function' 1785 */ 1786 1787 static void sym_Function (RDE_PARAM p) { 1788 /* 1789 * (Sinus) 1790 */ 1791 1792 if (rde_param_i_symbol_start_d (p, 17)) return ; 1793 sym_Sinus (p); 1794 rde_param_i_symbol_done_d_reduce (p, 17, 16); 1795 return; 1796 } 1797 1798 /* 1799 * value Symbol 'Sinus' 1800 */ 1801 1802 static void sym_Sinus (RDE_PARAM p) { 1803 /* 1804 * x 1805 * "sin\(" 1806 * (Expression) 1807 * '\)' 1808 */ 1809 1810 if (rde_param_i_symbol_start_d (p, 21)) return ; 1811 sequence_9 (p); 1812 rde_param_i_symbol_done_d_reduce (p, 21, 20); 1813 return; 1814 } 1815 1816 static void sequence_9 (RDE_PARAM p) { 1817 /* 1818 * x 1819 * "sin\(" 1820 * (Expression) 1821 * '\)' 1822 */ 1823 1824 rde_param_i_state_push_void (p); 1825 rde_param_i_next_str (p, "sin(", 18); 1826 if (rde_param_i_seq_void2value(p)) return; 1827 sym_Expression (p); 1828 if (rde_param_i_seq_value2value(p)) return; 1829 rde_param_i_next_char (p, ")", 19); 1830 rde_param_i_state_merge_value (p); 1831 return; 1832 } 1833 1834 } 1835 1836 ## END of GENERATED CODE. DO NOT EDIT. 1837 # # ## ### ###### ######## ############# 1838 1839 # # ## ### ###### ######## ############# 1840 ## Global PARSER management, per interp 1841 1842 critcl::ccode { 1843 /* -*- c -*- */ 1844 1845 typedef struct PARSERg { 1846 long int counter; 1847 char buf [50]; 1848 } PARSERg; 1849 1850 static void 1851 PARSERgRelease (ClientData cd, Tcl_Interp* interp) 1852 { 1853 ckfree((char*) cd); 1854 } 1855 1856 static const char* 1857 PARSERnewName (Tcl_Interp* interp) 1858 { 1859#define KEY "tcllib/parser/PACKAGE/critcl" 1860 1861 Tcl_InterpDeleteProc* proc = PARSERgRelease; 1862 PARSERg* parserg; 1863 1864 parserg = Tcl_GetAssocData (interp, KEY, &proc); 1865 if (parserg == NULL) { 1866 parserg = (PARSERg*) ckalloc (sizeof (PARSERg)); 1867 parserg->counter = 0; 1868 1869 Tcl_SetAssocData (interp, KEY, proc, 1870 (ClientData) parserg); 1871 } 1872 1873 parserg->counter ++; 1874 sprintf (parserg->buf, "PARSER%ld", parserg->counter); 1875 return parserg->buf; 1876#undef KEY 1877 } 1878 1879 static void 1880 PARSERdeleteCmd (ClientData clientData) 1881 { 1882 /* 1883 * Release the whole PARSER 1884 * (Low-level engine only actually). 1885 */ 1886 rde_param_del ((RDE_PARAM) clientData); 1887 } 1888 } 1889 1890 # # ## ### ##### ######## ############# 1891 ## Functions implementing the object methods, and helper. 1892 1893 critcl::ccode { 1894 static int COMPLETE (RDE_PARAM p, Tcl_Interp* interp); 1895 1896 static int parser_PARSE (RDE_PARAM p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1897 { 1898 int mode; 1899 Tcl_Channel chan; 1900 1901 if (objc != 3) { 1902 Tcl_WrongNumArgs (interp, 2, objv, "chan"); 1903 return TCL_ERROR; 1904 } 1905 1906 chan = Tcl_GetChannel(interp, 1907 Tcl_GetString (objv[2]), 1908 &mode); 1909 1910 if (!chan) { 1911 return TCL_ERROR; 1912 } 1913 1914 rde_param_reset (p, chan); 1915 MAIN (p) ; /* Entrypoint for the generated code. */ 1916 return COMPLETE (p, interp); 1917 } 1918 1919 static int parser_PARSET (RDE_PARAM p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1920 { 1921 char* buf; 1922 int len; 1923 1924 if (objc != 3) { 1925 Tcl_WrongNumArgs (interp, 2, objv, "text"); 1926 return TCL_ERROR; 1927 } 1928 1929 buf = Tcl_GetStringFromObj (objv[2], &len); 1930 1931 rde_param_reset (p, NULL); 1932 rde_param_data (p, buf, len); 1933 MAIN (p) ; /* Entrypoint for the generated code. */ 1934 return COMPLETE (p, interp); 1935 } 1936 1937 /* See also rde_critcl/m.c, param_COMPLETE() */ 1938 static int COMPLETE (RDE_PARAM p, Tcl_Interp* interp) 1939 { 1940 if (rde_param_query_st (p)) { 1941 long int ac; 1942 Tcl_Obj** av; 1943 1944 rde_param_query_ast (p, &ac, &av); 1945 1946 if (ac > 1) { 1947 Tcl_Obj** lv = NALLOC (3+ac, Tcl_Obj*); 1948 1949 memcpy(lv + 3, av, ac * sizeof (Tcl_Obj*)); 1950 lv [0] = Tcl_NewObj (); 1951 lv [1] = Tcl_NewIntObj (1 + rde_param_query_lstop (p)); 1952 lv [2] = Tcl_NewIntObj (rde_param_query_cl (p)); 1953 1954 Tcl_SetObjResult (interp, Tcl_NewListObj (3, lv)); 1955 ckfree ((char*) lv); 1956 1957 } else if (ac == 0) { 1958 /* 1959 * Match, but no AST. This is possible if the grammar 1960 * consists of only the start expression. 1961 */ 1962 Tcl_SetObjResult (interp, Tcl_NewStringObj ("",-1)); 1963 } else { 1964 Tcl_SetObjResult (interp, av [0]); 1965 } 1966 1967 return TCL_OK; 1968 } else { 1969 Tcl_Obj* xv [1]; 1970 const ERROR_STATE* er = rde_param_query_er (p); 1971 Tcl_Obj* res = rde_param_query_er_tcl (p, er); 1972 /* res = list (location, list(msg)) */ 1973 1974 /* Stick the exception type-tag before the existing elements */ 1975 xv [0] = Tcl_NewStringObj ("pt::rde",-1); 1976 Tcl_ListObjReplace(interp, res, 0, 0, 1, xv); 1977 1978 Tcl_SetErrorCode (interp, "PT", "RDE", "SYNTAX", NULL); 1979 Tcl_SetObjResult (interp, res); 1980 return TCL_ERROR; 1981 } 1982 } 1983 } 1984 1985 # # ## ### ##### ######## ############# 1986 ## Object command, method dispatch. 1987 1988 critcl::ccode { 1989 static int parser_objcmd (ClientData cd, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 1990 { 1991 RDE_PARAM p = (RDE_PARAM) cd; 1992 int m, res; 1993 1994 static CONST char* methods [] = { 1995 "destroy", "parse", "parset", NULL 1996 }; 1997 enum methods { 1998 M_DESTROY, M_PARSE, M_PARSET 1999 }; 2000 2001 if (objc < 2) { 2002 Tcl_WrongNumArgs (interp, objc, objv, "option ?arg arg ...?"); 2003 return TCL_ERROR; 2004 } else if (Tcl_GetIndexFromObj (interp, objv [1], methods, "option", 2005 0, &m) != TCL_OK) { 2006 return TCL_ERROR; 2007 } 2008 2009 /* Dispatch to methods. They check the #args in 2010 * detail before performing the requested 2011 * functionality 2012 */ 2013 2014 switch (m) { 2015 case M_DESTROY: 2016 if (objc != 2) { 2017 Tcl_WrongNumArgs (interp, 2, objv, NULL); 2018 return TCL_ERROR; 2019 } 2020 2021 Tcl_DeleteCommandFromToken(interp, (Tcl_Command) rde_param_query_clientdata (p)); 2022 return TCL_OK; 2023 2024 case M_PARSE: res = parser_PARSE (p, interp, objc, objv); break; 2025 case M_PARSET: res = parser_PARSET (p, interp, objc, objv); break; 2026 default: 2027 /* Not coming to this place */ 2028 ASSERT (0,"Reached unreachable location"); 2029 } 2030 2031 return res; 2032 } 2033 } 2034 2035 # # ## ### ##### ######## ############# 2036 # Class command, i.e. object construction. 2037 2038 critcl::ccommand PARSER_critcl {dummy interp objc objv} { 2039 /* 2040 * Syntax: No arguments beyond the name 2041 */ 2042 2043 RDE_PARAM parser; 2044 CONST char* name; 2045 Tcl_Obj* fqn; 2046 Tcl_CmdInfo ci; 2047 Tcl_Command c; 2048 2049#define USAGE "?name?" 2050 2051 if ((objc != 2) && (objc != 1)) { 2052 Tcl_WrongNumArgs (interp, 1, objv, USAGE); 2053 return TCL_ERROR; 2054 } 2055 2056 if (objc < 2) { 2057 name = PARSERnewName (interp); 2058 } else { 2059 name = Tcl_GetString (objv [1]); 2060 } 2061 2062 if (!Tcl_StringMatch (name, "::*")) { 2063 /* Relative name. Prefix with current namespace */ 2064 2065 Tcl_Eval (interp, "namespace current"); 2066 fqn = Tcl_GetObjResult (interp); 2067 fqn = Tcl_DuplicateObj (fqn); 2068 Tcl_IncrRefCount (fqn); 2069 2070 if (!Tcl_StringMatch (Tcl_GetString (fqn), "::")) { 2071 Tcl_AppendToObj (fqn, "::", -1); 2072 } 2073 Tcl_AppendToObj (fqn, name, -1); 2074 } else { 2075 fqn = Tcl_NewStringObj (name, -1); 2076 Tcl_IncrRefCount (fqn); 2077 } 2078 Tcl_ResetResult (interp); 2079 2080 if (Tcl_GetCommandInfo (interp, 2081 Tcl_GetString (fqn), 2082 &ci)) { 2083 Tcl_Obj* err; 2084 2085 err = Tcl_NewObj (); 2086 Tcl_AppendToObj (err, "command \"", -1); 2087 Tcl_AppendObjToObj (err, fqn); 2088 Tcl_AppendToObj (err, "\" already exists", -1); 2089 2090 Tcl_DecrRefCount (fqn); 2091 Tcl_SetObjResult (interp, err); 2092 return TCL_ERROR; 2093 } 2094 2095 parser = rde_param_new (sizeof(p_string)/sizeof(char*), (char**) p_string); 2096 c = Tcl_CreateObjCommand (interp, Tcl_GetString (fqn), 2097 parser_objcmd, (ClientData) parser, 2098 PARSERdeleteCmd); 2099 rde_param_clientdata (parser, (ClientData) c); 2100 Tcl_SetObjResult (interp, fqn); 2101 Tcl_DecrRefCount (fqn); 2102 return TCL_OK; 2103 } 2104 2105 ## 2106 # # ## ### ##### ######## ############# 2107} 2108 2109# # ## ### ##### ######## ############# ##################### 2110## Ready (Note: Our package provide is at the top). 2111return 2112