#ifndef lint
static char sccsid[] = "@(#)objects.c 9.9 88/01/19";
#endif

/*
 * Copyright (c) 1987 by Sun Microsystems, Inc.
 */

/*-
	General manipulation of PostScript objects

	objects.c, Mon Dec 31 09:42:15 1984

 */

#ifdef REF
#include <sys/types.h>
#include <ref/config.h>
#endif
#include "PostScript.h"
#include "input.h"
#include "qalloc.h"
#include <fcntl.h>
#include <values.h>


/*
 * Public
 */
struct object make_growable_object( /* type, where, numelements */ );
/* MACRO: struct object make_array( * n * ); */
/* MACRO: struct object make_string( * n, initial_string * ); */

struct body *new_growable_body( /* type, numelements */ );
/* MACRO: struct body *new_array( * n * ); */
/* MACRO: struct body *new_string( * n * ); */
/* MACRO: struct body *new_dict( * n * ); */
/* MACRO: struct body *new_body( * n * ); */
struct body *new_name( /* hash, name, length */ );

enum error_type define_object_in_dictionary( /* key, value, dict, real_obj */ );
struct object *find_object_in_dictionary( /* key, dict */ );
void        delete_object_from_dictionary( /* key, dict */ );

struct object open_file( /* fn, len, dir */ );
void        convert_string_to_name( /* o */ );
int         free_body( /* bodyp */ );	/* Free any body type */

static      extend_object( /* ee */ );
static      setautobind( /* ee */ );
static      currentautobind( /* ee */ );
static      undef( /* ee */ );

/*
 * Semi-Public
 */
struct body *alloc_body( /* size */ );	/* Used by 'new_body' macro */

char       *newshome;		/* The directory where the NeWS hierarchy has
				 * been installed.  Other modules import this
				 * variable */

/*
 * Private
 */

static struct body *alloc_growable( /* numelements, object_size */ );
static struct body *alloc_dict( /* numelements */ );
int extend_growable( /* body, new_size */ );
static void grow_dict( /* body, increase, max_use */ );
static /* void */ removebody( /* cv */ );

static struct object lookup( /* key */ );
static void push( /* obj, stack */ );
static struct object pop( /* stack */ );

/*
 * Private defs
 */
#define CONVERT_TO_GROWABLE_DICT 40	/* Number of key/value pairs */
#define INITIAL_SYSTEMDICT_SIZE 700
#define INITIAL_GROWABLE_SIZE 10/* for other dictionaries */
#define DICT_MAX_USE_PERCENTAGE 80	/* At this % full,  grow the dict */
#define DICT_INCREASE_PERCENTAGE 50	/* Grow the dict by this amount */

/* ------------------------------------------------------------------------- */




/*
 * Create any type of growable and return an object pointer pointing to it.
 * Storage is not initialized (not zeroed) unless the 'where' arg is provided.
 */
struct object
make_growable_object(type, where, numelements)
    enum type   type;
    char       *where;
    register    numelements;
{
    struct object ret;
    register struct body *p;

    /* new_growable_body() does typing check on the arguments */
    p = new_growable_body(type, numelements);

    ret.type = type;
    ret.executable = 0;
    ret.value.substring.start = 0;
    ret.value.substring.length = p->body.array.max_size;
    set_body_of(&ret, p);

    if (where) {
	assert(!(type == dictionary_type));	/* If this changes, then
						 * 2*numelements */
	bcopy(where, p->body.array.objects, numelements
	      * (type == string_type ? sizeof(char) : sizeof(struct object)));
	p->body.array.used = numelements;
    }

    return ret;
}


struct body *
new_growable_body(type, numelements)
    enum type   type;
    register    numelements;
{
    register struct body *p;

    assert(numelements >= 0);
    switch (type) {
    case string_type:
	p = alloc_growable(numelements, sizeof(char));
	break;
    case array_type:
	p = alloc_growable(numelements, sizeof(struct object));

#ifdef PERFORMANCE
	p->body.array.exec_count = 0;
#endif

	break;
    case dictionary_type:
	/*
	 * each dict element is a key-value pair, so we need two objects for
	 * each element
	 */
	p = alloc_dict(numelements);
	break;
    default:
	/* this routine can only handle creation of dicts, arrays,  strings */
	assert(0);
	/* NOTREACHED */
    }
    p->type = type;

    return p;
}


