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