object.c

#include <sys/types.h>
#include <sys/stat.h>
#include <stdio.h>
#include <stdlib.h>
#include <ctype.h>
#include <string.h>
#include <memory.h>

#include "config.h"
#include "lint.h"
#include "mstring.h"
#include "interpret.h"
#include "object.h"
#include "comm.h"
#include "super_snoop.h"
#include "sent.h"
#include "exec.h"
#include "mapping.h"
#include "mudstat.h"
#include "hash.h"
#include "main.h"
#include "simulate.h"
#ifdef DEALLOCATE_MEMORY_AT_SHUTDOWN
#include "call_out.h"
#endif

#include "inline_svalue.h"

extern int d_flag, s_flag;
extern int total_num_prog_blocks, total_prog_block_size;
extern char *add_slash(char *);
int tot_alloc_dest_object = 0;
int tot_removed_object = 0;

#define align(x) ( ((x) + (sizeof(void*)-1) )  &  ~(sizeof(void*)-1) )

struct object *previous_ob;

int tot_alloc_object, tot_alloc_object_size;

struct savebuf {
    unsigned int max_size;
    unsigned int size;
    char *buf;
    FILE *f;
};


#define STRBUFSIZE 4096
#define MAX_DEPTH  10000

void
add_strbuf(struct savebuf *sbuf, char *str)
{
    size_t len = strlen(str);

    if (sbuf->f) {
        fwrite(str, len, 1, sbuf->f);
        return;
    }

    if (sbuf->size + len + 1 > sbuf->max_size)
    {
        char *nbuf;
        size_t nsize;
        nsize = ((len + sbuf->size) / STRBUFSIZE + 1) * STRBUFSIZE;
        nbuf = xalloc(nsize);
        (void)memcpy(nbuf, sbuf->buf, sbuf->size);
        sbuf->max_size = nsize;
        free(sbuf->buf);
        sbuf->buf = nbuf;
    }
    (void)strcpy(&(sbuf->buf[sbuf->size]), str);
    sbuf->size += len;
}

#define Fprintf(s) if (fprintf s == EOF) failed=1

static void save_one (struct savebuf *,struct svalue *);

static void
save_string(struct savebuf *f, char *s)
{
    static char buf[2];

    buf[1] = '\0';

    add_strbuf(f, "\"");
    while (*s)
    {
        switch (*s)
        {
        case '"':
            add_strbuf(f, "\\\"");
            break;
        case '\\':
            add_strbuf(f, "\\\\");
            break;
        case '\n':
            add_strbuf(f, "\\n");
            break;
        default:
            buf[0] = *s;
            add_strbuf(f, buf);
            break;
        }
        s++;
    }
    add_strbuf(f, "\"");

}

/*
 * Encode an array of elements.
 */
static void
save_array(struct savebuf *f, struct vector *v)
{
    int i;

    add_strbuf(f, "({");
    for (i = 0; i < v->size; i++)
    {
        save_one(f, &v->item[i]);
        add_strbuf(f,",");
    }
    add_strbuf(f,"})");
}

static void
save_mapping(struct savebuf *f, struct mapping *m)
{
    int i;
    struct apair *p;

    add_strbuf(f, "([");
    for (i = 0; i < m->size; i++)
    {
        for(p = m->pairs[i]; p; p = p->next)
        {
            save_one(f, &p->arg);
            add_strbuf(f,":");
            save_one(f, &p->val);
            add_strbuf(f,",");
        }
    }
    add_strbuf(f,"])");
}

static void
save_one(struct savebuf *f, struct svalue *v)
{
    static char buf[48];
    static int depth = 0;

    if (++depth > MAX_DEPTH)
    {
        free(f->buf);
        depth = 0;
        error("Too deep recursion\n");
    }

    switch(v->type) {
    case T_FLOAT:
        (void)sprintf(buf,"#%a#", v->u.real);
        add_strbuf(f, buf);
        break;
    case T_NUMBER:
        (void)sprintf(buf, "%lld", v->u.number);
        add_strbuf(f, buf);
        break;
    case T_STRING:
        save_string(f, v->u.string);
        break;
    case T_POINTER:
        save_array(f, v->u.vec);
        break;
    case T_MAPPING:
        save_mapping(f, v->u.map);
        break;
    case T_OBJECT:
        (void)sprintf(buf, "$%d@", v->u.ob->created);
        add_strbuf(f, buf);
        add_strbuf(f, v->u.ob->name);
        add_strbuf(f, "$");
        break;
#if 0
    case T_FUNCTION:
        add_strbuf(f, "&FUNCTION&"); /* XXX function */
        break;
#endif
    default:
        add_strbuf(f, "0");
        break;
    }

    depth--;
}

