Added snd_hctl_open_ctl() function.

alisp massive extensions and tested ALSA function bindings.

alsalisp/alsalisp.c

@@ -68,7 +68,7 @@ static void interpret_filename(const char *file)
 		cfg.out = cfg.eout = cfg.vout = cfg.wout = cfg.dout = out;
 		cfg.root = root;
 		cfg.node = root;
-		err = alsa_lisp(&cfg);
+		err = alsa_lisp(&cfg, NULL);
 	}
 	if (err < 0)
 		fprintf(stderr, "alsa lisp returned error %i (%s)\n", err, strerror(err));

alsalisp/hctl.lisp

@@ -0,0 +1,49 @@
+(setq ctl (acall 'ctl_open ('default nil)))
+(setq ctl (car (cdr ctl)))
+(setq hctl (acall 'hctl_open_ctl ctl))
+(setq hctl (car (cdr hctl)))
+(setq hctl (acall 'hctl_close hctl))
+
+(setq hctl (acall 'hctl_open ('default nil)))
+(if (= (car hctl) 0)
+  (progn
+    (princ "open success: " hctl "\n")
+    (setq hctl (car (cdr hctl)))
+    (princ "open hctl: " hctl "\n")
+    (setq hctl (acall 'hctl_close hctl))
+    (if (= hctl 0)
+      (princ "close success\n")
+      (princ "close failed: " hctl "\n")
+    )
+  )
+  (progn
+    (princ "open failed: " hctl "\n")
+  )
+)
+
+(setq ctl (acall 'ctl_open ('default nil)))
+(if (= (car ctl) 0)
+  (progn
+    (princ "ctl open success: " ctl "\n")
+    (setq ctl (car (cdr ctl)))
+    (setq hctl (acall 'hctl_open_ctl ctl))
+    (if (= (car hctl) 0)
+      (progn
+        (princ "hctl open success: " hctl "\n")
+        (setq hctl (car (cdr hctl)))
+        (princ "open hctl: " hctl "\n")
+        (setq hctl (acall 'hctl_close hctl))
+        (if (= hctl 0)
+          (princ "hctl close success\n")
+          (princ "hctl close failed: " hctl "\n")
+        )
+      )
+      (progn
+        (princ "hctl open failed: " ctl "\n")
+      )
+    )
+  )
+  (progn
+    (princ "ctl open failed: " ctl "\n")
+  )
+)

alsalisp/hello.lisp

@@ -13,3 +13,8 @@
 
 (princ "Float test 1.1 + 1.35 = " (+ 1.1 1.35) "\n")
 (princ "Factorial of 10.0: " (factorial 10.0) "\n")
+
+(setq alist '((one . first) (two . second) (three . third)))
+(princ "alist = " alist "\n")
+(princ "alist assoc one = " (assoc 'one alist) "\n")
+(princ "alist rassoc third = " (rassoc 'third alist) "\n")

include/alisp.h

@@ -29,11 +29,12 @@ struct alisp_cfg {
 	snd_output_t *vout;	/* verbose output */
 	snd_output_t *wout;	/* warning output */
 	snd_output_t *dout;	/* debug output */
-	snd_config_t *root;
-	snd_config_t *node;
 };
 
-int alsa_lisp(struct alisp_cfg *cfg);
+struct alisp_instance;
+
+int alsa_lisp(struct alisp_cfg *cfg, struct alisp_instance **instance);
+void alsa_lisp_free(struct alisp_instance *instance);
 
 extern struct alisp_object alsa_lisp_nil;
 extern struct alisp_object alsa_lisp_t;

include/control.h

@@ -450,6 +450,7 @@ typedef int (*snd_hctl_elem_callback_t)(snd_hctl_elem_t *elem,
 					unsigned int mask);
 
 int snd_hctl_open(snd_hctl_t **hctl, const char *name, int mode);
+int snd_hctl_open_ctl(snd_hctl_t **hctlp, snd_ctl_t *ctl);
 int snd_hctl_close(snd_hctl_t *hctl);
 int snd_hctl_nonblock(snd_hctl_t *hctl, int nonblock);
 int snd_hctl_poll_descriptors_count(snd_hctl_t *hctl);

src/Versions

@@ -118,6 +118,7 @@ ALSA_0.9.5 {
 ALSA_0.9.6 {
   global:
 
+    snd_hctl_open_ctl;
     snd_seq_port_info_get_timestamping;
     snd_seq_port_info_get_timestamp_real;
     snd_seq_port_info_get_timestamp_queue;

src/alisp/Makefile.am

@@ -1,5 +1,7 @@
 EXTRA_LTLIBRARIES = libalisp.la
 
+EXTRA_DIST = alisp_snd.c
+
 libalisp_la_SOURCES = alisp.c
 
 noinst_HEADERS = alisp_local.h

src/alisp/alisp.c

@@ -142,6 +142,89 @@ static struct alisp_object * new_object(struct alisp_instance *instance, int typ
 	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 @@ static struct alisp_object * search_object_string(struct alisp_instance *instanc
 	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 @@ static struct alisp_object * parse_quote(struct alisp_instance *instance)
 	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 @@ static struct alisp_object * parse_object(struct alisp_instance *instance, int h
 		else if (!strcmp(instance->token_buffer, "nil"))
 			p = &alsa_lisp_nil;
 		else {
-			if ((p = search_object_identifier(instance, instance->token_buffer)) == NULL) {
+			if ((p = search_object_identifier(instance, instance->token_buffer)) == NULL)
-				p = new_object(instance, ALISP_OBJ_IDENTIFIER);
+				p = new_identifier(instance, instance->token_buffer);
-				if (p) {
-					if ((p->value.id = strdup(instance->token_buffer)) == NULL) {
-						nomem();
-						return NULL;
-					}
-				}
-			}
 		}
 		break;
 	case ALISP_INTEGER: {
 		long i;
 		i = atol(instance->token_buffer);
-		if ((p = search_object_integer(instance, i)) == NULL) {
+		if ((p = search_object_integer(instance, i)) == NULL)
-			p = new_object(instance, ALISP_OBJ_INTEGER);
+			p = new_integer(instance, i);
-			if (p)
-				p->value.i = i;
-		}
 		break;
 	}
 	case ALISP_FLOAT:
 	case ALISP_FLOATE: {
 		double f;
 		f = atof(instance->token_buffer);
-		if ((p = search_object_float(instance, f)) == NULL) {
+		if ((p = search_object_float(instance, f)) == NULL)
-			p = new_object(instance, ALISP_OBJ_FLOAT);
+			p = new_float(instance, f);
-			if (p)
-				p->value.f = f;
-		}
 		break;
 	}
 	case ALISP_STRING:
-		if ((p = search_object_string(instance, instance->token_buffer)) == NULL) {
+		if ((p = search_object_string(instance, instance->token_buffer)) == NULL)
-			p = new_object(instance, ALISP_OBJ_STRING);
+			p = new_string(instance, instance->token_buffer);
-			if (p) {
-				if ((p->value.s = strdup(instance->token_buffer)) == NULL) {
-					nomem();
-					return NULL;
-				}
-			}
-		}
 		break;
 	default:
 		lisp_warn(instance, "%d:%d: unexpected character `%c'", instance->lineno, instance->charno, thistoken);
@@ -716,14 +775,7 @@ static void do_garbage_collect(struct alisp_instance *instance)
 		if (p->gc != instance->gc_id && p->gc > 0) {
 			/* Remove unreferenced object. */
 			lisp_debug(instance, "** collecting cons %p", p);
-			switch (p->type) {
+			free_object(p);
-			case ALISP_OBJ_STRING:
-				free(p->value.s);
-				break;
-			case ALISP_OBJ_IDENTIFIER:
-				free(p->value.id);
-				break;
-			}
 
 			p->next = instance->free_objs_list;
 			instance->free_objs_list = p;
@@ -821,13 +873,9 @@ static struct alisp_object * F_add(struct alisp_instance *instance, struct alisp
 	} while (p != &alsa_lisp_nil);
 
 	if (type == ALISP_OBJ_INTEGER) {
-		p1 = new_object(instance, ALISP_OBJ_INTEGER);
+		p1 = new_integer(instance, v);
-		if (p1)
-			p1->value.i = v;
 	} else {
-		p1 = new_object(instance, ALISP_OBJ_FLOAT);
+		p1 = new_float(instance, f);
-		if (p1)
-			p1->value.f = f;
 	}
 	return p1;
 }
@@ -869,13 +917,9 @@ static struct alisp_object * F_sub(struct alisp_instance *instance, struct alisp
 	} while (p != &alsa_lisp_nil);
 
 	if (type == ALISP_OBJ_INTEGER) {
-		p1 = new_object(instance, ALISP_OBJ_INTEGER);
+		p1 = new_integer(instance, v);
-		if (p1)
-			p1->value.i = v;
 	} else {
-		p1 = new_object(instance, ALISP_OBJ_FLOAT);
+		p1 = new_object(instance, f);
-		if (p1)
-			p1->value.f = f;
 	}
 	return p1;
 }
@@ -907,13 +951,9 @@ static struct alisp_object * F_mul(struct alisp_instance *instance, struct alisp
 	} while (p != &alsa_lisp_nil);
 
 	if (type == ALISP_OBJ_INTEGER) {
-		p1 = new_object(instance, ALISP_OBJ_INTEGER);
+		p1 = new_integer(instance, v);
-		if (p1)
-			p1->value.i = v;
 	} else {
-		p1 = new_object(instance, ALISP_OBJ_FLOAT);
+		p1 = new_float(instance, f);
-		if (p1)
-			p1->value.f = f;
 	}
 
 	return p1;
@@ -969,13 +1009,9 @@ static struct alisp_object * F_div(struct alisp_instance *instance, struct alisp
 	} while (p != &alsa_lisp_nil);
 
 	if (type == ALISP_OBJ_INTEGER) {
-		p1 = new_object(instance, ALISP_OBJ_INTEGER);
+		p1 = new_integer(instance, v);
-		if (p1)
-			p1->value.i = v;
 	} else {
-		p1 = new_object(instance, ALISP_OBJ_FLOAT);
+		p1 = new_float(instance, f);
-		if (p1)
-			p1->value.f = f;
 	}
 
 	return p1;
@@ -1151,9 +1187,6 @@ static struct alisp_object * F_numeq(struct alisp_instance *instance, struct ali
 		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 @@ static void princ_object(snd_output_t *out, struct alisp_object * p)
 	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 @@ static struct alisp_object * F_atom(struct alisp_instance *instance, struct alis
 	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,6 +1343,42 @@ static struct alisp_object * F_list(struct alisp_instance *instance, struct alis
 	return first;
 }
 
+static inline int eq(struct alisp_object * p1, struct alisp_object * p2)
+{
+	return p1 == p2;
+}
+
+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 0;
+
+	if (p1->type == p2->type)
+		switch (p1->type) {
+		case ALISP_OBJ_IDENTIFIER:
+			if (!strcmp(p1->value.id, p2->value.id))
+				return 1;
+			return 0;
+		case ALISP_OBJ_STRING:
+			if (!strcmp(p1->value.s, p2->value.s))
+				return 1;
+			return 0;
+		case ALISP_OBJ_INTEGER:
+			if (p1->value.i == p2->value.i)
+				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)
  */
@@ -1315,28 +1389,23 @@ static struct alisp_object * F_eq(struct alisp_instance *instance, struct alisp_
 	p1 = eval(instance, car(args));
 	p2 = eval(instance, car(cdr(args)));
 
-	if (p1 == p2)
+	if (eq(p1, p2))
 		return &alsa_lisp_t;
+	return &alsa_lisp_nil;
+}
 
-	if (p1->type == ALISP_OBJ_CONS || p2->type == ALISP_OBJ_CONS)
+/*
-		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;
 
-	if (p1->type == p2->type)
+	p1 = eval(instance, car(args));
-		switch (p1->type) {
+	p2 = eval(instance, car(cdr(args)));
-		case ALISP_OBJ_IDENTIFIER:
-			if (!strcmp(p1->value.id, p2->value.id))
-				return &alsa_lisp_t;
-			return &alsa_lisp_nil;
-		case ALISP_OBJ_STRING:
-			if (!strcmp(p1->value.s, p2->value.s))
-				return &alsa_lisp_t;
-			return &alsa_lisp_nil;
-		case ALISP_OBJ_INTEGER:
-			if (p1->value.i == p2->value.i)
-				return &alsa_lisp_t;
-			return &alsa_lisp_nil;
-		}
 
+	if (equal(p1, p2))
+		return &alsa_lisp_t;
 	return &alsa_lisp_nil;
 }
 
@@ -1584,13 +1653,9 @@ static struct alisp_object * F_defun(struct alisp_instance *instance, struct ali
 
 	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 @@ struct alisp_object * F_int(struct alisp_instance *instance, struct alisp_object
 
 	if (p->type == ALISP_INTEGER)
 		return p;
-	if (p->type == ALISP_FLOAT) {
+	if (p->type == ALISP_FLOAT)
-		struct alisp_object * p1;
+		return new_integer(instance, floor(p->value.f));
-		p1 = new_object(instance, ALISP_OBJ_INTEGER);
-		if (p1 == NULL)
-			return NULL;
-		p1->value.i = floor(p->value.f);
-		return p1;
-	}
 
 	lisp_warn(instance, "expected an integer or float for integer conversion");
 	return &alsa_lisp_nil;
@@ -1702,14 +1761,8 @@ struct alisp_object * F_float(struct alisp_instance *instance, struct alisp_obje
 
 	if (p->type == ALISP_FLOAT)
 		return p;
-	if (p->type == ALISP_INTEGER) {
+	if (p->type == ALISP_INTEGER)
-		struct alisp_object * p1;
+		return new_float(instance, p->value.i);
-		p1 = new_object(instance, ALISP_OBJ_FLOAT);
-		if (p1 == NULL)
-			return NULL;
-		p1->value.f = p->value.i;
-		return p1;
-	}
 
 	lisp_warn(instance, "expected an integer or float for integer conversion");
 	return &alsa_lisp_nil;
@@ -1726,27 +1779,95 @@ struct alisp_object * F_str(struct alisp_instance *instance, struct alisp_object
 	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) {
+		return new_string(instance, buf);
-			nomem();
-			return &alsa_lisp_nil;
-		}
-		return p1;
 	}
 
 	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 @@ static struct intrinsic intrinsics[] = {
 	{ ">", 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 @@ static struct intrinsic intrinsics[] = {
 	{ "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 @@ static struct intrinsic intrinsics[] = {
 	{ "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 @@ static struct intrinsic intrinsics[] = {
 	{ "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 @@ static struct alisp_object * eval_cons(struct alisp_instance *instance, struct a
 				    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 @@ static struct alisp_object * F_eval(struct alisp_instance *instance, struct alis
  *  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 @@ int alsa_lisp(struct alisp_cfg *cfg)
 	}
 
 	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);
+}

src/alisp/alisp_local.h

@@ -36,6 +36,7 @@ enum alisp_objects {
 	ALISP_OBJ_FLOAT,
 	ALISP_OBJ_IDENTIFIER,
 	ALISP_OBJ_STRING,
+	ALISP_OBJ_POINTER,
 	ALISP_OBJ_CONS
 };
 
@@ -47,6 +48,7 @@ struct alisp_object {
 		char	*s;
 		long	i;
 		double	f;
+		const void *ptr;
 		struct {
 			struct alisp_object *car;
 			struct alisp_object *cdr;

src/alisp/alisp_snd.c

@@ -0,0 +1,228 @@
+/*
+ *  ALSA lisp implementation - sound related commands
+ *  Copyright (c) 2003 by Jaroslav Kysela <perex@suse.cz>
+ *
+ *
+ *   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 },
+};

src/control/hcontrol.c

@@ -69,18 +69,32 @@ static int snd_hctl_compare_default(const snd_hctl_elem_t *c1,
  */
 int snd_hctl_open(snd_hctl_t **hctlp, const char *name, int mode)
 {
-	snd_hctl_t *hctl;
 	snd_ctl_t *ctl;
 	int err;
 	
-	assert(hctlp);
-	*hctlp = NULL;
 	if ((err = snd_ctl_open(&ctl, name, mode)) < 0)
 		return err;
-	if ((hctl = (snd_hctl_t *)calloc(1, sizeof(snd_hctl_t))) == NULL) {
+	err = snd_hctl_open_ctl(hctlp, ctl);
+	if (err < 0)
 		snd_ctl_close(ctl);
+	return err;
+}
+
+/**
+ * \brief Opens an HCTL
+ * \param hctlp Returned HCTL handle
+ * \param ctl underlying CTL handle
+ * \return 0 on success otherwise a negative error code
+ */
+int snd_hctl_open_ctl(snd_hctl_t **hctlp, snd_ctl_t *ctl)
+{
+	snd_hctl_t *hctl;
+	int err;
+
+	assert(hctlp);
+	*hctlp = NULL;
+	if ((hctl = (snd_hctl_t *)calloc(1, sizeof(snd_hctl_t))) == NULL)
 		return -ENOMEM;
-	}
 	INIT_LIST_HEAD(&hctl->elems);
 	hctl->ctl = ctl;
 	*hctlp = hctl;