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_AddOp (RDE_PARAM p); 1726 static void sym_Digit (RDE_PARAM p); 1727 static void sequence_9 (RDE_PARAM p); 1728 static void sequence_14 (RDE_PARAM p); 1729 static void kleene_16 (RDE_PARAM p); 1730 static void sequence_18 (RDE_PARAM p); 1731 static void choice_20 (RDE_PARAM p); 1732 static void sym_Expression (RDE_PARAM p); 1733 static void sequence_26 (RDE_PARAM p); 1734 static void kleene_28 (RDE_PARAM p); 1735 static void sequence_30 (RDE_PARAM p); 1736 static void sym_Factor (RDE_PARAM p); 1737 static void sym_MulOp (RDE_PARAM p); 1738 static void optional_36 (RDE_PARAM p); 1739 static void poskleene_39 (RDE_PARAM p); 1740 static void sequence_41 (RDE_PARAM p); 1741 static void sym_Number (RDE_PARAM p); 1742 static void sym_Sign (RDE_PARAM p); 1743 static void sym_Term (RDE_PARAM p); 1744 1745 /* 1746 * Precomputed table of strings (symbols, error messages, etc.). 1747 */ 1748 1749 static char const* p_string [35] = { 1750 /* 0 = */ "alnum", 1751 /* 1 = */ "alpha", 1752 /* 2 = */ "ascii", 1753 /* 3 = */ "control", 1754 /* 4 = */ "ddigit", 1755 /* 5 = */ "digit", 1756 /* 6 = */ "graph", 1757 /* 7 = */ "lower", 1758 /* 8 = */ "print", 1759 /* 9 = */ "punct", 1760 /* 10 = */ "space", 1761 /* 11 = */ "upper", 1762 /* 12 = */ "wordchar", 1763 /* 13 = */ "xdigit", 1764 /* 14 = */ "cl -+", 1765 /* 15 = */ "n AddOp", 1766 /* 16 = */ "AddOp", 1767 /* 17 = */ "cl 0123456789", 1768 /* 18 = */ "n Digit", 1769 /* 19 = */ "Digit", 1770 /* 20 = */ "t (", 1771 /* 21 = */ "t )", 1772 /* 22 = */ "n Expression", 1773 /* 23 = */ "Expression", 1774 /* 24 = */ "n Factor", 1775 /* 25 = */ "Factor", 1776 /* 26 = */ "cl */", 1777 /* 27 = */ "n MulOp", 1778 /* 28 = */ "MulOp", 1779 /* 29 = */ "n Number", 1780 /* 30 = */ "Number", 1781 /* 31 = */ "n Sign", 1782 /* 32 = */ "Sign", 1783 /* 33 = */ "n Term", 1784 /* 34 = */ "Term" 1785 }; 1786 1787 /* 1788 * Grammar Start Expression 1789 */ 1790 1791 static void MAIN (RDE_PARAM p) { 1792 sym_Expression (p); 1793 return; 1794 } 1795 1796 /* 1797 * value Symbol 'AddOp' 1798 */ 1799 1800 static void sym_AddOp (RDE_PARAM p) { 1801 /* 1802 * [-+] 1803 */ 1804 1805 if (rde_param_i_symbol_start (p, 16)) return ; 1806 rde_param_i_next_class (p, "-+", 14); 1807 rde_param_i_symbol_done_leaf (p, 16, 15); 1808 return; 1809 } 1810 1811 /* 1812 * value Symbol 'Digit' 1813 */ 1814 1815 static void sym_Digit (RDE_PARAM p) { 1816 /* 1817 * [0123456789] 1818 */ 1819 1820 if (rde_param_i_symbol_start (p, 19)) return ; 1821 rde_param_i_next_class (p, "0123456789", 17); 1822 rde_param_i_symbol_done_leaf (p, 19, 18); 1823 return; 1824 } 1825 1826 /* 1827 * value Symbol 'Expression' 1828 */ 1829 1830 static void sym_Expression (RDE_PARAM p) { 1831 /* 1832 * / 1833 * x 1834 * '\(' 1835 * (Expression) 1836 * '\)' 1837 * x 1838 * (Factor) 1839 * * 1840 * x 1841 * (MulOp) 1842 * (Factor) 1843 */ 1844 1845 if (rde_param_i_symbol_start_d (p, 23)) return ; 1846 choice_20 (p); 1847 rde_param_i_symbol_done_d_reduce (p, 23, 22); 1848 return; 1849 } 1850 1851 static void choice_20 (RDE_PARAM p) { 1852 /* 1853 * / 1854 * x 1855 * '\(' 1856 * (Expression) 1857 * '\)' 1858 * x 1859 * (Factor) 1860 * * 1861 * x 1862 * (MulOp) 1863 * (Factor) 1864 */ 1865 1866 rde_param_i_state_push_value (p); 1867 sequence_9 (p); 1868 if (rde_param_i_bra_value2value(p)) return; 1869 sequence_18 (p); 1870 rde_param_i_state_merge_value (p); 1871 return; 1872 } 1873 1874 static void sequence_9 (RDE_PARAM p) { 1875 /* 1876 * x 1877 * '\(' 1878 * (Expression) 1879 * '\)' 1880 */ 1881 1882 rde_param_i_state_push_void (p); 1883 rde_param_i_next_char (p, "(", 20); 1884 if (rde_param_i_seq_void2value(p)) return; 1885 sym_Expression (p); 1886 if (rde_param_i_seq_value2value(p)) return; 1887 rde_param_i_next_char (p, ")", 21); 1888 rde_param_i_state_merge_value (p); 1889 return; 1890 } 1891 1892 static void sequence_18 (RDE_PARAM p) { 1893 /* 1894 * x 1895 * (Factor) 1896 * * 1897 * x 1898 * (MulOp) 1899 * (Factor) 1900 */ 1901 1902 rde_param_i_state_push_value (p); 1903 sym_Factor (p); 1904 if (rde_param_i_seq_value2value(p)) return; 1905 kleene_16 (p); 1906 rde_param_i_state_merge_value (p); 1907 return; 1908 } 1909 1910 static void kleene_16 (RDE_PARAM p) { 1911 /* 1912 * * 1913 * x 1914 * (MulOp) 1915 * (Factor) 1916 */ 1917 1918 while (1) { 1919 rde_param_i_state_push_2 (p); 1920 sequence_14 (p); 1921 if (rde_param_i_kleene_close(p)) return; 1922 } 1923 return; 1924 } 1925 1926 static void sequence_14 (RDE_PARAM p) { 1927 /* 1928 * x 1929 * (MulOp) 1930 * (Factor) 1931 */ 1932 1933 rde_param_i_state_push_value (p); 1934 sym_MulOp (p); 1935 if (rde_param_i_seq_value2value(p)) return; 1936 sym_Factor (p); 1937 rde_param_i_state_merge_value (p); 1938 return; 1939 } 1940 1941 /* 1942 * value Symbol 'Factor' 1943 */ 1944 1945 static void sym_Factor (RDE_PARAM p) { 1946 /* 1947 * x 1948 * (Term) 1949 * * 1950 * x 1951 * (AddOp) 1952 * (Term) 1953 */ 1954 1955 if (rde_param_i_symbol_start_d (p, 25)) return ; 1956 sequence_30 (p); 1957 rde_param_i_symbol_done_d_reduce (p, 25, 24); 1958 return; 1959 } 1960 1961 static void sequence_30 (RDE_PARAM p) { 1962 /* 1963 * x 1964 * (Term) 1965 * * 1966 * x 1967 * (AddOp) 1968 * (Term) 1969 */ 1970 1971 rde_param_i_state_push_value (p); 1972 sym_Term (p); 1973 if (rde_param_i_seq_value2value(p)) return; 1974 kleene_28 (p); 1975 rde_param_i_state_merge_value (p); 1976 return; 1977 } 1978 1979 static void kleene_28 (RDE_PARAM p) { 1980 /* 1981 * * 1982 * x 1983 * (AddOp) 1984 * (Term) 1985 */ 1986 1987 while (1) { 1988 rde_param_i_state_push_2 (p); 1989 sequence_26 (p); 1990 if (rde_param_i_kleene_close(p)) return; 1991 } 1992 return; 1993 } 1994 1995 static void sequence_26 (RDE_PARAM p) { 1996 /* 1997 * x 1998 * (AddOp) 1999 * (Term) 2000 */ 2001 2002 rde_param_i_state_push_value (p); 2003 sym_AddOp (p); 2004 if (rde_param_i_seq_value2value(p)) return; 2005 sym_Term (p); 2006 rde_param_i_state_merge_value (p); 2007 return; 2008 } 2009 2010 /* 2011 * value Symbol 'MulOp' 2012 */ 2013 2014 static void sym_MulOp (RDE_PARAM p) { 2015 /* 2016 * [\u002a\u002f] 2017 */ 2018 2019 if (rde_param_i_symbol_start (p, 28)) return ; 2020 rde_param_i_next_class (p, "*/", 26); 2021 rde_param_i_symbol_done_leaf (p, 28, 27); 2022 return; 2023 } 2024 2025 /* 2026 * value Symbol 'Number' 2027 */ 2028 2029 static void sym_Number (RDE_PARAM p) { 2030 /* 2031 * x 2032 * ? 2033 * (Sign) 2034 * + 2035 * (Digit) 2036 */ 2037 2038 if (rde_param_i_symbol_start_d (p, 30)) return ; 2039 sequence_41 (p); 2040 rde_param_i_symbol_done_d_reduce (p, 30, 29); 2041 return; 2042 } 2043 2044 static void sequence_41 (RDE_PARAM p) { 2045 /* 2046 * x 2047 * ? 2048 * (Sign) 2049 * + 2050 * (Digit) 2051 */ 2052 2053 rde_param_i_state_push_value (p); 2054 optional_36 (p); 2055 if (rde_param_i_seq_value2value(p)) return; 2056 poskleene_39 (p); 2057 rde_param_i_state_merge_value (p); 2058 return; 2059 } 2060 2061 static void optional_36 (RDE_PARAM p) { 2062 /* 2063 * ? 2064 * (Sign) 2065 */ 2066 2067 rde_param_i_state_push_2 (p); 2068 sym_Sign (p); 2069 rde_param_i_state_merge_ok (p); 2070 return; 2071 } 2072 2073 static void poskleene_39 (RDE_PARAM p) { 2074 /* 2075 * + 2076 * (Digit) 2077 */ 2078 2079 rde_param_i_loc_push (p); 2080 sym_Digit (p); 2081 if (rde_param_i_kleene_abort(p)) return; 2082 while (1) { 2083 rde_param_i_state_push_2 (p); 2084 sym_Digit (p); 2085 if (rde_param_i_kleene_close(p)) return; 2086 } 2087 return; 2088 } 2089 2090 /* 2091 * value Symbol 'Sign' 2092 */ 2093 2094 static void sym_Sign (RDE_PARAM p) { 2095 /* 2096 * [-+] 2097 */ 2098 2099 if (rde_param_i_symbol_start (p, 32)) return ; 2100 rde_param_i_next_class (p, "-+", 14); 2101 rde_param_i_symbol_done_leaf (p, 32, 31); 2102 return; 2103 } 2104 2105 /* 2106 * value Symbol 'Term' 2107 */ 2108 2109 static void sym_Term (RDE_PARAM p) { 2110 /* 2111 * (Number) 2112 */ 2113 2114 if (rde_param_i_symbol_start_d (p, 34)) return ; 2115 sym_Number (p); 2116 rde_param_i_symbol_done_d_reduce (p, 34, 33); 2117 return; 2118 } 2119 2120 } 2121 2122 ## END of GENERATED CODE. DO NOT EDIT. 2123 # # ## ### ###### ######## ############# 2124 2125 # # ## ### ###### ######## ############# 2126 ## Global PARSER management, per interp 2127 2128 critcl::ccode { 2129 /* -*- c -*- */ 2130 2131 typedef struct PARSERg { 2132 long int counter; 2133 char buf [50]; 2134 } PARSERg; 2135 2136 static void 2137 PARSERgRelease (ClientData cd, Tcl_Interp* interp) 2138 { 2139 ckfree((char*) cd); 2140 } 2141 2142 static const char* 2143 PARSERnewName (Tcl_Interp* interp) 2144 { 2145#define KEY "tcllib/parser/PACKAGE/critcl" 2146 2147 Tcl_InterpDeleteProc* proc = PARSERgRelease; 2148 PARSERg* parserg; 2149 2150 parserg = Tcl_GetAssocData (interp, KEY, &proc); 2151 if (parserg == NULL) { 2152 parserg = (PARSERg*) ckalloc (sizeof (PARSERg)); 2153 parserg->counter = 0; 2154 2155 Tcl_SetAssocData (interp, KEY, proc, 2156 (ClientData) parserg); 2157 } 2158 2159 parserg->counter ++; 2160 sprintf (parserg->buf, "PARSER%ld", parserg->counter); 2161 return parserg->buf; 2162#undef KEY 2163 } 2164 2165 static void 2166 PARSERdeleteCmd (ClientData clientData) 2167 { 2168 /* 2169 * Release the whole PARSER 2170 * (Low-level engine only actually). 2171 */ 2172 rde_param_del ((RDE_PARAM) clientData); 2173 } 2174 } 2175 2176 # # ## ### ##### ######## ############# 2177 ## Functions implementing the object methods, and helper. 2178 2179 critcl::ccode { 2180 static int COMPLETE (RDE_PARAM p, Tcl_Interp* interp); 2181 2182 static int parser_PARSE (RDE_PARAM p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 2183 { 2184 int mode; 2185 Tcl_Channel chan; 2186 2187 if (objc != 3) { 2188 Tcl_WrongNumArgs (interp, 2, objv, "chan"); 2189 return TCL_ERROR; 2190 } 2191 2192 chan = Tcl_GetChannel(interp, 2193 Tcl_GetString (objv[2]), 2194 &mode); 2195 2196 if (!chan) { 2197 return TCL_ERROR; 2198 } 2199 2200 rde_param_reset (p, chan); 2201 MAIN (p) ; /* Entrypoint for the generated code. */ 2202 return COMPLETE (p, interp); 2203 } 2204 2205 static int parser_PARSET (RDE_PARAM p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 2206 { 2207 char* buf; 2208 int len; 2209 2210 if (objc != 3) { 2211 Tcl_WrongNumArgs (interp, 2, objv, "text"); 2212 return TCL_ERROR; 2213 } 2214 2215 buf = Tcl_GetStringFromObj (objv[2], &len); 2216 2217 rde_param_reset (p, NULL); 2218 rde_param_data (p, buf, len); 2219 MAIN (p) ; /* Entrypoint for the generated code. */ 2220 return COMPLETE (p, interp); 2221 } 2222 2223 /* See also rde_critcl/m.c, param_COMPLETE() */ 2224 static int COMPLETE (RDE_PARAM p, Tcl_Interp* interp) 2225 { 2226 if (rde_param_query_st (p)) { 2227 long int ac; 2228 Tcl_Obj** av; 2229 2230 rde_param_query_ast (p, &ac, &av); 2231 2232 if (ac > 1) { 2233 Tcl_Obj** lv = NALLOC (3+ac, Tcl_Obj*); 2234 2235 memcpy(lv + 3, av, ac * sizeof (Tcl_Obj*)); 2236 lv [0] = Tcl_NewObj (); 2237 lv [1] = Tcl_NewIntObj (1 + rde_param_query_lstop (p)); 2238 lv [2] = Tcl_NewIntObj (rde_param_query_cl (p)); 2239 2240 Tcl_SetObjResult (interp, Tcl_NewListObj (3, lv)); 2241 ckfree ((char*) lv); 2242 2243 } else if (ac == 0) { 2244 /* 2245 * Match, but no AST. This is possible if the grammar 2246 * consists of only the start expression. 2247 */ 2248 Tcl_SetObjResult (interp, Tcl_NewStringObj ("",-1)); 2249 } else { 2250 Tcl_SetObjResult (interp, av [0]); 2251 } 2252 2253 return TCL_OK; 2254 } else { 2255 Tcl_Obj* xv [1]; 2256 const ERROR_STATE* er = rde_param_query_er (p); 2257 Tcl_Obj* res = rde_param_query_er_tcl (p, er); 2258 /* res = list (location, list(msg)) */ 2259 2260 /* Stick the exception type-tag before the existing elements */ 2261 xv [0] = Tcl_NewStringObj ("pt::rde",-1); 2262 Tcl_ListObjReplace(interp, res, 0, 0, 1, xv); 2263 2264 Tcl_SetErrorCode (interp, "PT", "RDE", "SYNTAX", NULL); 2265 Tcl_SetObjResult (interp, res); 2266 return TCL_ERROR; 2267 } 2268 } 2269 } 2270 2271 # # ## ### ##### ######## ############# 2272 ## Object command, method dispatch. 2273 2274 critcl::ccode { 2275 static int parser_objcmd (ClientData cd, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv) 2276 { 2277 RDE_PARAM p = (RDE_PARAM) cd; 2278 int m, res; 2279 2280 static CONST char* methods [] = { 2281 "destroy", "parse", "parset", NULL 2282 }; 2283 enum methods { 2284 M_DESTROY, M_PARSE, M_PARSET 2285 }; 2286 2287 if (objc < 2) { 2288 Tcl_WrongNumArgs (interp, objc, objv, "option ?arg arg ...?"); 2289 return TCL_ERROR; 2290 } else if (Tcl_GetIndexFromObj (interp, objv [1], methods, "option", 2291 0, &m) != TCL_OK) { 2292 return TCL_ERROR; 2293 } 2294 2295 /* Dispatch to methods. They check the #args in 2296 * detail before performing the requested 2297 * functionality 2298 */ 2299 2300 switch (m) { 2301 case M_DESTROY: 2302 if (objc != 2) { 2303 Tcl_WrongNumArgs (interp, 2, objv, NULL); 2304 return TCL_ERROR; 2305 } 2306 2307 Tcl_DeleteCommandFromToken(interp, (Tcl_Command) rde_param_query_clientdata (p)); 2308 return TCL_OK; 2309 2310 case M_PARSE: res = parser_PARSE (p, interp, objc, objv); break; 2311 case M_PARSET: res = parser_PARSET (p, interp, objc, objv); break; 2312 default: 2313 /* Not coming to this place */ 2314 ASSERT (0,"Reached unreachable location"); 2315 } 2316 2317 return res; 2318 } 2319 } 2320 2321 # # ## ### ##### ######## ############# 2322 # Class command, i.e. object construction. 2323 2324 critcl::ccommand PARSER_critcl {dummy interp objc objv} { 2325 /* 2326 * Syntax: No arguments beyond the name 2327 */ 2328 2329 RDE_PARAM parser; 2330 CONST char* name; 2331 Tcl_Obj* fqn; 2332 Tcl_CmdInfo ci; 2333 Tcl_Command c; 2334 2335#define USAGE "?name?" 2336 2337 if ((objc != 2) && (objc != 1)) { 2338 Tcl_WrongNumArgs (interp, 1, objv, USAGE); 2339 return TCL_ERROR; 2340 } 2341 2342 if (objc < 2) { 2343 name = PARSERnewName (interp); 2344 } else { 2345 name = Tcl_GetString (objv [1]); 2346 } 2347 2348 if (!Tcl_StringMatch (name, "::*")) { 2349 /* Relative name. Prefix with current namespace */ 2350 2351 Tcl_Eval (interp, "namespace current"); 2352 fqn = Tcl_GetObjResult (interp); 2353 fqn = Tcl_DuplicateObj (fqn); 2354 Tcl_IncrRefCount (fqn); 2355 2356 if (!Tcl_StringMatch (Tcl_GetString (fqn), "::")) { 2357 Tcl_AppendToObj (fqn, "::", -1); 2358 } 2359 Tcl_AppendToObj (fqn, name, -1); 2360 } else { 2361 fqn = Tcl_NewStringObj (name, -1); 2362 Tcl_IncrRefCount (fqn); 2363 } 2364 Tcl_ResetResult (interp); 2365 2366 if (Tcl_GetCommandInfo (interp, 2367 Tcl_GetString (fqn), 2368 &ci)) { 2369 Tcl_Obj* err; 2370 2371 err = Tcl_NewObj (); 2372 Tcl_AppendToObj (err, "command \"", -1); 2373 Tcl_AppendObjToObj (err, fqn); 2374 Tcl_AppendToObj (err, "\" already exists", -1); 2375 2376 Tcl_DecrRefCount (fqn); 2377 Tcl_SetObjResult (interp, err); 2378 return TCL_ERROR; 2379 } 2380 2381 parser = rde_param_new (sizeof(p_string)/sizeof(char*), (char**) p_string); 2382 c = Tcl_CreateObjCommand (interp, Tcl_GetString (fqn), 2383 parser_objcmd, (ClientData) parser, 2384 PARSERdeleteCmd); 2385 rde_param_clientdata (parser, (ClientData) c); 2386 Tcl_SetObjResult (interp, fqn); 2387 Tcl_DecrRefCount (fqn); 2388 return TCL_OK; 2389 } 2390 2391 ## 2392 # # ## ### ##### ######## ############# 2393} 2394 2395# # ## ### ##### ######## ############# ##################### 2396## Ready (Note: Our package provide is at the top). 2397return 2398