Tcl Library Source Code

     *
     * The obj literal here is very likely shared with the arguments of
     * i_symbol_save/restore, and i_value_leaf/reduce, and derivatives. This
     * here is the only point between these where we save the string id in the
     * Tcl_Obj*.
     */

    sym = rde_ot_intern1 (p, "n", objv [2]);
    rde_param_i_error_nonterminal (p->p, sym);

    return TCL_OK;
}

int
param_I_er_popmerge (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv)

	return TCL_ERROR;
    }

    /*
     * interning: msg as is. Already has PE operator in the message.
     */

    msg = rde_ot_intern0 (p, objv [2]);
    rde_param_i_input_next (p->p, msg);

    return TCL_OK;
}

int
param_I_test_alnum (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv)

    }

    /*
     * interning: t + space + char
     */

    ch  = Tcl_GetString (objv [2]);
    msg = rde_ot_intern1 (p, "t", objv [2]);

    rde_param_i_test_char (p->p, ch, msg);
    return TCL_OK;
}

int
param_I_test_control (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv)

    /*
     * interning: .. + space + char + space + char
     */

    chs = Tcl_GetString (objv [2]);
    che = Tcl_GetString (objv [3]);
    msg = rde_ot_intern2 (p, "..", objv [2], objv[3]);

    rde_param_i_test_range (p->p, chs, che, msg);

    return TCL_OK;
}

int

    }

    /*
     * interning: t + space + char
     */

    ch  = Tcl_GetString (objv [2]);
    msg = rde_ot_intern1 (p, "t", objv [2]);

    rde_param_i_input_next (p->p, msg);
    if (rde_param_query_st (p->p)) {
	rde_param_i_test_char (p->p, ch, msg);
    }
    return TCL_OK;
}

    /*
     * interning: .. + space + char + space + char
     */

    chs = Tcl_GetString (objv [2]);
    che = Tcl_GetString (objv [3]);
    msg = rde_ot_intern2 (p, "..", objv [2], objv[3]);

    rde_param_i_input_next (p->p, msg);
    if (rde_param_query_st (p->p)) {
	rde_param_i_test_range (p->p, chs, che, msg);
    }
    return TCL_OK;
}

     *
     * The obj literal here is very likely shared with the arguments of
     * i_symbol_save/restore, and i_value_leaf/reduce, and derivatives. This
     * here is the only point between these where we save the string id in the
     * Tcl_Obj*.
     */

    msg = rde_ot_intern1 (p, "n", objv [2]);

    rde_param_i_error_nonterminal (p->p, msg);
    rde_param_i_ast_pop_rewind (p->p);
    rde_param_i_loc_pop_discard (p->p);

    if (rde_param_query_st (p->p)) {
	rde_param_i_ast_value_push (p->p);

     *
     * The obj literal here is very likely shared with the arguments of
     * i_symbol_save/restore, and i_value_leaf/reduce, and derivatives. This
     * here is the only point between these where we save the string id in the
     * Tcl_Obj*.
     */

    msg = rde_ot_intern1 (p, "n", objv [2]);

    rde_param_i_error_nonterminal (p->p, msg);
    rde_param_i_loc_pop_discard (p->p);

    if (rde_param_query_st (p->p)) {
	rde_param_i_ast_value_push (p->p);
    }

     *
     * The obj literal here is very likely shared with the arguments of
     * i_symbol_save/restore, and i_value_leaf/reduce, and derivatives. This
     * here is the only point between these where we save the string id in the
     * Tcl_Obj*.
     */

    msg = rde_ot_intern1 (p, "n", objv [2]);

    rde_param_i_error_nonterminal (p->p, msg);
    rde_param_i_ast_pop_rewind (p->p);
    rde_param_i_loc_pop_discard (p->p);

    if (rde_param_query_st (p->p)) {
	rde_param_i_ast_value_push (p->p);

     *
     * The obj literal here is very likely shared with the arguments of
     * i_symbol_save/restore, and i_value_leaf/reduce, and derivatives. This
     * here is the only point between these where we save the string id in the
     * Tcl_Obj*.
     */

    msg = rde_ot_intern1 (p, "n", objv [2]);

    rde_param_i_error_nonterminal (p->p, msg);
    rde_param_i_ast_pop_rewind (p->p);
    rde_param_i_loc_pop_discard (p->p);

    return TCL_OK;
}

     *
     * The obj literal here is very likely shared with the arguments of
     * i_symbol_save/restore, and i_value_leaf/reduce, and derivatives. This
     * here is the only point between these where we save the string id in the
     * Tcl_Obj*.
     */

    msg = rde_ot_intern1 (p, "n", objv [2]);

    rde_param_i_error_nonterminal (p->p, msg);
    rde_param_i_loc_pop_discard (p->p);

    return TCL_OK;
}

    }

    /*
     * interning: str + space + char
     */

    str = Tcl_GetStringFromObj (objv [2], &len);
    msg = rde_ot_intern1 (p, "str", objv [2]);

    rde_param_i_next_str (p->p, str, msg);
    return TCL_OK;
}

int
param_SI_next_class (RDE_STATE p, Tcl_Interp* interp, int objc, Tcl_Obj* CONST* objv)

    }

    /*
     * interning: cl + space + char
     */

    class = Tcl_GetStringFromObj (objv [2], &len);
    msg   = rde_ot_intern1 (p, "cl", objv [2]);

    rde_param_i_next_class (p->p, class, msg);
    return TCL_OK;
}


/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

static Tcl_ObjType ot_type = {
    "tcllib/pt::rde/critcl",
    ot_free_rep,
    ot_dup_rep,
    ot_string_rep,
    ot_from_any
};

