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()?

diff --git a/alsalisp/hctl.lisp b/alsalisp/hctl.lisp
index 521334b..2d04041 100644 (file)
--- a/alsalisp/hctl.lisp
+++ b/alsalisp/hctl.lisp
@@ -9,6 +9,7 @@
     (setq card (aresult card))
   )
 )
+(unsetq card)
 
 (princ "card_get_index test (SI7018): " (acall 'card_get_index "SI7018") "\n")
 (princ "card_get_index test (ABCD): " (acall 'card_get_index "ABCD") "\n")
@@ -29,6 +30,7 @@
     (princ "open failed: " hctl "\n")
   )
 )
+(unsetq hctl)
 
 (setq ctl (acall 'ctl_open 'default nil))
 (if (= (aerror ctl) 0)
@@ -38,6 +40,7 @@
     (setq info (aresult (acall 'ctl_card_info ctl)))
     (princ "ctl card info: " info "\n")
     (princ "ctl card info (mixername): " (cdr (assq "mixername" info)) "\n")
+    (unsetq info)
     (setq hctl (acall 'hctl_open_ctl ctl))
     (if (= (aerror hctl) 0)
       (progn
@@ -59,6 +62,8 @@
            (when (equal (cdr (assq "name" (car (cdr (assq "id" (aresult info)))))) "Master Playback Volume")
              (princ "write Master: " (acall 'hctl_elem_write elem (20 20)) "\n")
            )
+           (unsetq info value)
+           (gc)
            (setq elem (acall 'hctl_elem_next elem))
          )
         )
@@ -69,14 +74,17 @@
         )
       )
       (progn
-        (princ "hctl open failed: " ctl "\n")
+        (princ "hctl open failed: " hctl "\n")
        (acall 'ctl_close ctl)
       )
     )
+    (unsetq hctl)
   )
   (progn
     (princ "ctl open failed: " ctl "\n")
   )
 )
+(unsetq ctl)
 
 (&stat-memory)
+(&dump-memory "memory.dump")

diff --git a/src/alisp/alisp.c b/src/alisp/alisp.c
index c60265b..e13ff53 100644 (file)
--- a/src/alisp/alisp.c
+++ b/src/alisp/alisp.c
@@ -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 @@ static struct alisp_object * new_object(struct alisp_instance *instance, int typ
                        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 void free_objects(struct alisp_instance *instance)
        }
 }
 
+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 @@ static struct alisp_object * new_float(struct alisp_instance *instance, double v
 {
        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 @@ static struct alisp_object * new_string(struct alisp_instance *instance, const c
 {
        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 @@ static struct alisp_object * new_identifier(struct alisp_instance *instance, con
 {
        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 @@ static struct alisp_object * new_pointer(struct alisp_instance *instance, const
 {
        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 @@ static struct alisp_object * parse_object(struct alisp_instance *instance, int h
                else if (!strcmp(instance->token_buffer, "nil"))
                        p = &alsa_lisp_nil;
                else {
-                       if ((p = search_object_identifier(instance, instance->token_buffer)) == NULL)
-                               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 @@ static struct alisp_object * parse_object(struct alisp_instance *instance, int h
  *  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 @@ static void dump_objects(struct alisp_instance *instance, const char *fname)
                        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 @@ static void do_garbage_collect(struct alisp_instance *instance)
                                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 @@ static void do_garbage_collect(struct alisp_instance *instance)
        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 @@ static struct alisp_object * F_add(struct alisp_instance *instance, struct alisp
        } 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 @@ static struct alisp_object * F_sub(struct alisp_instance *instance, struct alisp
        } 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 @@ static struct alisp_object * F_mul(struct alisp_instance *instance, struct alisp
        } 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 @@ static struct alisp_object * F_div(struct alisp_instance *instance, struct alisp
        } 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 @@ static struct alisp_object * F_set(struct alisp_instance *instance, struct alisp
        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 @@ static struct alisp_object * F_setq(struct alisp_instance *instance, struct alis
        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 @@ static struct alisp_object * F_setq(struct alisp_instance *instance, struct alis
 }
 
 /*
+ * 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 @@ static struct alisp_object * F_defun(struct alisp_instance *instance, struct ali
                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 @@ static struct alisp_object * eval_func(struct alisp_instance *instance, struct a
                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 @@ static struct alisp_object * eval_func(struct alisp_instance *instance, struct a
                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 @@ static struct intrinsic intrinsics[] = {
        { "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 @@ static struct alisp_object * eval_cons(struct alisp_instance *instance, struct a
 
                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 @@ static struct alisp_object * eval_cons(struct alisp_instance *instance, struct a
                                    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 @@ static struct alisp_object * F_eval(struct alisp_instance *instance, struct alis
 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 @@ int alsa_lisp(struct alisp_cfg *cfg, struct alisp_instance **_instance)
        
        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 @@ int alsa_lisp(struct alisp_cfg *cfg, struct alisp_instance **_instance)
                        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);
@@ -2089,6 +2184,8 @@ int alsa_lisp(struct alisp_cfg *cfg, struct alisp_instance **_instance)
                }
        }
 
+       unset_object(instance, omain);
+
        done_lex(instance);
        if (_instance)
                *_instance = instance;

diff --git a/src/alisp/alisp_local.h b/src/alisp/alisp_local.h
index 88f4918..09f2577 100644 (file)
--- a/src/alisp/alisp_local.h
+++ b/src/alisp/alisp_local.h
@@ -88,6 +88,7 @@ struct alisp_instance {
        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 */