#ifndef WYRM_ASSOC_BTREE_H
#define WYRM_ASSOC_BTREE_H

	//	wyrm-assoc-btree.dna - Copyright (C) 2002, 2004 SM Ryan.  All rights reserved.'

	#include "wyrmwif.h"
	
	int wyrm_assocBtreeInit(Intr intr);
	void wyrm_assocBTreeText(long *base,long length,chars path);

#endif

		

static const char COPYRIGHT[] = "wyrm-assoc-btree.dna - Copyright (C) 2002, 2004 SM Ryan.  All rights reserved.";

#define WYRM_ASSOC_H_IMPLEMENTORS
#include <stdarg.h>
#include "wyrm-assoc.h"
#include "wyrm-assoc-btree.h"
#include "wyrm-huff.h"
#include "wyrm-io.h"
#include "wyrm-assoc-btree-vm.sys"
#include "wyrm-assoc-btree.sys"


<BTree structure>
<File header block>
<Free block>
<Long string block>
<Leaf or node block>
<Release long string>
<BTree WyrmAssocMapType>
<Seek a key in the block>
<Query operators>
<Edit operators>
<Construct a new B-Tree>
<Link a static text mapping into the open mappings list>
<Dump a B-Tree>
<btree (1WY)>
<B-Tree initialisation>

		

#include <errno.h>
#include <fcntl.h>
#include <sys/file.h>
#include <sys/types.h>
#include <sys/mman.h>
#include <sys/stat.h>
#include <unistd.h>


typedef struct {
	<Unix Mapped file descriptor>
} Descriptor;

<Unix file locking>
<Unix file mapping>
<Unix write zeros at end>
<Unix If readonly file>
<Unix If same file>
<Unix Open a file>
<Unix Extend a file>
<Unix Validate the mapped in file>
<Unix Release the mapped in file>
<Unix Close the file>

		

int lockstate;
int lockdepth;

		

#ifdef TESTING
	bool locktest = true;
#endif

static bool readlockfile(Intr intr,Descriptor *f) {
	#ifdef TESTING
		if (!locktest) return rprintf(intr,"%!lock failure: forced failure for testing",false);
	#endif
	if (f->lockdepth>0) {
		f->lockdepth += 1;
		return true;
	}else if (flock(f->fd,LOCK_SH)<0) {
		rprintf(intr,"cannot read lock file: %s",strerror(errno));
		return false;
	}else {
		f->lockdepth = 1;
		f->lockstate = 'r';
		return true;
	}
}

static bool writelockfile(Intr intr,Descriptor *f) {
	#ifdef TESTING
		if (!locktest) return rprintf(intr,"%!lock failure: forced failure for testing",false);
	#endif
	if (f->lockdepth>0 && f->lockstate=='w') {
		f->lockdepth += 1;
		return true;
	} else if (f->lockdepth>0 && f->lockstate=='r') {
		rprintf(intr,"cannot upgrade read file lock to write lock");
		return false;
	}else if (flock(f->fd,LOCK_SH)<0) {
		rprintf(intr,"cannot write lock file: %s",strerror(errno));
		return false;
	}else {
		f->lockdepth += 1;
		f->lockstate = 'w';
		return true;
	}
}

static bool unlockfile(Intr intr,Descriptor *f) {
	#ifdef TESTING
		if (!locktest) return rprintf(intr,"%!lock failure: forced failure for testing",false);
	#endif
	if (f->lockdepth>1) {
		f->lockdepth -= 1;
		return true;
	}else {
		if (f->lockstate=='w') msync(f->base,f->length,0);
		if (flock(f->fd,LOCK_UN)<0) {
			rprintf(intr,"cannot unlockfile file: %s",strerror(errno));
			return false;
		}else {
			f->lockdepth = 0;
			f->lockstate = 0;
			return true;
		}
	}
}

		

int fd;
int prot;
ptr base;
long length;

		

#include <mach/vm_map.h>
#include <mach/mach_traps.h>

#if 0
static void regions (chars title) {
	vm_map_t self = mach_task_self();
	kern_return_t kret;
	struct vm_region_basic_info info;
	vm_size_t size;
	mach_port_t object_name;
	mach_msg_type_number_t count;
	vm_address_t address;
	vm_address_t last_address;
	address = 0;
	last_address = (vm_address_t) -1;
	printf("--------------%s\n",title);
	for (;;) {
		count = VM_REGION_BASIC_INFO_COUNT;
		kret = vm_region (
				self,
				&address,
				&size,
				VM_REGION_BASIC_INFO,
				(vm_region_info_t)&info,
				&count,
				&object_name);
		if (kret == KERN_NO_SPACE) {
			break;
		}
		printf("%c %08lx..%08lx (%10ld) prot %s; max %s; inh %s; %s; %s\n",
				last_address != address ? '+' : '-',
				address, address + size, size,
				info.protection==VM_PROT_NONE ? "---"
				: info.protection==VM_PROT_READ ? "r--"
				: info.protection==VM_PROT_WRITE ? "-w-"
				: info.protection==VM_PROT_READ | VM_PROT_WRITE ? "rw-"
				: info.protection==VM_PROT_EXECUTE ? "--x"
				: info.protection==VM_PROT_EXECUTE | VM_PROT_READ ? "r-x"
				: info.protection==VM_PROT_EXECUTE | VM_PROT_WRITE ? "-wx"
				: info.protection==VM_PROT_EXECUTE | VM_PROT_WRITE | VM_PROT_READ ? "rwx"
				:  "???",
				info.max_protection==VM_PROT_NONE ? "---"
				: info.max_protection==VM_PROT_READ ? "r--"
				: info.max_protection==VM_PROT_WRITE ? "-w-"
				: info.max_protection==VM_PROT_READ | VM_PROT_WRITE ? "rw-"
				: info.max_protection==VM_PROT_EXECUTE ? "--x"
				: info.max_protection==VM_PROT_EXECUTE | VM_PROT_READ ? "r-x"
				: info.max_protection==VM_PROT_EXECUTE | VM_PROT_WRITE ? "-wx"
				: info.max_protection==VM_PROT_EXECUTE | VM_PROT_WRITE | VM_PROT_READ ? "rwx"
				:  "???",
				info.inheritance==VM_INHERIT_SHARE ? "share"
				: info.inheritance==VM_INHERIT_COPY ? "copy"
				: info.inheritance==VM_INHERIT_NONE ? "none"
				: "???",
				info.shared ? "shared" : "private",
				info.reserved ? "reserved" : "not reserved");
		if (address+size<address) break;
		address += size;
		last_address = address;
		if (address == 0) {
			/* address space has wrapped around */
			break;
		}
	}
}
#endif

		

#include <sys/ptrace.h>
#include <sys/signal.h>
#include <sys/types.h>
#include <unistd.h>
#include <signal.h>

#include <string.h>
#include <ctype.h>

static bool mapin(Intr intr,Descriptor *f) {
	struct stat S; struct flock L;
	if (f->fd<0) return true;
	if (fstat(f->fd,&S)<0) {perror("mapin stat"); abort();}
	f->base = mmap(0,f->length,f->prot,MAP_SHARED,f->fd,0);
	if ((int)(f->base)==-1) {
		f->base = 0;
		rprintf(intr,"cannot map in file: %s",strerror(errno));
		return false;
	}else {
		return true;
	}
}

