Re: freeing srcprops ?

[Han-Wen Nienhuys]

Han-Wen Nienhuys escreveu:
> Hello,
> 
> I'm doign some leak checking to see why LilyPond needs such obscene
> amounts of memory. Looking through the valgrind leak table, I see mention 
> of srcprops. In srcprop.c, I see:  
> 
> 
> static size_t
> srcprops_free (SCM obj)
> {
>   *((scm_t_srcprops **) SCM_SMOB_DATA (obj)) = srcprops_freelist;
>   srcprops_freelist = (scm_t_srcprops *) SCM_SMOB_DATA (obj);
>   return 0; /* srcprops_chunks are not freed until leaving guile */
> }
> 
> 
> why use a separate storage pool for srcprop objects?  If optimized storage
> is needed, isn't it better to compress the srcprop a bit and use a 
> double cell?

Please have a look at the attached patch.  Test suite is OK. I can't detect any
performance changes introduced by this patch (I tried timing loading all of 
ice-9/ )


-- 
 Han-Wen Nienhuys - address@hidden - http://www.xs4all.nl/~hanwen

>From f8dd4c337da81db3e7e1f3faf2663ec67f496580 Mon Sep 17 00:00:00 2001
From: Han-Wen Nienhuys <address@hidden>
Date: Thu, 18 Jan 2007 15:00:44 +0100
Subject: [PATCH] srcprops cleanup.

- remove macros without SCM_ prefix from srcprops.h

- rename PROCTRACEP to SCM_PROCTRACEP

- Use double cell for storing srcprops.

- Get rid of specialized srcprop storage.
---
 libguile/eval.c    |    2 +-
 libguile/srcprop.c |  108 +++++++++++++++++++--------------------------------
 libguile/srcprop.h |   40 +------------------
 3 files changed, 43 insertions(+), 107 deletions(-)

