path: root/toxy/plustot.c

/* Copyright (c) 2003 krzYszcz and others.
 * For information on usage and redistribution, and for a DISCLAIMER OF ALL
 * WARRANTIES, see the file, "LICENSE.txt," in this distribution.  */

#include <string.h>
#include "m_pd.h"
#include "g_canvas.h"
#include "common/loud.h"
#include "common/grow.h"
#include "hammer/file.h"
#include "common/props.h"
#include "toxy/scriptlet.h"
#include "toxy/plusbob.h"
#include "plustot.h"
#include "build_counter"

#define PLUSTOT_VERBOSE
#define PLUSTOT_DEBUG
//#define PLUSTOT_DEBUGREFCOUNTS

#ifdef PLUSTOT_DEBUG
#   define PLUSDEBUG_ENDPOST(fn)  endpost()
#else
#   define PLUSDEBUG_ENDPOST(fn)
#endif

#ifdef PLUSTOT_DEBUGREFCOUNTS
#   define PLUSDEBUG_INCRREFCOUNT(ob, fn) \
	{post("++ %x "fn, (int)(ob)); Tcl_IncrRefCount(ob);}
#   define PLUSDEBUG_DECRREFCOUNT(ob, fn) \
	{post("-- %x "fn, (int)(ob)); Tcl_DecrRefCount(ob);}
#else
#   define PLUSDEBUG_INCRREFCOUNT(ob, fn)  Tcl_IncrRefCount(ob)
#   define PLUSDEBUG_DECRREFCOUNT(ob, fn)  Tcl_DecrRefCount(ob)
#endif

static t_symbol *plusps_tot;
static t_symbol *plusps_env;
static t_symbol *plusps_in;
static t_symbol *plusps_var;
static t_symbol *plusps_out;
static t_symbol *plusps_qlist;
static t_symbol *plusps_print;
static t_symbol *totps_query;

static void plusloud_tcldirty(t_pd *caller, char *fnname)
{
    loud_warning((caller == PLUSBOB_OWNER ? 0 : caller),
		 "(%s) tcl plays dirty tricks, sorry", fnname);
}

void plusloud_tclerror(t_pd *caller, Tcl_Interp *interp, char *msg)
{
    Tcl_Obj *ob = Tcl_GetObjResult(interp);
    loud_error((caller == PLUSBOB_OWNER ? 0 : caller), msg);
    if (ob)
    {
	int len;
	char *res = Tcl_GetStringFromObj(ob, &len);
	if (res && len > 0)
	{
	    char buf[MAXPDSTRING];
	    if (len > (MAXPDSTRING-2))
	    {
		len = (MAXPDSTRING-2);
		buf[MAXPDSTRING-2] = '*';
		buf[MAXPDSTRING-1] = 0;
	    }
	    else buf[len] = 0;
	    strncpy(buf, res, len);
	    loud_errand((caller == PLUSBOB_OWNER ? 0 : caller),
			"(tcl) %s", buf);
	}
	else ob = 0;
	Tcl_ResetResult(interp);
    }
    if (!ob) loud_errand((caller == PLUSBOB_OWNER ? 0 : caller),
			 "unknown error (probably a bug)");
}

/* Plustin (aka +Ti) is a Tcl_Interp wrapped as a +bob.
   This is a glist-based flavor of Plusenv. */

struct _plustin
{
    t_plusenv    tin_env;
    t_glist     *tin_glist;
    Tcl_Interp  *tin_interp;
};

static t_plustype *plustin_basetype;
static t_plustype *plustin_type;
static t_plustin *plustin_default = 0;

/* To be called from derived constructors or plustin's provider. */
t_plustin *plustin_create(t_plustype *tp, t_plusbob *parent, t_symbol *id)
{
    t_plustin *tin = 0;
    Tcl_Interp *interp = Tcl_CreateInterp();
    if (interp && (tin = (t_plustin *)plusenv_create(tp, parent, id)))
    {
#ifdef PLUSTOT_DEBUG
	post("plustin_create '%s' over %x",
	     (id ? id->s_name : "default"), (int)interp);
#endif
	tin->tin_interp = interp;
	Tcl_Preserve(interp);
	if (Tcl_Init(interp) == TCL_ERROR)
	    plusloud_tclerror(0, interp, "interpreter initialization failed");
	Tcl_Release(interp);
    }
    else loud_error(0, "failed attempt to create an interpreter");
    return (tin);
}

/* To be registered for calling from plusbob_release().
   Should never be called explicitly. */
static void plustin_delete(t_plustin *tin)
{
#ifdef PLUSTOT_DEBUG
    t_symbol *id = plusenv_getid((t_plusenv *)tin);
    post("plustin_delete '%s' over %x",
	 (id ? id->s_name : "default"), (int)tin->tin_interp);
#endif
    Tcl_Preserve(tin->tin_interp);
    if (!Tcl_InterpDeleted(tin->tin_interp))
	Tcl_DeleteInterp(tin->tin_interp);
    Tcl_Release(tin->tin_interp);
}

Tcl_Interp *plustin_getinterp(t_plustin *tin)
{
    return (tin->tin_interp);
}

t_symbol *plustin_glistid(t_glist *gl)
{
    char buf[32];
    sprintf(buf, "+ti%x", (int)gl);
    return (gensym(buf));
}

t_plustin *plustin_glistfind(t_glist *gl, int mode)
{
    t_plustin *tin = 0;
    if (mode == PLUSTIN_GLIST_UP)
    {
	gl = gl->gl_owner;
	mode = PLUSTIN_GLIST_ANY;
    }
    if (mode == PLUSTIN_GLIST_THIS)
	return ((t_plustin *)plusenv_find(plustin_glistid(gl),
					  (t_plusenv *)plustin_default));
    else
    {
	while (gl)
	{
	    char buf[32];
	    sprintf(buf, "+ti%x", (int)gl);
	    if (tin = (t_plustin *)plusenv_find(gensym(buf),
						(t_plusenv *)plustin_default))
		break;
	    gl = gl->gl_owner;
	}
	return (tin ? tin : plustin_default);
    }
}

/* To be called from client code, instead of plustin_create().
   Preserving is caller's responsibility.
   Never returns null, even when called with create == 0:
   if requested id not found, default returned, created if necessary. */
t_plustin *plustin_glistprovide(t_glist *gl, int mode, int create)
{
    t_plustin *tin = 0;
    t_plusbob *parent = plusenv_getparent(plustin_type);
    if (mode == PLUSTIN_GLIST_UP)
    {
	gl = gl->gl_owner;
	mode = PLUSTIN_GLIST_ANY;
    }
    tin = plustin_glistfind(gl, mode);
    if (!tin && create)
    {
	if (tin = plustin_create(plustin_type, parent, plustin_glistid(gl)))
	    tin->tin_glist = gl;
    }
    if (!tin)
    {
	if (!plustin_default)
	    plustin_default = plustin_create(plustin_type, parent, 0);
	tin = plustin_default;
    }
    return (tin);
}

t_symbol *plustin_getglistname(t_plustin *tin)
{
    return (tin->tin_glist ? tin->tin_glist->gl_name : 0);
}

/* Plustob (aka +To) is a Tcl_Obj wrapped as a +bob. */

/* LATER rethink the plustob/plusvar rules, measure performance.
   There are two cases:

   `Bobbing' is taking an object from its wrapping bob, wrapping it into
   another bob and, optionally, setting a variable to it.

   The main deal of bobbing design is not to Tcl_DuplicateObj while passing
   bobs around.

   `Messing' is converting a Pd message (float, symbol or list) to an object,
   wrapping it and, optionally, setting a variable to it.

   The obvious sequence of {Decr(old), New, Incr(new), SetVar(new)}, which
   is currently used, involves picking a new object (New), while returning
   an old one to the pool (by SetVar or Decr, depending on a third party
   changing or not the tcl variable's value in the meantime).  I guess
   the overhead is negligible, unless we hit at the bottom of the pool.
   Moreover, we can reduce the sequence to just {Set(old), SetVar(old)},
   in the case when old is not shared (referenced neither by a variable,
   nor by a third party).  The main advantage is being consistent with
   the way Tcl itself was designed.

   An alternative:  in the original messing design, the trick was to:

   . call Set on a prepicked object, instead of New
   . call SetVar on a preserved object, as usual (var would not own its value)
   . alternate between two prepicked objects in order to avoid calling UnsetVar

   So, the sequence was just {Set(v1), SetVar(v1)}, then {Set(v2), SetVar(v2)},
   again {Set(v1), SetVar(v1)}, and so on, unless a third party (other than
   plusvar and a tcl variable) referenced our prepicked object. */

#define PLUSTOB_INIELBUFSIZE  128  /* LATER rethink */

