/* Copyright 1995, 1997 J"orn Rennecke */

#include "common.h"
#include "alloc.h"
#include "object.h"
#include "exec.h"
#include "interpret.h"
#include "uid.h"
#include "schedule.h"

p_int num_objects;
union svalue master_ob, simul_efun_ob;

struct object nil_object = {
  T_OBJECT, 1/* ref */, 0/*flags*/, {0/* next.hash */}, {0}, {0},
  {&nil_uid}
};

char **otable[OTABLE_SIZE];

uint8 *language_suffix[] = {".c"}, language_suffix_length[] = {1};

union svalue obj_list_destructed;

void init_otable() {
    char ***p = otable;
    do {
	*p = (char **)p;
    } while (++p != &otable[OTABLE_SIZE]);
    master_ob = find_object(master_name, 1);
    if (!master_ob.p)
	fatal("Failed to load master object\n");
    call_hook(boot_fun, master_ob, 0);
}

union svalue split_basename(uint8 *basestart, mp_uint *lenp) {
    mp_uint baselen;
    uint32 clone;
    int i;

    baselen = *lenp;
    i = 9;
    if (i <= baselen || (i = baselen)) {
	char *end, *zero, c;

	clone = 0;
	end = (char *)&basestart[baselen];
	zero = end;
	do {
	    c = *--end;
	    switch(c) {
	      case '#':
	      {
		if (zero != &end[1]) {
		    *lenp = end - (char *)basestart;
		    return (union svalue)(p_int)(clone << 1);
		}
		break;
	      }
	      case '0':
		zero = end;
			case '1': case '2': case '3': case '4':
	      case '5': case '6': case '7': case '8': case '9':
		clone = (clone << 4) + c - '0';
		continue;
	      case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
		clone = (clone << 4) + c - ('a' - 10);
		continue;
	    }
	    break;
	} while (--i);
    }
    return SV_NULL;
}

#define NXT_TO_OB(p) ( (struct object *)(void *)\
	((char *)p - offsetof(struct object, next.hash) ) )

int enter_object_hash(struct object *ob) {
    union svalue dirname, basename;
    uint8 *basestart, *dirstart;
    mp_uint baselen, dirlen;
    uint32 clone;
    mp_uint hash;
    char ***anchor, **curr;

    dirname = ob->dirname;
    if (dirname.i & 1) {
	basename = ob->basename;
	basestart = sv_string(basename, &baselen);
	clone = split_basename(basestart, &baselen).i;
    } else {
	struct program *prog;

	prog = (struct program *)dirname.p;
	basename = prog->basename;
	dirname = prog->dirname;
	basestart = sv_string(basename, &baselen);
	clone = ob->basename.i;
    }
    dirstart = sv_string(dirname, &dirlen);
    hash = uhash(dirstart, dirlen);
    hash ^= uhash(basestart, baselen);
    hash ^= clone;
    hash ^= hash / (OTABLE_SIZE*OTABLE_SIZE);
    hash ^= hash / OTABLE_SIZE;
    hash &= OTABLE_SIZE - 1;
    anchor = &otable[hash];
    ob->next.hash = curr = *anchor;
    while (curr != (char **)anchor) {
	union svalue curr_dirname, curr_basename;
	uint32 curr_clone;
	uint8 *curr_dirstart, *curr_basestart;
	mp_uint curr_dirlen, curr_baselen;

	curr_dirname = NXT_TO_OB(curr)->dirname;
	if (curr_dirname.i & 1) {
	    curr_basename = NXT_TO_OB(curr)->basename;
	    curr_basestart = sv_string(curr_basename, &curr_baselen);
	    curr_clone = split_basename(curr_basestart, &curr_baselen).i;
	} else {
	    struct program *prog;

	    prog = (struct program *)curr_dirname.p;
	    curr_basename = prog->basename;
	    curr_dirname = prog->dirname;
	    curr_basestart = sv_string(basename, &baselen);
	    curr_clone = NXT_TO_OB(curr)->basename.i;
	}
	if (SV_STR_IS_LONG(curr_dirname)) {
	    curr_dirstart = SV_LSTRING(curr_dirname);
	    curr_dirlen = SV_LSTRLEN(curr_dirname);
	} else {
	    curr_dirstart = SV_STRING(curr_dirname);
	    curr_dirlen = SV_STRLEN(curr_dirname);
	}
	if (curr_dirlen == dirlen && curr_baselen == baselen &&
	    curr_clone == clone &&
	    !memcmp(curr_dirstart, dirstart, dirlen) &&
	    !memcmp(curr_basestart, basestart, baselen) )
	{
	    return 0;
	}
	curr = *(char ***)curr;
    }
    *anchor = (char **)&ob->next.hash;
    return 1;
}

