/* 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; }