/
driver3.2@242/autoconf/
driver3.2@242/doc/LPC/
driver3.2@242/hosts/
driver3.2@242/hosts/amiga/NetIncl/
driver3.2@242/hosts/amiga/NetIncl/netinet/
driver3.2@242/hosts/amiga/NetIncl/sys/
driver3.2@242/hosts/atari/
driver3.2@242/hosts/fcrypt/
driver3.2@242/mudlib/
driver3.2@242/mudlib/sys/
driver3.2@242/util/
driver3.2@242/util/indent/hosts/next/
driver3.2@242/util/make_docs/
#include <sys/types.h>
#include <sys/stat.h>
#include <fcntl.h>
#include <setjmp.h>
#include <errno.h>
#include <stdio.h>
#if defined(AMIGA)
#include <stdarg.h>
#endif
#ifdef AMIGA
#include "hosts/amiga/nsignal.h"
#else
#include <signal.h>
#endif
#include "port.h"
#if defined(DIRENT) || defined(_POSIX_VERSION)
#include <dirent.h>
#define generic_dirent dirent
#define DIRENT_NLENGTH(dirent) (strlen((dirent)->d_name))
#else /* not (DIRENT or _POSIX_VERSION) */
#define generic_dirent direct
#define DIRENT_NLENGTH(dirent) ((dirent)->d_namlen)
#ifdef SYSNDIR
#include <sys/ndir.h>
#endif /* SYSNDIR */
#ifdef SYSDIR
#include <sys/dir.h>
#endif /* SYSDIR */
#ifdef NDIR
#include <ndir.h>
#endif /* NDIR */
#endif /* not (DIRENT or _POSIX_VERSION) */

#include "lint.h"
#include "stdio.h"
#include "interpret.h"
#include "instrs.h"
#include "lang.h"
#include "object.h"
#include "sent.h"
#include "wiz_list.h"
#include "exec.h"
#include "comm.h"
#include "stralloc.h"

#ifdef atarist
#define CONST const
#else
#define CONST
#endif

#ifndef S_ISDIR
#define	S_ISDIR(m)	(((m)&S_IFMT) == S_IFDIR)
#endif

#ifndef S_ISREG
#define	S_ISREG(m)	(((m)&S_IFMT) == S_IFREG)
#endif

extern int errno;
extern int comp_flag;
extern int trace_level;

char *inherit_file;
int is_wizard_used = 0;

#ifdef SunOS4
extern int lstat PROT((CONST char *, struct stat *));
extern int fchmod PROT((int, int));     
#endif
#ifdef MSDOS
#define lstat stat
#endif

#define COMMAND_FOR_OBJECT_BUFSIZE 1000

char *last_verb = 0;

#ifdef INITIALIZATION_BY___INIT
struct object *get_empty_object PROT((int, struct variable *));
#else
struct object *get_empty_object PROT((int, struct variable *, struct svalue *));
#endif
int special_parse PROT((char *)),
    set_call PROT((struct object *, struct input_to *, int)),
    legal_path PROT((char *));

void pre_compile PROT((char *)),
    remove_interactive PROT((struct object *)),
    add_light PROT((struct object *, int)),
    add_verb PROT((char *, int)), ipc_remove(),
    set_snoop PROT((struct object *, struct object *)),
    remove_all_players(), start_new_file PROT((int)), end_new_file(),
    load_ob_from_swap PROT((struct object *)),
#if defined(MALLOC_smalloc) || defined(MALLOC_malloc)
    dump_malloc_data(),
#endif
    print_svalue PROT((struct svalue *)),
    debug_message_value PROT((struct svalue *)),
    destruct2();

extern int d_flag;

struct object *obj_list, *obj_list_destruct, *master_ob = 0;

extern struct wiz_list *back_bone_uid;

struct object *current_object;      /* The object interpreting a function. */
struct object *command_giver;       /* Where the current command came from. */
struct object *current_interactive; /* The user who caused this execution */

int num_parse_error;		/* Number of errors in the parser. */

void shutdowngame();

extern void flush_all_player_mess();

#if 0
struct variable *find_status(str, must_find)
    char *str;
    int must_find;
{
    int i;

    for (i=0; i < current_object->prog->num_variables; i++) {
	if (strcmp(current_object->prog->variable_names[i].name, str) == 0)
	    return &current_object->prog->variable_names[i];
    }
    if (!must_find)
	return 0;
    error("--Status %s not found in prog for %s\n", str,
	   current_object->name);
    return 0;
}
#endif

/*
 * Give the correct uid and euid to a created object.
 */
int give_uid_to_object(ob)
    struct object *ob;
{
    struct svalue *ret;
    char *creator_name;

    if (master_ob == 0) {
	/*
	 * Only for the master object. Note that
	 * back_bone_uid is not defined when master.c is being loaded.
	 */
#ifndef NATIVE_MODE
	/* if setuid were available, there would be no need for this. */
	ob->user = 0;
#else
	ob->user = add_name("NONAME");
#endif
	ob->eff_user = 0;
	return 1;
    }
    
    /*
     * Ask master.c who the creator of this object is.
     */
    push_volatile_string(ob->name);
    ret = apply_master_ob("creator_file", 1);
    if (!ret) {
	struct svalue arg;

#ifdef NATIVE_MODE
	ob->eff_user = ob->user = add_name("NONAME");
#else
	ob->eff_user = ob->user = 0;
#endif
	arg.type = T_OBJECT;
	arg.u.ob = ob;
	destruct_object(&arg);
	error("No function 'creator_file' in master.c!\n");
    }
    if (ret->type != T_STRING) {
#ifdef NATIVE_MODE
	/* This was missing for native before, with crash potential...	*/
	ob->eff_user = ob->user = add_name("NONAME");
#else
	ob->eff_user = ob->user = 0;
	if (ret->type != T_NUMBER || ret->u.number == 0)
#endif
	{
	    struct svalue arg;
	    /* This can be the case for objects in /ftp and /open. */
	    arg.type = T_OBJECT;
	    arg.u.ob = ob;
	    destruct_object(&arg);
	    error("Illegal object to load.\n");
	}
	return 1;
    }
    creator_name = ret->u.string;
#ifdef COMPAT_MODE
    ob->user = add_name(creator_name);
    ob->eff_user = ob->user;	/* Initial state */
    return 1;
#else
    /*
     * Now we are sure that we have a creator name.
     * Do not call apply() again, because creator_name will be lost !
     */
    if (strcmp(current_object->user->name, creator_name) == 0) {
	/* 
	 * The loaded object has the same uid as the loader.
	 */
	ob->user = current_object->eff_user;
	ob->eff_user = current_object->eff_user;
	return 1;
    }

    if (strcmp(back_bone_uid->name, creator_name) == 0) {
	/*
	 * The object is loaded from backbone. This is trusted, so we
	 * let it inherit the value of eff_user.
	 */
	ob->user = current_object->eff_user;
	ob->eff_user = current_object->eff_user;
	return 1;
    }

    /*
     * The object is not loaded from backbone, nor from 
     * from the loading objects path. That should be an object
     * defined by another wizard. It can't be trusted, so we give it the
     * same uid as the creator. Also give it eff_user 0, which means that
     * player 'a' can't use objects from player 'b' to load new objects nor
     * modify files owned by player 'b'.
     *
     * If this effect is wanted, player 'b' must let his object do
     * 'seteuid()' to himself. That is the case for most rooms.
     */
    ob->user = add_name(creator_name);
    ob->eff_user = (struct wiz_list *)0;
    return 1;
#endif /* COMPAT_MODE */
}

/*
 * Load an object definition from file. If the object wants to inherit
 * from an object that is not loaded, discard all, load the inherited object,
 * and reload again.
 *
 * In mudlib3.0 when loading inherited objects, their reset() is not called.
 *
 * Save the command_giver, because reset() in the new object might change
 * it.
 *
 *
 */
struct object *load_object(lname, dont_reset, depth)
    char *lname;
    int dont_reset;
    int depth;
{
    int fd;
    extern int total_lines;
    extern int approved_object;

    struct object *ob, *save_command_giver = command_giver;
    extern struct program *compiled_prog;
#ifndef INITIALIZATION_BY___INIT
    extern struct svalue *prog_variable_values;
#endif
    int i;
    extern char *current_file;
    struct stat c_st;
    int name_length;
    char name[200];
    struct program *prog;

#ifdef NATIVE_MODE
    if (current_object && current_object->eff_user == 0
	&& current_object->name)
	error("Can't load objects when no effective user.\n");
#endif
    /* Truncate possible .c in the object name. */
    /* Remove leading '/' if any. */
    while(lname[0] == '/')
	lname++;
    name_length = strlen(lname);
    if (name_length >= 2 &&
      lname[name_length-2] == '.' && lname[name_length-1] == 'c')
    {
	name_length -= 2;
    }
    if (name_length > sizeof name - 4)
	name_length = sizeof name - 4;
    if (name_length)
	memcpy(name, lname, name_length);
    if (master_ob && master_ob->flags & O_DESTRUCTED) {
	/* The master has been destructed, and it has not been noticed yet.
	 * Reload it, because it can't be done inside of yyparse.
	 * assert_master_ob_loaded() will clear master_ob while reloading is
	 * in progress, thus preventing a fatal recursion.
	 */
	assert_master_ob_loaded();
	/* has the object been loaded by assert_master_ob_loaded ? */
	name[name_length] = '\0';
	if (ob = find_object2(name))
	    return ob;
    }
    {
	char c;
	char *p;

	i = name_length;
	p = name+name_length;
	while (--i > 0) {
	    /* isdigit would need to check isascii first... */
	    if ( (c = *--p) < '0' || c > '9' ) {
		if (c == '#' && name_length - i > 1) {
		    fprintf(stderr, "Illegal file to load: %s\n", name);
		    error("Illegal file to load.\n");
		}
		break;
	    }
	}
    }
    /*
     * First check that the c-file exists.
     */
    (void)strcpy(name+name_length, ".c");
    if (ixstat(name, &c_st) == -1) {
	struct svalue *svp;

	push_volatile_string(name);
	svp = apply_master_ob("compile_object", 1);
	if (svp && svp->type == T_OBJECT) {
	    name[name_length] = '\0';
	    if (ob = lookup_object_hash(name)) {
		if (ob == svp->u.ob)
		    return ob;
	    } else if (ob != master_ob) {
		ob = svp->u.ob;
		remove_object_hash(ob);
		xfree(ob->name);
		ob->name = string_copy(name);
		enter_object_hash(ob);
		return ob;
	    }
	    name[name_length] = '.';
	}
	fprintf(stderr, "Could not load descr for %s\n", name);
	error("Failed to load file.\n");
	return 0;
    }
    /*
     * Check if it's a legal name.
     */
    if (!legal_path(name)) {
	fprintf(stderr, "Illegal pathname: %s\n", name);
	error("Illegal path name.\n");
	return 0;
    }
    if (comp_flag)
	fprintf(stderr, " compiling %s ...", name);
    if (current_file)
	error("Compiler is busy.\n");
    fd = ixopen(name, O_RDONLY);
    if (fd <= 0) {
	perror(name);
	error("Could not read the file.\n");
    }
    start_new_file(fd);
    current_file = alloca(strlen(name)+1); /* error in compile_file could */
    strcpy(current_file, name);		   /* inhibit freeing.            */
    name[name_length] = '\0';
    compile_file();
    end_new_file();
    if (comp_flag)
        fprintf(stderr, " done\n");
    update_compile_av(total_lines);
    total_lines = 0;
    (void)close(fd);
    current_file = 0;
    /*
     * This is an iterative process. If this object wants to inherit an
     * unloaded object, then discard current object, load the object to be
     * inherited and reload the current object again. The global variable
     * "inherit_file" will be set by lang.y to point to a file name.
     */
    if (inherit_file) {
	extern void push_referenced_shared_string PROT((char *));
	extern struct svalue *inter_sp;

	char *tmp, *tmp2;

	tmp = tmp2 = inherit_file;
	push_referenced_shared_string(tmp2);
	if (num_parse_error > 0) {
	    inherit_file = 0;
	    error("Error in loading object\n");
	}
	while (*tmp == '/') tmp++;
	if (strcmp(tmp, name) == 0) {
	    inherit_file = 0;
	    error("Illegal to inherit self.\n");
	}
	if (!depth)
	    error("Too deep inheritance nesting.\n");
	inherit_file = 0;
#if 1 /* MUDLIB3_NEED, It's very awkard to have to have a debug3 /JnA */
#ifndef NATIVE_MODE
	ob = load_object(tmp2, 0, depth-1);
#else	
	ob = load_object(tmp2, 1, depth-1);
#endif
#else
	ob = load_object(tmp2, 0, depth-1);		/* Remove this feature for now */
#endif
	free_string(inter_sp->u.string);
	inter_sp--;
	if (!ob || ob->flags & O_DESTRUCTED)
	    error("Inheritance failed\n");
	if ( !(ob = lookup_object_hash(name)) )
	    ob = load_object(name, dont_reset, depth);
	return ob;
    }
    if (num_parse_error > 0) {
	error("Error in loading object\n");
    }
    prog = compiled_prog;
#ifdef INITIALIZATION_BY___INIT
    ob = get_empty_object(prog->num_variables, prog->variable_names);
#else
    ob = get_empty_object(prog->num_variables, prog->variable_names,
      prog_variable_values);
    for (i = prog->num_variables; --i >= 0; )
	free_svalue(&prog_variable_values[i]);
    xfree((char *)prog_variable_values);
#endif
    /*
     * Can we approve of this object ?
     */
    if (approved_object || strcmp(prog->name, "std/object.c") == 0)
	ob->flags |= O_APPROVED;
    ob->name = string_copy(name);	/* Shared string is no good here */
    ob->prog = prog;
    ob->next_all = obj_list;
    obj_list = ob;
    enter_object_hash(ob);	/* add name to fast object lookup table */

    if (give_uid_to_object(ob)) {
	struct svalue *svp;
	int j;
	struct object *save_current;

	save_current = current_object;
	current_object = ob; /* for lambda_ref_replace_program */
	svp = ob->variables;
	for (j = ob->prog->num_variables;  --j >= 0; svp++) {
	    if (svp->type == T_NUMBER)
		continue;
	    set_svalue_user(svp, ob);
	}
	current_object = save_current;
	if (!dont_reset)
	    reset_object(ob, 0);
    }
    if ( !(ob->flags & O_DESTRUCTED) && function_exists("clean_up",ob) )
	ob->flags |= O_WILL_CLEAN_UP;
    command_giver = check_object(save_command_giver);
    if (d_flag > 1 && ob)
	debug_message("--%s loaded\n", ob->name);
    return ob;
}

