Update of /cvsroot/alsa/alsa-lib/src/alisp
In directory sc8-pr-cvs1:/tmp/cvs-serv5084/src/alisp
Modified Files:
Makefile.am alisp.c alisp_local.h
Added Files:
alisp_snd.c
Log Message:
Added snd_hctl_open_ctl() function.
alisp massive extensions and tested ALSA function bindings.
--- NEW FILE: alisp_snd.c ---
/*
* ALSA lisp implementation - sound related commands
* Copyright (c) 2003 by Jaroslav Kysela <[EMAIL PROTECTED]>
*
*
* 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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*
*/
struct acall_table {
const char *name;
struct alisp_object * (*func) (struct alisp_instance *instance, struct
acall_table * item, struct alisp_object * args);
void * xfunc;
const char *prefix;
};
/*
* helper functions
*/
static inline const void *get_pointer(struct alisp_object * obj)
{
if (obj->type == ALISP_OBJ_POINTER)
return obj->value.ptr;
return NULL;
}
static const char *get_string(struct alisp_object * obj, const char * deflt)
{
if (obj == &alsa_lisp_t)
return "true";
if (obj->type == ALISP_OBJ_STRING)
return obj->value.s;
if (obj->type == ALISP_OBJ_IDENTIFIER)
return obj->value.id;
return deflt;
}
struct flags {
const char *key;
unsigned int mask;
};
static unsigned int get_flags(struct alisp_object * obj, const struct flags * flags,
unsigned int deflt)
{
const char *key;
int invert;
unsigned int result;
const struct flags *ptr;
if (obj == &alsa_lisp_nil)
return deflt;
result = deflt;
do {
key = get_string(obj, NULL);
if (key) {
invert = key[0] == '!';
key += invert;
ptr = flags;
while (ptr->key) {
if (!strcmp(ptr->key, key)) {
if (invert)
result &= ~ptr->mask;
else
result |= ptr->mask;
break;
}
ptr++;
}
}
obj = cdr(obj);
} while (obj != &alsa_lisp_nil);
return result;
}
static const void *get_ptr(struct alisp_object * obj, const char *_ptr_id)
{
const char *ptr_id;
ptr_id = get_string(car(obj), NULL);
if (ptr_id == NULL)
return NULL;
if (strcmp(ptr_id, _ptr_id))
return NULL;
return get_pointer(cdr(obj));
}
static inline struct alisp_object * new_result(struct alisp_instance * instance, int
err)
{
return new_integer(instance, err);
}
static struct alisp_object * new_result1(struct alisp_instance * instance, int err,
const char *ptr_id, void *ptr)
{
struct alisp_object * lexpr, * p1;
if (err < 0)
ptr = NULL;
lexpr = new_object(instance, ALISP_OBJ_CONS);
if (lexpr == NULL)
return NULL;
lexpr->value.c.car = new_integer(instance, err);
if (lexpr->value.c.car == NULL)
return NULL;
p1 = lexpr->value.c.cdr = new_object(instance, ALISP_OBJ_CONS);
if (p1 == NULL)
return NULL;
p1->value.c.car = new_object(instance, ALISP_OBJ_CONS);
if ((p1 = p1->value.c.car) == NULL)
return NULL;
p1->value.c.car = new_string(instance, ptr_id);
if (p1->value.c.car == NULL)
return NULL;
p1->value.c.cdr = new_pointer(instance, ptr);
if (p1->value.c.cdr == NULL)
return NULL;
return lexpr;
}
/*
* macros
*/
/*
* HCTL functions
*/
typedef int (*snd_xxx_open_t)(void **rctl, const char *name, int mode);
typedef int (*snd_xxx_open1_t)(void **rctl, void *handle);
typedef int (*snd_xxx_close_t)(void **rctl);
static struct alisp_object * FA_xxx_open(struct alisp_instance * instance, struct
acall_table * item, struct alisp_object * args)
{
const char *name;
int err, mode;
void *handle;
static struct flags flags[] = {
{ "nonblock", SND_CTL_NONBLOCK },
{ "async", SND_CTL_ASYNC },
{ "readonly", SND_CTL_READONLY },
{ NULL, 0 }
};
name = get_string(eval(instance, car(args)), NULL);
if (name == NULL)
return &alsa_lisp_nil;
mode = get_flags(eval(instance, car(cdr(args))), flags, 0);
err = ((snd_xxx_open_t)item->xfunc)(&handle, name, mode);
return new_result1(instance, err, item->prefix, handle);
}
static struct alisp_object * FA_xxx_open1(struct alisp_instance * instance, struct
acall_table * item, struct alisp_object * args)
{
int err;
void *handle;
const char *prefix1 = "ctl";
args = eval(instance, args);
handle = (void *)get_ptr(args, prefix1);
if (handle == NULL)
return &alsa_lisp_nil;
err = ((snd_xxx_open1_t)item->xfunc)(&handle, handle);
return new_result1(instance, err, item->prefix, handle);
}
static struct alisp_object * FA_xxx_close(struct alisp_instance * instance, struct
acall_table * item, struct alisp_object * args)
{
void *handle;
args = eval(instance, args);
handle = (void *)get_ptr(args, item->prefix);
if (handle == NULL)
return &alsa_lisp_nil;
return new_result(instance, ((snd_xxx_close_t)item->xfunc)(handle));
}
/*
* main code
*/
static struct acall_table acall_table[] = {
{ "ctl_close", &FA_xxx_close, (void *)&snd_ctl_close, "ctl" },
{ "ctl_open", &FA_xxx_open, (void *)&snd_ctl_open, "ctl" },
{ "hctl_close", &FA_xxx_close, (void *)&snd_hctl_close, "hctl" },
{ "hctl_open", &FA_xxx_open, (void *)&snd_hctl_open, "hctl" },
{ "hctl_open_ctl", &FA_xxx_open1, (void *)&snd_hctl_open_ctl, "hctl" },
};
static int acall_compar(const void *p1, const void *p2)
{
return strcmp(((struct acall_table *)p1)->name,
((struct acall_table *)p2)->name);
}
static struct alisp_object * F_acall(struct alisp_instance *instance, struct
alisp_object * args)
{
struct alisp_object * p1, *p2;
struct acall_table key, *item;
p1 = eval(instance, car(args));
if (p1->type != ALISP_OBJ_IDENTIFIER && p1->type != ALISP_OBJ_STRING)
return &alsa_lisp_nil;
p2 = car(cdr(args));
key.name = p1->value.s;
if ((item = bsearch(&key, acall_table,
sizeof acall_table / sizeof acall_table[0],
sizeof acall_table[0], acall_compar)) != NULL)
return item->func(instance, item, p2);
lisp_warn(instance, "acall function %s' is undefined", p1->value.s);
return &alsa_lisp_nil;
}
static struct intrinsic snd_intrinsics[] = {
{ "acall", F_acall },
};
Index: Makefile.am
===================================================================
RCS file: /cvsroot/alsa/alsa-lib/src/alisp/Makefile.am,v
retrieving revision 1.1
retrieving revision 1.2
diff -u -r1.1 -r1.2
--- Makefile.am 24 Jun 2003 19:30:09 -0000 1.1
+++ Makefile.am 27 Jul 2003 20:20:26 -0000 1.2
@@ -1,5 +1,7 @@
EXTRA_LTLIBRARIES = libalisp.la
+EXTRA_DIST = alisp_snd.c
+
libalisp_la_SOURCES = alisp.c
noinst_HEADERS = alisp_local.h
Index: alisp.c
===================================================================
RCS file: /cvsroot/alsa/alsa-lib/src/alisp/alisp.c,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- alisp.c 26 Jul 2003 15:19:27 -0000 1.3
+++ alisp.c 27 Jul 2003 20:20:26 -0000 1.4
@@ -142,6 +142,89 @@
return p;
}
+static void free_object(struct alisp_object * p)
+{
+ switch (p->type) {
+ case ALISP_OBJ_STRING:
+ if (p->value.s)
+ free(p->value.s);
+ break;
+ case ALISP_OBJ_IDENTIFIER:
+ if (p->value.id)
+ free(p->value.id);
+ break;
+ }
+}
+
+static void free_objects(struct alisp_instance *instance)
+{
+ struct alisp_object * p, * next;
+
+ for (p = instance->used_objs_list; p != NULL; p = next) {
+ next = p->next;
+ free_object(p);
+ free(p);
+ }
+ for (p = instance->free_objs_list; p != NULL; p = next) {
+ next = p->next;
+ free(p);
+ }
+}
+
+static struct alisp_object * new_integer(struct alisp_instance *instance, long value)
+{
+ struct alisp_object * obj;
+
+ obj = new_object(instance, ALISP_OBJ_INTEGER);
+ if (obj)
+ obj->value.i = value;
+ return obj;
+}
+
+static struct alisp_object * new_float(struct alisp_instance *instance, double value)
+{
+ struct alisp_object * obj;
+
+ obj = new_object(instance, ALISP_OBJ_FLOAT);
+ if (obj)
+ obj->value.f = value;
+ return obj;
+}
+
+static struct alisp_object * new_string(struct alisp_instance *instance, const char
*str)
+{
+ struct alisp_object * obj;
+
+ obj = new_object(instance, ALISP_OBJ_STRING);
+ if (obj && (obj->value.s = strdup(str)) == NULL) {
+ nomem();
+ return NULL;
+ }
+ return obj;
+}
+
+static struct alisp_object * new_identifier(struct alisp_instance *instance, const
char *id)
+{
+ struct alisp_object * obj;
+
+ obj = new_object(instance, ALISP_OBJ_IDENTIFIER);
+ if (obj && (obj->value.id = strdup(id)) == NULL) {
+ nomem();
+ return NULL;
+ }
+ return obj;
+}
+
+static struct alisp_object * new_pointer(struct alisp_instance *instance, const void
*ptr)
+{
+ struct alisp_object * obj;
+
+ obj = new_object(instance, ALISP_OBJ_POINTER);
+ if (obj)
+ obj->value.ptr = ptr;
+ return obj;
+}
+
static struct alisp_object * search_object_identifier(struct alisp_instance
*instance, const char *s)
{
struct alisp_object * p;
@@ -164,7 +247,7 @@
return NULL;
}
-static struct alisp_object * search_object_integer(struct alisp_instance *instance,
int in)
+static struct alisp_object * search_object_integer(struct alisp_instance *instance,
long in)
{
struct alisp_object * p;
@@ -448,13 +531,9 @@
if (p == NULL)
return NULL;
- p->value.c.car = new_object(instance, ALISP_OBJ_IDENTIFIER);
+ p->value.c.car = new_identifier(instance, "quote");
if (p->value.c.car == NULL)
return NULL;
- if ((p->value.c.car->value.id = strdup("quote")) == NULL) {
- nomem();
- return NULL;
- }
p->value.c.cdr = new_object(instance, ALISP_OBJ_CONS);
if (p->value.c.cdr == NULL)
return NULL;
@@ -490,48 +569,28 @@
else if (!strcmp(instance->token_buffer, "nil"))
p = &alsa_lisp_nil;
else {
- if ((p = search_object_identifier(instance,
instance->token_buffer)) == NULL) {
- p = new_object(instance, ALISP_OBJ_IDENTIFIER);
- if (p) {
- if ((p->value.id =
strdup(instance->token_buffer)) == NULL) {
- nomem();
- return NULL;
- }
- }
- }
+ if ((p = search_object_identifier(instance,
instance->token_buffer)) == NULL)
+ p = new_identifier(instance, instance->token_buffer);
}
break;
case ALISP_INTEGER: {
long i;
i = atol(instance->token_buffer);
- if ((p = search_object_integer(instance, i)) == NULL) {
- p = new_object(instance, ALISP_OBJ_INTEGER);
- if (p)
- p->value.i = i;
- }
+ if ((p = search_object_integer(instance, i)) == NULL)
+ p = new_integer(instance, i);
break;
}
case ALISP_FLOAT:
case ALISP_FLOATE: {
double f;
f = atof(instance->token_buffer);
- if ((p = search_object_float(instance, f)) == NULL) {
- p = new_object(instance, ALISP_OBJ_FLOAT);
- if (p)
- p->value.f = f;
- }
+ if ((p = search_object_float(instance, f)) == NULL)
+ p = new_float(instance, f);
break;
}
case ALISP_STRING:
- if ((p = search_object_string(instance, instance->token_buffer)) ==
NULL) {
- p = new_object(instance, ALISP_OBJ_STRING);
- if (p) {
- if ((p->value.s = strdup(instance->token_buffer)) ==
NULL) {
- nomem();
- return NULL;
- }
- }
- }
+ if ((p = search_object_string(instance, instance->token_buffer)) ==
NULL)
+ p = new_string(instance, instance->token_buffer);
break;
default:
lisp_warn(instance, "%d:%d: unexpected character `%c'",
instance->lineno, instance->charno, thistoken);
@@ -716,14 +775,7 @@
if (p->gc != instance->gc_id && p->gc > 0) {
/* Remove unreferenced object. */
lisp_debug(instance, "** collecting cons %p", p);
- switch (p->type) {
- case ALISP_OBJ_STRING:
- free(p->value.s);
- break;
- case ALISP_OBJ_IDENTIFIER:
- free(p->value.id);
- break;
- }
+ free_object(p);
p->next = instance->free_objs_list;
instance->free_objs_list = p;
@@ -821,13 +873,9 @@
} while (p != &alsa_lisp_nil);
if (type == ALISP_OBJ_INTEGER) {
- p1 = new_object(instance, ALISP_OBJ_INTEGER);
- if (p1)
- p1->value.i = v;
+ p1 = new_integer(instance, v);
} else {
- p1 = new_object(instance, ALISP_OBJ_FLOAT);
- if (p1)
- p1->value.f = f;
+ p1 = new_float(instance, f);
}
return p1;
}
@@ -869,13 +917,9 @@
} while (p != &alsa_lisp_nil);
if (type == ALISP_OBJ_INTEGER) {
- p1 = new_object(instance, ALISP_OBJ_INTEGER);
- if (p1)
- p1->value.i = v;
+ p1 = new_integer(instance, v);
} else {
- p1 = new_object(instance, ALISP_OBJ_FLOAT);
- if (p1)
- p1->value.f = f;
+ p1 = new_object(instance, f);
}
return p1;
}
@@ -907,13 +951,9 @@
} while (p != &alsa_lisp_nil);
if (type == ALISP_OBJ_INTEGER) {
- p1 = new_object(instance, ALISP_OBJ_INTEGER);
- if (p1)
- p1->value.i = v;
+ p1 = new_integer(instance, v);
} else {
- p1 = new_object(instance, ALISP_OBJ_FLOAT);
- if (p1)
- p1->value.f = f;
+ p1 = new_float(instance, f);
}
return p1;
@@ -969,13 +1009,9 @@
} while (p != &alsa_lisp_nil);
if (type == ALISP_OBJ_INTEGER) {
- p1 = new_object(instance, ALISP_OBJ_INTEGER);
- if (p1)
- p1->value.i = v;
+ p1 = new_integer(instance, v);
} else {
- p1 = new_object(instance, ALISP_OBJ_FLOAT);
- if (p1)
- p1->value.f = f;
+ p1 = new_float(instance, f);
}
return p1;
@@ -1151,9 +1187,6 @@
f2 = p2->type == ALISP_OBJ_INTEGER ? p2->value.i : p2->value.f;
if (f1 == f2)
return &alsa_lisp_t;
- } else if ((p1->type == ALISP_OBJ_STRING || p2->type == ALISP_OBJ_STRING)) {
- if (!strcmp(p1->value.s, p2->value.s))
- return &alsa_lisp_t;
} else {
lisp_warn(instance, "comparison with a non integer or float operand");
}
@@ -1216,6 +1249,9 @@
case ALISP_OBJ_FLOAT:
snd_output_printf(out, "%f", p->value.f);
break;
+ case ALISP_OBJ_POINTER:
+ snd_output_printf(out, "<%p>", p->value.ptr);
+ break;
case ALISP_OBJ_CONS:
snd_output_putc(out, '(');
princ_cons(out, p);
@@ -1255,8 +1291,10 @@
case ALISP_OBJ_T:
case ALISP_OBJ_NIL:
case ALISP_OBJ_INTEGER:
+ case ALISP_OBJ_FLOAT:
case ALISP_OBJ_STRING:
case ALISP_OBJ_IDENTIFIER:
+ case ALISP_OBJ_POINTER:
return &alsa_lisp_t;
}
@@ -1305,38 +1343,69 @@
return first;
}
-/*
- * Syntax: (eq expr1 expr2)
- */
-static struct alisp_object * F_eq(struct alisp_instance *instance, struct
alisp_object * args)
+static inline int eq(struct alisp_object * p1, struct alisp_object * p2)
{
- struct alisp_object * p1, * p2;
-
- p1 = eval(instance, car(args));
- p2 = eval(instance, car(cdr(args)));
+ return p1 == p2;
+}
- if (p1 == p2)
- return &alsa_lisp_t;
+static int equal(struct alisp_object * p1, struct alisp_object * p2)
+{
+ if (eq(p1, p1))
+ return 1;
if (p1->type == ALISP_OBJ_CONS || p2->type == ALISP_OBJ_CONS)
- return &alsa_lisp_nil;
+ return 0;
if (p1->type == p2->type)
switch (p1->type) {
case ALISP_OBJ_IDENTIFIER:
if (!strcmp(p1->value.id, p2->value.id))
- return &alsa_lisp_t;
- return &alsa_lisp_nil;
+ return 1;
+ return 0;
case ALISP_OBJ_STRING:
if (!strcmp(p1->value.s, p2->value.s))
- return &alsa_lisp_t;
- return &alsa_lisp_nil;
+ return 1;
+ return 0;
case ALISP_OBJ_INTEGER:
if (p1->value.i == p2->value.i)
- return &alsa_lisp_t;
- return &alsa_lisp_nil;
+ return 1;
+ return 0;
+ case ALISP_OBJ_FLOAT:
+ if (p1->value.i == p2->value.i)
+ return 1;
+ return 0;
}
+ return 0;
+}
+
+/*
+ * Syntax: (eq expr1 expr2)
+ */
+static struct alisp_object * F_eq(struct alisp_instance *instance, struct
alisp_object * args)
+{
+ struct alisp_object * p1, * p2;
+
+ p1 = eval(instance, car(args));
+ p2 = eval(instance, car(cdr(args)));
+
+ if (eq(p1, p2))
+ return &alsa_lisp_t;
+ return &alsa_lisp_nil;
+}
+
+/*
+ * Syntax: (equal expr1 expr2)
+ */
+static struct alisp_object * F_equal(struct alisp_instance *instance, struct
alisp_object * args)
+{
+ struct alisp_object * p1, * p2;
+
+ p1 = eval(instance, car(args));
+ p2 = eval(instance, car(cdr(args)));
+
+ if (equal(p1, p2))
+ return &alsa_lisp_t;
return &alsa_lisp_nil;
}
@@ -1584,13 +1653,9 @@
lexpr = new_object(instance, ALISP_OBJ_CONS);
if (lexpr) {
- lexpr->value.c.car = new_object(instance, ALISP_OBJ_IDENTIFIER);
+ lexpr->value.c.car = new_identifier(instance, "lambda");
if (lexpr->value.c.car == NULL)
return NULL;
- if ((lexpr->value.c.car->value.id = strdup("lambda")) == NULL) {
- nomem();
- return NULL;
- }
if ((lexpr->value.c.cdr = new_object(instance, ALISP_OBJ_CONS)) ==
NULL)
return NULL;
lexpr->value.c.cdr->value.c.car = p2;
@@ -1679,14 +1744,8 @@
if (p->type == ALISP_INTEGER)
return p;
- if (p->type == ALISP_FLOAT) {
- struct alisp_object * p1;
- p1 = new_object(instance, ALISP_OBJ_INTEGER);
- if (p1 == NULL)
- return NULL;
- p1->value.i = floor(p->value.f);
- return p1;
- }
+ if (p->type == ALISP_FLOAT)
+ return new_integer(instance, floor(p->value.f));
lisp_warn(instance, "expected an integer or float for integer conversion");
return &alsa_lisp_nil;
@@ -1702,14 +1761,8 @@
if (p->type == ALISP_FLOAT)
return p;
- if (p->type == ALISP_INTEGER) {
- struct alisp_object * p1;
- p1 = new_object(instance, ALISP_OBJ_FLOAT);
- if (p1 == NULL)
- return NULL;
- p1->value.f = p->value.i;
- return p1;
- }
+ if (p->type == ALISP_INTEGER)
+ return new_float(instance, p->value.i);
lisp_warn(instance, "expected an integer or float for integer conversion");
return &alsa_lisp_nil;
@@ -1726,27 +1779,95 @@
if (p->type == ALISP_STRING)
return p;
if (p->type == ALISP_INTEGER || p->type == ALISP_FLOAT) {
- struct alisp_object * p1;
char buf[64];
- p1 = new_object(instance, ALISP_OBJ_STRING);
- if (p1 == NULL)
- return NULL;
if (p->type == ALISP_INTEGER) {
snprintf(buf, sizeof(buf), "%ld", p->value.i);
} else {
snprintf(buf, sizeof(buf), "%.f", p->value.f);
}
- if ((p1->value.s = strdup(buf)) == NULL) {
- nomem();
- return &alsa_lisp_nil;
- }
- return p1;
+ return new_string(instance, buf);
}
lisp_warn(instance, "expected an integer or float for integer conversion");
return &alsa_lisp_nil;
}
+/*
+ * Syntax: (assoc key alist)
+ */
+struct alisp_object * F_assoc(struct alisp_instance *instance, struct alisp_object *
args)
+{
+ struct alisp_object * p1, *p2;
+
+ p1 = eval(instance, car(args));
+ p2 = eval(instance, car(cdr(args)));
+
+ do {
+ if (eq(p1, car(car(p2))))
+ return car(p2);
+ p2 = cdr(p2);
+ } while (p2 != &alsa_lisp_nil);
+
+ return &alsa_lisp_nil;
+}
+
+/*
+ * Syntax: (rassoc value alist)
+ */
+struct alisp_object * F_rassoc(struct alisp_instance *instance, struct alisp_object *
args)
+{
+ struct alisp_object * p1, *p2;
+
+ p1 = eval(instance, car(args));
+ p2 = eval(instance, car(cdr(args)));
+
+ do {
+ if (eq(p1, cdr(car(p2))))
+ return car(p2);
+ p2 = cdr(p2);
+ } while (p2 != &alsa_lisp_nil);
+
+ return &alsa_lisp_nil;
+}
+
+/*
+ * Syntax: (assq key alist)
+ */
+struct alisp_object * F_assq(struct alisp_instance *instance, struct alisp_object *
args)
+{
+ struct alisp_object * p1, *p2;
+
+ p1 = eval(instance, car(args));
+ p2 = eval(instance, car(cdr(args)));
+
+ do {
+ if (equal(p1, car(car(p2))))
+ return car(p2);
+ p2 = cdr(p2);
+ } while (p2 != &alsa_lisp_nil);
+
+ return &alsa_lisp_nil;
+}
+
+/*
+ * Syntax: (rassq value alist)
+ */
+struct alisp_object * F_rassq(struct alisp_instance *instance, struct alisp_object *
args)
+{
+ struct alisp_object * p1, *p2;
+
+ p1 = eval(instance, car(args));
+ p2 = eval(instance, car(cdr(args)));
+
+ do {
+ if (equal(p1, cdr(car(p2))))
+ return car(p2);
+ p2 = cdr(p2);
+ } while (p2 != &alsa_lisp_nil);
+
+ return &alsa_lisp_nil;
+}
+
static struct alisp_object * F_dump_memory(struct alisp_instance *instance, struct
alisp_object * args)
{
struct alisp_object * p = car(args);
@@ -1798,6 +1919,8 @@
{ ">", F_gt },
{ ">=", F_ge },
{ "and", F_and },
+ { "assoc", F_assoc },
+ { "assq", F_assq },
{ "atom", F_atom },
{ "car", F_car },
{ "cdr", F_cdr },
@@ -1805,6 +1928,7 @@
{ "cons", F_cons },
{ "defun", F_defun },
{ "eq", F_eq },
+ { "equal", F_equal },
{ "eval", F_eval },
{ "float", F_float },
{ "garbage-collect", F_gc },
@@ -1820,6 +1944,8 @@
{ "prog2", F_prog2 },
{ "progn", F_progn },
{ "quote", F_quote },
+ { "rassoc", F_rassoc },
+ { "rassq", F_rassq },
{ "set", F_set },
{ "setf", F_setq },
{ "setq", F_setq },
@@ -1829,6 +1955,8 @@
{ "while", F_while },
};
+#include "alisp_snd.c"
+
static int compar(const void *p1, const void *p2)
{
return strcmp(((struct intrinsic *)p1)->name,
@@ -1850,6 +1978,11 @@
sizeof intrinsics[0], compar)) != NULL)
return item->func(instance, p2);
+ if ((item = bsearch(&key, snd_intrinsics,
+ sizeof snd_intrinsics / sizeof snd_intrinsics[0],
+ sizeof snd_intrinsics[0], compar)) != NULL)
+ return item->func(instance, p2);
+
if ((p3 = get_object(instance, p1)) != &alsa_lisp_nil)
return eval_func(instance, p3, p2);
else
@@ -1883,7 +2016,7 @@
* main routine
*/
-int alsa_lisp(struct alisp_cfg *cfg)
+int alsa_lisp(struct alisp_cfg *cfg, struct alisp_instance **_instance)
{
struct alisp_instance *instance;
struct alisp_object *p, *p1;
@@ -1932,7 +2065,18 @@
}
done_lex(instance);
- free(instance);
+ if (_instance)
+ *_instance = instance;
+ else
+ alsa_lisp_free(instance);
return 0;
+}
+
+void alsa_lisp_free(struct alisp_instance *instance)
+{
+ if (instance == NULL)
+ return;
+ free_objects(instance);
+ free(instance);
}
Index: alisp_local.h
===================================================================
RCS file: /cvsroot/alsa/alsa-lib/src/alisp/alisp_local.h,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- alisp_local.h 26 Jul 2003 15:19:27 -0000 1.3
+++ alisp_local.h 27 Jul 2003 20:20:26 -0000 1.4
@@ -36,6 +36,7 @@
ALISP_OBJ_FLOAT,
ALISP_OBJ_IDENTIFIER,
ALISP_OBJ_STRING,
+ ALISP_OBJ_POINTER,
ALISP_OBJ_CONS
};
@@ -47,6 +48,7 @@
char *s;
long i;
double f;
+ const void *ptr;
struct {
struct alisp_object *car;
struct alisp_object *cdr;
-------------------------------------------------------
This SF.Net email sponsored by: Free pre-built ASP.NET sites including
Data Reports, E-commerce, Portals, and Forums are available now.
Download today and enter to win an XBOX or Visual Studio .NET.
http://aspnet.click-url.com/go/psa00100003ave/direct;at.aspnet_072303_01/01
_______________________________________________
Alsa-cvslog mailing list
[EMAIL PROTECTED]
https://lists.sourceforge.net/lists/listinfo/alsa-cvslog