/*
 * Save an object to a file.
 * The routine checks with the function "valid_write()" in /obj/master.c
 * to assertain that the write is legal.
 */
void save_object(struct object *ob, char *file)
{
    char *name, *tmp_name;
    size_t len;
    int i, j;
    FILE *f;
    int failed = 0;
    struct savebuf sbuf;
    /* struct svalue *v; */

    if (ob->flags & O_DESTRUCTED)
        return;

    file = check_valid_path(file, ob, "save_object", 1);
    if (file == 0)
        error("Illegal use of save_object()\n");

    len = strlen(file);
    name = tmpalloc(len + 2 + 1);
    (void)strcpy(name, file);
    (void)strcat(name, ".o");
    /*
     * Write the save-files to different directories, just in case
     * they are on different file systems.
     */
    tmp_name = tmpalloc(len + 2 + 4 + 1);
    (void)sprintf(tmp_name, "%s.tmp", name);
    f = fopen(tmp_name, "w");
    if (s_flag)
        num_filewrite++;
    if (f == 0) {
        error("Could not open %s for a save.\n", tmp_name);
    }
    failed = 0;

    sbuf.size = 0;
    sbuf.max_size = 80;
    sbuf.buf = xalloc(80);
    sbuf.f = f;

    for (j = 0; j < (int)ob->prog->num_inherited; j++)
    {
        struct program *prog = ob->prog->inherit[j].prog;
        if (ob->prog->inherit[j].type & TYPE_MOD_SECOND ||
            prog->num_variables == 0)
            continue;
        for (i = 0; i < (int)prog->num_variables; i++) {
            struct svalue *v =
                &ob->variables[i + ob->prog->inherit[j].variable_index_offset];

            if (ob->prog->inherit[j].prog->variable_names[i].type & TYPE_MOD_STATIC)
                continue;
            if (v->type == T_NUMBER || v->type == T_STRING || v->type == T_POINTER
                || v->type == T_MAPPING || v->type == T_OBJECT || v->type == T_FLOAT) { /* XXX function */
                add_strbuf(&sbuf, ob->prog->inherit[j].prog->variable_names[i].name);
                add_strbuf(&sbuf, " ");
                save_one(&sbuf, v);
                add_strbuf(&sbuf, "\n");
            }
        }
    }

    fwrite(sbuf.buf, sbuf.size, 1, f);
    free(sbuf.buf);
    if (fclose(f) == EOF)
        failed = 1;
    if (failed)
    {
        (void)unlink(tmp_name);
        error("Failed to save to file. Disk could be full.\n");
    }
    if (rename(tmp_name, name) == -1)
    {
        (void)unlink(tmp_name);
        perror(name);
        (void)printf("Failed to link %s to %s\n", tmp_name, name);
        error("Failed to save object !\n");
    }
}

/*
 * Save an object to a mapping.
 */
struct mapping *
m_save_object(struct object *ob)
{
    int i, j;
    struct mapping *ret;
    struct svalue s = const0;

    if (ob->flags & O_DESTRUCTED)
        return allocate_map(0); /* XXX is this right /LA */

    ret = allocate_map((short)(ob->prog->num_variables +
                               ob->prog->inherit[ob->prog->num_inherited - 1].
                               variable_index_offset));

    for (j = 0; j < (int)ob->prog->num_inherited; j++)
    {
        struct program *prog = ob->prog->inherit[j].prog;
        if (ob->prog->inherit[j].type & TYPE_MOD_SECOND ||
            prog->num_variables == 0)
            continue;
        for (i = 0; i < (int)prog->num_variables; i++)
        {
            struct svalue *v =
                &ob->variables[i + ob->prog->inherit[j].
                               variable_index_offset];

            if (prog->variable_names[i].type & TYPE_MOD_STATIC)
                continue;
            free_svalue(&s);
            s.type = T_STRING;
            s.string_type = STRING_SSTRING;
            s.u.string = make_sstring(prog->variable_names[i].name);
            assign_svalue(get_map_lvalue(ret, &s, 1), v);
        }
    }

    free_svalue(&s);
    return ret;
}