void set_svalue_user(svp, owner)
    struct svalue *svp;
    struct object *owner;
{
    switch(svp->type) {
      case T_POINTER:
      case T_QUOTED_ARRAY:
	set_vector_user(svp->u.vec, owner);
	break;
#ifdef MAPPINGS
      case T_MAPPING:
      {
	extern void set_mapping_user
	  PROT((struct mapping *, struct object *));

	set_mapping_user(svp->u.map, owner);
	break;
      }
      case T_CLOSURE:
      {
	set_closure_user(svp, owner);
      }
#endif /* MAPPINGS */
    }
}

char *make_new_name(str)
    char *str;
{
    static long i = 0;
    static int test_conflict = 0;

    char *p;
    int l;
    char buff[12];

    for (;;) {
	(void)sprintf(buff, "#%ld", i);
	l = strlen(str);
	p = xalloc(l + strlen(buff) + 1);
	strcpy(p, str);
	strcpy(p+l, buff);
	i++;
	if (i <= 0)
	    test_conflict = 1;
	if (!test_conflict || !find_object2(p))
	    return p;
	xfree(p);
    }
}
    

/*
 * Save the command_giver, because reset() in the new object might change
 * it.
 */
struct object *clone_object(str1)
    char *str1;
{
    struct object *ob, *new_ob;
    struct object *save_command_giver = command_giver;

#ifdef NATIVE_MODE
    if (current_object && current_object->eff_user == 0)
	error("Illegal to call clone_object() with effective user 0\n");
#endif
    ob = find_object(str1);
    /*
     * If the object self-destructed...
     */
    if (ob == 0)
	return 0;
    if (ob->super)
	error("Cloning a bad object !\n");
    if (ob->flags & O_CLONE) {
	char c;
	char *p;
	mp_int name_length, i;

	name_length = strlen(ob->name);
	i = name_length;
	p = ob->name+name_length;
	while (--i > 0) {
	    /* isdigit would need to check isascii first... */
	    if ( (c = *--p) < '0' || c > '9' ) {
		if (c == '#' && name_length - i > 1) {
		    /* would need to use program name to allow it */
		    error("Cloning a bad object !\n");
		}
		break;
	    }
	}
    }
    
    /* We do not want the heart beat to be running for unused copied objects */

    if (ob->flags & O_HEART_BEAT) 
	(void)set_heart_beat(ob, 0);
    new_ob = get_empty_object(ob->prog->num_variables, ob->prog->variable_names
#ifndef INITIALIZATION_BY___INIT
        ,ob->variables
#endif
    );
    new_ob->name = make_new_name(ob->name);
    new_ob->flags |= O_CLONE | ob->flags & ( O_APPROVED | O_WILL_CLEAN_UP ) ;
    new_ob->prog = ob->prog;
    reference_prog (ob->prog, "clone_object");
#ifdef DEBUG
    if (!current_object)
	fatal("clone_object() from no current_object !\n");
#endif
    new_ob->next_all = obj_list;
    obj_list = new_ob;
    enter_object_hash(new_ob);	/* Add name to fast object lookup table */
#ifdef COMPAT_MODE
    if (current_object->user && !ob->user)
	new_ob->user = current_object->user;
    else
	new_ob->user = ob->user;		/* Possibly a null pointer */
    new_ob->eff_user = new_ob->user;	/* Init state */
#else 
    
    give_uid_to_object(new_ob);

#endif
    reset_object(new_ob, 0); 
    command_giver = check_object(save_command_giver);
    /* Never know what can happen ! :-( */
    if (new_ob->flags & O_DESTRUCTED)
	return 0;
    return new_ob;
}

struct svalue *rename_object(sp)
    struct svalue *sp;
{
    struct object *ob;
    char *name;
    mp_int length;

    if (sp[-1].type != T_OBJECT)
        bad_efun_arg(1, F_RENAME_OBJECT-F_OFFSET, sp);
    if (sp[0].type != T_STRING)
        bad_efun_arg(2, F_RENAME_OBJECT-F_OFFSET, sp);
    ob = sp[-1].u.ob;
    name = sp[0].u.string;
    /* Remove leading '/' if any. */
    while(name[0] == '/')
        name++;
    /* Truncate possible .c in the object name. */
    length = strlen(name);
    if (name[length-2] == '.' && name[length-1] == 'c') {
        /* A new writreable copy of the name is needed. */
        char *p;
        p = (char *)alloca(length+1);
        strcpy(p, name);
        name = p;
        name[length -= 2] = '\0';
    }
    {
        char c;
        char *p;
	mp_int i;

        i = length;
        p = name + length;
        while (--i > 0) {
            /* isdigit would need to check isascii first... */
            if ( (c = *--p) < '0' || c > '9' ) {
                if (c == '#' && length - i > 1) {
                    error("Illegal name to rename_object: '%s'.\n", name);
                }
                break;
            }
        }
    }
    if (lookup_object_hash(name)) {
	error("Attempt to rename to object '%s'\n", name);
    }
    assert_master_ob_loaded();
    if (master_ob == ob)
	error("Attempt to rename the master object\n");
    if (privilege_violation4("rename_object", ob, name, sp)) {
	remove_object_hash(ob);
	xfree(ob->name);
	ob->name = string_copy(name);
	enter_object_hash(ob);
    }
    free_svalue(sp--);
    free_svalue(sp--);
    return sp;
}

struct object *environment(arg)
    struct svalue *arg;
{
    struct object *ob = current_object;

    if (arg && arg->type == T_OBJECT)
	ob = arg->u.ob;
    else if (arg && arg->type == T_STRING)
	ob = find_object2(arg->u.string);
    if (ob == 0 || ob->super == 0 || (ob->flags & O_DESTRUCTED))
	return 0;
    if (ob->flags & O_DESTRUCTED)
	error("environment() of destructed object.\n");
    return ob->super;
}

/*
 * Execute a command for an object. Copy the command into a
 * new buffer, because 'parse_command()' can modify the command.
 * If the object is not current object, static functions will not
 * be executed. This will prevent forcing players to do illegal things.
 *
 * Return cost of the command executed if success (> 0).
 * When failure, return 0.
 */
int command_for_object(str, ob)
    char *str;
    struct object *ob;
{
    char buff[COMMAND_FOR_OBJECT_BUFSIZE];
    extern int eval_cost;
    int save_eval_cost = eval_cost - 1000;

    if (strlen(str) > sizeof(buff) - 1)
	error("Too long command.\n");
    if (ob == 0)
	ob = current_object;
    else if (ob->flags & O_DESTRUCTED)
	return 0;
    strncpy(buff, str, sizeof buff);
    buff[sizeof buff - 1] = '\0';
    if (ob->interactive)
	trace_level |= ob->interactive->trace_level;
    if (parse_command(buff, ob))
	return eval_cost - save_eval_cost;
    else
	return 0;
}

/*
 * To find if an object is present, we have to look in two inventory
 * lists. The first list is the inventory of the current object.
 * The second list is all things that have the same ->super as
 * current_object.
 * Also test the environment.
 * If the second argument 'ob' is non zero, only search in the
 * inventory of 'ob'. The argument 'ob' will be mandatory, later.
 */

static struct object *object_present2 PROT((char *, struct object *));

struct object *object_present(v, ob)
    struct svalue *v;
    struct object *ob;
{
    struct svalue *ret;
    struct object *ret_ob;
    int specific = 0;

    if (ob == 0)
	ob = current_object;
    else
	specific = 1;
    if (ob->flags & O_DESTRUCTED)
	return 0;
    if (v->type == T_OBJECT) {
	if (specific) {
	    if (v->u.ob->super == ob)
		return v->u.ob;
	    else
		return 0;
	}
	if (v->u.ob->super == ob ||
	    (v->u.ob->super == ob->super && ob->super != 0))
	    return v->u.ob->super;
	return 0;
    }
    ret_ob = object_present2(v->u.string, ob->contains);
    if (ret_ob)
	return ret_ob;
    if (specific)
	return 0;
    if (ob->super) {
	push_volatile_string(v->u.string);
	ret = sapply("id", ob->super, 1);
	if (ob->super->flags & O_DESTRUCTED)
	    return 0;
	if (ret && !(ret->type == T_NUMBER && ret->u.number == 0))
	    return ob->super;
	return object_present2(v->u.string, ob->super->contains);
    }
    return 0;
}

static struct object *object_present2(str, ob)
    char *str;
    struct object *ob;
{
    extern struct svalue *inter_sp;

    struct svalue *ret;
    char *p;
    int count = 0, length;
    char *item;

    length = strlen(str);
    item = xalloc(length + 1);
    if (!item)
	error("Out of memory\n");
    strcpy(item, str);
    push_malloced_string(item); /* free on error */
    p = item + length - 1;
    if (*p >= '0' && *p <= '9') {
	while(p > item && *p >= '0' && *p <= '9')
	    p--;
	if (p > item && *p == ' ') {
	    count = atoi(p+1) - 1;
	    *p = '\0';
	/*  length = p - item;	This is never used again ! */
	}
    }
    for (; ob; ob = ob->next_inv) {
	push_volatile_string(item);
	ret = sapply("id", ob, 1);
	if (ob->flags & O_DESTRUCTED) {
	    xfree(item);
	    inter_sp--;
	    return 0;
	}
	if (ret == 0 || (ret->type == T_NUMBER && ret->u.number == 0))
	    continue;
	if (count-- > 0)
	    continue;
	xfree(item);
	inter_sp--;
	return ob;
    }
    xfree(item);
    inter_sp--;
    return 0;
}

/*
 * Remove an object. It is first moved into the destruct list, and
 * not really destructed until later. (see destruct2()).
 */
void destruct_object(v)
    struct svalue *v;
{
    extern struct object *simul_efun_object;
    struct object *ob;
    struct object **pp;
    int removed;
    struct svalue *result;

    if (v->type == T_OBJECT)
	ob = v->u.ob;
    else {
	ob = find_object2(v->u.string);
	if (ob == 0)
	    error("destruct_object: Could not find %s\n", v->u.string);
    }
    if (ob->flags & O_DESTRUCTED)
	return;
    if (ob->flags & O_SWAPPED)
	load_ob_from_swap(ob);
    /*
     * If this is the first object being shadowed by another object, then
     * destruct the whole list of shadows.
     */
    if (ob->shadowed && !ob->shadowing) {
	struct svalue svp;
	struct object *ob2;

	svp.type = T_OBJECT;
	for (ob2 = ob->shadowed; ob2; ) {
	    svp.u.ob = ob2;
	    /* Update the shadowed field before the recursive call of
	     * destruct_object() , because the call could cause an error.
	     */
	    ob->shadowed = ob2 = ob2->shadowed;
	    if (ob2)
		ob2->shadowing = ob;
	    svp.u.ob->shadowed = 0;
	    svp.u.ob->shadowing = 0;
	    destruct_object(&svp);
	}
    }
    /*
     * The chain of shadows is a double linked list. Take care to update
     * it correctly.
     */
    if (ob->shadowing)
	ob->shadowing->shadowed = ob->shadowed;
    if (ob->shadowed)
	ob->shadowed->shadowing = ob->shadowing;
    ob->shadowing = 0;
    ob->shadowed = 0;

    if (d_flag > 1)
	debug_message("Destruct object %s (ref %d)\n", ob->name, ob->ref);
    push_object(ob);
    result = apply_master_ob("prepare_destruct", 1);
    if (!result) error("No prepare_destruct\n");
    if (result->type == T_STRING) error(result->u.string);
    if (result->type != T_NUMBER || result->u.number != 0) return;
    if (ob->contains) {
	error("Master failed to clean inventory in prepare_destruct\n");
    }
    remove_object_from_stack(ob);
    if (ob == simul_efun_object)
	simul_efun_object = 0;
    if ( ob->interactive ) {
	struct object *save=command_giver;

	command_giver=ob;
	trace_level |= ob->interactive->trace_level;
	if (ob->interactive->ed_buffer) {
	    extern void save_ed_buffer();

	    save_ed_buffer();
	}
	flush_all_player_mess();
	command_giver=save;
    }
    set_heart_beat(ob, 0);
    /*
     * Remove us out of this current room (if any).
     * Remove all sentences defined by this object from all objects here.
     */
    if (ob->super) {
	if (ob->super->sent)
	    remove_sent(ob, ob->super);
	add_light(ob->super, - ob->total_light);
	for (pp = &ob->super->contains; *pp;) {
	    if ((*pp)->sent)
		remove_sent(ob, *pp);
	    if (*pp != ob)
		pp = &(*pp)->next_inv;
	    else
		*pp = (*pp)->next_inv;
	}
    }
    /*
     * Now remove us out of the list of all objects.
     * This must be done last, because an error in the above code would
     * halt execution.
     */
    removed = 0;
    for (pp = &obj_list; *pp; pp = &(*pp)->next_all) {
	if (*pp != ob)
	    continue;
	*pp = (*pp)->next_all;
	removed = 1;
	remove_object_hash(ob);
	break;
    }
    if (!removed)
        fatal("Failed to delete object.\n");
    if (ob->living_name)
	remove_living_name(ob);
    ob->super = 0;
    ob->next_inv = 0;
    ob->contains = 0;
    ob->flags &= ~O_ENABLE_COMMANDS;
    ob->next_all = obj_list_destruct;
    obj_list_destruct = ob;
    ob->flags |= O_DESTRUCTED;
    if (command_giver == ob) command_giver = 0;
}