struct body *
new_name(hash, name, length)
    char       *name;
{
    register char *name_body;
    register struct body *ret = new_body(keyword);
    register    slot;
    extern char edata;
    if (length < 0) {
	register char *p = name;
	while (*p++);
	length = p - name - 1;
    }
    if (name < &edata)
	name_body = name;
    else if (length <= 0)
	name = "";
    else {
	typedef char * Name_body;	/* For easy leak checking */
	QALLOC(name_body, length, (Name_body));
	bcopy(name, name_body, length);
    }
    ret->type = keyword_type;
    ret->body.keyword.name = name_body;
    ret->body.keyword.namelen = length;

#ifdef undef
    ret->body.keyword.same_bucket = 0;
    ret->body.keyword.system_only = 0;
    ret->body.keyword.hardcore = 0;
    ret->body.keyword.dict_mask = 0;
    ret->body.keyword.last_pos = 0;
#endif

    if (hash == 0) {
	register    n = length;
	while (--n >= 0)
	    hash = (hash << 5) - hash + *name++;
    }
    slot = (hash & 0x7fffffff) % hash_table_size;
    ret->body.keyword.hash = hash;
    ret->body.keyword.same_bucket = hash_table[slot];
    hash_table[slot] = ret;
    return ret;
}


/*
 * Insert key and value into dict. Real_object is used by put_primitive.
 * Pointer to objects may change after a call to this routine.
 */
/*
 * If an error other than no_error_code is returned, then the refcount of
 * value is NOT reduced.  If no_error_code is returned, then it is reduced
 * (implicitly, by storing it in the definition). Thus all calls must check
 * the return code and do the appropriate thing to account for the refcount
 * change.
 */
enum error_type
define_object_in_dictionary(key, value, dict, real_object)
    struct object key,
                value;
    register struct body *dict;
{
    register struct object *ret;
    register    hash;

    if (key.type == null_type) {
	current_process->error_code = invalidaccess_error_code;
	return invalidaccess_error_code;
    }
    hash_object(hash, &key);
    ret = &dict->body.dict.objects[hash_index(hash, dict->body.dict.size >> 1)];
    while (ret->type != null_type) {
	if (equal_object(ret, &key)) {
	    if (ret[1].type == magic_variable_type) {
		if (real_object) {
		    (ret[1].value.def->function)
			(real_object, SET_MAGIC(ret[1].value.def->index), value);
		    object_decref(&value);
		}
		else {
		    current_process->error_code = invalidaccess_error_code;
		    return invalidaccess_error_code;
		}
	    }
	    else {
		object_decref(&ret[1]);
		ret[1] = value;
	    }
	    return no_error_code;
	}
	ret -= 2;
	if (ret < dict->body.dict.objects)
	    ret = &dict->body.dict.objects[dict->body.dict.size - 2];
    }
    if (dict->body.dict.max_use <= dict->body.dict.used) {
	if (dict->body.dict.max_size <= dict->body.dict.used) {
	    current_process->error_code = dictfull_error_code;
	    return dictfull_error_code;
	}
	else if (dict->body.dict.max_size >= dict->body.dict.size) {
	    grow_dict(dict, DICT_INCREASE_PERCENTAGE, DICT_MAX_USE_PERCENTAGE);
	    assert(!(dict->body.dict.max_size <= dict->body.dict.used));
	    /* Dictionary grown, so try again */
	    return define_object_in_dictionary(key, value, dict, real_object);
	}
    }
    ret[0] = key;
    object_incref(&key);
    ret[1] = value;
    dict->body.dict.used += 2;
    return no_error_code;
}


struct object *
find_object_in_dictionary(key, dict)
    struct object key;
    register struct body *dict;
{
    register struct object *ret;
    register    hash;
    hash_object(hash, &key);
    ret = &dict->body.dict.objects
	[hash_index(hash, dict->body.dict.size >> 1)];
    while (ret->type != null_type) {
	if (equal_object(ret, &key))
	    return ret + 1;
	ret -= 2;
	if (ret < dict->body.dict.objects)
	    ret = &dict->body.dict.objects[dict->body.dict.size - 2];
    }
    return 0;
}


