/************************************************************
**
** TEA-based C/PARAM implementation of the parsing
** expression grammar
**
**	TEMPLATE
**
** Generated from file	TEST
**            for user  unknown
**
* * ** *** ***** ******** ************* *********************/
	#include <string.h>
	#include <tcl.h>
	#include <stdlib.h>
	#include <ctype.h>
	#define SCOPE static

#line 1 "rde_critcl/util.h"

	#ifndef _RDE_UTIL_H
	#define _RDE_UTIL_H 1
	#ifndef SCOPE
	#define SCOPE
	#endif
	#define ALLOC(type)    (type *) ckalloc (sizeof (type))
	#define NALLOC(n,type) (type *) ckalloc ((n) * sizeof (type))
	#undef  RDE_DEBUG
	#define RDE_DEBUG 1
	#undef  RDE_TRACE
	#ifdef RDE_DEBUG
	#define STOPAFTER(x) { static int count = (x); count --; if (!count) { Tcl_Panic ("stop"); } }
	#define XSTR(x) #x
	#define STR(x) XSTR(x)
	#define RANGEOK(i,n) ((0 <= (i)) && (i < (n)))
	#define ASSERT(x,msg) if (!(x)) { Tcl_Panic (msg " (" #x "), in file " __FILE__ " @line " STR(__LINE__));}
	#define ASSERT_BOUNDS(i,n) ASSERT (RANGEOK(i,n),"array index out of bounds: " STR(i) " >= " STR(n))
	#else
	#define STOPAFTER(x)
	#define ASSERT(x,msg)
	#define ASSERT_BOUNDS(i,n)
	#endif
	#ifdef RDE_TRACE
	SCOPE void trace_enter (const char* fun);
	SCOPE void trace_return (const char *pat, ...);
	SCOPE void trace_printf (const char *pat, ...);
	#define ENTER(fun)          trace_enter (fun)
	#define RETURN(format,x)    trace_return (format,x) ; return x
	#define RETURNVOID          trace_return ("%s","(void)") ; return
	#define TRACE0(x)           trace_printf0 x
	#define TRACE(x)            trace_printf x
	#else
	#define ENTER(fun)
	#define RETURN(f,x) return x
	#define RETURNVOID  return
	#define TRACE0(x)
	#define TRACE(x)
	#endif
	#endif 
	

#line 1 "rde_critcl/stack.h"

	#ifndef _RDE_DS_STACK_H
	#define _RDE_DS_STACK_H 1
	typedef void (*RDE_STACK_CELL_FREE) (void* cell);
	typedef struct RDE_STACK_* RDE_STACK;
	static const int RDE_STACK_INITIAL_SIZE = 256;
	#endif 
	

#line 1 "rde_critcl/tc.h"

	#ifndef _RDE_DS_TC_H
	#define _RDE_DS_TC_H 1
	typedef struct RDE_TC_* RDE_TC;
	#endif 
	

#line 1 "rde_critcl/param.h"

	#ifndef _RDE_DS_PARAM_H
	#define _RDE_DS_PARAM_H 1
	typedef struct RDE_PARAM_* RDE_PARAM;
	typedef struct ERROR_STATE {
	    int       refCount;
	    long int  loc;
	    RDE_STACK msg; 
	} ERROR_STATE;
	typedef struct NC_STATE {
	    long int     CL;
	    long int     ST;
	    Tcl_Obj*     SV;
	    ERROR_STATE* ER;
	} NC_STATE;
	#endif 
	

#line 1 "rde_critcl/util.c"

	#ifdef RDE_TRACE
	typedef struct F_STACK {
	    const char*     str;
	    struct F_STACK* down;
	} F_STACK;
	static F_STACK* top   = 0;
	static int      level = 0;
	static void
	push (const char* str)
	{
	    F_STACK* new = ALLOC (F_STACK);
	    new->str = str;
	    new->down = top;
	    top = new;
	    level += 4;
	}
	static void
	pop (void)
	{
	    F_STACK* next = top->down;
	    level -= 4;
	    ckfree ((char*)top);
	    top = next;
	}
	static void
	indent (void)
	{
	    int i;
	    for (i = 0; i < level; i++) {
		fwrite(" ", 1, 1, stdout);
		fflush           (stdout);
	    }
	    if (top) {
		fwrite(top->str, 1, strlen(top->str), stdout);
		fflush                               (stdout);
	    }
	    fwrite(" ", 1, 1, stdout);
	    fflush           (stdout);
	}
	SCOPE void
	trace_enter (const char* fun)
	{
	    push (fun);
	    indent();
	    fwrite("ENTER\n", 1, 6, stdout);
	    fflush                 (stdout);
	}
	static char msg [1024*1024];
	SCOPE void
	trace_return (const char *pat, ...)
	{
	    int len;
	    va_list args;
	    indent();
	    fwrite("RETURN = ", 1, 9, stdout);
	    fflush                   (stdout);
	    va_start(args, pat);
	    len = vsprintf(msg, pat, args);
	    va_end(args);
	    msg[len++] = '\n';
	    msg[len] = '\0';
	    fwrite(msg, 1, len, stdout);
	    fflush             (stdout);
	    pop();
	}
	SCOPE void
	trace_printf (const char *pat, ...)
	{
	    int len;
	    va_list args;
	    indent();
	    va_start(args, pat);
	    len = vsprintf(msg, pat, args);
	    va_end(args);
	    msg[len++] = '\n';
	    msg[len] = '\0';
	    fwrite(msg, 1, len, stdout);
	    fflush             (stdout);
	}
	SCOPE void
	trace_printf0 (const char *pat, ...)
	{
	    int len;
	    va_list args;
	    va_start(args, pat);
	    len = vsprintf(msg, pat, args);
	    va_end(args);
	    msg[len++] = '\n';
	    msg[len] = '\0';
	    fwrite(msg, 1, len, stdout);
	    fflush             (stdout);
	}
	#endif
	

#line 1 "rde_critcl/stack.c"

	typedef struct RDE_STACK_ {
	    long int            max;   
	    long int            top;   
	    RDE_STACK_CELL_FREE freeCellProc; 
	    void**              cell;  
	} RDE_STACK_;
	
	SCOPE RDE_STACK
	rde_stack_new (RDE_STACK_CELL_FREE freeCellProc)
	{
	    RDE_STACK s = ALLOC (RDE_STACK_);
	    s->cell = NALLOC (RDE_STACK_INITIAL_SIZE, void*);
	    s->max  = RDE_STACK_INITIAL_SIZE;
	    s->top  = 0;
	    s->freeCellProc = freeCellProc;
	    return s;
	}
	SCOPE void
	rde_stack_del (RDE_STACK s)
	{
	    if (s->freeCellProc && s->top) {
		long int i;
		for (i=0; i < s->top; i++) {
		    ASSERT_BOUNDS(i,s->max);
		    s->freeCellProc ( s->cell [i] );
		}
	    }
	    ckfree ((char*) s->cell);
	    ckfree ((char*) s);
	}
	SCOPE void
	rde_stack_push (RDE_STACK s, void* item)
	{
	    if (s->top >= s->max) {
		long int new  = s->max ? (2 * s->max) : RDE_STACK_INITIAL_SIZE;
		void**   cell = (void**) ckrealloc ((char*) s->cell, new * sizeof(void*));
		ASSERT (cell,"Memory allocation failure for RDE stack");
		s->max  = new;
		s->cell = cell;
	    }
	    ASSERT_BOUNDS(s->top,s->max);
	    s->cell [s->top] = item;
	    s->top ++;
	}
	SCOPE void*
	rde_stack_top (RDE_STACK s)
	{
	    ASSERT_BOUNDS(s->top-1,s->max);
	    return s->cell [s->top - 1];
	}
	SCOPE void
	rde_stack_pop (RDE_STACK s, long int n)
	{
	    ASSERT (n >= 0, "Bad pop count");
	    if (n == 0) return;
	    if (s->freeCellProc) {
		while (n) {
		    s->top --;
		    ASSERT_BOUNDS(s->top,s->max);
		    s->freeCellProc ( s->cell [s->top] );
		    n --;
		}
	    } else {
		s->top -= n;
	    }
	}
	SCOPE void
	rde_stack_trim (RDE_STACK s, long int n)
	{
	    ASSERT (n >= 0, "Bad trimsize");
	    if (s->freeCellProc) {
		while (s->top > n) {
		    s->top --;
		    ASSERT_BOUNDS(s->top,s->max);
		    s->freeCellProc ( s->cell [s->top] );
		}
	    } else {
		s->top = n;
	    }
	}
	SCOPE void
	rde_stack_drop (RDE_STACK s, long int n)
	{
	    ASSERT (n >= 0, "Bad pop count");
	    if (n == 0) return;
	    s->top -= n;
	}
	SCOPE void
	rde_stack_move (RDE_STACK dst, RDE_STACK src)
	{
	    ASSERT (dst->freeCellProc == src->freeCellProc, "Ownership mismatch");
	    
	    while (src->top > 0) {
		src->top --;
		ASSERT_BOUNDS(src->top,src->max);
		rde_stack_push (dst, src->cell [src->top] );
	    }
	}
	SCOPE void
	rde_stack_get (RDE_STACK s, long int* cn, void*** cc)
	{
	    *cn = s->top;
	    *cc = s->cell;
	}
	SCOPE long int
	rde_stack_size (RDE_STACK s)
	{
	    return s->top;
	}
	

