1 /*
2  *  ALSA lisp implementation - sound related commands
3  *  Copyright (c) 2003 by Jaroslav Kysela <perex@perex.cz>
4  *
5  *
6  *   This library is free software; you can redistribute it and/or modify
7  *   it under the terms of the GNU Lesser General Public License as
8  *   published by the Free Software Foundation; either version 2.1 of
9  *   the License, or (at your option) any later version.
10  *
11  *   This program is distributed in the hope that it will be useful,
12  *   but WITHOUT ANY WARRANTY; without even the implied warranty of
13  *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14  *   GNU Lesser General Public License for more details.
15  *
16  *   You should have received a copy of the GNU Lesser General Public
17  *   License along with this library; if not, write to the Free Software
18  *   Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
19  *
20  */
21 
22 #include "../control/control_local.h"
23 
24 struct acall_table {
25 	const char *name;
26 	struct alisp_object * (*func) (struct alisp_instance *instance, struct acall_table * item, struct alisp_object * args);
27 	void * xfunc;
28 	const char *prefix;
29 };
30 
31 /*
32  *  helper functions
33  */
34 
get_integer(struct alisp_object * obj)35 static inline int get_integer(struct alisp_object * obj)
36 {
37 	if (alisp_compare_type(obj, ALISP_OBJ_INTEGER))
38 		return obj->value.i;
39 	return 0;
40 }
41 
get_pointer(struct alisp_object * obj)42 static inline const void *get_pointer(struct alisp_object * obj)
43 {
44 	if (alisp_compare_type(obj, ALISP_OBJ_POINTER))
45 		return obj->value.ptr;
46 	return NULL;
47 }
48 
get_string(struct alisp_object * obj,const char * deflt)49 static const char *get_string(struct alisp_object * obj, const char * deflt)
50 {
51 	if (obj == &alsa_lisp_t)
52 		return "true";
53 	if (alisp_compare_type(obj, ALISP_OBJ_STRING) ||
54 	    alisp_compare_type(obj, ALISP_OBJ_IDENTIFIER))
55 		return obj->value.s;
56 	return deflt;
57 }
58 
59 struct flags {
60 	const char *key;
61 	unsigned int mask;
62 };
63 
get_flags(struct alisp_instance * instance,struct alisp_object * obj,const struct flags * flags,unsigned int deflt)64 static unsigned int get_flags(struct alisp_instance * instance,
65 			      struct alisp_object * obj,
66 			      const struct flags * flags,
67 			      unsigned int deflt)
68 {
69 	const char *key;
70 	int invert;
71 	unsigned int result;
72 	const struct flags *ptr;
73 	struct alisp_object *n;
74 
75 	if (obj == &alsa_lisp_nil)
76 		return deflt;
77 	result = deflt;
78 	do {
79 		key = get_string(obj, NULL);
80 		if (key) {
81 			invert = key[0] == '!';
82 			key += invert;
83 			ptr = flags;
84 			while (ptr->key) {
85 				if (!strcmp(ptr->key, key)) {
86 					if (invert)
87 						result &= ~ptr->mask;
88 					else
89 						result |= ptr->mask;
90 					break;
91 				}
92 				ptr++;
93 			}
94 		}
95 		delete_tree(instance, car(obj));
96 		obj = cdr(n = obj);
97 		delete_object(instance, n);
98 	} while (obj != &alsa_lisp_nil);
99 	return result;
100 }
101 
get_ptr(struct alisp_instance * instance,struct alisp_object * obj,const char * _ptr_id)102 static const void *get_ptr(struct alisp_instance * instance,
103 			   struct alisp_object * obj,
104 			   const char *_ptr_id)
105 {
106 	const char *ptr_id;
107 	const void *ptr;
108 
109 	ptr_id = get_string(car(obj), NULL);
110 	if (ptr_id == NULL) {
111 		delete_tree(instance, obj);
112 		return NULL;
113 	}
114 	if (strcmp(ptr_id, _ptr_id)) {
115 		delete_tree(instance, obj);
116 		return NULL;
117 	}
118 	ptr = get_pointer(cdr(obj));
119 	delete_tree(instance, obj);
120 	return ptr;
121 }
122 
new_lexpr(struct alisp_instance * instance,int err)123 static struct alisp_object * new_lexpr(struct alisp_instance * instance, int err)
124 {
125 	struct alisp_object * lexpr;
126 
127 	lexpr = new_object(instance, ALISP_OBJ_CONS);
128 	if (lexpr == NULL)
129 		return NULL;
130 	lexpr->value.c.car = new_integer(instance, err);
131 	if (lexpr->value.c.car == NULL) {
132 		delete_object(instance, lexpr);
133 		return NULL;
134 	}
135 	lexpr->value.c.cdr = new_object(instance, ALISP_OBJ_CONS);
136 	if (lexpr->value.c.cdr == NULL) {
137 		delete_object(instance, lexpr->value.c.car);
138 		delete_object(instance, lexpr);
139 		return NULL;
140 	}
141 	return lexpr;
142 }
143 
add_cons(struct alisp_instance * instance,struct alisp_object * lexpr,int cdr,const char * id,struct alisp_object * obj)144 static struct alisp_object * add_cons(struct alisp_instance * instance,
145 				      struct alisp_object *lexpr,
146 				      int cdr, const char *id,
147 				      struct alisp_object *obj)
148 {
149 	struct alisp_object * p1, * p2;
150 
151 	if (lexpr == NULL || obj == NULL) {
152 		delete_tree(instance, obj);
153 		return NULL;
154 	}
155 	if (cdr) {
156 		p1 = lexpr->value.c.cdr = new_object(instance, ALISP_OBJ_CONS);
157 	} else {
158 		p1 = lexpr->value.c.car = new_object(instance, ALISP_OBJ_CONS);
159 	}
160 	lexpr = p1;
161 	if (p1 == NULL) {
162 		delete_tree(instance, obj);
163 		return NULL;
164 	}
165 	p1->value.c.car = new_object(instance, ALISP_OBJ_CONS);
166 	if ((p2 = p1->value.c.car) == NULL)
167 		goto __err;
168 	p2->value.c.car = new_string(instance, id);
169 	if (p2->value.c.car == NULL) {
170 	      __err:
171 		if (cdr)
172 			lexpr->value.c.cdr = NULL;
173 		else
174 			lexpr->value.c.car = NULL;
175 		delete_tree(instance, p1);
176 		delete_tree(instance, obj);
177 		return NULL;
178 	}
179 	p2->value.c.cdr = obj;
180 	return lexpr;
181 }
182 
add_cons2(struct alisp_instance * instance,struct alisp_object * lexpr,int cdr,struct alisp_object * obj)183 static struct alisp_object * add_cons2(struct alisp_instance * instance,
184 				       struct alisp_object *lexpr,
185 				       int cdr, struct alisp_object *obj)
186 {
187 	struct alisp_object * p1;
188 
189 	if (lexpr == NULL || obj == NULL) {
190 		delete_tree(instance, obj);
191 		return NULL;
192 	}
193 	if (cdr) {
194 		p1 = lexpr->value.c.cdr = new_object(instance, ALISP_OBJ_CONS);
195 	} else {
196 		p1 = lexpr->value.c.car = new_object(instance, ALISP_OBJ_CONS);
197 	}
198 	lexpr = p1;
199 	if (p1 == NULL) {
200 		delete_tree(instance, obj);
201 		return NULL;
202 	}
203 	p1->value.c.car = obj;
204 	return lexpr;
205 }
206 
new_result1(struct alisp_instance * instance,int err,const char * ptr_id,void * ptr)207 static struct alisp_object * new_result1(struct alisp_instance * instance,
208 					 int err, const char *ptr_id, void *ptr)
209 {
210 	struct alisp_object * lexpr, * p1;
211 
212 	if (err < 0)
213 		ptr = NULL;
214 	lexpr = new_object(instance, ALISP_OBJ_CONS);
215 	if (lexpr == NULL)
216 		return NULL;
217 	lexpr->value.c.car = new_integer(instance, err);
218 	if (lexpr->value.c.car == NULL) {
219 		delete_object(instance, lexpr);
220 		return NULL;
221 	}
222 	p1 = add_cons(instance, lexpr, 1, ptr_id, new_pointer(instance, ptr));
223 	if (p1 == NULL) {
224 		delete_object(instance, lexpr);
225 		return NULL;
226 	}
227 	return lexpr;
228 }
229 
new_result2(struct alisp_instance * instance,int err,int val)230 static struct alisp_object * new_result2(struct alisp_instance * instance,
231 					 int err, int val)
232 {
233 	struct alisp_object * lexpr, * p1;
234 
235 	if (err < 0)
236 		val = 0;
237 	lexpr = new_lexpr(instance, err);
238 	if (lexpr == NULL)
239 		return NULL;
240 	p1 = lexpr->value.c.cdr;
241 	p1->value.c.car = new_integer(instance, val);
242 	if (p1->value.c.car == NULL) {
243 		delete_object(instance, lexpr);
244 		return NULL;
245 	}
246 	return lexpr;
247 }
248 
new_result3(struct alisp_instance * instance,int err,const char * str)249 static struct alisp_object * new_result3(struct alisp_instance * instance,
250 					 int err, const char *str)
251 {
252 	struct alisp_object * lexpr, * p1;
253 
254 	if (err < 0)
255 		str = "";
256 	lexpr = new_lexpr(instance, err);
257 	if (lexpr == NULL)
258 		return NULL;
259 	p1 = lexpr->value.c.cdr;
260 	p1->value.c.car = new_string(instance, str);
261 	if (p1->value.c.car == NULL) {
262 		delete_object(instance, lexpr);
263 		return NULL;
264 	}
265 	return lexpr;
266 }
267 
268 /*
269  *  macros
270  */
271 
272 /*
273  *  HCTL functions
274  */
275 
276 typedef int (*snd_int_pp_strp_int_t)(void **rctl, const char *name, int mode);
277 typedef int (*snd_int_pp_p_t)(void **rctl, void *handle);
278 typedef int (*snd_int_p_t)(void *rctl);
279 typedef char * (*snd_str_p_t)(void *rctl);
280 typedef int (*snd_int_intp_t)(int *val);
281 typedef int (*snd_int_str_t)(const char *str);
282 typedef int (*snd_int_int_strp_t)(int val, char **str);
283 typedef void *(*snd_p_p_t)(void *handle);
284 
FA_int_pp_strp_int(struct alisp_instance * instance,struct acall_table * item,struct alisp_object * args)285 static struct alisp_object * FA_int_pp_strp_int(struct alisp_instance * instance, struct acall_table * item, struct alisp_object * args)
286 {
287 	const char *name;
288 	int err, mode;
289 	void *handle;
290 	struct alisp_object *p1, *p2;
291 	static const struct flags flags[] = {
292 		{ "nonblock", SND_CTL_NONBLOCK },
293 		{ "async", SND_CTL_ASYNC },
294 		{ "readonly", SND_CTL_READONLY },
295 		{ NULL, 0 }
296 	};
297 
298 	name = get_string(p1 = eval(instance, car(args)), NULL);
299 	if (name == NULL)
300 		return &alsa_lisp_nil;
301 	mode = get_flags(instance, p2 = eval(instance, car(cdr(args))), flags, 0);
302 	delete_tree(instance, cdr(cdr(args)));
303 	delete_object(instance, cdr(args));
304 	delete_object(instance, args);
305 	delete_tree(instance, p2);
306 	err = ((snd_int_pp_strp_int_t)item->xfunc)(&handle, name, mode);
307 	delete_tree(instance, p1);
308 	return new_result1(instance, err, item->prefix, handle);
309 }
310 
FA_int_pp_p(struct alisp_instance * instance,struct acall_table * item,struct alisp_object * args)311 static struct alisp_object * FA_int_pp_p(struct alisp_instance * instance, struct acall_table * item, struct alisp_object * args)
312 {
313 	int err;
314 	void *handle;
315 	const char *prefix1;
316 	struct alisp_object *p1;
317 
318 	if (item->xfunc == &snd_hctl_open_ctl)
319 		prefix1 = "ctl";
320 	else {
321 		delete_tree(instance, args);
322 		return &alsa_lisp_nil;
323 	}
324 	p1 = eval(instance, car(args));
325 	delete_tree(instance, cdr(args));
326 	delete_object(instance, args);
327 	handle = (void *)get_ptr(instance, p1, prefix1);
328 	if (handle == NULL)
329 		return &alsa_lisp_nil;
330 	err = ((snd_int_pp_p_t)item->xfunc)(&handle, handle);
331 	return new_result1(instance, err, item->prefix, handle);
332 }
333 
FA_p_p(struct alisp_instance * instance,struct acall_table * item,struct alisp_object * args)334 static struct alisp_object * FA_p_p(struct alisp_instance * instance, struct acall_table * item, struct alisp_object * args)
335 {
336 	void *handle;
337 	const char *prefix1;
338 	struct alisp_object * p1;
339 
340 	if (item->xfunc == &snd_hctl_first_elem ||
341 	    item->xfunc == &snd_hctl_last_elem ||
342 	    item->xfunc == &snd_hctl_elem_next ||
343 	    item->xfunc == &snd_hctl_elem_prev)
344 		prefix1 = "hctl_elem";
345 	else if (item->xfunc == &snd_hctl_ctl)
346 		prefix1 = "ctl";
347 	else {
348 		delete_tree(instance, args);
349 		return &alsa_lisp_nil;
350 	}
351 	p1 = eval(instance, car(args));
352 	delete_tree(instance, cdr(args));
353 	delete_object(instance, args);
354 	handle = (void *)get_ptr(instance, p1, item->prefix);
355 	if (handle == NULL)
356 		return &alsa_lisp_nil;
357 	handle = ((snd_p_p_t)item->xfunc)(handle);
358 	return new_cons_pointer(instance, prefix1, handle);
359 }
360 
FA_int_p(struct alisp_instance * instance,struct acall_table * item,struct alisp_object * args)361 static struct alisp_object * FA_int_p(struct alisp_instance * instance, struct acall_table * item, struct alisp_object * args)
362 {
363 	void *handle;
364 	struct alisp_object * p1;
365 
366 	p1 = eval(instance, car(args));
367 	delete_tree(instance, cdr(args));
368 	delete_object(instance, args);
369 	handle = (void *)get_ptr(instance, p1, item->prefix);
370 	if (handle == NULL)
371 		return &alsa_lisp_nil;
372 	return new_integer(instance, ((snd_int_p_t)item->xfunc)(handle));
373 }
374 
FA_str_p(struct alisp_instance * instance,struct acall_table * item,struct alisp_object * args)375 static struct alisp_object * FA_str_p(struct alisp_instance * instance, struct acall_table * item, struct alisp_object * args)
376 {
377 	void *handle;
378 	struct alisp_object * p1;
379 
380 	p1 = eval(instance, car(args));
381 	delete_tree(instance, cdr(args));
382 	delete_object(instance, args);
383 	handle = (void *)get_ptr(instance, p1, item->prefix);
384 	if (handle == NULL)
385 		return &alsa_lisp_nil;
386 	return new_string(instance, ((snd_str_p_t)item->xfunc)(handle));
387 }
388 
FA_int_intp(struct alisp_instance * instance,struct acall_table * item,struct alisp_object * args)389 static struct alisp_object * FA_int_intp(struct alisp_instance * instance, struct acall_table * item, struct alisp_object * args)
390 {
391 	int val, err;
392 	struct alisp_object * p1;
393 
394 	p1 = eval(instance, car(args));
395 	delete_tree(instance, cdr(args));
396 	delete_object(instance, args);
397 	if (!alisp_compare_type(p1, ALISP_OBJ_INTEGER)) {
398 		delete_tree(instance, p1);
399 		return &alsa_lisp_nil;
400 	}
401 	val = p1->value.i;
402 	delete_tree(instance, p1);
403 	err = ((snd_int_intp_t)item->xfunc)(&val);
404 	return new_result2(instance, err, val);
405 }
406 
FA_int_str(struct alisp_instance * instance,struct acall_table * item,struct alisp_object * args)407 static struct alisp_object * FA_int_str(struct alisp_instance * instance, struct acall_table * item, struct alisp_object * args)
408 {
409 	int err;
410 	struct alisp_object * p1;
411 
412 	p1 = eval(instance, car(args));
413 	delete_tree(instance, cdr(args));
414 	delete_object(instance, args);
415 	if (!alisp_compare_type(p1, ALISP_OBJ_STRING) &&
416 	    !alisp_compare_type(p1, ALISP_OBJ_IDENTIFIER)) {
417 		delete_tree(instance, p1);
418 		return &alsa_lisp_nil;
419 	}
420 	err = ((snd_int_str_t)item->xfunc)(p1->value.s);
421 	delete_tree(instance, p1);
422 	return new_integer(instance, err);
423 }
424 
FA_int_int_strp(struct alisp_instance * instance,struct acall_table * item,struct alisp_object * args)425 static struct alisp_object * FA_int_int_strp(struct alisp_instance * instance, struct acall_table * item, struct alisp_object * args)
426 {
427 	int err;
428 	char *str;
429 	long val;
430 	struct alisp_object * p1;
431 
432 	p1 = eval(instance, car(args));
433 	delete_tree(instance, cdr(args));
434 	delete_object(instance, args);
435 	if (!alisp_compare_type(p1, ALISP_OBJ_INTEGER)) {
436 		delete_tree(instance, p1);
437 		return &alsa_lisp_nil;
438 	}
439 	val = p1->value.i;
440 	delete_tree(instance, p1);
441 	err = ((snd_int_int_strp_t)item->xfunc)(val, &str);
442 	return new_result3(instance, err, str);
443 }
444 
FA_card_info(struct alisp_instance * instance,struct acall_table * item,struct alisp_object * args)445 static struct alisp_object * FA_card_info(struct alisp_instance * instance, struct acall_table * item, struct alisp_object * args)
446 {
447 	snd_ctl_t *handle;
448 	struct alisp_object * lexpr, * p1;
449 	snd_ctl_card_info_t info = {0};
450 	int err;
451 
452 	p1 = eval(instance, car(args));
453 	delete_tree(instance, cdr(args));
454 	delete_object(instance, args);
455 	handle = (snd_ctl_t *)get_ptr(instance, p1, item->prefix);
456 	if (handle == NULL)
457 		return &alsa_lisp_nil;
458 	err = snd_ctl_card_info(handle, &info);
459 	lexpr = new_lexpr(instance, err);
460 	if (err < 0)
461 		return lexpr;
462 	p1 = add_cons(instance, lexpr->value.c.cdr, 0, "id", new_string(instance, snd_ctl_card_info_get_id(&info)));
463 	p1 = add_cons(instance, p1, 1, "driver", new_string(instance, snd_ctl_card_info_get_driver(&info)));
464 	p1 = add_cons(instance, p1, 1, "name", new_string(instance, snd_ctl_card_info_get_name(&info)));
465 	p1 = add_cons(instance, p1, 1, "longname", new_string(instance, snd_ctl_card_info_get_longname(&info)));
466 	p1 = add_cons(instance, p1, 1, "mixername", new_string(instance, snd_ctl_card_info_get_mixername(&info)));
467 	p1 = add_cons(instance, p1, 1, "components", new_string(instance, snd_ctl_card_info_get_components(&info)));
468 	if (p1 == NULL) {
469 		delete_tree(instance, lexpr);
470 		return NULL;
471 	}
472 	return lexpr;
473 }
474 
create_ctl_elem_id(struct alisp_instance * instance,snd_ctl_elem_id_t * id,struct alisp_object * cons)475 static struct alisp_object * create_ctl_elem_id(struct alisp_instance * instance, snd_ctl_elem_id_t * id, struct alisp_object * cons)
476 {
477 	cons = add_cons(instance, cons, 0, "numid", new_integer(instance, snd_ctl_elem_id_get_numid(id)));
478 	cons = add_cons(instance, cons, 1, "iface", new_string(instance, snd_ctl_elem_iface_name(snd_ctl_elem_id_get_interface(id))));
479 	cons = add_cons(instance, cons, 1, "dev", new_integer(instance, snd_ctl_elem_id_get_device(id)));
480 	cons = add_cons(instance, cons, 1, "subdev", new_integer(instance, snd_ctl_elem_id_get_subdevice(id)));
481 	cons = add_cons(instance, cons, 1, "name", new_string(instance, snd_ctl_elem_id_get_name(id)));
482 	cons = add_cons(instance, cons, 1, "index", new_integer(instance, snd_ctl_elem_id_get_index(id)));
483 	return cons;
484 }
485 
parse_ctl_elem_id(struct alisp_instance * instance,struct alisp_object * cons,snd_ctl_elem_id_t * id)486 static int parse_ctl_elem_id(struct alisp_instance * instance,
487 			     struct alisp_object * cons,
488 			     snd_ctl_elem_id_t * id)
489 {
490 	struct alisp_object *p1;
491 	const char *xid;
492 
493 	if (cons == NULL)
494 		return -ENOMEM;
495 	snd_ctl_elem_id_clear(id);
496 	id->numid = 0;
497 	do {
498 		p1 = car(cons);
499 		if (alisp_compare_type(p1, ALISP_OBJ_CONS)) {
500 			xid = get_string(p1->value.c.car, NULL);
501 			if (xid == NULL) {
502 				/* noop */
503 			} else if (!strcmp(xid, "numid")) {
504 				snd_ctl_elem_id_set_numid(id, get_integer(p1->value.c.cdr));
505 			} else if (!strcmp(xid, "iface")) {
506 				snd_ctl_elem_id_set_interface(id, snd_config_get_ctl_iface_ascii(get_string(p1->value.c.cdr, "0")));
507 			} else if (!strcmp(xid, "dev")) {
508 				snd_ctl_elem_id_set_device(id, get_integer(p1->value.c.cdr));
509 			} else if (!strcmp(xid, "subdev")) {
510 				snd_ctl_elem_id_set_subdevice(id, get_integer(p1->value.c.cdr));
511 			} else if (!strcmp(xid, "name")) {
512 				snd_ctl_elem_id_set_name(id, get_string(p1->value.c.cdr, "?"));
513 			} else if (!strcmp(xid, "index")) {
514 				snd_ctl_elem_id_set_index(id, get_integer(p1->value.c.cdr));
515 			}
516 		}
517 		delete_tree(instance, p1);
518 	        cons = cdr(p1 = cons);
519 	        delete_object(instance, p1);
520 	} while (cons != &alsa_lisp_nil);
521 	return 0;
522 }
523 
FA_hctl_find_elem(struct alisp_instance * instance,struct acall_table * item,struct alisp_object * args)524 static struct alisp_object * FA_hctl_find_elem(struct alisp_instance * instance, struct acall_table * item, struct alisp_object * args)
525 {
526 	snd_hctl_t *handle;
527 	snd_ctl_elem_id_t id = {0};
528 	struct alisp_object *p1;
529 
530 	handle = (snd_hctl_t *)get_ptr(instance, car(args), item->prefix);
531 	if (handle == NULL) {
532 		delete_tree(instance, cdr(args));
533 		delete_object(instance, args);
534 		return &alsa_lisp_nil;
535 	}
536 	p1 = car(cdr(args));
537 	delete_tree(instance, cdr(cdr(args)));
538 	delete_object(instance, cdr(args));
539 	delete_object(instance, args);
540 	if (parse_ctl_elem_id(instance, eval(instance, p1), &id) < 0)
541 		return &alsa_lisp_nil;
542 	return new_cons_pointer(instance, "hctl_elem", snd_hctl_find_elem(handle, &id));
543 }
544 
FA_hctl_elem_info(struct alisp_instance * instance,struct acall_table * item,struct alisp_object * args)545 static struct alisp_object * FA_hctl_elem_info(struct alisp_instance * instance, struct acall_table * item, struct alisp_object * args)
546 {
547 	snd_hctl_elem_t *handle;
548 	struct alisp_object * lexpr, * p1, * p2;
549 	snd_ctl_elem_info_t info = {0};
550 	snd_ctl_elem_id_t id = {0};
551 	snd_ctl_elem_type_t type;
552 	int err;
553 
554 	p1 = eval(instance, car(args));
555 	delete_tree(instance, cdr(args));
556 	delete_object(instance, args);
557 	handle = (snd_hctl_elem_t *)get_ptr(instance, p1, item->prefix);
558 	if (handle == NULL)
559 		return &alsa_lisp_nil;
560 	err = snd_hctl_elem_info(handle, &info);
561 	lexpr = new_lexpr(instance, err);
562 	if (err < 0)
563 		return lexpr;
564 	type = snd_ctl_elem_info_get_type(&info);
565 	p1 = add_cons(instance, lexpr->value.c.cdr, 0, "id", p2 = new_object(instance, ALISP_OBJ_CONS));
566 	snd_ctl_elem_info_get_id(&info, &id);
567 	if (create_ctl_elem_id(instance, &id, p2) == NULL) {
568 		delete_tree(instance, lexpr);
569 		return NULL;
570 	}
571 	p1 = add_cons(instance, p1, 1, "type", new_string(instance, snd_ctl_elem_type_name(type)));
572 	p1 = add_cons(instance, p1, 1, "readable", new_integer(instance, snd_ctl_elem_info_is_readable(&info)));
573 	p1 = add_cons(instance, p1, 1, "writable", new_integer(instance, snd_ctl_elem_info_is_writable(&info)));
574 	p1 = add_cons(instance, p1, 1, "volatile", new_integer(instance, snd_ctl_elem_info_is_volatile(&info)));
575 	p1 = add_cons(instance, p1, 1, "inactive", new_integer(instance, snd_ctl_elem_info_is_inactive(&info)));
576 	p1 = add_cons(instance, p1, 1, "locked", new_integer(instance, snd_ctl_elem_info_is_locked(&info)));
577 	p1 = add_cons(instance, p1, 1, "isowner", new_integer(instance, snd_ctl_elem_info_is_owner(&info)));
578 	p1 = add_cons(instance, p1, 1, "owner", new_integer(instance, snd_ctl_elem_info_get_owner(&info)));
579 	p1 = add_cons(instance, p1, 1, "count", new_integer(instance, snd_ctl_elem_info_get_count(&info)));
580 	err = INTERNAL(snd_ctl_elem_info_get_dimensions)(&info);
581 	if (err > 0) {
582 		int idx;
583 		p1 = add_cons(instance, p1, 1, "dimensions", p2 = new_object(instance, ALISP_OBJ_CONS));
584 		for (idx = 0; idx < err; idx++)
585 			p2 = add_cons2(instance, p2, idx > 0, new_integer(instance, INTERNAL(snd_ctl_elem_info_get_dimension)(&info, idx)));
586 	}
587 	switch (type) {
588 	case SND_CTL_ELEM_TYPE_ENUMERATED: {
589 		unsigned int items, item;
590 		items = snd_ctl_elem_info_get_items(&info);
591 		p1 = add_cons(instance, p1, 1, "items", p2 = new_object(instance, ALISP_OBJ_CONS));
592 		for (item = 0; item < items; item++) {
593 			snd_ctl_elem_info_set_item(&info, item);
594 			err = snd_hctl_elem_info(handle, &info);
595 			if (err < 0) {
596 				p2 = add_cons2(instance, p2, item, &alsa_lisp_nil);
597 			} else {
598 				p2 = add_cons2(instance, p2, item, new_string(instance, snd_ctl_elem_info_get_item_name(&info)));
599 			}
600 		}
601 		break;
602 	}
603 	case SND_CTL_ELEM_TYPE_INTEGER:
604 		p1 = add_cons(instance, p1, 1, "min", new_integer(instance, snd_ctl_elem_info_get_min(&info)));
605 		p1 = add_cons(instance, p1, 1, "max", new_integer(instance, snd_ctl_elem_info_get_max(&info)));
606 		p1 = add_cons(instance, p1, 1, "step", new_integer(instance, snd_ctl_elem_info_get_step(&info)));
607 		break;
608 	case SND_CTL_ELEM_TYPE_INTEGER64:
609 		p1 = add_cons(instance, p1, 1, "min64", new_float(instance, snd_ctl_elem_info_get_min64(&info)));
610 		p1 = add_cons(instance, p1, 1, "max64", new_float(instance, snd_ctl_elem_info_get_max64(&info)));
611 		p1 = add_cons(instance, p1, 1, "step64", new_float(instance, snd_ctl_elem_info_get_step64(&info)));
612 		break;
613 	default:
614 		break;
615 	}
616 	if (p1 == NULL) {
617 		delete_tree(instance, lexpr);
618 		return NULL;
619 	}
620 	return lexpr;
621 }
622 
FA_hctl_elem_read(struct alisp_instance * instance,struct acall_table * item,struct alisp_object * args)623 static struct alisp_object * FA_hctl_elem_read(struct alisp_instance * instance, struct acall_table * item, struct alisp_object * args)
624 {
625 	snd_hctl_elem_t *handle;
626 	struct alisp_object * lexpr, * p1 = NULL, * obj;
627 	snd_ctl_elem_info_t info = {0};
628 	snd_ctl_elem_value_t value = {0};
629 	snd_ctl_elem_type_t type;
630 	unsigned int idx, count;
631 	int err;
632 
633 	p1 = eval(instance, car(args));
634 	delete_tree(instance, cdr(args));
635 	delete_object(instance, args);
636 	handle = (snd_hctl_elem_t *)get_ptr(instance, p1, item->prefix);
637 	if (handle == NULL)
638 		return &alsa_lisp_nil;
639 	err = snd_hctl_elem_info(handle, &info);
640 	if (err >= 0)
641 		err = snd_hctl_elem_read(handle, &value);
642 	lexpr = new_lexpr(instance, err);
643 	if (err < 0)
644 		return lexpr;
645 	type = snd_ctl_elem_info_get_type(&info);
646 	count = snd_ctl_elem_info_get_count(&info);
647 	if (type == SND_CTL_ELEM_TYPE_IEC958) {
648 		count = sizeof(snd_aes_iec958_t);
649 		type = SND_CTL_ELEM_TYPE_BYTES;
650 	}
651 	for (idx = 0; idx < count; idx++) {
652 		switch (type) {
653 		case SND_CTL_ELEM_TYPE_BOOLEAN:
654 			obj = new_integer(instance, snd_ctl_elem_value_get_boolean(&value, idx));
655 			break;
656 		case SND_CTL_ELEM_TYPE_INTEGER:
657 			obj = new_integer(instance, snd_ctl_elem_value_get_integer(&value, idx));
658 			break;
659 		case SND_CTL_ELEM_TYPE_INTEGER64:
660 			obj = new_integer(instance, snd_ctl_elem_value_get_integer64(&value, idx));
661 			break;
662 		case SND_CTL_ELEM_TYPE_ENUMERATED:
663 			obj = new_integer(instance, snd_ctl_elem_value_get_enumerated(&value, idx));
664 			break;
665 		case SND_CTL_ELEM_TYPE_BYTES:
666 			obj = new_integer(instance, snd_ctl_elem_value_get_byte(&value, idx));
667 			break;
668 		default:
669 			obj = NULL;
670 			break;
671 		}
672 		if (idx == 0) {
673 			p1 = add_cons2(instance, lexpr->value.c.cdr, 0, obj);
674 		} else {
675 			p1 = add_cons2(instance, p1, 1, obj);
676 		}
677 	}
678 	if (p1 == NULL) {
679 		delete_tree(instance, lexpr);
680 		return &alsa_lisp_nil;
681 	}
682 	return lexpr;
683 }
684 
FA_hctl_elem_write(struct alisp_instance * instance,struct acall_table * item,struct alisp_object * args)685 static struct alisp_object * FA_hctl_elem_write(struct alisp_instance * instance, struct acall_table * item, struct alisp_object * args)
686 {
687 	snd_hctl_elem_t *handle;
688 	struct alisp_object * p1 = NULL, * obj;
689 	snd_ctl_elem_info_t info = {0};
690 	snd_ctl_elem_value_t value = {0};
691 	snd_ctl_elem_type_t type;
692 	unsigned int idx, count;
693 	int err;
694 
695 	p1 = car(cdr(args));
696 	obj = eval(instance, car(args));
697 	delete_tree(instance, cdr(cdr(args)));
698 	delete_object(instance, cdr(args));
699 	delete_object(instance, args);
700 	handle = (snd_hctl_elem_t *)get_ptr(instance, obj, item->prefix);
701 	if (handle == NULL) {
702 		delete_tree(instance, p1);
703 		return &alsa_lisp_nil;
704 	}
705 	err = snd_hctl_elem_info(handle, &info);
706 	if (err < 0) {
707 		delete_tree(instance, p1);
708 		return new_integer(instance, err);
709 	}
710 	type = snd_ctl_elem_info_get_type(&info);
711 	count = snd_ctl_elem_info_get_count(&info);
712 	if (type == SND_CTL_ELEM_TYPE_IEC958) {
713 		count = sizeof(snd_aes_iec958_t);
714 		type = SND_CTL_ELEM_TYPE_BYTES;
715 	}
716 	idx = -1;
717 	do {
718 		if (++idx >= count) {
719 			delete_tree(instance, p1);
720 			break;
721 		}
722 		obj = car(p1);
723 		switch (type) {
724 		case SND_CTL_ELEM_TYPE_BOOLEAN:
725 			snd_ctl_elem_value_set_boolean(&value, idx, get_integer(obj));
726 			break;
727 		case SND_CTL_ELEM_TYPE_INTEGER:
728 			snd_ctl_elem_value_set_integer(&value, idx, get_integer(obj));
729 			break;
730 		case SND_CTL_ELEM_TYPE_INTEGER64:
731 			snd_ctl_elem_value_set_integer64(&value, idx, get_integer(obj));
732 			break;
733 		case SND_CTL_ELEM_TYPE_ENUMERATED:
734 			snd_ctl_elem_value_set_enumerated(&value, idx, get_integer(obj));
735 			break;
736 		case SND_CTL_ELEM_TYPE_BYTES:
737 			snd_ctl_elem_value_set_byte(&value, idx, get_integer(obj));
738 			break;
739 		default:
740 			break;
741 		}
742 		delete_tree(instance, obj);
743 		p1 = cdr(obj = p1);
744 		delete_object(instance, obj);
745 	} while (p1 != &alsa_lisp_nil);
746 	err = snd_hctl_elem_write(handle, &value);
747 	return new_integer(instance, err);
748 }
749 
FA_pcm_info(struct alisp_instance * instance,struct acall_table * item,struct alisp_object * args)750 static struct alisp_object * FA_pcm_info(struct alisp_instance * instance, struct acall_table * item, struct alisp_object * args)
751 {
752 	snd_pcm_t *handle;
753 	struct alisp_object * lexpr, * p1;
754 	snd_pcm_info_t info = {0};
755 	int err;
756 
757 	p1 = eval(instance, car(args));
758 	delete_tree(instance, cdr(args));
759 	delete_object(instance, args);
760 	handle = (snd_pcm_t *)get_ptr(instance, p1, item->prefix);
761 	if (handle == NULL)
762 		return &alsa_lisp_nil;
763 	err = snd_pcm_info(handle, &info);
764 	lexpr = new_lexpr(instance, err);
765 	if (err < 0)
766 		return lexpr;
767 	p1 = add_cons(instance, lexpr->value.c.cdr, 0, "card", new_integer(instance, snd_pcm_info_get_card(&info)));
768 	p1 = add_cons(instance, p1, 1, "device", new_integer(instance, snd_pcm_info_get_device(&info)));
769 	p1 = add_cons(instance, p1, 1, "subdevice", new_integer(instance, snd_pcm_info_get_subdevice(&info)));
770 	p1 = add_cons(instance, p1, 1, "id", new_string(instance, snd_pcm_info_get_id(&info)));
771 	p1 = add_cons(instance, p1, 1, "name", new_string(instance, snd_pcm_info_get_name(&info)));
772 	p1 = add_cons(instance, p1, 1, "subdevice_name", new_string(instance, snd_pcm_info_get_subdevice_name(&info)));
773 	p1 = add_cons(instance, p1, 1, "class", new_integer(instance, snd_pcm_info_get_class(&info)));
774 	p1 = add_cons(instance, p1, 1, "subclass", new_integer(instance, snd_pcm_info_get_subclass(&info)));
775 	p1 = add_cons(instance, p1, 1, "subdevices_count", new_integer(instance, snd_pcm_info_get_subdevices_count(&info)));
776 	p1 = add_cons(instance, p1, 1, "subdevices_avail", new_integer(instance, snd_pcm_info_get_subdevices_avail(&info)));
777 	//p1 = add_cons(instance, p1, 1, "sync", new_string(instance, snd_pcm_info_get_sync(&info)));
778 	return lexpr;
779 }
780 
781 /*
782  *  main code
783  */
784 
785 static const struct acall_table acall_table[] = {
786 	{ "card_get_index", &FA_int_str, (void *)snd_card_get_index, NULL },
787 	{ "card_get_longname", &FA_int_int_strp, (void *)snd_card_get_longname, NULL },
788 	{ "card_get_name", &FA_int_int_strp, (void *)snd_card_get_name, NULL },
789 	{ "card_next", &FA_int_intp, (void *)&snd_card_next, NULL },
790 	{ "ctl_card_info", &FA_card_info, NULL, "ctl" },
791 	{ "ctl_close", &FA_int_p, (void *)&snd_ctl_close, "ctl" },
792 	{ "ctl_open", &FA_int_pp_strp_int, (void *)&snd_ctl_open, "ctl" },
793 	{ "hctl_close", &FA_int_p, (void *)&snd_hctl_close, "hctl" },
794 	{ "hctl_ctl", &FA_p_p, (void *)&snd_hctl_ctl, "hctl" },
795 	{ "hctl_elem_info", &FA_hctl_elem_info, (void *)&snd_hctl_elem_info, "hctl_elem" },
796 	{ "hctl_elem_next", &FA_p_p, (void *)&snd_hctl_elem_next, "hctl_elem" },
797 	{ "hctl_elem_prev", &FA_p_p, (void *)&snd_hctl_elem_prev, "hctl_elem" },
798 	{ "hctl_elem_read", &FA_hctl_elem_read, (void *)&snd_hctl_elem_read, "hctl_elem" },
799 	{ "hctl_elem_write", &FA_hctl_elem_write, (void *)&snd_hctl_elem_write, "hctl_elem" },
800 	{ "hctl_find_elem", &FA_hctl_find_elem, (void *)&snd_hctl_find_elem, "hctl" },
801 	{ "hctl_first_elem", &FA_p_p, (void *)&snd_hctl_first_elem, "hctl" },
802 	{ "hctl_free", &FA_int_p, (void *)&snd_hctl_free, "hctl" },
803 	{ "hctl_last_elem", &FA_p_p, (void *)&snd_hctl_last_elem, "hctl" },
804 	{ "hctl_load", &FA_int_p, (void *)&snd_hctl_load, "hctl" },
805 	{ "hctl_open", &FA_int_pp_strp_int, (void *)&snd_hctl_open, "hctl" },
806 	{ "hctl_open_ctl", &FA_int_pp_p, (void *)&snd_hctl_open_ctl, "hctl" },
807 	{ "pcm_info", &FA_pcm_info, NULL, "pcm" },
808 	{ "pcm_name", &FA_str_p, (void *)&snd_pcm_name, "pcm" },
809 };
810 
acall_compar(const void * p1,const void * p2)811 static int acall_compar(const void *p1, const void *p2)
812 {
813 	return strcmp(((struct acall_table *)p1)->name,
814         	      ((struct acall_table *)p2)->name);
815 }
816 
F_acall(struct alisp_instance * instance,struct alisp_object * args)817 static struct alisp_object * F_acall(struct alisp_instance *instance, struct alisp_object * args)
818 {
819 	struct alisp_object * p1, *p2;
820 	struct acall_table key, *item;
821 
822 	p1 = eval(instance, car(args));
823 	p2 = cdr(args);
824 	delete_object(instance, args);
825 	if (!alisp_compare_type(p1, ALISP_OBJ_IDENTIFIER) &&
826 	    !alisp_compare_type(p1, ALISP_OBJ_STRING)) {
827 	    	delete_tree(instance, p2);
828 		return &alsa_lisp_nil;
829 	}
830 	key.name = p1->value.s;
831 	if ((item = bsearch(&key, acall_table,
832 			    sizeof acall_table / sizeof acall_table[0],
833 			    sizeof acall_table[0], acall_compar)) != NULL) {
834 		delete_tree(instance, p1);
835 		return item->func(instance, item, p2);
836 	}
837 	delete_tree(instance, p1);
838 	delete_tree(instance, p2);
839 	lisp_warn(instance, "acall function %s' is undefined", p1->value.s);
840 	return &alsa_lisp_nil;
841 }
842 
F_ahandle(struct alisp_instance * instance,struct alisp_object * args)843 static struct alisp_object * F_ahandle(struct alisp_instance *instance, struct alisp_object * args)
844 {
845 	struct alisp_object *p1;
846 
847 	p1 = eval(instance, car(args));
848 	delete_tree(instance, cdr(args));
849 	delete_object(instance, args);
850 	args = car(cdr(p1));
851 	delete_tree(instance, cdr(cdr(p1)));
852 	delete_object(instance, cdr(p1));
853 	delete_tree(instance, car(p1));
854 	delete_object(instance, p1);
855 	return args;
856 }
857 
F_aerror(struct alisp_instance * instance,struct alisp_object * args)858 static struct alisp_object * F_aerror(struct alisp_instance *instance, struct alisp_object * args)
859 {
860 	struct alisp_object *p1;
861 
862 	p1 = eval(instance, car(args));
863 	delete_tree(instance, cdr(args));
864 	delete_object(instance, args);
865 	args = car(p1);
866 	if (args == &alsa_lisp_nil) {
867 		delete_tree(instance, p1);
868 		return new_integer(instance, SND_ERROR_ALISP_NIL);
869 	} else {
870 		delete_tree(instance, cdr(p1));
871 		delete_object(instance, p1);
872 	}
873 	return args;
874 }
875 
common_error(snd_output_t ** rout,struct alisp_instance * instance,struct alisp_object * args)876 static int common_error(snd_output_t **rout, struct alisp_instance *instance, struct alisp_object * args)
877 {
878 	struct alisp_object * p = args, * p1;
879 	snd_output_t *out;
880 	int err;
881 
882 	err = snd_output_buffer_open(&out);
883 	if (err < 0) {
884 		delete_tree(instance, args);
885 		return err;
886 	}
887 
888 	do {
889 		p1 = eval(instance, car(p));
890 		if (alisp_compare_type(p1, ALISP_OBJ_STRING))
891 			snd_output_printf(out, "%s", p1->value.s);
892 		else
893 			princ_object(out, p1);
894 		delete_tree(instance, p1);
895 		p = cdr(p1 = p);
896 		delete_object(instance, p1);
897 	} while (p != &alsa_lisp_nil);
898 
899 	*rout = out;
900 	return 0;
901 }
902 
F_snderr(struct alisp_instance * instance,struct alisp_object * args)903 static struct alisp_object * F_snderr(struct alisp_instance *instance, struct alisp_object * args)
904 {
905 	snd_output_t *out;
906 	char *str;
907 
908 	if (common_error(&out, instance, args) < 0)
909 		return &alsa_lisp_nil;
910 	snd_output_buffer_string(out, &str);
911 	SNDERR(str);
912 	snd_output_close(out);
913 	return &alsa_lisp_t;
914 }
915 
F_syserr(struct alisp_instance * instance,struct alisp_object * args)916 static struct alisp_object * F_syserr(struct alisp_instance *instance, struct alisp_object * args)
917 {
918 	snd_output_t *out;
919 	char *str;
920 
921 	if (common_error(&out, instance, args) < 0)
922 		return &alsa_lisp_nil;
923 	snd_output_buffer_string(out, &str);
924 	SYSERR(str);
925 	snd_output_close(out);
926 	return &alsa_lisp_t;
927 }
928 
929 static const struct intrinsic snd_intrinsics[] = {
930 	{ "Acall", F_acall },
931 	{ "Aerror", F_aerror },
932 	{ "Ahandle", F_ahandle },
933 	{ "Aresult", F_ahandle },
934 	{ "Asnderr", F_snderr },
935 	{ "Asyserr", F_syserr }
936 };
937