void
delete_object_from_dictionary(key, dict)
    struct object key;
    register struct body *dict;
{
    register struct object *ret;
    register    hash;
    if (key.type == null_type)
	return;
    hash_object(hash, &key);
    ret = &dict->body.dict.objects
	[hash_index(hash, dict->body.dict.size >> 1)];
    while (!equal_object(ret, &key)) {
	if (ret->type == null_type)
	    return;
	ret -= 2;
	if (ret < dict->body.dict.objects)
	    ret = &dict->body.dict.objects[dict->body.dict.size - 2];
    }
    object_decref(ret);
    object_decref(ret + 1);
    clear_object(ret);
    clear_object(ret + 1);
    while (1) {
	struct object key,
	            value;
	register struct object *p;
	ret -= 2;
	if (ret < dict->body.dict.objects)
	    ret = &dict->body.dict.objects[dict->body.dict.size - 2];
	if (ret->type == null_type)
	    break;
	key = ret[0];
	value = ret[1];
	clear_object(ret);
	clear_object(ret + 1);
	hash_object(hash, &key);
	p = &dict->body.dict.objects[hash_index(hash, dict->body.dict.size >> 1)];
	while (p->type != null_type) {
	    assert(!equal_object(p, &key));
	    p -= 2;
	    if (p < dict->body.dict.objects)
		p = &dict->body.dict.objects[dict->body.dict.size - 2];
	}
	p[0] = key;
	p[1] = value;
    }
    dict->body.dict.used -= 2;
}


struct object
open_file(fn, len, dir)
    char           *fn, *dir;
{
    struct object   ret;
    register struct body *b = 0;
    PSFILE         *f = 0;
    PSFILE         *inf = 0;
    char            fnb[200];

    if (len >= sizeof fnb)
	len = sizeof fnb - 1;
    strncpy(fnb, fn, len);
    fnb[len] = 0;
    if (fnb[0] != '%') {
	char            canonical[200];

	if (dir[0] == 'r') {
	    if (abspath(fnb, canonical) < 0)
		inf = psio_open(fnb, "r");
	    else
		inf = psio_open(canonical, "r");
	    if (inf == 0 && newshome) {
		sprintf(canonical, "%s/lib/%s", newshome, fnb);
		inf = psio_open(canonical, "r");
	    }
#ifdef PSLIBDIR
	    if (inf == 0 && dir[0] == 'r'
	     && fn[len - 1] == 's' && fn[len - 2] == 'p'
	     && fn[len - 3] == '.') {
		sprintf(canonical, "%s/%s", PSLIBDIR, fnb);
		inf = psio_open(canonical, "r");
	    }
#endif
	} else {		/* writing */
	    if (abspath(fnb, canonical) < 0)
		f = psio_open(fnb, dir);
	    else
		f = psio_open(canonical, dir);
	}
    } else if (strcmp(fnb, "%stdin") == 0) {
	if (psio_stdin == 0) {
	    /* fcntl(0, F_SETFL, FNDELAY); */
	    psio_stdin = psio_fdopen(0, "r");
	}
	if (stdio_file->body.file.inbuf == 0)
	    stdio_file->body.file.inbuf = psio_stdin;
	b = stdio_file;
    } else if (strcmp(fnb, "%stdout") == 0)
	b = stdio_file;
    else if (strcmp(fnb, "%stderr") == 0)
	b = stdio_file;
    else if (strncmp(fnb, "%socket", 7) == 0)
	open_socket(fnb + 7, &inf, &f);
    if (f == 0 && inf == 0 && b == 0)
	clear_object(&ret);
    else {
	if (b == 0) {
	    b = new_body(file);
	    b->type = file_type;
	    b->body.file.name =
	        body_of(&make_growable_object(string_type, fnb, len));
	    b->body.file.inbuf = 0;
	    b->body.file.outbuf = 0;
	    if (f) {
		if (psio_fileno(f) > 2)
		    fcntl(psio_fileno(f), F_SETFD, 1);
		if (psio_fileno(f) >= maximum_fd)
		    maximum_fd = psio_fileno(f) + 1;
		b->body.file.outbuf = f;
	    }
	    if (inf) {
		if (psio_fileno(inf) > 2)
		    fcntl(psio_fileno(inf), F_SETFD, 1);
		if (psio_fileno(inf) >= maximum_fd)
		    maximum_fd = psio_fileno(inf) + 1;
		b->body.file.inbuf = inf;
	    }
	    b->body.file.tok = 0;
	    b->body.file.ntok = 0;
	}
	set_typed_bodied_object(&ret, file_type, b);
	/*-	ret.value.file = b->body.file.inbuf; */
    }
    if (inf) 
	make_async(psio_fileno(inf));
    return ret;
}


