/*

 *  ALSA lisp implementation

 *  Copyright (c) 2003 by Jaroslav Kysela <perex@perex.cz>

 *

 *  Based on work of Sandro Sigala (slisp-1.2)

 *

 *

 *   This library is free software; you can redistribute it and/or modify

 *   it under the terms of the GNU Lesser General Public License as

 *   published by the Free Software Foundation; either version 2.1 of

 *   the License, or (at your option) any later version.

 *

 *   This program is distributed in the hope that it will be useful,

 *   but WITHOUT ANY WARRANTY; without even the implied warranty of

 *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

 *   GNU Lesser General Public License for more details.

 *

 *   You should have received a copy of the GNU Lesser General Public

 *   License along with this library; if not, write to the Free Software

 *   Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA

 *

 */

#include <assert.h>

#include <limits.h>

#include <stdio.h>

#include <stdlib.h>

#include <string.h>

#include <ctype.h>

#include <math.h>

#include <err.h>

#define alisp_seq_iterator alisp_object

#include "local.h"

#include "alisp.h"

#include "alisp_local.h"

struct alisp_object alsa_lisp_nil;

struct alisp_object alsa_lisp_t;

/* parser prototypes */

static struct alisp_object * parse_object(struct alisp_instance *instance, int havetoken);

static void princ_cons(snd_output_t *out, struct alisp_object * p);

static void princ_object(snd_output_t *out, struct alisp_object * p);

static struct alisp_object * eval(struct alisp_instance *instance, struct alisp_object * p);

/* functions */

static struct alisp_object *F_eval(struct alisp_instance *instance, struct alisp_object *);

static struct alisp_object *F_progn(struct alisp_instance *instance, struct alisp_object *);

static struct alisp_object *F_funcall(struct alisp_instance *instance, struct alisp_object *);

/* others */

static int alisp_include_file(struct alisp_instance *instance, const char *filename);

/*

 *  object handling

 */

static int get_string_hash(const char *s)

{

	int val = 0;

	if (s == NULL)

		return val;

	while (*s)

		val += *s++;

	return val & ALISP_OBJ_PAIR_HASH_MASK;

}

static void nomem(void)

{

	SNDERR("alisp: no enough memory");

}

static void lisp_verbose(struct alisp_instance *instance, const char *fmt, ...)

{

	va_list ap;

	if (!instance->verbose)

		return;

	va_start(ap, fmt);

	snd_output_printf(instance->vout, "alisp: ");

	snd_output_vprintf(instance->vout, fmt, ap);

	snd_output_putc(instance->vout, '\n');

	va_end(ap);

}

static void lisp_error(struct alisp_instance *instance, const char *fmt, ...)

{

	va_list ap;

	if (!instance->warning)

		return;

	va_start(ap, fmt);

	snd_output_printf(instance->eout, "alisp error: ");

	snd_output_vprintf(instance->eout, fmt, ap);

	snd_output_putc(instance->eout, '\n');

	va_end(ap);

}

static void lisp_warn(struct alisp_instance *instance, const char *fmt, ...)

{

	va_list ap;

	if (!instance->warning)

		return;

	va_start(ap, fmt);

	snd_output_printf(instance->wout, "alisp warning: ");

	snd_output_vprintf(instance->wout, fmt, ap);

	snd_output_putc(instance->wout, '\n');

	va_end(ap);

}

static void lisp_debug(struct alisp_instance *instance, const char *fmt, ...)

{

	va_list ap;

	if (!instance->debug)

		return;

	va_start(ap, fmt);

	snd_output_printf(instance->dout, "alisp debug: ");

	snd_output_vprintf(instance->dout, fmt, ap);

	snd_output_putc(instance->dout, '\n');

	va_end(ap);

}

static struct alisp_object * new_object(struct alisp_instance *instance, int type)

{

	struct alisp_object * p;