struct _plustob
{
    t_plusbob         tob_bob;
    Tcl_Obj          *tob_value;
    t_plustin        *tob_tin;  /* redundant, LATER rethink */
    t_plusifsharedfn  tob_ifsharedfn;
    int               tob_elbufsize;
    Tcl_Obj         **tob_elbuf;
    Tcl_Obj          *tob_elbufini[PLUSTOB_INIELBUFSIZE];
};

static t_plustype *plustob_type;

/* To be called from derived constructors.
   Preserving is caller's responsibility. */
t_plustob *plustob_create(t_plustype *tp, t_plustin *tin, Tcl_Obj *ob)
{
    t_plustob *tob = 0;
    if (tin && (ob != PLUSTOB_MAKEIT || (ob = Tcl_NewObj()))
	&& (tob = (t_plustob *)plusbob_create(tp, (t_plusbob *)tin)))
    {
	if (ob) PLUSDEBUG_INCRREFCOUNT(ob, "plustob_create");
	plusbob_preserve((t_plusbob *)tin);
	tob->tob_value = ob;
	tob->tob_tin = tin;
	tob->tob_ifsharedfn = 0;
	tob->tob_elbufsize = PLUSTOB_INIELBUFSIZE;
	tob->tob_elbuf = tob->tob_elbufini;
    }
    return (tob);
}

/* To be registered for calling from plusbob_release().
   Should never be called explicitly. */
static void plustob_delete(t_plustob *tob)
{
    if (tob->tob_tin)
	plusbob_release((t_plusbob *)tob->tob_tin);
    if (tob->tob_value)
	PLUSDEBUG_DECRREFCOUNT(tob->tob_value, "plustob_delete");
    if (tob->tob_elbuf != tob->tob_elbufini)
	freebytes(tob->tob_elbuf, tob->tob_elbufsize * sizeof(*tob->tob_elbuf));
}

/* To be registered for calling from plusbob_attach().
   Should never be called explicitly. */
static void plustob_attach(t_plustob *tob)
{
    t_plustin *tin;
    if (tin = (t_plustin *)plusbob_getparent((t_plusbob *)tob))
    {
	if (tob->tob_tin)
	    plusbob_release((t_plusbob *)tob->tob_tin);
	tob->tob_tin = tin;
	plusbob_preserve((t_plusbob *)tin);
    }
    else bug("plustob_attach");
}

/* To be called from client code.
   Preserving is caller's responsibility. */
t_plustob *plustob_new(t_plustin *tin, Tcl_Obj *ob)
{
    return (plustob_create(plustob_type, tin, ob));
}

void plustob_setifshared(t_plustob *tob, t_plusifsharedfn ifsharedfn)
{
    tob->tob_ifsharedfn = ifsharedfn;
}

int plustob_isshared(t_plustob *tob)
{
    return (tob->tob_value && Tcl_IsShared(tob->tob_value));
}

Tcl_Obj *plustob_getvalue(t_plustob *tob)
{
    return (tob->tob_value);
}

/* silent, if caller is empty */
t_plustin *plustag_tobtin(t_symbol *tag, t_pd *caller)
{
    return (plustag_validroot(tag, plusps_To, caller)
	    ? ((t_plustob *)tag)->tob_tin : 0);
}

/* silent, if caller is empty */
Tcl_Obj *plustag_tobvalue(t_symbol *tag, t_pd *caller)
{
    return (plustag_validroot(tag, plusps_To, caller)
	    ? ((t_plustob *)tag)->tob_value : 0);
}

/* silent, if caller is empty */
Tcl_Obj *plusatom_tobvalue(t_atom *ap, t_pd *caller)
{
    if (ap->a_type == A_SYMBOL)
	return (plustag_tobvalue(ap->a_w.w_symbol, caller));
    else if (caller)
    {
    	char buf[80];
    	atom_string(ap, buf, 80);
	loud_error((caller == PLUSBOB_OWNER ? 0 : caller),
 "+tot does not understand '%s' (check object connections)", buf);
    }
    return (0);
}

Tcl_Obj *plustob_set(t_plustob *tob, t_plustin *tin, Tcl_Obj *ob)
{
    if (tin != tob->tob_tin)
    {
	/* FIXME */
	loud_warning(0, "+To: environment mismatch");
	return (0);
    }
    if (ob != tob->tob_value)
    {
	if (tob->tob_value)
	    PLUSDEBUG_DECRREFCOUNT(tob->tob_value, "plustob_set");
	if (ob)
	{
	    PLUSDEBUG_INCRREFCOUNT(ob, "plustob_set");
	    if (Tcl_IsShared(ob))
	    {
		/* FIXME */
	    }
	}
	tob->tob_value = ob;
    }
    return (ob);
}

Tcl_Obj *plustob_setfloat(t_plustob *tob, t_float f)
{
    Tcl_Obj *ob = tob->tob_value;
    if (!ob || Tcl_IsShared(ob))
    {
	Tcl_Obj *tmp;
	int i = (int)f;
	if (ob && tob->tob_ifsharedfn)
	{
	    if ((*tob->tob_ifsharedfn)((t_plusbob *)tob, ob) == 0)
		return (0);
	}
	if (f == i)  /* LATER rethink */
	    tmp = Tcl_NewIntObj(i);
	else
	    tmp = Tcl_NewDoubleObj((double)f);
	if (tmp)
	{
	    if (ob) PLUSDEBUG_DECRREFCOUNT(ob, "plustob_setfloat");
	    tob->tob_value = ob = tmp;
	    PLUSDEBUG_INCRREFCOUNT(ob, "plustob_setfloat");
	}
	else return (0);
    }
    else
    {
	int i = (int)f;
	if (f == i)  /* LATER rethink */
	    Tcl_SetIntObj(ob, i);
	else
	    Tcl_SetDoubleObj(ob, (double)f);
    }
    return (ob);
}

Tcl_Obj *plustob_setsymbol(t_plustob *tob, t_symbol *s)
{
    if (plustag_isvalid(s, 0))
    {
	if (plustag_validroot(s, plusps_To, PLUSBOB_OWNER))
	{
	    t_plustob *from = (t_plustob *)s;
	    return (plustob_set(tob, from->tob_tin, from->tob_value));
	}
	else return (0);
    }
    else
    {
	Tcl_Obj *ob = tob->tob_value;
	if (!ob || Tcl_IsShared(ob))
	{
	    Tcl_Obj *tmp;
	    if (ob && tob->tob_ifsharedfn)
	    {
		if ((*tob->tob_ifsharedfn)((t_plusbob *)tob, ob) == 0)
		    return (0);
	    }
	    if (tmp = Tcl_NewStringObj(s->s_name, -1))
	    {
		if (ob) PLUSDEBUG_DECRREFCOUNT(ob, "plustob_setsymbol");
		tob->tob_value = ob = tmp;
		PLUSDEBUG_INCRREFCOUNT(ob, "plustob_setsymbol");
	    }
	    else return (0);
	}
	else Tcl_SetStringObj(ob, s->s_name, -1);
	return (ob);
    }
}

Tcl_Obj *plustob_setlist(t_plustob *tob, int ac, t_atom *av)
{
    if (ac == 1)
    {
	if (av->a_type == A_FLOAT)
	    return (plustob_setfloat(tob, av->a_w.w_float));
	else if (av->a_type == A_SYMBOL)
	    return (plustob_setsymbol(tob, av->a_w.w_symbol));
    }
    else if (ac > 1)
    {
	Tcl_Obj *ob = tob->tob_value;
	int count;
	t_atom *ap;
	for (count = 0, ap = av; count < ac; count++, ap++)
	    if (ap->a_type != A_FLOAT && ap->a_type != A_SYMBOL)
		break;
	if (count > tob->tob_elbufsize)
	{
#ifdef PLUSTOT_DEBUG
	    post("growing +To %d -> %d", tob->tob_elbufsize, count);
#endif
	    tob->tob_elbuf =
		grow_nodata(&count, &tob->tob_elbufsize, tob->tob_elbuf,
			    PLUSTOB_INIELBUFSIZE, tob->tob_elbufini,
			    sizeof(*tob->tob_elbuf));
	}
	if (count > 0)
	{
	    int i;
	    Tcl_Obj **elp;
	    for (i = 0, elp = tob->tob_elbuf; i < count; i++, elp++, av++)
	    {
		if (av->a_type == A_FLOAT)
		    *elp = Tcl_NewDoubleObj((double)av->a_w.w_float);
		else if (av->a_type == A_SYMBOL)
		    *elp = Tcl_NewStringObj(av->a_w.w_symbol->s_name, -1);
	    }
	    if (!ob || Tcl_IsShared(ob))
	    {
		Tcl_Obj *tmp;
		if (ob && tob->tob_ifsharedfn)
		{
		    if ((*tob->tob_ifsharedfn)((t_plusbob *)tob, ob) == 0)
			return (0);
		}
		if (tmp = Tcl_NewListObj(count, tob->tob_elbuf))
		{
		    if (ob) PLUSDEBUG_DECRREFCOUNT(ob, "plustob_setlist");
		    tob->tob_value = ob = tmp;
		    PLUSDEBUG_INCRREFCOUNT(ob, "plustob_setlist");
		}
		else return (0);
	    }
	    else Tcl_SetListObj(ob, count, tob->tob_elbuf);
	    return (ob);
	}
    }
    return (0);  /* count == 0, LATER rethink */
}