static int      IsCached (RDE_STATE p, Tcl_Obj* obj, long int* id);
static long int Make     (RDE_STATE p, Tcl_Obj* obj, const char* str);


/*
 * = = == === ===== ======== ============= =====================
 */

long int
rde_ot_intern0 (RDE_STATE p,
		Tcl_Obj* detail)
{
    long int id;

    TRACE (("rde_ot_intern0 (%p, %p = '%s')", p, detail, Tcl_GetString(detail)));
    if (IsCached (p, detail, &id)) {
	return id;
    }

    TRACE (("INTERNALIZE"));
    return Make (p, detail, Tcl_GetString (detail));
}

long int
rde_ot_intern1 (RDE_STATE p,
		const char* operator,
		Tcl_Obj* detail)
{
    long int id;
    Tcl_DString buf;

    TRACE (("rde_ot_intern1 (%p, '%s' %p = '%s')", p, operator, detail, Tcl_GetString(detail)));
    if (IsCached (p, detail, &id)) {
	return id;
    }

    TRACE (("INTERNALIZE"));

    /* Create a list of operator + detail.
     * Using a DString.
     */

    Tcl_DStringInit (&buf);
    Tcl_DStringAppendElement (&buf, operator);
    Tcl_DStringAppendElement (&buf, Tcl_GetString (detail));

    id = Make (p, detail, Tcl_DStringValue (&buf));

    Tcl_DStringFree (&buf);
    return id;
}

long int
rde_ot_intern2 (RDE_STATE p,
		const char* operator,
		Tcl_Obj* detail1,
		Tcl_Obj* detail2)
{
    long int id;
    Tcl_DString buf;

    TRACE (("rde_ot_intern2 (%p, '%s' %p = '%s', %p = '%s')", p, operator,
	    detail1, Tcl_GetString(detail1)
	    detail2, Tcl_GetString(detail2)));
    if (IsCached (p, detail1, &id)) {
	return id;
    }

    TRACE (("INTERNALIZE"));

    /* Create a list of operator + detail1 + detail2.
     * Using a DString.
     */

    Tcl_DStringInit (&buf);
    Tcl_DStringAppendElement (&buf, operator);
    Tcl_DStringAppendElement (&buf, Tcl_GetString (detail1));
    Tcl_DStringAppendElement (&buf, Tcl_GetString (detail2));

    id = Make (p, detail1, Tcl_DStringValue (&buf));

    Tcl_DStringFree (&buf);
    return id;
}

/*
 * = = == === ===== ======== ============= =====================
 */

static int
IsCached (RDE_STATE p, Tcl_Obj* obj, long int* id)
{
    /*
     * Quick exit if we have a cached and valid value.
     */

    if ((obj->typePtr == &ot_type) &&
	(obj->internalRep.twoPtrValue.ptr1 == p)) {
	RDE_STRING* rs = (RDE_STRING*) obj->internalRep.twoPtrValue.ptr2;
	TRACE (("CACHED %p = %d", rs, rs->id));
	*id = rs->id;

	return 1;

    }











    return 0;



}







static long int

Make (RDE_STATE p, Tcl_Obj* obj, const char* str)


{






    long int    id = param_intern (p, str);

    RDE_STRING* rs = ALLOC (RDE_STRING);











    rs->next = p->sfirst;
    rs->self = obj;
    rs->id   = id;
    p->sfirst = rs;

    /* Invalidate previous int.rep before setting our own.
     * Inlined copy of TclFreeIntRep() macro (tclInt.h)
     */

    if ((obj)->typePtr &&
	(obj)->typePtr->freeIntRepProc) {
        (obj)->typePtr->freeIntRepProc(obj);
    }

    obj->internalRep.twoPtrValue.ptr1 = p;
    obj->internalRep.twoPtrValue.ptr2 = rs;
    obj->typePtr = &ot_type;

    return id;
}

	RDE_STRING* iter = p->sfirst;
	while (iter->next != rs) {
	    iter = iter->next;
	}
	iter->next = rs->next;
    }

    /* Drop the now un-tracked structure */
    ckfree ((char*) rs);

    /* Nothing to release in the obj itself, just resetting references. */
    obj->internalRep.twoPtrValue.ptr1 = NULL;
    obj->internalRep.twoPtrValue.ptr2 = NULL;
}
        
static void
ot_dup_rep(Tcl_Obj* obj, Tcl_Obj* dup)
{

/*
 * = = == === ===== ======== ============= =====================
 * == pt::rde (critcl) - Data Structures - ObjType for interned strings.
 */

#ifndef _RDE_DS_OT_H
#define _RDE_DS_OT_H 1

#include "tcl.h"
#include <p.h>   /* State declarations */

long int rde_ot_intern0 (RDE_STATE p,
			 Tcl_Obj* detail);

long int rde_ot_intern1 (RDE_STATE p,
			 const char* operator,
			 Tcl_Obj* detail);

long int rde_ot_intern2 (RDE_STATE p,
			 const char* operator,
			 Tcl_Obj* detail1,
			 Tcl_Obj* detail2);

#endif /* _RDE_DS_OT_H */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4

	 *
	 * FUTURE :: keep track of what location the data stored in CC is
	 * for. If the location is identical no extraction is required. This
	 * may help when a choice repeatedly tests the same character.
	 */

	rde_tc_get (p->TC, p->CL, &p->CC, &p->CC_len);

	/* Note: BOUNDS(n) <=> [0..(n-1)].
	 * cc_len in [1..utfmax] <=> cc_len-1 in [0...utfmax-1] <=> BOUNDS(utfmax)
	 */
	ASSERT_BOUNDS (p->CC_len-1, TCL_UTF_MAX);

	p->ST = 1;
	ER_CLEAR (p);