src/alisp/alisp_snd.c

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