static int plustob_parseatoms(int ac, t_atom *av, int *natomsp, int *nlistsp,
			      Tcl_Obj **listobs, Tcl_Obj **atomobs)
{
    int i, natoms = 0, nlists = 0, start = 1;
    t_atom *ap;
    int atomcnt = 0;
    Tcl_Obj **atomptr = atomobs;
    for (i = 0, ap = av; i < ac; i++, ap++)
    {
	if (ap->a_type == A_SEMI || ap->a_type == A_COMMA)
	{
	    /* empty lists are filtered out, LATER rethink */
	    if (!start)
	    {
		if (listobs)
		{
		    if (listobs[nlists] = Tcl_NewListObj(atomcnt, atomptr))
		    {
			atomptr += atomcnt;
			atomcnt = 0;
		    }
		    else goto parsefailed;
		}
		nlists++;
	    }
	    start = 1;
	}
	else
	{
	    /* other types are ignored, LATER rethink */
	    start = 0;
	    if (ap->a_type == A_FLOAT || ap->a_type == A_SYMBOL)
	    {
		if (atomobs)
		{
		    if (!(atomobs[natoms] =
			  (ap->a_type == A_FLOAT ?
			   Tcl_NewDoubleObj((double)ap->a_w.w_float) :
			   Tcl_NewStringObj(ap->a_w.w_symbol->s_name, -1))))
			goto parsefailed;
		    atomcnt++;
		}
		natoms++;
	    }
	}
    }
    if (natoms && !start)
    {
	if (listobs &&
	    !(listobs[nlists] = Tcl_NewListObj(atomcnt, atomptr)))
	    goto parsefailed;
	nlists++;
    }
    if (natomsp) *natomsp = natoms;
    if (nlistsp) *nlistsp = nlists;
    return (1);
parsefailed:
    /* FIXME cleanup */
    return (0);
}

Tcl_Obj *plustob_setbinbuf(t_plustob *tob, t_binbuf *bb)
{
    int ac = binbuf_getnatom(bb);
    if (ac)
    {
	t_atom *av = binbuf_getvec(bb);
	Tcl_Obj *ob = tob->tob_value;
	int count, natoms, nlists;
	plustob_parseatoms(ac, av, &natoms, &nlists, 0, 0);
	count = natoms + nlists;
	if (count > tob->tob_elbufsize)
	{
	    int n = count;
#ifdef PLUSTOT_DEBUG
	    post("growing +To %d -> %d", tob->tob_elbufsize, count);
#endif
	    tob->tob_elbuf =
		grow_nodata(&n, &tob->tob_elbufsize, tob->tob_elbuf,
			    PLUSTOB_INIELBUFSIZE, tob->tob_elbufini,
			    sizeof(*tob->tob_elbuf));
	    if (n < count)
		goto setbbfailed;
	}
	if (!plustob_parseatoms(ac, av, 0, 0,
				tob->tob_elbuf, tob->tob_elbuf + nlists))
	    goto setbbfailed;
	if (!ob || Tcl_IsShared(ob))
	{
	    Tcl_Obj *tmp;
	    if (ob && tob->tob_ifsharedfn)
	    {
		if ((*tob->tob_ifsharedfn)((t_plusbob *)tob, ob) == 0)
		    goto setbbfailed;
	    }
	    if (tmp = Tcl_NewListObj(nlists, tob->tob_elbuf))
	    {
		if (ob) PLUSDEBUG_DECRREFCOUNT(ob, "plustob_setbinbuf");
		tob->tob_value = ob = tmp;
		PLUSDEBUG_INCRREFCOUNT(ob, "plustob_setbinbuf");
	    }
	    else goto setbbfailed;
	}
	else Tcl_SetListObj(ob, nlists, tob->tob_elbuf);
	return (ob);
    }
setbbfailed:
    return (0);
}

Tcl_Obj *plustob_grabresult(t_plustob *tob)
{
    Tcl_Interp *interp = tob->tob_tin->tin_interp;
    Tcl_Obj *rob;
    if (rob = Tcl_GetObjResult(interp))
    {
	if (rob == tob->tob_value)
	    Tcl_ResetResult(interp);
	else
	{
	    PLUSDEBUG_INCRREFCOUNT(rob, "plustob_grabresult");
	    Tcl_ResetResult(interp);
	    if (Tcl_IsShared(rob))
	    {
		/* FIXME */
	    }
	    if (tob->tob_value)
		PLUSDEBUG_DECRREFCOUNT(tob->tob_value, "plustob_grabresult");
	    tob->tob_value = rob;
	}
    }
    else plusloud_tcldirty(plusbob_getowner((t_plusbob *)tob),
			   "plustob_grabresult");
    return (rob);
}

Tcl_Obj *plustob_evalob(t_plustob *tob, Tcl_Obj *ob)
{
    Tcl_Interp *interp = tob->tob_tin->tin_interp;
    Tcl_Obj *rob;
    Tcl_Preserve(interp);
    if (Tcl_EvalObj(interp, ob) == TCL_OK)
	rob = plustob_grabresult(tob);
    else
    {
	plusloud_tclerror(plusbob_getowner((t_plusbob *)tob), interp,
			  "immediate command failed");
	rob = 0;
    }
    Tcl_Release(interp);
    return (rob);
}

/* Plusvar (aka +Tv) is a plustob with a one-way link to a tcl variable.
   Whenever plusvar's value changes, the variable is set to it (the opposite
   update requires explicitly calling the plusvar_pull() request).
   This is different from one-way linking by passing TCL_LINK_READ_ONLY flag
   to Tcl_LinkVar():  plusvar's variable is not forced to be read-only,
   and its value's form and internal representation are not constrained. */

struct _plusvar
{
    t_plustob  var_tob;
    char      *var_name;
    char      *var_index;
    Tcl_Obj   *var_part1;
    Tcl_Obj   *var_part2;
};

static t_plustype *plusvar_type;

/* Since tcl always uses a hash table of string indices for array element
   lookup, there are never any gains when using integer indices. */

/* To be called from derived constructors.
   Preserving is caller's responsibility. */
t_plusvar *plusvar_create(t_plustype *tp, t_plustin *tin, Tcl_Obj *ob,
			  char *name, char *index)
{
    t_plusvar *var = 0;
    Tcl_Obj *ntob = 0;
    Tcl_Obj *itob = 0;
    if (name && *name)
    {
	if (ntob = Tcl_NewStringObj(name, -1))
	{
	    PLUSDEBUG_INCRREFCOUNT(ntob, "plusvar_create");
	}
	else goto varfailed1;
    }
    else
    {
	bug("plusvar_create");
	goto varfailed2;
    }
    if (index)
    {
	if (itob = Tcl_NewStringObj(index, -1))
	{
	    PLUSDEBUG_INCRREFCOUNT(itob, "plusvar_create");
	}
	else goto varfailed1;
    }
    if (var = (t_plusvar *)plustob_create(tp, tin, ob))
    {
	var->var_name = getbytes(strlen(name) + 1);
	strcpy(var->var_name, name);
	if (index)
	{
	    var->var_index = getbytes(strlen(index) + 1);
	    strcpy(var->var_index, index);
	}
	else var->var_index = 0;
	var->var_part1 = ntob;
	var->var_part2 = itob;
    }
    else goto varfailed2;
    return (var);
varfailed1:
    plusloud_tcldirty(0, "plusvar_create");
varfailed2:
    if (ntob) PLUSDEBUG_DECRREFCOUNT(ntob, "plusvar_create");
    if (itob) PLUSDEBUG_DECRREFCOUNT(itob, "plusvar_create");
    return (0);
}

/* To be registered for calling from plusbob_release().
   Should never be called explicitly. */
static void plusvar_delete(t_plusvar *var)
{
    freebytes(var->var_name, strlen(var->var_name) + 1);
    if (var->var_index)
	freebytes(var->var_index, strlen(var->var_index) + 1);
    PLUSDEBUG_DECRREFCOUNT(var->var_part1, "plusvar_delete");
    if (var->var_part2)
	PLUSDEBUG_DECRREFCOUNT(var->var_part2, "plusvar_delete");
}

/* To be called from client code.
   Preserving is caller's responsibility */
t_plusvar *plusvar_new(char *name, char *index, t_plustin *tin)
{
    return (plusvar_create(plusvar_type, tin, 0, name, index));
}

