<div>Dear Marc,</div><div><br></div><div>Just realized there's a memory leak in many Gambit libraries, such as the sqlite FFI - their u8vector allocation in C boils down to:</div><div><br></div><blockquote style="margin:0 0 0 40px;border:none;padding:0px">

<div><div><font face="courier new, monospace">___result = ___EXT(___alloc_scmobj)(___sU8VECTOR,len,___MOVABLE0);</font></div></div></blockquote><div><br></div><div><br></div><div><br></div><div><div>Studying <font face="courier new, monospace">##make-u8vector</font> of _kernel.scm provides some inspiration: It</div>

<div><br></div><div> 1) Shows that it's fine to use <font face="courier new, monospace">___STILL</font></div><div><br></div><div> 2) Uses  <span style="font-family:'courier new',monospace">___still_obj_refcount_dec</span> ,</div>

<div><br></div><div> 3) Has its C code in a <font face="courier new, monospace">##c-code</font> and not a <font face="courier new, monospace">##c-lambda</font></div></div><div><br></div><div> 4) Has its surrounding Scheme code in <span style="font-family:'courier new',monospace">(##declare (not interrupts-enabled))</span></div>

<div><br></div><div> 5) Surrounds the <font face="courier new, monospace">___alloc_scmobj</font> call by some magic (<span style="font-family:'courier new',monospace">___FRAME_STORE_RA(___R0)</span><font face="courier new, monospace">___W_ALL </font><font face="courier new, monospace">___R_ALL </font><span style="font-family:'courier new',monospace">___SET_R0(___FRAME_FETCH_RA)</span> )</div>

<div><br></div><div>(<font face="courier new, monospace">##make-u8vector</font> provides a code path for small objects apart from this, though the use regarded here should be for u8vectors of nontrivial size so going with the codepath for large objects should always be fine.)</div>

<div><br></div><div><br></div><div>By applying 1) and 2) I get something that works but can't know if it's really correct and safe:</div><div><br></div><div><br></div><div><div>How do you allocate an u8vector in C code in a way that does not leak memory, and that safely transfers the new object reference from the C world to the Scheme world?</div>

</div><div><br></div><div><br></div><div><br></div><div>Thanks!<br>Mikael</div><div><br></div><div><br></div><div><b>How to reproduce</b></div><div><div>Running a test that repeats</div><div><br></div><blockquote style="margin:0px 0px 0px 40px;border:none;padding:0px">

<font face="courier new, monospace">((c-lambda () scheme-object "___result = ___EXT(___alloc_scmobj)(___sU8VECTOR,10000,___MOVABLE0);"))</font></blockquote><div><br></div><div>over and over e.g.</div><div><br></div>