/*
 * Remove an object while the master is out of order. It is first moved into
 * the destruct list, and not really destructed until later. (see destruct2()).
 */
void emergency_destruct(ob)
    struct object *ob;
{
    extern struct object *simul_efun_object;
    struct object **pp, *item, *next;
    int removed;

    if (ob->flags & O_DESTRUCTED)
	return;
    if (ob->flags & O_SWAPPED)
	load_ob_from_swap(ob);
    /*
     * The chain of shadows is a double linked list. Take care to update
     * it correctly.
     */
    if (ob->shadowing)
	ob->shadowing->shadowed = ob->shadowed;
    if (ob->shadowed)
	ob->shadowed->shadowing = ob->shadowing;
    ob->shadowing = 0;
    ob->shadowed = 0;

    for (item = ob->contains; item; item = next) {
	remove_sent(ob, item);
	item->super = 0;
	next = item->next_inv;
	item->next_inv = 0;
    }
    remove_object_from_stack(ob);
    if (ob == simul_efun_object)
	simul_efun_object = 0;
    if (ob->interactive && ob->interactive->ed_buffer) {
	extern void free_ed_buffer();
	struct object *save=command_giver;

	command_giver = ob;
	free_ed_buffer();
	command_giver=save;
    }
    set_heart_beat(ob, 0);
    /*
     * Remove us out of this current room (if any).
     * Remove all sentences defined by this object from all objects here.
     */
    if (ob->super) {
	if (ob->super->sent)
	    remove_sent(ob, ob->super);
	add_light(ob->super, - ob->total_light);
	for (pp = &ob->super->contains; *pp;) {
	    if ((*pp)->sent)
		remove_sent(ob, *pp);
	    if (*pp != ob)
		pp = &(*pp)->next_inv;
	    else
		*pp = (*pp)->next_inv;
	}
    }
    /*
     * Now remove us out of the list of all objects.
     * This must be done last, because an error in the above code would
     * halt execution.
     */
    removed = 0;
    for (pp = &obj_list; *pp; pp = &(*pp)->next_all) {
	if (*pp != ob)
	    continue;
	*pp = (*pp)->next_all;
	removed = 1;
	remove_object_hash(ob);
	break;
    }
    if (!removed)
        fatal("Failed to delete object.\n");
    if (ob->living_name)
	remove_living_name(ob);
    ob->super = 0;
    ob->next_inv = 0;
    ob->contains = 0;
    ob->flags &= ~O_ENABLE_COMMANDS;
    ob->next_all = obj_list_destruct;
    obj_list_destruct = ob;
    ob->flags |= O_DESTRUCTED;
    if (command_giver == ob) command_giver = 0;
}

/*
 * This one is called when no program is executing from the main loop.
 */
void destruct2(ob)
    struct object *ob;
{
    struct sentence *sent;

    if (d_flag > 1) {
	debug_message("Destruct-2 object %s (ref %d)\n", ob->name, ob->ref);
    }
    if (ob->interactive)
	remove_interactive(ob);
    /*
     * We must deallocate variables here, not in 'free_object()'.
     * That is because one of the local variables may point to this object,
     * and deallocation of this pointer will also decrease the reference
     * count of this object. Otherwise, an object with a variable pointing
     * to itself, would never be freed.
     * Just in case the program in this object would continue to
     * execute, change string and object variables into the number 0.
     */
    if (ob->prog->num_variables > 0) {
	/*
	 * Deallocate variables in this object.
	 * The space of the variables are not deallocated until
	 * the object structure is freed in free_object().
	 */
	int i;
	for (i=0; i<ob->prog->num_variables; i++) {
	    free_svalue(&ob->variables[i]);
	    ob->variables[i].type = T_NUMBER;
	    ob->variables[i].u.number = 0;
	}
    }

    /* This should be here to avoid using up memory as long as the object
     * isn't released. It must be here because gcollect doesn't expect
     * sentences in destructed objects.
     */
    if (sent = ob->sent) {
	struct sentence *next;
	do {

	    next = sent->next;
	    free_sentence(sent);
	} while (sent = next);
	ob->sent = 0;
    }

    free_object(ob, "destruct_object");
}

/*
 * A message from an object will reach
 * all objects in the inventory,
 * all objects in the same environment and
 * the surrounding object.
 * Non interactive objects gets no messages.
 *
 * There are two cases to take care of. If this routine is called from
 * a player (indirectly), then the message goes to all in his
 * environment. Otherwise, the message goes to all in the current_object's
 * environment (as the case when called from a heart_beat()).
 *
 * Do not send the message to members of the array avoid.
 */

void say(v, avoid)
    struct svalue *v;
    struct vector *avoid;
{
    extern int assoc PROT((struct svalue *key, struct vector *));
    static struct svalue ltmp = { T_POINTER };
    static struct svalue stmp = { T_OBJECT };
    struct object *ob, *save_command_giver = command_giver;
    struct object *origin;
    char buff[256], *message;
#define INITIAL_MAX_RECIPIENTS 48
    int max_recipients = INITIAL_MAX_RECIPIENTS;
    struct object *first_recipients[INITIAL_MAX_RECIPIENTS];
    struct object **recipients = first_recipients;
    struct object **curr_recipient = first_recipients;
    struct object **last_recipients =
	&first_recipients[INITIAL_MAX_RECIPIENTS-1];

    struct object *save_again;

    if (current_object->flags & O_ENABLE_COMMANDS)
	command_giver = current_object;
    else if (current_object->shadowing)
	command_giver = current_object->shadowing;
    if (command_giver) {
	if (command_giver->interactive)
	    trace_level |= command_giver->interactive->trace_level;
	origin = command_giver;
        if (avoid->item[0].type == T_NUMBER) {
            avoid->item[0].type = T_OBJECT;
            avoid->item[0].u.ob = command_giver;
            add_ref(command_giver, "ass to var");
        }
    } else
	origin = current_object;
    ltmp.u.vec = avoid;
    avoid = order_alist(&ltmp, 1, 1);
    push_referenced_vector(avoid);
    avoid = avoid->item[0].u.vec;
    if (ob = origin->super) {
	if (ob->flags & O_ENABLE_COMMANDS || ob->interactive) {
	    *curr_recipient++ = ob;
	}
	for (ob = origin->super->contains; ob; ob = ob->next_inv) {
            if (ob->flags & O_ENABLE_COMMANDS || ob->interactive) {
                if (curr_recipient >= last_recipients) {
                    max_recipients <<= 1;
                    curr_recipient = (struct object **)
		      alloca(max_recipients * sizeof(struct object *));
                    memcpy((char*)curr_recipient, (char*)recipients,
                      max_recipients * sizeof(struct object *)>>1);
                    recipients = curr_recipient;
                    last_recipients = &recipients[max_recipients-1];
		    curr_recipient += (max_recipients>>1) - 1;
                }
                *curr_recipient++ = ob;
            }
	}
    }
    for (ob = origin->contains; ob; ob = ob->next_inv) {
	if (ob->flags & O_ENABLE_COMMANDS || ob->interactive) {
	    if (curr_recipient >= last_recipients) {
		max_recipients <<= 1;
		curr_recipient = (struct object **)alloca(max_recipients);
		memcpy((char*)curr_recipient, (char*)recipients,
		  max_recipients * sizeof(struct object *)>>1);
		recipients = curr_recipient;
		last_recipients = &recipients[max_recipients-1];
		curr_recipient += (max_recipients>>1) - 1;
	    }
	    *curr_recipient++ = ob;
	}
    }
    *curr_recipient = (struct object *)0;
    switch(v->type) {
    case T_STRING:
	message = v->u.string;
	break;
    case T_OBJECT:
	strncpy(buff, v->u.ob->name, sizeof buff);
	buff[sizeof buff - 1] = '\0';
	message = buff;
	break;
    case T_NUMBER:
	sprintf(buff, "%d", v->u.number);
	message = buff;
	break;
    case T_POINTER:
	for (curr_recipient = recipients; ob = *curr_recipient++; ) {
	    extern void push_vector PROT((struct vector *));

	    if (ob->flags & O_DESTRUCTED) continue;
	    stmp.u.ob = ob;
	    if (assoc(&stmp, avoid) >= 0) continue;
	    push_vector(v->u.vec);
	    push_object(command_giver);
	    sapply("catch_msg", ob, 2);
	}
	pop_stack(); /* free avoid alist */
        command_giver = check_object(save_command_giver);
	return;
    default:
	error("Invalid argument %d to say()\n", v->type);
    }
    for (curr_recipient = recipients; ob = *curr_recipient++; ) {
        if (ob->flags & O_DESTRUCTED) continue;
	stmp.u.ob = ob;
	if (assoc(&stmp, avoid) >= 0) continue;
	if (ob->interactive == 0) {
	    tell_npc(ob, message);
	    continue;
	}
        save_again = command_giver;
	command_giver = ob;
	add_message("%s", message);
	command_giver = save_again;
    }
    pop_stack(); /* free avoid alist */
    command_giver = check_object(save_command_giver);
}

/*
 * Send a message to all objects inside an object.
 * Non interactive objects get the messages too.
 * Compare with say().
 */

void tell_room(room, v, avoid)
    struct object *room;
    struct svalue *v;
    struct vector *avoid; /* has to be in alist order */
{
    int assoc PROT((struct svalue *key, struct vector *));
    struct object *ob, *save_command_giver;
    int num_recipients = 0;
    struct object *some_recipients[20], **recipients, **curr_recipient;
    char buff[256], *message;
    static struct svalue stmp = { T_OBJECT, } ;


    for (ob = room->contains; ob; ob = ob->next_inv) {
	if ( ob->flags & O_ENABLE_COMMANDS || ob->interactive )
	    num_recipients++;
    }
    if (num_recipients < 20)
	recipients = some_recipients;
    else
	recipients = (struct object **)
	  alloca( (num_recipients+1) * sizeof(struct object *) );
    curr_recipient = recipients;
    for (ob = room->contains; ob; ob = ob->next_inv) {
	if ( ob->flags & O_ENABLE_COMMANDS || ob->interactive )
	    *curr_recipient++ = ob;
    }
    *curr_recipient = (struct object *)0;
    switch(v->type) {
    case T_STRING:
	message = v->u.string;
	break;
    case T_OBJECT:
	strncpy(buff, v->u.ob->name, sizeof buff);
	buff[sizeof buff - 1] = '\0';
	message = buff;
	break;
    case T_NUMBER:
	sprintf(buff, "%d", v->u.number);
	message = buff;
	break;
    case T_POINTER:
	for (curr_recipient = recipients; ob = *curr_recipient++; ) {
	    extern void push_vector PROT((struct vector *));

	    if (ob->flags & O_DESTRUCTED) continue;
	    stmp.u.ob = ob;
	    if (assoc(&stmp, avoid) >= 0) continue;
	    push_vector(v->u.vec);
	    push_object(command_giver);
	    sapply("catch_msg", ob, 2);
	}
	return;
    default:
	error("Invalid argument %d to tell_room()\n", v->type);
    }
    for (curr_recipient = recipients; ob = *curr_recipient++; ) {
	if (ob->flags & O_DESTRUCTED) continue;
	stmp.u.ob = ob;
	if (assoc(&stmp, avoid) >= 0) continue;
	if (ob->interactive == 0) {
	    tell_npc(ob, message);
	    continue;
	}
        save_command_giver = command_giver;
	command_giver = ob;
	add_message("%s", message);
        command_giver = save_command_giver;
    }
}

void shout_string(str)
    char *str;
{
    struct object *ob, *save_command_giver = command_giver;
    char *p;

    str = string_copy(str);	/* So that we can modify the string */
    for (p=str; *p; p++) {
	if ((*p < ' ' || *p > '~') && *p != '\n')
	    *p = ' ';
    }

    p = 0;
#ifdef LOG_SHOUT
    if (command_giver) {
	struct svalue *v;
	v = sapply("query_real_name", command_giver, 0);
	if (v && v->type == T_STRING)
	    p = v->u.string;
    } else if (current_object && current_object->user)
	p = current_object->user->name;
    if (p) {
	FILE *f = 0;

	f = fopen("log/SHOUTS", "a");
	if (f) {
	    fprintf(f, "%s: %s\n", p, str);
	    fclose(f);
	}
    }
#endif
    for (ob = obj_list; ob; ob = ob->next_all) {
	if (!ob->interactive || ob == save_command_giver || !ob->super)
	    continue;
	command_giver = ob;
	add_message("%s", str);
    }
    command_giver = save_command_giver;
    xfree(str);
}

struct object *first_inventory(arg)
    struct svalue *arg;
{
    struct object *ob;

    if (arg->type == T_STRING)
	ob = find_object(arg->u.string);
    else
	ob = arg->u.ob;
    if (ob == 0)
	error("No object to first_inventory()");
    if (ob->contains == 0)
	return 0;
    return ob->contains;
}

/*
 * This will enable an object to use commands normally only
 * accessible by interactive players.
 * Also check if the player is a wizard. Wizards must not affect the
 * value of the wizlist ranking.
 */

void enable_commands(num)
    int num;
{
    if (current_object->flags & O_DESTRUCTED)
	return;
    if (d_flag > 1) {
	debug_message("Enable commands %s (ref %d)\n",
	    current_object->name, current_object->ref);
    }
    if (num) {
	current_object->flags |= O_ENABLE_COMMANDS;
	command_giver = current_object;
	if (command_giver->interactive)
	    trace_level |= command_giver->interactive->trace_level;
    } else {
	current_object->flags &= ~O_ENABLE_COMMANDS;
	command_giver = 0;
    }
}

/*
 * Set up a function in this object to be called with the next
 * user input string.
 */