	if (list_empty(&instance->free_objs_list)) {

		p = (struct alisp_object *)malloc(sizeof(struct alisp_object));

		if (p == NULL) {

			nomem();

			return NULL;

		}

		lisp_debug(instance, "allocating cons %p", p);

	} else {

		p = (struct alisp_object *)instance->free_objs_list.next;

		list_del(&p->list);

		instance->free_objs--;

		lisp_debug(instance, "recycling cons %p", p);

	}

	instance->used_objs++;

	alisp_set_type(p, type);

	alisp_set_refs(p, 1);

	if (type == ALISP_OBJ_CONS) {

		p->value.c.car = &alsa_lisp_nil;

		p->value.c.cdr = &alsa_lisp_nil;

		list_add(&p->list, &instance->used_objs_list[0][ALISP_OBJ_CONS]);

	}

	if (instance->used_objs + instance->free_objs > instance->max_objs)

		instance->max_objs = instance->used_objs + instance->free_objs;

	return p;

}

static void free_object(struct alisp_object * p)

{

	switch (alisp_get_type(p)) {

	case ALISP_OBJ_STRING:

	case ALISP_OBJ_IDENTIFIER:

		free(p->value.s);

		alisp_set_type(p, ALISP_OBJ_INTEGER);

		break;

	default:

		break;

	}

}

static void delete_object(struct alisp_instance *instance, struct alisp_object * p)

{

	if (p == NULL || p == &alsa_lisp_nil || p == &alsa_lisp_t)

		return;

	if (alisp_compare_type(p, ALISP_OBJ_NIL) ||

	    alisp_compare_type(p, ALISP_OBJ_T))

		return;

	assert(alisp_get_refs(p) > 0);

	lisp_debug(instance, "delete cons %p (type = %i, refs = %i) (s = '%s')", p, alisp_get_type(p), alisp_get_refs(p),

			alisp_compare_type(p, ALISP_OBJ_STRING) ||

			alisp_compare_type(p, ALISP_OBJ_IDENTIFIER) ? p->value.s : "???");

	if (alisp_dec_refs(p))

		return;

	list_del(&p->list);

	instance->used_objs--;

	free_object(p);

	if (instance->free_objs >= ALISP_FREE_OBJ_POOL) {

		lisp_debug(instance, "freed cons %p", p);

		free(p);

		return;

	}

	lisp_debug(instance, "moved cons %p to free list", p);

	list_add(&p->list, &instance->free_objs_list);

	instance->free_objs++;

}

static void delete_tree(struct alisp_instance *instance, struct alisp_object * p)

{

	if (p == NULL)

		return;

	if (alisp_compare_type(p, ALISP_OBJ_CONS)) {

		delete_tree(instance, p->value.c.car);

		delete_tree(instance, p->value.c.cdr);

	}

	delete_object(instance, p);

}

static struct alisp_object * incref_object(struct alisp_instance *instance ATTRIBUTE_UNUSED, struct alisp_object * p)

{

	if (p == NULL || p == &alsa_lisp_nil || p == &alsa_lisp_t)

		return p;

	if (alisp_get_refs(p) == ALISP_MAX_REFS) {

		assert(0);

		fprintf(stderr, "OOPS: alsa lisp: incref fatal error\n");

		exit(EXIT_FAILURE);

	}

	alisp_inc_refs(p);

	return p;

}

static struct alisp_object * incref_tree(struct alisp_instance *instance, struct alisp_object * p)

{

	if (p == NULL)

		return NULL;

	if (alisp_compare_type(p, ALISP_OBJ_CONS)) {

		incref_tree(instance, p->value.c.car);

		incref_tree(instance, p->value.c.cdr);

	}

	return incref_object(instance, p);

}

/* Function not used yet. Leave it commented out until we actually use it to

 * avoid compiler complaints */

#if 0

static struct alisp_object * incref_tree_explicit(struct alisp_instance *instance, struct alisp_object * p, struct alisp_object * e)

{

	if (p == NULL)

		return NULL;