void
convert_string_to_name(o)
    register struct object *o;
{
    register struct body *p;
    if (o->type != string_type)
	return;
    p = get_name(body_of(o)->body.string.chars + o->value.substring.start,
		 o->value.substring.length);
    decref(body_of(o));
    set_typed_bodied_object(o, keyword_type, p);
}


/*
 * The return value is meaningless but free_body() is used in a conditional
 * statement in the decref macro.
 */
free_body(p)
    register struct body *p;
{
    assert(p->refcnt == 0);

#ifdef DEBUG
    if (verbose /* && p->type != event_type */ ) {
	struct object o;
	set_typed_bodied_object(&o, p->type, p);
	psio_fprintf(psio_stdout, "Freed ");
	switch (p->type) {
	case array_type:
	case dictionary_type:
	    o.value.substring.length = p->body.dict.size;
	    break;
	case string_type:
	    o.value.substring.length = p->body.string.size;
	    break;
	case canvas_type:
	    o.value.canvas = p->body.canvas.canvas;
	    break;
	}
	decode_object(psio_stdout, o, 1);
	psio_putc('\n', psio_stdout);
    }
#endif

    switch (p->type) {
    case string_type:
	QFREE(p->body.string.chars);	/* Free growable portion */
	break;
    case array_type:
    case dictionary_type:
	{
	    register struct object *e = p->body.array.objects;

#ifdef sparc
	    int         n = p->body.array.size;
#else
	    register    n = p->body.array.size;
#endif

	    while (--n >= 0) {
		object_decref(e);
		e++;
	    }
	    QFREE(p->body.array.objects);	/* Free growable portion */
	}
	break;
    case file_type:
	if (p->body.file.name)
	    decref(p->body.file.name);
	if (p->body.file.inbuf)
	    if (psio_fileno(p->body.file.inbuf) > 2) {
		if (selectable_file(psio_fileno(p->body.file.inbuf), 1))
		    remove_selectable_file(psio_fileno(p->body.file.inbuf), 1);
		psio_close(p->body.file.inbuf);
	    }
	if (p->body.file.outbuf)
	    if (psio_fileno(p->body.file.outbuf) > 2) {
		psio_close(p->body.file.outbuf);
	    }
	    else
		psio_flush(p->body.file.outbuf);
	if (p->body.file.tok) {
	    register struct object *tokp;
	    for (tokp = &p->body.file.tok[p->body.file.ntok];
		 --tokp >= p->body.file.tok; ) {
		     object_decref(tokp);
		 }
	    free(p->body.file.tok);
	}
	break;
    case canvas_type:
	if (cv_is_canvas(p->body.canvas.canvas)) {
	    cv_decref((struct canvas *) p->body.canvas.canvas);
	    return 0;		/* The body will be deallocated by removebody */
	}
	else
	    pr_destroy(p->body.canvas.canvas);
	break;
    case event_type:
	event_dec_refs(p);
	break;
    case process_type:
	{
	    register struct execution_environment *ee = p->body.process.env;
	    switch (ee->event) {
	    case suspended_process:
		free_process(ee);
		break;
	    case zombie_process:
		ee->event = dead_process;
		object_decref(&p->body.process.terminal_value);
		ee->next = process_free_list;
		process_free_list = ee;
		ee->pos = 0;
		break;
	    }
	}
	return 0;		/* Dont free the body associated with a
				 * process */
    case font_id_type:
	psf_decref(p->body.font);
	break;
    case monitor_type:
	assert(p->body.monitor.holder == 0);
	break;
    case graphicsstate_type:
	cs_setcanvas(&p->body.graphicsstate, 0);
	cs_setfont(&p->body.graphicsstate, (struct psfont *) 0);
	if (p->body.graphicsstate.path.element)
	    free(p->body.graphicsstate.path.element);
    }
    QFREE(p);
    return 0;
}