diff --git a/libguile/eval.c b/libguile/eval.c
index 26d90f1..d797fc0 100644
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -3024,7 +3024,7 @@ scm_eval_body (SCM code, SCM env)
 do { \
   SCM_SET_ARGSREADY (debug);\
   if (scm_check_apply_p && SCM_TRAPS_P)\
-    if (SCM_APPLY_FRAME_P || (SCM_TRACE_P && PROCTRACEP (proc)))\
+    if (SCM_APPLY_FRAME_P || (SCM_TRACE_P && SCM_PROCTRACEP (proc)))\
       {\
        SCM tmp, tail = scm_from_bool(SCM_TRACED_FRAME_P (debug)); \
        SCM_SET_TRACED_FRAME (debug); \
diff --git a/libguile/srcprop.c b/libguile/srcprop.c
index e1b8673..b44b503 100644
--- a/libguile/srcprop.c
+++ b/libguile/srcprop.c
@@ -37,7 +37,7 @@
 /* {Source Properties}
  *
  * Properties of source list expressions.
- * Five of these have special meaning and optimized storage:
+ * Five of these have special meaning:
  *
  * filename    string   The name of the source file.
  * copy        list     A copy of the list expression.
@@ -55,29 +55,47 @@ SCM_GLOBAL_SYMBOL (scm_sym_line, "line");
 SCM_GLOBAL_SYMBOL (scm_sym_column, "column");
 SCM_GLOBAL_SYMBOL (scm_sym_breakpoint, "breakpoint");
 
+
+
+/*
+  layout:
+  
+  car = tag
+  cbr = pos
+  ccr = copy
+  cdr = plist 
+*/
+
+#define SRCPROPSP(p) (SCM_SMOB_PREDICATE (scm_tc16_srcprops, (p)))
+#define SRCPROPBRK(p) (SCM_SMOB_FLAGS (p) & SCM_SOURCE_PROPERTY_FLAG_BREAK)
+#define SRCPROPPOS(p) (SCM_CELL_WORD(p,1))
+#define SRCPROPLINE(p) (SRCPROPPOS(p) >> 12)
+#define SRCPROPCOL(p) (SRCPROPPOS(p) & 0x0fffL)
+#define SRCPROPCOPY(p) (SCM_CELL_OBJECT(p,2))
+#define SRCPROPPLIST(p) (SCM_CELL_OBJECT_3(p))
+#define SETSRCPROPBRK(p) \
+ (SCM_SET_SMOB_FLAGS ((p), \
+                      SCM_SMOB_FLAGS (p) | SCM_SOURCE_PROPERTY_FLAG_BREAK))
+#define CLEARSRCPROPBRK(p)  \
+ (SCM_SET_SMOB_FLAGS ((p), \
+                      SCM_SMOB_FLAGS (p) & ~SCM_SOURCE_PROPERTY_FLAG_BREAK))
+#define SRCPROPMAKPOS(l, c) (((l) << 12) + (c))
+#define SETSRCPROPPOS(p, l, c) (SCM_SET_CELL_WORD(p,1, SRCPROPMAKPOS (l, c)))
+#define SETSRCPROPLINE(p, l) SETSRCPROPPOS (p, l, SRCPROPCOL (p))
+#define SETSRCPROPCOL(p, c) SETSRCPROPPOS (p, SRCPROPLINE (p), c)
+
+
+
 scm_t_bits scm_tc16_srcprops;
-static scm_t_srcprops_chunk *srcprops_chunklist = 0;
-static scm_t_srcprops *srcprops_freelist = 0;
 
 
 static SCM
 srcprops_mark (SCM obj)
 {
-  scm_gc_mark (SRCPROPFNAME (obj));
   scm_gc_mark (SRCPROPCOPY (obj));
   return SRCPROPPLIST (obj);
 }
 
-
-static size_t
-srcprops_free (SCM obj)
-{
-  *((scm_t_srcprops **) SCM_SMOB_DATA (obj)) = srcprops_freelist;
-  srcprops_freelist = (scm_t_srcprops *) SCM_SMOB_DATA (obj);
-  return 0; /* srcprops_chunks are not freed until leaving guile */
-}
-
-
 static int
 srcprops_print (SCM obj, SCM port, scm_print_state *pstate)
 {
@@ -99,38 +117,17 @@ scm_c_source_property_breakpoint_p (SCM form)
 }
 
 
+
 SCM
 scm_make_srcprops (long line, int col, SCM filename, SCM copy, SCM plist)
 {
-  register scm_t_srcprops *ptr;
-  SCM_CRITICAL_SECTION_START;
-  if ((ptr = srcprops_freelist) != NULL)
-    srcprops_freelist = *(scm_t_srcprops **)ptr;
-  else
-    {
-      size_t i;
-      scm_t_srcprops_chunk *mem;
-      size_t n = sizeof (scm_t_srcprops_chunk)
-                   + sizeof (scm_t_srcprops) * (SRCPROPS_CHUNKSIZE - 1);
-      SCM_SYSCALL (mem = (scm_t_srcprops_chunk *) scm_malloc (n));
-      if (mem == NULL)
-       scm_memory_error ("srcprops");
-      scm_gc_register_collectable_memory (mem, n, "srcprops");
-      
-      mem->next = srcprops_chunklist;
-      srcprops_chunklist = mem;
-      ptr = &mem->srcprops[0];
-      for (i = 1; i < SRCPROPS_CHUNKSIZE - 1; ++i)
-       *(scm_t_srcprops **)&ptr[i] = &ptr[i + 1];
-      *(scm_t_srcprops **)&ptr[SRCPROPS_CHUNKSIZE - 1] = 0;
-      srcprops_freelist = (scm_t_srcprops *) &ptr[1];
-    }
-  ptr->pos = SRCPROPMAKPOS (line, col);
-  ptr->fname = filename;
-  ptr->copy = copy;
-  ptr->plist = plist;
-  SCM_CRITICAL_SECTION_END;
-  SCM_RETURN_NEWSMOB (scm_tc16_srcprops, ptr);
+  if (!SCM_UNBNDP (filename))
+    plist = scm_acons (scm_sym_filename, filename, plist);
+  
+  SCM_RETURN_NEWSMOB3 (scm_tc16_srcprops,
+                      SRCPROPMAKPOS (line, col),
+                      copy,
+                      plist);
 }
 
 
@@ -140,8 +137,6 @@ scm_srcprops_to_plist (SCM obj)
   SCM plist = SRCPROPPLIST (obj);
   if (!SCM_UNBNDP (SRCPROPCOPY (obj)))
     plist = scm_acons (scm_sym_copy, SRCPROPCOPY (obj), plist);
-  if (!SCM_UNBNDP (SRCPROPFNAME (obj)))
-    plist = scm_acons (scm_sym_filename, SRCPROPFNAME (obj), plist);
   plist = scm_acons (scm_sym_column, scm_from_int (SRCPROPCOL (obj)), plist);
   plist = scm_acons (scm_sym_line, scm_from_int (SRCPROPLINE (obj)), plist);
   plist = scm_acons (scm_sym_breakpoint, scm_from_bool (SRCPROPBRK (obj)), 
plist);
@@ -206,7 +201,6 @@ SCM_DEFINE (scm_source_property, "source-property", 2, 0, 0,
   if      (scm_is_eq (scm_sym_breakpoint, key)) p = scm_from_bool (SRCPROPBRK 
(p));
   else if (scm_is_eq (scm_sym_line,       key)) p = scm_from_int (SRCPROPLINE 
(p));
   else if (scm_is_eq (scm_sym_column,     key)) p = scm_from_int (SRCPROPCOL 
(p));
-  else if (scm_is_eq (scm_sym_filename,   key)) p = SRCPROPFNAME (p);
   else if (scm_is_eq (scm_sym_copy,       key)) p = SRCPROPCOPY (p);
   else
     {
@@ -277,13 +271,6 @@ SCM_DEFINE (scm_set_source_property_x, 
"set-source-property!", 3, 0, 0,
                      scm_make_srcprops (0, scm_to_int (datum),
                                         SCM_UNDEFINED, SCM_UNDEFINED, p));
     }
-  else if (scm_is_eq (scm_sym_filename, key))
-    {
-      if (SRCPROPSP (p))
-       SRCPROPFNAME (p) = datum;
-      else
-       SCM_WHASHSET (scm_source_whash, h, scm_make_srcprops (0, 0, datum, 
SCM_UNDEFINED, p));
-    }
   else if (scm_is_eq (scm_sym_copy, key))
     {
       if (SRCPROPSP (p))
@@ -308,7 +295,6 @@ scm_init_srcprop ()
 {
   scm_tc16_srcprops = scm_make_smob_type ("srcprops", 0);
   scm_set_smob_mark (scm_tc16_srcprops, srcprops_mark);
-  scm_set_smob_free (scm_tc16_srcprops, srcprops_free);
   scm_set_smob_print (scm_tc16_srcprops, srcprops_print);
 
   scm_source_whash = scm_make_weak_key_hash_table (scm_from_int (2047));
@@ -317,20 +303,6 @@ scm_init_srcprop ()
 #include "libguile/srcprop.x"
 }
 
-void
-scm_finish_srcprop ()
-{
-  register scm_t_srcprops_chunk *ptr = srcprops_chunklist, *next;
-  size_t n= sizeof (scm_t_srcprops_chunk)
-    + sizeof (scm_t_srcprops) * (SRCPROPS_CHUNKSIZE - 1);
-  while (ptr)
-    {
-      next = ptr->next;
-      scm_gc_unregister_collectable_memory (ptr, n, "srcprops");
-      free ((char *) ptr);
-      ptr = next;
-    }
-}
 
 /*
   Local Variables:
diff --git a/libguile/srcprop.h b/libguile/srcprop.h
index c0e4277..87e5fde 100644
--- a/libguile/srcprop.h
+++ b/libguile/srcprop.h
@@ -49,46 +49,10 @@ do { \
 
 /* {Source properties}
  */
-
-SCM_API scm_t_bits scm_tc16_srcprops;
-
-typedef struct scm_t_srcprops
-{
-  unsigned long pos;
-  SCM fname;
-  SCM copy;
-  SCM plist;
-} scm_t_srcprops;
-
-#define SRCPROPS_CHUNKSIZE 2047 /* Number of srcprops per chunk */
-typedef struct scm_t_srcprops_chunk
-{
-  struct scm_t_srcprops_chunk *next;
-  scm_t_srcprops srcprops[1];
-} scm_t_srcprops_chunk;
-
+#define SCM_PROCTRACEP(x) (scm_is_true (scm_procedure_property (x, 
scm_sym_trace)))
 #define SCM_SOURCE_PROPERTY_FLAG_BREAK 1
 
-#define SRCPROPSP(p) (SCM_SMOB_PREDICATE (scm_tc16_srcprops, (p)))
-#define SRCPROPBRK(p) (SCM_SMOB_FLAGS (p) & SCM_SOURCE_PROPERTY_FLAG_BREAK)
-#define SRCPROPPOS(p) ((scm_t_srcprops *) SCM_SMOB_DATA (p))->pos
-#define SRCPROPLINE(p) (SRCPROPPOS(p) >> 12)
-#define SRCPROPCOL(p) (SRCPROPPOS(p) & 0x0fffL)
-#define SRCPROPFNAME(p) ((scm_t_srcprops *) SCM_SMOB_DATA (p))->fname
-#define SRCPROPCOPY(p) ((scm_t_srcprops *) SCM_SMOB_DATA (p))->copy
-#define SRCPROPPLIST(p) ((scm_t_srcprops *) SCM_SMOB_DATA (p))->plist
-#define SETSRCPROPBRK(p) \
- (SCM_SET_SMOB_FLAGS ((p), \
-                      SCM_SMOB_FLAGS (p) | SCM_SOURCE_PROPERTY_FLAG_BREAK))
-#define CLEARSRCPROPBRK(p)  \
- (SCM_SET_SMOB_FLAGS ((p), \
-                      SCM_SMOB_FLAGS (p) & ~SCM_SOURCE_PROPERTY_FLAG_BREAK))
-#define SRCPROPMAKPOS(l, c) (((l) << 12) + (c))
-#define SETSRCPROPPOS(p, l, c) (SRCPROPPOS (p) = SRCPROPMAKPOS (l, c))
-#define SETSRCPROPLINE(p, l) SETSRCPROPPOS (p, l, SRCPROPCOL (p))
-#define SETSRCPROPCOL(p, c) SETSRCPROPPOS (p, SRCPROPLINE (p), c)
-
-#define PROCTRACEP(x) (scm_is_true (scm_procedure_property (x, scm_sym_trace)))
+SCM_API scm_t_bits scm_tc16_srcprops;
 
 SCM_API SCM scm_sym_filename;
 SCM_API SCM scm_sym_copy;
-- 
1.4.4.2