static bool mapout(Intr intr,Descriptor *f) {
	if (f->fd<0) return true;
	if (!f->base) {
		return true;
	}else if (munmap(f->base,f->length)<0) {
		f->base = 0;
		rprintf(intr,"cannot map out file: %s",strerror(errno));
		return false;
	}else {
		f->base = 0;
		return true;
	}
}

		

static bool readonlyFile(chars path) {
	return access(path,F_OK)==0 && access(path,W_OK)<0;
	
}

		

dev_t device;
ino_t inode;

		

static bool isSameFile(Descriptor *f,chars opath,chars path,bool writable) {
	struct stat S;
	bool q = f->fd<0 ? streq(opath,path) : stat(path,&S)>=0 && S.st_dev==f->device && S.st_ino==f->inode;
	if (q && f->fd>=0) {
		int flags = fcntl(f->fd,F_GETFL,0);
		q = writable == ((flags&O_ACCMODE)!=0);
	}
	return q;
}

		

#define defaultBlockSize (getpagesize())

static int openFile(Intr intr,Descriptor *f,chars path,bool writable) {
	struct stat S;
	zero(1,Descriptor,f);
	if (stat(path,&S)>=0 && S.st_size>0) {
		f->fd = open(path,writable?O_RDWR:O_RDONLY);
		if (f->fd<0) {
			rprintf(intr,"cannot open file: %s: %s",strerror(errno),path);
			return 0;
		}
		f->length = S.st_size;
		f->prot = writable?PROT_READ|PROT_WRITE:PROT_READ;
		f->device = S.st_dev; f->inode = S.st_ino;
		if (!mapin(intr,f)) {close(f->fd); return 0;}
		return -1;
	}else if (!writable) {
		rprintf(intr,"nonexistent read-only file: %s",path);
		return 0;
	}else {
		chars b,r;
		f->fd = open(path,O_RDWR|O_CREAT|O_TRUNC,0644);
		if (f->fd<0) {
			rprintf(intr,"cannot create file: %s: %s",strerror(errno),path);
			return 0;
		}
		stat(path,&S); f->device = S.st_dev; f->inode = S.st_ino;
		f->length = 2*getpagesize();
		if (!writelockfile(intr,f)) {close(f->fd); return 0;}
		if (!writezeros(intr,f,f->length)) {unlockfile(intr,f); close(f->fd); return 0;}
		f->prot = PROT_WRITE|PROT_READ;
		if (!mapin(intr,f)) {unlockfile(intr,f); close(f->fd); return 0;}
		if (!unlockfile(intr,f)) {close(f->fd); return 0;}
		return getpagesize();
	}
}

static int openMemory(Descriptor *f,ptr base,long length) {
	zero(1,Descriptor,f);
	f->fd = -1; f->base = base; f->length = length;
	f->lockstate = 'r'; f->lockdepth = 1;
}

		

static bool writezeros(Intr intr,Descriptor *f,long newLength) {
	long O,N,n; char *B;
	if (f->fd<0) return rprintf(intr,"%!cannot modify a static mapping",TCL_ERROR);
	newLength = (newLength+getpagesize()-1) & ~(getpagesize()-1);
	if ((O=lseek(f->fd,0,SEEK_END))<0) Tcl_Sleep(1);
	if ((O=lseek(f->fd,0,SEEK_END))<0) {rprintf(intr,"lseek failed: %s",strerror(errno)); return false;}
	N = newLength-O; B = nheap(N,char); zero(N,char,B);
	n = write(f->fd,B,N); dispose(B);
	if (n<N) {
		if (n<0) {
			rprintf(intr,"cannot extend file: %s",strerror(errno));
		}else {
			rprintf(intr,"cannot write complete file tail: %d instead of %d",n,N);
		}
		return false;
	}
	f->length = newLength;
	return true;
}

		

static int extendFile(Intr intr,Descriptor *f,long newLength) {
	struct stat S; int rc = TCL_ERROR;
	if (f->fd<0) return rprintf(intr,"%!cannot modify a static mapping",TCL_ERROR);
	if (fstat(f->fd,&S)<0) {
		rprintf(intr,"cannot status the file: %s",strerror(errno));
		return TCL_ERROR;
	}else if (S.st_size>=newLength) {
		return TCL_OK;
	}else {
		if (!mapout(intr,f)) goto quit;
		if (!writezeros(intr,f, newLength)) goto quit;
		rc = TCL_OK;
	quit:
		if (!mapin(intr,f)) {
			Tcl_Panic("[" __FILE__ ":%d] extendFile map-in failed: %s: %s",
					__LINE__,strerror(errno),
					intr ? Tcl_GetStringResult(intr) : "(no result)");
		}
		return rc;
	}
}

static int truncateFile(Intr intr,Descriptor *f,long newLength) {
	if (f->fd<0) return rprintf(intr,"%!cannot modify a static mapping",TCL_ERROR);
	if (ftruncate(f->fd,newLength)<0) {
		rprintf(intr,"truncate failed: %s",strerror(errno));
		return TCL_ERROR;
	}else
		return TCL_OK;
}

		

static int validateFile(Intr intr,Descriptor *f,bool exclusive) {
	struct stat S;
	if (exclusive ? !writelockfile(intr,f) : !readlockfile(intr,f)) {
		return TCL_ERROR;
	}else if (f->fd<0) {
		return TCL_OK;
	}else if (fstat(f->fd,&S)<0) {
		rprintf(intr,"cannot status the file: %s",strerror(errno));
		unlockfile(intr,f);
		return TCL_ERROR;
	}else if (S.st_dev!=f->device || S.st_ino!=f->inode) {
		unlockfile(intr,f);
		return TCL_BREAK;
	}else if (S.st_size>f->length) {
		mapout(intr,f);
		return mapin(intr,f) ? TCL_OK : TCL_ERROR;
	}else {
		return TCL_OK;
	}
}

		

static int releaseFile(Intr intr,Descriptor *f) {
	bool ok = unlockfile(intr,f);
	Tcl_MutexUnlock(&btreeMutex);
	return ok ? TCL_OK : TCL_ERROR;
}

		

static void closeFile(Intr intr,Descriptor *f) {
	if (f->fd>=0) {
		mapout(intr,f);
		close(f->fd);
	}
}

		

enum {filelabel = 'bt10'};
typedef long Word;

#define load(mapping,off)			(ntohw(base(mapping)[off]))
#define store(mapping,off,val)		(base(mapping)[off] = htonw(val))
#define addr(mapping,off)			(&(base(mapping)[off]))

#define ntohw(x)					ntohl(x)
#define htonw(x)					htonl(x)

#define getHeaderType(mapping) 		load(mapping,0)
#define setHeaderType(mapping,t)	store(mapping,0,t)
#define getHeaderBlock(mapping) 	load(mapping,1)
#define setHeaderBlock(mapping,b)	store(mapping,1,b)
#define getHeaderBlockW(mapping) 	(load(mapping,1)/sizeof(Word))
#define setHeaderBlockW(mapping,b)	store(mapping,1,(b)*sizeof(Word))
#define getHeaderRoot(mapping) 		load(mapping,2)
#define setHeaderRoot(mapping,r)	store(mapping,2,r)
#define getHeaderFree(mapping) 		load(mapping,3)
#define setHeaderFree(mapping,r)	store(mapping,3,r)
#define getHeaderLast(mapping) 		load(mapping,4)
#define setHeaderLast(mapping,r)	store(mapping,4,r)
#define getHeaderLastW(mapping) 	(load(mapping,4)/sizeof(Word))
#define setHeaderLastW(mapping,r)	store(mapping,4,(r)*sizeof(Word))