struct svalue *input_to(sp, num_arg)
    struct svalue *sp;
    int num_arg;
{
    struct svalue *arg;
    int flag;
    struct input_to *it;
    int extra;

    arg = sp - num_arg + 1;
    if (arg[0].type != T_STRING)
        bad_efun_arg(1, F_INPUT_TO-F_OFFSET, sp);
    flag = 0;
    extra = 0;
    if (num_arg > 1) {
	if (arg[1].type != T_NUMBER)
	    bad_efun_arg(2, F_INPUT_TO-F_OFFSET, sp);
	flag = arg[1].u.number & 1;
	extra = num_arg - 2;
    }
    it = (struct input_to *)xalloc(
	sizeof *it - sizeof *sp + sizeof *sp * extra );
    it->function = make_shared_string(arg[0].u.string);
    free_string_svalue(arg);
    if (set_call(command_giver, it, flag)) {
	struct svalue *dest;

	it->num_arg = extra;
	it->ob = current_object;
	add_ref(current_object, "input_to");
	sp = arg;
	arg += 2;
	dest = it->arg;
	while (--extra >= 0) {
	    if (arg->type == T_LVALUE) {
		int error_index = arg - sp + 1;
		do {
		    free_svalue(arg++);
		    (dest++)->type = T_INVALID;
		} while (--extra >= 0);
		free_input_to(it);
		bad_efun_arg(error_index, F_INPUT_TO-F_OFFSET, sp - 1);
	    }
	    transfer_svalue_no_free(dest++, arg++);
	}
	sp->type = T_NUMBER;
	sp->u.number = 1;
	return sp;
    }
    free_string(it->function);
    xfree((char *)it);
    while (--num_arg > 0) {
	free_svalue(sp);
	sp--;
    }
    sp->type = T_NUMBER;
    sp->u.number = 0;
    return sp;
}

void free_input_to(it)
    struct input_to *it;
{
    struct svalue *arg;
    int i;

    free_object(it->ob, "free_input_to");
    free_string(it->function);
    for (arg = it->arg, i = it->num_arg; --i >= 0; ) {
	free_svalue(arg++);
    }
    xfree((char *)it);
}

#define MAX_LINES 50

/*
 * This one is used by qsort in get_dir().
 */
static int pstrcmp(p1, p2)
    struct svalue *p1, *p2;
{
    return strcmp(p1->u.string, p2->u.string);
}

#ifdef atarist
/* this code is provided to speed up ls() on an Atari ST/TT . */

#include <support.h>
#include <limits.h>
#include <osbind.h>

extern long _unixtime PROT((unsigned, unsigned));

struct xdirect {
	/* inode and position in directory aren't usable in a portable way,
	   so why support them anyway?
	 */
	short d_namlen;
	char  d_name[16];
	int   size;
	int   time;
};

typedef struct
{
    _DTA dta;
    char *dirname;
    long status;
} xdir;
#define XDIR xdir

static long olddta;

XDIR *xopendir(path)
char *path;
{
    char pattern[PATH_MAX];
    XDIR *d;
    long status;

    d = (XDIR *)xalloc(sizeof(XDIR));
    _unx2dos(path, pattern);
    strcat(pattern, "\\*.*");
    olddta = Fgetdta();
    Fsetdta(&d->dta);
    d->status = status = Fsfirst(pattern, 0xff);
    if (status && status != -ENOENT) {
        xfree(d);
        return 0;
    }
    d->dirname = string_copy(pattern);
    return d;
}

#define XOPENDIR(dest, path) ((dest) = xopendir(path))

struct xdirect *xreaddir(d)
XDIR *d;
{
    static struct xdirect xde;

    if (d->status)
        return 0;
    _dos2unx(d->dta.dta_name, xde.d_name);
    xde.d_namlen = strlen(xde.d_name);
    if (FA_DIR & d->dta.dta_attribute)
	xde.size = -2;
    else
        xde.size = d->dta.dta_size;
    xde.time = _unixtime(d->dta.dta_time, d->dta.dta_date);
    d->status = Fsnext();
    return &xde;
}

void xclosedir(d)
XDIR *d;
{
    Fsetdta(olddta);
    xfree(d->dirname);
    xfree(d);
}
void xrewinddir(d)
XDIR *d;
{
    long status;

    Fsetdta(&d->dta);
    d->status = status = Fsfirst(d->dirname, 0xff);
}

#endif /* atarist */

#ifndef XDIR

struct xdirect {
	/* inode and position in directory aren't usable in a portable way,
	   so why support them anyway?
	 */
	short d_namlen;
	char  *d_name;
	int   size;
	int   time;
};

extern char *mud_lib;

#define XOPENDIR(dest, path) (\
    !chdir(path) &&\
    ((dest) = opendir(".")) ||\
	(chdir(mud_lib),MY_FALSE)\
)

#define xclosedir( dir_ptr) (chdir(mud_lib),closedir(dir_ptr))
#define xrewinddir(dir_ptr)  rewinddir(dir_ptr)
#define XDIR DIR

struct xdirect *xreaddir(dir_ptr, mask)
XDIR *dir_ptr;
int mask;
{
    static struct xdirect xde;
    struct generic_dirent *de;
    int namelen;
    struct stat st;

    de = readdir(dir_ptr);
    if (!de) return 0;
    namelen = DIRENT_NLENGTH(de);
    xde.d_namlen = namelen;
    xde.d_name   = de->d_name;
    if (mask & (2|4) ) {
	if (ixstat(xde.d_name, &st) == -1) { /* who knows... */
	    xde.size = -1;
	    xde.time = 0;
	} else {
	    if (S_IFDIR & st.st_mode)
		xde.size = -2;
	    else
        	xde.size = st.st_size;
	    xde.time = st.st_mtime;
	}
    }
    return &xde;
}
#endif /* XDIR */

/*
 * List files in directory. This function do same as standard list_files did,
 * but instead writing files right away to player this returns an array
 * containing those files. Actually most of code is copied from list_files()
 * function.
 * Differences with list_files:
 *
 *   - file_list("/w"); returns ({ "w" })
 *
 *   - file_list("/w/"); and file_list("/w/."); return contents of directory
 *     "/w"
 *
 *   - file_list("/");, file_list("."); and file_list("/."); return contents
 *     of directory "/"
 */
struct vector *get_dir(path, mask)
    char *path;
    int mask;
{
    struct vector *v, *w;
    int i,j, count = 0;
    XDIR *dirp;
    int namelen, do_match = 0;
    struct xdirect *de;
    struct stat st;
    char *temppath;
    char *p;
    char *regexp = 0;
    int nqueries;

    if (!path)
	return 0;

    path = check_valid_path(path, current_object, "get_dir", 0);

    if (path == 0)
	return 0;

    /*
     * We need to modify the returned path, and thus to make a
     * writeable copy.
     * The path "" needs 2 bytes to store ".\0".
     */
    temppath = (char *)alloca(strlen(path)+2);
    if (strlen(path)<2) {
	temppath[0]=path[0]?path[0]:'.';
	temppath[1]='\000';
	p = temppath;
    } else {
	strcpy(temppath, path);
	/*
	 * If path ends with '/' or "/." remove it
	 */
	if ((p = strrchr(temppath, '/')) == 0)
	    p = temppath;
	if (p[0] == '/' && p[1] == '.' && p[2] == '\0' || 
	    p[0] == '/' && p[1] == '\0')
	    *p = '\0';
    }

    nqueries = (mask&1) + (mask>>1 &1) + (mask>>2 &1);
    if (strchr(p, '*') || ixstat(temppath, &st) < 0) {
	if (*p == '\0')
	    return 0;
	regexp = (char *)alloca(strlen(p)+2);
	if (p != temppath) {
	    strcpy(regexp, p + 1);
	    *p = '\0';
	} else {
	    strcpy(regexp, p);
	    strcpy(temppath, ".");
	}
	do_match = 1;
    } else if (*p != '\0' && strcmp(temppath, ".")) {
	struct svalue *stmp;

	if (*p == '/' && *(p + 1) != '\0')
	    p++;
	v = allocate_array(nqueries);
	stmp = v->item;
	if (mask&1) {
	    stmp->type = T_STRING;
	    stmp->x.string_type = STRING_MALLOC;
	    stmp->u.string = string_copy(p);
	    stmp++;
	}
	if (mask&2) {
	    stmp->type = T_NUMBER;
	    stmp->u.number =  (S_IFDIR & st.st_mode) ? -2 : st.st_size;
	    stmp++;
	}
	if (mask&4) {
	    stmp->type = T_NUMBER;
	    stmp->u.number = st.st_mtime;
	    stmp++;
	}
	return v;
    }

    if ( XOPENDIR(dirp, temppath) == 0)
	return 0;

    /*
     *  Count files
     */
    for (de = xreaddir(dirp, 1); de; de = xreaddir(dirp, 1)) {
	namelen = de->d_namlen;
	if (do_match) {
	    if ( !match_string(regexp, de->d_name, namelen) )
		continue;
	} else {
	    if (namelen <= 2 && *de->d_name == '.' &&
		(namelen == 1 || de->d_name[1] == '.' ) )
		continue;
	}
	count += nqueries;
	if ( count >= MAX_ARRAY_SIZE)
	    break;
    }
    if (nqueries)
	count /= nqueries;
    /*
     * Make array and put files on it.
     */
    v = allocate_array(count * nqueries);
    if (count == 0) {
	/* This is the easy case :-) */
	xclosedir(dirp);
	return v;
    }
    xrewinddir(dirp);
    w = v;
    j = 0;
    /* Taken into account that files might be added/deleted from outside. */
    for(i = 0, de = xreaddir(dirp,mask); de; de = xreaddir(dirp,mask)) {

	namelen = de->d_namlen;
	if (do_match) {
	    if ( !match_string(regexp, de->d_name, namelen) )
		continue;
	} else {
	    if (namelen <= 2 && *de->d_name == '.' &&
		(namelen == 1 || de->d_name[1] == '.' ) )
		continue;
	}
	if (i >= count) {
	    struct vector *tmp, *new;
	    /* New file. Don't need efficience here, but consistence. */
	    count++;
	    tmp = allocate_array(nqueries);
	    new = add_array(v, tmp);
	    free_vector(v);
	    free_vector(tmp);
	    v = new;
	    w = v;
	}
	if (mask & 1) {
	    char *name;

	    if ( !(name = xalloc(namelen+1)) ) {
		xclosedir(dirp);
		free_vector(v);
		error("Out of memory\n");
	    }
	    if (namelen)
		memcpy(name, de->d_name, namelen);
	    name[namelen] = '\0';
	    w->item[j].type = T_STRING;
	    w->item[j].x.string_type = STRING_MALLOC;
	    w->item[j].u.string = name;
	    j++;
	}
	if (mask & 2) {
	    w->item[j].type = T_NUMBER;
	    w->item[j].u.number = de->size;
	    j++;
	}
	if (mask & 4) {
	    w->item[j].type = T_NUMBER;
	    w->item[j].u.number = de->time;
	    j++;
	}
	i++;
    }
    xclosedir(dirp);
    if ( !((mask ^ 1) & 0x21) ) {
	/* Sort by names. */
	qsort((char *)v->item, i, sizeof v->item[0] * nqueries, pstrcmp);
    }
    return v;
}

int tail(path)
    char *path;
{
    char buff[1000];
    FILE *f;
    struct stat st;
    int offset;
 
    path = check_valid_path(path, current_object, "tail", 0);

    if (path == 0)
        return 0;
    f = fopen(path, "r");
    if (f == 0)
	return 0;
    if (fstat(fileno(f), &st) == -1)
	fatal("Could not stat an open file.\n");
    if ( !S_ISREG(st.st_mode) ) {
	fclose(f);
	return 0;
    }
    offset = st.st_size - 54 * 20;
    if (offset < 0)
	offset = 0;
    if (fseek(f, offset, 0) == -1)
	fatal("Could not seek.\n");
    /* Throw away the first incomplete line. */
    if (offset > 0)
	(void)fgets(buff, sizeof buff, f);
    while(fgets(buff, sizeof buff, f)) {
	add_message("%s", buff);
    }
    fclose(f);
    return 1;
}

int print_file(path, start, len)
    char *path;
    int start, len;
{
    char buff[1000];
    FILE *f;
    int i;

    if (len < 0)
	return 0;

    path = check_valid_path(path, current_object, "print_file", 0);

    if (path == 0)
        return 0;
    if (start < 0)
	return 0;
    f = fopen(path, "r");
    if (f == 0)
	return 0;
    if (len == 0)
	len = MAX_LINES;
    if (len > MAX_LINES)
	len = MAX_LINES;
    if (start == 0)
	start = 1;
    for (i=1; i < start + len; i++) {
	if (fgets(buff, sizeof buff, f) == 0)
	    break;
	if (i >= start)
	    add_message("%s", buff);
    }
    fclose(f);
    if (i <= start)
	return 0;
    if (i == MAX_LINES + start)
	add_message("*****TRUNCATED****\n");
    return i-start;
}

int remove_file(path)
    char *path;
{
    path = check_valid_path(path, current_object, "remove_file", 1);

    if (path == 0)
        return 0;
    if (unlink(path) == -1)
        return 0;
    return 1;
}

void
print_svalue(arg)
    struct svalue *arg;
{
    if (arg == 0)
	add_message("<NULL>");
    else if (arg->type == T_STRING) {
	if (strlen(arg->u.string) > 9500)	/* Not pretty */
	    error("Too long string.\n");
	/* Strings sent to monsters are now delivered */
	if (command_giver && (command_giver->flags & O_ENABLE_COMMANDS) &&
	          !command_giver->interactive)
	    tell_npc(command_giver, arg->u.string);
	else
	    add_message("%s", arg->u.string);
    } else if (arg->type == T_OBJECT)
	add_message("OBJ(%s)", arg->u.ob->name);
    else if (arg->type == T_NUMBER)
	add_message("%d", arg->u.number);
    else if (arg->type == T_FLOAT) {
	char buff[40];

	sprintf(buff, "%g", READ_DOUBLE( arg ) );
	add_message(buff);
    } else if (arg->type == T_POINTER)
	add_message("<ARRAY>");
    else
	add_message("<UNKNOWN>");
}