#line 1 "rde_critcl/tc.c"

	typedef struct RDE_TC_ {
	    int       max;   
	    int       num;   
	    char*     str;   
	    RDE_STACK off;   
	} RDE_TC_;
	
	SCOPE RDE_TC
	rde_tc_new (void)
	{
	    RDE_TC tc = ALLOC (RDE_TC_);
	    tc->max   = RDE_STACK_INITIAL_SIZE;
	    tc->num   = 0;
	    tc->str   = NALLOC (RDE_STACK_INITIAL_SIZE, char);
	    tc->off   = rde_stack_new (NULL);
	    return tc;
	}
	SCOPE void
	rde_tc_del (RDE_TC tc)
	{
	    rde_stack_del (tc->off);
	    ckfree (tc->str);
	    ckfree ((char*) tc);
	}
	SCOPE long int
	rde_tc_size (RDE_TC tc)
	{
	    return rde_stack_size (tc->off);
	}
	SCOPE void
	rde_tc_clear (RDE_TC tc)
	{
	    tc->num   = 0;
	    rde_stack_trim (tc->off,  0);
	}
	SCOPE char*
	rde_tc_append (RDE_TC tc, char* string, long int len)
	{
	    long int base = tc->num;
	    long int off  = tc->num;
	    char* ch;
	    int clen;
	    Tcl_UniChar uni;
	    if (len < 0) {
		len = strlen (string);
	    }
	    
	    if (!len) {
		return tc->str + base;
	    }
	    
	    if ((tc->num + len) >= tc->max) {
		int   new = len + (tc->max ? (2 * tc->max) : RDE_STACK_INITIAL_SIZE);
		char* str = ckrealloc (tc->str, new * sizeof(char));
		ASSERT (str,"Memory allocation failure for token character array");
		tc->max = new;
		tc->str = str;
	    }
	    tc->num += len;
	    ASSERT_BOUNDS(tc->num,tc->max);
	    ASSERT_BOUNDS(off,tc->max);
	    ASSERT_BOUNDS(off+len-1,tc->max);
	    ASSERT_BOUNDS(off+len-1,tc->num);
	    memcpy (tc->str + off, string, len);
	    
	    ch = string;
	    while (ch < (string + len)) {
		ASSERT_BOUNDS(off,tc->num);
		rde_stack_push (tc->off,  (void*) off);
		clen = Tcl_UtfToUniChar (ch, &uni);
		off += clen;
		ch  += clen;
	    }
	    return tc->str + base;
	}
	SCOPE void
	rde_tc_get (RDE_TC tc, int at, char** ch, long int* len)
	{
	    long int  oc, off, end;
	    void** ov;
	    rde_stack_get (tc->off, &oc, &ov);
	    ASSERT_BOUNDS(at,oc);
	    off = (long int) ov [at];
	    if ((at+1) == oc) {
		end = tc->num;
	    } else {
		end = (long int) ov [at+1];
	    }
	    TRACE (("rde_tc_get (RDE_TC %p, @ %d) => %d.[%d ... %d]/%d",tc,at,end-off,off,end-1,tc->num));
	    ASSERT_BOUNDS(off,tc->num);
	    ASSERT_BOUNDS(end-1,tc->num);
	    *ch = tc->str + off;
	    *len = end - off;
	}
	SCOPE void
	rde_tc_get_s (RDE_TC tc, int at, int last, char** ch, long int* len)
	{
	    long int  oc, off, end;
	    void** ov;
	    rde_stack_get (tc->off, &oc, &ov);
	    ASSERT_BOUNDS(at,oc);
	    ASSERT_BOUNDS(last,oc);
	    off = (long int) ov [at];
	    if ((last+1) == oc) {
		end = tc->num;
	    } else {
		end = (long int) ov [last+1];
	    }
	    TRACE (("rde_tc_get_s (RDE_TC %p, @ %d .. %d) => %d.[%d ... %d]/%d",tc,at,last,end-off,off,end-1,tc->num));
	    ASSERT_BOUNDS(off,tc->num);
	    ASSERT_BOUNDS(end-1,tc->num);
	    *ch = tc->str + off;
	    *len = end - off;
	}
	