#define verifyBlocks do { \
	Word o,m; for (o=0,m=getHeaderLastW(mapping); o<m; o+=getHeaderBlockW(mapping)) { \
		switch (load(mapping,o)) { \
			case 'bt10': case 'node': case 'leaf': case 'free': case 'str+': case 'str.': break; \
			default: Tcl_Panic("[" __FILE__  ":%d] block %d corruption: %08X %08X", \
					__LINE__,o,load(mapping,o+0),load(mapping,o+1)); \
		} \
	} \
} while (0)

		

#define getNodeType(mapping,block)		load(mapping,(block)+0)
#define setNodeType(mapping,block,t)	store(mapping,(block)+0,t)
#define getNodeSize(mapping,block)		load(mapping,(block)+1)
#define setNodeSize(mapping,block,t)	store(mapping,(block)+1,t)
#define getNodeSizeW(mapping,block)		(load(mapping,(block)+1)/sizeof(Word))
#define setNodeSizeW(mapping,block,t)	store(mapping,(block)+1,(t)*sizeof(Word))

enum {
	nodelabel='node',leaflabel='leaf',
	directstring='d',indirectstring='i',blockoffset='o',
	nodeheadersizeW = 2
};
enum {
	nodeheadersize = nodeheadersizeW*sizeof(Word)
};

#define blockaddr(mapping,item)			(~(getHeaderBlockW(mapping)-1) & (item))
#define blockitem(mapping,item)			((getHeaderBlockW(mapping)-1) & (item))

		

static Word succ(Obj mapping,Word item) {
	Word f = load(mapping,item); item++;
	switch ((f>>16)&0xFFFF) {
		case directstring: item += (load(mapping,item)+sizeof(Word)-1)/sizeof(Word);
		case blockoffset: case indirectstring: item++; break;
		default:
			Tcl_Panic("[" __FILE__ ":%d] succ kind unknown: item %d, kind %c, flags %08lx",
					__LINE__,item-1,(f>>16)&0xFFFF,f);
	}
	return item;
}

<Node editting>

		

static Obj getobj(Obj mapping,Word item,bool key) {
	Obj obj;
	Word f = load(mapping,item); item++;
	switch ((f>>16)&0xFFFF) {
		case directstring: {
			Word l = load(mapping,item); item++;
			obj = incr(Tcl_NewByteArrayObj((bytes)addr(mapping,item),l));
		}	break;
		case indirectstring: {
			<Collect the bytes of a long string>
		}	break;
		default:
			Tcl_Panic("[" __FILE__ ":%d] getobj kind unknown: item %d, kind %c, flags %08lx",
					__LINE__,item-1,(f>>16)&0xFFFF,f);
	}
	if (key ? (f&wyrm_assocFlagCompressKey) : (f&wyrm_assocFlagCompressData)) {
		Obj dcm = wyrm_huffExpandObj(obj,1,0); decr(obj); obj = dcm;
	}
	return obj;
}

#define getaddr(mapping,item)		load(mapping,item+1)

		

typedef int (*Bottom)(Intr intr,ptr context,Obj mapping,Obj key,Word d,Word k,Obj K,Word F,OV);

static int seekRcr(Intr intr,Bottom bottom,ptr context,Obj mapping,Word blk,Word parent,Obj key,Word k,Obj K,OV) {
	Word max = blk+getNodeSizeW(mapping,blk);
	Word i = blk+nodeheadersizeW;
	Word d = 0,F = 0;
	bool node = getNodeType(mapping,blk)==nodelabel;
	int rc;
	incr(K);
	d = i; F = load(mapping,i)&0xFFFF; i = succ(mapping,i);
	while (key && i<max) {
		Obj NK = getobj(mapping,i,true);
		if (strcmp(Tcl_GetString(NK),Tcl_GetString(key))>0 && (node || K)) {
			decr(NK); break;
		}
		k = i; decr(K); K = NK;
		i = succ(mapping,i);
		d = i; F = load(mapping,i)&0xFFFF;
		i = succ(mapping,i);
	}
	rc = node
		? seekRcr(intr,bottom,context,mapping,getaddr(mapping,d),blk,key,k,K,ov)
		: bottom(intr,context,mapping,key,d,k,K,F,ov);
	if (rc=='upd') {
		<Find the parent data pointers to this block>
		<Fuse small blocks on ascent>
		<Split large blocks on ascent>
	}else 
		<Special case to find the next key during an ascent>
	else 
		<Special case to find the previous key during an ascent>
	decr(K);
	return rc;
}

static int seek(Intr intr,Bottom bottom,ptr context,Obj mapping,Obj key) {
	Overflow *ofl = 0;
	int rc = seekRcr(intr,bottom,context,mapping,getHeaderRoot(mapping),0,key,0,0,&ofl);
	discardspills(&ofl);
	if (rc=='upd') rc = TCL_OK;
	return rc;
}

		

#define getStringType(mapping,block)	load(mapping,(block)+0)
#define setStringType(mapping,block,t)	store(mapping,(block)+0,t)
#define getStringSize(mapping,block)	\
		(getStringType(mapping,block)==stringcontinuelabel \
			? maxStringChunk(mapping) \
			: load(mapping,(block)+1) \
		)
#define setStringSize(mapping,block,t)	store(mapping,(block)+1,t)
#define getStringNext(mapping,block)	load(mapping,(block)+1)
#define setStringNext(mapping,block,t)	store(mapping,(block)+1,t)
#define maxStringChunk(mapping)			(getHeaderBlock(mapping)-stringheadersize)

enum {
	stringcontinuelabel = 'str+',stringfinallabel = 'str.',
	stringheadersizeW = 2
};
enum {
	stringheadersize = stringheadersizeW*sizeof(Word)
};

		

Word o = load(mapping,item); bytes b = 0; int n = 0;
item++;
for (;;) {
	int m = getStringSize(mapping,o);
	b = reheap(n+m,byte,b);
	memcpy(b+n,addr(mapping,o+stringheadersizeW),m); n += m;
	if (getStringType(mapping,o)==stringcontinuelabel) {
		o = getStringNext(mapping,o);
	}else {
		break;
	}
}
obj = incr(Tcl_NewByteArrayObj(b,n));
dispose(b);

		

Word longstring = 0,curr = 0,prev = 0,max = maxStringChunk(mapping);
while (N>0) {
	int M = N>max ? max : N;
	curr = newblock(intr,mapping);
	if (!curr) return 0;
	if (prev) setStringNext(mapping,prev,curr); else longstring = curr;
	if (N>max) {
		setStringType(mapping,curr,stringcontinuelabel);
		setStringNext(mapping,curr,0);
	}else {
		setStringType(mapping,curr,stringfinallabel);
		setStringSize(mapping,curr,N);
	}
	memcpy(addr(mapping,curr+stringheadersizeW),P,M); P += M; N -= M;
	prev = curr;
}

		