void do_write(arg)
    struct svalue *arg;
{
    struct object *save_command_giver = command_giver;
    if (command_giver == 0 && current_object->shadowing)
	command_giver = current_object;
    if (command_giver) {
	/* Send the message to the first object in the shadow list */
	while (command_giver->shadowing)
	    command_giver = command_giver->shadowing;
    }
    print_svalue(arg);
    command_giver = check_object(save_command_giver);
}

/* Find an object. If not loaded, load it !
 * The object may selfdestruct, which is the only case when 0 will be
 * returned.
 */

struct object *find_object(str)
    char *str;
{
    struct object *ob;

    /* Remove leading '/' if any. */
    while(str[0] == '/')
	str++;
    ob = find_object2(str);
    if (ob)
	return ob;
    ob = load_object(str, 0, 60);
    if (ob->flags & O_DESTRUCTED)		/* *sigh* */
	return 0;
    if (ob && ob->flags & O_SWAPPED)
	load_ob_from_swap(ob);
    return ob;
}

/* Look for a loaded object. Return 0 if non found. */
struct object *find_object2(str)
    char *str;
{
    register struct object *ob;
    register int length;

    /* Remove leading '/' if any. */
    while(str[0] == '/')
	str++;
    /* Truncate possible .c in the object name. */
    length = strlen(str);
    if (str[length-2] == '.' && str[length-1] == 'c') {
	/* A new writreable copy of the name is needed. */
	char *p;
	p = (char *)alloca(strlen(str)+1);
	strcpy(p, str);
	str = p;
	str[length-2] = '\0';
    }
    if (ob = lookup_object_hash(str)) {
	if (ob->flags & O_SWAPPED)
	    load_ob_from_swap(ob);
	return ob;
    }
    return 0;
}

#if 0

void apply_command(com)
    char *com;
{
    struct value *ret;

    if (command_giver == 0)
	error("command_giver == 0 !\n");
    ret = apply(com, command_giver->super, 0);
    if (ret != 0) {
	add_message("Result:");
	if (ret->type == T_STRING)
	    add_message("%s\n", ret->u.string);
	if (ret->type == T_NUMBER)
	    add_message("%d\n", ret->u.number);
    } else {
	add_message("Error apply_command: function %s not found.\n", com);
    }
}
#endif /* 0 */


/*
 * Transfer an object.
 * The object has to be taken from one inventory list and added to another.
 * The main work is to update all command definitions, depending on what is
 * living or not. Note that all objects in the same inventory are affected.
 *
 * There are some boring compatibility to handle. When -o flag is specified,
 * several functions are called in some objects. This is dangerous, as
 * object might self-destruct when called.
 */
void move_object(item, dest)
    struct object *item, *dest;
{
    struct object **pp, *ob, *next_ob;
    struct object *save_cmd = command_giver;

#ifdef NATIVE_MODE
    if (item != current_object)
	error("Illegal to move other object than this_object()\n");
#endif
    /* Recursive moves are not allowed. */
    for (ob = dest; ob; ob = ob->super)
	if (ob == item)
	    error("Can't move object inside itself.\n");
    if (item->shadowing)
	error("Can't move an object that is shadowing.\n");

#if 0 /* Not now /Lars */
    /*
     * Objects must have inherited std/object if they are to be allowed to
     * be moved.
     */
#ifdef NATIVE_MODE
    if (!(item->flags & O_APPROVED) ||
		    !(dest->flags & O_APPROVED)) {
	error("Trying to move object where src or dest not inherit std/object\n");
	return;
    }
#endif    
#endif
#ifndef NATIVE_MODE
	/* This is not needed in native mode. In the latter, objects can only
	 * move themselves.
	 */
	dest->flags &= ~O_RESET_STATE;
	item->flags &= ~O_RESET_STATE;
#endif
    add_light(dest, item->total_light);
    if (item->super) {
	int okey = 0;
		
	if (item->sent) {
	    void remove_environment_sent PROT((struct object *));

#ifdef COMPAT_MODE
		command_giver = item;
		if (command_giver->interactive)
		    trace_level |= command_giver->interactive->trace_level;
		push_object(item);
		(void)sapply("exit", item->super, 1);
		if (item->flags & O_DESTRUCTED || dest->flags & O_DESTRUCTED)
		    return;	/* Give up */
#endif
	    remove_environment_sent(item);
	}
	if (item->super->sent)
	    remove_sent(item, item->super);
	add_light(item->super, - item->total_light);
	for (pp = &item->super->contains; *pp;) {
	    if (*pp != item) {
		if ((*pp)->sent)
		    remove_sent(item, *pp);
		pp = &(*pp)->next_inv;
		continue;
	    }
	    *pp = item->next_inv;
	    okey = 1;
	}
	if (!okey)
	    fatal("Failed to find object %s in super list of %s.\n",
		  item->name, item->super->name);
    }
    item->next_inv = dest->contains;
    dest->contains = item;
    item->super = dest;
    /*
     * Setup the new commands. The order is very important, as commands
     * in the room should override commands defined by the room.
     * Beware that init() in the room may have moved 'item' !
     *
     * The call of init() should really be done by the object itself
     * (except in the -o mode). It might be too slow, though :-(
     */
    if (item->flags & O_ENABLE_COMMANDS) {
	command_giver = item;
	if (command_giver->interactive)
	    trace_level |= command_giver->interactive->trace_level;
	(void)sapply("init", dest, 0);
	if ((dest->flags & O_DESTRUCTED) || item->super != dest) {
	    command_giver =  		/* marion */
	        check_object(save_cmd); /* amylaar */
	    return;
	}
    }
    /*
     * Run init of the item once for every present player, and
     * for the environment (which can be a player).
     */
    for (ob = dest->contains; ob; ob=next_ob) {
	next_ob = ob->next_inv;
	/* ob can cause some confusion when it moves next_inventory() ,
	 * but nothing that destroys gamedriver consistency. Infinite loops
	 * are prevented by the eval_cost too big error.
	 */
	if (ob == item)
	    continue;
	if ( (ob->flags | item->flags) & O_DESTRUCTED)
	    error("An object was destructed at call of init()\n");
	if (ob->flags & O_ENABLE_COMMANDS) {
	    command_giver = ob;
	    if (command_giver->interactive)
		trace_level |= command_giver->interactive->trace_level;
	    (void)sapply("init", item, 0);
	    if (dest != item->super) {
	        command_giver =  	    /* marion */
	            check_object(save_cmd); /* amylaar */
		return;
	    }
	}
	if (item->flags & O_DESTRUCTED) /* marion */
	    error("The object to be moved was destructed at call of init()\n");
	if (item->flags & O_ENABLE_COMMANDS) {
	    command_giver = item;
	    if (command_giver->interactive)
		trace_level |= command_giver->interactive->trace_level;
	    if (ob->flags & O_DESTRUCTED)
		error("An object was destructed at call of init()\n");
	    (void)sapply("init", ob, 0);
	    if (dest != item->super) {
	        command_giver =  	    /* marion */
	            check_object(save_cmd); /* amylaar */
		return;
	    }
	}
    }
    if (dest->flags & O_DESTRUCTED) /* marion */
	error("The destination to move to was destructed at call of init()\n");
    if (dest->flags & O_ENABLE_COMMANDS) {
	command_giver = dest;
	if (command_giver->interactive)
	    trace_level |= command_giver->interactive->trace_level;
	(void)sapply("init", item, 0);
    }
    command_giver = check_object(save_cmd);
}

/*
 * Every object as a count of number of light sources it contains.
 * Update this.
 */

void add_light(p, n)
    struct object *p;
    int n;
{
    if (n == 0)
	return;
    p->total_light += n;
    if (p->super)
	add_light(p->super, n);
}

struct sentence *sent_free = 0;
int tot_alloc_sentence;

struct sentence *alloc_sentence() {
    struct sentence *p;

    if (sent_free == 0) {
	p = (struct sentence *)xalloc(sizeof *p);
	tot_alloc_sentence++;
    } else {
	p = sent_free;
	sent_free = sent_free->next;
    }
    p->verb = 0;
    return p;
}

void free_all_sent() {
    struct sentence *p;
    for (;sent_free; sent_free = p) {
	p = sent_free->next;
	xfree((char *)sent_free);
	tot_alloc_sentence--;
    }
}

void free_sentence(p)
    struct sentence *p;
{
    free_string(p->function);
    if (p->verb)
	free_string(p->verb);
    p->next = sent_free;
    sent_free = p;
}

static struct marked_command_giver {

    struct object *object;
    struct error_recovery_info *erp;
    struct sentence *marker;           /* when at the end of the sentence
					* chain, the marker is referenced here.
					*/
    struct marked_command_giver *next;
} *last_marked = 0;

static void pop_marked_command_giver()
{
    struct marked_command_giver *tmp;

    tmp = last_marked;
    last_marked = tmp->next;
    xfree( (char *)tmp);
}

/*
 * Find the sentence for a command from the player.
 * Return success status.
 */
int player_parser(buff)
    char *buff;
{
    struct sentence *s;
    char *p;
    int length;
    struct object *save_current_object = current_object;
    struct object *save_command_giver  = command_giver;
    char *shared_verb;
    struct sentence *mark_sentence;

#ifdef DEBUG
    if (d_flag > 1)
	debug_message("cmd [%s]: %s\n", command_giver->name, buff);
#endif
    /* strip trailing spaces. */
    for (p = buff + strlen(buff) - 1; p >= buff; p--) {
	if (*p != ' ')
	    break;
	*p = '\0';
    }
    if (buff[0] == '\0')
	return 0;
    if (special_parse(buff))
	return 1;
    length = (int)p;
    p = strchr(buff, ' ');
    if (p == 0) {
	length += 1 - (int)buff;
	shared_verb = make_shared_string(buff);
    } else {
	*p = '\0';
	shared_verb = make_shared_string(buff);
	*p = ' ';
	length = p - buff;
    }
    clear_notify();
    mark_sentence = alloc_sentence();
    {
	/* mark the command_giver as having a sentence of type SENT_MARKER
	 * in the current error recovery context.
	 */

	struct marked_command_giver *new_marked;

	new_marked = (struct marked_command_giver *)xalloc(sizeof *new_marked);
	new_marked->object = command_giver;
	new_marked->erp = error_recovery_pointer;
	new_marked->marker = 0;
	new_marked->next = last_marked;
	last_marked = new_marked;
    }
    for (s = command_giver->sent; s; s = s->next) {
	struct svalue *ret;
	struct object *command_object;
	unsigned char type;
	struct sentence *next; /* used only as flag */
	
	if ((type = s->type) == SENT_PLAIN) {
	    if (s->verb != shared_verb)
		continue;
	} else if (type == SENT_SHORT_VERB) {
	    int len;
	    len = strlen(s->verb);
	    if (strncmp(s->verb, buff, len) != 0)
		continue;
	} else if (type == SENT_NO_SPACE) {
	    int len;
	    len = strlen(s->verb);
	    if(strncmp(buff, s->verb,len) != 0)
		continue;
	} else if (type == SENT_NO_VERB) {
	    /* Give an error only the first time we scan this sentence */
	    if (s->short_verb)
		continue;
	    s->short_verb++;
	    error("An 'action' had an undefined verb.\n");
	} else {
	    /* SENT_MARKER ... due to recursion. */
	    continue;
	}
	/*
	 * Now we have found a special sentence !
	 */
#ifdef DEBUG
	if (d_flag > 1)
	    debug_message("Local command %s on %s\n", s->function, s->ob->name);
#endif
	last_verb = shared_verb;
	/*
	 * If the function is static and not defined by current object,
	 * then it will fail. If this is called directly from player input,
	 * then we set current_object so that static functions are allowed.
	 * current_object is reset just after the call to apply().
	 */
	if (current_object == 0)
	    current_object = s->ob;
	/*
	 * Remember the object, to update score.
	 */
	command_object = s->ob;

	/* if we get an error, we want the verb to be freed */
	mark_sentence->function = shared_verb;
	mark_sentence->verb = 0;
	if ( !(next = s->next) ) {
	    mark_sentence->next = 0;
	    last_marked->marker = mark_sentence;
	    /* Since new commands are always added at the start, the end
	     * will remain the end. So there's no need to clear
	     * last_marked->marker again.
	     */
	} else {
	    /* Place the marker, so we can continue the search, no matter what
	     * the object does. But beware, if the command_giver is destructed,
	     * the marker will be freed.
	     * Take care not to alter marker addresses.
	     */
	    if (next->type == SENT_MARKER) {
		struct sentence *insert;

		do {
		    insert = next;
		    next = next->next;
		    if (!next) {
			last_marked->marker = mark_sentence;
			break;
		    }
		} while (next->type == SENT_MARKER);
		if (next)
		    insert->next = mark_sentence;
	    } else {
		s->next = mark_sentence;
	    }
	    mark_sentence->ob = (struct object *)error_recovery_pointer;
	    mark_sentence->next = next;
	    mark_sentence->type = SENT_MARKER;
	}

	if(s->type == SENT_NO_SPACE) {
	    push_volatile_string(&buff[strlen(s->verb)]);
	    ret = sapply(s->function, s->ob, 1);
	} else if (buff[length] == ' ') {
	    push_volatile_string(&buff[length+1]);
	    ret = sapply(s->function, s->ob, 1);
	} else {
	    ret = sapply(s->function, s->ob, 0);
	}
	current_object = save_current_object;
	command_giver  = save_command_giver;
	if (ret == 0) {
	    add_message("Error: function %s not found.\n", s->function);
	    if (next) {
		while (s->next != mark_sentence) s = s->next;
		s->next = mark_sentence->next;
	    }
	    break;
	}
	/* s might be a dangling pointer right now. */
	if (command_giver->flags & O_DESTRUCTED) {
	    /* the marker has been freed by destruct_object unless... */
	    if (!next) {
		free_sentence(mark_sentence);
	    }
	    pop_marked_command_giver();
	    command_giver = 0;
	    return 1;
	}

	/* remove the marker from the sentence chain, and make s->next valid */
	if ( (s = mark_sentence->next) && s->type != SENT_MARKER) {
	    *mark_sentence = *s;
	    s->next = mark_sentence;
	    mark_sentence = s;
	} else {
	    if (next) {
		/* !s : there have been trailing sentences before, but all
		 * have been removed.
		 * s->type == SENT_MARKER : There was a delimiter sentence
		 * between the two markers, which has been removed.
		 */
		struct sentence **pp;

		for (pp = &command_giver->sent; (s = *pp) != mark_sentence; )
		    pp = &s->next;
		*pp = s->next;
	    }
	    s = mark_sentence;
	}
	/* If we get fail from the call, it was wrong second argument. */
	if (ret->type == T_NUMBER && ret->u.number == 0) {
	    continue;
	}
	if (command_object->user && command_giver->interactive &&
	    !(command_giver->flags & O_IS_WIZARD))
	{
	    command_object->user->score++;
	}
	break;
    }
    last_verb = 0;
    /* free marker and verb */
    mark_sentence->verb = 0;
    mark_sentence->function = shared_verb;
    free_sentence(mark_sentence);
    pop_marked_command_giver();
    if (s == 0) {
	notify_no_command();
	return 0;
    }
    return 1;
}