	if (alisp_compare_type(p, ALISP_OBJ_CONS)) {

		if (e == p) {

			incref_tree(instance, p->value.c.car);

			incref_tree(instance, p->value.c.cdr);

		} else {

			incref_tree_explicit(instance, p->value.c.car, e);

			incref_tree_explicit(instance, p->value.c.cdr, e);

		}

	}

	if (e == p)

		return incref_object(instance, p);

	return p;

}

#endif

static void free_objects(struct alisp_instance *instance)

{

	struct list_head *pos, *pos1;

	struct alisp_object * p;

	struct alisp_object_pair * pair;

	int i, j;

	for (i = 0; i < ALISP_OBJ_PAIR_HASH_SIZE; i++) {

		list_for_each_safe(pos, pos1, &instance->setobjs_list[i]) {

			pair = list_entry(pos, struct alisp_object_pair, list);

			lisp_debug(instance, "freeing pair: '%s' -> %p", pair->name, pair->value);

			delete_tree(instance, pair->value);

			free((void *)pair->name);

			free(pair);

		}

	}

	for (i = 0; i < ALISP_OBJ_PAIR_HASH_SIZE; i++)

		for (j = 0; j <= ALISP_OBJ_LAST_SEARCH; j++) {

			list_for_each_safe(pos, pos1, &instance->used_objs_list[i][j]) {

				p = list_entry(pos, struct alisp_object, list);

				lisp_warn(instance, "object %p is still referenced %i times!", p, alisp_get_refs(p));

#if 0

				snd_output_printf(instance->wout, ">>>> ");

				princ_object(instance->wout, p);

				snd_output_printf(instance->wout, " <<<<\n");

#endif

				if (alisp_get_refs(p) > 0)

					alisp_set_refs(p, 1);

				delete_object(instance, p);

			}

		}

	list_for_each_safe(pos, pos1, &instance->free_objs_list) {

		p = list_entry(pos, struct alisp_object, list);

		list_del(&p->list);

		free(p);

		lisp_debug(instance, "freed (all) cons %p", p);

	}

}

static struct alisp_object * search_object_identifier(struct alisp_instance *instance, const char *s)

{

	struct list_head * pos;

	struct alisp_object * p;

	list_for_each(pos, &instance->used_objs_list[get_string_hash(s)][ALISP_OBJ_IDENTIFIER]) {

		p = list_entry(pos, struct alisp_object, list);

		if (alisp_get_refs(p) > ALISP_MAX_REFS_LIMIT)

			continue;

		if (!strcmp(p->value.s, s))

			return incref_object(instance, p);

	}

	return NULL;

}

static struct alisp_object * search_object_string(struct alisp_instance *instance, const char *s)

{

	struct list_head * pos;

	struct alisp_object * p;

	list_for_each(pos, &instance->used_objs_list[get_string_hash(s)][ALISP_OBJ_STRING]) {

		p = list_entry(pos, struct alisp_object, list);

		if (!strcmp(p->value.s, s)) {

			if (alisp_get_refs(p) > ALISP_MAX_REFS_LIMIT)

				continue;

			return incref_object(instance, p);

		}

	}

	return NULL;

}

static struct alisp_object * search_object_integer(struct alisp_instance *instance, long in)

{

	struct list_head * pos;

	struct alisp_object * p;

	list_for_each(pos, &instance->used_objs_list[in & ALISP_OBJ_PAIR_HASH_MASK][ALISP_OBJ_INTEGER]) {

		p = list_entry(pos, struct alisp_object, list);

		if (p->value.i == in) {

			if (alisp_get_refs(p) > ALISP_MAX_REFS_LIMIT)

				continue;

			return incref_object(instance, p);

		}

	}

	return NULL;

}

static struct alisp_object * search_object_float(struct alisp_instance *instance, double in)

{

	struct list_head * pos;

	struct alisp_object * p;

	list_for_each(pos, &instance->used_objs_list[(long)in & ALISP_OBJ_PAIR_HASH_MASK][ALISP_OBJ_FLOAT]) {

		p = list_entry(pos, struct alisp_object, list);

		if (p->value.i == in) {

			if (alisp_get_refs(p) > ALISP_MAX_REFS_LIMIT)

				continue;

			return incref_object(instance, p);

		}

	}

