| top | | Obj wyrm_oavGet(Intr intr,Obj mapping,Obj origobject,int N,Obj *P); | ^ | Referenced at: 2, 88, 89. | | | | | section top | |
case o_get:
if (N>=(4-bundled)) {
Obj mapping = bundled ? bundle : voav ? Tcl_ObjGetVar2(intr,P[2],0,TCL_LEAVE_ERR_MSG) : P[2];
Obj value = mapping ? wyrm_oavGet(intr,mapping,P[3-bundled],N-(4-bundled),P+(4-bundled)) : 0;
if (value) {
Tcl_SetObjResult(intr,value); decr(value);
return TCL_OK;
}else {
return TCL_ERROR;
}
}else {
Tcl_WrongNumArgs(intr,2,P,bundled ? "object.attribute ..." : "mapping object.attribute ...");
return TCL_ERROR;
}
| ^ | | | | | | section top | | | ^ | | | | | | section top | | - proc wyrm_oavGet—Find the object attribute's value, and return the found value or NULL if error.
| - output intr—The found value or an error message.
| - io mapping—Where objects are stored; its final position is at the object.
| - input origobject—The object-attribute to resolve.
| - input N—Number of additional parameters.
| - input P—Additional parameters which can be substituted into the found value.
| - output active—If the found value had the active value.
| - input super—Ignore the first direct get: only search delegate then parent.
| - input getkey—Return the actual key instead of the value.
|
|
|
<Task stack for delegatable gets>
<Get tracing>
<Push a new task>
Obj wyrm_oavGet(Intr intr,Obj mapping,Obj object,int N,Obj *P) {
ThreadData *thread = Tcl_GetThreadData(&oavKey,sizeof(ThreadData));
trace("wyrm_oavGet begin %{y}s",object);
if (!object) {
rprintf(intr,"get: no object specified.");
return 0;
}else {
int rc = TCL_OK;
pGets stack = 0; Obj found = 0,key = 0;
bool delegated = false,substed = false,super1 = thread->super; <Declare resumption flag>
int nobj; chars obj = Tcl_GetStringFromObj(object,&nobj);
incr(mapping); incr(object);
<Look up object key in the cache>
thread->active = false;
stack = pushGets(getting,obj,nobj,nobj,0,0,object,stack);
<Run through all tasks until a value is found or all searches fail>
if (rc==TCL_ERROR) {
decr(found); found = 0;
}
<Save the object key and found value in the cache>
if (found) {
<Prepare found value>
}
if (found) {
Tcl_SetObjResult(intr,found);
}else if (rc==TCL_OK) {
rprintf(intr,"missing: %{y}s",object); rc = TCL_ERROR;
}
trace("wyrm_oavGet end %{y}s -> %d %.40{r}s",object,rc,intr);
decr(mapping); decr(object); decr(key);
return found;
}
}
| ^ | Referenced at: 3, 88, 89. | | | | | section top | |
while (stack) {
int op = stack->op;
chars o = stack->o; int no = stack->no; int ro = stack->ro;
chars a = stack->a; int na = stack->na;
Obj ob = stack->ob; pGets under = stack->under;
dispose(stack); stack = under;
trace("%.pop op=%s o=%.*s ro=%.*s no=%d ro=%d a=%.*s rc=%d",
stack,DIS[op],
no>0?no:0,o?o:"",
ro>0?ro-no:0,o?o+no:"",
no,ro,
na>0?na:0,a?a:"",
rc);
if (ob) trace("%. ob=%{y}s",stack,ob);
if (found) trace("%. found=%{y}s",stack,found);
switch (op) {
<Release Obj task>
<Find the current object+attributes in the mapping stack>
<Begin getting a object in a mapping>
<Follow the delegation chain to a real value>
<See if the object is delegated independently of the attribute>
<Truncate the object to its parent and try searching that>
}
}
| ^ | | | | | | section top | | - type Gets—Delegate get task.
| - a—The current attribute string.
| - na—The current attribute length.
| - n—Stack depth, for debugging and error recovery only.
| - ob—The Obj version of the original or intermediate object.
| - op—The task operation.
| - under—The next task.
| - o—The current object string.
| - no—The current object length.
| - ro—The current object original length.
|
|
|
enum {
decring,finding,getting,gettingdirect,
ifdelegating,objdelegating,ifobjdelegating,
parenting
};
struct Gets {
int op;
chars o;
int no,ro;
chars a;
int na;
Obj ob;
int n;
pGets under;
};
#ifdef TESTING
static chars DIS[] = {
"decring","finding","getting","gettingdirect",
"ifdelegating","objdelegating","ifobjdelegating",
"parenting"
};
#endif
| ^ | | | | | | section top | |
bool active;
bool super;
bool getkey;
| ^ | Definition continued at: 27, 34, 36. | | | | | section top | |
case gettingdirect:
if (rc==TCL_ERROR) break;
if (!found) {
trace("%. not already found",stack);
stack = pushGets(ifdelegating,o,no,ro,a,na,0,stack);
stack = pushGets(finding,o,no,ro,a,na,0,stack);
}
break;
case ifdelegating:
if (rc==TCL_ERROR) break;
if (found && delegated) {
trace("%. found=%{y}s and delegated",stack,found);
stack = pushGets(decring,0,0,0,0,0,found,stack);
<Resume the delegation with all of the trailing key>
o = Tcl_GetStringFromObj(found,&no);
found = 0;
stack = pushGets(ifdelegating,o,no,no,0,0,0,stack);
stack = pushGets(finding,o,no,no,0,0,0,stack);
}
break;
| ^ | | | | | | section top | |
case objdelegating:
if (rc==TCL_ERROR) break;
if (!found) {
trace("%. not already found",stack);
stack = pushGets(ifobjdelegating,o,no,ro,a,na,0,stack);
stack = pushGets(finding,o,no,ro,0,0,0,stack);
}
break;
case ifobjdelegating:
if (rc==TCL_ERROR) break;
if (found && delegated) {
trace("%. found=%{y}s and delegated R=%d",stack,found,resumption);
stack = pushGets(decring,0,0,0,0,0,found,stack);
<Resume the delegation with all of the trailing key>
o = Tcl_GetStringFromObj(found,&no);
found = 0;
stack = pushGets(parenting,o,no,no,a,na,0,stack);
stack = pushGets(objdelegating,o,no,no,a,na,0,stack);
stack = pushGets(gettingdirect,o,no,no,a,na,0,stack);
}else {
decr(found); found = 0;
}
break;
| ^ | | | | | | section top | |
case parenting:
if (rc==TCL_ERROR) break;
if (!found) {
chars p = memrchr(o,'.',no);
trace("%. not already found",stack);
if (p) {
no = p-o;
stack = pushGets(parenting,o,no,ro,a,na,0,stack);
stack = pushGets(objdelegating,o,no,ro,a,na,0,stack);
stack = pushGets(gettingdirect,o,no,ro,a,na,0,stack);
}
}
break;
| ^ | | | | | | section top | | | ^ | | | | | | section top | |
case finding: {
Obj autre = 0;
if (rc==TCL_ERROR) break;
autre = incr(mapping);
decr(key); key = incr(Tcl_NewStringObj(o,no));
if (na && a) {
Tcl_AppendToObj(key,".",-1);
Tcl_AppendToObj(key,a,na);
}
decr(found);
for (;;) {
bool exact; int flags; Obj actualkey = 0;
Obj stackedkey=0,stackeddata=0;
if (super1) {
trace("%. skipped because of super",stack);
exact = false;
super1 = false;
break;
}else if (wyrm_assocGet(intr,autre,key,&actualkey,&found,&flags)==TCL_ERROR) {
rc = strbegins("missing:",Tcl_GetStringResult(intr)) ? TCL_OK : TCL_ERROR; exact = false;
}else if (!actualkey || !streq(Tcl_GetString(key),Tcl_GetString(actualkey))) {
decr(found); exact = false;
}else {
exact = true;
}
decr(actualkey); actualkey = 0;
trace("%. seek %{y}s exact=%d rc=%d %.40{r}s",stack,key,exact,rc,intr);
if (exact) {
delegated = (wyrm_oavFlagDelegate&flags)!=0;
<Set resumption flag if this is a resumed delegation>
substed = (wyrm_oavFlagSubst&flags)!=0;
thread->active = (wyrm_oavFlagActive&flags)!=0;
trace("%. get %{y}s D=%d R=%d S=%d",stack,found,delegated,resumption,substed);
break;
}else {
stackedkey = incr(Tcl_NewStringObj("/stacked/.script",-1));
rc = wyrm_assocGet(intr,autre,stackedkey,&actualkey,&stackeddata,&flags);
if (!actualkey || !streq(Tcl_GetString(actualkey),"/stacked/.script")) rc = TCL_BREAK;
decr(stackedkey); stackedkey = 0;
decr(actualkey); actualkey = 0;
if (rc==TCL_OK) {
rc = Tcl_EvalObj(intr,stackeddata);
trace("%. stacked script=%{y}s eval=%d %.40{r}s",stack,stackeddata,rc,intr);
if (rc==TCL_OK) {
decr(autre); autre = incr(Tcl_GetObjResult(intr));
}
decr(stackeddata);
if (rc!=TCL_OK) {rc = TCL_OK; break;}
}else {
stackedkey = incr(Tcl_NewStringObj("/stacked/.mapping",-1));
rc = wyrm_assocGet(intr,autre,stackedkey,&actualkey,&stackeddata,&flags);
if (!actualkey || !streq(Tcl_GetString(actualkey),"/stacked/.mapping")) rc = TCL_BREAK;
decr(stackedkey); stackedkey = 0;
decr(actualkey); actualkey = 0;
if (rc==TCL_OK) {
trace("%. stacked mapping=%.40{y}s eval=%d",stack,stackeddata);
decr(autre); autre = stackeddata;
}else {
trace("%. not found",stack);
found = 0; delegated = substed = false; <Clear resumption flag>
rc = TCL_OK; break;
}
}
}
}
decr(autre);
} break;
| ^ | | | | | | section top | |
case getting:
if (rc==TCL_ERROR) break;
a = memrchr(o,'.',no);
if (a) {
a++; na = no-(a-o);
stack = pushGets(parenting,o,a-o-1,a-o-1,a,na,0,stack);
stack = pushGets(objdelegating,o,a-o-1,a-o-1,a,na,0,stack);
}else
na = 0;
stack = pushGets(gettingdirect,o,a?a-o-1:no,a?a-o-1:no,a,na,0,stack);
break;
| ^ | | | | | | section top | |
case decring:
decr(ob);
break;
| ^ | | | | | | section top | | - proc pushGets—Push a new task; return the top
- Memory. Heap allocated, caller disposes.
| - input o,no,ro,a,na,ob—Task parameters.
| - input op—Task operation.
| - input stack—Pending task evaluated after the new one.
|
|
|
static pGets pushGets(int op,chars o,int no,int ro,chars a,int na,Obj ob,pGets stack) {
pGets e = heap(Gets);
trace("%.push op=%s o=%.*s ro=%.*s no=%d ro=%d a=%.*s",stack,DIS[op],
no>0?no:0,o?o:"",
ro>0?ro-no:0,o?o+no:"",
no,ro,
na>0?na:0,a?a:"");
if (ob) trace("%. ob=%{y}s",stack,ob);
if (no<0) no = o ? strlen(o) : 0;
if (ro<0) ro = no;
if (na<0) na = a ? strlen(a) : 0;
e->op = op; e->o = o; e->no = no; e->ro = ro; e->a = a; e->na = na; e->ob = ob;
e->n = stack ? stack->n+1 : 1;
e->under = stack; return e;
}
| ^ | | | | | | section top | | | ^ | Referenced at: 9, 88, 89. | | | | | section top | |
Obj S = incr(Tcl_NewObj());
int vllen; chars vlstr = Tcl_GetStringFromObj(found,&vllen);
int kylen; chars kystr = Tcl_GetStringFromObj(key,&kylen);
int oblen; chars obstr = Tcl_GetStringFromObj(object,&oblen);
int atlen=0; chars atstr = "";
chars p = memrchr(obstr,'.',oblen);
int rest = 0;
if (p) {
atstr = p; atlen = oblen - (atstr-obstr);
oblen = atstr-obstr;
}
if (atlen==0) {atlen = 2; atstr = "{}";}
for (; vllen>0; vllen--,vlstr++) {
if (*vlstr=='%') {
vllen--; vlstr++;
switch (vllen==0 ? 0 : *vlstr) {
case 0: Tcl_AppendToObj(S,"",1); break;
case 'a': Tcl_AppendToObj(S,atstr,atlen); break;
case 'k': Tcl_AppendToObj(S,kystr,kylen); break;
case 'o': Tcl_AppendToObj(S,obstr,oblen); break;
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9': {
chars t; int i = strtol(vlstr,&t,10)-1;
int l=0; chars s = i<N ? Tcl_GetStringFromObj(P[i],&l) : "";
if (*t=='%') t++;
vllen = vllen-(t-vlstr)+1; vlstr = t-1;
Tcl_AppendToObj(S,s,l); rest = i+1;
} break;
case '*': {
Obj list = incr(Tcl_NewListObj(N,P));
int l; chars s = Tcl_GetStringFromObj(list,&l);
Tcl_AppendToObj(S,s,l);
decr(list); rest = N;
} break;
case '+': {
Obj list = incr(Tcl_NewListObj(N-rest,P+rest));
int l; chars s = Tcl_GetStringFromObj(list,&l);
Tcl_AppendToObj(S,s,l);
decr(list); rest = N;
} break;
case ',': {
int i; for (i=0; i<N; i++) {
Tcl_ListObjAppendElement(0,S,P[i]);
}
} break;
case '-': {
do {vllen--,vlstr++;} while (vllen>0 && isspace(*vlstr));
if (vllen>0 && *vlstr=='{') {
int d;
Tcl_AppendToObj(S,vlstr,1);
for (d=1,vllen--,vlstr++; vllen>0 && d>0; vllen--,vlstr++) {
switch (*vlstr) {
case '{': d++; break;
case '}': d--; break;
case '\\':
if (vllen>=2) {
Tcl_AppendToObj(S,vlstr,1);
vllen--,vlstr++;
}
break;
}
Tcl_AppendToObj(S,vlstr,1);
}
}
vllen++,vlstr--;
} break;
default: Tcl_AppendToObj(S,vlstr,1); break;
}
}else {
Tcl_AppendToObj(S,vlstr,1);
}
}
| ^ | | | | | | section top | | int wyrm_oavDo(Intr intr,Obj mapping,Obj object,int N,Obj *P); | ^ | Referenced at: 2, 88, 89. | | | | | section top | |
case o_do:
if (N>=(4-bundled)) {
Obj mapping = bundled ? bundle : voav ? Tcl_ObjGetVar2(intr,P[2],0,TCL_LEAVE_ERR_MSG) : P[2];
return mapping ? wyrm_oavDo(intr,mapping,P[3-bundled],N-(4-bundled),P+(4-bundled)) : TCL_ERROR;
}else {
Tcl_WrongNumArgs(intr,2,P,bundled ? "object.attribute ..." : "mapping object.attribute ...");
return TCL_ERROR;
}
case o_other:
if (N>=(3-bundled)) {
Obj mapping = bundled ? bundle : voav ? Tcl_ObjGetVar2(intr,P[2],0,TCL_LEAVE_ERR_MSG) : P[2];
return mapping ? wyrm_oavDo(intr,mapping,P[1],N-(3-bundled),P+(3-bundled)) : TCL_ERROR;
}else {
Tcl_WrongNumArgs(intr,2,P,"mapping ...");
return TCL_ERROR;
}
| ^ | | | | | | section top | | | ^ | | | | | | section top | | - proc wyrm_oavDo—Result of evaluation, TCL_OK or TCL_ERROR.
| - output intr—The evaluation result or an error message.
| - io mapping—Where objects are stored; its final position is at the object.
| - input object—The object-attribute to resolve.
| - input N—Number of additional parameters.
| - input P—Additional parameters which can be substituted into the found value.
| - io activemapping—Active mapping during an oav do.
|
|
|
int wyrm_oavDo(Intr intr,Obj mapping,Obj object,int N,Obj *P) {
ThreadData *thread = Tcl_GetThreadData(&oavKey,sizeof(ThreadData));
Obj data = wyrm_oavGet(intr,mapping,object,N,P); int rc;
Obj oactivemapping = thread->activemapping;
thread->super = false;
thread->activemapping = incr(mapping);
if (data) {
if (thread->active) {
Tcl_AllowExceptions(intr);
rc = Tcl_EvalObj(intr,data);
}else {
Tcl_SetObjResult(intr,data);
rc = TCL_OK;
}
decr(data);
}else {
rc = TCL_ERROR;
}
decr(thread->activemapping); thread->activemapping = oactivemapping;
return rc;
}
| ^ | | | | | | section top | | | ^ | Definition continued at: 34, 36. | | | | | section top | | int wyrm_oavSuper(Intr intr,Obj mapping,Obj object,int N,Obj *P); | ^ | Referenced at: 2, 88, 89. | | | | | section top | |
case o_super:
if (N>=(4-bundled)) {
Obj mapping = bundled ? bundle : voav ? Tcl_ObjGetVar2(intr,P[2],0,TCL_LEAVE_ERR_MSG) : P[2];
return mapping ? wyrm_oavSuper(intr,mapping,P[3-bundled],N-(4-bundled),P+(4-bundled)) : TCL_ERROR;
}else {
Tcl_WrongNumArgs(intr,2,P,bundled ? "object.attribute ..." : "mapping object.attribute ...");
return TCL_ERROR;
}
| ^ | | | | | | section top | | | ^ | | | | | | section top | | - proc wyrm_oavSuper—Result of evaluation, TCL_OK or TCL_ERROR.
| - output intr—The evaluation result or an error message.
| - io mapping—Where objects are stored; its final position is at the object.
| - input object—The object-attribute to resolve.
| - input N—Number of additional parameters.
| - input P—Additional parameters which can be substituted into the found value.
|
|
|
int wyrm_oavSuper(Intr intr,Obj mapping,Obj object,int N,Obj *P) {
ThreadData *thread = Tcl_GetThreadData(&oavKey,sizeof(ThreadData));
int rc; thread->super = true;
rc = wyrm_oavDo(intr,mapping,object,N,P);
thread->super = false;
return rc;
}
| ^ | | | | | | section top | |
#ifdef TESTING
static void trace(chars format,...) {
ThreadData *thread = Tcl_GetThreadData(&oavKey,sizeof(ThreadData));
if (thread->tracing) {
va_list L; va_start(L,format);
if (format[0]=='%' && format[1]=='.') {
pGets s = va_arg(L,pGets);
for (; s; s=s->under) cputc(chstderr,'.');
format += 2;
}
vcprintf(chstderr,format,L); va_end(L);
cputc(chstderr,'\n');
}
}
#else
#define trace (void)
#endif
| ^ | | | | | | section top | |
#ifdef TESTING
case o_trace:
if (N==2) {
thread->tracing = !thread->tracing;
Tcl_SetObjResult(intr,Tcl_NewBooleanObj(thread->tracing)); return TCL_OK;
}else if (N==3) {
int rc = Tcl_GetBooleanFromObj(intr,P[2],&thread->tracing);
if (rc==TCL_OK) Tcl_SetObjResult(intr,Tcl_NewBooleanObj(thread->tracing));
return rc;
}else {
Tcl_WrongNumArgs(intr,3,P,"");
return TCL_ERROR;
}
#endif
| ^ | | | | | | section top | |
#ifdef TESTING
int tracing;
#endif
| ^ | Definition continued at: 36. | |
| |