/*
 * Allocs storage and initializes generic body. Used by 'new_body' macro in
 * PostScript.h.
 */
struct body *
alloc_body(size)
    register    size;
{
    register struct body *ret;
    typedef struct body * Generic_body;	/* For easy leak checking */

    QALLOC(ret, size, (Generic_body));
    ret->refcnt = 1;
    ret->readonly = 0;

    return ret;
}


/*
 * Internal use only (doesnt set type field), use new_growable_body() instead.
 * Alloc growable body for arrays, strings and dicts, return body pointer.
 * Array is not initialized (not zeroed) unless the 'where' arg is provided.
 * Dicts must always have at least one empty slot.
 */
static struct body *
alloc_growable(numelements, obj_size)
    register    numelements,
                obj_size;
{
    register struct body *p;
    typedef struct object * Growable_body;	/* For easy leak checking */
    register size = numelements * obj_size;
    p = new_body(array);
    /* Alloc growable portion */
    if (size <= 0) size = 1;
    assert(obj_size > 0);
    QALLOC(p->body.array.objects, size, (Growable_body));

    p->body.array.used = 0;
    p->body.array.size = numelements;
    p->body.array.max_use = p->body.array.max_size = numelements;

    return p;
}


static struct body *
alloc_dict(n_kvpairs)
    int         n_kvpairs;
{
    register struct body *p;
    if (n_kvpairs <= 0)
	n_kvpairs = 1;
    n_kvpairs += 1;		/* Always pad the dict */

#ifdef undef
    {
	/* Force the dictionary size to be prime,  if possible */
	static int  primes[] = {
	    5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53,
	    59, 61, 67, 71, 73, 79, 83, 89, 97, 101, 131, 149, 179,
	    199, 251, 307, 379, 457, 563, 701, 809, 997,
	};
	register    lo = 0,
	            hi = sizeof primes / sizeof primes[0] - 1,
	            mid;


	if (n_kvpairs < primes[hi]) {
	    while (hi > lo) {
		mid = (hi + lo) >> 1;
		if (primes[mid] < n_kvpairs) {
		    lo = mid + 1;
		}
		else {
		    hi = mid;
		}
	    }
	    n_kvpairs = primes[hi];
	}
    }
#endif

    if (n_kvpairs > CONVERT_TO_GROWABLE_DICT) {
	register    init_size = INITIAL_GROWABLE_SIZE * 2;
	if (system_dictionary == 0)
	    init_size = INITIAL_SYSTEMDICT_SIZE * 2;
	p = alloc_growable(init_size, sizeof(struct object));
	/* Correct the alloc_growable() defaults to make it growable */
	p->body.dict.max_size = (n_kvpairs - 1) * 2;
	p->body.dict.max_use = p->body.dict.size
	    * DICT_MAX_USE_PERCENTAGE / 100;
    }
    else {
	p = alloc_growable(n_kvpairs * 2, sizeof(struct object));
	p->body.dict.max_size -= 2;
	p->body.dict.max_use -= 2;
    }
    bzero(p->body.dict.objects, p->body.dict.size * sizeof(struct object));
    return p;
}


static void
grow_dict(dict, increase, max_use)
    register struct body *dict;
    int         increase,
                max_use;
{
    int         size;
    struct body nb;
    register    n;
    register struct object *obj;
    register enum error_type error = no_error_code;

    if (dict->body.dict.size > dict->body.dict.max_size)
	return;

    size = dict->body.dict.size * (100 + increase) / 100;
    if (size > dict->body.dict.max_size)
	size = dict->body.dict.max_size + 2;
    size &= ~1;
    bcopy(dict, &nb, body_size(dict));
    nb.body.dict.size = size;
    nb.body.dict.used = 0;
    if (size > dict->body.dict.max_size) {
	nb.body.dict.max_use = dict->body.dict.max_size;
    }
    else {
	nb.body.dict.max_use = size * max_use / 100;
    }

    {
    typedef struct object * Dict_extend;	/* For easy leak checking */
    /* Alloc new growable portion */
    QALLOC(nb.body.dict.objects, size * sizeof(struct object), (Dict_extend));
    bzero(nb.body.dict.objects, size * sizeof(struct object));
    }

    /* rehash objects into nb from dict, dont change ref cnts */
    obj = dict->body.dict.objects;
    n = dict->body.dict.size >> 1;
    while (--n >= 0 && error == no_error_code) {
	if (obj->type != null_type) {
	    error = define_object_in_dictionary(*obj, *(obj + 1), &nb, 0);
	    object_decref(obj);
	    assert(error == no_error_code);
	}
	obj += 2;
    }
    QFREE(dict->body.dict.objects);
    dict->body.dict = nb.body.dict;
}


