DNA.
wyrm-oav
Version.
2.0.9
Namespace.
::wyrm
Command.
::wyrm::oav
Language.
c
Manpage.
oav (1WY)
Manpage.
wyrm_oavGet (3WY)
Manpage.
wyrm_oavKey (3WY)
Manpage.
wyrm_oavPut (3WY)
Testbase.
Test Script
Test Report
Import.
Interface.
wyrmwif
wyrm-assoc
Export.
Implementation.
wyrm-oav.c
Interface.
wyrm-oav.h
Object.
wyrm-oav.o

Object Attribute Value

Sections.
Compile Files
Object-Attribute-Value Mappings
Delegatable OAV Queries
Cache
Resumption
Object Key Parsing
OAV Modification
OAV Bundles
oav Command
Man Pages
Test Base
Make.
Object.
        compile -c -o [export object] [export implementation] \
-- -list [import interface] [export interface]
   
top

1 :: Create a manipulate a mapping (or database) of object attributes and their values.

Copyright (C) 2002 SM Ryan

Wyrmwif Tcl extensions. For non-profit uses only, provided this copyright is preserved on all copies, this work may be freely copied, modified, redistributed, compiled, and incorporated in other works. This work is distributed with no warranty of any kind; no author or distributor accepts any responsibility for the consequences of using it, or for whether it serves any particular purpose or works at all, unless he or she says so in writing.

   
   

Compile Files

   
top

#ifndef WYRM_OAV_H
#define WYRM_OAV_H

	//	wyrm-oav.dna - Copyright (C) 2002 SM Ryan.  All rights reserved.

	#include "wyrmwif.h"
	
	<Get syntax>
	<Evaluate method syntax>
	<Evaluate supermethod syntax>
	<Key syntax>
	<Parse syntax>
	<Put syntax>
	<Delegate syntax>
	<Method syntax>
	<Delete syntax>
	<Declare wyrm_oavCommandInit>

#endif

		
 
section    top
   
   

Object-Attribute-Value Mappings

   
top
 
section    top

5 :: For example, one could create a mapping dealing with file types and file operations. The file type could be something like c-source, object, executable, or an image. A c-source is also a text file which is also plain file.

plain.text.c-source
C source file.
plain.text.header
C header file.
plain.text.makefile
Makefile.
plain.binary.object
.o object file.
plain.binary.exec
An executable file.
plain.binary.image.gif
A GIF image.
plain.binary.image.jpeg
A JPEG image.

The attributes would be methods on the file.

plain.text.print
Print a text file. plain.text.c-source.print and plain.text.header.print would resolve to this.
plain.text.open
Open a text file in an edittor.
plain.text.c-source.open
could be an edittor specific to mapping files.
plain.binary.image.gif.open
Open the image in Photoshop, Gimp, etc
plain.binary.image.jpeg
Could delegate to plain.binary.image.gif. plain.binary.image.jpeg.open would then resolve into plain.binary.image.gif.open.
   
   

Delegatable OAV Queries

   
top
Obj wyrm_oavGet(Intr intr,Obj mapping,Obj origobject,int N,Obj *P);
 
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;
	}
}

		
 
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;

		
 
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

16. Search stacked mappings if necessary and possible :: Mappings can be stacked, so that if a object cannot be resolved anywhere in one mapping, another mapping can be searched. This permits a situation such as a default static invariant mapping which can be extended by pushing an entire new mapping atop it.

A mapping is stacked with the object attribute "/stacked/.script" or "/stacked/.mapping". The first is a Tcl script whose evaluated result is the next stacked associative mapping; the second is an attribute value which itself is the next stacked associative mapping. If both exist, only the script is consulted.

The script (if presented) is evaluated; if it does not return any error, the returned value is taken as the next mapping to search. Stacked mappings are searched at each stage of the key resolution: the current key or parent or delegate is searched from the given mapping through the stack in an attempt to resolve it.

 
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

if (thread->getkey) {
	decr(found); found = incr(key);
}else if (substed) {
	<Substitute into a found value>
	decr(found); found = S;
}

		
 
section    top

22. Substitute into a found value :: The value is scanned for formatters:

%a
Replaced with the attribute of original object, if any.
%k
Replaced with the actual object and attribute for the returned value.
%o
Replaced with the original object without its attribute.
%i[%]
(i is one or more digits.) Replaced with the ith additional parameter.
%*
Replaced with the additional parameters as a Tcl list.
%+
Replaced with the remaining additional parameters as a Tcl list starting after the last explicitly addressed parameter with a %i formatter.
%- {...}
Ignore % substitutions within a list element.