void
save_map(struct object *ob, struct mapping *map, char *file)
{
    char *name, *tmp_name;
    struct apair *i;
    size_t len;
    int j;
    FILE *f;
    struct savebuf sbuf;
    int failed = 0;
    /* struct svalue *v; */


    file = check_valid_path(file, ob, "save_map", 1);
    if (file == 0)
        error("Illegal use of save_map()\n");

    for (j = 0; j < map->size; j++)
    {
        for (i = map->pairs[j]; i; i = i->next) {
            if (i->arg.type != T_STRING)
                error("Non-string index in mapping\n");
            if (strpbrk(i->arg.u.string, " \n\r\t\f\v\b") != NULL)
                error("Mapping index cannot have whitespace\n");
        }
    }

    len = strlen(file);
    name = tmpalloc(len + 2 + 1);
    (void)strcpy(name, file);
    (void)strcat(name, ".o");
    /*
     * Write the save-files to different directories, just in case
     * they are on different file systems.
     */
    tmp_name = tmpalloc(len + 2 + 4 + 1);
    (void)sprintf(tmp_name, "%s.tmp", name);
    f = fopen(tmp_name, "w");
    if (s_flag)
        num_filewrite++;
    if (f == 0) {
        error("Could not open %s for a save.\n", tmp_name);
    }
    failed = 0;

    sbuf.size = 0;
    sbuf.max_size = 80;
    sbuf.buf = xalloc(80);
    sbuf.f = f;

    for (j = 0; j < map->size; j++)
    {
        for (i = map->pairs[j]; i; i = i->next) {
            struct svalue *v =
                &i->val;

            if (i->arg.type != T_STRING)
                continue;
            if (v->type == T_NUMBER || v->type == T_STRING || v->type == T_POINTER
                || v->type == T_MAPPING || v->type == T_OBJECT || v->type == T_FLOAT) { /* XXX function */
                add_strbuf(&sbuf, i->arg.u.string);
                add_strbuf(&sbuf, " ");
                save_one(&sbuf, v);
                add_strbuf(&sbuf, "\n");
            }
        }
    }
    fwrite(sbuf.buf, sbuf.size, 1, f);
    free(sbuf.buf);
    if (fclose(f) == EOF)
        failed = 1;
    if (failed)
    {
        (void)unlink(tmp_name);
        error("Failed to save to file. Disk could be full.\n");
    }
    if (rename(tmp_name, name) == -1)
    {
        (void)unlink(tmp_name);
        perror(name);
        (void)printf("Failed to link %s to %s\n", tmp_name, name);
        error("Failed to save mapping !\n");
    }
}

char *
valtostr(struct svalue *sval)
{
    struct savebuf sbuf;

    sbuf.buf = xalloc(80);
    sbuf.size = 0;
    sbuf.max_size = 80;
    sbuf.buf[0] = 0;
    sbuf.f = NULL;

    save_one(&sbuf, sval);

    return sbuf.buf;
}
#define BIG 1000

int restore_one (struct svalue *, char **);

static struct vector *
restore_array(char **str)
{
    struct svalue *tmp;
    int nmax = BIG;
    int i, k;

    tmp = (struct svalue *)xalloc(nmax * sizeof(struct svalue));
    for(k = 0; k < nmax; k++)
        tmp[k] = const0;
    i = 0;
    for(;;)
    {
        if (**str == '}')
        {
            if (*++*str == ')')
            {
                struct vector *v;

                ++*str;
                v = allocate_array(i);
                (void)memcpy((char *)&v->item[0], (char *)tmp, sizeof(struct svalue) * i);
                free(tmp);
                return v;
            }
            else
                break;
        }
        else
        {
            if (i >= nmax)
            {
                struct svalue *ntmp = (struct svalue *)xalloc(nmax * 2 * sizeof(struct svalue));
                (void)memcpy((char *)ntmp, (char *)tmp, sizeof(struct svalue) * nmax);
                free(tmp);
                tmp = ntmp;
                nmax *= 2;
                for(k = i; k < nmax; k++)
                    tmp[k] = const0;
            }
            if (!restore_one(&tmp[i++], str))
                break;
            if (*(*str)++ != ',')
                break;
        }
        }
        for (i--; i >= 0; i--)
                free_svalue(&(tmp[i]));
        free(tmp);
    return 0;
}