/*
 * Associate a command with function in this object.
 * The optional second argument is the command name. If the command name
 * is not given here, it should be given with add_verb().
 *
 * The optinal third argument is a flag that will state that the verb should
 * only match against leading characters.
 *
 * The object must be near the command giver, so that we ensure that the
 * sentence is removed when the command giver leaves.
 *
 * If the call is from a shadow, make it look like it is really from
 * the shadowed object.
 */
int add_action(func, cmd, flag)
    struct svalue *func, *cmd;
    int flag;
{
    struct sentence *p;
    struct object *ob;
    char *str;
    short string_type;

    if (current_object->flags & O_DESTRUCTED)
	return -1;
    ob = current_object;
    if (ob->shadowing) {
        str = findstring(func->u.string);
        do {
            ob = ob->shadowing;
	    if (find_function(str, ob->prog) >= 0) {
		extern struct svalue *inter_sp;

		if ( !privilege_violation4(
		    "shadow_add_action", ob, str, inter_sp)
		)
		    return -1;
	    }
        } while(ob->shadowing);
    }
    if (command_giver == 0 || (command_giver->flags & O_DESTRUCTED))
	return -1;
    if (ob != command_giver && ob->super != command_giver &&
	ob->super != command_giver->super && ob != command_giver->super)
      error("add_action from object that was not present.\n");
    str = func->u.string;
#ifdef DEBUG
    if (d_flag > 1)
	debug_message("--Add action %s\n", str);
#endif
    if (*str == ':')
	error("Illegal function name: %s\n", str);
#ifdef COMPAT_MODE
    if (*str++=='e' && *str++=='x' && *str++=='i' && *str++=='t' && !*str)
	error("Illegal to define a command to the exit() function.\n");
#endif
    p = alloc_sentence();
    str = func->u.string;
    if ((string_type = func->x.string_type) != STRING_SHARED) {
	char *str2;
	str = make_shared_string(str2 = str);
	if (string_type == STRING_MALLOC) {
	    xfree(str2);
	}
    }
    p->function = str;
    p->ob = ob;
    p->next = command_giver->sent;
    if (cmd) {
	str = cmd->u.string;
	if ((string_type = cmd->x.string_type) != STRING_SHARED) {
	    char *str2;
	    str = make_shared_string(str2 = str);
	    if (string_type == STRING_MALLOC) {
		xfree(str2);
	    }
	}
	p->verb = str;
	p->type = SENT_PLAIN;
	if (flag) {
	    p->type = SENT_SHORT_VERB;
	    p->short_verb = flag;
	    if (flag == 2)
		p->type = SENT_NO_SPACE;
	}
    } else {
	p->short_verb = 0;
	p->verb = 0;
	p->type = SENT_NO_VERB;
    }
    command_giver->sent = p;
    return 0;
}

void add_verb(str, no_space)
    char *str;
    int no_space;
{
    if (command_giver == 0 || (command_giver->flags & O_DESTRUCTED))
	return;
    if (command_giver->sent == 0)
	error("No add_action().\n");
    if (command_giver->sent->verb != 0)
	error("Tried to set verb again.\n");
    command_giver->sent->verb = make_shared_string(str);
    command_giver->sent->type = no_space ? SENT_NO_SPACE : SENT_PLAIN;
    if (d_flag > 1)
	debug_message("--Adding verb %s to action %s\n", str,
		command_giver->sent->function);
}

/*
 * Remove all commands (sentences) defined by object 'ob' in object
 * 'player'
 */
void remove_sent(ob, player)
    struct object *ob, *player;
{
    struct sentence **s;

    for (s= &player->sent; *s;) {
	struct sentence *tmp;
	if ((*s)->ob == ob) {
#ifdef DEBUG
	    if (d_flag > 1)
		debug_message("--Unlinking sentence %s\n", (*s)->function);
#endif
	    tmp = *s;
	    *s = tmp->next;
	    free_sentence(tmp);
	} else
	    s = &((*s)->next);
    }
}

/*
 * Remove all commands (sentences) defined by objects that have the same
 * environment as object 'player' in object 'player'
 */
void remove_environment_sent(player)
    struct object *player;
{
    struct sentence **p, *s;
    struct object *super, *ob;

    super = player->super;
    p= &player->sent;
    if (s = *p) for(;;) {
	ob = s->ob;
	if ((s->type != SENT_MARKER && ob->super == super && ob != player) ||
	    ob == super )
	{
	    do {
		struct sentence *tmp;

#ifdef DEBUG
		if (d_flag > 1)
		    debug_message("--Unlinking sentence %s\n", s->function);
#endif
		tmp = s;
		s = s->next;
		free_sentence(tmp);
		if (!s) {
		    *p = 0;
		    return;
		}
	    } while (s->ob == ob);
	    *p = s;
	} else {
	    do {
		p = &s->next;
		if (!(s = *p)) return;
	    } while (s->ob == ob);
	}
    }
}

void no_op(p, size)
    char *p;
    long size;
{
}

void show_memory_block(p, size)
    char *p;
    long size;
{
    add_message("adress: 0x%x size: 0x%x '%.*s'\n", (long)p, size, size, p);
}

int status_parse(buff)
    char *buff;
{
    if (*buff == 0 || strcmp(buff, "tables") == 0) {
	int tot, res, verbose = 0;
	extern char *reserved_user_area, *reserved_master_area,
		    *reserved_system_area;
	extern mp_int reserved_user_size, reserved_master_size,
		      reserved_system_size;
	extern int tot_alloc_sentence, tot_alloc_object,
		tot_alloc_object_size, num_swapped, total_bytes_swapped,
		num_arrays, total_array_size;
	extern mp_int total_num_prog_blocks, total_prog_block_size;
#ifdef COMM_STAT
	extern int add_message_calls,inet_packets,inet_volume;
#endif
#ifdef APPLY_CACHE_STAT
	extern int apply_cache_hit, apply_cache_miss;
#endif
#if defined( COMM_STAT ) || defined( APPLY_CACHE_STAT )
	/* passing floats/doubles to add_message is not portable */

	char print_buff[90];
#endif
#ifdef MAPPINGS
	extern mp_int total_mapping_size PROT((void));
	extern mp_int num_mappings;
#endif

	if (strcmp(buff, "tables") == 0)
	    verbose = 1;
	res = 0;
	if (reserved_user_area)
	    res = reserved_user_size;
	if (reserved_master_area)
	    res += reserved_master_size;
	if (reserved_system_area)
	    res += reserved_system_size;
	if (!verbose) {
	    add_message("Sentences:\t\t\t%8d %8d\n", tot_alloc_sentence,
			tot_alloc_sentence * sizeof (struct sentence));
	    add_message("Objects:\t\t\t%8d %8d\n",
			tot_alloc_object, tot_alloc_object_size);
	    add_message("Arrays:\t\t\t\t%8d %8d\n", num_arrays,
			total_array_size);
#ifdef MAPPINGS
	    add_message("Mappings:\t\t\t%8d %8d\n", num_mappings,
			total_mapping_size() );
#endif
	    add_message("Prog blocks:\t\t\t%8d %8d (%d swapped, %d Kbytes)\n",
			total_num_prog_blocks, total_prog_block_size,
			num_swapped, total_bytes_swapped / 1024);
	    add_message("Memory reserved:\t\t\t %8d\n", res);
	}
	if (verbose) {
#ifdef COMM_STAT
	    sprintf(print_buff,
	      "Calls to add_message: %d   Packets: %d   Average packet size: %.2f\n\n",
	      add_message_calls,
	      inet_packets,
	      (float)inet_volume/(float)inet_packets
	    );
	    add_message(print_buff);
#endif
#ifdef APPLY_CACHE_STAT
	    sprintf(print_buff,
	      "Calls to apply_low: %d Cache hits: %.2f%%%%\n\n",
	      apply_cache_hit+apply_cache_miss,
	      100.*(float)apply_cache_hit/
		(float)(apply_cache_hit+apply_cache_miss) );
	    add_message(print_buff);
#endif
	    stat_living_objects();
	}
	tot =		   total_prog_block_size +
			   total_array_size +
			   tot_alloc_object_size +
			   show_otable_status(verbose) +
			   heart_beat_status(verbose) +
			   add_string_status(verbose) +
			   print_call_out_usage(verbose) +
#ifdef MAPPINGS
			   total_mapping_size() +
#endif
			   res;

	if (!verbose) {
	    add_message("\t\t\t\t\t --------\n");
	    add_message("Total:\t\t\t\t\t %8d\n", tot);
	}
	return 1;
    }
    if (strcmp(buff, "swap") == 0) {
	extern mp_int num_swapped, total_bytes_swapped,
	  num_swapfree, total_bytes_swapfree,
	  swapfile_size, total_swap_reused;
	add_message("\
%4d prog blocks swapped,%13d bytes\n\
%4d free prog blocks in swap,%8d bytes\n\
Swapfile size:%24d bytes\n\
Total reused space:%19d bytes\n",
	  num_swapped, total_bytes_swapped,
	  num_swapfree, total_bytes_swapfree,
	  swapfile_size,
	  total_swap_reused
	);
	return 1;
    }
    return 0;
}

/*
 * Hard coded commands, that will be available to all players. They can not
 * be redefined, so the command name should be something obscure, not likely
 * to be used in the game.
 */

char debug_parse_buff[50]; /* Used for debugging */

int first_showsmallnewmalloced_call = 1;

int special_parse(buff)
    char *buff;
{
#ifdef DEBUG
    strncpy(debug_parse_buff, buff, sizeof debug_parse_buff);
    debug_parse_buff[sizeof debug_parse_buff - 1] = '\0';
#endif
    if (strcmp(buff, "malloc") == 0) {
#if defined(MALLOC_malloc) || defined(MALLOC_smalloc)
	dump_malloc_data();
#endif
#ifdef MALLOC_gmalloc
	add_message("Using Gnu malloc.\n");
#endif
#ifdef MALLOC_sysmalloc
	add_message("Using system standard malloc.\n");
#endif
	return 1;
    }
    if (!is_wizard_used || command_giver->flags & O_IS_WIZARD) {
	if (strcmp(buff, "dumpallobj") == 0) {
            dumpstat();
	    return 1;
	}
#ifdef OPCPROF /* amylaar */
	if (strcmp(buff,  "opcdump") == 0) {
	    opcdump();
	    return 1;
	}
#endif
#if defined(MALLOC_malloc) || defined(MALLOC_smalloc)
	if (strcmp(buff,  "showsmallnewmalloced") == 0) {
	    extern void walk_new_small_malloced
		PROT(( void (*)(char *, long) ));

#if !defined(DEBUG) || defined(SHOWSMALLNEWMALLOCED_RESTRICTED)
	    struct svalue *arg;
	    push_constant_string("inspect memory");
	    arg = apply_master_ob("query_player_level", 1);
	    if (arg && (arg->type != T_NUMBER || arg->u.number != 0))
#endif
	    {
		if (first_showsmallnewmalloced_call) {
		    add_message("No previous call. please redo.\n");
		    walk_new_small_malloced(no_op);
		    first_showsmallnewmalloced_call = 0;
		} else {
		    walk_new_small_malloced(show_memory_block);
		}
	    }
	    return 1;
	}
	if (strcmp(buff, "debugmalloc") == 0) {
	    extern int debugmalloc;
	    debugmalloc = !debugmalloc;
	    if (debugmalloc)
		add_message("On.\n");
	    else
		add_message("Off.\n");
	    return 1;
	}
#endif /* MALLOC_(s)malloc */
	if (strncmp(buff, "status", 6) == 0)
	    return status_parse(buff+6+(buff[6]==' '));
    } /* end of wizard-only spacial parse commands */
    if (command_giver->interactive &&
	command_giver->interactive->modify_command )
    {
	struct svalue *svp;
	struct object *ob = command_giver->interactive->modify_command;

	if (ob->flags & O_DESTRUCTED) {
	    command_giver->interactive->modify_command = 0;
	    free_object(ob, "modify_command");
	    return 0;
	}
	push_volatile_string(buff);
	svp = sapply( "modify_command", ob, 1);
	if (!svp) return 0;
	if (command_giver) {
	    if (svp->type == T_STRING) {
		strncpy(buff, svp->u.string, COMMAND_FOR_OBJECT_BUFSIZE-1);
		buff[COMMAND_FOR_OBJECT_BUFSIZE-1] = '\0';
	    } else if (svp->type == T_NUMBER && svp->u.number)
		return 1;
	} else
	    /* the command_giver has been destructed */
	    return 1;
    } else {
	if (strcmp(buff, "e") == 0) {
	    (void)strcpy(buff, "east");
	    return 0;
	}
	if (strcmp(buff, "w") == 0) {
	    (void)strcpy(buff, "west");
	    return 0;
	}
	if (strcmp(buff, "s") == 0) {
	    (void)strcpy(buff, "south");
	    return 0;
	}
	if (strcmp(buff, "n") == 0) {
	    (void)strcpy(buff, "north");
	    return 0;
	}
	if (strcmp(buff, "d") == 0) {
	    (void)strcpy(buff, "down");
	    return 0;
	}
	if (strcmp(buff, "u") == 0) {
	    (void)strcpy(buff, "up");
	    return 0;
	}
	if (strcmp(buff, "nw") == 0) {
	    (void)strcpy(buff, "northwest");
	    return 0;
	}
	if (strcmp(buff, "ne") == 0) {
	    (void)strcpy(buff, "northeast");
	    return 0;
	}
	if (strcmp(buff, "sw") == 0) {
	    (void)strcpy(buff, "southwest");
	    return 0;
	}
	if (strcmp(buff, "se") == 0) {
	    (void)strcpy(buff, "southeast");
	    return 0;
	}
    }
    return 0;
}