void enter_clone_hash(union svalue sv_ob, union svalue dir, union svalue base)
{
    static p_int clone_counter;

    struct object *ob;
    struct counted_string dirstr;
    char *basestr_start;
    mp_uint  basestr_len;
    mp_uint hash;
    char ***anchor, **curr;

    ob = &SV_OBJECT(sv_ob);
reroll:
    /*
     * We don't expect to cycle this loop more than 1.00001 on average.
     * Using a proper loop statement would send the wrong message to the
     * optimizer.
     */
    if ( !(ob->basename.i = hash = clone_counter += 2) )
	goto reroll;
    dirstr = sv_string2(dir);
    hash ^= ahash(dirstr.start, dirstr.len);
    SV_COUNT_STRING(base, basestr_start, basestr_len);
    hash ^= ahash(basestr_start, basestr_len);
    hash ^= hash / (OTABLE_SIZE*OTABLE_SIZE);
    hash ^= hash / OTABLE_SIZE;
    hash &= OTABLE_SIZE - 1;
    anchor = &otable[hash];
    ob->next.hash = curr = *anchor;
    while (curr != (char **)anchor) {
	union svalue curr_dirname, curr_basename;

	curr_dirname = NXT_TO_OB(curr)->dirname;
	if ( !(curr_dirname.i & 1) ) {
	    struct program *prog;

	    prog = (struct program *)curr_dirname.p;
	    if (prog->dirname.p != dir.p || prog->basename.p != base.p)
		continue;
	    if (NXT_TO_OB(curr)->basename.i != clone_counter)
		continue;
	} else {
	    uint8 *curr_basestart;
	    mp_uint curr_baselen;

	    if (curr_dirname.p != dir.p)
		continue;
	    curr_basestart = sv_string(curr_basename, &curr_baselen);
	    if (clone_counter != split_basename(curr_basestart, &curr_baselen).i)
		continue;
	    if (curr_baselen != basestr_len)
		continue;
	    if (memcmp(curr_basestart, basestr_start, basestr_len))
		continue;
	}
	goto reroll;
    }
    *anchor = (char **)&ob->next.hash;
}

static union svalue clone_name(union svalue base, union svalue clone) {
    struct counted_string basestr;
    mp_int newlen;
    char *dest;
    int32 bits;

    basestr = sv_string2(base);
    bits = clone.i | clone.i >> 1;
    bits |= bits >> 2;
    bits |= bits >> 4;
    bits |= bits >> 8;
    bits |= bits >> 16;
    bits &= ~(bits >> 1);
    newlen = basestr.len + (ffs(bits)+6 >> 2);
    if (newlen > MAX_SMALL_STRING) {
	base = ALLOC_LSTRING(newlen);
	if (!base.p)
	    return base;
	dest = SV_LSTRING(base);
	SV_LSTRREF(base) = 0;
	SV_LSTRLEN(base) = newlen;
    } else {
	base = ALLOC_STRING(newlen);
	if (!base.p)
	    return base;
	dest = SV_STRING(base);
	SV_STRREF(base) = 0;
	SV_STRLEN(base) = newlen;
    }
    amemcpy(dest, basestr.start, basestr.len);
    dest += newlen -1;
    clone.i = (p_uint)clone.i >> 1;
    do {
	int d;

	d = (clone.i & 0xf) + '0';
	if (d > '9')
	    d += 'a' - '0' - 10;
	*dest-- = d;
    } while (clone.i >>= 4);
    *dest = '#';
    return make_string_global(base);
}