static struct mapping *
restore_mapping(char **str)
{
    struct mapping *m;

    m = allocate_map(0);
    for(;;)
    {
        if (**str == ']')
        {
            if (*++*str == ')')
            {
                ++*str;
                return m;
            }
            else
                break;
        }
        else
        {
            struct svalue arg, *val;
            arg = const0;
            if (!restore_one(&arg, str))
                break;
            if (*(*str)++ != ':')
            {
                free_svalue(&arg);
                break;
            }
            val = get_map_lvalue(m, &arg, 1);
            free_svalue(&arg);

            if (!restore_one(val, str) ||
                *(*str)++ != ',')
                break;
        }
    }
    free_mapping(m);
    return 0;
}

/* XXX function */
int
restore_one(struct svalue *v, char **msp)
{
    char *q, *p, *s;

    s = *msp;
    switch(*s) {
    case '(':
        switch(*++s)
        {
        case '[':
            {
                struct mapping *map;
                s++;
                map = restore_mapping(&s);
                if (!map) {
                    return 0;
                }
                free_svalue(v);
                v->type = T_MAPPING;
                v->u.map = map;
            }
            break;

        case '{':
            {
                struct vector *vec;
                s++;
                vec = restore_array(&s);
                if (!vec) {
                    return 0;
                }
                free_svalue(v);
                v->type = T_POINTER;
                v->u.vec = vec;
            }
            break;

        default:
            return 0;
        }
        break;
    case '"':
        for (p = s + 1, q = s; *p && *p != '"'; p++)
        {
            if (*p == '\\') {
                switch (*++p) {
                    case '\0':
                        /* string can't end with \ */
                        return 0;
                        break;
                    case 'n':
                        *q++ = '\n';
                        break;
                    default:
                        *q++ = *p;
                        break;
                }
            } else {
                /* Have to be able to restore old format... */
                if (*p == '\r')
                    *q++ = '\n';
                else
                    *q++ = *p;
            }
        }
        *q = 0;
        if (*p != '"')
            return 0;
        free_svalue(v);
        v->type = T_STRING;
        v->string_type = STRING_SSTRING;
        v->u.string = make_sstring(s);
        s = p+1;
        break;
    case '$':
        {
            int ct;
            struct object *ob;
            char name[1024];
            char *b = strchr(s + 1,'$');

            *name = '\0';
            if (b == NULL)
                return 0;
            if (sscanf(s,"$%d@%[^$ \n\t]$",&ct,name) != 2)
                return 0;
            ob = find_object2(name);
            free_svalue(v);
            if (ob && ob->created == ct)
            {
                v->type = T_OBJECT;
                v->u.ob = ob;
                add_ref(ob,"restore_one");
            }
            else
            {
                v->type = T_NUMBER;
                v->u.number = 0;
            }
            s = b + 1;
        }
        break;
    case '#':
        {
            double f;
            char *b = strchr(s + 1, '#');
            if (b == NULL)
                return 0;
            f = strtod(s + 1, NULL);
            free_svalue(v);
            v->type = T_FLOAT;
            v->u.real = f;
            s = b + 1;
        }
        break;
    default:
        if (!isdigit(*s) && *s != '-')
            return 0;
        free_svalue(v);
        v->type = T_NUMBER;
        v->u.number = atoll(s);
        while(isdigit(*s) || *s == '-')
            s++;
        break;
    }
    *msp = s;
    return 1;
}

