#include <sys/types.h>
#include <sys/stat.h>
#include <stdio.h>
#include <ctype.h>
#include <string.h>
#ifdef __STDC__
#include <memory.h>
#endif

#include "config.h"
#include "lint.h"
#include "interpret.h"
#include "object.h"
#include "sent.h"
#include "exec.h"
#include "mapping.h"
#include "mudstat.h"

extern int d_flag, s_flag;
extern int total_num_prog_blocks, total_prog_block_size;
extern char *add_slash();
extern void print_svalue (struct svalue *, struct object *);
int tot_alloc_dest_object = 0;
int tot_removed_object = 0;

#ifdef USE_TIOCGETP		/* Check if BSD */
extern int getpid();
#else
extern pid_t getpid();
#endif

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

extern char *xalloc (int), *string_copy (char *);

void remove_swap_file (struct object *);

extern int atoi();

struct object *previous_ob;
extern struct svalue const0;

int tot_alloc_object, tot_alloc_object_size;

/*
 * Replace carriage return in a string with newlines.
 */

static void 
restore_newline(char *str)
{
    for (; *str; str++)
    {
	if (str[0] == '\r')
	    str[0] = '\n';
    }
}

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


void
add_strbuf(struct savebuf *sbuf, char *str)
{
    int len;

    len = strlen(str);
    if (sbuf->size + len + 1 > sbuf->max_size)
    {
	char *nbuf;
	int nsize;
	nbuf = xalloc(nsize = len + sbuf->size + 80);
	strcpy(nbuf, sbuf->buf);
	sbuf->max_size = nsize;
	free(sbuf->buf);
	sbuf->buf = nbuf;
    }
    strcpy(&(sbuf->buf[sbuf->size]), str);
    sbuf->size += len;
}


static int failed;
#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)
{
    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:
	/*if (isprint(*s))*/
	    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)
{
    char buf[20];

    switch(v->type) {
    case T_FLOAT:
	sprintf(buf,"#%.8e#", v->u.real);
	add_strbuf(f, buf);
	break;
    case T_NUMBER:
	sprintf(buf, "%d", 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:
	sprintf(buf, "$%d@", v->u.ob->created);
	add_strbuf(f, buf);
	add_strbuf(f, v->u.ob->name);
	add_strbuf(f, "$");
        break;
    default:
	add_strbuf(f, "0");
	break;
    }
}

/*
 * 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[80];
    int len, 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 = xalloc(len + 3);
    (void)strcpy(name, file);
    (void)strcat(name, ".o");
    /*
     * Write the save-files to different directories, just in case
     * they are on different file systems.
     */
    sprintf(tmp_name, "%s.tmp", name);
    f = fopen(tmp_name, "w");
    if (s_flag)
	num_filewrite++;
    if (f == 0) {
	free(name);
	error("Could not open %s for a save.\n", tmp_name);
    }
    failed = 0;
    
    sbuf.size = 0;
    sbuf.max_size = 80;
    sbuf.buf = xalloc(80);
    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;
	access_program(prog);
	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) {
		sbuf.size = 0;
		sbuf.buf[0] = 0;
		save_one(&sbuf, v);
		Fprintf((f, "%s %s\n", ob->prog->inherit[j].prog->variable_names[i].name, sbuf.buf));
	    }
	}
    }

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

/*
 * Save an object to a mapping.
 */
struct mapping *
m_save_object(struct object *ob)
{
    int len, i, j;
    FILE *f;
    int failed = 0;
    struct mapping *ret;
    struct svalue s = const0;
    
    if (ob->flags & O_DESTRUCTED)
	return;

    ret = allocate_map(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;
	access_program(prog);
	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 = TYPE_STRING;
	    s.string_type = STRING_MALLOC;
	    s.u.string = string_copy(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[80];
    struct apair *i;
    int len, 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");

    len = strlen(file);
    name = xalloc(len + 3);
    (void)strcpy(name, file);
    (void)strcat(name, ".o");
    /*
     * Write the save-files to different directories, just in case
     * they are on different file systems.
     */
    sprintf(tmp_name, "%s.tmp", name);
    f = fopen(tmp_name, "w");
    if (s_flag)
	num_filewrite++;
    if (f == 0) {
	free(name);
	error("Could not open %s for a save.\n", tmp_name);
    }
    failed = 0;
    
    sbuf.size = 0;
    sbuf.max_size = 80;
    sbuf.buf = xalloc(80);
    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) {
		sbuf.size = 0;
		sbuf.buf[0] = 0;
		save_one(&sbuf, v);
		Fprintf((f, "%s %s\n", i->arg.u.string, sbuf.buf));
	    }
	}
    }

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

