static value_t read_vector(value_t label, u_int32_t closer)
{
value_t v=the_empty_vector, elt;
u_int32_t i=0;
PUSH(v);
if (label != UNBOUND)
ptrhash_put(&readstate->backrefs, (void*)label, (void*)v);
while (peek() != closer) {
if (ios_eof(F))
lerror(ParseError, "read: unexpected end of input");
if (i >= vector_size(v)) {
v = Stack[SP-1] = vector_grow(v);
if (label != UNBOUND)
ptrhash_put(&readstate->backrefs, (void*)label, (void*)v);
}
elt = do_read_sexpr(UNBOUND);
v = Stack[SP-1];
vector_elt(v,i) = elt;
i++;
}
take();
if (i > 0)
vector_setsize(v, i);
return POP();
}
static void * helper_thread(void * ignore)
{
while (1)
{
queue_entry_t * qe;
char b = 1;
mutex_lock(&helper.mutex);
if (!vector_size(helper.queue))
{
helper.alive = 0;
mutex_unlock(&helper.mutex);
Dprintf("%s() EXIT\n", __FUNCTION__);
return NULL;
}
qe = vector_elt(helper.queue, 0);
// NOTE: vector_erase() is O(|helper.queue|). If this queue
// gets to be big we can change how this removal works.
vector_erase(helper.queue, 0);
mutex_unlock(&helper.mutex);
if (qe->action == QEMOUNT)
helper_thread_mount(qe->mount);
else if (qe->action == QEUNMOUNT)
{
helper_thread_unmount(qe->mount);
if (write(unmount_pipe[1], &b, 1) != 1)
perror("helper_thread: write");
}
memset(qe, 0, sizeof(*qe));
free(qe);
}
assert(0); // not reachable
return NULL; // placate compiler
}
static value_t bounded_vector_compare(value_t a, value_t b, int bound, int eq)
{
size_t la = vector_size(a);
size_t lb = vector_size(b);
size_t m, i;
if (eq && (la!=lb)) return fixnum(1);
m = la < lb ? la : lb;
for (i = 0; i < m; i++) {
value_t d = bounded_compare(vector_elt(a,i), vector_elt(b,i),
bound-1, eq);
if (d==NIL || numval(d)!=0) return d;
}
if (la < lb) return fixnum(-1);
if (la > lb) return fixnum(1);
return fixnum(0);
}
static value_t cyc_vector_compare(value_t a, value_t b, htable_t *table,
int eq)
{
size_t la = vector_size(a);
size_t lb = vector_size(b);
size_t m, i;
value_t d, xa, xb, ca, cb;
// first try to prove them different with no recursion
if (eq && (la!=lb)) return fixnum(1);
m = la < lb ? la : lb;
for (i = 0; i < m; i++) {
xa = vector_elt(a,i);
xb = vector_elt(b,i);
if (leafp(xa) || leafp(xb)) {
d = bounded_compare(xa, xb, 1, eq);
if (d!=NIL && numval(d)!=0) return d;
}
else if (tag(xa) < tag(xb)) {
return fixnum(-1);
}
else if (tag(xa) > tag(xb)) {
return fixnum(1);
}
}
ca = eq_class(table, a);
cb = eq_class(table, b);
if (ca!=NIL && ca==cb)
return fixnum(0);
eq_union(table, a, b, ca, cb);
for (i = 0; i < m; i++) {
xa = vector_elt(a,i);
xb = vector_elt(b,i);
if (!leafp(xa) || tag(xa)==TAG_FUNCTION) {
d = cyc_compare(xa, xb, table, eq);
if (numval(d)!=0)
return d;
}
}
if (la < lb) return fixnum(-1);
if (la > lb) return fixnum(1);
return fixnum(0);
}
// NOTE: this is NOT an efficient operation. it is only used by the
// reader, and requires at least 1 and up to 3 garbage collections!
static value_t vector_grow(value_t v)
{
size_t i, s = vector_size(v);
size_t d = vector_grow_amt(s);
PUSH(v);
value_t newv = alloc_vector(s+d, 1);
v = Stack[SP-1];
for(i=0; i < s; i++)
vector_elt(newv, i) = vector_elt(v, i);
// use gc to rewrite references from the old vector to the new
Stack[SP-1] = newv;
if (s > 0) {
((size_t*)ptr(v))[0] |= 0x1;
vector_elt(v, 0) = newv;
gc(0);
}
return POP();
}
static int smallp(value_t v)
{
if (tinyp(v)) return 1;
if (fl_isnumber(v)) return 1;
if (iscons(v)) {
if (tinyp(car_(v)) && (tinyp(cdr_(v)) ||
(iscons(cdr_(v)) && tinyp(car_(cdr_(v))) &&
cdr_(cdr_(v))==NIL)))
return 1;
return 0;
}
if (isvector(v)) {
size_t s = vector_size(v);
return (s == 0 || (tinyp(vector_elt(v,0)) &&
(s == 1 || (s == 2 &&
tinyp(vector_elt(v,1))))));
}
return 0;
}
void print_traverse(value_t v)
{
value_t *bp;
while (iscons(v)) {
if (ismarked(v)) {
bp = (value_t*)ptrhash_bp(&printconses, (void*)v);
if (*bp == (value_t)HT_NOTFOUND)
*bp = fixnum(printlabel++);
return;
}
mark_cons(v);
print_traverse(car_(v));
v = cdr_(v);
}
if (!ismanaged(v) || issymbol(v))
return;
if (ismarked(v)) {
bp = (value_t*)ptrhash_bp(&printconses, (void*)v);
if (*bp == (value_t)HT_NOTFOUND)
*bp = fixnum(printlabel++);
return;
}
if (isvector(v)) {
if (vector_size(v) > 0)
mark_cons(v);
unsigned int i;
for(i=0; i < vector_size(v); i++)
print_traverse(vector_elt(v,i));
}
else if (iscprim(v)) {
mark_cons(v);
}
else if (isclosure(v)) {
mark_cons(v);
function_t *f = (function_t*)ptr(v);
print_traverse(f->bcode);
print_traverse(f->vals);
print_traverse(f->env);
}
else {
assert(iscvalue(v));
cvalue_t *cv = (cvalue_t*)ptr(v);
// don't consider shared references to ""
if (!cv_isstr(cv) || cv_len(cv)!=0)
mark_cons(v);
fltype_t *t = cv_class(cv);
if (t->vtable != NULL && t->vtable->print_traverse != NULL)
t->vtable->print_traverse(v);
}
}
// Find the index for the given ino in hide_table
static int hide_lookup(vector_t * hide_table, inode_t ino)
{
Dprintf("%s(0x%08x, %u)\n", __FUNCTION__, hide_table, ino);
const size_t hide_table_size = vector_size(hide_table);
int i;
for (i = 0; i < hide_table_size; i++)
{
const hide_entry_t * me = (hide_entry_t *) vector_elt(hide_table, i);
if (me->ino == ino)
return i;
}
return -ENOENT;
}
static value_t fl_vector_alloc(value_t *args, u_int32_t nargs)
{
fixnum_t i;
value_t f, v;
if (nargs == 0)
lerror(ArgError, "vector.alloc: too few arguments");
i = (fixnum_t)toulong(args[0], "vector.alloc");
if (i < 0)
lerror(ArgError, "vector.alloc: invalid size");
if (nargs == 2)
f = args[1];
else
f = FL_UNSPECIFIED;
v = alloc_vector((unsigned)i, f==FL_UNSPECIFIED);
if (f != FL_UNSPECIFIED) {
int k;
for(k=0; k < i; k++)
vector_elt(v,k) = f;
}
return v;
}
int file_hiding_cfs_unhide(CFS_t * cfs, inode_t ino)
{
Dprintf("%s(%u)\n", __FUNCTION__, ino);
file_hiding_state_t * state = (file_hiding_state_t *) cfs;
hide_entry_t * me;
/* make sure this is really a table classifier */
if (OBJMAGIC(cfs) != FILE_HIDING_MAGIC)
return -EINVAL;
int idx = hide_lookup(state->hide_table, ino);
if (idx < 0)
return idx;
me = vector_elt(state->hide_table, idx);
fprintf(stderr,"file_hiding_cfs: unhiding %u\n", ino);
vector_erase(state->hide_table, idx);
hide_entry_destroy(me);
return 0;
}
int fuse_serve_mount_step_remove(void)
{
char b = 1;
queue_entry_t * qe;
Dprintf("%s()\n", __FUNCTION__);
if (unmount_pipe[0] == -1)
return -1;
// Read the byte from helper to zero the read fd's level
if (read(unmount_pipe[0], &b, 1) != 1)
{
perror("fuse_serve_mount_step_shutdown(): read");
if (write(unmount_pipe[1], &b, 1) != 1)
assert(0);
return -1;
}
if (vector_size(remove_queue) > 0)
{
qe = vector_elt(remove_queue, 0);
// NOTE: vector_erase() is O(|remove_queue|). If this queue
// gets to be big we can change how this removal works.
vector_erase(remove_queue, 0);
}
else
{
assert(shutdown_has_started());
if (nmounts == 1)
{
Dprintf("%s(): unmounting root\n", __FUNCTION__);
return unmount_root();
}
if (!(qe = calloc(1, sizeof(*qe))))
{
(void) write(unmount_pipe[1], &b, 1); // unzero the read fd's level
return -ENOMEM;
}
qsort(mounts, nmounts, sizeof(*mounts), mount_path_compar);
qe->mount = mounts[nmounts - 1];
qe->action = QEUNMOUNT;
}
mounts_remove(qe->mount);
fuse_session_destroy(qe->mount->session);
qe->mount->session = NULL;
(void) close(qe->mount->channel_fd);
fuse_opt_free_args(&qe->mount->args);
if (enqueue_helper_request(qe) < 0)
{
fprintf(stderr, "%s(): enqueue_helper_request failed; unmount \"%s\" is unrecoverable\n", __FUNCTION__, qe->mount->fstitch_path);
free(qe);
return -1;
}
if (ensure_helper_is_running() < 0)
{
fprintf(stderr, "%s(): ensure_helper_is_running failed; unmount \"%s\" is unrecoverable\n", __FUNCTION__, qe->mount->fstitch_path);
return -1;
}
return 0;
}
void fl_print_child(ios_t *f, value_t v)
{
char *name, *str;
char buf[64];
if (print_level >= 0 && P_LEVEL >= print_level &&
(iscons(v) || isvector(v) || isclosure(v))) {
outc('#', f);
return;
}
P_LEVEL++;
switch (tag(v)) {
case TAG_NUM :
case TAG_NUM1: //HPOS+=ios_printf(f, "%ld", numval(v)); break;
str = uint2str(&buf[1], sizeof(buf)-1, labs(numval(v)), 10);
if (numval(v)<0)
*(--str) = '-';
outs(str, f);
break;
case TAG_SYM:
name = symbol_name(v);
if (print_princ)
outs(name, f);
else if (ismanaged(v)) {
outsn("#:", f, 2);
outs(name, f);
}
else
print_symbol_name(f, name);
break;
case TAG_FUNCTION:
if (v == FL_T) {
outsn("#t", f, 2);
}
else if (v == FL_F) {
outsn("#f", f, 2);
}
else if (v == FL_NIL) {
outsn("()", f, 2);
}
else if (v == FL_EOF) {
outsn("#<eof>", f, 6);
}
else if (isbuiltin(v)) {
if (!print_princ)
outsn("#.", f, 2);
outs(builtin_names[uintval(v)], f);
}
else {
assert(isclosure(v));
if (!print_princ) {
if (print_circle_prefix(f, v)) break;
function_t *fn = (function_t*)ptr(v);
outs("#fn(", f);
char *data = cvalue_data(fn->bcode);
size_t i, sz = cvalue_len(fn->bcode);
for(i=0; i < sz; i++) data[i] += 48;
fl_print_child(f, fn->bcode);
for(i=0; i < sz; i++) data[i] -= 48;
outc(' ', f);
fl_print_child(f, fn->vals);
if (fn->env != NIL) {
outc(' ', f);
fl_print_child(f, fn->env);
}
if (fn->name != LAMBDA) {
outc(' ', f);
fl_print_child(f, fn->name);
}
outc(')', f);
}
else {
outs("#<function>", f);
}
}
break;
case TAG_CVALUE:
case TAG_CPRIM:
if (v == UNBOUND) { outs("#<undefined>", f); break; }
case TAG_VECTOR:
case TAG_CONS:
if (print_circle_prefix(f, v)) break;
if (isvector(v)) {
outc('[', f);
int newindent = HPOS, est;
int i, sz = vector_size(v);
for(i=0; i < sz; i++) {
if (print_length >= 0 && i >= print_length && i < sz-1) {
outsn("...", f, 3);
break;
}
fl_print_child(f, vector_elt(v,i));
if (i < sz-1) {
if (!print_pretty) {
outc(' ', f);
}
else {
est = lengthestimate(vector_elt(v,i+1));
if (HPOS > SCR_WIDTH-4 ||
(est!=-1 && (HPOS+est > SCR_WIDTH-2)) ||
(HPOS > SCR_WIDTH/2 &&
!smallp(vector_elt(v,i+1)) &&
!tinyp(vector_elt(v,i))))
newindent = outindent(newindent, f);
else
outc(' ', f);
}
}
}
outc(']', f);
break;
}
if (iscvalue(v) || iscprim(v))
cvalue_print(f, v);
else
print_pair(f, v);
break;
}
P_LEVEL--;
}
// *oob: output argument, means we hit the limit specified by 'bound'
static uptrint_t bounded_hash(value_t a, int bound, int *oob)
{
*oob = 0;
union {
double d;
int64_t i64;
} u;
numerictype_t nt;
size_t i, len;
cvalue_t *cv;
cprim_t *cp;
void *data;
uptrint_t h = 0;
int oob2, tg = tag(a);
switch(tg) {
case TAG_NUM :
case TAG_NUM1:
u.d = (double)numval(a);
return doublehash(u.i64);
case TAG_FUNCTION:
if (uintval(a) > N_BUILTINS)
return bounded_hash(((function_t*)ptr(a))->bcode, bound, oob);
return inthash(a);
case TAG_SYM:
return ((symbol_t*)ptr(a))->hash;
case TAG_CPRIM:
cp = (cprim_t*)ptr(a);
data = cp_data(cp);
if (cp_class(cp) == wchartype)
return inthash(*(int32_t*)data);
nt = cp_numtype(cp);
u.d = conv_to_double(data, nt);
return doublehash(u.i64);
case TAG_CVALUE:
cv = (cvalue_t*)ptr(a);
data = cv_data(cv);
return memhash(data, cv_len(cv));
case TAG_VECTOR:
if (bound <= 0) {
*oob = 1;
return 1;
}
len = vector_size(a);
for(i=0; i < len; i++) {
h = MIX(h, bounded_hash(vector_elt(a,i), bound/2, &oob2)^1);
if (oob2)
bound/=2;
*oob = *oob || oob2;
}
return h;
case TAG_CONS:
do {
if (bound <= 0) {
*oob = 1;
return h;
}
h = MIX(h, bounded_hash(car_(a), bound/2, &oob2));
// bounds balancing: try to share the bounds efficiently
// so we can hash better when a list is cdr-deep (a common case)
if (oob2)
bound/=2;
else
bound--;
// recursive OOB propagation. otherwise this case is slow:
// (hash '#2=((#0=(#1=(#1#) . #0#)) . #2#))
*oob = *oob || oob2;
a = cdr_(a);
} while (iscons(a));
h = MIX(h, bounded_hash(a, bound-1, &oob2)^2);
*oob = *oob || oob2;
return h;
}
return 0;
}