static void releaseLongstring(Obj mapping,Word item) {
	if ((load(mapping,item)>>16)==indirectstring) {
		Word curr = load(mapping,item+1);
		while (curr) {
			Word next = getStringType(mapping,curr)==stringcontinuelabel ? getStringNext(mapping,curr) : 0;
			freeblock(mapping,curr);
			curr = next;
		}
	}
}

		

enum {freelabel = 'free'};

#define setFreeType(mapping,block)		store(mapping,(block)+0,'free')
#define getFreeNext(mapping,block) 		load(mapping,(block)+1)
#define setFreeNext(mapping,block,b)	store(mapping,(block)+1,b)

static void freeblock(Obj mapping,Word block) {
	setFreeType(mapping,block);
	setFreeNext(mapping,block,getHeaderFree(mapping));
	setHeaderFree(mapping,block);
}

static Word newblock(Intr intr,Obj mapping) {
	Word allocate = getHeaderFree(mapping);
	if (allocate) {
		setHeaderFree(mapping,getFreeNext(mapping, allocate));
		zero(getHeaderBlock(mapping),char,addr(mapping,allocate));
		return allocate;
	}else {
		Word m = getHeaderBlockW(mapping);
		allocate = getHeaderLastW(mapping);
		if (extendFile(intr,&tree(mapping)->f,getHeaderLast(mapping)+getHeaderBlock(mapping))==TCL_OK) {
			Word new,i;
			setHeaderLast(mapping,length(mapping));
			new = getHeaderLastW(mapping);
			for (i=allocate+m; i<new; i+=m) {
				setFreeNext(mapping,i,getHeaderFree(mapping));
				setHeaderFree(mapping,i);
			}
			zero(m,Word,addr(mapping,allocate));
			return allocate;
		}else {
			if (intr) Tcl_AppendResult(intr," (The mapping file structure has probably been destroyed.)",0);
			return 0;
		}
	}
}

		

typedef struct BTree BTree;
struct BTree {
	Descriptor f;
	int refcount;
	Obj path;
	BTree *link;
	bool writable;
};

#define tree(mapping) ((BTree*)((mapping)->internalRep.otherValuePtr))
#define descriptor(mapping) (&(tree(mapping)->f))
#define base(mapping) ((Word*)(tree(mapping)->f.base))
#define length(mapping) (tree(mapping)->f.length)

		

{
	Descriptor f; BTree *prev; int block;
	if (wyrm_assocAllowedPath(intr,path,&writable)) {
		for (prev=0,tree=opentrees; tree; prev=tree,tree=tree->link) {
			if (isSameFile(&tree->f,Tcl_GetString(tree->path),Tcl_GetString(path),writable)) {
				if (prev) {prev->link = tree->link; tree->link = opentrees; opentrees = tree;}
				break;
			}
		}
		if (!tree) {
			block = openFile(intr,&f,Tcl_GetString(path),writable);
			if (block>0)
				<Create new B-Tree>
			if (block==0) {
				tree = 0;
			}else {
				tree = heap(BTree); zero(1,BTree,tree);
				tree->f = f; tree->refcount = 0; tree->path = incr(path);
				tree->writable = writable;
				tree->link = opentrees; opentrees = tree;
			}
		}
	}else
		tree = 0;
}

		

{
	int rc = validateFile(intr,&f,true); Word root = block/sizeof(Word);
	if (rc==TCL_OK) {
		long *base = f.base;
		long *root = (long*)((chars)(f.base)+block);
		chars hiddendata = "Kilroy was here.";
		base[0] = htonw(filelabel);
		base[1] = htonw(block);
		base[2] = htonw(block/sizeof(Word));
		base[3] = htonw(0);
		base[4] = htonw(2*block);
		root[0] = htonw(leaflabel);
		root[1] = htonw(sizeof(Word)*(4+(strlen(hiddendata)+sizeof(Word)-1)/sizeof(Word)));
		root[2] = htonw(directstring<<16);
		root[3] = htonw(strlen(hiddendata));
		strcpy((chars)(root+4),hiddendata);
		if (releaseFile(intr,&f)!=TCL_OK) rc = TCL_ERROR;
	}
	if (rc!=TCL_OK) {
		closeFile(intr,&f); block = 0;
	}
}

		

TCL_DECLARE_MUTEX(btreeMutex)
static BTree *opentrees = 0;

static int validateTree(Intr intr,Obj mapping,bool exclusive) {
	Tcl_MutexLock(&btreeMutex);
	int rc = setBTreeInternalRepresentationLocked(intr,mapping);
	if (rc==TCL_OK) rc = validateFile(intr,descriptor(mapping),exclusive);
	if (rc==TCL_BREAK) {
		if ((mapping)->typePtr && (mapping)->typePtr->freeIntRepProc)
			(mapping)->typePtr->freeIntRepProc((mapping));
		(mapping)->typePtr = 0;
		mapping->internalRep.otherValuePtr = 0;
		rc = Tcl_ConvertToType(intr,mapping,(Tcl_ObjType*)&WyrmAssocBTreeType);
		if (rc==TCL_OK) rc = validateFile(intr,descriptor(mapping),exclusive);
	}
	if (rc!=TCL_OK) Tcl_MutexUnlock(&btreeMutex);
	return rc;
}

static int setBTreeInternalRepresentationLocked(Intr intr,Obj mapping) {
	int rc;
	if (mapping->typePtr==(Tcl_ObjType*)&WyrmAssocBTreeType
			|| mapping->typePtr==(Tcl_ObjType*)&WyrmAssocBTreeROType
	) {
		rc = TCL_OK;
	}else {
		int N; chars *P = 0;
		if ((rc=Tcl_SplitList(intr,Tcl_GetString(mapping),&N,(CONST char***)&P))!=TCL_OK) {
			rc = TCL_ERROR;
		}else if (N!=1) {
			rprintf(intr,"mapping path is not a single element list");
			rc = TCL_ERROR;
		}else {
			Obj path = incr(Tcl_NewStringObj(*P,-1));
			bool writable = !readonlyFile(*P);
			BTree *tree = 0;
			<Find an open file, if already open, otherwise open or create it and link in>
			decr(path);
			if (tree) {
				if ((mapping)->typePtr && (mapping)->typePtr->freeIntRepProc)
					(mapping)->typePtr->freeIntRepProc((mapping));
				(mapping)->typePtr = tree->writable
						? (Tcl_ObjType*)&WyrmAssocBTreeType
						: (Tcl_ObjType*)&WyrmAssocBTreeROType;
				mapping->internalRep.otherValuePtr = tree;
				tree->refcount++;
				rc = TCL_OK;
			}else {
				rc = TCL_ERROR;
			}
		}
		dispose(P);
	}
	return rc;
}

static int setBTreeInternalRepresentation(Intr intr,Obj mapping) {
	Tcl_MutexLock(&btreeMutex);
	int rc = setBTreeInternalRepresentationLocked(intr,mapping);
	Tcl_MutexUnlock(&btreeMutex);
	return rc;
}

		