svalue *clone_object(svalue *sp, struct frame *fp) {
    svalue ob, new, *variables, uid;
    p_int size;

    ob = *sp;
    inter_sp = sp;
    inter_fp = fp;
    if (SV_TYPE(ob) != T_OBJECT) {
	if (!SV_IS_STRING(ob)) {
	}
	ob = find_object(ob, MAX_INHERIT_DEPTH);
    }
    new = ALLOC_OBJECT();
    if (!new.p)
	goto nomem;
    SV_OBJECT(new).program = SV_OBJECT(ob).program;
    size = SV_OBJECT(ob).program->global_variables * sizeof(svalue);
    SV_OBJECT(new).variable = variables = alloc_gen(size);
    if (!variables)
	goto nomem2;
    bzero(variables, size);
    if (SV_OBJECT(ob).dirname.i & 1 | SV_OBJECT(ob).basename.i) {
	union svalue basename, dirname;

	if (SV_OBJECT(ob).dirname.i & 1) {
	    dirname = SV_OBJECT(ob).dirname;
	    basename = REF_INC(SV_OBJECT(ob).basename);
	} else {
	    struct program *prog;

	    prog = (struct program *)SV_OBJECT(ob).dirname.p;
	    dirname = prog->dirname;
	    basename = clone_name(prog->basename, SV_OBJECT(ob).basename);
	    if (!basename.p) {
  nomem3:
  nomem2:
  nomem:
		;
	    }
	}
	SV_OBJECT(new).dirname = dirname;
	enter_clone_hash(new, dirname, basename);
	SV_OBJECT(new).basename = clone_name(basename, SV_OBJECT(new).basename);
	FREE_ALLOCED_SVALUE(basename);
	if (!SV_OBJECT(new).basename.p)
	    goto nomem3;
	REF_INC(SV_OBJECT(new).dirname);
    } else {
	struct program *prog;

	SV_OBJECT(new).dirname = SV_OBJECT(ob).dirname;
	prog = (struct program *)SV_OBJECT(ob).dirname.p;
	enter_clone_hash(new, prog->dirname, prog->basename);
    }
    SV_OBJECT(new).x.uid = &nil_uid;
    push_svalue(ob);
    uid = call_hook(driver_hook[H_CLONE_UID], new, 1);
    if (SV_IS_NUMBER(uid) ? uid.i : !SV_IS_STRING(uid)) {
	error(IE_HOOKFAIL, H_LOAD_UID<<1);
    } else {
	SV_OBJECT(new).x.uid = add_uid(uid);
    }
    FREE_SVALUE(uid);
    ob = *sp;
    FREE_ALLOCED_SVALUE(ob);
    if (inter_errno) {
	/* FIXME: destruct new */
    }
    *sp = new;
    return sp;
}

void remove_object_hash(struct object *ob) {
    char ***search, **curr, **prev;
    search = &ob->next.hash;
    curr = *search;
    do {
	prev = curr;
	curr = *(char ***)curr;
    } while ((char ***)curr != search);
    *prev = *curr;
}

static union svalue load_object(union svalue,
char *, mp_int, char *, mp_int, mp_int, p_int, char ***, int);

/* we require objects to be named without the file name extension */

union svalue find_object(union svalue name, int load) {
    uint8 *dirstart;
    uint8 *basestart, *end, c;
    mp_int namelen, baselen, dirlen;
    p_int clone;
    mp_uint hash;
    char ***anchor, **curr, **prev, save;