#line 1 "rde_critcl/param.c"

	typedef struct RDE_PARAM_ {
	    Tcl_Channel   IN;
	    Tcl_Obj*      readbuf;
	    char*         CC; 
	    long int      CC_len;
	    RDE_TC        TC;
	    long int      CL;
	    RDE_STACK     LS; 
	    ERROR_STATE*  ER;
	    RDE_STACK     ES; 
	    long int      ST;
	    Tcl_Obj*      SV;
	    Tcl_HashTable NC;
	    
	    RDE_STACK    ast  ; 
	    RDE_STACK    mark ; 
	    
	    long int numstr; 
	    char**  string;
	    
	    ClientData clientData;
	} RDE_PARAM_;
	typedef int (*UniCharClass) (int);
	typedef enum test_class_id {
	    tc_alnum,
	    tc_alpha,
	    tc_ascii,
	    tc_control,
	    tc_ddigit,
	    tc_digit,
	    tc_graph,
	    tc_lower,
	    tc_printable,
	    tc_punct,
	    tc_space,
	    tc_upper,
	    tc_wordchar,
	    tc_xdigit
	} test_class_id;
	static void ast_node_free    (void* n);
	static void error_state_free (void* es);
	static void error_set        (RDE_PARAM p, long int s);
	static void nc_clear         (RDE_PARAM p);
	static int UniCharIsAscii    (int character);
	static int UniCharIsHexDigit (int character);
	static int UniCharIsDecDigit (int character);
	static void test_class (RDE_PARAM p, UniCharClass class, test_class_id id);
	static int  er_int_compare (const void* a, const void* b);
	#define SV_INIT(p)             \
	    p->SV = NULL; \
	    TRACE (("SV_INIT (%p => %p)", (p), (p)->SV))
	#define SV_SET(p,newsv)             \
	    if (((p)->SV) != (newsv)) { \
	        TRACE (("SV_CLEAR/set (%p => %p)", (p), (p)->SV)); \
	        if ((p)->SV) {                  \
		    Tcl_DecrRefCount ((p)->SV); \
	        }				    \
	        (p)->SV = (newsv);		    \
	        TRACE (("SV_SET       (%p => %p)", (p), (p)->SV)); \
	        if ((p)->SV) {                  \
		    Tcl_IncrRefCount ((p)->SV); \
	        } \
	    }
	#define SV_CLEAR(p)                 \
	    TRACE (("SV_CLEAR (%p => %p)", (p), (p)->SV)); \
	    if ((p)->SV) {                  \
		Tcl_DecrRefCount ((p)->SV); \
	    }				    \
	    (p)->SV = NULL
	#define ER_INIT(p)             \
	    p->ER = NULL; \
	    TRACE (("ER_INIT (%p => %p)", (p), (p)->ER))
	#define ER_CLEAR(p)             \
	    error_state_free ((p)->ER);	\
	    (p)->ER = NULL
	SCOPE RDE_PARAM
	rde_param_new (long int nstr, char** strings)
	{
	    RDE_PARAM p;
	    ENTER ("rde_param_new");
	    TRACE (("\tINT %d strings @ %p", nstr, strings));
	    p = ALLOC (RDE_PARAM_);
	    p->numstr = nstr;
	    p->string = strings;
	    p->readbuf = Tcl_NewObj ();
	    Tcl_IncrRefCount (p->readbuf);
	    TRACE (("\tTcl_Obj* readbuf %p used %d", p->readbuf,p->readbuf->refCount));
	    Tcl_InitHashTable (&p->NC, TCL_ONE_WORD_KEYS);
	    p->IN   = NULL;
	    p->CL   = -1;
	    p->ST   = 0;
	    ER_INIT (p);
	    SV_INIT (p);
	    p->CC   = NULL;
	    p->CC_len = 0;
	    p->TC   = rde_tc_new ();
	    p->ES   = rde_stack_new (error_state_free);
	    p->LS   = rde_stack_new (NULL);
	    p->ast  = rde_stack_new (ast_node_free);
	    p->mark = rde_stack_new (NULL);
	    RETURN ("%p", p);
	}
	SCOPE void 
	rde_param_del (RDE_PARAM p)
	{
	    ENTER ("rde_param_del");
	    TRACE (("RDE_PARAM %p",p));
	    ER_CLEAR (p);                 TRACE (("\ter_clear"));
	    SV_CLEAR (p);                 TRACE (("\tsv_clear"));
	    nc_clear (p);                 TRACE (("\tnc_clear"));
	    Tcl_DeleteHashTable (&p->NC); TRACE (("\tnc hashtable delete"));
	    rde_tc_del    (p->TC);        TRACE (("\ttc clear"));
	    rde_stack_del (p->ES);        TRACE (("\tes clear"));
	    rde_stack_del (p->LS);        TRACE (("\tls clear"));
	    rde_stack_del (p->ast);       TRACE (("\tast clear"));
	    rde_stack_del (p->mark);      TRACE (("\tmark clear"));
	    TRACE (("\tTcl_Obj* readbuf %p used %d", p->readbuf,p->readbuf->refCount));
	    Tcl_DecrRefCount (p->readbuf);
	    ckfree ((char*) p);
	    RETURNVOID;
	}
	SCOPE void 
	rde_param_reset (RDE_PARAM p, Tcl_Channel chan)
	{
	    ENTER ("rde_param_reset");
	    TRACE (("RDE_PARAM   %p",p));
	    TRACE (("Tcl_Channel %p",chan));
	    p->IN  = chan;
	    p->CL  = -1;
	    p->ST  = 0;
	    p->CC  = NULL;
	    p->CC_len = 0;
	    ER_CLEAR (p);
	    SV_CLEAR (p);
	    nc_clear (p);
	    rde_tc_clear   (p->TC);
	    rde_stack_trim (p->ES,   0);
	    rde_stack_trim (p->LS,   0);
	    rde_stack_trim (p->ast,  0);
	    rde_stack_trim (p->mark, 0);
	    TRACE (("\tTcl_Obj* readbuf %p used %d", p->readbuf,p->readbuf->refCount));
	    RETURNVOID;
	}
	SCOPE void
	rde_param_update_strings (RDE_PARAM p, long int nstr, char** strings)
	{
	    ENTER ("rde_param_update_strings");
	    TRACE (("RDE_PARAM %p", p));
	    TRACE (("INT       %d strings", nstr));
	    p->numstr = nstr;
	    p->string = strings;
	    RETURNVOID;
	}
	SCOPE void
	rde_param_data (RDE_PARAM p, char* buf, long int len)
	{
	    (void) rde_tc_append (p->TC, buf, len);
	}
	SCOPE void
	rde_param_clientdata (RDE_PARAM p, ClientData clientData)
	{
	    p->clientData = clientData;
	}
	static void
	nc_clear (RDE_PARAM p)
	{
	    Tcl_HashSearch hs;
	    Tcl_HashEntry* he;
	    Tcl_HashTable* tablePtr;
	    for(he = Tcl_FirstHashEntry(&p->NC, &hs);
		he != NULL;
		he = Tcl_FirstHashEntry(&p->NC, &hs)) {
		Tcl_HashSearch hsc;
		Tcl_HashEntry* hec;
		tablePtr = (Tcl_HashTable*) Tcl_GetHashValue (he);
		for(hec = Tcl_FirstHashEntry(tablePtr, &hsc);
		    hec != NULL;
		    hec = Tcl_NextHashEntry(&hsc)) {
		    NC_STATE* scs = Tcl_GetHashValue (hec);
		    error_state_free (scs->ER);
		    if (scs->SV) { Tcl_DecrRefCount (scs->SV); }
		    ckfree ((char*) scs);
		}
		Tcl_DeleteHashTable (tablePtr);
		ckfree ((char*) tablePtr);
		Tcl_DeleteHashEntry (he);
	    }
	}
	SCOPE ClientData
	rde_param_query_clientdata (RDE_PARAM p)
	{
	    return p->clientData;
	}
	SCOPE void
	rde_param_query_amark (RDE_PARAM p, long int* mc, void*** mv)
	{
	    rde_stack_get (p->mark, mc, mv);
	}
	SCOPE void
	rde_param_query_ast (RDE_PARAM p, long int* ac, Tcl_Obj*** av)
	{
	    rde_stack_get (p->ast, ac, (void***) av);
	}
	SCOPE const char*
	rde_param_query_in (RDE_PARAM p)
	{
	    return p->IN
		? Tcl_GetChannelName (p->IN)
		: "";
	}
	SCOPE const char*
	rde_param_query_cc (RDE_PARAM p, long int* len)
	{
	    *len = p->CC_len;
	    return p->CC;
	}
	SCOPE int
	rde_param_query_cl (RDE_PARAM p)
	{
	    return p->CL;
	}
	SCOPE const ERROR_STATE*
	rde_param_query_er (RDE_PARAM p)
	{
	    return p->ER;
	}
	SCOPE Tcl_Obj*
	rde_param_query_er_tcl (RDE_PARAM p, const ERROR_STATE* er)
	{
	    Tcl_Obj* res;
	    if (!er) {
		
		res = Tcl_NewStringObj ("", 0);
	    } else {
		Tcl_Obj* ov [2];
		Tcl_Obj** mov;
		long int  mc, i, j;
		void** mv;
		int lastid;
		const char* msg;
		rde_stack_get (er->msg, &mc, &mv);
		
		qsort (mv, mc, sizeof (void*), er_int_compare);
		
		mov = NALLOC (mc, Tcl_Obj*);
		lastid = -1;
		for (i=0, j=0; i < mc; i++) {
		    ASSERT_BOUNDS (i,mc);
		    if (((long int) mv [i]) == lastid) continue;
		    lastid = (long int) mv [i];
		    ASSERT_BOUNDS((long int) mv[i],p->numstr);
		    msg = p->string [(long int) mv[i]]; 
		    ASSERT_BOUNDS (j,mc);
		    mov [j] = Tcl_NewStringObj (msg, -1);
		    j++;
		}
		
		ov [0] = Tcl_NewIntObj  (er->loc);
		ov [1] = Tcl_NewListObj (j, mov);
		res = Tcl_NewListObj (2, ov);
		ckfree ((char*) mov);
	    }
	    return res;
	}
	SCOPE void
	rde_param_query_es (RDE_PARAM p, long int* ec, ERROR_STATE*** ev)
	{
	    rde_stack_get (p->ES, ec, (void***) ev);
	}
	SCOPE void
	rde_param_query_ls (RDE_PARAM p, long int* lc, void*** lv)
	{
	    rde_stack_get (p->LS, lc, lv);
	}
	SCOPE long int
	rde_param_query_lstop (RDE_PARAM p)
	{
	    return (long int) rde_stack_top (p->LS);
	}
	SCOPE Tcl_HashTable*
	rde_param_query_nc (RDE_PARAM p)
	{
	    return &p->NC;
	}
	SCOPE int
	rde_param_query_st (RDE_PARAM p)
	{
	    return p->ST;
	}
	SCOPE Tcl_Obj*
	rde_param_query_sv (RDE_PARAM p)
	{
	    TRACE (("SV_QUERY %p => (%p)", (p), (p)->SV)); \
	    return p->SV;
	}
	SCOPE long int
	rde_param_query_tc_size (RDE_PARAM p)
	{
	    return rde_tc_size (p->TC);
	}
	SCOPE void
	rde_param_query_tc_get_s (RDE_PARAM p, long int at, long int last, char** ch, long int* len)
	{
	    rde_tc_get_s (p->TC, at, last, ch, len);
	}
	SCOPE const char*
	rde_param_query_string (RDE_PARAM p, long int id)
	{
	    TRACE (("rde_param_query_string (RDE_PARAM %p, %d/%d)", p, id, p->numstr));
	    ASSERT_BOUNDS(id,p->numstr);
	    return p->string [id];
	}
	SCOPE void
	rde_param_i_ast_pop_discard (RDE_PARAM p)
	{
	    rde_stack_pop (p->mark, 1);
	}
	SCOPE void
	rde_param_i_ast_pop_rewind (RDE_PARAM p)
	{
	    long int trim = (long int) rde_stack_top (p->mark);
	    ENTER ("rde_param_i_ast_pop_rewind");
	    TRACE (("RDE_PARAM %p",p));
	    rde_stack_pop  (p->mark, 1);
	    rde_stack_trim (p->ast, trim);
	    TRACE (("SV = (%p rc%d '%s')",
		    p->SV,
		    p->SV ? p->SV->refCount       : -1,
		    p->SV ? Tcl_GetString (p->SV) : ""));
	    RETURNVOID;
	}
	SCOPE void
	rde_param_i_ast_rewind (RDE_PARAM p)
	{
	    long int trim = (long int) rde_stack_top (p->mark);
	    ENTER ("rde_param_i_ast_rewind");
	    TRACE (("RDE_PARAM %p",p));
	    rde_stack_trim (p->ast, trim);
	    TRACE (("SV = (%p rc%d '%s')",
		    p->SV,
		    p->SV ? p->SV->refCount       : -1,
		    p->SV ? Tcl_GetString (p->SV) : ""));
	    RETURNVOID;
	}
	SCOPE void
	rde_param_i_ast_push (RDE_PARAM p)
	{
	    rde_stack_push (p->mark, (void*) rde_stack_size (p->ast));
	}
	SCOPE void
	rde_param_i_ast_value_push (RDE_PARAM p)
	{
	    ENTER ("rde_param_i_ast_value_push");
	    TRACE (("RDE_PARAM %p",p));
	    ASSERT(p->SV,"Unable to push undefined semantic value");
	    TRACE (("rde_param_i_ast_value_push %p => (%p)", p, p->SV));
	    TRACE (("SV = (%p rc%d '%s')", p->SV, p->SV->refCount, Tcl_GetString (p->SV)));
	    rde_stack_push (p->ast, p->SV);
	    Tcl_IncrRefCount (p->SV);
	    RETURNVOID;
	}
	static void
	ast_node_free (void* n)
	{
	    Tcl_DecrRefCount ((Tcl_Obj*) n);
	}
	SCOPE void
	rde_param_i_error_clear (RDE_PARAM p)
	{
	    ER_CLEAR (p);
	}
	SCOPE void
	rde_param_i_error_nonterminal (RDE_PARAM p, long int s)
	{
	    
	    return;
	#if 0
	    long int pos;
	    if (!p->ER) return;
	    pos = 1 + (long int) rde_stack_top (p->LS);
	    if (p->ER->loc != pos) return;
	    error_set (p, s);
	    p->ER->loc = pos;
	#endif
	}
	SCOPE void
	rde_param_i_error_pop_merge (RDE_PARAM p)
	{
	    ERROR_STATE* top = (ERROR_STATE*) rde_stack_top (p->ES);
	    
	    if (top == p->ER) {
		rde_stack_pop (p->ES, 1);
		return;
	    }
	    
	    if (!top) {
		rde_stack_pop (p->ES, 1);
		return;
	    }
	    
	    if (!p->ER) {
		rde_stack_drop (p->ES, 1);
		p->ER = top;
		
		return;
	    }
	    
	    if (top->loc < p->ER->loc) {
		rde_stack_pop (p->ES, 1);
		return;
	    }
	    
	    if (top->loc > p->ER->loc) {
		rde_stack_drop (p->ES, 1);
		error_state_free (p->ER);
		p->ER = top;
		
		return;
	    }
	    
	    rde_stack_move (p->ER->msg, top->msg);
	    rde_stack_pop  (p->ES, 1);
	}
	SCOPE void
	rde_param_i_error_push (RDE_PARAM p)
	{
	    rde_stack_push (p->ES, p->ER);
	    if (p->ER) { p->ER->refCount ++; }
	}
	static void
	error_set (RDE_PARAM p, long int s)
	{
	    error_state_free (p->ER);
	    p->ER = ALLOC (ERROR_STATE);
	    p->ER->refCount = 1;
	    p->ER->loc      = p->CL;
	    p->ER->msg      = rde_stack_new (NULL);
	    ASSERT_BOUNDS(s,p->numstr);
	    rde_stack_push (p->ER->msg, (void*) s);
	}
	static void
	error_state_free (void* esx)
	{
	    ERROR_STATE* es = esx;
	    if (!es) return;
	    es->refCount --;
	    if (es->refCount > 0) return;
	    rde_stack_del (es->msg);
	    ckfree ((char*) es);
	}
	SCOPE void
	rde_param_i_loc_pop_discard (RDE_PARAM p)
	{
	    rde_stack_pop (p->LS, 1);
	}
	SCOPE void
	rde_param_i_loc_pop_rewind (RDE_PARAM p)
	{
	    p->CL = (long int) rde_stack_top (p->LS);
	    rde_stack_pop (p->LS, 1);
	}
	SCOPE void
	rde_param_i_loc_push (RDE_PARAM p)
	{
	    rde_stack_push (p->LS, (void*) p->CL);
	}
	SCOPE void
	rde_param_i_loc_rewind (RDE_PARAM p)
	{
	    p->CL = (long int) rde_stack_top (p->LS);
	}
	SCOPE void
	rde_param_i_input_next (RDE_PARAM p, long int m)
	{
	    int leni;
	    char* ch;
	    ASSERT_BOUNDS(m,p->numstr);
	    p->CL ++;
	    if (p->CL < rde_tc_size (p->TC)) {
		
		rde_tc_get (p->TC, p->CL, &p->CC, &p->CC_len);
		
		ASSERT_BOUNDS (p->CC_len-1, TCL_UTF_MAX);
		p->ST = 1;
		ER_CLEAR (p);
		return;
	    }
	    if (!p->IN || 
		Tcl_Eof (p->IN) ||
		(Tcl_ReadChars (p->IN, p->readbuf, 1, 0) <= 0)) {
		
		p->ST = 0;
		error_set (p, m);
		return;
	    }
	    
	    ch = Tcl_GetStringFromObj (p->readbuf, &leni);
	    ASSERT_BOUNDS (leni, TCL_UTF_MAX);
	    p->CC = rde_tc_append (p->TC, ch, leni);
	    p->CC_len = leni;
	    p->ST = 1;
	    ER_CLEAR (p);
	}
	SCOPE void
	rde_param_i_status_fail (RDE_PARAM p)
	{
	    p->ST = 0;
	}
	SCOPE void
	rde_param_i_status_ok (RDE_PARAM p)
	{
	    p->ST = 1;
	}
	SCOPE void
	rde_param_i_status_negate (RDE_PARAM p)
	{
	    p->ST = !p->ST;
	}
	SCOPE int 
	rde_param_i_symbol_restore (RDE_PARAM p, long int s)
	{
	    NC_STATE*      scs;
	    Tcl_HashEntry* hPtr;
	    Tcl_HashTable* tablePtr;
	    
	    hPtr = Tcl_FindHashEntry (&p->NC, (char*) p->CL);
	    if (!hPtr) { return 0; }
	    tablePtr = (Tcl_HashTable*) Tcl_GetHashValue (hPtr);
	    hPtr = Tcl_FindHashEntry (tablePtr, (char*) s);
	    if (!hPtr) { return 0; }
	    
	    scs = Tcl_GetHashValue (hPtr);
	    p->CL = scs->CL;
	    p->ST = scs->ST;
	    error_state_free (p->ER);
	    p->ER = scs->ER;
	    if (p->ER) { p->ER->refCount ++; }
	    TRACE (("SV_RESTORE (%p) '%s'",scs->SV, scs->SV ? Tcl_GetString (scs->SV):""));
	    SV_SET (p, scs->SV);
	    return 1;
	}
	SCOPE void
	rde_param_i_symbol_save (RDE_PARAM p, long int s)
	{
	    long int       at = (long int) rde_stack_top (p->LS);
	    NC_STATE*      scs;
	    Tcl_HashEntry* hPtr;
	    Tcl_HashTable* tablePtr;
	    int            isnew;
	    ENTER ("rde_param_i_symbol_save");
	    TRACE (("RDE_PARAM %p",p));
	    TRACE (("INT       %d",s));
	    
	    hPtr = Tcl_CreateHashEntry (&p->NC, (char*) at, &isnew);
	    if (isnew) {
		tablePtr = ALLOC (Tcl_HashTable);
		Tcl_InitHashTable (tablePtr, TCL_ONE_WORD_KEYS);
		Tcl_SetHashValue (hPtr, tablePtr);
	    } else {
		tablePtr = (Tcl_HashTable*) Tcl_GetHashValue (hPtr);
	    }
	    hPtr = Tcl_CreateHashEntry (tablePtr, (char*) s, &isnew);
	    if (isnew) {
		
		scs = ALLOC (NC_STATE);
		scs->CL = p->CL;
		scs->ST = p->ST;
		TRACE (("SV_CACHE (%p '%s')", p->SV, p->SV ? Tcl_GetString(p->SV) : ""));
		scs->SV = p->SV;
		if (scs->SV) { Tcl_IncrRefCount (scs->SV); }
		scs->ER = p->ER;
		if (scs->ER) { scs->ER->refCount ++; }
		Tcl_SetHashValue (hPtr, scs);
	    } else {
		
		scs = (NC_STATE*) Tcl_GetHashValue (hPtr);
		scs->CL = p->CL;
		scs->ST = p->ST;
		TRACE (("SV_CACHE/over (%p '%s')", p->SV, p->SV ? Tcl_GetString(p->SV) : "" ));
		if (scs->SV) { Tcl_DecrRefCount (scs->SV); }
		scs->SV = p->SV;
		if (scs->SV) { Tcl_IncrRefCount (scs->SV); }
		error_state_free (scs->ER);
		scs->ER = p->ER;
		if (scs->ER) { scs->ER->refCount ++; }
	    }
	    TRACE (("SV = (%p rc%d '%s')",
		    p->SV,
		    p->SV ? p->SV->refCount       : -1,
		    p->SV ? Tcl_GetString (p->SV) : ""));
	    RETURNVOID;
	}
	SCOPE void
	rde_param_i_test_alnum (RDE_PARAM p)
	{
	    test_class (p, Tcl_UniCharIsAlnum, tc_alnum);
	}
	SCOPE void
	rde_param_i_test_alpha (RDE_PARAM p)
	{
	    test_class (p, Tcl_UniCharIsAlpha, tc_alpha);
	}
	SCOPE void
	rde_param_i_test_ascii (RDE_PARAM p)
	{
	    test_class (p, UniCharIsAscii, tc_ascii);
	}
	SCOPE void
	rde_param_i_test_control (RDE_PARAM p)
	{
	    test_class (p, Tcl_UniCharIsControl, tc_control);
	}
	SCOPE void
	rde_param_i_test_char (RDE_PARAM p, const char* c, long int msg)
	{
	    ASSERT_BOUNDS(msg,p->numstr);
	    p->ST = Tcl_UtfNcmp (p->CC, c, 1) == 0;
	    if (p->ST) {
		ER_CLEAR (p);
	    } else {
		error_set (p, msg);
		p->CL --;
	    }
	}
	SCOPE void
	rde_param_i_test_ddigit (RDE_PARAM p)
	{
	    test_class (p, UniCharIsDecDigit, tc_ddigit);
	}
	SCOPE void
	rde_param_i_test_digit (RDE_PARAM p)
	{
	    test_class (p, Tcl_UniCharIsDigit, tc_digit);
	}
	SCOPE void
	rde_param_i_test_graph (RDE_PARAM p)
	{
	    test_class (p, Tcl_UniCharIsGraph, tc_graph);
	}
	SCOPE void
	rde_param_i_test_lower (RDE_PARAM p)
	{
	    test_class (p, Tcl_UniCharIsLower, tc_lower);
	}
	SCOPE void
	rde_param_i_test_print (RDE_PARAM p)
	{
	    test_class (p, Tcl_UniCharIsPrint, tc_printable);
	}
	SCOPE void
	rde_param_i_test_punct (RDE_PARAM p)
	{
	    test_class (p, Tcl_UniCharIsPunct, tc_punct);
	}
	SCOPE void
	rde_param_i_test_range (RDE_PARAM p, const char* s, const char* e, long int msg)
	{
	    ASSERT_BOUNDS(msg,p->numstr);
	    p->ST =
		(Tcl_UtfNcmp (s, p->CC, 1) <= 0) &&
		(Tcl_UtfNcmp (p->CC, e, 1) <= 0);
	    if (p->ST) {
		ER_CLEAR (p);
	    } else {
		error_set (p, msg);
		p->CL --;
	    }
	}
	SCOPE void
	rde_param_i_test_space (RDE_PARAM p)
	{
	    test_class (p, Tcl_UniCharIsSpace, tc_space);
	}
	SCOPE void
	rde_param_i_test_upper (RDE_PARAM p)
	{
	    test_class (p, Tcl_UniCharIsUpper, tc_upper);
	}
	SCOPE void
	rde_param_i_test_wordchar (RDE_PARAM p)
	{
	    test_class (p, Tcl_UniCharIsWordChar, tc_wordchar);
	}
	SCOPE void
	rde_param_i_test_xdigit (RDE_PARAM p)
	{
	    test_class (p, UniCharIsHexDigit, tc_xdigit);
	}
	static void
	test_class (RDE_PARAM p, UniCharClass class, test_class_id id)
	{
	    Tcl_UniChar ch;
	    Tcl_UtfToUniChar(p->CC, &ch);
	    ASSERT_BOUNDS(id,p->numstr);
	    p->ST = !!class (ch);
	    
	    if (p->ST) {
		ER_CLEAR (p);
	    } else {
		error_set (p, id);
		p->CL --;
	    }
	}
	static int
	UniCharIsAscii (int character)
	{
	    return (character >= 0) && (character < 0x80);
	}
	static int
	UniCharIsHexDigit (int character)
	{
	    return (character >= 0) && (character < 0x80) && isxdigit(character);
	}
	static int
	UniCharIsDecDigit (int character)
	{
	    return (character >= 0) && (character < 0x80) && isdigit(character);
	}
	SCOPE void
	rde_param_i_value_clear (RDE_PARAM p)
	{
	    SV_CLEAR (p);
	}
	SCOPE void
	rde_param_i_value_leaf (RDE_PARAM p, long int s)
	{
	    Tcl_Obj* newsv;
	    Tcl_Obj* ov [3];
	    long int pos = 1 + (long int) rde_stack_top (p->LS);
	    ASSERT_BOUNDS(s,p->numstr);
	    ov [0] = Tcl_NewStringObj (p->string[s], -1);
	    ov [1] = Tcl_NewIntObj (pos);
	    ov [2] = Tcl_NewIntObj (p->CL);
	    newsv = Tcl_NewListObj (3, ov);
	    TRACE (("rde_param_i_value_leaf => '%s'",Tcl_GetString (newsv)));
	    SV_SET (p, newsv);
	}
	SCOPE void
	rde_param_i_value_reduce (RDE_PARAM p, long int s)
	{
	    Tcl_Obj*  newsv;
	    int       i, j;
	    Tcl_Obj** ov;
	    long int  ac;
	    Tcl_Obj** av;
	    long int pos   = 1 + (long int) rde_stack_top (p->LS);
	    long int mark  = (long int) rde_stack_top (p->mark);
	    long int asize = rde_stack_size (p->ast);
	    long int new   = asize - mark;
	    ASSERT (new >= 0, "Bad number of elements to reduce");
	    ov = NALLOC (3+new, Tcl_Obj*);
	    ASSERT_BOUNDS(s,p->numstr);
	    ov [0] = Tcl_NewStringObj (p->string[s], -1);
	    ov [1] = Tcl_NewIntObj (pos);
	    ov [2] = Tcl_NewIntObj (p->CL);
	    rde_stack_get (p->ast, &ac, (void***) &av);
	    for (i = 3, j = mark; j < asize; i++, j++) {
		ASSERT_BOUNDS (i, 3+new);
		ASSERT_BOUNDS (j, ac);
		ov [i] = av [j];
	    }
	    ASSERT (i == 3+new, "Reduction result incomplete");
	    newsv = Tcl_NewListObj (3+new, ov);
	    TRACE (("rde_param_i_value_reduce => '%s'",Tcl_GetString (newsv)));
	    SV_SET (p, newsv);
	    ckfree ((char*) ov);
	}
	static int
	er_int_compare (const void* a, const void* b)
	{
	    
	    const void** ael = (const void**) a;
	    const void** bel = (const void**) b;
	    long int avalue = (long int) *ael;
	    long int bvalue = (long int) *bel;
	    if (avalue < bvalue) { return -1; }
	    if (avalue > bvalue) { return  1; }
	    return 0;
	}
	SCOPE int
	rde_param_i_symbol_start (RDE_PARAM p, long int s)
	{
	    if (rde_param_i_symbol_restore (p, s)) {
		if (p->ST) {
		    rde_stack_push (p->ast, p->SV);
		    Tcl_IncrRefCount (p->SV);
		}
		return 1;
	    }
	    rde_stack_push (p->LS, (void*) p->CL);
	    return 0;
	}
	SCOPE int
	rde_param_i_symbol_start_d (RDE_PARAM p, long int s)
	{
	    if (rde_param_i_symbol_restore (p, s)) {
		if (p->ST) {
		    rde_stack_push (p->ast, p->SV);
		    Tcl_IncrRefCount (p->SV);
		}
		return 1;
	    }
	    rde_stack_push (p->LS,   (void*) p->CL);
	    rde_stack_push (p->mark, (void*) rde_stack_size (p->ast));
	    return 0;
	}
	SCOPE int
	rde_param_i_symbol_void_start (RDE_PARAM p, long int s)
	{
	    if (rde_param_i_symbol_restore (p, s)) return 1;
	    rde_stack_push (p->LS, (void*) p->CL);
	    return 0;
	}
	SCOPE int
	rde_param_i_symbol_void_start_d (RDE_PARAM p, long int s)
	{
	    if (rde_param_i_symbol_restore (p, s)) return 1;
	    rde_stack_push (p->LS,   (void*) p->CL);
	    rde_stack_push (p->mark, (void*) rde_stack_size (p->ast));
	    return 0;
	}
	SCOPE void
	rde_param_i_symbol_done_d_reduce (RDE_PARAM p, long int s, long int m)
	{
	    if (p->ST) {
		rde_param_i_value_reduce (p, s);
	    } else {
		SV_CLEAR (p);
	    }
	    rde_param_i_symbol_save       (p, s);
	    rde_param_i_error_nonterminal (p, m);
	    rde_param_i_ast_pop_rewind    (p);
	    rde_stack_pop (p->LS, 1);
	    if (p->ST) {
		rde_stack_push (p->ast, p->SV);
		Tcl_IncrRefCount (p->SV);
	    }
	}
	SCOPE void
	rde_param_i_symbol_done_leaf (RDE_PARAM p, long int s, long int m)
	{
	    if (p->ST) {
		rde_param_i_value_leaf (p, s);
	    } else {
		SV_CLEAR (p);
	    }
	    rde_param_i_symbol_save       (p, s);
	    rde_param_i_error_nonterminal (p, m);
	    rde_stack_pop (p->LS, 1);
	    if (p->ST) {
		rde_stack_push (p->ast, p->SV);
		Tcl_IncrRefCount (p->SV);
	    }
	}
	SCOPE void
	rde_param_i_symbol_done_d_leaf (RDE_PARAM p, long int s, long int m)
	{
	    if (p->ST) {
		rde_param_i_value_leaf (p, s);
	    } else {
		SV_CLEAR (p);
	    }
	    rde_param_i_symbol_save       (p, s);
	    rde_param_i_error_nonterminal (p, m);
	    rde_param_i_ast_pop_rewind    (p);
	    rde_stack_pop (p->LS, 1);
	    if (p->ST) {
		rde_stack_push (p->ast, p->SV);
		Tcl_IncrRefCount (p->SV);
	    }
	}
	SCOPE void
	rde_param_i_symbol_done_void (RDE_PARAM p, long int s, long int m)
	{
	    SV_CLEAR (p);
	    rde_param_i_symbol_save       (p, s);
	    rde_param_i_error_nonterminal (p, m);
	    rde_stack_pop (p->LS, 1);
	}
	SCOPE void
	rde_param_i_symbol_done_d_void (RDE_PARAM p, long int s, long int m)
	{
	    SV_CLEAR (p);
	    rde_param_i_symbol_save       (p, s);
	    rde_param_i_error_nonterminal (p, m);
	    rde_param_i_ast_pop_rewind    (p);
	    rde_stack_pop (p->LS, 1);
	}
	SCOPE void
	rde_param_i_next_char (RDE_PARAM p, const char* c, long int m)
	{
	    rde_param_i_input_next (p, m);
	    if (!p->ST) return;
	    rde_param_i_test_char (p, c, m);
	}
	SCOPE void
	rde_param_i_next_range (RDE_PARAM p, const char* s, const char* e, long int m)
	{
	    rde_param_i_input_next (p, m);
	    if (!p->ST) return;
	    rde_param_i_test_range (p, s, e, m);
	}
	SCOPE void
	rde_param_i_next_alnum (RDE_PARAM p, long int m)
	{
	    rde_param_i_input_next (p, m);
	    if (!p->ST) return;
	    rde_param_i_test_alnum (p);
	}
	SCOPE void
	rde_param_i_next_alpha (RDE_PARAM p, long int m)
	{
	    rde_param_i_input_next (p, m);
	    if (!p->ST) return;
	    rde_param_i_test_alpha (p);
	}
	SCOPE void
	rde_param_i_next_ascii (RDE_PARAM p, long int m)
	{
	    rde_param_i_input_next (p, m);
	    if (!p->ST) return;
	    rde_param_i_test_ascii (p);
	}
	SCOPE void
	rde_param_i_next_control (RDE_PARAM p, long int m)
	{
	    rde_param_i_input_next (p, m);
	    if (!p->ST) return;
	    rde_param_i_test_control (p);
	}
	SCOPE void
	rde_param_i_next_ddigit (RDE_PARAM p, long int m)
	{
	    rde_param_i_input_next (p, m);
	    if (!p->ST) return;
	    rde_param_i_test_ddigit (p);
	}
	SCOPE void
	rde_param_i_next_digit (RDE_PARAM p, long int m)
	{
	    rde_param_i_input_next (p, m);
	    if (!p->ST) return;
	    rde_param_i_test_digit (p);
	}
	SCOPE void
	rde_param_i_next_graph (RDE_PARAM p, long int m)
	{
	    rde_param_i_input_next (p, m);
	    if (!p->ST) return;
	    rde_param_i_test_graph (p);
	}
	SCOPE void
	rde_param_i_next_lower (RDE_PARAM p, long int m)
	{
	    rde_param_i_input_next (p, m);
	    if (!p->ST) return;
	    rde_param_i_test_lower (p);
	}
	SCOPE void
	rde_param_i_next_print (RDE_PARAM p, long int m)
	{
	    rde_param_i_input_next (p, m);
	    if (!p->ST) return;
	    rde_param_i_test_print (p);
	}
	SCOPE void
	rde_param_i_next_punct (RDE_PARAM p, long int m)
	{
	    rde_param_i_input_next (p, m);
	    if (!p->ST) return;
	    rde_param_i_test_punct (p);
	}
	SCOPE void
	rde_param_i_next_space (RDE_PARAM p, long int m)
	{
	    rde_param_i_input_next (p, m);
	    if (!p->ST) return;
	    rde_param_i_test_space (p);
	}
	SCOPE void
	rde_param_i_next_upper (RDE_PARAM p, long int m)
	{
	    rde_param_i_input_next (p, m);
	    if (!p->ST) return;
	    rde_param_i_test_upper (p);
	}
	SCOPE void
	rde_param_i_next_wordchar (RDE_PARAM p, long int m)
	{
	    rde_param_i_input_next (p, m);
	    if (!p->ST) return;
	    rde_param_i_test_wordchar (p);
	}
	SCOPE void
	rde_param_i_next_xdigit (RDE_PARAM p, long int m)
	{
	    rde_param_i_input_next (p, m);
	    if (!p->ST) return;
	    rde_param_i_test_xdigit (p);
	}
	SCOPE void
	rde_param_i_notahead_start_d (RDE_PARAM p)
	{
	    rde_stack_push (p->LS, (void*) p->CL);
	    rde_stack_push (p->mark, (void*) rde_stack_size (p->ast));
	}
	SCOPE void
	rde_param_i_notahead_exit_d (RDE_PARAM p)
	{
	    if (p->ST) {
		rde_param_i_ast_pop_rewind (p); 
	    } else {
		rde_stack_pop (p->mark, 1);
	    }
	    p->CL = (long int) rde_stack_top (p->LS);
	    rde_stack_pop (p->LS, 1);
	    p->ST = !p->ST;
	}
	SCOPE void
	rde_param_i_notahead_exit (RDE_PARAM p)
	{
	    p->CL = (long int) rde_stack_top (p->LS);
	    rde_stack_pop (p->LS, 1);
	    p->ST = !p->ST;
	}
	SCOPE void
	rde_param_i_state_push_2 (RDE_PARAM p)
	{
	    
	    rde_stack_push (p->LS, (void*) p->CL);
	    rde_stack_push (p->ES, p->ER);
	    if (p->ER) { p->ER->refCount ++; }
	}
	SCOPE void
	rde_param_i_state_push_void (RDE_PARAM p)
	{
	    rde_stack_push (p->LS, (void*) p->CL);
	    ER_CLEAR (p);
	    rde_stack_push (p->ES, p->ER);
	    
	}
	SCOPE void
	rde_param_i_state_push_value (RDE_PARAM p)
	{
	    rde_stack_push (p->mark, (void*) rde_stack_size (p->ast));
	    rde_stack_push (p->LS, (void*) p->CL);
	    ER_CLEAR (p);
	    rde_stack_push (p->ES, p->ER);
	    
	}
	SCOPE void
	rde_param_i_state_merge_ok (RDE_PARAM p)
	{
	    rde_param_i_error_pop_merge (p);
	    if (!p->ST) {
		p->ST = 1;
		p->CL = (long int) rde_stack_top (p->LS);
	    }
	    rde_stack_pop (p->LS, 1);
	}
	SCOPE void
	rde_param_i_state_merge_void (RDE_PARAM p)
	{
	    rde_param_i_error_pop_merge (p);
	    if (!p->ST) {
		p->CL = (long int) rde_stack_top (p->LS);
	    }
	    rde_stack_pop (p->LS, 1);
	}
	SCOPE void
	rde_param_i_state_merge_value (RDE_PARAM p)
	{
	    rde_param_i_error_pop_merge (p);
	    if (!p->ST) {
		long int trim = (long int) rde_stack_top (p->mark);
		rde_stack_trim (p->ast, trim);
		p->CL = (long int) rde_stack_top (p->LS);
	    }
	    rde_stack_pop (p->mark, 1);
	    rde_stack_pop (p->LS, 1);
	}
	SCOPE int
	rde_param_i_kleene_close (RDE_PARAM p)
	{
	    int stop = !p->ST;
	    rde_param_i_error_pop_merge (p);
	    if (stop) {
		p->ST = 1;
		p->CL = (long int) rde_stack_top (p->LS);
	    }
	    rde_stack_pop (p->LS, 1);
	    return stop;
	}
	SCOPE int
	rde_param_i_kleene_abort (RDE_PARAM p)
	{
	    int stop = !p->ST;
	    if (stop) {
		p->CL = (long int) rde_stack_top (p->LS);
	    }
	    rde_stack_pop (p->LS, 1);
	    return stop;
	}
	SCOPE int
	rde_param_i_seq_void2void (RDE_PARAM p)
	{
	    rde_param_i_error_pop_merge (p);
	    if (p->ST) {
		rde_stack_push (p->ES, p->ER);
		if (p->ER) { p->ER->refCount ++; }
		return 0;
	    } else {
		p->CL = (long int) rde_stack_top (p->LS);
		rde_stack_pop (p->LS, 1);
		return 1;
	    }
	}
	SCOPE int
	rde_param_i_seq_void2value (RDE_PARAM p)
	{
	    rde_param_i_error_pop_merge (p);
	    if (p->ST) {
		rde_stack_push (p->mark, (void*) rde_stack_size (p->ast));
		rde_stack_push (p->ES, p->ER);
		if (p->ER) { p->ER->refCount ++; }
		return 0;
	    } else {
		p->CL = (long int) rde_stack_top (p->LS);
		rde_stack_pop (p->LS, 1);
		return 1;
	    }
	}
	SCOPE int
	rde_param_i_seq_value2value (RDE_PARAM p)
	{
	    rde_param_i_error_pop_merge (p);
	    if (p->ST) {
		rde_stack_push (p->ES, p->ER);
		if (p->ER) { p->ER->refCount ++; }
		return 0;
	    } else {
		long int trim = (long int) rde_stack_top (p->mark);
		rde_stack_pop  (p->mark, 1);
		rde_stack_trim (p->ast, trim);
		p->CL = (long int) rde_stack_top (p->LS);
		rde_stack_pop (p->LS, 1);
		return 1;
	    }
	}
	SCOPE int
	rde_param_i_bra_void2void (RDE_PARAM p)
	{
	    rde_param_i_error_pop_merge (p);
	    if (p->ST) {
		rde_stack_pop (p->LS, 1);
	    } else {
		p->CL = (long int) rde_stack_top (p->LS);
		rde_stack_push (p->ES, p->ER);
		if (p->ER) { p->ER->refCount ++; }
	    }
	    return p->ST;
	}
	SCOPE int
	rde_param_i_bra_void2value (RDE_PARAM p)
	{
	    rde_param_i_error_pop_merge (p);
	    if (p->ST) {
		rde_stack_pop (p->LS, 1);
	    } else {
		rde_stack_push (p->mark, (void*) rde_stack_size (p->ast));
		p->CL = (long int) rde_stack_top (p->LS);
		rde_stack_push (p->ES, p->ER);
		if (p->ER) { p->ER->refCount ++; }
	    }
	    return p->ST;
	}
	SCOPE int
	rde_param_i_bra_value2void (RDE_PARAM p)
	{
	    rde_param_i_error_pop_merge (p);
	    if (p->ST) {
		rde_stack_pop (p->mark, 1);
		rde_stack_pop (p->LS, 1);
	    } else {
		long int trim = (long int) rde_stack_top (p->mark);
		rde_stack_pop  (p->mark, 1);
		rde_stack_trim (p->ast, trim);
		p->CL = (long int) rde_stack_top (p->LS);
		rde_stack_push (p->ES, p->ER);
		if (p->ER) { p->ER->refCount ++; }
	    }
	    return p->ST;
	}
	SCOPE int
	rde_param_i_bra_value2value (RDE_PARAM p)
	{
	    rde_param_i_error_pop_merge (p);
	    if (p->ST) {
		rde_stack_pop (p->mark, 1);
		rde_stack_pop (p->LS, 1);
	    } else {
		long int trim = (long int) rde_stack_top (p->mark);
		rde_stack_trim (p->ast, trim);
		p->CL = (long int) rde_stack_top (p->LS);
		rde_stack_push (p->ES, p->ER);
		if (p->ER) { p->ER->refCount ++; }
	    }
	    return p->ST;
	}
	SCOPE void
	rde_param_i_next_str (RDE_PARAM p, const char* str, long int m)
	{
	    int at = p->CL;
	    
	    while (*str) {
		rde_param_i_input_next (p, m);
		if (!p->ST) {
		    p->ER->loc = at+1;
		    p->CL = at;
		    return;
		}
		rde_param_i_test_char (p, str, m);
		if (!p->ST) {
		    p->ER->loc = at+1;
		    p->CL = at;
		    return;
		}
		str = Tcl_UtfNext (str);
	    }
	}
	SCOPE void
	rde_param_i_next_class (RDE_PARAM p, const char* class, long int m)
	{
	    rde_param_i_input_next (p, m);
	    if (!p->ST) return;
	    while (*class) {
		p->ST = Tcl_UtfNcmp (p->CC, class, 1) == 0;
		if (p->ST) {
		    ER_CLEAR (p);
		    return;
		}
		class = Tcl_UtfNext (class);
	    }
	    error_set (p, m);
	    p->CL --;
	}
	

        /*
         * Declaring the parse functions
         */
        
        
        /*
         * Precomputed table of strings (symbols, error messages, etc.).
         */
        
        static char const* p_string [15] = {
            /*        0 = */   "alnum",
            /*        1 = */   "alpha",
            /*        2 = */   "ascii",
            /*        3 = */   "control",
            /*        4 = */   "ddigit",
            /*        5 = */   "digit",
            /*        6 = */   "graph",
            /*        7 = */   "lower",
            /*        8 = */   "print",
            /*        9 = */   "punct",
            /*       10 = */   "space",
            /*       11 = */   "upper",
            /*       12 = */   "wordchar",
            /*       13 = */   "xdigit",
            /*       14 = */   "cl abc"
        };
        
        /*
         * Grammar Start Expression
         */
        
        static void MAIN (RDE_PARAM p) {
            rde_param_i_next_class (p, "abc", 14);
            return;
        }
        
	/* -*- c -*- */

	typedef struct PARSERg {
	    long int counter;
	    char     buf [50];
	} PARSERg;

	static void
	PARSERgRelease (ClientData cd, Tcl_Interp* interp)
	{
	    ckfree((char*) cd);
	}

	static const char*
	PARSERnewName (Tcl_Interp* interp)
	{
#define KEY "tcllib/parser/PACKAGE/TEA"

	    Tcl_InterpDeleteProc* proc = PARSERgRelease;
	    PARSERg*                  parserg;

	    parserg = Tcl_GetAssocData (interp, KEY, &proc);
	    if (parserg  == NULL) {
		parserg = (PARSERg*) ckalloc (sizeof (PARSERg));
		parserg->counter = 0;

		Tcl_SetAssocData (interp, KEY, proc,
				  (ClientData) parserg);
	    }

	    parserg->counter ++;
	    sprintf (parserg->buf, "PARSER%ld", parserg->counter);
	    return parserg->buf;
#undef  KEY
	}

	static void
	PARSERdeleteCmd (ClientData clientData)
	{
	    /*
	     * Release the whole PARSER
	     * (Low-level engine only actually).
	     */
	    rde_param_del ((RDE_PARAM) clientData);
	}
    

    /* * ** *** ***** ******** *************
    ** Functions implementing the object methods, and helper.
    */

	static int  COMPLETE (RDE_PARAM p, Tcl_Interp* interp);

	static int parser_PARSE  (RDE_PARAM p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv)
	{
	    int mode;
	    Tcl_Channel chan;

	    if (objc != 3) {
		Tcl_WrongNumArgs (interp, 2, objv, "chan");
		return TCL_ERROR;
	    }

	    chan = Tcl_GetChannel(interp,
				  Tcl_GetString (objv[2]),
				  &mode);

	    if (!chan) {
		return TCL_ERROR;
	    }

	    rde_param_reset (p, chan);
	    MAIN (p) ; /* Entrypoint for the generated code. */
	    return COMPLETE (p, interp);
	}

	static int parser_PARSET (RDE_PARAM p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv)
	{
	    char* buf;
	    int   len;

	    if (objc != 3) {
		Tcl_WrongNumArgs (interp, 2, objv, "text");
		return TCL_ERROR;
	    }

	    buf = Tcl_GetStringFromObj (objv[2], &len);

	    rde_param_reset (p, NULL);
	    rde_param_data  (p, buf, len);
	    MAIN (p) ; /* Entrypoint for the generated code. */
	    return COMPLETE (p, interp);
	}

	/* See also rde_critcl/m.c, param_COMPLETE() */
	static int COMPLETE (RDE_PARAM p, Tcl_Interp* interp)
	{
	    if (rde_param_query_st (p)) {
		long int  ac;
		Tcl_Obj** av;

		rde_param_query_ast (p, &ac, &av);

		if (ac > 1) {
		    Tcl_Obj** lv = NALLOC (3+ac, Tcl_Obj*);

		    memcpy(lv + 3, av, ac * sizeof (Tcl_Obj*));
		    lv [0] = Tcl_NewObj ();
		    lv [1] = Tcl_NewIntObj (1 + rde_param_query_lstop (p));
		    lv [2] = Tcl_NewIntObj (rde_param_query_cl (p));

		    Tcl_SetObjResult (interp, Tcl_NewListObj (3, lv));
		    ckfree ((char*) lv);

		} else if (ac == 0) {
		    /*
		     * Match, but no AST. This is possible if the grammar
		     * consists of only the start expression.
		     */
		    Tcl_SetObjResult (interp, Tcl_NewStringObj ("",-1));
		} else {
		    Tcl_SetObjResult (interp, av [0]);
		}

		return TCL_OK;
	    } else {
		Tcl_Obj* xv [1];
		const ERROR_STATE* er = rde_param_query_er (p);
		Tcl_Obj* res = rde_param_query_er_tcl (p, er);
		/* res = list (location, list(msg)) */

		/* Stick the exception type-tag before the existing elements */
		xv [0] = Tcl_NewStringObj ("pt::rde",-1);
		Tcl_ListObjReplace(interp, res, 0, 0, 1, xv);

		Tcl_SetErrorCode (interp, "PT", "RDE", "SYNTAX", NULL);
		Tcl_SetObjResult (interp, res);
		return TCL_ERROR;
	    }
	}
    

    /* * ** *** ***** ******** *************
    ** Object command, method dispatch.
    */
	static int parser_objcmd (ClientData cd, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv)
	{
	    RDE_PARAM p = (RDE_PARAM) cd;
	    int m, res;

	    static CONST char* methods [] = {
		"destroy", "parse", "parset", NULL
	    };
	    enum methods {
		M_DESTROY, M_PARSE, M_PARSET
	    };

	    if (objc < 2) {
		Tcl_WrongNumArgs (interp, objc, objv, "option ?arg arg ...?");
		return TCL_ERROR;
	    } else if (Tcl_GetIndexFromObj (interp, objv [1], methods, "option",
					    0, &m) != TCL_OK) {
		return TCL_ERROR;
	    }

	    /* Dispatch to methods. They check the #args in
	     * detail before performing the requested
	     * functionality
	     */

	    switch (m) {
		case M_DESTROY:
		    if (objc != 2) {
			Tcl_WrongNumArgs (interp, 2, objv, NULL);
			return TCL_ERROR;
		    }

		Tcl_DeleteCommandFromToken(interp, (Tcl_Command) rde_param_query_clientdata (p));
		return TCL_OK;

		case M_PARSE:	res = parser_PARSE  (p, interp, objc, objv); break;
		case M_PARSET:	res = parser_PARSET (p, interp, objc, objv); break;
		default:
		/* Not coming to this place */
		ASSERT (0,"Reached unreachable location");
	    }

	    return res;
	}

    /** * ** *** ***** ******** *************
    * Class command, i.e. object construction.
    */
    static int ParserClassCmd (ClientData dummy, Tcl_Interp *interp, int objc, Tcl_Obj * const*objv) {
	/*
	 * Syntax: No arguments beyond the name
	 */

	RDE_PARAM   parser;
	CONST char* name;
	Tcl_Obj*    fqn;
	Tcl_CmdInfo ci;
	Tcl_Command c;

#define USAGE "?name?"

	if ((objc != 2) && (objc != 1)) {
	    Tcl_WrongNumArgs (interp, 1, objv, USAGE);
	    return TCL_ERROR;
	}

	if (objc < 2) {
	    name = PARSERnewName (interp);
	} else {
	    name = Tcl_GetString (objv [1]);
	}

	if (!Tcl_StringMatch (name, "::*")) {
	    /* Relative name. Prefix with current namespace */

	    Tcl_Eval (interp, "namespace current");
	    fqn = Tcl_GetObjResult (interp);
	    fqn = Tcl_DuplicateObj (fqn);
	    Tcl_IncrRefCount (fqn);

	    if (!Tcl_StringMatch (Tcl_GetString (fqn), "::")) {
		Tcl_AppendToObj (fqn, "::", -1);
	    }
	    Tcl_AppendToObj (fqn, name, -1);
	} else {
	    fqn = Tcl_NewStringObj (name, -1);
	    Tcl_IncrRefCount (fqn);
	}
	Tcl_ResetResult (interp);

	if (Tcl_GetCommandInfo (interp,
				Tcl_GetString (fqn),
				&ci)) {
	    Tcl_Obj* err;

	    err = Tcl_NewObj ();
	    Tcl_AppendToObj    (err, "command \"", -1);
	    Tcl_AppendObjToObj (err, fqn);
	    Tcl_AppendToObj    (err, "\" already exists", -1);

	    Tcl_DecrRefCount (fqn);
	    Tcl_SetObjResult (interp, err);
	    return TCL_ERROR;
	}

	parser = rde_param_new (sizeof(p_string)/sizeof(char*), (char**) p_string);
	c = Tcl_CreateObjCommand (interp, Tcl_GetString (fqn),
				  parser_objcmd, (ClientData) parser,
				  PARSERdeleteCmd);
	rde_param_clientdata (parser, (ClientData) c);
	Tcl_SetObjResult (interp, fqn);
	Tcl_DecrRefCount (fqn);
	return TCL_OK;
    }
    
int Package_Init(Tcl_Interp* interp) {
    if (interp == 0) return TCL_ERROR;

    if (Tcl_InitStubs(interp, TCL_VERSION, 0) == NULL) {
	    return TCL_ERROR;
    }

    if (Tcl_CreateObjCommand(interp, "PARSER", ParserClassCmd , NULL, NULL) == NULL) {
	    Tcl_SetResult(interp, "Can't create constructor", NULL);
	    return TCL_ERROR;
    }
    
    
    Tcl_PkgProvide(interp, "PACKAGE", "0.1");
    
    return TCL_OK;
}