static void freeBTree(Obj mapping) {
	Tcl_MutexLock(&btreeMutex);
	BTree *tree = mapping->internalRep.otherValuePtr;
	if (--tree->refcount<0) {
		closeFile(0,&tree->f);
		decr(tree->path);
		if (opentrees==tree) {
			opentrees = tree->link;
		}else {
			BTree *prev; for (prev=opentrees; prev && prev->link!=tree; prev=prev->link) ;
			if (prev) prev->link = tree->link;
		}
		dispose(tree);
	}
	mapping->internalRep.otherValuePtr = 0;
	mapping->typePtr = 0;
	Tcl_MutexUnlock(&btreeMutex);
}

		

static void duplicateBTree(Obj mapping,Obj newmapping) {
	Tcl_MutexLock(&btreeMutex);
	BTree *tree = mapping->internalRep.otherValuePtr;
	if ((newmapping)->typePtr && (newmapping)->typePtr->freeIntRepProc)
		(newmapping)->typePtr->freeIntRepProc((newmapping));
	(newmapping)->typePtr = (mapping)->typePtr;
	(newmapping)->internalRep.otherValuePtr = tree;
	tree->refcount++;
	Tcl_MutexUnlock(&btreeMutex);
}
			
		

static void updateBTree(Obj mapping) {
	Tcl_MutexLock(&btreeMutex);
	BTree *tree = mapping->internalRep.otherValuePtr;
	Tcl_DString D; Tcl_DStringInit(&D);
	Tcl_DStringAppendElement(&D,Tcl_GetString(tree->path));
	mapping->length = Tcl_DStringLength(&D);
	mapping->bytes = nheap(mapping->length+1,char);
	strcpy(mapping->bytes,Tcl_DStringValue(&D));
	Tcl_DStringFree(&D);
	Tcl_MutexUnlock(&btreeMutex);
}

		

static int setBTreeInternalRepresentationLocked(Intr intr,Obj mapping);
static int setBTreeInternalRepresentation(Intr intr,Obj mapping);
static void freeBTree(Obj mapping);
static void updateBTree(Obj mapping);
static void duplicateBTree(Obj mapping,Obj newmapping);

static int isBTreeEmpty(Intr intr,Obj mapping);
static Obj firstBTreeScan(Intr intr,Obj mapping);
static Obj lastBTreeScan(Intr intr,Obj mapping);
static Obj nextBTreeScan(Intr intr,Obj mapping,Obj key);
static Obj previousBTreeScan(Intr intr,Obj mapping,Obj key);
static int getBTree(Intr intr,Obj mapping,Obj seeking,Obj *key,Obj *data,int *flags);
static int putBTree(Intr intr,Obj mapping,Obj key,Obj data,int flags);
static int deleteBTree(Intr intr,Obj mapping,Obj key);
static int putRejected (Intr intr,Obj mapping,Obj key,Obj data,int flags);
static int deleteRejected(Intr intr,Obj mapping,Obj key);

static Obj newBTree(Intr intr,Obj base,int N,Obj *P);
static Obj dumpBTree(Intr intr,Obj mapping,int N,Obj *P);

static WyrmAssocMapType WyrmAssocBTreeType = {
	{
		"wyrm.assoc.btree",
		freeBTree,
		duplicateBTree,
		updateBTree,
		setBTreeInternalRepresentation
	},
	0,
	0,
	dumpBTree,
	'bt10',
	newBTree,
	isBTreeEmpty,
	firstBTreeScan,
	lastBTreeScan,
	nextBTreeScan,
	previousBTreeScan,
	wyrm_sortedEnumerateBegin,
	wyrm_sortedEnumerate,
	wyrm_sortedEnumerateEnd,
	getBTree,
	putBTree,
	deleteBTree,
};

static WyrmAssocMapType WyrmAssocBTreeROType = {
	{
		"wyrm.assoc.robtree",
		freeBTree,
		duplicateBTree,
		updateBTree,
		setBTreeInternalRepresentation
	},
	0,
	0,
	dumpBTree,
	'bt10',
	newBTree,
	isBTreeEmpty,
	firstBTreeScan,
	lastBTreeScan,
	nextBTreeScan,
	previousBTreeScan,
	wyrm_sortedEnumerateBegin,
	wyrm_sortedEnumerate,
	wyrm_sortedEnumerateEnd,
	getBTree,
	putRejected,
	deleteRejected,
};

<Tcl type operators>

		

<Load/store with overflow block checking>

static void blocktail(Obj mapping,Word db,Word dd,int m,Word **tb,Word *tn,OV) {
	if (!db) {
		Tcl_Panic("[" __FILE__ ":%d] blocktail zero db",__LINE__);
	}
	if (m>=0) {
		while (m-->0) dd = succo(mapping,db,dd,ov);
		m = getNodeSizeW(mapping,db)-dd;
		if (m<0) Tcl_Panic("[" __FILE__ ":%d] blocktail negative m: db=%d dd=%d size=%d",
				__LINE__,db,dd,getNodeSizeW(mapping,db));
		*tb = nheap(m,Word); *tn = m;
		memcpy(*tb,addro(mapping,db,dd,ov),m*sizeof(Word));
	}else {
		*tb = 0; *tn = 0;
	}
}
static Word repairtail(Obj mapping,Word db,Word dd0,Word *tb,Word tn,OV) {
	Word dd = dd0;
	if (tn) {
		memcpy(addro(mapping,db,dd,ov),tb,tn*sizeof(Word));
		dd += tn;
	}
	dispose(tb);
	setNodeSizeW(mapping,db,dd);
	if (dd<=getHeaderBlockW(mapping)) refillblock(mapping,db,ov);
	return dd0;
}

static void blocksize(Obj mapping,Word db,Word dd,int n,OV) {
	if (getNodeSizeW(mapping,db)+n>getHeaderBlockW(mapping)) {
		spillblock(mapping,db,ov);
	}
}

static Word moveblock(Obj mapping,Word db,Word dd,int m,Word sb,Word ss,int n,OV) {
	Word *tb,tn;
	if (n>=0) {
		Word tt = ss;
		while (n-->0) tt = succo(mapping,sb,tt,ov);
		n = tt-ss;
	}else {
		n = getNodeSizeW(mapping,sb)-ss;
	}
	blocktail(mapping,db,dd,m,&tb,&tn,ov);
	blocksize(mapping,db,dd,n,ov);
	memmove(addro(mapping,db,dd,ov),addro(mapping,sb,ss,ov),n*sizeof(Word)); dd += n;
	return repairtail(mapping,db,dd,tb,tn,ov);
}

static Word moveobj(Intr intr,Obj mapping,Word db,Word dd,int m,Obj ss,long flags,bool key,OV) {
	Word *tb,tn,*SS,n; int N; bytes P;
	if (key ? (flags&wyrm_assocFlagCompressKey) : (flags&wyrm_assocFlagCompressData)) {
		ss = incr(wyrm_huffCompressObj(ss,1,0));
	}else
		ss = incr(ss);
	P = Tcl_GetByteArrayFromObj(ss,&N);
	if (N>getHeaderBlock(mapping)/4) {
		<Allocate and write out a long string>
		n = 2; SS = nheap(n,Word);
		SS[0] = htonw((indirectstring<<16) | (flags&0xFFFF));
		SS[1] = htonw(longstring);
	}else {
		n = 2+(N+sizeof(Word)-1)/sizeof(Word); SS = nheap(n,Word);
		zero(n,long,SS);
		SS[0] = htonw((directstring<<16) | (flags&0xFFFF));
		SS[1] = htonw(N);
		memcpy(SS+2,P,N);
	}
	blocktail(mapping,db,dd,m,&tb,&tn,ov);
	blocksize(mapping,db,dd,n,ov);
	memcpy(addro(mapping,db,dd,ov),SS,n*sizeof(Word)); dd += n;
	dispose(SS); decr(ss);
	return repairtail(mapping,db,dd,tb,tn,ov);
}