The following formatters append as list elements. The editted value must be a valid list when the formatter is encounterred.

%,
Replaced with each additional parameters in sequence.

Any other character after a percent is added unchanged.


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);
 
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

Obj activemapping;

		
 
section    top
int wyrm_oavSuper(Intr intr,Obj mapping,Obj object,int N,Obj *P);
 
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

		
   
   

Cache

   
top

enum {getCacheSize = 4096,getCacheLines=4};

		
 
section    top

struct {
	int age; Obj mapping,object,key,found; bool substed,active,super;
} getCache[getCacheSize][getCacheLines];
int getCacheAge;

		
 
section    top

for (i=0; i<nobj; i++) H += 101*H + obj[i]; H &= getCacheSize-1;

		
 
section    top

int H = 0,i,j; bool hit;
<getCache hash function>
for (hit=false,j=0; !hit && j<getCacheLines; j++) {
	if (thread->getCache[H][j].mapping!=mapping) {
		;
	}else if (thread->getCache[H][j].object && thread->getCache[H][j].super==thread->super) {
		int nf; chars f = Tcl_GetStringFromObj(thread->getCache[H][j].object,&nf);
		if (thread->getCache[H][j].object==object || nf==nobj && memcmp(f,obj,nf)==0) {
			hit = true;
			key = incr(thread->getCache[H][j].key);
			found = incr(thread->getCache[H][j].found);
			substed = thread->getCache[H][j].substed;
			thread->active = thread->getCache[H][j].active;
			thread->getCache[H][j].age = ++thread->getCacheAge;
			trace("cache[%d][%d] hit object=%d %{y}s found=%d %{y}s\n",
					H,j,
					object->refCount,object,
					found?found->refCount:0,found);
		}
	}
}
if (!hit) {

		
 
section    top

{
	int min = 0;
	<getCache hash function>
	for (j=1; j<getCacheLines; j++) {
		if (!thread->getCache[H][j].key || thread->getCache[H][j].age<thread->getCache[H][min].age) min = j;
	}
	decr(thread->getCache[H][min].mapping);
	decr(thread->getCache[H][min].object);
	decr(thread->getCache[H][min].key);
	decr(thread->getCache[H][min].found);
	thread->getCache[H][min].mapping = incr(mapping);
	thread->getCache[H][min].object = incr(object);
	thread->getCache[H][min].key = incr(key);
	thread->getCache[H][min].found = incr(found);
	thread->getCache[H][min].substed = substed;
	thread->getCache[H][min].active = thread->active;
	thread->getCache[H][min].super = thread->super;
	thread->getCache[H][min].age = ++thread->getCacheAge;
	trace("cache[%d][%d] save object=%d %{y}s found=%d %{y}s\n",
			H,min,
			object->refCount,object,
			found?found->refCount:0,found);
}}

		
 
section    top

if (thread->getCacheAge) {
	int i,j;
	trace("cache purge\n");
	for (i=0; i<getCacheSize; i++) for (j=0; j<getCacheLines; j++) {
		decr(thread->getCache[i][j].mapping);
		decr(thread->getCache[i][j].object);
		decr(thread->getCache[i][j].key);
		decr(thread->getCache[i][j].found);
	}
	memset(thread->getCache,0,sizeof thread->getCache);
	thread->getCacheAge = 0;
}

		
   
   

Resumption

   
top
		
if (resumption && no<ro) {
	Obj resuming = incr(Tcl_DuplicateObj(found));
	Tcl_AppendToObj(resuming,o+no,ro-no);
	stack = pushGets(decring,0,0,0,0,0,resuming,stack);
	found = resuming;
}
		
		
 
section    top
 
section    top

resumption = delegated && (wyrm_oavResumption&flags)!=0;
		
		
 
section    top

resumption = false;
		
		
   
   

Object Key Parsing

   
top

45. Delegatable and non-delegated operators :: The OAV query operators, get, do, and super, will follow the delegation and parent chains, even continuing to other mappings to resolve the key. The eventual key that provides the returned value can be quite different and distant from the original key.