/* not used yet */
static int plusvar_ifshared(t_plusbob *bob, Tcl_Obj *ob)
{
    /* Shared means either the variable still holds our value, or the value
       is referenced by a third party, or both. In either case, we have to
       pick a new object.
       LATER consider testing for illegal use of a pseudo-variable. */
    return (1);
}

/* LATER try making it more efficient */
static Tcl_Obj *plusvar_postset(t_plusvar *var)
{
    Tcl_Obj *rob;
    t_plustob *tob = (t_plustob *)var;
    Tcl_Interp *interp = tob->tob_tin->tin_interp;
    Tcl_Preserve(interp);
    if (tob->tob_value)
    {
	rob = Tcl_ObjSetVar2(interp, var->var_part1, var->var_part2,
			     tob->tob_value, 0);
	if (!rob)
	{
	    if (Tcl_UnsetVar2(interp, var->var_name, 0,
			      TCL_LEAVE_ERR_MSG) == TCL_OK)
		rob = Tcl_ObjSetVar2(interp, var->var_part1, var->var_part2,
				     tob->tob_value, TCL_LEAVE_ERR_MSG);
	}
	if (rob)
	{
#ifdef PLUSTOT_DEBUGREFCOUNTS
	    if (var->var_index)
		post("vv %x plusvar_postset [%s(%s)]",
		     (int)tob->tob_value, var->var_name, var->var_index);
	    else
		post("vv %x plusvar_postset [%s]",
		     (int)tob->tob_value, var->var_name);
#endif
	}
	else plusloud_tclerror(0, interp, "cannot set variable");
    }
    else
    {
	if (Tcl_UnsetVar2(interp, var->var_name, 0,
			  TCL_LEAVE_ERR_MSG) != TCL_OK)
	    plusloud_tclerror(0, interp, "cannot unset variable");
	rob = 0;
    }
    Tcl_Release(interp);
    return (rob);
}

Tcl_Obj *plusvar_push(t_plusvar *var)
{
    if (((t_plustob *)var)->tob_value)
	return (plusvar_postset(var));
    else
	return (0);
}

Tcl_Obj *plusvar_pull(t_plusvar *var)
{
    Tcl_Obj *rob;
    t_plustob *tob = (t_plustob *)var;
    Tcl_Interp *interp = tob->tob_tin->tin_interp;
    Tcl_Preserve(interp);
    if (rob = Tcl_ObjGetVar2(interp, var->var_part1, var->var_part2,
			     TCL_LEAVE_ERR_MSG))
	plustob_set(tob, tob->tob_tin, rob);
    else
	plusloud_tclerror(0, interp, "cannot read variable");
    Tcl_Release(interp);
    return (rob);
}

Tcl_Obj *plusvar_set(t_plusvar *var, Tcl_Obj *ob, int doit)
{
    t_plustob *tob = (t_plustob *)var;
    if (plustob_set(tob, tob->tob_tin, ob))
	return (doit ? plusvar_postset(var) : tob->tob_value);
    else
	return (0);
}

Tcl_Obj *plusvar_setfloat(t_plusvar *var, t_float f, int doit)
{
    t_plustob *tob = (t_plustob *)var;
    if (plustob_setfloat(tob, f))
	return (doit ? plusvar_postset(var) : tob->tob_value);
    else
	return (0);
}

Tcl_Obj *plusvar_setsymbol(t_plusvar *var, t_symbol *s, int doit)
{
    t_plustob *tob = (t_plustob *)var;
    if (plustob_setsymbol(tob, s))
	return (doit ? plusvar_postset(var) : tob->tob_value);
    else
	return (0);
}

Tcl_Obj *plusvar_setlist(t_plusvar *var, int ac, t_atom *av, int doit)
{
    t_plustob *tob = (t_plustob *)var;
    if (plustob_setlist(tob, ac, av))
	return (doit ? plusvar_postset(var) : tob->tob_value);
    else
	return (0);
}

/* LATER derive +string from +bob */

typedef struct _plusstring
{
    int    ps_len;
    char  *ps_buf;
    int    ps_refcount;
} t_plusstring;

/* Resolving dot-separators, unless script is empty. */
t_plusstring *plusstring_fromatoms(int ac, t_atom *av, t_scriptlet *script)
{
    t_plusstring *ps = 0;
    char *buf;
    int length;
    if (script)
    {
	char *start;
	scriptlet_reset(script);
	scriptlet_add(script, 1, 1, ac, av);
	start = scriptlet_getcontents(script, &length);
	buf = copybytes(start, length);
    }
    else
    {
	char *newbuf;
	buf = getbytes(0);
	length = 0;
	while (ac--)
	{
	    char string[MAXPDSTRING];
	    int newlength;
	    if ((av->a_type == A_SEMI || av->a_type == A_COMMA) &&
		length && buf[length-1] == ' ') length--;
	    atom_string(av, string, MAXPDSTRING);
	    newlength = length + strlen(string) + 1;
	    if (!(newbuf = resizebytes(buf, length, newlength))) break;
	    buf = newbuf;
	    strcpy(buf + length, string);
	    length = newlength;
	    if (av->a_type == A_SEMI) buf[length-1] = '\n';
	    else buf[length-1] = ' ';
	    av++;
	}
	if (length && buf[length-1] == ' ')
	{
	    if (newbuf = resizebytes(buf, length, length-1))
	    {
		buf = newbuf;
		length--;
	    }
	}
    }
    ps = getbytes(sizeof(*ps));
    ps->ps_len = length;
    ps->ps_buf = buf;
    ps->ps_refcount = 0;
    return (ps);
}

void plusstring_preserve(t_plusstring *ps)
{
    ps->ps_refcount++;
}

void plusstring_release(t_plusstring *ps)
{
    if (--ps->ps_refcount <= 0)
    {
	if (ps->ps_refcount == 0)
	{
	    if (ps->ps_buf) freebytes(ps->ps_buf, ps->ps_len);
	    freebytes(ps, sizeof(*ps));
	}
	else bug("plusstring_release");
    }
}

typedef struct _plusword
{
    int         pw_type;
    Tcl_Obj    *pw_ob;
    Tcl_Token  *pw_ndxv;  /* index part of this word (if array variable) */
    int         pw_ndxc;  /* numComponents of the above */
} t_plusword;

#define PLUSTOT_MAXINLETS   256  /* LATER rethink */
#define PLUSTOT_INIMAXWORDS  16

/* LATER elaborate */
#define PLUSTOT_ERRUNKNOWN  -1
#define PLUSTOT_ERROTHER    -2

typedef struct _plusproxy
{
    t_pd        pp_pd;
    t_pd       *pp_master;
    t_plusvar  *pp_var;
    int         pp_ndx;
    int         pp_doit;
    int         pp_warned;
} t_plusproxy;

typedef struct _plustot
{
    t_object       x_ob;
    t_glist       *x_glist;
    t_plustob     *x_tob;        /* interpreter's result (after invocation) */
    t_scriptlet   *x_script;
    Tcl_Obj       *x_cname;      /* command name, main validation flag */
    Tcl_CmdInfo    x_cinfo;
    t_plusstring  *x_ctail;      /* command arguments, parse validation flag */
    Tcl_Parse      x_tailparse;
    int            x_maxwords;   /* as allocated */
    int            x_nwords;     /* as used, including command name */
    t_plusword    *x_words;      /* arguments, not evaluated */
    t_plusword     x_wordsini[PLUSTOT_INIMAXWORDS];
    int            x_maxargs;    /* == maxwords, except during growing */
    int            x_argc;       /* 0 or nwords, except during evaluation */
    Tcl_Obj      **x_argv;       /* command name and evaluated arguments */
    Tcl_Obj       *x_argvini[PLUSTOT_INIMAXWORDS];
    int            x_pseudoscalar;
    int            x_nproxies;
    t_plusproxy  **x_proxies;
    t_plusproxy   *x_mainproxy;  /* == x_proxies[0], unless pseudo-scalar */
    int            x_grabwarned;
} t_plustot;

static t_class *plusproxy_class;
static t_class *plustot_class;

/* Create a variable here only for the main slot.  Other slots are to be
   filled during the second parsing pass, in order to fill only the slots
   that are actually referenced.  If ndx is negative, then create
   a pseudo-scalar, otherwise this is a pseudo-array element. */
static t_plusproxy *plusproxy_new(t_pd *master, int ndx, t_plustin *tin)
{
    t_plusproxy *pp = (t_plusproxy *)pd_new(plusproxy_class);
    pp->pp_master = master;
    pp->pp_var = (ndx > 0 ? 0 : plusvar_new("in", (ndx ? 0 : "0"), tin));
    if (pp->pp_var)
    {
	plusbob_preserve((t_plusbob *)pp->pp_var);
	plusbob_setowner((t_plusbob *)pp->pp_var, master);
    }
    pp->pp_ndx = ndx;
    pp->pp_doit = (ndx < 1);
    pp->pp_warned = 0;
    return (pp);
}