static Word moveaddr(Obj mapping,Word db,Word dd,int m,Word ss,OV) {
	Word *tb,tn,SS[2];
	SS[0] = htonw(blockoffset<<16);
	SS[1] = htonw(ss);
	blocktail(mapping,db,dd,m,&tb,&tn,ov);
	blocksize(mapping,db,dd,2,ov);
	memcpy(addro(mapping,db,dd,ov),SS,2*sizeof(Word)); dd += 2;
	return repairtail(mapping,db,dd,tb,tn,ov);
}

static void truncateblock(Obj mapping,Word db,Word dd,OV) {
	setNodeSizeW(mapping,db,dd);
	refillblock(mapping,db,ov);
}

		

typedef struct Overflow Overflow;
struct Overflow {
	Word		block;
	Word		*buffer;
	Overflow	*link;
};
#define OV Overflow **ov
#define overflow (*ov)

static void discardspills(OV) {
	while (overflow) {
		Overflow *t = overflow->link; dispose(overflow->buffer); dispose(overflow); overflow = t;
	}
}

static void spillblock(Obj mapping,Word block,OV) {
	Overflow *p,*c;
	for (p=0,c=overflow; c; p=c,c=c->link) {
		if (c->block==block) {
			if (p) {p->link = c->link; c->link = overflow; overflow = c;}
			return;
		}
	}
	c = heap(Overflow); c->buffer = nheap(3*getHeaderBlockW(mapping),long);
	c->block = block; c->link = overflow; overflow = c;
	memcpy(c->buffer,addr(mapping,block),getHeaderBlock(mapping));
}

static void refillblock(Obj mapping,Word block,OV) {
	Overflow *p,*c;
	for (p=0,c=overflow; c; p=c,c=c->link) {
		if (c->block==block) {
			if (p) p->link = c->link; else overflow = c->link;
			memcpy(addr(mapping,block)+2,c->buffer+2,getNodeSize(mapping,block)-2*sizeof(Word));
			dispose(c->buffer); dispose(c);
			return;
		}
	}
}

static Word *addro(Obj mapping,Word block,Word off,OV) {
	Overflow *p,*c;
	for (p=0,c=overflow; c; p=c,c=c->link) {
		if (c->block==block) {
			if (p) {p->link = c->link; c->link = overflow; overflow = c;}
			return c->buffer+off;
		}
	}
	return base(mapping)+block+off;
}
#define loado(mapping,blk,off,ov)			(ntohw(*(addro(mapping,blk,off,ov))))
#define storeo(mapping,blk,off,val,ov)		((*(addro(mapping,blk,off,ov))) = htonw(val))
#define getaddro(mapping,blk,item,ov)		loado(mapping,blk,item+1,ov)

static Word succo(Obj mapping,Word blk,Word item,OV) {
	Word f = loado(mapping,blk,item,ov); item++;
	switch ((f>>16)&0xFFFF) {
		case directstring: item += (loado(mapping,blk,item,ov)+sizeof(Word)-1)/sizeof(Word);
		case blockoffset: case indirectstring: item++; break;
		default:
			Tcl_Panic("[" __FILE__ ":%d] succo kind unknown: item %d+%d (%d), kind %c, flags %08lx",
					__LINE__,blk,item-1,blk+item-1,(f>>16)&0xFFFF,f);
	}
	return item;
}

		

Word p,q,r;
if (parent) {
	p = 0; q =0; r = nodeheadersizeW;
	while (q==0 || getaddro(mapping,parent,q,ov)!=blk) {
		p = q; q = r;
		r = succo(mapping,parent,r,ov);
		if (r>=getNodeSizeW(mapping,parent)) {r = 0; break;}
		r = succo(mapping,parent,r,ov);
	}
}else
	p = q = r = 0;

		

if (q && getNodeSize(mapping,blk)<getHeaderBlock(mapping)/4) {
	if (r
		&& (!p
			|| getNodeSize(mapping,getaddro(mapping,parent,succo(mapping,parent,p,ov),ov))
					>	getNodeSize(mapping,getaddro(mapping,parent,succo(mapping,parent,r,ov),ov))
		)
	) {
		p = q; q = r;
	}
	if (!p && !r) {
		setHeaderRoot(mapping,blk);
		freeblock(mapping,blk);
	} else {
		Word x = getaddro(mapping,parent,p,ov);
		Word y = getaddro(mapping,parent,q,ov);
		d = moveblock(mapping,x,getNodeSizeW(mapping,x),-1,parent,succo(mapping,parent,p,ov),1,ov);
		moveblock(mapping,x,d,-1,y,nodeheadersizeW,-1,ov);
		moveblock(mapping,parent,succo(mapping,parent,p,ov),-1,parent,succo(mapping,parent,q,ov),-1,ov);
		blk = x; q = p;
		freeblock(mapping,y);
	}
}

		

if (getNodeSize(mapping,blk)>getHeaderBlock(mapping)-nodeheadersize) {
	Word m,n,half = getNodeSizeW(mapping,blk)/2;
	if (!q) {
		parent = newblock(intr,mapping);
		if (!parent) return TCL_ERROR;
		setHeaderRoot(mapping,parent);
		setNodeType(mapping,parent,nodelabel);
		setNodeSizeW(mapping,parent,2);
		q = nodeheadersizeW; moveaddr(mapping,parent,nodeheadersizeW,0,blk,ov);
	}
	for (i=nodeheadersizeW; i<half; i=succo(mapping,blk,i,ov)) {
		if (i>=getNodeSizeW(mapping,blk)) break;
		m = i = succo(mapping,blk,i,ov);
	}
	n = newblock(intr,mapping);
	if (!n) return TCL_ERROR;
	setNodeType(mapping,n,node?nodelabel:leaflabel);
	setNodeSize(mapping,n,nodeheadersize);
	q = moveblock(mapping,parent,succo(mapping,parent,q,ov),0,blk,m,1,ov);
	moveaddr(mapping,parent,q,0,n,ov);
	moveblock(mapping,n,nodeheadersizeW,-1,blk,succo(mapping,blk,m,ov),-1,ov);
	truncateblock(mapping,blk,m,ov);
}

		