	return NULL;

}

static struct alisp_object * search_object_pointer(struct alisp_instance *instance, const void *ptr)

{

	struct list_head * pos;

	struct alisp_object * p;

	list_for_each(pos, &instance->used_objs_list[(long)ptr & ALISP_OBJ_PAIR_HASH_MASK][ALISP_OBJ_POINTER]) {

		p = list_entry(pos, struct alisp_object, list);

		if (p->value.ptr == ptr) {

			if (alisp_get_refs(p) > ALISP_MAX_REFS_LIMIT)

				continue;

			return incref_object(instance, p);

		}

	}

	return NULL;

}

static struct alisp_object * new_integer(struct alisp_instance *instance, long value)

{

	struct alisp_object * obj;

	obj = search_object_integer(instance, value);

	if (obj != NULL)

		return obj;

	obj = new_object(instance, ALISP_OBJ_INTEGER);

	if (obj) {

		list_add(&obj->list, &instance->used_objs_list[value & ALISP_OBJ_PAIR_HASH_MASK][ALISP_OBJ_INTEGER]);

		obj->value.i = value;

	}

	return obj;

}

static struct alisp_object * new_float(struct alisp_instance *instance, double value)

{

	struct alisp_object * obj;

	obj = search_object_float(instance, value);

	if (obj != NULL)

		return obj;

	obj = new_object(instance, ALISP_OBJ_FLOAT);

	if (obj) {

		list_add(&obj->list, &instance->used_objs_list[(long)value & ALISP_OBJ_PAIR_HASH_MASK][ALISP_OBJ_FLOAT]);

		obj->value.f = value;

	}

	return obj;

}

static struct alisp_object * new_string(struct alisp_instance *instance, const char *str)

{

	struct alisp_object * obj;

	obj = search_object_string(instance, str);

	if (obj != NULL)

		return obj;

	obj = new_object(instance, ALISP_OBJ_STRING);

	if (obj)

		list_add(&obj->list, &instance->used_objs_list[get_string_hash(str)][ALISP_OBJ_STRING]);

	if (obj && (obj->value.s = strdup(str)) == NULL) {

		delete_object(instance, obj);

		nomem();

		return NULL;

	}

	return obj;

}

static struct alisp_object * new_identifier(struct alisp_instance *instance, const char *id)

{

	struct alisp_object * obj;

	obj = search_object_identifier(instance, id);

	if (obj != NULL)

		return obj;

	obj = new_object(instance, ALISP_OBJ_IDENTIFIER);

	if (obj)

		list_add(&obj->list, &instance->used_objs_list[get_string_hash(id)][ALISP_OBJ_IDENTIFIER]);

	if (obj && (obj->value.s = strdup(id)) == NULL) {

		delete_object(instance, obj);

		nomem();

		return NULL;

	}

	return obj;

}

static struct alisp_object * new_pointer(struct alisp_instance *instance, const void *ptr)

{

	struct alisp_object * obj;

	obj = search_object_pointer(instance, ptr);

	if (obj != NULL)

		return obj;

	obj = new_object(instance, ALISP_OBJ_POINTER);

	if (obj) {

		list_add(&obj->list, &instance->used_objs_list[(long)ptr & ALISP_OBJ_PAIR_HASH_MASK][ALISP_OBJ_POINTER]);

		obj->value.ptr = ptr;

	}

	return obj;

}

static struct alisp_object * new_cons_pointer(struct alisp_instance * instance, const char *ptr_id, void *ptr)

{

	struct alisp_object * lexpr;

	if (ptr == NULL)

		return &alsa_lisp_nil;

	lexpr = new_object(instance, ALISP_OBJ_CONS);

	if (lexpr == NULL)

		return NULL;

	lexpr->value.c.car = new_string(instance, ptr_id);

