Update of /cvsroot/alsa/alsa-lib/src/alisp
In directory sc8-pr-cvs1:/tmp/cvs-serv27938/src/alisp
Modified Files:
alisp.c alisp_local.h
Log Message:
alsalisp memory allocation optimization
- force of reusing alisp objects
- added auto-garbage-collect mechanism
- fixed bad garbage-collect (yes, the original code can free "running" lisp program)
- hctl.lisp test example
- reduced lisp object memory pool usage from 240kB to 29kB (auto-gc)
- reduced --''-- from 29kB (auto-gc) to 9kB (manual gc)
FIXME: we need definitely an opminization for the alisp object lookups
- use bsearch()?
Index: alisp.c
===================================================================
RCS file: /cvsroot/alsa/alsa-lib/src/alisp/alisp.c,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -r1.7 -r1.8
--- alisp.c 3 Aug 2003 20:36:54 -0000 1.7
+++ alisp.c 22 Aug 2003 09:41:17 -0000 1.8
@@ -35,7 +35,9 @@
#include "alisp.h"
#include "alisp_local.h"
-#define ALISP_FREE_OBJ_POOL 1000 /* free objects above this pool */
+#define ALISP_FREE_OBJ_POOL 500 /* free objects above this pool */
+#define ALISP_AUTO_GC_THRESHOLD 200 /* run automagically garbage-collect
when this threshold is reached */
+#define ALISP_MAIN_ID "---alisp---main---"
struct alisp_object alsa_lisp_nil;
struct alisp_object alsa_lisp_t;
@@ -121,6 +123,7 @@
nomem();
return NULL;
}
+ ++instance->gc_thr_objs;
lisp_debug(instance, "allocating cons %p", p);
} else {
p = instance->free_objs_list;
@@ -175,10 +178,68 @@
}
}
+static struct alisp_object * search_object_identifier(struct alisp_instance
*instance, const char *s)
+{
+ struct alisp_object * p;
+
+ for (p = instance->used_objs_list; p != NULL; p = p->next)
+ if (p->type == ALISP_OBJ_IDENTIFIER && !strcmp(p->value.id, s))
+ return p;
+
+ return NULL;
+}
+
+static struct alisp_object * search_object_string(struct alisp_instance *instance,
const char *s)
+{
+ struct alisp_object * p;
+
+ for (p = instance->used_objs_list; p != NULL; p = p->next)
+ if (p->type == ALISP_OBJ_STRING && !strcmp(p->value.s, s))
+ return p;
+
+ return NULL;
+}
+
+static struct alisp_object * search_object_integer(struct alisp_instance *instance,
long in)
+{
+ struct alisp_object * p;
+
+ for (p = instance->used_objs_list; p != NULL; p = p->next)
+ if (p->type == ALISP_OBJ_INTEGER && p->value.i == in)
+ return p;
+
+ return NULL;
+}
+
+static struct alisp_object * search_object_float(struct alisp_instance *instance,
double in)
+{
+ struct alisp_object * p;
+
+ for (p = instance->used_objs_list; p != NULL; p = p->next)
+ if (p->type == ALISP_OBJ_FLOAT && p->value.f == in)
+ return p;
+
+ return NULL;
+}
+
+static struct alisp_object * search_object_pointer(struct alisp_instance *instance,
const void *ptr)
+{
+ struct alisp_object * p;
+
+ for (p = instance->used_objs_list; p != NULL; p = p->next)
+ if (p->type == ALISP_OBJ_POINTER && p->value.ptr == ptr)
+ return p;
+
+ return NULL;
+}
+
static struct alisp_object * new_integer(struct alisp_instance *instance, long value)
{
struct alisp_object * obj;
+ obj = search_object_integer(instance, value);
+ if (obj != NULL)
+ return obj;
obj = new_object(instance, ALISP_OBJ_INTEGER);
if (obj)
obj->value.i = value;
@@ -189,6 +250,9 @@
{
struct alisp_object * obj;
+ obj = search_object_float(instance, value);
+ if (obj != NULL)
+ return obj;
obj = new_object(instance, ALISP_OBJ_FLOAT);
if (obj)
obj->value.f = value;
@@ -199,6 +263,9 @@
{
struct alisp_object * obj;
+ obj = search_object_string(instance, str);
+ if (obj != NULL)
+ return obj;
obj = new_object(instance, ALISP_OBJ_STRING);
if (obj && (obj->value.s = strdup(str)) == NULL) {
nomem();
@@ -211,6 +278,9 @@
{
struct alisp_object * obj;
+ obj = search_object_identifier(instance, id);
+ if (obj != NULL)
+ return obj;
obj = new_object(instance, ALISP_OBJ_IDENTIFIER);
if (obj && (obj->value.id = strdup(id)) == NULL) {
nomem();
@@ -223,56 +293,15 @@
{
struct alisp_object * obj;
+ obj = search_object_pointer(instance, ptr);
+ if (obj != NULL)
+ return obj;
obj = new_object(instance, ALISP_OBJ_POINTER);
if (obj)
obj->value.ptr = ptr;
return obj;
}
-static struct alisp_object * search_object_identifier(struct alisp_instance
*instance, const char *s)
-{
- struct alisp_object * p;
-
- for (p = instance->used_objs_list; p != NULL; p = p->next)
- if (p->type == ALISP_OBJ_IDENTIFIER && !strcmp(p->value.id, s))
- return p;
-
- return NULL;
-}
-
-static struct alisp_object * search_object_string(struct alisp_instance *instance,
const char *s)
-{
- struct alisp_object * p;
-
- for (p = instance->used_objs_list; p != NULL; p = p->next)
- if (p->type == ALISP_OBJ_STRING && !strcmp(p->value.s, s))
- return p;
-
- return NULL;
-}
-
-static struct alisp_object * search_object_integer(struct alisp_instance *instance,
long in)
-{
- struct alisp_object * p;
-
- for (p = instance->used_objs_list; p != NULL; p = p->next)
- if (p->type == ALISP_OBJ_INTEGER && p->value.i == in)
- return p;
-
- return NULL;
-}
-
-static struct alisp_object * search_object_float(struct alisp_instance *instance,
double in)
-{
- struct alisp_object * p;
-
- for (p = instance->used_objs_list; p != NULL; p = p->next)
- if (p->type == ALISP_OBJ_FLOAT && p->value.f == in)
- return p;
-
- return NULL;
-}
-
void alsa_lisp_init_objects(void) __attribute__ ((constructor));
void alsa_lisp_init_objects(void)
@@ -573,28 +602,20 @@
else if (!strcmp(instance->token_buffer, "nil"))
p = &alsa_lisp_nil;
else {
- if ((p = search_object_identifier(instance,
instance->token_buffer)) == NULL)
- p = new_identifier(instance, instance->token_buffer);
+ p = new_identifier(instance, instance->token_buffer);
}
break;
case ALISP_INTEGER: {
- long i;
- i = atol(instance->token_buffer);
- if ((p = search_object_integer(instance, i)) == NULL)
- p = new_integer(instance, i);
+ p = new_integer(instance, atol(instance->token_buffer));
break;
}
case ALISP_FLOAT:
case ALISP_FLOATE: {
- double f;
- f = atof(instance->token_buffer);
- if ((p = search_object_float(instance, f)) == NULL)
- p = new_float(instance, f);
+ p = new_float(instance, atof(instance->token_buffer));
break;
}
case ALISP_STRING:
- if ((p = search_object_string(instance, instance->token_buffer)) ==
NULL)
- p = new_string(instance, instance->token_buffer);
+ p = new_string(instance, instance->token_buffer);
break;
default:
lisp_warn(instance, "%d:%d: unexpected character `%c'",
instance->lineno, instance->charno, thistoken);
@@ -608,30 +629,47 @@
* object manipulation
*/
-static int set_object(struct alisp_instance *instance, struct alisp_object * name,
struct alisp_object * value)
+static struct alisp_object_pair * set_object(struct alisp_instance *instance, struct
alisp_object * name, struct alisp_object * value)
{
struct alisp_object_pair *p;
if (name->value.id == NULL)
- return 0;
+ return NULL;
for (p = instance->setobjs_list; p != NULL; p = p->next)
if (p->name->value.id != NULL &&
!strcmp(name->value.id, p->name->value.id)) {
p->value = value;
- return 0;
+ return p;
}
p = (struct alisp_object_pair *)malloc(sizeof(struct alisp_object_pair));
if (p == NULL) {
nomem();
- return -ENOMEM;
+ return NULL;
}
p->next = instance->setobjs_list;
instance->setobjs_list = p;
p->name = name;
p->value = value;
- return 0;
+ return p;
+}
+
+static void unset_object(struct alisp_instance *instance, struct alisp_object * name)
+{
+ struct alisp_object_pair *p, *p1;
+
+ for (p = instance->setobjs_list, p1 = NULL; p != NULL; p1 = p, p = p->next) {
+ if (p->name->value.id != NULL &&
+ !strcmp(name->value.id, p->name->value.id)) {
+ if (p1)
+ p1->next = p->next;
+ else
+ instance->setobjs_list = p->next;
+ free(p);
+ return;
+ }
+ }
}
static struct alisp_object * get_object(struct alisp_instance *instance, struct
alisp_object * name)
@@ -670,6 +708,8 @@
snd_output_printf(out, ")\n");
continue;
}
+ if (!strcmp(p->name->value.id, ALISP_MAIN_ID)) /* internal thing */
+ continue;
snd_output_printf(out, "(setq %s '", p->name->value.id);
princ_object(out, p->value);
snd_output_printf(out, ")\n");
@@ -786,6 +826,8 @@
p->next = instance->free_objs_list;
instance->free_objs_list = p;
++instance->free_objs;
+ if (instance->gc_thr_objs > 0)
+ instance->gc_thr_objs--;
} else {
free(p);
}
@@ -801,6 +843,14 @@
instance->used_objs_list = new_used_objs_list;
}
+static inline void auto_garbage_collect(struct alisp_instance *instance)
+{
+ if (instance->gc_thr_objs >= ALISP_AUTO_GC_THRESHOLD) {
+ do_garbage_collect(instance);
+ instance->gc_thr_objs = 0;
+ }
+}
+
static void garbage_collect(struct alisp_instance *instance)
{
if (++instance->gc_id == 255)
@@ -882,11 +932,10 @@
} while (p != &alsa_lisp_nil);
if (type == ALISP_OBJ_INTEGER) {
- p1 = new_integer(instance, v);
+ return new_integer(instance, v);
} else {
- p1 = new_float(instance, f);
+ return new_float(instance, f);
}
- return p1;
}
/*
@@ -926,11 +975,10 @@
} while (p != &alsa_lisp_nil);
if (type == ALISP_OBJ_INTEGER) {
- p1 = new_integer(instance, v);
+ return new_integer(instance, v);
} else {
- p1 = new_object(instance, f);
+ return new_object(instance, f);
}
- return p1;
}
/*
@@ -960,12 +1008,10 @@
} while (p != &alsa_lisp_nil);
if (type == ALISP_OBJ_INTEGER) {
- p1 = new_integer(instance, v);
+ return new_integer(instance, v);
} else {
- p1 = new_float(instance, f);
+ return new_float(instance, f);
}
-
- return p1;
}
/*
@@ -1018,12 +1064,10 @@
} while (p != &alsa_lisp_nil);
if (type == ALISP_OBJ_INTEGER) {
- p1 = new_integer(instance, v);
+ return new_integer(instance, v);
} else {
- p1 = new_float(instance, f);
+ return new_float(instance, f);
}
-
- return p1;
}
/*
@@ -1624,13 +1668,24 @@
if (p1 == &alsa_lisp_nil) {
lisp_warn(instance, "setting the value of a nil object");
} else
- if (set_object(instance, p1, p2))
+ if (set_object(instance, p1, p2) == NULL)
return NULL;
return p2;
}
/*
+ * Syntax: (unset name)
+ */
+static struct alisp_object * F_unset(struct alisp_instance *instance, struct
alisp_object * args)
+{
+ struct alisp_object * p1 = eval(instance, car(args));
+
+ unset_object(instance, p1);
+ return &alsa_lisp_nil;
+}
+
+/*
* Syntax: (setq name value...)
* Syntax: (setf name value...)
* `name' is not evalled
@@ -1642,7 +1697,7 @@
do {
p1 = car(p);
p2 = eval(instance, car(cdr(p)));
- if (set_object(instance, p1, p2))
+ if (set_object(instance, p1, p2) == NULL)
return NULL;
p = cdr(cdr(p));
} while (p != &alsa_lisp_nil);
@@ -1651,6 +1706,24 @@
}
/*
+ * Syntax: (unsetq name...)
+ * Syntax: (unsetf name...)
+ * `name' is not evalled
+ */
+static struct alisp_object * F_unsetq(struct alisp_instance *instance, struct
alisp_object * args)
+{
+ struct alisp_object * p = args, * p1;
+
+ do {
+ p1 = car(p);
+ unset_object(instance, p1);
+ p = cdr(p);
+ } while (p != &alsa_lisp_nil);
+
+ return &alsa_lisp_nil;
+}
+
+/*
* Syntax: (defun name arglist expr...)
* `name' is not evalled
* `arglist' is not evalled
@@ -1670,7 +1743,7 @@
lexpr->value.c.cdr->value.c.car = p2;
lexpr->value.c.cdr->value.c.cdr = p3;
- if (set_object(instance, p1, lexpr))
+ if (set_object(instance, p1, lexpr) == NULL)
return NULL;
}
@@ -1710,7 +1783,7 @@
do {
p4 = car(p2);
save_objs[i] = get_object(instance, p4);
- if (set_object(instance, p4, eval_objs[i]))
+ if (set_object(instance, p4, eval_objs[i]) == NULL)
return NULL;
p2 = cdr(p2);
++i;
@@ -1725,7 +1798,7 @@
i = 0;
do {
p4 = car(p2);
- if (set_object(instance, p4, save_objs[i++]))
+ if (set_object(instance, p4, save_objs[i++]) == NULL)
return NULL;
p2 = cdr(p2);
} while (p2 != &alsa_lisp_nil);
@@ -1976,6 +2049,9 @@
{ "string=", F_equal },
{ "string-equal", F_equal },
{ "unless", F_unless },
+ { "unset", F_unset },
+ { "unsetf", F_unsetq },
+ { "unsetq", F_unsetq },
{ "when", F_when },
{ "while", F_while },
};
@@ -1997,6 +2073,9 @@
if (!strcmp(p1->value.id, "lambda"))
return p;
+
+ auto_garbage_collect(instance);
+
key.name = p1->value.id;
if ((item = bsearch(&key, intrinsics,
sizeof intrinsics / sizeof intrinsics[0],
@@ -2008,6 +2087,7 @@
sizeof snd_intrinsics[0], compar)) != NULL)
return item->func(instance, p2);
+
if ((p3 = get_object(instance, p1)) != &alsa_lisp_nil)
return eval_func(instance, p3, p2);
else
@@ -2044,13 +2124,15 @@
int alsa_lisp(struct alisp_cfg *cfg, struct alisp_instance **_instance)
{
struct alisp_instance *instance;
- struct alisp_object *p, *p1;
+ struct alisp_object *p, *p1, *omain;
+ struct alisp_object_pair *pmain;
instance = (struct alisp_instance *)malloc(sizeof(struct alisp_instance));
if (instance == NULL) {
nomem();
return -ENOMEM;
}
+ memset(instance, 0, sizeof(struct alisp_instance));
instance->verbose = cfg->verbose && cfg->vout;
instance->warning = cfg->warning && cfg->wout;
instance->debug = cfg->debug && cfg->dout;
@@ -2064,6 +2146,17 @@
init_lex(instance);
+ omain = new_identifier(instance, ALISP_MAIN_ID);
+ if (omain == NULL) {
+ alsa_lisp_free(instance);
+ return -ENOMEM;
+ }
+ pmain = set_object(instance, omain, &alsa_lisp_t);
+ if (pmain == NULL) {
+ alsa_lisp_free(instance);
+ return -ENOMEM;
+ }
+
for (;;) {
if ((p = parse_object(instance, 0)) == NULL)
break;
@@ -2072,7 +2165,9 @@
princ_object(instance->vout, p);
snd_output_putc(instance->vout, '\n');
}
+ pmain->value = p; /* protect the code tree from
garbage-collect */
p1 = eval(instance, p);
+ pmain->value = &alsa_lisp_t; /* let garbage-collect working */
if (instance->verbose) {
lisp_verbose(instance, "** result");
princ_object(instance->vout, p1);
@@ -2088,6 +2183,8 @@
print_obj_lists(instance, instance->dout);
}
}
+
+ unset_object(instance, omain);
done_lex(instance);
if (_instance)
Index: alisp_local.h
===================================================================
RCS file: /cvsroot/alsa/alsa-lib/src/alisp/alisp_local.h,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -r1.5 -r1.6
--- alisp_local.h 3 Aug 2003 20:36:54 -0000 1.5
+++ alisp_local.h 22 Aug 2003 09:41:17 -0000 1.6
@@ -88,6 +88,7 @@
long free_objs;
long used_objs;
long max_objs;
+ long gc_thr_objs;
struct alisp_object *free_objs_list;
struct alisp_object *used_objs_list;
/* set object */
-------------------------------------------------------
This SF.net email is sponsored by: VM Ware
With VMware you can run multiple operating systems on a single machine.
WITHOUT REBOOTING! Mix Linux / Windows / Novell virtual machines
at the same time. Free trial click here:http://www.vmware.com/wl/offer/358/0
_______________________________________________
Alsa-cvslog mailing list
[EMAIL PROTECTED]
https://lists.sourceforge.net/lists/listinfo/alsa-cvslog