/*
 * Increase the size of a growable by 'size' elements. The new space is
 * uninitialized. Returns 1 for success, 0 for failure.
 */
int
extend_growable(gb, size)
    struct body *gb;
    int         size;
{
    if (size >= 1 << 16)
	return 0;
    switch (gb->type) {
	/* XXX Untested for string and array types */
    case string_type:
	{
	    typedef char * String_extend;	/* For easy leak checking */
	    char       *o = gb->body.string.chars;
	    QALLOC(gb->body.string.chars, size * sizeof(char), (String_extend));
	    bcopy(o, gb->body.string.chars,
		  gb->body.string.size * sizeof(char));
	    gb->body.string.max_size = gb->body.string.max_use = size;
	    gb->body.string.size = size;
	    QFREE(o);
	}
	break;
    case array_type:
	{
	    typedef struct object * Array_extend; /* For easy leak checking */
	    struct object *o = gb->body.array.objects;
	    QALLOC(gb->body.array.objects,
		   size * sizeof(struct object), (Array_extend));
	    bcopy(o, gb->body.array.objects,
		  gb->body.array.size * sizeof(struct object));
	    bzero(gb->body.array.objects + gb->body.array.size,
		  (size - gb->body.array.size) * sizeof(struct object));
	    gb->body.array.max_size = gb->body.array.max_use = size;
	    gb->body.array.size = size;
	    QFREE(o);
	}
	break;
    case dictionary_type:
	size <<= 1;
	if (gb->body.dict.max_size > size)
	    return 0;
	gb->body.dict.max_size = size;
    }
    return 1;			/* Success */
}


/*
 * Called when a canvas is deallocated: it deals with deallocating the body
 * object pointed to by the spare field
 */
static				/* void */
/* b Initialization doesnot allow void */
removebody(cv)
    register struct canvas *cv;
{
    register struct body *b = (struct body *) cs_currentcanvasspare(cv);
    assert(b->type == canvas_type);
    assert((struct canvas *) b->body.canvas.canvas == cv);

    /* the following is some defensive code to handle occurances of
       the failures detected by the previous assertions */
    if (b == 0 || b->type != canvas_type
	|| (struct canvas *) b->body.canvas.canvas != cv)
	    return;

    if (b->refcnt > 0) {	/* Account for the hidden reference */
	cv_incref(cv);
	if (verbose)
	    psio_fprintf(current_process ? current_process->stddiag->body.file.outbuf : psio_stderr,
			 "Saved canvas %dx%d from the brink of destruction\n",
			 cv->pixrect.pr_width, cv->pixrect.pr_height);
    }
    else {
	register struct body *e,
	           *en;
	if (cv->mapped) {
	    cv->refcnt++;
	    cs_unmap(cv, 0);
	    cv->refcnt--;
	    assert(cv->refcnt == 0);
	    CheckCrossings(last_event_time);
	    assert(cv->refcnt == 0);
	    if (cv->refcnt > 0)
		return;
	}
	if (verbose)
	    psio_fprintf(current_process ? current_process->stddiag->body.file.outbuf : psio_stderr,
			 "Finally destroyed canvas (%dx%d)\n",
			 cv->pixrect.pr_width, cv->pixrect.pr_height);
	/* Flush any reference to cv in cursor tracking code */
	if (CanvasUnderMouse == cv || LastCanvasUnderMouse == cv)
	    CheckCrossings(last_event_time);
	for (en = b->body.canvas.interest; e = en;) {
	    en = e->body.event.next;
	    assert(e->type == event_type);
	    assert(e->body.event.canvas == cv);
	    untangle_event(e);
	}
	assert(cv->refcnt == 0);
	QFREE(b);
    }
}