    dirstart = sv_string(name, &namelen);
    while (*dirstart == '/' && namelen) {
	dirstart++;
	namelen--;
    }
    clone = split_basename(dirstart, &namelen).i;
    save = dirstart[-1];
    dirstart[-1] = '/';
    end = &dirstart[namelen];
    do {
	c = *--end;
    } while (c != '/');
    dirstart[-1] = save;
    basestart = &end[1];
    dirlen = end - dirstart;
    baselen = namelen - dirlen + 1;
    if (dirlen + 1 == 0)
	dirlen = 0;
    hash = uhash(dirstart, dirlen);
    hash ^= uhash(basestart, baselen);
    hash ^= clone;
    hash ^= hash / (OTABLE_SIZE*OTABLE_SIZE);
    hash ^= hash / OTABLE_SIZE;
    hash &= OTABLE_SIZE - 1;
    anchor = &otable[hash];
    curr = *anchor;
    prev = 0;
    while (curr != (char **)anchor) {
	union svalue curr_dirname;
	uint8 *curr_dirstart, *curr_basestart;
	mp_uint curr_baselen;

	curr_dirname = NXT_TO_OB(curr)->dirname;
	if (curr_dirname.i & 1) {
	    curr_basestart =
	      sv_string(NXT_TO_OB(curr)->basename, &curr_baselen);
	    if (clone != split_basename(curr_basestart, &curr_baselen).i)
		goto no_match;
	} else {
	    struct program *prog;

	    if (clone != NXT_TO_OB(curr)->basename.i)
		goto no_match;
	    prog = (struct program *)curr_dirname.p;
	    curr_basestart = sv_string(prog->basename, &curr_baselen);
	    curr_dirname = prog->dirname;
	}
	if (curr_baselen != baselen)
	    goto no_match;
	if (SV_STR_IS_LONG(curr_dirname)) {
	    if (dirlen != SV_LSTRLEN(curr_dirname))
		goto no_match;
	    curr_dirstart = SV_LSTRING(curr_dirname);
	} else {
	    if (dirlen != SV_STRLEN(curr_dirname))
		goto no_match;
	    curr_dirstart = SV_STRING(curr_dirname);
	}
	if (!memcmp(curr_dirstart, dirstart, dirlen) &&
	    !memcmp(curr_basestart, basestart, baselen) )
	{
	    if (prev) {
		*prev = *curr;
		*curr = *(char **)anchor;
		*anchor = curr;
	    }
	    return TO_SVALUE(NXT_TO_OB(curr));
	}
      no_match:
	prev = curr;
	curr = *(char ***)curr;
    }
    if (!load)
	return SV_NULL;
    return
      load_object(
	name, dirstart, dirlen, basestart, baselen, namelen,
	clone, anchor, load);
}

/*
 * load_object() exists to avoid registers to be taken away from the critical
 * path in find_object() . It would not be necessary if C allowed to declare
 * critical paths and compilers had better register allocation shemes.
 */