char *
valtostr(struct svalue *sval)
{
    struct savebuf sbuf;
   
    sbuf.buf = xalloc(80);
    sbuf.size = 0;
    sbuf.max_size = 80;
    sbuf.buf[0] = 0;
    save_one(&sbuf, sval);

    return sbuf.buf;
}
#define BIG 1000

static FILE *resf;
static char *resname;
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);
		memcpy((char *)&v->item[0], (char *)tmp, sizeof(struct svalue) * i);
		free((char *)tmp);
		return v;
	    }
	    else
		break;
	} 
	else
	{
	    if (i >= nmax)
	    {
		struct svalue *ntmp;

		ntmp = (struct svalue *)xalloc(nmax * 2 * sizeof(struct svalue));
		memcpy((char *)ntmp, (char *)tmp, sizeof(struct svalue) * nmax);
		free((char *)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]));
    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;
}

int
restore_one(struct svalue *v, char **sp)
{
    char *q, *p, *s;

    s = *sp;
    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 '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->u.string = string_copy(s);
	v->string_type = STRING_MALLOC;
	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 '#':
	{
	    float f;
	    char *b = strchr(s + 1, '#');
	    if (b == NULL)
		return 0;
	    if (sscanf(s,"#%f#",&f) != 1)
		return 0;
	    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 = atoi(s);
	while(isdigit(*s) || *s == '-')
	    s++;
	break;
    }
    *sp = s;
    return 1;
}

