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