static void plusproxy_free(t_plusproxy *pp)
{
#ifdef PLUSTOT_DEBUG
    post("plusproxy_free (%s %d)",
	 (pp->pp_var ? pp->pp_var->var_name : "empty"), pp->pp_ndx);
#endif
    if (pp->pp_var)
	plusbob_release((t_plusbob *)pp->pp_var);
}

static void plusproxy_emptyhit(t_plusproxy *pp)
{
    if (!pp->pp_warned)
    {
	loud_error(pp->pp_master, "empty slot hit");
	pp->pp_warned = 1;
    }
}

static void plusproxy_bang(t_plusproxy *pp)
{
    if (pp->pp_var)
	plusvar_push(pp->pp_var);
    else
	plusproxy_emptyhit(pp);
}

static void plusproxy_float(t_plusproxy *pp, t_float f)
{
    if (pp->pp_var)
	plusvar_setfloat(pp->pp_var, f, pp->pp_doit);
    else
	plusproxy_emptyhit(pp);
}

static void plusproxy_symbol(t_plusproxy *pp, t_symbol *s)
{
    if (pp->pp_var)
	plusvar_setsymbol(pp->pp_var, s, pp->pp_doit);
    else
	plusproxy_emptyhit(pp);
}

static void plusproxy_list(t_plusproxy *pp, t_symbol *s, int ac, t_atom *av)
{
    if (pp->pp_var)
	plusvar_setlist(pp->pp_var, ac, av, pp->pp_doit);
    else
	plusproxy_emptyhit(pp);
}

#ifdef PLUSTOT_DEBUG
static void plusproxy_debug(t_plusproxy *pp)
{
    t_plustin *tin = ((t_plustob *)pp->pp_var)->tob_tin;
    t_symbol *id = plusenv_getid((t_plusenv *)tin);
    t_symbol *glname = plustin_getglistname(tin);
    post("+proxy %d, glist %x",
	 pp->pp_ndx, (int)((t_plustot *)pp->pp_master)->x_glist);
    post("  plustin '%s' (%s) over %x", (id ? id->s_name : "default"),
	 (glname ? glname->s_name : "<anonymous>"), (int)tin->tin_interp);
}
#endif

/* First pass (!doit): determine number of slots.
   Second pass (doit): create variables for non-empty slots. */
static int plustot_usevariable(t_plustot *x, Tcl_Token *tp, int doit)
{
    int nc = tp->numComponents;
    char *errmess = 0;
    int errcode = PLUSTOT_ERRUNKNOWN;
#ifdef PLUSTOT_DEBUG
    if (!doit)
    {
	char buf[MAXPDSTRING];
	int size = tp->size;
	if (size > (MAXPDSTRING-2))
	{
	    size = (MAXPDSTRING-2);
	    buf[MAXPDSTRING-2] = '*';
	    buf[MAXPDSTRING-1] = 0;
	}
	else buf[size] = 0;
	strncpy(buf, tp->start, size);
	startpost("%s ", buf);
    }
#endif
    tp++;
    if (nc && tp->type == TCL_TOKEN_TEXT)
    {
	if (strncmp(tp->start, "in", tp->size))
	{
	    /* regular variable */
	    /* LATER consider tracing it (2nd pass) */
	}
	else
	{
	    /* pseudo-variable */
	    int inno = -1;
	    tp++;
	    if (nc == 1)
	    {
		if (x->x_nproxies && !x->x_pseudoscalar)
		{
		    errmess = "mixed scalar and array forms of pseudo-variable";
		    errcode = PLUSTOT_ERROTHER;
		    goto badvariable;
		}
		inno = 0;
		x->x_pseudoscalar = 1;
	    }
	    else if (nc == 2 && tp->type == TCL_TOKEN_TEXT)
	    {
		int i;
		char *p;
		if (x->x_pseudoscalar)
		{
		    errmess = "mixed scalar and array forms of pseudo-variable";
		    errcode = PLUSTOT_ERROTHER;
		    goto badvariable;
		}
		inno = 0;
		for (i = 0, p = (char *)tp->start; i < tp->size; i++, p++)
		{
		    if (*p < '0' || *p > '9')
		    {
			errmess = "invalid inlet number in pseudo-variable";
			errcode = PLUSTOT_ERROTHER;
			goto badvariable;
		    }
		    inno = inno * 10 + (int)(*p - '0');
		}
		if (inno > PLUSTOT_MAXINLETS)
		{
		    errmess = "inlet number too large in pseudo-variable";
		    errcode = PLUSTOT_ERROTHER;
		    goto badvariable;
		}
	    }
	    else
	    {
		errmess = "invalid index format in pseudo-variable";
		errcode = PLUSTOT_ERROTHER;
		goto badvariable;
	    }
	    if (inno >= 0)
	    {
		if (!doit)
		{
#ifdef PLUSTOT_DEBUG
		    startpost("(inlet %d) ", inno);
#endif
		    if (inno >= x->x_nproxies)
			x->x_nproxies = inno + 1;
		}
		else if (inno < x->x_nproxies)
		{
		    if (inno > 0 && !x->x_proxies[inno]->pp_var)
		    {
			t_plusvar *var;
			char buf[8];
			sprintf(buf, "%d", inno);
			var = plusvar_new("in", buf, x->x_tob->tob_tin);
			plusbob_preserve((t_plusbob *)var);
			plusbob_setowner((t_plusbob *)var, (t_pd *)x);
			x->x_proxies[inno]->pp_var = var;
		    }
		}
		else
		{
		    PLUSDEBUG_ENDPOST("plustot_usevariable");
		    bug("plustot_usevariable");
		    goto badvariable;
		}
	    }
	    else
	    {
		errmess = "invalid pseudo-variable";
		errcode = PLUSTOT_ERROTHER;
		goto badvariable;
	    }
	}
	return (1);
    }
    else plusloud_tcldirty((t_pd *)x, "plustot_usevariable");
badvariable:
    if (errmess)
    {
	PLUSDEBUG_ENDPOST("plustot_usevariable");
	loud_error((t_pd *)x, errmess);
    }
    return (errcode);
}

static int plustot_doparsevariables(t_plustot *x, Tcl_Interp *interp,
				    const char *buf, int len,
				    Tcl_Parse *parsep, int doit)
{
    int nvars = 0;
    int errcode = PLUSTOT_ERRUNKNOWN;
    if (Tcl_ParseCommand(interp, buf, len, 0, parsep) == TCL_OK)
    {
	int ntok = parsep->numTokens;
	Tcl_Token *tp = parsep->tokenPtr;
	while (ntok--)
	{
	    if (tp->type == TCL_TOKEN_VARIABLE)
	    {
		int res = plustot_usevariable(x, tp, doit);
		if (res > 0)
		    nvars++;
		else
		{
		    errcode = res;
		    goto parsefailed;
		}
	    }
	    else if (tp->type == TCL_TOKEN_COMMAND)
	    {
		if (tp->size > 2)
		{
		    Tcl_Parse parse;
		    int res =
			plustot_doparsevariables(x, interp, tp->start + 1,
						 tp->size - 2, &parse, doit);
		    if (res != PLUSTOT_ERRUNKNOWN)
			Tcl_FreeParse(&parse);
		    if (res >= 0)
			nvars += res;
		    else
		    {
			errcode = res;
			goto parsefailed;
		    }
		}
	    }
	    else if (tp->type == TCL_TOKEN_SIMPLE_WORD
		     && tp->size > 2 && *tp->start == '{')
	    {
		tp++;
#if 0 && defined(PLUSTOT_DEBUG)
		if (doit && tp->size > 0)
		{
		    char buf[MAXPDSTRING+1];
		    int sz = (tp->size < MAXPDSTRING ? tp->size : MAXPDSTRING);
		    strncpy(buf, tp->start, sz);
		    buf[sz] = 0;
		    post("simple word's text:  %s", buf);
		}
#endif
		if (ntok-- && tp->type == TCL_TOKEN_TEXT && tp->size > 0)
		{
		    Tcl_Parse parse;
		    int res =
			plustot_doparsevariables(x, interp, tp->start,
						 tp->size, &parse, doit);
		    if (res != PLUSTOT_ERRUNKNOWN)
			Tcl_FreeParse(&parse);
		    if (res >= 0)
			nvars += res;
		    else
		    {
			errcode = res;
			goto parsefailed;
		    }
		}
		else
		{
		    plusloud_tcldirty((t_pd *)x, "plustot_doparsevariables");
		    goto parsefailed;
		}
	    }
#if 0 && defined(PLUSTOT_DEBUG)
	    else if (doit && tp->size > 0)
	    {
		char buf[MAXPDSTRING+1];
		int sz = (tp->size < MAXPDSTRING ? tp->size : MAXPDSTRING);
		strncpy(buf, tp->start, sz);
		buf[sz] = 0;
		post("other type (%d):  %s", tp->type, buf);
	    }
#endif
	    tp++;
	}
    }
    else goto parsefailed;
    return (nvars);
parsefailed:
    return (errcode);
}

