Lines Matching refs:instance
45 static struct alisp_object * parse_object(struct alisp_instance *instance, int havetoken);
48 static struct alisp_object * eval(struct alisp_instance *instance, struct alisp_object * p);
51 static struct alisp_object *F_eval(struct alisp_instance *instance, struct alisp_object *);
52 static struct alisp_object *F_progn(struct alisp_instance *instance, struct alisp_object *);
53 static struct alisp_object *F_funcall(struct alisp_instance *instance, struct alisp_object *);
56 static int alisp_include_file(struct alisp_instance *instance, const char *filename);
77 static void lisp_verbose(struct alisp_instance *instance, const char *fmt, ...)
81 if (!instance->verbose)
84 snd_output_printf(instance->vout, "alisp: ");
85 snd_output_vprintf(instance->vout, fmt, ap);
86 snd_output_putc(instance->vout, '\n');
90 static void lisp_error(struct alisp_instance *instance, const char *fmt, ...)
94 if (!instance->warning)
97 snd_output_printf(instance->eout, "alisp error: ");
98 snd_output_vprintf(instance->eout, fmt, ap);
99 snd_output_putc(instance->eout, '\n');
103 static void lisp_warn(struct alisp_instance *instance, const char *fmt, ...)
107 if (!instance->warning)
110 snd_output_printf(instance->wout, "alisp warning: ");
111 snd_output_vprintf(instance->wout, fmt, ap);
112 snd_output_putc(instance->wout, '\n');
116 static void lisp_debug(struct alisp_instance *instance, const char *fmt, ...)
120 if (!instance->debug)
123 snd_output_printf(instance->dout, "alisp debug: ");
124 snd_output_vprintf(instance->dout, fmt, ap);
125 snd_output_putc(instance->dout, '\n');
129 static struct alisp_object * new_object(struct alisp_instance *instance, int type)
133 if (list_empty(&instance->free_objs_list)) {
139 lisp_debug(instance, "allocating cons %p", p);
141 p = (struct alisp_object *)instance->free_objs_list.next;
143 instance->free_objs--;
144 lisp_debug(instance, "recycling cons %p", p);
147 instance->used_objs++;
154 list_add(&p->list, &instance->used_objs_list[0][ALISP_OBJ_CONS]);
157 if (instance->used_objs + instance->free_objs > instance->max_objs)
158 instance->max_objs = instance->used_objs + instance->free_objs;
176 static void delete_object(struct alisp_instance *instance, struct alisp_object * p)
184 lisp_debug(instance, "delete cons %p (type = %i, refs = %i) (s = '%s')", p, alisp_get_type(p), alisp_get_refs(p),
190 instance->used_objs--;
192 if (instance->free_objs >= ALISP_FREE_OBJ_POOL) {
193 lisp_debug(instance, "freed cons %p", p);
197 lisp_debug(instance, "moved cons %p to free list", p);
198 list_add(&p->list, &instance->free_objs_list);
199 instance->free_objs++;
202 static void delete_tree(struct alisp_instance *instance, struct alisp_object * p)
207 delete_tree(instance, p->value.c.car);
208 delete_tree(instance, p->value.c.cdr);
210 delete_object(instance, p);
213 static struct alisp_object * incref_object(struct alisp_instance *instance ATTRIBUTE_UNUSED, struct alisp_object * p)
226 static struct alisp_object * incref_tree(struct alisp_instance *instance, struct alisp_object * p)
231 incref_tree(instance, p->value.c.car);
232 incref_tree(instance, p->value.c.cdr);
234 return incref_object(instance, p);
240 static struct alisp_object * incref_tree_explicit(struct alisp_instance *instance, struct alisp_object * p, struct alisp_object * e)
246 incref_tree(instance, p->value.c.car);
247 incref_tree(instance, p->value.c.cdr);
249 incref_tree_explicit(instance, p->value.c.car, e);
250 incref_tree_explicit(instance, p->value.c.cdr, e);
254 return incref_object(instance, p);
259 static void free_objects(struct alisp_instance *instance)
267 list_for_each_safe(pos, pos1, &instance->setobjs_list[i]) {
269 lisp_debug(instance, "freeing pair: '%s' -> %p", pair->name, pair->value);
270 delete_tree(instance, pair->value);
277 list_for_each_safe(pos, pos1, &instance->used_objs_list[i][j]) {
279 lisp_warn(instance, "object %p is still referenced %i times!", p, alisp_get_refs(p));
281 snd_output_printf(instance->wout, ">>>> ");
282 princ_object(instance->wout, p);
283 snd_output_printf(instance->wout, " <<<<\n");
287 delete_object(instance, p);
290 list_for_each_safe(pos, pos1, &instance->free_objs_list) {
294 lisp_debug(instance, "freed (all) cons %p", p);
298 static struct alisp_object * search_object_identifier(struct alisp_instance *instance, const char *s)
303 list_for_each(pos, &instance->used_objs_list[get_string_hash(s)][ALISP_OBJ_IDENTIFIER]) {
308 return incref_object(instance, p);
314 static struct alisp_object * search_object_string(struct alisp_instance *instance, const char *s)
319 list_for_each(pos, &instance->used_objs_list[get_string_hash(s)][ALISP_OBJ_STRING]) {
324 return incref_object(instance, p);
331 static struct alisp_object * search_object_integer(struct alisp_instance *instance, long in)
336 list_for_each(pos, &instance->used_objs_list[in & ALISP_OBJ_PAIR_HASH_MASK][ALISP_OBJ_INTEGER]) {
341 return incref_object(instance, p);
348 static struct alisp_object * search_object_float(struct alisp_instance *instance, double in)
353 list_for_each(pos, &instance->used_objs_list[(long)in & ALISP_OBJ_PAIR_HASH_MASK][ALISP_OBJ_FLOAT]) {
358 return incref_object(instance, p);
365 static struct alisp_object * search_object_pointer(struct alisp_instance *instance, const void *ptr)
370 list_for_each(pos, &instance->used_objs_list[(long)ptr & ALISP_OBJ_PAIR_HASH_MASK][ALISP_OBJ_POINTER]) {
375 return incref_object(instance, p);
382 static struct alisp_object * new_integer(struct alisp_instance *instance, long value)
386 obj = search_object_integer(instance, value);
389 obj = new_object(instance, ALISP_OBJ_INTEGER);
391 list_add(&obj->list, &instance->used_objs_list[value & ALISP_OBJ_PAIR_HASH_MASK][ALISP_OBJ_INTEGER]);
397 static struct alisp_object * new_float(struct alisp_instance *instance, double value)
401 obj = search_object_float(instance, value);
404 obj = new_object(instance, ALISP_OBJ_FLOAT);
406 list_add(&obj->list, &instance->used_objs_list[(long)value & ALISP_OBJ_PAIR_HASH_MASK][ALISP_OBJ_FLOAT]);
412 static struct alisp_object * new_string(struct alisp_instance *instance, const char *str)
416 obj = search_object_string(instance, str);
419 obj = new_object(instance, ALISP_OBJ_STRING);
421 list_add(&obj->list, &instance->used_objs_list[get_string_hash(str)][ALISP_OBJ_STRING]);
423 delete_object(instance, obj);
430 static struct alisp_object * new_identifier(struct alisp_instance *instance, const char *id)
434 obj = search_object_identifier(instance, id);
437 obj = new_object(instance, ALISP_OBJ_IDENTIFIER);
439 list_add(&obj->list, &instance->used_objs_list[get_string_hash(id)][ALISP_OBJ_IDENTIFIER]);
441 delete_object(instance, obj);
448 static struct alisp_object * new_pointer(struct alisp_instance *instance, const void *ptr)
452 obj = search_object_pointer(instance, ptr);
455 obj = new_object(instance, ALISP_OBJ_POINTER);
457 list_add(&obj->list, &instance->used_objs_list[(long)ptr & ALISP_OBJ_PAIR_HASH_MASK][ALISP_OBJ_POINTER]);
463 static struct alisp_object * new_cons_pointer(struct alisp_instance * instance, const char *ptr_id, void *ptr)
469 lexpr = new_object(instance, ALISP_OBJ_CONS);
472 lexpr->value.c.car = new_string(instance, ptr_id);
475 lexpr->value.c.cdr = new_pointer(instance, ptr);
477 delete_object(instance, lexpr->value.c.car);
479 delete_object(instance, lexpr);
501 static int xgetc(struct alisp_instance *instance)
503 instance->charno++;
504 if (instance->lex_bufp > instance->lex_buf)
505 return *--(instance->lex_bufp);
506 return snd_input_getc(instance->in);
509 static inline void xungetc(struct alisp_instance *instance, int c)
511 *(instance->lex_bufp)++ = c;
512 instance->charno--;
515 static int init_lex(struct alisp_instance *instance)
517 instance->charno = instance->lineno = 1;
518 instance->token_buffer_max = 10;
519 if ((instance->token_buffer = (char *)malloc(instance->token_buffer_max)) == NULL) {
523 instance->lex_bufp = instance->lex_buf;
527 static void done_lex(struct alisp_instance *instance)
529 free(instance->token_buffer);
532 static char * extend_buf(struct alisp_instance *instance, char *p)
534 int off = p - instance->token_buffer;
536 instance->token_buffer_max += 10;
537 instance->token_buffer = (char *)realloc(instance->token_buffer, instance->token_buffer_max);
538 if (instance->token_buffer == NULL) {
543 return instance->token_buffer + off;
546 static int gettoken(struct alisp_instance *instance)
552 c = xgetc(instance);
555 ++instance->lineno;
563 while ((c = xgetc(instance)) != '\n' && c != EOF)
566 ++instance->lineno;
571 c = xgetc(instance);
572 sprintf(instance->token_buffer, "%d", c);
573 return instance->thistoken = ALISP_INTEGER;
577 c = xgetc(instance);
579 xungetc(instance, c);
583 xungetc(instance, c);
592 p = instance->token_buffer;
593 instance->thistoken = ALISP_INTEGER;
596 if (p - instance->token_buffer >= instance->token_buffer_max - 1) {
597 p = extend_buf(instance, p);
599 return instance->thistoken = EOF;
602 c = xgetc(instance);
603 if (c == '.' && instance->thistoken == ALISP_INTEGER) {
604 c = xgetc(instance);
605 xungetc(instance, c);
607 instance->thistoken = ALISP_FLOAT;
613 } else if (c == 'e' && instance->thistoken == ALISP_FLOAT) {
614 c = xgetc(instance);
616 instance->thistoken = ALISP_FLOATE;
621 xungetc(instance, c);
623 return instance->thistoken;
639 p = instance->token_buffer;
641 if (p - instance->token_buffer >= instance->token_buffer_max - 1) {
642 p = extend_buf(instance, p);
644 return instance->thistoken = EOF;
647 c = xgetc(instance);
649 xungetc(instance, c);
651 return instance->thistoken = ALISP_IDENTIFIER;
655 p = instance->token_buffer;
656 while ((c = xgetc(instance)) != '"' && c != EOF) {
657 if (p - instance->token_buffer >= instance->token_buffer_max - 1) {
658 p = extend_buf(instance, p);
660 return instance->thistoken = EOF;
663 c = xgetc(instance);
665 case '\n': ++instance->lineno; break;
677 ++instance->lineno;
682 return instance->thistoken = ALISP_STRING;
685 return instance->thistoken = c;
694 static struct alisp_object * parse_form(struct alisp_instance *instance)
699 while ((thistoken = gettoken(instance)) != ')' && thistoken != EOF) {
704 gettoken(instance);
706 lisp_error(instance, "unexpected '.'");
708 delete_tree(instance, first);
711 prev->value.c.cdr = parse_object(instance, 1);
714 if ((thistoken = gettoken(instance)) != ')') {
715 lisp_error(instance, "expected ')'");
721 p = new_object(instance, ALISP_OBJ_CONS);
730 p->value.c.car = parse_object(instance, 1);
743 static struct alisp_object * quote_object(struct alisp_instance *instance, struct alisp_object * obj)
750 p = new_object(instance, ALISP_OBJ_CONS);
754 p->value.c.car = new_identifier(instance, "quote");
757 p->value.c.cdr = new_object(instance, ALISP_OBJ_CONS);
759 delete_object(instance, p->value.c.car);
761 delete_object(instance, p);
763 delete_tree(instance, obj);
771 static inline struct alisp_object * parse_quote(struct alisp_instance *instance)
773 return quote_object(instance, parse_object(instance, 0));
776 static struct alisp_object * parse_object(struct alisp_instance *instance, int havetoken)
782 thistoken = gettoken(instance);
784 thistoken = instance->thistoken;
790 p = parse_form(instance);
793 p = parse_quote(instance);
796 if (!strcmp(instance->token_buffer, "t"))
798 else if (!strcmp(instance->token_buffer, "nil"))
801 p = new_identifier(instance, instance->token_buffer);
805 p = new_integer(instance, atol(instance->token_buffer));
810 p = new_float(instance, atof(instance->token_buffer));
814 p = new_string(instance, instance->token_buffer);
817 lisp_warn(instance, "%d:%d: unexpected character `%c'", instance->lineno, instance->charno, thistoken);
828 static struct alisp_object_pair * set_object_direct(struct alisp_instance *instance, struct alisp_object * name, struct alisp_object * value)
841 delete_tree(instance, value);
845 list_add(&p->list, &instance->setobjs_list[get_string_hash(id)]);
850 static int check_set_object(struct alisp_instance * instance, struct alisp_object * name)
853 lisp_warn(instance, "setting the value of a nil object");
857 lisp_warn(instance, "setting the value of a t object");
862 lisp_warn(instance, "setting the value of an object with non-indentifier");
868 static struct alisp_object_pair * set_object(struct alisp_instance *instance, struct alisp_object * name, struct alisp_object * value)
879 list_for_each(pos, &instance->setobjs_list[get_string_hash(id)]) {
882 delete_tree(instance, p->value);
895 delete_tree(instance, value);
899 list_add(&p->list, &instance->setobjs_list[get_string_hash(id)]);
904 static struct alisp_object * unset_object(struct alisp_instance *instance, struct alisp_object * name)
913 lisp_warn(instance, "unset object with a non-indentifier");
918 list_for_each(pos, &instance->setobjs_list[get_string_hash(id)]) {
932 static struct alisp_object * get_object1(struct alisp_instance *instance, const char *id)
937 list_for_each(pos, &instance->setobjs_list[get_string_hash(id)]) {
946 static struct alisp_object * get_object(struct alisp_instance *instance, struct alisp_object * name)
950 delete_tree(instance, name);
953 return get_object1(instance, name->value.s);
956 static struct alisp_object * replace_object(struct alisp_instance *instance, struct alisp_object * name, struct alisp_object * onew)
965 delete_tree(instance, name);
969 list_for_each(pos, &instance->setobjs_list[get_string_hash(id)]) {
981 static void dump_objects(struct alisp_instance *instance, const char *fname)
998 list_for_each(pos, &instance->setobjs_list[i]) {
1031 static void print_obj_lists(struct alisp_instance *instance, snd_output_t *out)
1040 list_for_each(pos, &instance->used_objs_list[i][j]) {
1050 list_for_each(pos, &instance->free_objs_list) {
1056 static void dump_obj_lists(struct alisp_instance *instance, const char *fname)
1070 print_obj_lists(instance, out);
1110 static struct alisp_object * F_car(struct alisp_instance *instance, struct alisp_object * args)
1113 delete_tree(instance, cdr(args));
1114 delete_object(instance, args);
1115 p1 = eval(instance, p1);
1116 delete_tree(instance, cdr(p1));
1118 delete_object(instance, p1);
1125 static struct alisp_object * F_cdr(struct alisp_instance *instance, struct alisp_object * args)
1128 delete_tree(instance, cdr(args));
1129 delete_object(instance, args);
1130 p1 = eval(instance, p1);
1131 delete_tree(instance, car(p1));
1133 delete_object(instance, p1);
1140 static struct alisp_object * F_add(struct alisp_instance *instance, struct alisp_object * args)
1147 p1 = eval(instance, car(p));
1159 lisp_warn(instance, "sum with a non integer or float operand");
1161 delete_tree(instance, p1);
1163 delete_object(instance, n);
1166 p1 = eval(instance, car(p));
1169 return new_integer(instance, v);
1171 return new_float(instance, f);
1178 static struct alisp_object * F_concat(struct alisp_instance *instance, struct alisp_object * args)
1183 p1 = eval(instance, car(p));
1198 lisp_warn(instance, "concat with a non string or identifier operand");
1200 delete_tree(instance, p1);
1202 delete_object(instance, n);
1205 p1 = eval(instance, car(p));
1208 p = new_string(instance, str);
1219 static struct alisp_object * F_sub(struct alisp_instance *instance, struct alisp_object * args)
1227 p1 = eval(instance, car(p));
1248 lisp_warn(instance, "difference with a non integer or float operand");
1249 delete_tree(instance, p1);
1251 delete_object(instance, p);
1256 return new_integer(instance, v);
1258 return new_float(instance, f);
1265 static struct alisp_object * F_mul(struct alisp_instance *instance, struct alisp_object * args)
1273 p1 = eval(instance, car(p));
1283 lisp_warn(instance, "product with a non integer or float operand");
1285 delete_tree(instance, p1);
1287 delete_object(instance, p);
1292 return new_integer(instance, v);
1294 return new_float(instance, f);
1301 static struct alisp_object * F_div(struct alisp_instance *instance, struct alisp_object * args)
1309 p1 = eval(instance, car(p));
1315 lisp_warn(instance, "division by zero");
1335 lisp_warn(instance, "division by zero");
1343 lisp_warn(instance, "quotient with a non integer or float operand");
1344 delete_tree(instance, p1);
1346 delete_object(instance, p);
1351 return new_integer(instance, v);
1353 return new_float(instance, f);
1360 static struct alisp_object * F_mod(struct alisp_instance *instance, struct alisp_object * args)
1364 p1 = eval(instance, car(args));
1365 p2 = eval(instance, car(cdr(args)));
1366 delete_tree(instance, cdr(cdr(args)));
1367 delete_object(instance, cdr(args));
1368 delete_object(instance, args);
1373 lisp_warn(instance, "module by zero");
1374 p3 = new_integer(instance, 0);
1376 p3 = new_integer(instance, p1->value.i % p2->value.i);
1387 lisp_warn(instance, "module by zero");
1388 p3 = new_float(instance, 0);
1390 p3 = new_float(instance, f1);
1393 lisp_warn(instance, "module with a non integer or float operand");
1394 delete_tree(instance, p1);
1395 delete_tree(instance, p2);
1399 delete_tree(instance, p1);
1400 delete_tree(instance, p2);
1407 static struct alisp_object * F_lt(struct alisp_instance *instance, struct alisp_object * args)
1411 p1 = eval(instance, car(args));
1412 p2 = eval(instance, car(cdr(args)));
1413 delete_tree(instance, cdr(cdr(args)));
1414 delete_object(instance, cdr(args));
1415 delete_object(instance, args);
1421 delete_tree(instance, p1);
1422 delete_tree(instance, p2);
1435 lisp_warn(instance, "comparison with a non integer or float operand");
1438 delete_tree(instance, p1);
1439 delete_tree(instance, p2);
1446 static struct alisp_object * F_gt(struct alisp_instance *instance, struct alisp_object * args)
1450 p1 = eval(instance, car(args));
1451 p2 = eval(instance, car(cdr(args)));
1452 delete_tree(instance, cdr(cdr(args)));
1453 delete_object(instance, cdr(args));
1454 delete_object(instance, args);
1460 delete_tree(instance, p1);
1461 delete_tree(instance, p2);
1474 lisp_warn(instance, "comparison with a non integer or float operand");
1477 delete_tree(instance, p1);
1478 delete_tree(instance, p2);
1485 static struct alisp_object * F_le(struct alisp_instance *instance, struct alisp_object * args)
1489 p1 = eval(instance, car(args));
1490 p2 = eval(instance, car(cdr(args)));
1491 delete_tree(instance, cdr(cdr(args)));
1492 delete_object(instance, cdr(args));
1493 delete_object(instance, args);
1499 delete_tree(instance, p1);
1500 delete_tree(instance, p2);
1513 lisp_warn(instance, "comparison with a non integer or float operand");
1516 delete_tree(instance, p1);
1517 delete_tree(instance, p2);
1524 static struct alisp_object * F_ge(struct alisp_instance *instance, struct alisp_object * args)
1528 p1 = eval(instance, car(args));
1529 p2 = eval(instance, car(cdr(args)));
1530 delete_tree(instance, cdr(cdr(args)));
1531 delete_object(instance, cdr(args));
1532 delete_object(instance, args);
1538 delete_tree(instance, p1);
1539 delete_tree(instance, p2);
1552 lisp_warn(instance, "comparison with a non integer or float operand");
1555 delete_tree(instance, p1);
1556 delete_tree(instance, p2);
1563 static struct alisp_object * F_numeq(struct alisp_instance *instance, struct alisp_object * args)
1567 p1 = eval(instance, car(args));
1568 p2 = eval(instance, car(cdr(args)));
1569 delete_tree(instance, cdr(cdr(args)));
1570 delete_object(instance, cdr(args));
1571 delete_object(instance, args);
1577 delete_tree(instance, p1);
1578 delete_tree(instance, p2);
1591 lisp_warn(instance, "comparison with a non integer or float operand");
1594 delete_tree(instance, p1);
1595 delete_tree(instance, p2);
1602 static struct alisp_object * F_numneq(struct alisp_instance *instance, struct alisp_object * args)
1606 p = F_numeq(instance, args);
1616 static struct alisp_object * F_exfun(struct alisp_instance *instance, struct alisp_object * args)
1620 p1 = eval(instance, car(args));
1621 delete_tree(instance, cdr(args));
1622 delete_object(instance, args);
1623 p2 = get_object(instance, p1);
1625 delete_tree(instance, p1);
1631 delete_tree(instance, p1);
1634 delete_tree(instance, p1);
1707 static struct alisp_object * F_princ(struct alisp_instance *instance, struct alisp_object * args)
1713 delete_tree(instance, p1);
1714 p1 = eval(instance, car(p));
1716 snd_output_printf(instance->out, "%s", p1->value.s);
1718 princ_object(instance->out, p1);
1720 delete_object(instance, p);
1730 static struct alisp_object * F_atom(struct alisp_instance *instance, struct alisp_object * args)
1734 p = eval(instance, car(args));
1735 delete_tree(instance, cdr(args));
1736 delete_object(instance, args);
1748 delete_tree(instance, p);
1754 delete_tree(instance, p);
1761 static struct alisp_object * F_cons(struct alisp_instance *instance, struct alisp_object * args)
1765 p = new_object(instance, ALISP_OBJ_CONS);
1767 p->value.c.car = eval(instance, car(args));
1768 p->value.c.cdr = eval(instance, car(cdr(args)));
1769 delete_tree(instance, cdr(cdr(args)));
1770 delete_object(instance, cdr(args));
1771 delete_object(instance, args);
1773 delete_tree(instance, args);
1782 static struct alisp_object * F_list(struct alisp_instance *instance, struct alisp_object * args)
1790 p1 = new_object(instance, ALISP_OBJ_CONS);
1792 delete_tree(instance, p);
1793 delete_tree(instance, first);
1796 p1->value.c.car = eval(instance, car(p));
1798 delete_tree(instance, first);
1799 delete_tree(instance, cdr(p));
1800 delete_object(instance, p);
1809 delete_object(instance, p1);
1850 static struct alisp_object * F_eq(struct alisp_instance *instance, struct alisp_object * args)
1854 p1 = eval(instance, car(args));
1855 p2 = eval(instance, car(cdr(args)));
1856 delete_tree(instance, cdr(cdr(args)));
1857 delete_object(instance, cdr(args));
1858 delete_object(instance, args);
1861 delete_tree(instance, p1);
1862 delete_tree(instance, p2);
1865 delete_tree(instance, p1);
1866 delete_tree(instance, p2);
1873 static struct alisp_object * F_equal(struct alisp_instance *instance, struct alisp_object * args)
1877 p1 = eval(instance, car(args));
1878 p2 = eval(instance, car(cdr(args)));
1879 delete_tree(instance, cdr(cdr(args)));
1880 delete_object(instance, cdr(args));
1881 delete_object(instance, args);
1884 delete_tree(instance, p1);
1885 delete_tree(instance, p2);
1888 delete_tree(instance, p1);
1889 delete_tree(instance, p2);
1896 static struct alisp_object * F_quote(struct alisp_instance *instance ATTRIBUTE_UNUSED, struct alisp_object * args)
1900 delete_tree(instance, cdr(args));
1901 delete_object(instance, args);
1908 static struct alisp_object * F_and(struct alisp_instance *instance, struct alisp_object * args)
1914 delete_tree(instance, p1);
1915 p1 = eval(instance, car(p));
1917 delete_tree(instance, p1);
1918 delete_tree(instance, cdr(p));
1919 delete_object(instance, p);
1923 delete_object(instance, n);
1932 static struct alisp_object * F_or(struct alisp_instance *instance, struct alisp_object * args)
1938 delete_tree(instance, p1);
1939 p1 = eval(instance, car(p));
1941 delete_tree(instance, cdr(p));
1942 delete_object(instance, p);
1946 delete_object(instance, n);
1956 static struct alisp_object * F_not(struct alisp_instance *instance, struct alisp_object * args)
1958 struct alisp_object * p = eval(instance, car(args));
1960 delete_tree(instance, cdr(args));
1961 delete_object(instance, args);
1963 delete_tree(instance, p);
1967 delete_tree(instance, p);
1974 static struct alisp_object * F_cond(struct alisp_instance *instance, struct alisp_object * args)
1980 if ((p2 = eval(instance, car(p1))) != &alsa_lisp_nil) {
1982 delete_object(instance, p1);
1983 delete_tree(instance, cdr(p));
1984 delete_object(instance, p);
1986 delete_tree(instance, p2);
1987 return F_progn(instance, p3);
1989 delete_tree(instance, p3);
1993 delete_tree(instance, p2);
1994 delete_tree(instance, cdr(p1));
1995 delete_object(instance, p1);
1998 delete_object(instance, p2);
2007 static struct alisp_object * F_if(struct alisp_instance *instance, struct alisp_object * args)
2014 delete_object(instance, cdr(args));
2015 delete_object(instance, args);
2017 p1 = eval(instance, p1);
2019 delete_tree(instance, p1);
2020 delete_tree(instance, p3);
2021 return eval(instance, p2);
2024 delete_tree(instance, p1);
2025 delete_tree(instance, p2);
2026 return F_progn(instance, p3);
2032 static struct alisp_object * F_when(struct alisp_instance *instance, struct alisp_object * args)
2038 delete_object(instance, args);
2039 if ((p1 = eval(instance, p1)) != &alsa_lisp_nil) {
2040 delete_tree(instance, p1);
2041 return F_progn(instance, p2);
2043 delete_tree(instance, p1);
2044 delete_tree(instance, p2);
2053 static struct alisp_object * F_unless(struct alisp_instance *instance, struct alisp_object * args)
2059 delete_object(instance, args);
2060 if ((p1 = eval(instance, p1)) == &alsa_lisp_nil) {
2061 return F_progn(instance, p2);
2063 delete_tree(instance, p1);
2064 delete_tree(instance, p2);
2073 static struct alisp_object * F_while(struct alisp_instance *instance, struct alisp_object * args)
2080 delete_object(instance, args);
2082 incref_tree(instance, p1);
2083 if ((p3 = eval(instance, p1)) == &alsa_lisp_nil)
2085 delete_tree(instance, p3);
2086 incref_tree(instance, p2);
2087 delete_tree(instance, F_progn(instance, p2));
2090 delete_tree(instance, p1);
2091 delete_tree(instance, p2);
2098 static struct alisp_object * F_progn(struct alisp_instance *instance, struct alisp_object * args)
2104 delete_tree(instance, p1);
2105 p1 = eval(instance, car(p));
2107 delete_object(instance, p);
2117 static struct alisp_object * F_prog1(struct alisp_instance *instance, struct alisp_object * args)
2122 p1 = eval(instance, car(p));
2126 delete_tree(instance, p1);
2128 delete_object(instance, p);
2141 static struct alisp_object * F_prog2(struct alisp_instance *instance, struct alisp_object * args)
2148 p1 = eval(instance, car(p));
2152 delete_tree(instance, p1);
2154 delete_object(instance, p);
2167 static struct alisp_object * F_set(struct alisp_instance *instance, struct alisp_object * args)
2169 struct alisp_object * p1 = eval(instance, car(args)),
2170 * p2 = eval(instance, car(cdr(args)));
2172 delete_tree(instance, cdr(cdr(args)));
2173 delete_object(instance, cdr(args));
2174 delete_object(instance, args);
2175 if (!check_set_object(instance, p1)) {
2176 delete_tree(instance, p2);
2179 if (set_object(instance, p1, p2) == NULL) {
2180 delete_tree(instance, p1);
2181 delete_tree(instance, p2);
2185 delete_tree(instance, p1);
2186 return incref_tree(instance, p2);
2192 static struct alisp_object * F_unset(struct alisp_instance *instance, struct alisp_object * args)
2194 struct alisp_object * p1 = eval(instance, car(args));
2196 delete_tree(instance, unset_object(instance, p1));
2197 delete_tree(instance, cdr(args));
2198 delete_object(instance, args);
2207 static struct alisp_object * F_setq(struct alisp_instance *instance, struct alisp_object * args)
2213 p2 = eval(instance, car(cdr(p)));
2215 delete_object(instance, cdr(p));
2216 delete_object(instance, p);
2217 if (!check_set_object(instance, p1)) {
2218 delete_tree(instance, p2);
2221 if (set_object(instance, p1, p2) == NULL) {
2222 delete_tree(instance, p1);
2223 delete_tree(instance, p2);
2227 delete_tree(instance, p1);
2231 return incref_tree(instance, p2);
2239 static struct alisp_object * F_unsetq(struct alisp_instance *instance, struct alisp_object * args)
2245 delete_tree(instance, p1);
2246 p1 = unset_object(instance, car(p));
2247 delete_tree(instance, car(p));
2249 delete_object(instance, n);
2260 static struct alisp_object * F_defun(struct alisp_instance *instance, struct alisp_object * args)
2267 lexpr = new_object(instance, ALISP_OBJ_CONS);
2269 lexpr->value.c.car = new_identifier(instance, "lambda");
2271 delete_object(instance, lexpr);
2272 delete_tree(instance, args);
2275 if ((lexpr->value.c.cdr = new_object(instance, ALISP_OBJ_CONS)) == NULL) {
2276 delete_object(instance, lexpr->value.c.car);
2277 delete_object(instance, lexpr);
2278 delete_tree(instance, args);
2283 delete_object(instance, cdr(args));
2284 delete_object(instance, args);
2285 if (set_object(instance, p1, lexpr) == NULL) {
2286 delete_tree(instance, p1);
2287 delete_tree(instance, lexpr);
2290 delete_tree(instance, p1);
2292 delete_tree(instance, args);
2297 static struct alisp_object * eval_func(struct alisp_instance *instance, struct alisp_object * p, struct alisp_object * args)
2310 lisp_warn(instance, "wrong number of parameters");
2326 eval_objs[i++] = eval(instance, car(p3));
2328 delete_object(instance, p4);
2337 save_objs[i] = replace_object(instance, p3, eval_objs[i]);
2339 set_object_direct(instance, p3, eval_objs[i]) == NULL) {
2347 p4 = F_progn(instance, cdr(incref_tree(instance, p3 = cdr(p))));
2353 delete_object(instance, p3);
2358 p3 = unset_object(instance, p3);
2360 p3 = replace_object(instance, p3, save_objs[i]);
2363 delete_tree(instance, p3);
2364 delete_tree(instance, car(p2));
2366 delete_object(instance, p3);
2375 delete_tree(instance, args);
2380 struct alisp_object * F_gc(struct alisp_instance *instance ATTRIBUTE_UNUSED, struct alisp_object * args ATTRIBUTE_UNUSED)
2390 struct alisp_object * F_path(struct alisp_instance *instance, struct alisp_object * args)
2394 p1 = eval(instance, car(args));
2395 delete_tree(instance, cdr(args));
2396 delete_object(instance, args);
2398 delete_tree(instance, p1);
2402 delete_tree(instance, p1);
2403 return new_string(instance, snd_config_topdir());
2405 delete_tree(instance, p1);
2412 struct alisp_object * F_include(struct alisp_instance *instance, struct alisp_object * args)
2418 p1 = eval(instance, car(p));
2420 res = alisp_include_file(instance, p1->value.s);
2421 delete_tree(instance, p1);
2423 delete_object(instance, p1);
2426 return new_integer(instance, res);
2433 struct alisp_object * F_string_to_integer(struct alisp_instance *instance, struct alisp_object * args)
2435 struct alisp_object * p = eval(instance, car(args)), * p1;
2437 delete_tree(instance, cdr(args));
2438 delete_object(instance, args);
2442 p1 = new_integer(instance, floor(p->value.f));
2444 lisp_warn(instance, "expected an integer or float for integer conversion");
2447 delete_tree(instance, p);
2455 struct alisp_object * F_string_to_float(struct alisp_instance *instance, struct alisp_object * args)
2457 struct alisp_object * p = eval(instance, car(args)), * p1;
2459 delete_tree(instance, cdr(args));
2460 delete_object(instance, args);
2464 p1 = new_float(instance, p->value.i);
2466 lisp_warn(instance, "expected an integer or float for integer conversion");
2469 delete_tree(instance, p);
2495 static int format_parse_char(struct alisp_instance *instance, char **s, int *len, struct alisp_object *p)
2500 lisp_warn(instance, "format: expected integer\n");
2507 static int format_parse_integer(struct alisp_instance *instance, char **s, int *len, struct alisp_object *p)
2514 lisp_warn(instance, "format: expected integer or float\n");
2528 static int format_parse_float(struct alisp_instance *instance, char **s, int *len, struct alisp_object *p)
2535 lisp_warn(instance, "format: expected integer or float\n");
2549 static int format_parse_string(struct alisp_instance *instance, char **s, int *len, struct alisp_object *p)
2552 lisp_warn(instance, "format: expected string\n");
2562 struct alisp_object * F_format(struct alisp_instance *instance, struct alisp_object * args)
2564 struct alisp_object * p = eval(instance, car(args)), * p1 = cdr(args), * n;
2568 delete_object(instance, args);
2570 delete_tree(instance, p1);
2571 delete_tree(instance, p);
2572 lisp_warn(instance, "format: expected an format string");
2578 n = eval(instance, car(p1));
2587 delete_tree(instance, n);
2588 delete_tree(instance, cdr(p1));
2589 delete_object(instance, p1);
2590 delete_tree(instance, p);
2603 if (format_parse_char(instance, &s1, &len, n) < 0)
2609 if (format_parse_integer(instance, &s1, &len, n) < 0)
2614 if (format_parse_float(instance, &s1, &len, n) < 0)
2619 if (format_parse_string(instance, &s1, &len, n) < 0)
2626 lisp_warn(instance, "unknown format char '%c'", *s2);
2632 delete_tree(instance, n);
2634 delete_object(instance, n);
2635 n = eval(instance, car(p1));
2638 delete_tree(instance, n);
2639 delete_tree(instance, cdr(p1));
2640 delete_object(instance, p1);
2641 delete_tree(instance, p);
2643 p1 = new_string(instance, s1);
2661 struct alisp_object * F_compare_strings(struct alisp_instance *instance, struct alisp_object * args)
2668 p[start1] = eval(instance, car(p1));
2670 delete_object(instance, n);
2672 delete_tree(instance, p1);
2674 lisp_warn(instance, "compare-strings: first argument must be string\n");
2679 lisp_warn(instance, "compare-strings: second argument must be integer\n");
2684 lisp_warn(instance, "compare-strings: third argument must be integer\n");
2689 lisp_warn(instance, "compare-strings: fifth argument must be string\n");
2695 lisp_warn(instance, "compare-strings: fourth argument must be integer\n");
2701 lisp_warn(instance, "compare-strings: sixth argument must be integer\n");
2744 delete_tree(instance, p[start1]);
2751 struct alisp_object * F_assoc(struct alisp_instance *instance, struct alisp_object * args)
2755 p1 = eval(instance, car(args));
2756 p2 = eval(instance, car(cdr(args)));
2757 delete_tree(instance, cdr(cdr(args)));
2758 delete_object(instance, cdr(args));
2759 delete_object(instance, args);
2764 delete_tree(instance, p1);
2765 delete_tree(instance, cdr(p2));
2766 delete_object(instance, p2);
2769 delete_tree(instance, car(p2));
2771 delete_object(instance, n);
2774 delete_tree(instance, p1);
2781 struct alisp_object * F_rassoc(struct alisp_instance *instance, struct alisp_object * args)
2785 p1 = eval(instance, car(args));
2786 p2 = eval(instance, car(cdr(args)));
2787 delete_tree(instance, cdr(cdr(args)));
2788 delete_object(instance, cdr(args));
2789 delete_object(instance, args);
2794 delete_tree(instance, p1);
2795 delete_tree(instance, cdr(p2));
2796 delete_object(instance, p2);
2799 delete_tree(instance, car(p2));
2801 delete_object(instance, n);
2804 delete_tree(instance, p1);
2811 struct alisp_object * F_assq(struct alisp_instance *instance, struct alisp_object * args)
2815 p1 = eval(instance, car(args));
2816 p2 = eval(instance, car(cdr(args)));
2817 delete_tree(instance, cdr(cdr(args)));
2818 delete_object(instance, cdr(args));
2819 delete_object(instance, args);
2824 delete_tree(instance, p1);
2825 delete_tree(instance, cdr(p2));
2826 delete_object(instance, p2);
2829 delete_tree(instance, car(p2));
2831 delete_object(instance, n);
2834 delete_tree(instance, p1);
2841 struct alisp_object * F_nth(struct alisp_instance *instance, struct alisp_object * args)
2846 p1 = eval(instance, car(args));
2847 p2 = eval(instance, car(cdr(args)));
2848 delete_tree(instance, cdr(cdr(args)));
2849 delete_object(instance, cdr(args));
2850 delete_object(instance, args);
2853 delete_tree(instance, p1);
2854 delete_tree(instance, p2);
2858 delete_object(instance, p1);
2859 delete_tree(instance, p2);
2863 delete_object(instance, p1);
2865 delete_tree(instance, car(p2));
2867 delete_object(instance, n);
2870 delete_tree(instance, cdr(p2));
2871 delete_object(instance, p2);
2878 struct alisp_object * F_rassq(struct alisp_instance *instance, struct alisp_object * args)
2882 p1 = eval(instance, car(args));
2883 p2 = eval(instance, car(cdr(args)));
2884 delete_tree(instance, cdr(cdr(args)));
2885 delete_object(instance, cdr(args));
2886 delete_object(instance, args);
2891 delete_tree(instance, p1);
2892 delete_tree(instance, cdr(p2));
2893 delete_object(instance, p2);
2896 delete_tree(instance, car(p2));
2898 delete_object(instance, n);
2901 delete_tree(instance, p1);
2905 static struct alisp_object * F_dump_memory(struct alisp_instance *instance, struct alisp_object * args)
2912 dump_objects(instance, p->value.s);
2913 delete_tree(instance, args);
2916 lisp_warn(instance, "expected filename");
2918 lisp_warn(instance, "wrong number of parameters (expected string)");
2920 delete_tree(instance, args);
2924 static struct alisp_object * F_stat_memory(struct alisp_instance *instance, struct alisp_object * args)
2926 snd_output_printf(instance->out, "*** Memory stats\n");
2927 snd_output_printf(instance->out, " used_objs = %li, free_objs = %li, max_objs = %li, obj_size = %i (total bytes = %li, max bytes = %li)\n",
2928 instance->used_objs,
2929 instance->free_objs,
2930 instance->max_objs,
2932 (long)((instance->used_objs + instance->free_objs) * sizeof(struct alisp_object)),
2933 (long)(instance->max_objs * sizeof(struct alisp_object)));
2934 delete_tree(instance, args);
2938 static struct alisp_object * F_check_memory(struct alisp_instance *instance, struct alisp_object * args)
2940 delete_tree(instance, args);
2941 if (instance->used_objs > 0) {
2943 F_stat_memory(instance, &alsa_lisp_nil);
2949 static struct alisp_object * F_dump_objects(struct alisp_instance *instance, struct alisp_object * args)
2956 dump_obj_lists(instance, p->value.s);
2957 delete_tree(instance, args);
2960 lisp_warn(instance, "expected filename");
2962 lisp_warn(instance, "wrong number of parameters (expected string)");
2964 delete_tree(instance, args);
2970 struct alisp_object * (*func)(struct alisp_instance *instance, struct alisp_object * args);
3047 static inline struct alisp_object * eval_cons1(struct alisp_instance *instance, struct alisp_object * p1, struct alisp_object * p2)
3057 delete_object(instance, p1);
3058 return item->func(instance, p2);
3064 delete_object(instance, p1);
3065 return item->func(instance, p2);
3068 if ((p3 = get_object(instance, p1)) != &alsa_lisp_nil) {
3069 delete_object(instance, p1);
3070 return eval_func(instance, p3, p2);
3072 lisp_warn(instance, "function `%s' is undefined", p1->value.s);
3073 delete_object(instance, p1);
3074 delete_tree(instance, p2);
3083 static struct alisp_object * F_funcall(struct alisp_instance *instance, struct alisp_object * args)
3085 struct alisp_object * p = eval(instance, car(args)), * p1;
3089 lisp_warn(instance, "expected an function name");
3090 delete_tree(instance, p);
3091 delete_tree(instance, cdr(args));
3092 delete_object(instance, args);
3096 delete_object(instance, args);
3097 return eval_cons1(instance, p, p1);
3100 static inline struct alisp_object * eval_cons(struct alisp_instance *instance, struct alisp_object * p)
3109 delete_object(instance, p);
3110 return eval_cons1(instance, p1, p2);
3112 delete_tree(instance, p);
3118 static struct alisp_object * eval(struct alisp_instance *instance, struct alisp_object * p)
3122 struct alisp_object *r = incref_tree(instance, get_object(instance, p));
3123 delete_object(instance, p);
3132 return eval_cons(instance, p);
3140 static struct alisp_object * F_eval(struct alisp_instance *instance, struct alisp_object * args)
3142 return eval(instance, eval(instance, car(args)));
3149 static int alisp_include_file(struct alisp_instance *instance, const char *filename)
3159 old_in = instance->in;
3160 err = snd_input_stdio_open(&instance->in, name, "r");
3165 if (instance->verbose)
3166 lisp_verbose(instance, "** include filename '%s'", name);
3169 if ((p = parse_object(instance, 0)) == NULL)
3171 if (instance->verbose) {
3172 lisp_verbose(instance, "** code");
3173 princ_object(instance->vout, p);
3174 snd_output_putc(instance->vout, '\n');
3176 p1 = eval(instance, p);
3181 if (instance->verbose) {
3182 lisp_verbose(instance, "** result");
3183 princ_object(instance->vout, p1);
3184 snd_output_putc(instance->vout, '\n');
3186 delete_tree(instance, p1);
3187 if (instance->debug) {
3188 lisp_debug(instance, "** objects after operation");
3189 print_obj_lists(instance, instance->dout);
3193 snd_input_close(instance->in);
3196 instance->in = old_in;
3202 struct alisp_instance *instance;
3206 instance = (struct alisp_instance *)calloc(1, sizeof(struct alisp_instance));
3207 if (instance == NULL) {
3211 instance->verbose = cfg->verbose && cfg->vout;
3212 instance->warning = cfg->warning && cfg->wout;
3213 instance->debug = cfg->debug && cfg->dout;
3214 instance->in = cfg->in;
3215 instance->out = cfg->out;
3216 instance->vout = cfg->vout;
3217 instance->eout = cfg->eout;
3218 instance->wout = cfg->wout;
3219 instance->dout = cfg->dout;
3220 INIT_LIST_HEAD(&instance->free_objs_list);
3223 INIT_LIST_HEAD(&instance->used_objs_list[i][j]);
3224 INIT_LIST_HEAD(&instance->setobjs_list[i]);
3227 init_lex(instance);
3230 if ((p = parse_object(instance, 0)) == NULL)
3232 if (instance->verbose) {
3233 lisp_verbose(instance, "** code");
3234 princ_object(instance->vout, p);
3235 snd_output_putc(instance->vout, '\n');
3237 p1 = eval(instance, p);
3242 if (instance->verbose) {
3243 lisp_verbose(instance, "** result");
3244 princ_object(instance->vout, p1);
3245 snd_output_putc(instance->vout, '\n');
3247 delete_tree(instance, p1);
3248 if (instance->debug) {
3249 lisp_debug(instance, "** objects after operation");
3250 print_obj_lists(instance, instance->dout);
3255 *_instance = instance;
3257 alsa_lisp_free(instance);
3262 void alsa_lisp_free(struct alisp_instance *instance)
3264 if (instance == NULL)
3266 done_lex(instance);
3267 free_objects(instance);
3268 free(instance);
3307 int alsa_lisp_function(struct alisp_instance *instance, struct alisp_seq_iterator **result,
3331 obj = new_string(instance, va_arg(ap, char *));
3334 obj = new_integer(instance, va_arg(ap, int));
3337 obj = new_integer(instance, va_arg(ap, long));
3341 obj = new_integer(instance, va_arg(ap, double));
3353 obj = new_cons_pointer(instance, _ptrid, va_arg(ap, void *));
3354 obj = quote_object(instance, obj);
3368 p = aargs = new_object(instance, ALISP_OBJ_CONS);
3370 p->value.c.cdr = new_object(instance, ALISP_OBJ_CONS);
3384 snd_output_printf(instance->wout, ">>>");
3385 princ_object(instance->wout, aargs);
3386 snd_output_printf(instance->wout, "<<<\n");
3393 if ((obj = get_object1(instance, id)) != &alsa_lisp_nil) {
3394 res = eval_func(instance, obj, aargs);
3402 res = item->func(instance, aargs);
3407 res = item->func(instance, aargs);
3418 delete_tree(instance, res);
3424 void alsa_lisp_result_free(struct alisp_instance *instance,
3427 delete_tree(instance, result);
3430 int alsa_lisp_seq_first(struct alisp_instance *instance, const char *id,
3435 p1 = get_object1(instance, id);