static
extend_object(ee)
    register struct execution_environment *ee;
{
    /*
     * XXX Implement for array and string types. Disallow subarrays and
     * substrings.
     */
    if (ee->optop[-2].type != fixed_type
	    || ee->optop[-1].type != dictionary_type) {
	ee->error_code = typecheck_error_code;
	return;
    }
    if (!extend_growable(body_of(ee->optop - 1),
			 roundfr(ee->optop[-2].value.fixed))) {
	ee->error_code = rangecheck_error_code;
	return;
    }
    ee->optop[-2] = ee->optop[-1];
    ee->optop--;
}

static
setautobind(ee)
    register struct execution_environment *ee;
{
    if (ee->optop[-1].type != boolean_type) {
	ee->error_code = typecheck_error_code;
	return;
    }
    ee->autobind = ee->optop[-1].value.fixed != 0;
    ee->optop--;
}

static
currentautobind(ee)
    register struct execution_environment *ee;
{
    set_typed_object(ee->optop, boolean_type);
    ee->optop->value.fixed = fracti(ee->autobind);
    ee->optop++;
}

static
undef(ee)
    register struct execution_environment *ee;
{
    register struct object *optop = ee->optop;
    if (optop[-2].type != dictionary_type) {
	ee->error_code = typecheck_error_code;
	return;
    }
    delete_object_from_dictionary(optop[-1], body_of(optop - 2));
    object_decref(optop - 1);
    object_decref(optop - 2);
    ee->optop -= 2;
}

#ifdef DEBUG
static
struct object
lookup(key)
    struct object key;
{
    register struct object *ret = find_object_in_dictionary(key, system_dictionary);
    if (ret)
	return *ret;
    else {
	static struct object bogus;
	return bogus;
    }
}


static void
push(obj, stack)
    struct object obj;
    register struct body *stack;
{
    if (stack->body.array.used >= stack->body.array.size)
	error("stackoverflow");
    else
	stack->body.array.objects[stack->body.array.used++] = obj;
}

static struct object
pop(stack)
    register struct body *stack;
{
    if (stack->body.array.used <= 0) {
	error("stackunderflow");
	/* NOTREACHED */
    }
    else
	return stack->body.array.objects[--stack->body.array.used];
}

ck_dict(dict)
    struct body *dict;
{
    register    limit = dict->body.array.size;
    register    i;
    register struct object *o = dict->body.dict.objects;
    for (i = 1; i < limit; i += 2, o += 2)
	if ((int) o[0].type < (int) null_type
		|| (int) o[0].type > (int) cursor_type)
	    printf("***Bad dict entry %d, type = %d.\n", i - 1, o[0].type);
    printf("ck_dict done\n");
}

#endif /* DEBUG */


initialize_objects()
{
    extern char *getenv();
    if (newshome == 0 && (newshome = getenv("NEWSHOME")) == 0) {
	newshome = DEFAULTNEWSHOME;
	putenv("NEWSHOME", newshome);
    }
    psio_stdout = psio_fdopen(1, "w");
    psio_stderr = psio_stdout;
    psio_setneverblock(psio_stdout);
	/* If stdout blocks then we can be in a deadlock situation.
	 * This is because the thing emptying the pipe is usually
	 * a console window, which itself might be blocked waiting
	 * for the server.
	 *
	 * The psio package can "handle" blocking when a file is
	 * set to non-blocking mode.  However, we can't do that here
	 * because alot of crazy things happen if stdio is made non-
	 * blocking (debugging of server is messed up for one thing).
	 *
	 * Better solutions would be:
	 * 	1) Have file blocking be a per process property instead
	 * 	   of a file system wide property.
	 * 	2) Have the server implemented with preemptive C light
	 *	   weight processes.
	 */
    stdio_file = new_body(file);
    stdio_file->type = file_type;
    stdio_file->body.file.name = body_of(&make_growable_object(string_type, "%stdio", 6));
    stdio_file->body.file.outbuf = psio_stdout;
    stdio_file->body.file.inbuf = 0;
    stdio_file->body.file.tok = 0;
    stdio_file->body.file.ntok = 0;
    cs_setcanvasdestructionhook(removebody);
    define_operator("extend", extend_object, 0, 1, 1);
    define_operator("setautobind", setautobind, 0, 1, 0);
    define_operator("currentautobind", currentautobind, 0, 0, 1);
    define_operator("undef", undef, 0, 2, 0);
}