static union svalue load_object(
    union svalue name,
    char *dirstart, mp_int dirlen, char *basestart, mp_int baselen,
    mp_int namelen, p_int clone, char ***anchor, int depth)
{
    struct object *ob;
    union svalue uid, sv;
    int retries;
    struct program *new_prog;

    sv = ALLOC_OBJECT();
    if (!sv.p) {
	/* alloc() has already called error() */
	return sv;
    }
    ob = &SV_OBJECT(sv);
    ob->program = &nil_program;
    ob->dirname = make_global_string(dirstart, dirlen);
    ob->basename = make_global_string(basestart, baselen);
    ob->x.uid = &nil_uid;
    push_svalue(name);
    uid = call_hook(driver_hook[H_LOAD_UID], sv, 1);
    if (SV_IS_NUMBER(uid) ? uid.i : !SV_IS_STRING(uid)) {
	error(IE_HOOKFAIL, H_LOAD_UID<<1);
    } else {
	ob->x.uid = add_uid(uid);
    }
    FREE_SVALUE(uid);
    if (inter_errno) {
	if (ob->dirname.p)
  raise_error:
	    _free_svalue(ob->dirname);
	if (ob->basename.p)
	    _free_svalue(ob->basename);
	_free_svalue(TO_SVALUE(ob));
	return SV_NULLP;
    }
    if (clone) {
	union svalue basename;

	ob->basename = clone_name(basename = ob->basename, (union svalue)clone);
	FREE_ALLOCED_SVALUE(basename);
	if (!ob->basename.p)
	    goto raise_error;
    }

    /* enter ob in hashtable */
    ob->next.hash = *anchor;
    *anchor = (char **)&ob->next.hash;

    retries = MAX_INHERIT_DEPTH;
    inter_fp[1].previous = inter_fp;
    inter_fp++;
    do {
	inter_fp->object = TO_SVALUE(ob);
	if (new_prog = compile_file(dirstart, namelen, 0)) {
	    ob->program = new_prog;
	    new_prog->dirname = ob->dirname;
	    new_prog->basename = ob->basename;
	    if (clone) {
		REF_INC(ob->dirname );
		REF_INC(ob->basename);
	    } else {
		ob->dirname.p = (char *)new_prog;
		ob->basename.i = 0;
	    }
	    return TO_SVALUE(ob);
	}
	if (!inherit_file.p) {
	    goto raise_error;
	}
	if (depth-1 == 0) {
	    error(IE_INHERIT_DEPTH);
	    goto raise_error;
	}
	find_object(inherit_file, depth - 1);
    } while (--retries);
    inter_fp--;
    error(IE_INHERIT_DEPTH);
    goto raise_error;
}

void _free_object(union svalue ob) {
    FREE_SVALUE(SV_OBJECT(ob).dirname);
    FREE_SVALUE(SV_OBJECT(ob).basename);
    free_block(ob.p, sizeof(struct object));
}

/* async_current_time == (uint32)current_time / ASYNC_GRANULARITY */

p_int async_load;
int time_to_swap, time_to_swap_variables;