struct vector *get_action(ob, verb)
    struct object *ob;
    char *verb;
{
    struct vector *v;
    struct sentence *s;
    struct svalue *p;

    if ( !(verb = findstring(verb)) ) return NULL;
    for (s = ob->sent; s; s = s->next) {
        if (verb != s->verb) continue;
	/* verb will be 0 for SENT_MARKER */

	v = allocate_array(4);
	p = v->item;

	p->u.number = s->type;
	p++;
	p->u.number = s->type != SENT_PLAIN ? s->short_verb : 0;
	p++;
	p->type = T_OBJECT;
	add_ref((p->u.ob = s->ob), "get_action");
	p++;
	p->type = T_STRING;
	p->x.string_type = STRING_SHARED;
	increment_string_ref(p->u.string = s->function);

	return v;
    }
    /* not found */
    return NULL;
}

struct vector *get_all_actions(ob, mask)
    struct object *ob;
    int mask;
{
    struct vector *v;
    struct sentence *s;
    int num;
    struct svalue *p;
    int nqueries;

    nqueries = ((mask>>1) & 0x55) + (mask & 0x55);
    nqueries = ((nqueries>>2) & 0x33) + (nqueries & 0x33);
    nqueries = ((nqueries>>4) & 0x0f) + (nqueries & 0x0f);
    num = 0;
    for (s = ob->sent; s; s = s->next) {
	if (s->type == SENT_MARKER)
	    continue;
	num += nqueries;
    }

    v = allocate_array(num);
    p = v->item;
    for (s = ob->sent; s; s = s->next)
    {
	if (s->type == SENT_MARKER)
	    continue;
	if (mask & 1) {
	    if (p->u.string = s->verb) {
		increment_string_ref(p->u.string);
		p->type = T_STRING;
		p->x.string_type = STRING_SHARED;
	    }
	    p++;
	}
	if (mask & 2) {
	    p->u.number = s->type;
	    p++;
	}
	if (mask & 4) {
	    p->u.number = s->short_verb;
	    p++;
	}
	if (mask & 8) {
	    p->type = T_OBJECT;
	    add_ref((p->u.ob = s->ob), "get_action");
	    p++;
	}
	if (mask & 16) {
	    p->type = T_STRING;
	    p->x.string_type = STRING_SHARED;
	    increment_string_ref(p->u.string = s->function);
	    p++;
	}
    }
    
    return v;  
}

struct vector *get_object_actions(ob1, ob2)
    struct object *ob1;
    struct object *ob2;
{
    struct vector *v;
    struct sentence *s;
    int num;
    struct svalue *p;

    num = 0;
    for (s = ob1->sent; s; s = s->next)
        if (s->ob == ob2) num += 2;

    v = allocate_array(num);
    p = v->item;
    for (s = ob1->sent; s; s = s->next)
    {
        if (s->ob == ob2) {
            increment_string_ref(p->u.string = s->verb);
            p->type = T_STRING;
            p->x.string_type = STRING_SHARED;
            p++;

            p->type = T_STRING;
            p->x.string_type = STRING_SHARED;
            increment_string_ref(p->u.string = s->function);
            p++;
        }
    }
    return v;
}

#if defined(AMIGA)
VOLATILE void fatal(char *fmt, ...)
#else
/*VARARGS1*/
VOLATILE void fatal(fmt, a, b, c, d, e, f, g, h)
    char *fmt;
    int a, b, c, d, e, f, g, h;
#endif
{
#if defined(AMIGA)
    va_list va;
#endif
    static int in_fatal = 0;
    /* Prevent double fatal. */
    if (in_fatal)
	abort();
#if defined(AMIGA)
    va_start(va, fmt);
#endif
    in_fatal = 1;
    fflush(stdout);
#if defined(AMIGA)
    (void)vfprintf(stderr, fmt, va);
#else
    (void)fprintf(stderr, fmt, a, b, c, d, e, f, g, h);
#endif
    fflush(stderr);
    if (current_object)
	(void)fprintf(stderr, "Current object was %s\n",
		      current_object->name);
#if defined(AMIGA)
    debug_message(fmt, va);
#else
    debug_message(fmt, a, b, c, d, e, f, g, h);
#endif
    if (current_object)
	debug_message("Current object was %s\n", current_object->name);
    debug_message("Dump of variables:\n");
    (void)dump_trace(1);
    fflush(stdout);
    sleep(1); /* let stdout settle down... abort can ignore the buffer... */
#if defined(AMIGA)
    va_end(va);
#endif
#ifdef linux
    /* abort makes bad cores, signals give nice ones. */
    *(char*)0 = a/0;
#endif
    abort();
}

int num_error = 0;
char *current_error, *current_error_file, *current_error_object_name;
mp_int current_error_line_number;

/*
 * Error() has been "fixed" so that users can catch and throw them.
 * To catch them nicely, we really have to provide decent error information.
 * Hence, all errors that are to be caught
 * (error_recovery_pointer->type == ERROR_RECOVERY_CATCH)
 * construct a string containing the error message, which is returned as the
 * thrown value.  Users can throw their own error values however they choose.
 */

static void remove_command_giver_markers()
{
    struct marked_command_giver *m;

    while ( (m = last_marked) && m->erp == error_recovery_pointer) {
	if (m->marker) {
	    free_sentence(m->marker);
	} else {
	    remove_sent( (struct object *)error_recovery_pointer, m->object);
	}
	last_marked = m->next;
	xfree( (char *)m);
    }
}

/*
 * This is here because throw constructs its own return value; we dont
 * want to replace it with the system's error string.
 */

void throw_error() {
    extern struct svalue catch_value;

    if (error_recovery_pointer->type >= ERROR_RECOVERY_CATCH) {
	remove_command_giver_markers();
	longjmp(error_recovery_pointer->context, 1);
	fatal("Throw_error failed!");
    }
    free_svalue(&catch_value);
    catch_value.type = T_INVALID;
    error("Throw with no catch.\n");
}

static char emsg_buf[2000];

#if defined(AMIGA)
VOLATILE void error(char *fmt, ...)
#else
/*VARARGS1*/
VOLATILE void error(fmt, a, b, c, d, e, f, g, h)
    char *fmt;
    int a, b, c, d, e, f, g, h;
#endif
{
    extern void assign_eval_cost();
    extern struct object *current_heart_beat;
    extern struct svalue catch_value;
    extern int out_of_memory;

    char *object_name;
    struct object *save_cmd;
    struct svalue *svp;
    int do_save_error;
    char *file, *malloced_error, *malloced_file = 0, *malloced_name = 0;
    mp_int line_number;
#if defined(AMIGA)
    int a;
    va_list va;
#endif

#if defined(AMIGA)
    va_start(va, fmt);
#endif
    if (current_object)
	assign_eval_cost();
    remove_command_giver_markers();
    if (num_error && error_recovery_pointer->type <= ERROR_RECOVERY_APPLY) {
	static char *times_word[] = {
	  "",
	  "Double",
	  "Triple",
	  "Quadruple",
	};
	debug_message(
	  "%s fault, last error was: %s",
	  times_word[num_error],
	  emsg_buf + 1
	);
    }
#if defined(AMIGA)
    vsprintf(emsg_buf+1, fmt, va);
    va_end(va);
#else
    sprintf(emsg_buf+1, fmt, a, b, c, d, e, f, g, h);
#endif
    emsg_buf[0] = '*';	/* all system errors get a * at the start */
    if (error_recovery_pointer->type >= ERROR_RECOVERY_CATCH) {
	/* user catches this error */
	catch_value.type = T_STRING;
	catch_value.x.string_type = STRING_MALLOC;	/* Always reallocate */
	catch_value.u.string = string_copy(emsg_buf);
   	longjmp(error_recovery_pointer->context, 1);
   	fatal("Catch() longjump failed");
    }
    num_error++;
    if (num_error > 3)
	fatal("Too many simultaneous errors.\n");
    debug_message("%s", emsg_buf+1);
    do_save_error = 0;
    if ( malloced_error = xalloc(strlen(emsg_buf)/* -1 for *, +1 for \0 */) ) {
	strcpy(malloced_error, emsg_buf+1);
    }
    if (current_object) {
	line_number = get_line_number_if_any(&file);
	debug_message("program: %s, object: %s line %d\n",
		    file,
		    current_object->name,
		    line_number);
	if (current_prog && num_error < 3) {
	    do_save_error = 1;
	}
	if ( malloced_file = xalloc(strlen(file) + 1) ) {
	    strcpy(malloced_file, file);
	}
	if ( malloced_name = xalloc(strlen(current_object->name) + 1) ) {
	    strcpy(malloced_name, current_object->name);
	}
    }
    object_name = dump_trace(num_error == 3);
    fflush(stdout);
    if (error_recovery_pointer->type == ERROR_RECOVERY_APPLY) {
	printf("error in apply_master_ob: %s", emsg_buf+1);
	if (current_object) {
	    printf("program: %s, object: %s line %d\n",
	      file,
	      current_object->name,
	      line_number
	    );
	}
	current_error = malloced_error;
	current_error_file = malloced_file;
	current_error_object_name = malloced_name;
	current_error_line_number = line_number;
	if (out_of_memory) {
	    if (malloced_error)
		xfree(malloced_error);
	    if (malloced_file)
		xfree(malloced_file);
	    if (malloced_name)
		xfree(malloced_name);
	}
	longjmp(error_recovery_pointer->context, 1);
    }
    /* 
     * The stack must be brought in a usable state. After the
     * call to reset_machine(), all arguments to error() are invalid,
     * and may not be used any more. The reason is that some strings
     * may have been on the stack machine stack, and have been deallocated.
     */
    reset_machine (0);
    if (do_save_error) {
	save_error(emsg_buf, file, line_number);
    }
    if (object_name) {
	struct object *ob;
	ob = find_object2(object_name);
	if (!ob) {
	    if (command_giver && num_error < 2)
		add_message("error when executing program in destroyed object %s\n",
			    object_name);
	    debug_message("error when executing program in destroyed object %s\n",
			object_name);
	}
    }
    if (num_error == 3) {
	debug_message("Master failure: %s", emsg_buf+1);
    } else if (!out_of_memory) {
	extern int32 eval_cost, assigned_eval_cost;

	assigned_eval_cost = eval_cost -= MASTER_RESERVED_COST;
	push_volatile_string(malloced_error);
	a = 1;
	if (current_object) {
	    push_volatile_string(malloced_file);
	    push_volatile_string(malloced_name);
	    push_number(line_number);
	    a += 3;
	}
	save_cmd = command_giver;
	apply_master_ob("runtime_error", a);
	command_giver = save_cmd;
	if (current_heart_beat) {
	    struct object *culprit;

	    culprit = current_heart_beat;
	    current_heart_beat = 0;
	    set_heart_beat(culprit, 0);
	    debug_message("Heart beat in %s turned off.\n",
			  culprit->name);
	    push_object(culprit);
	    push_volatile_string(malloced_error);
	    a = 2;
	    if (current_object) {
		push_volatile_string(malloced_file);
		push_volatile_string(malloced_name);
		push_number(line_number);
		a += 3;
	    }
	    svp = apply_master_ob("heart_beat_error", a);
	    command_giver = save_cmd;
	    if (svp && (svp->type != T_NUMBER || svp->u.number) )
		set_heart_beat(culprit, 1);
	}
	assigned_eval_cost = eval_cost += MASTER_RESERVED_COST;
    }
    if (malloced_error)
	xfree(malloced_error);
    if (malloced_file)
	xfree(malloced_file);
    if (malloced_name)
	xfree(malloced_name);
    num_error--;
    if (error_recovery_pointer->type != ERROR_RECOVERY_NONE)
	longjmp(error_recovery_pointer->context, 1);
    abort();
}

/*
 * Check that it is an legal path. No '..' are allowed.
 */
int legal_path(path)
    char *path;
{
    char *p;

    if (path == NULL || strchr(path, ' '))
	return 0;
    if (path[0] == '/')
        return 0;
#ifdef MSDOS
    if (!valid_msdos(path)) return(0);
#endif
    for(p = strchr(path, '.'); p; p = strchr(p+1, '.')) {
	if (p[1] == '.')
	    return 0;
    }
    return 1;
}

/*
 * There is an error in a specific file. Ask the game driver to log the
 * message somewhere.
 */
void smart_log(error_file, line, what)
     char *error_file, *what;
     int line;
{
    char buff[500];

    if (error_file == 0)
	return;
    if (strlen(what) + strlen(error_file) > sizeof buff - 100)
	what = "...[too long error message]...";
    if (strlen(what) + strlen(error_file) > sizeof buff - 100)
	error_file = "...[too long filename]...";
    sprintf(buff, "%s line %d:%s\n", error_file, line, what);
    /* Amylaar: don't reload the master object from yyparse! */
    if (master_ob && !(master_ob->flags & O_DESTRUCTED) ) {
	push_volatile_string(error_file);
	push_volatile_string(buff);
	apply_master_ob("log_error", 2);
    }
}

/*
 * Check that a file name is valid for read or write.
 * Also change the name as if the current directory was at the players
 * own directory.
 * This is done by functions in the player object.
 *
 * The master object (master.c) always have permissions to access
 * any file in the mudlib hierarchy, but only inside the mudlib.
 *
 * WARNING: The string returned will (mostly) be deallocated at next
 * call of apply().
 */