int
restore_object(struct object *ob, char *file)
{
    char *name, var[100], *buff, *space;
    size_t len;
    FILE *f;
    struct object *save = current_object;
    struct stat st;
    int p;

    if (current_object != ob)
        fatal("Bad argument to restore_object()\n");
    if (ob->flags & O_DESTRUCTED)
        return 0;

    file = check_valid_path(file, ob, "restore_object", 0);
    if (file == 0)
        error("Illegal use of restore_object()\n");

    len = strlen(file);
    name = tmpalloc(len + 3);
    (void)strcpy(name, file);
    if (name[len-2] == '.' && name[len-1] == 'c')
        name[len-1] = 'o';
    else
        (void)strcat(name, ".o");
    f = fopen(name, "r");
    if (s_flag)
        num_fileread++;
    if (!f || fstat(fileno(f), &st) == -1) {
        if (f)
            (void)fclose(f);
        return 0;
    }
    if (st.st_size == 0) {
        (void)fclose(f);
        return 0;
    }
    buff = xalloc((size_t)st.st_size + 1);
    current_object = ob;

    for (;;) {
        struct svalue *v;

        if (fgets(buff, (int)st.st_size + 1, f) == 0)
            break;
        /* Remember that we have a newline at end of buff ! */
        space = strchr(buff, ' ');
        if (space == 0 || space - buff >= sizeof (var)) {
            (void)fclose(f);
            free(buff);
            error("Illegal format when restoring %s.\n", file);
        }
        (void)strncpy(var, buff, (size_t)(space - buff));
        var[space - buff] = '\0';
        p = find_status(ob->prog, var, TYPE_MOD_STATIC);
        if (p == -1)
            continue;
        v = &ob->variables[p];
        space++;
        if (!restore_one(v, &space)) {
            (void)fclose(f);
            free(buff);
            error("Illegal format when restoring %s from %s.\n", var, file);
        }
    }
    current_object = save;
    if (d_flag & DEBUG_RESTORE)
        debug_message("Object %s restored from %s.\n", ob->name, file);
    free(buff);
    (void)fclose(f);
    return 1;
}
int
m_restore_object(struct object *ob, struct mapping *map)
{
    int p;
    int i;
    struct apair *j;

    if (ob->flags & O_DESTRUCTED)
        return 0;

    for (i = 0; i < map->size; i++)
    {
        for (j = map->pairs[i]; j ; j = j->next)
        {
            if (j->arg.type != T_STRING)
                continue;

            if ((p = find_status(ob->prog, j->arg.u.string, TYPE_MOD_STATIC))
                == -1)
                continue;

            assign_svalue(&ob->variables[p], &j->val);
        }
    }

    return 1;
}

void
restore_map(struct object *ob, struct mapping *map, char *file)
{
    char *name, *buff, *space;
    size_t len;
    FILE *f;
    struct object *save = current_object;
    struct stat st;

    if (current_object != ob)
        fatal("Bad argument to restore_map()\n");
    if (ob->flags & O_DESTRUCTED)
        return;

    file = check_valid_path(file, ob, "restore_map", 0);
    if (file == 0)
        error("Illegal use of restore_map()\n");

    len = strlen(file);
    name = tmpalloc(len + 2 + 1);
    (void)strcpy(name, file);
    if (name[len-2] == '.' && name[len-1] == 'c')
        name[len-1] = 'o';
    else
        (void)strcat(name, ".o");
    f = fopen(name, "r");
    if (s_flag)
        num_fileread++;
    if (!f || fstat(fileno(f), &st) == -1) {
        if (f)
            (void)fclose(f);
        return;
    }
    if (st.st_size == 0) {
        (void)fclose(f);
        return;
    }
    buff = xalloc((size_t)st.st_size + 1);

    for (;;) {
        struct svalue v;

        v.type = T_STRING;
        v.string_type = STRING_SSTRING;

        if (fgets(buff, (int)st.st_size + 1, f) == 0)
            break;
        /* Remember that we have a newline at end of buff ! */
        space = strchr(buff, ' ');
        if (space == 0) {
            (void)fclose(f);
            free(buff);
            error("Illegal format when restoring %s.\n", file);
        }
        *space++ = '\0';
        v.u.string = make_sstring(buff);

        if (!restore_one(get_map_lvalue(map,&v,1), &space)) {
            (void)fclose(f);
            free(buff);
            free_svalue(&v);
            error("Illegal format when restoring %s.\n", file);
        }
        free_svalue(&v);
    }
    current_object = save;
    free(buff);
    (void)fclose(f);
}

void
free_object(struct object *ob, char *from)
{
    if (d_flag & DEBUG_OB_REF)
        (void)printf("Subtr ref to ob %s: %d (%s)\n", ob->name,
                      ob->ref, from);
    if (!ob->ref || --ob->ref > 0)
        return;
    if (!(ob->flags & O_DESTRUCTED))
    {
        /* This is fatal, and should never happen. */
        fatal("FATAL: Object %p %s ref count 0, but not destructed (from %s).\n",
            ob, ob->name, from);
    }
    if (ob->interactive)
        fatal("Tried to free an interactive object.\n");
    /*
     * If the program is freed, then we can also free the variable
     * declarations.
     */
    if (ob->name) {
        if (lookup_object_hash(ob->name) == ob)
            fatal("Freeing object %s but name still in name table\n", ob->name);
        free(ob->name);
        ob->name = 0;
    }
    tot_alloc_object--;
    tot_alloc_dest_object--;
    tot_removed_object++;
    free((char *)ob);
    tot_alloc_object_size -= sizeof (struct object);
}