The OAV modification operators, put, delegate, method, and delete, do not follow the delegation chain. The key as given is the key that used in the operation. Because OAV does not have a notion of object creation, rather an object and its attributes are created as they are put, modifiers have no restricted set of object names to provide a context for resolving object keys. Instead they are required to specify the exact key of the object and attributes. Otherwise the problem is deciding what exactly needs to be modified. Should an existing attribute be modified? Should an existing object be modified by creating a new attribute? To modify a distant object, the key must be modified to point to the distant object.

If the distant attribute exists, its actual key can be discoverred with the key command:

oav key $c x.y.z
and put with
oav put [oav key $c x.y.z] value
If the distant object exists, its actual key can be discoverred with the key command and pasted with the attibute:
oav put [oav key $c x.y].z value
An object can encode its key as an attribute
oav put $c $object.#key $object
oav put $c [oav $object.#key $c].attribute $value

The parse command can also help follow a chain of delegations and resumptions that partially identify an object. parse splits the key into the maximal prefix that actually identifies something (perhaps the entire key), and the remaining suffix. This can be used to identify a distant object from which to root a new object:

oav put [join [oav parse $c x.y.z] {}] value

 
section    top
Obj wyrm_oavKey(Intr intr,Obj mapping,Obj object);
 
section    top

case o_key:
	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_oavKey(intr,mapping,P[3-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_oavKey—The actual key or NULL if 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.

Obj wyrm_oavKey(Intr intr,Obj mapping,Obj object) {
	ThreadData *thread = Tcl_GetThreadData(&oavKey,sizeof(ThreadData));
	Obj key; bool ogetkey = thread->getkey;
	thread->getkey = true;
	key = wyrm_oavGet(intr,mapping,object,0,0);
	thread->getkey = ogetkey;
	return key;
}

		
 
section    top
Obj wyrm_oavParse(Intr intr,Obj mapping,Obj key,bool alwaysSplitAttribute,int *N,Obj **P);
 
section    top

case o_parse:
	if (N==(4-bundled) || N==(5-bundled)) {
		Obj mapping = bundled ? bundle : voav ? Tcl_ObjGetVar2(intr,P[N-2],0,TCL_LEAVE_ERR_MSG) : P[N-2];
		Obj value;
		bool split = N==(5-bundled);
		if (split && !strbegins("-a",Tcl_GetString(P[2]))) {
			Tcl_WrongNumArgs(intr,2,P,bundled ? "-a key" : "mapping -a key");
			return TCL_ERROR;
		}
		value = mapping ? wyrm_oavParse(intr,mapping,P[N-1],split,0,0) : 0;
		Tcl_SetObjResult(intr,value); decr(value);
		return TCL_OK;
	}else {
		Tcl_WrongNumArgs(intr,2,P,bundled ? "[-a] key" : "mapping [-a] key");
		return TCL_ERROR;
	}

		
 
section    top
 
section    top
proc wyrm_oavParse—The actual key or NULL if error.
output intr—The evaluation result or an error message.
io mapping—Where objects are stored; its final position is at the object.
input key—The key to parse.
input alwaysSplitAttribute—The attribute is always part of the unrecognised suffix.
output N—If non-null, it is set to 2 unless there is an error..
output P—If non-null, it is set to the array of elements of the returned list.

Obj wyrm_oavParse(Intr intr,Obj mapping,Obj key,bool alwaysSplitAttribute,int *N,Obj **P) {
	int nk,m; chars k = Tcl_GetStringFromObj(key,&nk),p;
	Obj t,L,E[2],*P1; int N1;
	E[0] = 0;
	m = nk;
	if (!memchr(k,'.',m)) alwaysSplitAttribute = false;
	while (!E[0]) {
		if (m==0) {
			E[0] = incr(Tcl_NewObj());
		}else if ((E[0] = alwaysSplitAttribute
					? (t=0)
					: wyrm_oavKey(intr,mapping,(t=incr(Tcl_NewStringObj(k,m))))),
				decr(t), E[0]
		) {
			;
		}else if ((p=memrchr(k,'.',m))) {
			m = p-k; alwaysSplitAttribute = false;
		}else {
			m = 0;
		}
	}
	E[1] = incr(Tcl_NewStringObj(k+m,nk-m));
	L = incr(Tcl_NewListObj(2,E)); decr(E[0]); decr(E[1]);
	if (N || P) Tcl_ListObjGetElements(0,L,N?N:&N1,P?P:&P1);
	return L;
}

		
   
   

OAV Modification

   
top
int wyrm_oavPut(Intr intr,Obj mapping,Obj object,Obj value,bool keycompress,bool datacompress,bool subst,bool active);
 
section    top

case o_put: {
	int i; bool k=false,d=false,s=false,a=false;
	for (i=2; i<N-(3-bundled); i++)
		if (strbegins("-k",Tcl_GetString(P[i]))) k = true;
		else if (strbegins("-d",Tcl_GetString(P[i]))) d = true;
		else if (strbegins("-s",Tcl_GetString(P[i]))) s = true;
		else if (strbegins("-a",Tcl_GetString(P[i]))) a = true;
		else break;
	if (N-i==(3-bundled)) {
		Obj mapping = bundled ? bundle : voav ? Tcl_ObjGetVar2(intr,P[N-3],0,TCL_LEAVE_ERR_MSG) : P[N-3];
		bool changed = !bundled && mapping ? Tcl_IsShared(mapping) : false; int rc;
		if (changed) mapping = incr(Tcl_DuplicateObj(mapping));
		rc = mapping ? wyrm_oavPut(intr,mapping,P[N-2],P[N-1],k,d,s,a) : TCL_ERROR;
		if (rc==TCL_OK) {
			Tcl_SetObjResult(intr,mapping);
			if (voav && changed && Tcl_ObjSetVar2(intr,P[N-3],0,mapping,TCL_LEAVE_ERR_MSG)==0)
				rc = TCL_ERROR;
		}
		if (changed) decr(mapping);
		return rc;
	}else {
		Tcl_WrongNumArgs(intr,2,P,"[-k|-d|-s|-a]... mapping object.attribute value");
		return TCL_ERROR;
	}
}

		
 
section    top
 
section    top
proc wyrm_oavPut—Whether the put was successful, TCL_OK or TCL_ERROR.
output intr—Possible error message if not NULL.
io mapping—Object attribute value.
input object—The object-attribute to define.
input value—The object-attribute defined value.
input keycompress—Compress the key in the mapping if possible.
input datacompress—Compress the data in the mapping if possible.
input subst—Apply %-substitution to the value when gotten.
input active—Mark as active data for wyrm_oavDo.

int wyrm_oavPut(Intr intr,Obj mapping,Obj object,Obj value,bool keycompress,bool datacompress,bool subst,bool active) {
	ThreadData *thread = Tcl_GetThreadData(&oavKey,sizeof(ThreadData));
	int flags = 0;
	if (!object) return rprintf(intr,"%!no object given for put",TCL_ERROR);
	<Purge the get cache>
	if (keycompress) flags |= wyrm_assocFlagCompressKey;
	if (datacompress) flags |= wyrm_assocFlagCompressData;
	if (subst) flags |= wyrm_oavFlagSubst;
	if (active) flags |= wyrm_oavFlagActive;
	if (wyrm_assocPut(intr,mapping,object,value,flags)==TCL_ERROR) {
		return TCL_ERROR;
	}
	return TCL_OK;
}

		
 
section    top
int wyrm_oavDelegate(Intr intr,Obj mapping,Obj object,Obj value,bool resumption,bool keycompress,bool datacompress);
 
section    top

case o_delegate: {
	int i; bool r=false,k=false,d=false;
	for (i=2; i<N-(3-bundled); i++)
		if (strbegins("-k",Tcl_GetString(P[i]))) k = true;
		else if (strbegins("-d",Tcl_GetString(P[i]))) d = true;
		else if (strbegins("-r",Tcl_GetString(P[i]))) r = true;
		else break;
	if (N-i==(3-bundled)) {
		Obj mapping = bundled ? bundle : voav ? Tcl_ObjGetVar2(intr,P[N-3],0,TCL_LEAVE_ERR_MSG) : P[N-3];
		bool changed = !bundled && mapping ? Tcl_IsShared(mapping) : false; int rc;
		if (changed) mapping = incr(Tcl_DuplicateObj(mapping));
		rc = mapping ? wyrm_oavDelegate(intr,mapping,P[N-2],P[N-1],r,k,d) : TCL_ERROR;
		if (rc==TCL_OK) {
			Tcl_SetObjResult(intr,mapping);
			if (voav && changed && Tcl_ObjSetVar2(intr,P[N-3],0,mapping,TCL_LEAVE_ERR_MSG)==0)
				rc = TCL_ERROR;
		}
		if (changed) decr(mapping);
		return rc;
	}else {
		Tcl_WrongNumArgs(intr,2,P,"[-r|-k|-d]... mapping object.attribute value");
		return TCL_ERROR;
	}
}

		
 
section    top