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