void
add_ref(struct object *ob, char *from)
{
    INCREF(ob->ref);
    if (d_flag & DEBUG_OB_REF)
        (void)printf("Add reference to object %s: %d (%s)\n", ob->name,
               ob->ref, from);
}

/*
 * Allocate an empty object, and set all variables to 0. Note that a
 * 'struct object' already has space for one variable. So, if no variables
 * are needed, we allocate a space that is smaller than 'struct object'. This
 * unused (last) part must of course (and will not) be referenced.
 */
struct object *
get_empty_object()
{
    static struct object NULL_object;
    struct object *ob;
    int size = sizeof (struct object);

    tot_alloc_object++;
    tot_alloc_object_size += size;
    ob = (struct object *)xalloc(sizeof(struct object));
    /* marion
     * Don't initialize via memset, this is incorrect. E.g. the bull machines
     * have a (char *)0 which is not zero. We have structure assignment, so
     * use it.
     */
    *ob = NULL_object;
    ob->ref = 1;
    ob->auth = const0;
    return ob;
}

#ifdef DEALLOCATE_MEMORY_AT_SHUTDOWN
static void
force_remove_object(struct object *ob)
{
    remove_object_from_stack(ob);
    remove_object_hash(ob);
    remove_task(ob->callout_task);
    delete_all_calls(ob);
    ob->next_all = obj_list_destruct;
    ob->prev_all = NULL;
    obj_list_destruct = ob;
    ob->flags |= O_DESTRUCTED;
    tot_alloc_dest_object++;
}

void
remove_all_objects()
{
    extern struct object *master_ob, *vbfc_object, *auto_ob, *simul_efun_ob;
    struct gdexception exception_frame;
    struct object *ob;
    int n;

    exception_frame.e_exception = NULL;
    exception_frame.e_catch = 0;

    for (;;) {
        ob = obj_list;
        n = 0;
        while (ob == master_ob ||
               ob == vbfc_object ||
               ob == auto_ob ||
               ob == simul_efun_ob) {
            ob = ob->next_all;
            if (n++ > 3)
                break;
        }
        if (n > 3 || ob == 0)
            break;
        if (setjmp(exception_frame.e_context))
            clear_state();
        else {
            exception = &exception_frame;
            ob->prog->flags &= ~PRAGMA_RESIDENT;
            destruct_object(ob);
            exception = NULL;
        }
    }
    /*
     * In case we have objects referenced through
     * closure cache
     */
    clear_closure_cache();
    /*
     * Remove VBFC object
     */
    force_remove_object(vbfc_object);
    free_object(vbfc_object, "remove_all_objects");
    vbfc_object = NULL;
    /*
     * Remove master object
     */
    force_remove_object(master_ob);
    free_object(master_ob, "remove_all_objects");
    master_ob = NULL;
    /*
     * Remove simul_efun object
     */
    force_remove_object(simul_efun_ob);
    free_object(simul_efun_ob, "remove_all_objects");
    simul_efun_ob = NULL;
    /*
     * Remove auto object
     */
    force_remove_object(auto_ob);
    free_object(auto_ob, "remove_all_objects");
    auto_ob = NULL;
}
#endif

#if 0
/*
 * For debugging purposes.
 */
void
check_ob_ref(struct object *ob, char *from)
{
    struct object *o;
    int i;

    for (o = obj_list, i=0; o; o = o->next_all) {
        if (o->inherit == ob)
            i++;
    }
    if (i+1 > ob->ref) {
        fatal("FATAL too many references to inherited object %s (%d) from %s.\n",
              ob->name, ob->ref, from);
        if (current_object)
            (void)fprintf(stderr, "current_object: %s\n", current_object->name);
        for (o = obj_list; o; o = o->next_all) {
            if (o->inherit != ob)
                continue;
            (void)fprintf(stderr, "  %s\n", ob->name);
        }
    }
}
#endif /* 0 */

static struct object *hashed_living[LIVING_HASH_SIZE];

static int num_living_names, num_searches = 1, search_length = 1;