int 
restore_object(struct object *ob, char *file)
{
    char *name, var[100], *buff, *space;
    int 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 = xalloc(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) {
	free (name);
	if (f) 
	    (void)fclose(f);
	return 0;
    }
    if (st.st_size == 0) {
	(void)fclose(f);
	free (name);
	return 0;
    }
    buff = xalloc(st.st_size + 1);
    current_object = ob;
    
    while(1) {
	struct svalue *v;

	if (fgets(buff, 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(name);
	    free(buff);
	    error("Illegal format when restoring %s.\n", file);
	}
	(void)strncpy(var, buff, space - buff);
	var[space - buff] = '\0';
	p = find_status(ob->prog, var, TYPE_MOD_STATIC);
	if (p == -1)
	    continue;
	v = &ob->variables[p];
	resname = name;
	resf = f;
	space++;
	if (!restore_one(v, &space)) {
	    (void)fclose(f);
	    free(name);
	    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(name);
    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 != TYPE_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;
}

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

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

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

    len = strlen(file);
    name = xalloc(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) {
	free (name);
	if (f) 
	    (void)fclose(f);
	return 0;
    }
    if (st.st_size == 0) {
	(void)fclose(f);
	free (name);
	return 0;
    }
    buff = xalloc(st.st_size + 1);
    
    while(1) {
	struct svalue v;

	v.type = T_STRING;
	v.string_type = STRING_MALLOC;

	if (fgets(buff, 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);
	    free(name);
	    error("Illegal format when restoring %s.\n", file);
	}
	
	v.u.string = xalloc(space - buff + 1);
	(void)strncpy(v.u.string, buff, space - buff);
	v.u.string[space - buff] = '\0';
	
	resname = name;
	resf = f;
	space++;
	if (!restore_one(get_map_lvalue(map,&v,1), &space)) {
	    (void)fclose(f);
	    free(buff);
	    free(name);
	    error("Illegal format when restoring %s.\n", file);
	}
	free_svalue(&v);
    }
    current_object = save;
    free(name);
    free(buff);
    (void)fclose(f);
    return 1;
}

void 
tell_npc(struct object *ob, char *str)
{
    push_string(str, STRING_MALLOC);
    (void)apply("catch_tell", ob, 1, 1);
}

/*
 * Send a message to an object.
 * If it is an interactive object, it will go to his
 * screen. Otherwise, it will go to a local function
 * catch_tell() in that object. This enables communications
 * between players and NPC's, and between other NPC's.
 */
void 
tell_object(struct object *ob, struct svalue *arg)
{
    struct object *save_command_giver;

    if (ob &&(ob->flags & O_DESTRUCTED))
	return;
    print_svalue(arg, ob);
    return;
}

void 
free_object(struct object *ob, char *from)
{
    struct sentence *s;

    ob->ref--;
    if (d_flag & DEBUG_OB_REF)
	printf("Subtr ref to ob %s: %d (%s)\n", ob->name,
		      ob->ref, from);
    if (ob->ref > 0)
	return;
    if (!(ob->flags & O_DESTRUCTED))
    {
	/* This is fatal, and should never happen. */
	fatal("FATAL: Object 0x%x %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", ob->name);
	free(ob->name);
	ob->name = 0;
    }
    tot_alloc_object--;
    tot_alloc_dest_object--;
    tot_removed_object++;
#ifdef RUSAGE
    remove_cpu_stack(ob);
#endif
    free((char *)ob);
    tot_alloc_object_size -= sizeof (struct object);
}

void 
add_ref(struct object *ob, char *from)
{
    ob->ref++;
    if (d_flag & DEBUG_OB_REF)
	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(int num_var)
{
    static struct object NULL_object;
    struct object *ob;
    int size = sizeof (struct object);
    int i;

    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;
    return ob;
}

void remove_all_objects()
{
    struct object *ob;
    while(1) {
	if (obj_list == 0)
	    break;
	ob = obj_list;
	destruct_object(ob);
	if (ob == obj_list)
	    break;
    }
    remove_destructed_objects();
}

#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)
	    fprintf(stderr, "current_object: %s\n", current_object->name);
	for (o = obj_list; o; o = o->next_all) {
	    if (o->inherit != ob)
		continue;
	    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;

#if defined(ultrix) && !defined(__GNUC__)
#define LivHash(s) (hashstr((s), 100, LIVING_HASH_SIZE))
#else
#if BITNUM(LIVING_HASH_SIZE) == 1
/* This one only works for even power-of-2 table size, but is faster */
#define LivHash(s) (hashstr16((s), 100) & ((LIVING_HASH_SIZE)-1))
#else
#define LivHash(s) (hashstr((s), 100, LIVING_HASH_SIZE))
#endif
#endif

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

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);
    }
    if (!*str)
	return;
    num_living_names++;
    hl = &hashed_living[LivHash(str)];
    ob->next_hashed_living = *hl;
    *hl = ob;
    ob->living_name = make_shared_string(str);
    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_string(ob->living_name);
    ob->next_hashed_living = 0;
    ob->living_name = 0;
}

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

    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)
{
    progp->ref++;
    if (d_flag & DEBUG_PROG_REF)
	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)
{
    extern struct program *swap_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 = swap_prog = prog->next_all = prog->prev_all = prog;
    
    if (current_prog)
	access_program(current_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, int free_sub_strings)
{
    int psize;
    extern int total_program_size;
    extern struct program *swap_prog;
    
    progp->ref--;
    if (d_flag & DEBUG_PROG_REF)
	printf("free_prog: %s\n", progp->name);
    if (progp->ref > 0)
	return;
    if (progp->ref < 0)
	fatal("Negative ref count for prog ref.\n");

    if (progp == swap_prog)
	swap_prog = progp->prev_all;
    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 = swap_prog = 0;
    
    remove_prog_from_swap(progp);
    
    total_program_size -= progp->exec_size;
    
    total_prog_block_size -= progp->total_size;
    total_num_prog_blocks--;
    
    if (free_sub_strings) {
	int i;
	
	/* Free all function names. */
	for (i=0; i < (int)progp->num_functions; i++)
	    if (progp->functions[i].name)
		free_string(progp->functions[i].name);

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

	/* Free all inherited objects */
	for (i=0; i < (int)progp->num_inherited - 1; i++)
	{
	    free_prog(progp->inherit[i].prog, 1);
	    free_string(progp->inherit[i].name);
	}
	free_string(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)
{
    extern int current_time;
    int num_var, i;
    extern int tot_alloc_variable_size;
    if (!(ob->flags & O_CREATED))
    {
	ob->flags |= O_CREATED;
	ob->created = current_time;
	for (i = 0; i < 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, ob->prog->inherit[i].prog->
				  ctor_index, 0);
		    pop_stack();
		}
	    }
	if (search_for_function("create", ob->prog))
	{
	    call_function(ob, function_inherit_found,
			  function_index_found, 0);
	    pop_stack();
	}
    }
}
void 
recreate_object(struct object *ob, struct object *old_ob)
{
    extern int current_time;
    int num_var, i;
    extern int tot_alloc_variable_size;
    if (!(ob->flags & O_CREATED))
    {
	ob->flags |= O_CREATED;
	if (!ob->created)
	    ob->created = current_time;
	for (i = 0; i < 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, 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,
		      function_index_found, 1);
	pop_stack();
    }
}

/*
 * If there is a shadow for this object, then the message should be
 * sent to it. But only if catch_tell() is defined. Beware that one of the
 * shadows may be the originator of the message, which means that we must
 * not send the message to that shadow, or any shadows in the linked list
 * before that shadow.
 */
int 
shadow_catch_message(struct object *ob, char *str)
{
    if (!ob->shadowed)
	return 0;
    while(ob->shadowed != 0 && ob->shadowed != current_object)
	ob = ob->shadowed;
    while(ob->shadowing)
    {
	if (function_exists("catch_tell", ob))
	{
	    push_string(str, STRING_MALLOC);

	    /* this will work, since we know the function is defined 
	     */
	    if (apply("catch_tell", ob, 1, 1))
		return 1;
	}
	ob = ob->shadowing;
    }
    return 0;
}

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