void object_async() {
    int ref_time = async_current_time;
    do {
	static int i;

	char *anchor, *curr;

	i = i+sizeof otable[0] & (OTABLE_SIZE - 1)*sizeof(otable[0]);
	curr = anchor = (char *)&otable + i;
	while ((curr = *(char **)curr) != anchor) {
	    int time_since_ref;
	    time_since_ref = (uint16)(ref_time - NXT_TO_OB(curr)->last_touched);

	    if (NXT_TO_OB(curr)->flags & (O_RESET_NONE|O_RESET_CUSTOM) ?
		 (NXT_TO_OB(curr)->flags & O_RESET_CUSTOM &&
		   (int16)(ref_time - NXT_TO_OB(curr)->reset.next) >= 0 ) :
		 (uint16)( ref_time - NXT_TO_OB(curr)->reset.last) >=
		   TIME_TO_RESET/ASYNC_GRANULARITY &&
		 NXT_TO_OB(curr)->last_touched ==
		   (uint16)(NXT_TO_OB(curr)->reset.last + 1)	)
	    {
		union svalue nxt;

		PUSH_NUMBER(0);
		nxt = call_hook(
		    driver_hook[H_RESET], TO_SVALUE(NXT_TO_OB(curr)), 1);
		if (!SV_IS_NUMBER(nxt)) {
		    /* includes CONST_INVALID for call failed */

		    FREE_SVALUE(nxt);
		    NXT_TO_OB(curr)->flags |= O_RESET_NONE;
		} else if (nxt.i) {
		    NXT_TO_OB(curr)->flags |= O_RESET_CUSTOM;
		    NXT_TO_OB(curr)->reset.next =
			ref_time + (p_uint)(nxt.i >> 1)/ASYNC_GRANULARITY;
		} else {
		    NXT_TO_OB(curr)->flags &= ~O_RESET_CUSTOM;
		    NXT_TO_OB(curr)->reset.last = ref_time;
		    NXT_TO_OB(curr)->last_touched = ref_time - 1;
		}
	    }
#if TIME_TO_CLEAN_UP > 0
	    else if (time_since_ref > TIME_TO_CLEAN_UP/ASYNC_GRANULARITY &&
		     NXT_TO_OB(curr)->flags & O_WILL_CLEAN_UP)
	    {
		union svalue sv;
		int was_swapped = NXT_TO_OB(curr)->flags & O_SWAPPED ;
		int save_touched = NXT_TO_OB(curr)->last_touched;

		push_svalue(TO_SVALUE(NXT_TO_OB(curr)));
		PUSH_NUMBER( NXT_TO_OB(curr)->flags & O_CLONE ? 0 :
		  ( O_PROG_SWAPPED(NXT_TO_OB(curr)) ? 1 :
		    NXT_TO_OB(curr)->program->ref)
		);
		sv = call_hook(
		    driver_hook[H_CLEAN_UP], TO_SVALUE(NXT_TO_OB(curr)), 2);
		NXT_TO_OB(curr)->last_touched = save_touched;
		if (!sv.i && was_swapped) {
		     NXT_TO_OB(curr)->flags &= ~O_WILL_CLEAN_UP;
		}
		FREE_SVALUE(sv);
	    }
#endif /* TIME_TO_CLEAN_UP */
	    async_load--;
	}
    } while (async_load > 0);
}

void remove_destructed_objects() {
    union svalue ob, next;

    for (ob = obj_list_destructed; ob.i; ob = next) {
	next = SV_OBJECT(ob).next.destructed;
	FREE_ALLOCED_SVALUE(ob);
    }
    CLEAR_JOB(remove_destructed_objects);
    EXTRA_JOBS();
}

struct object_x *alloc_object_x(svalue ob) {
    union object_xu x = SV_OBJECT(ob).x;
    if (!OX_VALID(x.x)) {
	svalue sv = ALLOC_TTS(T_INTERNAL, IT_X_OBJ, 1,
	  sizeof (p_int) + sizeof(struct object_x));
	if (sv.p) {
	    ((struct object_x *)&sv.p[sizeof(p_int) - 1])->uid = x.uid;
	    x.x = (struct object_x *)&sv.p[sizeof(p_int) - 1];
	    SV_OBJECT(ob).x = x;
	    x.x->user = 0;
	    x.x->shadowing = 0;
	    x.x->shadowed_by = 0;
	}
    }
    return x.x;
}

int validate_shadowing(struct frame *fp, svalue ob) {
    return SV_OBJECT(fp->object).x.uid->self->name.p
	== driver_hook[H_PRIVILEGED_UID].p;
}

svalue *f_shadow(svalue *sp, struct frame *fp) {
    struct object_x *victim_x, *shadow_x;
    svalue ob = *sp;
    if (OP_X_FLAGS(SV_OBJECTP(ob)) & O_X_SHADOWED) {
        do {
            ob = SV_OBJECT(ob).x.x->shadowed_by;
        } while (SV_OBJECT(ob).x.x->shadowed_by.i);
    }
    switch(0) { default:
	if (validate_shadowing (fp, ob)) {
	    victim_x = alloc_object_x(ob);
	    shadow_x = alloc_object_x(fp->object);
	    if (victim_x && shadow_x) {
		victim_x->shadowed_by = fp->object;
		OX_FLAGS(victim_x) |= O_X_SHADOWED;
		shadow_x->shadowing = ob;
		break;
	    }
	}
	FREE_ALLOCED_SVALUE(ob);
	sp->i = 0;
    }
    return sp;
}