int cc = K ? strcmp(Tcl_GetString(K),Tcl_GetString(key)) : key ? -1 : 0;
if (put->flags<0) put->flags = F;
if (!key) {
	Word B = blockaddr(mapping,d);
	Obj D = put->data ? incr(put->data) : getobj(mapping,d,false);
	releaseLongstring(mapping,d);
	d = blockitem(mapping,d);
	d = moveobj(intr,mapping,B,d,1,D,put->flags,false,ov);
	decr(D);
	if (!d) return TCL_ERROR;
}else if (cc==0) {
	Word B = blockaddr(mapping,d);
	Obj D = put->data ? incr(put->data) : getobj(mapping,d,false);
	bool precedes = succ(mapping,k)==d;
	releaseLongstring(mapping,d);
	if ((put->flags&wyrm_assocFlagCompressKey)!=(F&wyrm_assocFlagCompressKey)) {
		releaseLongstring(mapping,k);
		k = moveobj(intr,mapping,blockaddr(mapping,k),blockitem(mapping,k),1,key,put->flags,true,ov);
	}else
		k = blockitem(mapping,k);
	d = precedes ? (k ? succo(mapping,B,k,ov) : 0) : blockitem(mapping,d);
	if (k) k = moveobj(intr,mapping,B,d,1,D,put->flags,false,ov);
	decr(D);
	if (!k) return TCL_ERROR;
}else if (cc>0) {
	Word B = blockaddr(mapping,k);
	Obj D = put->data ? incr(put->data) : incr(Tcl_NewObj());
	k = moveobj(intr,mapping,B,blockitem(mapping,k),0,key,put->flags>=0?put->flags:0,true,ov);
	if (k) k = moveobj(intr,mapping,B,k,0,D,put->flags>=0?put->flags:0,false,ov);
	decr(D);
	if (!k) return TCL_ERROR;
}else if (cc<0) {
	Word B = blockaddr(mapping,d);
	Obj D = put->data ? incr(put->data) : incr(Tcl_NewObj());
	k = moveobj(intr,mapping,B,blockitem(mapping,succ(mapping,d)),0,key,put->flags>=0?put->flags:0,true,ov);
	if (k) k = moveobj(intr,mapping,B,k,0,D,put->flags>=0?put->flags:0,false,ov);
	decr(D);
	if (!k) return TCL_ERROR;
}

		

if (!K || !streq(Tcl_GetString(K),Tcl_GetString(key))) {
	rprintf(intr,"missing: %{y}s",key);
	return TCL_ERROR;
}else if (succ(mapping,k)==d) {
	Word kb = blockaddr(mapping,k),ki=blockitem(mapping,k);
	releaseLongstring(mapping,k);
	releaseLongstring(mapping,d);
	if (succ(mapping,d)>=kb+getNodeSizeW(mapping,kb)) {
		truncateblock(mapping,kb,ki,ov);
	}else {
		moveblock(mapping,kb,ki,-1,kb,succo(mapping,kb,succo(mapping,kb,ki,ov),ov),-1,ov);
	}
} else {
	Word kb = blockaddr(mapping,k),ki=blockitem(mapping,k);
	Word db = blockaddr(mapping,d),di=blockitem(mapping,d);
	Word nk = succo(mapping,db,di,ov);
	releaseLongstring(mapping,k);
	releaseLongstring(mapping,d);
	moveblock(mapping,kb,ki,1,db,nk,1,ov);
	moveblock(mapping,db,di,-1,db,succo(mapping,db,nk,ov),-1,ov);
}

		

static int isBTreeEmpty(Intr intr,Obj mapping) {
	Word root,item; int rc;
	if (validateTree(intr,mapping,false)!=TCL_OK) return TCL_ERROR;
	root = getHeaderRoot(mapping);
	item = succ(mapping,root+nodeheadersizeW);
	rc = item>=root+getNodeSizeW(mapping,getHeaderRoot(mapping)) ? TCL_OK : TCL_BREAK;
	if (releaseFile(intr,descriptor(mapping))!=TCL_OK) rc = TCL_ERROR;
	return rc;
}

		

static Obj firstBTreeScan(Intr intr,Obj mapping) {
	Word p,x; Obj r = 0;
	if (validateTree(intr,mapping,false)!=TCL_OK) return 0;
	for (p=getHeaderRoot(mapping); getNodeType(mapping,p)==nodelabel; p=getaddr(mapping,p+nodeheadersizeW)) ;
	x = succ(mapping,p+nodeheadersizeW);
	if (x>=p+getNodeSizeW(mapping,p)) {
		rprintf(intr,"empty mapping");
	}else {
		r = getobj(mapping,x,true);
	}
	if (releaseFile(intr,descriptor(mapping))!=TCL_OK) {decr(r); r = 0;}
	return r;
}

		

static Obj lastBTreeScan(Intr intr,Obj mapping) {
	Word p = getHeaderRoot(mapping),x = p+nodeheadersizeW; Obj r = 0;
	if (validateTree(intr,mapping,false)!=TCL_OK) return 0;
	for (;;) {
		Word y = succ(mapping,x);
		if (y<p+getNodeSizeW(mapping,p)) {
			decr(r); r = getobj(mapping,y,true);
			x = succ(mapping,y);
		}else if (getNodeType(mapping,p)==nodelabel) {
			p = getaddr(mapping,x);
			x = p+nodeheadersizeW;
		}else if (!r) {
			rprintf(intr,"empty mapping");
			break;
		}else {
			break;
		}
	}
	if (releaseFile(intr,descriptor(mapping))!=TCL_OK) {decr(r); r = 0;}
	return r;
}

		

typedef struct {Obj r; int pass;} ScanContext;

static int nextBTreeBottom(Intr intr,ptr context,Obj mapping,Obj key,Word d,Word k,Obj K,Word F,OV) {
	ScanContext *scan = context;
	if (scan->pass==1) {
		scan->pass = 2; return 'next';
	}else if (scan->pass==2) {
		scan->r = incr(K); return TCL_OK;
	}
}	

static Obj nextBTreeScan(Intr intr,Obj mapping,Obj key) {
	ScanContext scan = {0,1};
	if (validateTree(intr,mapping,false)!=TCL_OK) return 0;
	if (seek(intr,nextBTreeBottom,&scan,mapping,key)!=TCL_OK) {decr(scan.r); scan.r = 0;}
	if (!scan.r) rprintf(intr,"no next key");
	if (releaseFile(intr,descriptor(mapping))!=TCL_OK) {decr(scan.r); scan.r = 0;}
	return scan.r;
}

		

if (rc=='next') {
	if (i<max) rc = bottom(intr,context,mapping,key,0,0,getobj(mapping,i,true),0,ov);
}

		

static int previousBTreeBottom(Intr intr,ptr context,Obj mapping,Obj key,Word d,Word k,Obj K,Word F,OV) {
	ScanContext *scan = context;
	if (scan->pass==1) {
		scan->pass = 2; return 'prev';
	}else if (scan->pass==2) {
		scan->r = incr(K); return TCL_OK;
	}
}	

static Obj previousBTreeScan(Intr intr,Obj mapping,Obj key) {
	ScanContext scan = {0,1};
	if (validateTree(intr,mapping,false)!=TCL_OK) return 0;
	if (seek(intr,previousBTreeBottom,&scan,mapping,key)!=TCL_OK) {decr(scan.r); scan.r = 0;}
	if (!scan.r) rprintf(intr,"no previous key");
	if (releaseFile(intr,descriptor(mapping))!=TCL_OK) {decr(scan.r); scan.r = 0;}
	return scan.r;
}

		

