/* 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 #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 : ""), (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 : ""), (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(); }