#define LivHash(s) (hash_string(s) % (LIVING_HASH_SIZE))

struct object *
find_living_object(char *str)
{
    struct object **obp, *tmp;
    struct object **hl;

    num_searches++;
    hl = &hashed_living[LivHash(str)];
    for (obp = hl; *obp; obp = &(*obp)->next_hashed_living) {
        search_length++;
        if (!((*obp)->flags & O_ENABLE_COMMANDS))
            continue;
        if (strcmp((*obp)->living_name, str) == 0)
            break;
    }
    if (*obp == 0)
        return 0;
    /* Move the found ob first. */
    if (obp == hl)
        return *obp;
    tmp = *obp;
    *obp = tmp->next_hashed_living;
    tmp->next_hashed_living = *hl;
    *hl = tmp;
    return tmp;
}

struct vector *
find_living_objects(char *str)
{
    struct object **obp;
    struct object **hl;
    struct vector *ret;
    int count;

    num_searches++;
    hl = &hashed_living[LivHash(str)];
    for (count = 0, obp = hl; *obp; obp = &(*obp)->next_hashed_living) {
        search_length++;
        if (!((*obp)->flags & O_ENABLE_COMMANDS))
            continue;
        if (strcmp((*obp)->living_name, str) == 0)
            count++;
    }

    ret = allocate_array(count);

    for (count = 0, obp = hl; *obp; obp = &(*obp)->next_hashed_living)
    {
        search_length++;
        if (!((*obp)->flags & O_ENABLE_COMMANDS))
            continue;
        if (strcmp((*obp)->living_name, str) == 0)
        {
            ret->item[count].type = T_OBJECT;
            ret->item[count++].u.ob = *obp;
            add_ref(*obp, "find_living_objects");
        }
    }

    return ret;
}

void
set_living_name(struct object *ob, char *str)
{
    struct object **hl;

    if (ob->flags & O_DESTRUCTED)
        return;
    if (ob->living_name) {
        remove_living_name(ob);
#ifdef SUPER_SNOOP
        if (ob->interactive && ob->interactive->snoop_fd >= 0) {
            (void) close(ob->interactive->snoop_fd);
            ob->interactive->snoop_fd = -1;
        }
#endif
    }
    if (!*str)
        return;
    num_living_names++;
    hl = &hashed_living[LivHash(str)];
    ob->next_hashed_living = *hl;
    *hl = ob;
    ob->living_name = make_sstring(str);
#ifdef SUPER_SNOOP
    check_supersnoop(ob);
#endif
    return;
}

void
remove_living_name(struct object *ob)
{
    struct object **hl;

    num_living_names--;
    if (!ob->living_name)
        fatal("remove_living_name: no living name set.\n");
    hl = &hashed_living[LivHash(ob->living_name)];
    while(*hl) {
        if (*hl == ob)
            break;
        hl = &(*hl)->next_hashed_living;
    }
    if (*hl == 0)
        fatal("remove_living_name: Object named %s no in hash list.\n",
              ob->living_name);
    *hl = ob->next_hashed_living;
    free_sstring(ob->living_name);
    ob->next_hashed_living = 0;
    ob->living_name = 0;
}

char *
stat_living_objects()
{
    static char tmp[400];

    (void)sprintf(tmp,"Hash table of living objects:\n-----------------------------\n%d living named objects, average search length: %4.2f\n",
            num_living_names, (double)search_length / num_searches);
    return tmp;
}

void
reference_prog (struct program *progp, char *from)
{
    INCREF(progp->ref);
    if (d_flag & DEBUG_PROG_REF)
        (void)printf("reference_prog: %s ref %d (%s)\n",
            progp->name, progp->ref, from);
}

struct program *prog_list;

/* Add a program to the list of all programs */
void register_program(struct program *prog)
{
    if (prog_list)
    {
        prog->next_all = prog_list;
        prog->prev_all = prog_list->prev_all;
        prog_list->prev_all->next_all = prog;
        prog_list->prev_all = prog;
        prog_list = prog;
    }
    else
        prog_list = prog->next_all = prog->prev_all = prog;
}

/*
 * Decrement reference count for a program. If it is 0, then free the prgram.
 * The flag free_sub_strings tells if the propgram plus all used strings
 * should be freed. They normally are, except when objects are swapped,
 * as we want to be able to read the program in again from the swap area.
 * That means that strings are not swapped.
 */