static int plustot_parsevariables(t_plustot *x, Tcl_Interp *interp,
				  const char *buf, int len,
				  Tcl_Parse *parsep, int doit)
{
    int nvars;
#ifdef PLUSTOT_DEBUG
    if (!doit) startpost("variables: ");
#endif
    nvars = plustot_doparsevariables(x, interp, buf, len, parsep, doit);
#ifdef PLUSTOT_DEBUG
    if (!doit)
    {
	if (nvars > 0)
	{
	    post("\n%d variable substitutions", nvars);
	    post("%d inlets requested", x->x_nproxies);
	}
	else if (nvars == 0) post("none");
    }
#endif
    return (nvars);
}

static int plustot_makeproxies(t_plustot *x)
{
    Tcl_Interp *interp = x->x_tob->tob_tin->tin_interp;
    if (interp)
    {
	if (x->x_nproxies == 1)
	{
	    x->x_mainproxy =
		plusproxy_new((t_pd *)x, (x->x_pseudoscalar ? -1 : 0),
			      x->x_tob->tob_tin);
	}
	else if (x->x_nproxies > 1 && !x->x_pseudoscalar)
	{
	    if (x->x_proxies = getbytes(x->x_nproxies * sizeof(*x->x_proxies)))
	    {
		int i;
		for (i = 0; i < x->x_nproxies; i++)
		    x->x_proxies[i] =
			plusproxy_new((t_pd *)x, i, x->x_tob->tob_tin);
		for (i = 1; i < x->x_nproxies; i++)
		    inlet_new((t_object *)x, (t_pd *)x->x_proxies[i], 0, 0);
		x->x_mainproxy = x->x_proxies[0];
		/* second pass: traverse non-empty slots, create variables */
		plustot_parsevariables(x, interp,
				       x->x_ctail->ps_buf, x->x_ctail->ps_len,
				       &x->x_tailparse, 1);
	    }
	    else goto proxiesfailed;
	}
	else
	{
	    bug("plustot_makeproxies");
	    goto proxiesfailed;
	}
	return (1);
    }
proxiesfailed:
    return (0);
}

static void plustot_initwords(t_plustot *x)
{
    if (x->x_words != x->x_wordsini)
	freebytes(x->x_words, x->x_maxwords * sizeof(*x->x_words));
    x->x_maxwords = PLUSTOT_INIMAXWORDS;
    x->x_nwords = 0;
    x->x_words = x->x_wordsini;
}

static void plustot_initargs(t_plustot *x)
{
    if (x->x_argv != x->x_argvini)
	freebytes(x->x_argv, x->x_maxargs * sizeof(*x->x_argv));
    x->x_maxargs = PLUSTOT_INIMAXWORDS;
    x->x_argc = 0;
    x->x_argv = x->x_argvini;
    x->x_argv[0] = x->x_cname;
}

static int plustot_resetwords(t_plustot *x)
{
    int i;
    for (i = 1; i < x->x_nwords; i++)
	PLUSDEBUG_DECRREFCOUNT(x->x_words[i].pw_ob, "plustot_resetwords");
    x->x_nwords = 0;
    if (x->x_ctail)
    {
	int nwords = x->x_tailparse.numWords + 1;
	if (nwords > x->x_maxwords)
	{
	    int n = nwords;
#ifdef PLUSTOT_DEBUG
	    post("growing words %d -> %d", x->x_maxwords, nwords);
#endif
	    x->x_words = grow_nodata(&n, &x->x_maxwords, x->x_words,
				     PLUSTOT_INIMAXWORDS, x->x_wordsini,
				     sizeof(*x->x_words));
	    if (n != nwords)
		return (0);
	}
	return (1);
    }
    else return (0);
}

static int plustot_resetargs(t_plustot *x)
{
    int i;
    for (i = 1; i < x->x_argc; i++)
	PLUSDEBUG_DECRREFCOUNT(x->x_argv[i], "plustot_resetargs");
    x->x_argc = 0;
    x->x_argv[0] = x->x_cname;
    if (x->x_ctail)
    {
	int nargs = x->x_maxwords;
	if (nargs > x->x_maxargs)
	{
	    int n = nargs;
#ifdef PLUSTOT_DEBUG
	    post("growing argv %d -> %d", x->x_maxargs, nargs);
#endif
	    x->x_argv = grow_nodata(&n, &x->x_maxargs, x->x_argv,
				    PLUSTOT_INIMAXWORDS, x->x_argvini,
				    sizeof(*x->x_argv));
	    x->x_argv[0] = x->x_cname;
	    if (n != nargs)
	    {
		plustot_initwords(x);
		plustot_initargs(x);
		return (0);
	    }
	}
	else if (nargs < x->x_maxargs)
	{
	    bug("plustot_resetargs");  /* LATER rethink */
	    plustot_initwords(x);
	    plustot_initargs(x);
	    return (0);
	}
	return (1);
    }
    else return (0);
}

static int plustot_makewords(t_plustot *x)
{
    if (plustot_resetwords(x))
    {
	int i, ncomponents = 0, nwords = x->x_tailparse.numWords + 1;
	Tcl_Token *tp;
	int len;
	char buf[TCL_UTF_MAX];
#ifdef PLUSTOT_DEBUG
	post("arguments:");
#endif
	for (i = 1, tp = x->x_tailparse.tokenPtr;
	     i < nwords; i++, tp += ncomponents)
	{
#ifdef PLUSTOT_DEBUG
	    post("  %s token: type %d[%d], having %d[%d] component%s",
		 loud_ordinal(i), tp->type, tp[1].type,
		 tp->numComponents, tp[1].numComponents,
		 (tp->numComponents > 1 ? "s" : ""));
#endif
	    ncomponents = tp->numComponents;
	    tp++;
	    switch (x->x_words[i].pw_type = tp->type)
	    {
	    case TCL_TOKEN_TEXT:
		x->x_words[i].pw_ob = Tcl_NewStringObj(tp->start, tp->size);
		break;

	    case TCL_TOKEN_BS:
		len = Tcl_UtfBackslash(tp->start, 0, buf);
		x->x_words[i].pw_ob = Tcl_NewStringObj(buf, len);
		break;

	    case TCL_TOKEN_COMMAND:
		x->x_words[i].pw_ob = Tcl_NewStringObj(tp->start + 1,
						       tp->size - 2);
		break;

	    case TCL_TOKEN_VARIABLE:
		if (tp->numComponents > 1)
		{
		    x->x_words[i].pw_ndxv = tp + 2;
		    x->x_words[i].pw_ndxc = tp->numComponents - 1;
		}
		else x->x_words[i].pw_ndxv = 0;
		x->x_words[i].pw_ob = Tcl_NewStringObj(tp[1].start, tp[1].size);
		break;

	    default:
		plusloud_tcldirty((t_pd *)x,
				  "plustot_makewords (unexpected token type)");
		goto wordsfailed;
	    }
	    PLUSDEBUG_INCRREFCOUNT(x->x_words[i].pw_ob, "plustot_makewords");
	}
	x->x_nwords = nwords;
	return (1);
wordsfailed:
	x->x_nwords = i;
	plustot_resetwords(x);
    }
    return (0);
}