	if (lexpr->value.c.car == NULL)

		goto __end;

	lexpr->value.c.cdr = new_pointer(instance, ptr);

	if (lexpr->value.c.cdr == NULL) {

		delete_object(instance, lexpr->value.c.car);

	      __end:

		delete_object(instance, lexpr);

		return NULL;

	}

	return lexpr;

}

void alsa_lisp_init_objects(void) __attribute__ ((constructor));

void alsa_lisp_init_objects(void)

{

	memset(&alsa_lisp_nil, 0, sizeof(alsa_lisp_nil));

	alisp_set_type(&alsa_lisp_nil, ALISP_OBJ_NIL);

	INIT_LIST_HEAD(&alsa_lisp_nil.list);

	memset(&alsa_lisp_t, 0, sizeof(alsa_lisp_t));

	alisp_set_type(&alsa_lisp_t, ALISP_OBJ_T);

	INIT_LIST_HEAD(&alsa_lisp_t.list);

}

/*

 * lexer

 */ 

static int xgetc(struct alisp_instance *instance)

{

	instance->charno++;

	if (instance->lex_bufp > instance->lex_buf)

		return *--(instance->lex_bufp);

	return snd_input_getc(instance->in);

}

static inline void xungetc(struct alisp_instance *instance, int c)

{

	*(instance->lex_bufp)++ = c;

	instance->charno--;

}

static int init_lex(struct alisp_instance *instance)

{

	instance->charno = instance->lineno = 1;

	instance->token_buffer_max = 10;

	if ((instance->token_buffer = (char *)malloc(instance->token_buffer_max)) == NULL) {

		nomem();

		return -ENOMEM;

	}

	instance->lex_bufp = instance->lex_buf;

	return 0;

}

static void done_lex(struct alisp_instance *instance)

{

	free(instance->token_buffer);

}

static char * extend_buf(struct alisp_instance *instance, char *p)

{

	int off = p - instance->token_buffer;

	instance->token_buffer_max += 10;

	instance->token_buffer = (char *)realloc(instance->token_buffer, instance->token_buffer_max);

	if (instance->token_buffer == NULL) {

		nomem();

		return NULL;

	}

	return instance->token_buffer + off;

}

static int gettoken(struct alisp_instance *instance)