void
free_prog(struct program *progp)
{
    extern int total_program_size;
    int i;

    if (d_flag & DEBUG_PROG_REF)
        (void)printf("free_prog: %s\n", progp->name);
    if (!progp->ref || --progp->ref > 0)
        return;
    if (progp->ref < 0)
        fatal("Negative ref count for prog ref.\n");

    if (progp == prog_list)
        prog_list = progp->next_all;

    progp->prev_all->next_all = progp->next_all;
    progp->next_all->prev_all = progp->prev_all;
    if (progp->next_all == progp)
        prog_list = 0;

    total_program_size -= progp->exec_size;

    total_prog_block_size -= progp->total_size;
    total_num_prog_blocks--;

    /* Free all function names. */
    for (i=0; i < progp->num_functions; i++)
        if (progp->functions[i].name)
            free_sstring(progp->functions[i].name);

    /* Free all variable names */
    for (i=0; i < progp->num_variables; i++)
        free_sstring(progp->variable_names[i].name);

    /* Free all inherited objects */
    for (i=0; i < progp->num_inherited - 1; i++)
    {
        free_prog(progp->inherit[i].prog);
        free_sstring(progp->inherit[i].name);
    }
    free_sstring(progp->inherit[i].name);
    free(progp->name);
    free((char *)progp->program);
    if (progp->line_numbers != 0)
        free((char *)progp->line_numbers);
    free((char *)progp);
}

void
create_object(struct object *ob)
{
    int i;

    if (!(ob->flags & O_CREATED))
    {
        ob->flags |= O_CREATED;
        ob->created = current_time;
        for (i = 0; i < (int)ob->prog->num_inherited; i++)
            if (!(ob->prog->inherit[i].type & TYPE_MOD_SECOND))
            {
                if (ob->prog->inherit[i].prog->ctor_index !=
                    (unsigned short) -1)
                {
                    call_function(ob, i,
                                  (unsigned int)ob->prog->inherit[i].prog->ctor_index, 0);
                    pop_stack();
                }
            }
        if (search_for_function("create", ob->prog))
        {
            call_function(ob, function_inherit_found,
                          (unsigned int)function_index_found, 0);
            pop_stack();
        }
    }
}
void
recreate_object(struct object *ob, struct object *old_ob)
{
    int i;
    int need_create = 0;

    if (!(ob->flags & O_CREATED))
    {
        need_create = 1;
        ob->flags |= O_CREATED;
        if (!ob->created)
            ob->created = current_time;
        for (i = 0; i < (int)ob->prog->num_inherited; i++)
            if (!(ob->prog->inherit[i].type & TYPE_MOD_SECOND))
            {
                if (ob->prog->inherit[i].prog->ctor_index !=
                    (unsigned short) -1)
                {
                    call_function(ob, i,
                                  (unsigned int)ob->prog->inherit[i].prog->ctor_index, 0);
                    pop_stack();
                }
            }
    }
    if (search_for_function("recreate", ob->prog))
    {
        push_object(old_ob);
        call_function(ob, function_inherit_found,
                      (unsigned int)function_index_found, 1);
        pop_stack();
    }
    else if (need_create && search_for_function("create", ob->prog))
    {
        call_function(ob, function_inherit_found,
                      (unsigned int)function_index_found, 0);
        pop_stack();
    }
}

/*
 * Returns a list of all inherited files.
 *
 */
struct vector *
inherit_list(struct object *ob)
{
    struct vector *ret;
    int inh;

    ret = allocate_array(ob->prog->num_inherited);

    for (inh = 0; inh < (int)ob->prog->num_inherited; inh++ )
    {
        ret->item[inh].type = T_STRING;
        ret->item[inh].string_type = STRING_MSTRING;
        ret->item[inh].u.string = add_slash(ob->prog->inherit[inh].prog->name);
    }
    return ret;
}

void
change_ref(struct object *to, struct object *from, char *msg)
{
    if (from)
        add_ref(from, msg);
    if (to)
        free_object(to, msg);
}

void
warnobsolete(struct object *ob, char *msg)
{
    extern int warnobsoleteflag;

    ob->flags |= O_OBSOLETE_WARNING;
    if (!warnobsoleteflag)
        return;
    (void)fprintf(stderr, "OBSOLETE: %s: %s\n", ob->name, msg);
}