/*
 * Check that a path to a file is valid for read or write.
 * This is done by functions in the master object.
 * The path is returned without a leading '/'.
 * If the path was '/', then '.' is returned.
 * The returned string may or may not be residing inside the argument 'path',
 * so don't deallocate arg 'path' until the returned result is used no longer.
 * Otherwise, the returned path is temporarily allocated by apply(), which
 * means it will be dealocated at next apply().
 */
char *check_valid_path(path, caller, call_fun, writeflg)
    char *path;
    struct object *caller;
    char *call_fun;
    int writeflg;
{
    struct svalue *v;
    struct wiz_list *eff_user;

    if (path)
	push_string_malloced(path);
    else
	push_number(0);
    eff_user = caller->eff_user;
    if (eff_user == 0)
        push_number(0);
    else
        push_constant_string(eff_user->name);
    push_constant_string(call_fun);
    push_object(caller);
    if (writeflg)
	v = apply_master_ob("valid_write", 4);
    else
	v = apply_master_ob("valid_read", 4);
    if (!v || (v->type == T_NUMBER && v->u.number == 0))
	return 0;
    if (v->type != T_STRING) {
	if (!path) {
	    debug_message("master returned bogus error file\n");
	    return 0;
	}
    } else {
        path = v->u.string;
    }
    if (path[0] == '/')
	path++;
    /* The string "/" will be converted to "." */
    if (path[0] == '\0')
	path = ".";
    if (legal_path(path))
	return path;
    error("Illegal path: %s\n", path);
    return 0;
}

/*
 * This one is called from HUP.
 */
extern int extra_jobs_to_do;
int game_is_being_shut_down = 0;
int master_will_be_updated = 0;

void startshutdowngame () {
    extra_jobs_to_do = 1;
    game_is_being_shut_down = 1;
}

/* this will be activated by SIGUSR1 */
void startmasterupdate() {
    extern int initial_eval_cost;
    extern void add_eval_cost PROT((int));

    extra_jobs_to_do = 1;
    master_will_be_updated = 1;
    add_eval_cost(-initial_eval_cost >> 3);
    (void)signal(SIGUSR1, (void(*)())startmasterupdate);
}

/*
 * This one is called from the command "shutdown".
 * We don't call it directly from HUP, because it is dangerous when being
 * in an interrupt.
 */
void shutdowngame() {
    shout_string("Game driver shouts: LPmud shutting down immediately.\n");
    save_wiz_file();
    ipc_remove();
    remove_all_players();
    remove_destructed_objects(); /*Will perform the remove_interactive calls*/
    unlink_swap_file();
#ifdef DEALLOCATE_MEMORY_AT_SHUTDOWN
    remove_all_objects();
    free_all_sent();
    remove_wiz_list();
#if defined(MALLOC_malloc) || defined(MALLOC_smalloc)
    dump_malloc_data();
#endif
    find_alloced_data();
#endif
#ifdef OPCPROF
    opcdump();
#endif
#if defined(AMIGA)
    amiga_end();
#endif
    exit(0);
}

/*
 * Transfer an object from an object to an object.
 * Call add_weight(), drop(), get(), prevent_insert(), add_weight(),
 * and can_put_and_get() where needed.
 * Return 0 on success, and special code on failure:
 *
 * 1: To heavy for destination.
 * 2: Can't be dropped.
 * 3: Can't take it out of it's container.
 * 4: The object can't be inserted into bags etc.
 * 5: The destination doesn't allow insertions of objects.
 * 6: The object can't be picked up.
 */
#ifdef F_TRANSFER
int transfer_object(ob, to)
    struct object *ob, *to;
{
    struct svalue *v_weight, *ret;
    int weight;
    struct object *from = ob->super;

    /*
     * Get the weight of the object
     */
#ifdef NATIVE_MODE
	error("transfer() not allowed.\n");
#endif
    weight = 0;
    v_weight = sapply("query_weight", ob, 0);
    if (v_weight && v_weight->type == T_NUMBER)
	weight = v_weight->u.number;
    if (ob->flags & O_DESTRUCTED)
	return 3;
    /*
     * If the original place of the object is a living object,
     * then we must call drop() to check that the object can be dropped.
     */
    if (from && (from->flags & O_ENABLE_COMMANDS)) {
	ret = sapply("drop", ob, 0);
	if (ret && (ret->type != T_NUMBER || ret->u.number != 0))
	    return 2;
	/* This shold not happen, but we can not trust LPC hackers. :-) */
	if (ob->flags & O_DESTRUCTED)
	    return 2;
    }
    /*
     * If 'from' is not a room and not a player, check that we may
     * remove things out of it.
     */
    if (from && from->super && !(from->flags & O_ENABLE_COMMANDS)) {
	ret = sapply("can_put_and_get", from, 0);
	if (!ret || (ret->type != T_NUMBER && ret->u.number != 1) ||
	  (from->flags & O_DESTRUCTED))
	    return 3;
    }
    /*
     * If the destination is not a room, and not a player,
     * Then we must test 'prevent_insert', and 'can_put_and_get'.
     */
    if (to->super && !(to->flags & O_ENABLE_COMMANDS)) {
	ret = sapply("prevent_insert", ob, 0);
	if (ret && (ret->type != T_NUMBER || ret->u.number != 0))
	    return 4;
	ret = sapply("can_put_and_get", to, 0);
	if (!ret || (ret->type != T_NUMBER && ret->type != 0) ||
	  (to->flags & O_DESTRUCTED) || (ob->flags & O_DESTRUCTED))
	    return 5;
    }
    /*
     * If the destination is a player, check that he can pick it up.
     */
    if (to->flags & O_ENABLE_COMMANDS) {
	ret = sapply("get", ob, 0);
	if (!ret || (ret->type == T_NUMBER && ret->u.number == 0) ||
	  (ob->flags & O_DESTRUCTED))
	    return 6;
    }
    /*
     * If it is not a room, correct the total weight in the destination.
     */
    if (to->super && weight) {
	/*
	 * Check if the destination can carry that much.
	 */
	push_number(weight);
	ret = sapply("add_weight", to, 1);
	if (ret && ret->type == T_NUMBER && ret->u.number == 0)
	    return 1;
	if (to->flags & O_DESTRUCTED)
	    return 1;
    }
    /*
     * If it is not a room, correct the weight in the 'from' object.
     */
    if (from && from->super && weight) {
	push_number(-weight);
	(void)sapply("add_weight", from, 1);
    }
    move_object(ob, to);
    return 0;
}
#endif /* F_TRANSFER */

/*
 * Call this one when there is only little memory left. It will start
 * Armageddon.
 */
void slow_shut_down(minutes)
    int minutes;
{
    push_number(minutes);
    apply_master_ob("slow_shut_down", 1);
}

int match_string(match, str, len)
    char *match, *str;
    mp_int len;
{
    for (;;) {
	switch(*match) {
	  case '?':
	    if (--len < 0)
		return 0;
	    str++;
	    match++;
	    continue;
	  case '*':
	  {
	    char *str2;
	    mp_int matchlen;

	    for (;;) {
		switch (*++match) {
		  case '\0':
		    return len >= 0;
		  case '?':
		    --len;
		    str++;
		  case '*':
		    continue;
		  case '\\':
		    match++;
		  default:
		    break;
		}
		break;
	    }
	    if (len <= 0)
		return 0;
	    str2 = strpbrk(match + 1, "?*\\");
	    if (!str2) {
		if ( (matchlen = strlen(match)) > len)
		    return 0;
		return strncmp(match, str + len - matchlen, matchlen) == 0;
	    } else {
		matchlen = str2 - match;
	    }
	    do {
		if ( !(str2 = memmem(match, matchlen, str, len)) )
		    return 0;
		len -= str2 - str;
		if (match_string(match + matchlen, str2, len))
		    return 1;
		str = str2 + 1;
	    } while (--len > 0);
	    return 0;
	  }
	  case '\0':
	    return len == 0;
	  case '\\':
	    match++;
	    if (*match == '\0')
		return 0;
	    /* Fall through ! */
	  default:
	    if (--len >= 0 && *match == *str) {
		match++;
		str++;
		continue;
	    }
	    return 0;
	}
    }
}

/*
 * Credits for some of the code below goes to Free Software Foundation
 * Copyright (C) 1990 Free Software Foundation, Inc.
 * See the GNU General Public License for more details.
 */

int
isdir (path)
     char *path;
{
  struct stat stats;

  return ixstat (path, &stats) == 0 && S_ISDIR (stats.st_mode);
}

void
strip_trailing_slashes (path)
     char *path;
{
  int last;

  last = strlen (path) - 1;
  while (last > 0 && path[last] == '/')
    path[last--] = '\0';
}

struct stat to_stats, from_stats;

int
copy (from, to)
     char *from, *to;
{
  int ifd;
  int ofd;
  char buf[1024 * 8];
  int len;			/* Number of bytes read into `buf'. */
  
  if (!S_ISREG (from_stats.st_mode))
    {
      error ("cannot move `%s' across filesystems: Not a regular file\n", from);
      return 1;
    }
  
  if (unlink (to) && errno != ENOENT)
    {
      error ("cannot remove `%s'\n", to);
      return 1;
    }

  ifd = ixopen3 (from, O_RDONLY, 0);
  if (ifd < 0)
    {
      error ("%s: open failed\n", from);
      return errno;
    }
  ofd = ixopen3 (to, O_WRONLY | O_CREAT | O_TRUNC, 0600);
  if (ofd < 0)
    {
      error ("%s: open failed\n", to);
      close (ifd);
      return 1;
    }
#ifdef HAVE_FCHMOD
  if (fchmod (ofd, from_stats.st_mode & 0777))
    {
      error ("%s: fchmod failed\n", to);
      close (ifd);
      close (ofd);
      unlink (to);
      return 1;
    }
#endif
  
  while ((len = read (ifd, buf, sizeof (buf))) > 0)
    {
      int wrote = 0;
      char *bp = buf;
      
      do
	{
	  wrote = write (ofd, bp, len);
	  if (wrote < 0)
	    {
	      error ("%s: write failed\n", to);
	      close (ifd);
	      close (ofd);
	      unlink (to);
	      return 1;
	    }
	  bp += wrote;
	  len -= wrote;
	} while (len > 0);
    }
  if (len < 0)
    {
      error ("%s: read failed\n", from);
      close (ifd);
      close (ofd);
      unlink (to);
      return 1;
    }

  if (close (ifd) < 0)
    {
      error ("%s: close failed", from);
      close (ofd);
      return 1;
    }
  if (close (ofd) < 0)
    {
      error ("%s: close failed", to);
      return 1;
    }
  
#ifndef HAVE_FCHMOD
  if (chmod (to, from_stats.st_mode & 0777))
    {
      error ("%s: chmod failed\n", to);
      return 1;
    }
#endif

  return 0;
}

/* Move FROM onto TO.  Handles cross-filesystem moves.
   If TO is a directory, FROM must be also.
   Return 0 if successful, 1 if an error occurred.  */

int
do_move (from, to)
     char *from;
     char *to;
{
  if (lstat (from, &from_stats) != 0)
    {
      error ("%s: lstat failed\n", from);
      return 1;
    }

  if (lstat (to, &to_stats) == 0)
    {
#ifndef MSDOS
      if (from_stats.st_dev == to_stats.st_dev
	  && from_stats.st_ino == to_stats.st_ino)
#else
      if (same_file(from,to))
#endif
	{
	  error ("`%s' and `%s' are the same file", from, to);
	  return 1;
	}

      if (S_ISDIR (to_stats.st_mode))
	{
	  error ("%s: cannot overwrite directory", to);
	  return 1;
	}

    }
  else if (errno != ENOENT)
    {
      perror("do_move");
      error ("%s: unknown error\n", to);
      return 1;
    }
#ifndef RENAME_HANDLES_DIRECTORIES
  /* old SYSV */
  if (isdir(from)) {
      char cmd_buf[100];

      if (strchr(from, '\'') || strchr(to, '\''))
	return 0;
      sprintf(cmd_buf, "/usr/lib/mv_dir '%s' '%s'", from, to);
      return system(cmd_buf);
  } else
#endif /* RENAME_HANDLES_DIRECTORIES */      
  if (rename (from, to) == 0)
    {
      return 0;
    }

#if !defined(AMIGA)
  if (errno != EXDEV)
    {
      error ("cannot move `%s' to `%s'", from, to);
      return 1;
    }
#endif

  /* rename failed on cross-filesystem link.  Copy the file instead. */

  if (copy (from, to))
      return 1;
  
  if (unlink (from))
    {
      error ("cannot remove `%s'", from);
      return 1;
    }

  return 0;

}
    
/*
 * do_rename is used by the efun rename. It is basically a combination
 * of the unix system call rename and the unix command mv. Please shoot
 * the people at ATT who made Sys V.
 */

#ifdef F_RENAME
int
do_rename(fr, t)
    char *fr, *t;
{
    extern void push_apply_value(), pop_apply_value();
    char *from, *to;
    int i;
    
    from = check_valid_path(fr, current_object, "do_rename", 1);
    if(!from)
	return 1;
    push_apply_value();
    to = check_valid_path(t, current_object, "do_rename", 1);
    if(!to) {
	pop_apply_value();
	return 1;
    }
    if(!strlen(to) && !strcmp(t, "/")) {
	to = (char *)alloca(3);
	sprintf(to, "./");
    }
    strip_trailing_slashes (from);
    if (isdir (to))
	{
	    /* Target is a directory; build full target filename. */
	    char *cp;
	    char *newto;
	    
	    cp = strrchr (from, '/');
	    if (cp)
		cp++;
	    else
		cp = from;
	    
	    newto = (char *) alloca (strlen (to) + 1 + strlen (cp) + 1);
	    sprintf (newto, "%s/%s", to, cp);
	    pop_apply_value();
	    return do_move (from, newto);
	}
    else
	i = do_move (from, to);
	pop_apply_value();
	return i;
}
#endif /* F_RENAME */