{

	char *p;

	int c;

	for (;;) {

		c = xgetc(instance);

		switch (c) {

		case '\n':

			++instance->lineno;

			break;

		case ' ': case '\f': case '\t': case '\v': case '\r':

			break;

		case ';':

			/* Comment: ";".*"\n" */

			while ((c = xgetc(instance)) != '\n' && c != EOF)

				;

			if (c != EOF)

				++instance->lineno;

			break;

		case '?':

			/* Character: "?". */

			c = xgetc(instance);

			sprintf(instance->token_buffer, "%d", c);

			return instance->thistoken = ALISP_INTEGER;

		case '-':

			/* Minus sign: "-". */

			c = xgetc(instance);

			if (!isdigit(c)) {

				xungetc(instance, c);

				c = '-';

				goto got_id;

			}

			xungetc(instance, c);

			c = '-';

			/* FALLTRHU */

		case '0':

		case '1': case '2': case '3':

		case '4': case '5': case '6':

		case '7': case '8': case '9':

			/* Integer: [0-9]+ */

			p = instance->token_buffer;

			instance->thistoken = ALISP_INTEGER;

			do {

			      __ok:

				if (p - instance->token_buffer >= instance->token_buffer_max - 1) {

					p = extend_buf(instance, p);

					if (p == NULL)

						return instance->thistoken = EOF;

				}

				*p++ = c;

				c = xgetc(instance);

				if (c == '.' && instance->thistoken == ALISP_INTEGER) {

					c = xgetc(instance);

					xungetc(instance, c);

					if (isdigit(c)) {

						instance->thistoken = ALISP_FLOAT;

						c = '.';

						goto __ok;

					} else {

						c = '.';

					}

				} else if (c == 'e' && instance->thistoken == ALISP_FLOAT) {

					c = xgetc(instance);

					if (isdigit(c)) {

						instance->thistoken = ALISP_FLOATE;

						goto __ok;

					}

				}

			} while (isdigit(c));

			xungetc(instance, c);

			*p = '\0';

			return instance->thistoken;

		got_id:

		case '!': case '_': case '+': case '*': case '/': case '%':

		case '<': case '>': case '=': case '&':

		case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':

		case 'g': case 'h': case 'i': case 'j': case 'k': case 'l':

		case 'm': case 'n': case 'o': case 'p': case 'q': case 'r':

		case 's': case 't': case 'u': case 'v': case 'w': case 'x':

		case 'y': case 'z':

		case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':

		case 'G': case 'H': case 'I': case 'J': case 'K': case 'L':

		case 'M': case 'N': case 'O': case 'P': case 'Q': case 'R':

		case 'S': case 'T': case 'U': case 'V': case 'W': case 'X':

		case 'Y': case 'Z':

			/* Identifier: [!-/+*%<>=&a-zA-Z_][-/+*%<>=&a-zA-Z_0-9]* */

			p = instance->token_buffer;

			do {

				if (p - instance->token_buffer >= instance->token_buffer_max - 1) {

					p = extend_buf(instance, p);

					if (p == NULL)

						return instance->thistoken = EOF;

				}

				*p++ = c;

				c = xgetc(instance);

			} while (isalnum(c) || strchr("!_-+*/%<>=&", c) != NULL);

			xungetc(instance, c);

			*p = '\0';

			return instance->thistoken = ALISP_IDENTIFIER;

		case '"':

			/* String: "\""([^"]|"\\".)*"\"" */

			p = instance->token_buffer;

			while ((c = xgetc(instance)) != '"' && c != EOF) {

				if (p - instance->token_buffer >= instance->token_buffer_max - 1) {

					p = extend_buf(instance, p);

					if (p == NULL)

						return instance->thistoken = EOF;

				}

				if (c == '\\') {

					c = xgetc(instance);

					switch (c) {

					case '\n': ++instance->lineno; break;

					case 'a': *p++ = '\a'; break;

					case 'b': *p++ = '\b'; break;

					case 'f': *p++ = '\f'; break;

					case 'n': *p++ = '\n'; break;

					case 'r': *p++ = '\r'; break;

					case 't': *p++ = '\t'; break;

					case 'v': *p++ = '\v'; break;

					default: *p++ = c;

					}

				} else {

					if (c == '\n')

						++instance->lineno;

					*p++ = c;

				}

			}

			*p = '\0';

			return instance->thistoken = ALISP_STRING;

		default:

			return instance->thistoken = c;

		}

	}

}

/*

 *  parser

 */

static struct alisp_object * parse_form(struct alisp_instance *instance)

{

	int thistoken;

	struct alisp_object * p, * first = NULL, * prev = NULL;

	while ((thistoken = gettoken(instance)) != ')' && thistoken != EOF) {

		/*

		 * Parse a dotted pair notation.

		 */

		if (thistoken == '.') {

			gettoken(instance);

			if (prev == NULL) {

				lisp_error(instance, "unexpected '.'");

			      __err:

				delete_tree(instance, first);

				return NULL;

			}

			prev->value.c.cdr = parse_object(instance, 1);

			if (prev->value.c.cdr == NULL)

				goto __err;

			if ((thistoken = gettoken(instance)) != ')') {

				lisp_error(instance, "expected ')'");

				goto __err;

			}

			break;

		}

		p = new_object(instance, ALISP_OBJ_CONS);

		if (p == NULL)

			goto __err;

		if (first == NULL)

			first = p;

		if (prev != NULL)

			prev->value.c.cdr = p;

		p->value.c.car = parse_object(instance, 1);

		if (p->value.c.car == NULL)

			goto __err;

		prev = p;

	}

	if (first == NULL)

		return &alsa_lisp_nil;

	else

		return first;

}