<blockquote style="margin:0px 0px 0px 40px;border:none;padding:0px"><div><font face="courier new, monospace">(##gc-report-set! #t)</font></div><div><font face="courier new, monospace">(for-each (lambda (x) ((c-lambda () scheme-object "___result = ___EXT(___alloc_scmobj)(___sU8VECTOR,10000,___MOVABLE0);")))</font></div>

<div><font face="courier new, monospace">          (string->list (make-string 100000))</font></div><div><font face="courier new, monospace">(##gc)</font></div></blockquote><div><br></div><div>shows that this memory leaks all the allocated memory (!).</div>

</div><div><br></div><div><br></div><div><b>Fix, duno if safe & complete</b></div><div><br></div><div><blockquote style="margin:0 0 0 40px;border:none;padding:0px"><div><div><font face="courier new, monospace">(##gc-report-set! #t)</font></div>

<div><font face="courier new, monospace">(for-each (lambda (x) ((c-lambda () scheme-object "___result = ___EXT(___alloc_scmobj)(___sU8VECTOR,10000,___STILL);</font></div><div><font face="courier new, monospace">                                                   if (!___FIXNUMP(___result)) ___still_obj_refcount_dec (___result);</font></div>

<div><font face="courier new, monospace">                                                   ")))</font></div><div><font face="courier new, monospace">          (string->list (make-string 100000))</font></div></div>

<div><font face="courier new, monospace">(##gc)</font></div></blockquote></div><div><br></div><div><br></div><div><b>Copy of <font face="courier new, monospace">##make-u8vector</font> of _kernel.scm for reference</b></div>

<div><br></div><blockquote style="margin:0 0 0 40px;border:none;padding:0px"><div><div><div><font face="courier new, monospace">(define-prim (##make-u8vector k #!optional (fill (macro-absent-obj)))</font></div><div><font face="courier new, monospace">  (##declare (not interrupts-enabled))</font></div>

<div><font face="courier new, monospace">  (let ((v (##c-code #<<end-of-code</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">long i;</font></div><div><font face="courier new, monospace">long n = ___INT(___ARG1);</font></div>

<div><font face="courier new, monospace">long words = ___WORDS(n) + 1;</font></div><div><font face="courier new, monospace">___SCMOBJ result;</font></div><div><font face="courier new, monospace">if (n > ___CAST(___WORD, ___LMASK>>___LF))</font></div>

<div><font face="courier new, monospace">  result = ___FIX(___HEAP_OVERFLOW_ERR); /* requested object is too big! */</font></div><div><font face="courier new, monospace">else if (words > ___MSECTION_BIGGEST)</font></div>

<div><font face="courier new, monospace">  {</font></div><div><font face="courier new, monospace">    ___FRAME_STORE_RA(___R0)</font></div><div><font face="courier new, monospace">    ___W_ALL</font></div><div><font face="courier new, monospace">    result = ___alloc_scmobj (___sU8VECTOR, n, ___STILL);</font></div>

<div><font face="courier new, monospace">    ___R_ALL</font></div><div><font face="courier new, monospace">    ___SET_R0(___FRAME_FETCH_RA)</font></div><div><font face="courier new, monospace">    if (!___FIXNUMP(result))</font></div>

<div><font face="courier new, monospace">      ___still_obj_refcount_dec (result);</font></div><div><font face="courier new, monospace">  }</font></div><div><font face="courier new, monospace">else</font></div><div><font face="courier new, monospace">  {</font></div>

<div><font face="courier new, monospace">    ___BOOL overflow = 0;</font></div><div><font face="courier new, monospace">    ___hp += words;</font></div><div><font face="courier new, monospace">    if (___hp > ___ps->heap_limit)</font></div>

<div><font face="courier new, monospace">      {</font></div><div><font face="courier new, monospace">        ___FRAME_STORE_RA(___R0)</font></div><div><font face="courier new, monospace">        ___W_ALL</font></div><div>

<font face="courier new, monospace">        overflow = ___heap_limit () && ___garbage_collect (0);</font></div><div><font face="courier new, monospace">        ___R_ALL</font></div><div><font face="courier new, monospace">        ___SET_R0(___FRAME_FETCH_RA)</font></div>

<div><font face="courier new, monospace">      }</font></div><div><font face="courier new, monospace">    else</font></div><div><font face="courier new, monospace">      ___hp -= words;</font></div><div><font face="courier new, monospace">    if (overflow)</font></div>

<div><font face="courier new, monospace">      result = ___FIX(___HEAP_OVERFLOW_ERR);</font></div><div><font face="courier new, monospace">    else</font></div><div><font face="courier new, monospace">      {</font></div>

<div><font face="courier new, monospace">        result = ___TAG(___hp, ___tSUBTYPED);</font></div><div><font face="courier new, monospace">        ___HEADER(result) = ___MAKE_HD_BYTES(n, ___sU8VECTOR);</font></div><div>
<font face="courier new, monospace">        ___hp += words;</font></div>
<div><font face="courier new, monospace">      }</font></div><div><font face="courier new, monospace">  }</font></div><div><font face="courier new, monospace">if (!___FIXNUMP(result) && ___ARG2 != ___ABSENT)</font></div>

<div><font face="courier new, monospace">  {</font></div><div><font face="courier new, monospace">    for (i=0; i<n; i++)</font></div><div><font face="courier new, monospace">      ___U8VECTORSET(result,___FIX(i),___ARG2)</font></div>

<div><font face="courier new, monospace">  }</font></div><div><font face="courier new, monospace">___RESULT = result;</font></div><div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">end-of-code</font></div>

<div><font face="courier new, monospace"><br></font></div><div><font face="courier new, monospace">            k</font></div><div><font face="courier new, monospace">            fill)))</font></div><div><font face="courier new, monospace">    (if (##fixnum? v)</font></div>

<div><font face="courier new, monospace">      (begin</font></div><div><font face="courier new, monospace">        (##raise-heap-overflow-exception)</font></div><div><font face="courier new, monospace">        (##make-u8vector k fill))</font></div>

<div><font face="courier new, monospace">      v)))</font></div></div></div><div><br></div></blockquote>