static int plustot_argsfromwords(t_plustot *x, Tcl_Interp *interp)
{
    if (plustot_resetargs(x))
    {
	t_plusword *pw;
	int i;
	for (i = 1, pw = &x->x_words[1]; i < x->x_nwords; i++, pw++)
	{
	    int result;
	    if (pw->pw_type == TCL_TOKEN_COMMAND)
	    {
		result = Tcl_EvalObjEx(interp, pw->pw_ob, 0);
		if (result == TCL_OK)
		{
		    if (x->x_argv[i] = Tcl_GetObjResult(interp))
		    {
			PLUSDEBUG_INCRREFCOUNT(x->x_argv[i],
					       "plustot_argsfromwords");
			Tcl_ResetResult(interp);
		    }
		    else
		    {
			plusloud_tcldirty((t_pd *)x, "plustot_argsfromwords");
			goto evalfailed;
		    }
		}
		else
		{
		    plusloud_tclerror((t_pd *)x, interp, "bad word (command)");
		    goto evalfailed;
		}
	    }
	    else if (pw->pw_type == TCL_TOKEN_VARIABLE)
	    {
		Tcl_Obj *indexp;
		if (x->x_words[i].pw_ndxv)
		{
		    /* FIXME */
		    int res = Tcl_EvalTokensStandard(interp,
						     x->x_words[i].pw_ndxv,
						     x->x_words[i].pw_ndxc);
		    if (res == TCL_OK)
		    {
			indexp = Tcl_GetObjResult(interp);
			PLUSDEBUG_INCRREFCOUNT(indexp,
					       "plustot_argsfromwords");
			Tcl_ResetResult(interp);
		    }
		    else
		    {
			plusloud_tclerror((t_pd *)x, interp, "bad index");
			goto evalfailed;
		    }
		}
		else indexp = 0;
		if (x->x_argv[i] = Tcl_ObjGetVar2(interp, pw->pw_ob, indexp,
						  TCL_LEAVE_ERR_MSG))
		{
		    PLUSDEBUG_INCRREFCOUNT(x->x_argv[i],
					   "plustot_argsfromwords");
		    Tcl_ResetResult(interp);
		}
		else
		{
		    plusloud_tclerror((t_pd *)x, interp, "bad word (variable)");
		    goto evalfailed;
		}
	    }
	    else
	    {
		x->x_argv[i] = pw->pw_ob;
		/* refcount is 1 already (makewords), but we need to comply to
		   a general rule: args are decremented after use (resetargs) */
		PLUSDEBUG_INCRREFCOUNT(x->x_argv[i], "plustot_argsfromwords");
	    }
	}
	x->x_argc = x->x_nwords;
	return (1);
evalfailed:
	x->x_argc = i;
	plustot_resetargs(x);
    }
    return (0);  /* LATER find a proper way for passing a result */
}

static int plustot_argsfromtokens(t_plustot *x, Tcl_Interp *interp)
{
    if (plustot_resetargs(x))
    {
	int i, nwords = x->x_tailparse.numWords + 1;
	Tcl_Token *tp;
#ifdef PLUSTOT_DEBUG
	post("arguments:");
#endif
	for (i = 1, tp = x->x_tailparse.tokenPtr;
	     i < nwords; i++, tp += (tp->numComponents + 1))
	{
	    int result;
#ifdef PLUSTOT_DEBUG
	    startpost("  %s token: type %d[%d], having %d component%s",
		      loud_ordinal(i), tp->type, tp[1].type,
		      tp->numComponents, (tp->numComponents > 1 ? "s" : ""));
#endif
	    result = Tcl_EvalTokensStandard(interp, tp + 1, tp->numComponents);
	    if (result == TCL_OK)
	    {
		if (x->x_argv[i] = Tcl_GetObjResult(interp))
		{
		    PLUSDEBUG_INCRREFCOUNT(x->x_argv[i],
					   "plustot_argsfromwords");
		    Tcl_ResetResult(interp);
#ifdef PLUSTOT_DEBUG
		    post(", %sshared: '%s'",
			 (Tcl_IsShared(x->x_argv[i]) ? "" : "not "),
			 Tcl_GetString(x->x_argv[i]));
#endif
		}
		else
		{
		    PLUSDEBUG_ENDPOST("plustot_argsfromtokens");
		    plusloud_tcldirty((t_pd *)x, "plustot_argsfromtokens");
		}
	    }
	    else
	    {
		PLUSDEBUG_ENDPOST("plustot_argsfromtokens");
		plusloud_tclerror((t_pd *)x, interp, "bad token");
		while (--i)
		    PLUSDEBUG_DECRREFCOUNT(x->x_argv[i],
					   "plustot_argsfromtokens");
		return (0);  /* LATER find a proper way for passing a result */
	    }
	}
	x->x_argc = nwords;
	return (1);
    }
    else return (0);
}

/* not used yet */
static int plustot_ifgrabshared(t_plustot *x, Tcl_Obj *ob)
{
    if (!x->x_grabwarned)
    {
	x->x_grabwarned = 1;
	loud_warning((t_pd *)x, "shared result of a command '%s'",
		     (x->x_cname ? Tcl_GetString(x->x_cname) : "???"));
    }
    return (1);
}

static int plustot_push(t_plustot *x)
{
    if (x->x_proxies)
    {
	int i;
	for (i = 1; i < x->x_nproxies; i++)
	    if (x->x_proxies[i]->pp_var)
		if (!plusvar_push(x->x_proxies[i]->pp_var))
		    return (0);
    }
    return (1);
}

static int plustot_doit(t_plustot *x)
{
    int result = 0;
    Tcl_Interp *interp = x->x_tob->tob_tin->tin_interp;
    if (x->x_cname && plustot_push(x) &&
	plustot_argsfromwords(x, interp))
    {
	if ((*x->x_cinfo.objProc)(x->x_cinfo.objClientData, interp,
				  x->x_argc, x->x_argv) == TCL_OK)
	{
	    if (plustob_grabresult(x->x_tob))
		result = 1;
	}
	else plusloud_tclerror((t_pd *)x, interp, "command failed");
	/* Although args are to be reset in the next call to
	   plustot_argsfromwords(), however, plusvar_preset() will be called
	   first, so, unless reset is done here, $ins would be shared there.
	   LATER rethink. */
	plustot_resetargs(x);
    }
    return (result);
}

static void plustot_eval(t_plustot *x)
{
    plustot_doit(x);
}

static void plustot_get(t_plustot *x)
{
    if (x->x_tob->tob_value)
	outlet_plusbob(((t_object *)x)->ob_outlet, (t_plusbob *)x->x_tob);
}

/* set in(0), no evaluation */
static void plustot_set(t_plustot *x, t_symbol *s, int ac, t_atom *av)
{
    if (x->x_mainproxy)
    {
	if (ac == 1)
	{
	    if (av->a_type == A_FLOAT)
		plusproxy_float(x->x_mainproxy, av->a_w.w_float);
	    else if (av->a_type == A_SYMBOL)
		plusproxy_symbol(x->x_mainproxy, av->a_w.w_symbol);
	}
	else plusproxy_list(x->x_mainproxy, s, ac, av);
    }
}

static void plustot_bang(t_plustot *x)
{
    if (x->x_mainproxy)
	plusproxy_bang(x->x_mainproxy);
    if (plustot_doit(x))
	outlet_plusbob(((t_object *)x)->ob_outlet, (t_plusbob *)x->x_tob);
}

static void plustot_float(t_plustot *x, t_float f)
{
    if (x->x_mainproxy)
	plusproxy_float(x->x_mainproxy, f);
    if (plustot_doit(x))
	outlet_plusbob(((t_object *)x)->ob_outlet, (t_plusbob *)x->x_tob);
}

static void plustot_symbol(t_plustot *x, t_symbol *s)
{
    if (x->x_mainproxy)
	plusproxy_symbol(x->x_mainproxy, s);
    if (plustot_doit(x))
	outlet_plusbob(((t_object *)x)->ob_outlet, (t_plusbob *)x->x_tob);
}

static void plustot_list(t_plustot *x, t_symbol *s, int ac, t_atom *av)
{
    if (x->x_mainproxy)
	plusproxy_list(x->x_mainproxy, s, ac, av);
    if (plustot_doit(x))
	outlet_plusbob(((t_object *)x)->ob_outlet, (t_plusbob *)x->x_tob);
}

static void plustot_tot(t_plustot *x, t_symbol *s, int ac, t_atom *av)
{
    if (ac)
    {
	Tcl_Obj *ob;
	char *start;
	int len;
	scriptlet_reset(x->x_script);
	scriptlet_add(x->x_script, 1, 1, ac, av);
	start = scriptlet_getcontents(x->x_script, &len);
	if (len > 0 && (ob = Tcl_NewStringObj(start, len)))
	{
	    /* LATER set a persistent ob, rather than create a new one */
	    PLUSDEBUG_INCRREFCOUNT(ob, "plustot_tot");
	    if (plustob_evalob(x->x_tob, ob) && s == totps_query)
		outlet_plusbob(((t_object *)x)->ob_outlet,
			       (t_plusbob *)x->x_tob);
	    PLUSDEBUG_DECRREFCOUNT(ob, "plustot_tot");
	}
    }
}

#ifdef PLUSTOT_DEBUG
static void plustot_debug(t_plustot *x)
{
    t_plustin *tin = x->x_tob->tob_tin;
    t_symbol *id = plusenv_getid((t_plusenv *)tin);
    t_symbol *glname = plustin_getglistname(tin);
    post("+tot, glist %x", (int)x->x_glist);
    post("  plustin '%s' (%s) over %x", (id ? id->s_name : "default"),
	 (glname ? glname->s_name : "<anonymous>"), (int)tin->tin_interp);
    if (x->x_mainproxy)
	plusproxy_debug(x->x_mainproxy);
}
#endif