static struct alisp_object * quote_object(struct alisp_instance *instance, struct alisp_object * obj)

{

	struct alisp_object * p;

	if (obj == NULL)

		goto __end1;

	p = new_object(instance, ALISP_OBJ_CONS);

	if (p == NULL)

		goto __end1;

	p->value.c.car = new_identifier(instance, "quote");

	if (p->value.c.car == NULL)

		goto __end;

	p->value.c.cdr = new_object(instance, ALISP_OBJ_CONS);

	if (p->value.c.cdr == NULL) {

		delete_object(instance, p->value.c.car);

	      __end:

		delete_object(instance, p);

	      __end1:

		delete_tree(instance, obj);

		return NULL;

	}

	p->value.c.cdr->value.c.car = obj;

	return p;

}

static inline struct alisp_object * parse_quote(struct alisp_instance *instance)

{

	return quote_object(instance, parse_object(instance, 0));

}

static struct alisp_object * parse_object(struct alisp_instance *instance, int havetoken)

{

	int thistoken;

	struct alisp_object * p = NULL;

	if (!havetoken)

		thistoken = gettoken(instance);

	else

		thistoken = instance->thistoken;

	switch (thistoken) {

	case EOF:

		break;

	case '(':

		p = parse_form(instance);

		break;

	case '\'':

		p = parse_quote(instance);

		break;

	case ALISP_IDENTIFIER:

		if (!strcmp(instance->token_buffer, "t"))

			p = &alsa_lisp_t;

		else if (!strcmp(instance->token_buffer, "nil"))

			p = &alsa_lisp_nil;

		else {

			p = new_identifier(instance, instance->token_buffer);

		}

		break;

	case ALISP_INTEGER: {

		p = new_integer(instance, atol(instance->token_buffer));

		break;

	}

	case ALISP_FLOAT:

	case ALISP_FLOATE: {

		p = new_float(instance, atof(instance->token_buffer));

		break;

	}

	case ALISP_STRING:

		p = new_string(instance, instance->token_buffer);

		break;

	default:

		lisp_warn(instance, "%d:%d: unexpected character `%c'", instance->lineno, instance->charno, thistoken);

		break;

	}

	return p;

}

/*

 *  object manipulation

 */

static struct alisp_object_pair * set_object_direct(struct alisp_instance *instance, struct alisp_object * name, struct alisp_object * value)

{

	struct alisp_object_pair *p;

	const char *id;

	id = name->value.s;

	p = (struct alisp_object_pair *)malloc(sizeof(struct alisp_object_pair));

	if (p == NULL) {

		nomem();

		return NULL;

	}

	p->name = strdup(id);

	if (p->name == NULL) {

		delete_tree(instance, value);

		free(p);

		return NULL;

	}

	list_add(&p->list, &instance->setobjs_list[get_string_hash(id)]);

	p->value = value;

	return p;

}

static int check_set_object(struct alisp_instance * instance, struct alisp_object * name)

{

	if (name == &alsa_lisp_nil) {

		lisp_warn(instance, "setting the value of a nil object");

		return 0;

	}

	if (name == &alsa_lisp_t) {

		lisp_warn(instance, "setting the value of a t object");

		return 0;

	}

	if (!alisp_compare_type(name, ALISP_OBJ_IDENTIFIER) &&

	    !alisp_compare_type(name, ALISP_OBJ_STRING)) {

		lisp_warn(instance, "setting the value of an object with non-indentifier");

		return 0;

	}

	return 1;

}

static struct alisp_object_pair * set_object(struct alisp_instance *instance, struct alisp_object * name, struct alisp_object * value)

{

	struct list_head *pos;

	struct alisp_object_pair *p;

	const char *id;

	if (name == NULL || value == NULL)

		return NULL;

	id = name->value.s;

	list_for_each(pos, &instance->setobjs_list[get_string_hash(id)]) {

		p = list_entry(pos, struct alisp_object_pair, list);

		if (!strcmp(p->name, id)) {