if (rc=='prev') {
	Word l,m;
	for (i=nodeheadersizeW+blk,l=m=0; i!=d && i<max; i=succ(mapping,l)) {
		m = l; l = succ(mapping,i);
	}
	if (m) rc = bottom(intr,context,mapping,key,0,0,getobj(mapping,m,true),0,ov);
}

		

typedef struct {Obj *key,*data; int *flags;} GetContext;

static int getBTreeBottom(Intr intr,ptr context,Obj mapping,Obj key,Word d,Word k,Obj K,Word F,OV) {
	GetContext *get = context;
	if (!K && key) {rprintf(intr,"empty mapping"); return TCL_ERROR;}
	if (get->key) *(get->key) = incr(K);
	if (get->data) *(get->data) = getobj(mapping,d,false);
	if (get->flags) *(get->flags) = F;	
	return TCL_OK;
}	

static int getBTree(Intr intr,Obj mapping,Obj seeking,Obj *key,Obj *data,int *flags) {
	GetContext get = {key,data,flags}; int rc;
	if (validateTree(intr,mapping,false)!=TCL_OK) return TCL_ERROR;
	rc = seek(intr,getBTreeBottom,&get,mapping,seeking);
	if (releaseFile(intr,descriptor(mapping))!=TCL_OK) rc = TCL_ERROR;
	return rc;
}

		

typedef struct {Obj data; int flags;} PutContext;

static int putBTreeBottom(Intr intr,ptr context,Obj mapping,Obj key,Word d,Word k,Obj K,Word F,OV) {
	PutContext *put = context;
	<Put the key and data into the mapping at the bottom of a seek>
	return 'upd';
}	

static int putBTree(Intr intr,Obj mapping,Obj key,Obj data,int flags) {
	PutContext put = {data,flags}; int rc;
	if (validateTree(intr,mapping,true)!=TCL_OK) return TCL_ERROR;
	rc = seek(intr,putBTreeBottom,&put,mapping,key);
	if (releaseFile(intr,descriptor(mapping))!=TCL_OK) rc = TCL_ERROR;
	return rc;
}

		

static int deleteBTreeBottom(Intr intr,ptr context,Obj mapping,Obj key,Word d,Word k,Obj K,Word F,OV) {
	<Delete the key and data into the mapping at the bottom of a seek>
	return 'upd';
}	

static int deleteBTree(Intr intr,Obj mapping,Obj key) {
	int rc;
	if (validateTree(intr,mapping,true)!=TCL_OK) return TCL_ERROR;
	rc = seek(intr,deleteBTreeBottom,0,mapping,key);
	if (releaseFile(intr,descriptor(mapping))!=TCL_OK) rc = TCL_ERROR;
	return rc;
}

		

static int putRejected(Intr intr,Obj mapping,Obj key,Obj data,int flags) {
	rprintf(intr,"read-only map"); return TCL_ERROR;
}

static int deleteRejected(Intr intr,Obj mapping,Obj key) {
	rprintf(intr,"read-only map"); return TCL_ERROR;
}

		

int wyrm_assocBtreeInit(Intr intr) {
	char package[] =
		"namespace eval ::wyrm {\n"
		"	namespace export btree\n"
		"}\n";
	Tcl_CreateObjCommand(intr,"::wyrm::btree",btreeCommand,0,0);
	if (Tcl_Eval(intr,package)!=TCL_OK) return TCL_ERROR;
	Tcl_RegisterObjType((Tcl_ObjType*)(&WyrmAssocBTreeType));
	Tcl_RegisterObjType((Tcl_ObjType*)(&WyrmAssocBTreeROType));
	return TCL_OK;
}

		

static Obj newBTree(Intr intr,Obj base,int N,Obj *P) {
	int M; Obj *Q = 0;
	if (Tcl_ListObjGetElements(intr,base,&M,&Q)!=TCL_OK) {
		return 0;
	}else if (M!=1) {
		rprintf(intr,"mapping path is not a single element list");
		return 0;
	}else {
		Obj path = *Q;
		bool readonly = readonlyFile(Tcl_GetString(path));
		bool writable = !readonly;
		Tcl_MutexLock(&btreeMutex);
		BTree *tree = 0;
		while (N>0) {
			if (streq(Tcl_GetString(P[0]),"-ro")) {
				writable = false;
				N -= 1; P += 1;
			}else if (streq(Tcl_GetString(P[0]),"-wr")) {
				if (readonly) {
					rprintf(intr,"file is read only: %{y}s",path);
					return 0;
				}
				N -= 1; P += 1;
			}else {
				rprintf(intr,"unknown parameter: %{y}s",P[0]); return 0;
			}
		}
		<Find an open file, if already open, otherwise open or create it and link in>
		if (tree) {
			Obj mapping = incr(base);
			if ((mapping)->typePtr && (mapping)->typePtr->freeIntRepProc)
				(mapping)->typePtr->freeIntRepProc((mapping));
			(mapping)->typePtr = tree->writable
				? (Tcl_ObjType*)&WyrmAssocBTreeType
				: (Tcl_ObjType*)&WyrmAssocBTreeROType;
			mapping->internalRep.otherValuePtr = tree;
			tree->refcount++;
			Tcl_MutexUnlock(&btreeMutex);
			return mapping;
		}else {
			Tcl_MutexUnlock(&btreeMutex);
			return 0;
		}
	}
}

		

void wyrm_assocBTreeText(Word *base,Word length,chars path) {
	BTree *tree = heap(BTree); zero(1,BTree,tree);
	tree->refcount = 1; tree->path = incr(Tcl_NewStringObj(path,-1));
	tree->writable = false;
	tree->link = opentrees; opentrees = tree;
	openMemory(&tree->f,base,length);
}

		

static void tprintf(Tcl_DString *D,bool nodal,chars format,...) {
	va_list L; Obj p; va_start(L,format);
	if (D) {
		Obj p = voprintf(format,L);
		if (nodal) Tcl_DStringAppend(D,Tcl_GetString(p),-1);
		else Tcl_DStringAppendElement(D,Tcl_GetString(p));
		decr(p);
	}else {
		vcprintf(chstdout,format,L);
	}
	va_end(L);
}
static bool indent(Obj mapping,Word item,bool nodal,int depth,Tcl_DString *D) {
	if (nodal) {
		while (depth-->0) Tcl_DStringAppend(D,".",-1);
		tprintf(D,nodal,"%8d.%5d.",item,blockitem(mapping,item));
	}
	return nodal;
}

static void dumpNode(Obj mapping,Word block,bool nodal,bool first,int depth,Tcl_DString *D) {
	Word item = block+nodeheadersizeW;
	bool node = getNodeType(mapping,block)==nodelabel;
	Word max = block+getNodeSizeW(mapping,block);
	if (indent(mapping,block,nodal,depth,D))
		tprintf(D,nodal,"%{i+}s %d longs\n",load(mapping,block+0),load(mapping,block+1)/sizeof(Word));
	for (;;) {
		if (first && indent(mapping,item,nodal,depth,D)) tprintf(D,nodal,"(FIRST)\n");
		if (indent(mapping,item,nodal,depth,D)) {
			if (node) tprintf(D,nodal,"db.%d\n",load(mapping,item+1));
			else tprintf(D,nodal,"ds.");
		}
		if (node) {
			dumpNode(mapping,getaddr(mapping,item),nodal