static void plustot_free(t_plustot *x)
{
    int i;
    plusbob_release((t_plusbob *)x->x_tob);
    if (x->x_cname) PLUSDEBUG_DECRREFCOUNT(x->x_cname, "plustot_free");
    if (x->x_ctail)
    {
	for (i = 1; i < x->x_nwords; i++)
	    PLUSDEBUG_DECRREFCOUNT(x->x_words[i].pw_ob, "plustot_free");
	for (i = 1; i < x->x_argc; i++)
	    PLUSDEBUG_DECRREFCOUNT(x->x_argv[i], "plustot_free");
	if (x->x_words != x->x_wordsini)
	    freebytes(x->x_words, x->x_maxwords * sizeof(*x->x_words));
	if (x->x_argv != x->x_argvini)
	    freebytes(x->x_argv, x->x_maxwords * sizeof(*x->x_argv));
	Tcl_FreeParse(&x->x_tailparse);
	plusstring_release(x->x_ctail);
    }
    if (x->x_mainproxy) pd_free((t_pd *)x->x_mainproxy);
    if (x->x_proxies)
    {
	for (i = 1; i < x->x_nproxies; i++)
	    pd_free((t_pd *)x->x_proxies[i]);
	freebytes(x->x_proxies, x->x_nproxies * sizeof(*x->x_proxies));
    }
    if (x->x_script) scriptlet_free(x->x_script);
}

static void *plustot_new(t_symbol *s, int ac, t_atom *av)
{
    t_plustot *x = 0;
    t_plusstring *ctail = 0;
    t_symbol *cmdname = 0;  /* command name or +selector */
    t_glist *glist = canvas_getcurrent();
    t_plustin *tin = 0;
    t_plustob *tob = 0;
    t_scriptlet *script = scriptlet_new(0, 0, 0, 0, glist, 0);
    if (ac && av->a_type == A_SYMBOL)
    {
	cmdname = av->a_w.w_symbol;
	ac--; av++;
	if (*cmdname->s_name == '+')
	{
	    if (cmdname == plusps_env)
		return (plustot_env_new(cmdname, ac, av));
	    else if (cmdname == plusps_in)
		return (plustot_in_new(cmdname, ac, av));
	    else if (cmdname == plusps_var)
		return (plustot_var_new(cmdname, ac, av));
	    else if (cmdname == plusps_out)
		return (plustot_out_new(cmdname, ac, av));
	    else if (cmdname == plusps_qlist)
		return (plustot_qlist_new(cmdname, ac, av));
	    else if (cmdname == plusps_print)
		return (plustot_print_new(cmdname, ac, av));
	    else
	    {
		loud_error(0, "unknown +tot's subclass");
		return (0);
	    }
	}
	if (ac)
	{
	    ctail = plusstring_fromatoms(ac, av, script);
	    plusstring_preserve(ctail);
	}
    }
    if ((tin = plustin_glistprovide(glist, PLUSTIN_GLIST_ANY, 0)) &&
	(tob = plustob_new(tin, 0)))
    {
	x = (t_plustot *)pd_new(plustot_class);
	/* tin already preserved (plustob_new() did it) */
	plusbob_preserve((t_plusbob *)tob);
	plusbob_setowner((t_plusbob *)tob, (t_pd *)x);
	x->x_glist = glist;
	x->x_tob = tob;
	scriptlet_setowner(script, (t_pd *)x);
	x->x_script = script;
	x->x_cname = 0;
	x->x_ctail = 0;
	x->x_words = x->x_wordsini;
	plustot_initwords(x);
	x->x_argv = x->x_argvini;
	plustot_initargs(x);
	x->x_pseudoscalar = 0;
	x->x_nproxies = 0;
	x->x_proxies = 0;
	x->x_mainproxy = 0;
	x->x_grabwarned = 0;
	if (cmdname && *cmdname->s_name)
	{
	    Tcl_Interp *interp = tin->tin_interp;
	    if (interp)
	    {
		if (Tcl_GetCommandInfo(interp, cmdname->s_name, &x->x_cinfo))
		{
		    if (x->x_cinfo.isNativeObjectProc)
		    {
			x->x_cname = Tcl_NewStringObj(cmdname->s_name, -1);
			PLUSDEBUG_INCRREFCOUNT(x->x_cname, "plustot_new");
			x->x_argv[0] = x->x_cname;
		    }
		    else loud_error((t_pd *)x, "'%s' is not an object command",
				    cmdname->s_name);
		}
		else loud_error((t_pd *)x, "command '%s' does not exist",
				cmdname->s_name);
		if (x->x_cname && ctail)
		{
		    int nvars =
			plustot_parsevariables(x, interp,
					       ctail->ps_buf, ctail->ps_len,
					       &x->x_tailparse, 0);
		    if (nvars >= 0)
		    {
			int res = 1;
			x->x_ctail = ctail;
			if (x->x_nproxies)
			    res = plustot_makeproxies(x);
			if (res)
			    res = plustot_makewords(x);
			if (!res)
			    x->x_ctail = 0;
			Tcl_FreeParse(&x->x_tailparse);
		    }
		    else
		    {
			if (nvars == PLUSTOT_ERRUNKNOWN)
			    plusloud_tclerror((t_pd *)x, interp,
					    "parsing command arguments failed");
			else
			    Tcl_FreeParse(&x->x_tailparse);
			PLUSDEBUG_DECRREFCOUNT(x->x_cname, "plustot_new");
			x->x_cname = 0;
		    }
		}
	    }
	}
	outlet_new((t_object *)x, &s_symbol);
    }
    else
    {
	loud_error(0, "+tot: cannot initialize");
	if (tin)
	{
	    plusbob_preserve((t_plusbob *)tin);
	    plusbob_release((t_plusbob *)tin);
	}
	if (script) scriptlet_free(script);
    }
    if (ctail && !(x && x->x_ctail))
	plusstring_release(ctail);
    return (x);
}

void plustot_setup(void)
{
    post("beware! this is plustot %s, %s %s build...",
	 TOXY_VERSION, loud_ordinal(TOXY_BUILD), TOXY_RELEASE);
    plustot_class = class_new(gensym("+tot"),
			      (t_newmethod)plustot_new,
			      (t_method)plustot_free,
			      sizeof(t_plustot), 0, A_GIMME, 0);
    class_addcreator((t_newmethod)plustot_new,
		     gensym("plustot"), A_GIMME, 0);
    class_addbang(plustot_class, plustot_bang);
    class_addfloat(plustot_class, plustot_float);
    class_addsymbol(plustot_class, plustot_symbol);
    class_addlist(plustot_class, plustot_list);
    class_addmethod(plustot_class, (t_method)plustot_eval,
		    gensym("eval"), 0);
    class_addmethod(plustot_class, (t_method)plustot_set,
		    gensym("set"), A_GIMME, 0);
    class_addmethod(plustot_class, (t_method)plustot_get,
		    gensym("get"), 0);
    class_addmethod(plustot_class, (t_method)plustot_tot,
		    gensym("tot"), A_GIMME, 0);
    class_addmethod(plustot_class, (t_method)plustot_tot,
		    gensym("query"), A_GIMME, 0);
#ifdef PLUSTOT_DEBUG
    class_addmethod(plustot_class, (t_method)plustot_debug,
		    gensym("debug"), 0);
#endif

    plusproxy_class = class_new(gensym("+tot proxy"), 0,
				(t_method)plusproxy_free,
				sizeof(t_plusproxy), CLASS_PD, 0);
    class_addfloat(plusproxy_class, plusproxy_float);
    class_addsymbol(plusproxy_class, plusproxy_symbol);
    class_addlist(plusproxy_class, plusproxy_list);
#ifdef PLUSTOT_DEBUG
    class_addmethod(plusproxy_class, (t_method)plusproxy_debug,
		    gensym("debug"), 0);
#endif

    plusps_tot = gensym("+tot");
    plusps_env = gensym("+env");
    plusps_in = gensym("+in");
    plusps_var = gensym("+var");
    plusps_out = gensym("+out");
    plusps_qlist = gensym("+qlist");
    plusps_print = gensym("+print");
    plusps_Ti = gensym("+Ti");
    plusps_To = gensym("+To");
    plusps_Tv = gensym("+Tv");
    totps_query = gensym("query");

    plustin_basetype = plusenv_setup();
    plustin_type = plustype_new(plustin_basetype, plusps_Ti,
				sizeof(t_plustin),
				(t_plustypefn)plustin_delete, 0, 0, 0);
    plustob_type = plustype_new(0, plusps_To,
				sizeof(t_plustob),
				(t_plustypefn)plustob_delete, 0, 0,
				(t_plustypefn)plustob_attach);
    plusvar_type = plustype_new(plustob_type, plusps_Tv,
				sizeof(t_plusvar),
				(t_plustypefn)plusvar_delete, 0, 0, 0);

    plustot_env_setup();
    plustot_in_setup();
    plustot_var_setup();
    plustot_out_setup();
    plustot_qlist_setup();
    plustot_print_setup();
}