[gambit-list] Allocate Scheme vector before or after C call?

Marc Feeley feeley at iro.umontreal.ca
Mon Jul 20 11:59:05 EDT 2020


The function ___release_scmobj(obj) doesn’t free the object.  Only the GC can do that.  The function ___release_scmobj(obj) decrements the refcount to indicate that the C world no longer references obj, but because obj is returned from C to Scheme it is still reachable by the Scheme world and will not be reclaimed until the Scheme world is done using it.

Moreover Gambit supports a vector shrinking operation:

> (define v (vector 1 2 3 4 5 6))
> v
#(1 2 3 4 5 6)
> (vector-shrink! v 3)
> v
#(1 2 3)
> (vector-shrink! v 42)
*** ERROR IN (stdin)@5.1 -- (Argument 2) Out of range
(vector-shrink! #(1 2 3) 42)

The fact that the width (and sign) of gid_t is not known at Scheme compilation time can be managed with some C macros.  The problem I see however is that the resulting homogeneous vector will have a type that depends on the underlying OS, so it is a leaky API.  It would be better to return a normal vector of the group ids.

Let me propose 2 solutions (see code below):

1) which returns a homogeneous vector and doesn’t call malloc (but that is a leaky API)

2) which returns a normal vector of fixnums and sometimes calls malloc/free

Solution 2 uses a small statically allocated buffer so that malloc/free can frequently be avoided.  In a quick test it is about 30% faster than solution 1.

Marc



(c-declare #<<end-of-c-declare

#include <unistd.h>
#include <errno.h>

/* compute log base 2 of a power of 2 */
#define LOG2(pow2) LOG2STEP(LOG2STEP(LOG2STEP((pow2-1),1,85),2,51),4,15)
#define LOG2STEP(n,shift,mask) (((n >> shift) & mask)+(n & mask))

#define LOG2_SIZEOF(type) LOG2(sizeof(type))
#define IS_UNSIGNED(type) (0<___CAST(type,-1))

#define HOMVEC_SUBTYPE(type) \
  homvec_subtypes[___CAST(type,0.5) == 0 \
                  ? LOG2_SIZEOF(type)*2 + IS_UNSIGNED(type) \
                  : 8 - 2 + LOG2_SIZEOF(type)]

static int homvec_subtypes[] = {
 ___sS8VECTOR ,___sU8VECTOR ,___sS16VECTOR,___sU16VECTOR
,___sS32VECTOR,___sU32VECTOR,___sS64VECTOR,___sU64VECTOR
,___sF32VECTOR,___sF64VECTOR
};

#define HOMVEC_ALLOC_STILL(type, nb_elems) \
___EXT(___alloc_scmobj)(___PSTATE, HOMVEC_SUBTYPE(type), sizeof(type)*nb_elems)

#define HOMVEC_SHRINK(vect, type, nb_elems) \
do { \
 ___SCMOBJ ___temp; \
 ___U8VECTORSHRINK(vect,___FIX(sizeof(type)*nb_elems)); \
} while (0)

___SCMOBJ os_getgroups() {

  ___SCMOBJ result; /* homogeneous vector of group ids */
  int len; /* actual length, determined later */
  int cap = getgroups(0, NULL); /* first approximation of number of groups */

  if (cap < 0)
    return ___FIX(___ERRNO_ERR(errno));

  for (;;) {

    result = HOMVEC_ALLOC_STILL(gid_t, cap);

    if (___FIXNUMP(result))
      return result;

    ___EXT(___release_scmobj)(result);

    if (cap == 0) /* guard against special meaning of getgroups(0,...) */
      return result;

    len = getgroups(cap, ___CAST(gid_t*,___BODY_AS(result,___tSUBTYPED)));

    if (len >= 0) break;

    if (errno == EINVAL) {
      if (cap >= 1000000) { /* arbitrary implementation limit */
        return ___FIX(___IMPL_LIMIT_ERR);
      } else {
        cap = cap*2; /* will try again with larger buffer */
      }
    } else {
      return ___FIX(___ERRNO_ERR(errno));
    }
  }

  HOMVEC_SHRINK(result, gid_t, len); /* shrink vector to actual length */

  return result;
}

/* Alternative definition which returns a normal vector */

#include <stdlib.h>

___SCMOBJ os_getgroups2() {

  const int static_cap = 100; /* within this limit, no call to malloc */
  gid_t buffer[static_cap];
  gid_t *buf = buffer;
  int cap = static_cap;
  ___SCMOBJ result; /* homogeneous vector of group ids */
  int len; /* actual length, determined later */

  for (;;) {

    len = getgroups(cap, buf);

    if (len >= 0) break;

    if (errno == EINVAL) {
      if (buf != buffer) free(buf);
      if (cap >= 1000000) { /* arbitrary implementation limit */
        return ___FIX(___IMPL_LIMIT_ERR);
      } else {
        cap = cap*2; /* will try again with larger buffer */
        buf = malloc(sizeof(gid_t)*cap);
        if (buf == NULL)
          return ___FIX(___HEAP_OVERFLOW_ERR);
      }
    } else {
      if (buf != buffer) free(buf);
      return ___FIX(___ERRNO_ERR(errno));
    }
  }

  result = ___EXT(___make_vector)(___PSTATE, len, ___FIX(0));

  if (!___FIXNUMP(result)) {
    while (len-- > 0)
      ___VECTORSET(result, ___FIX(len), ___FIX(buf[len]))
  }

  if (buf != buffer) free(buf);

  return ___EXT(___release_scmobj(result));
}

end-of-c-declare
)

(define (getgroups)
  (let ((result ((c-lambda () scheme-object "os_getgroups2"))))
    (if (fixnum? result)
        (##raise-os-exception #f result getgroups)
        result)))

(pp (getgroups))




> On Jul 20, 2020, at 7:07 AM, Lassi Kortela <lassi at lassi.io> wrote:
> 
> Marc, thank you once again for the excellent explanation. You have a knack for explaining complex topics clearly. We should start collecting and editing this stuff into the Gambit manual proper.
> 
> Here's a Unix getgroups() wrapper that allocates increasing powers of two until the result fits. We should finish up SRFI 170 (POSIX APIs) with Harold; since the Unix syscall interface is designed such that the kernel copies data into statically-sized userland buffers, many syscalls are best wrapped by trying powers of two.
> 
> The below code raises more potential problems:
> 
> - I'm still not confident that I understand when and how to release objects. In the code below, __release_scmobj is used to wrap up accessing ___BODY; is this right?
> 
> - getgroups() returns a gid_t array but POSIX doesn't say how many bits wide gid_t is. (In fact, it doesn't even say whether it's a signed or unsigned type.) This is the case for many/most C datatypes. An API like ___alloc_sint_vector(NULL, count, sizeof(gid_t)) would help with this.
> 
> - getgroups() can return fewer entries than we allocated buffer space for. Does Gambit have a way of truncating vectors? In general, there is no way to know ahead of time the exact size needed for result buffers: some syscalls accept a NULL buffer to not copy any data and only return the right buffer size, but relying on that size can lead to race conditions between that call and the next call that supplies a non-NULL buffer to actually copy the data.
> 
> Clojure transients <https://clojure.org/reference/transients> might be a good model for Scheme FFI in situations like this. Clojure is mostly an immutable language, but a transient is a mutable collection that is "sealed" into an immutable one once it has been filled; transients were added for performance reasons. While Scheme strings and vectors are mutable, their size cannot change (at least not by RnRS means) so in that respect they are immutable.
> 
> Perhaps Gambit's object header can be hacked from C code to mutate a vector to have fewer actual elements than space is allocated for. Is such a thing safe to do, and would it be workable to have an official way in the FFI to truncate a vector?
> 
> ----------------------------------------------------------------------
> 
> (c-declare "#include <unistd.h>")
> 
> (define getgroups
>  (c-lambda () scheme-object #<<c-end
>    for (int cap = 2; cap <= 256; cap *= 2) {
>        size_t nbytes = cap * sizeof(___S32);
>        ___SCMOBJ vector = ___EXT(___alloc_scmobj)(NULL, ___sS32VECTOR, nbytes);
>        if (___FIXNUMP(vector)) ___return(___FAL);
>        ___S32 *gids = ___CAST(___S32 *, ___BODY(vector));
>        int len = getgroups(cap, gids);
>        ___EXT(___release_scmobj)(vector);
>        if (len >= 0) ___return(vector);
>    }
>    ___return(___FAL);
> c-end
> ))
> 
> (define (writeln x) (write x) (newline))
> 
> (let ((gs (getgroups)))
>  (writeln gs)
>  (writeln (s32vector-length gs)))
> 
> _______________________________________________
> Gambit-list mailing list
> Gambit-list at iro.umontreal.ca
> https://mailman.iro.umontreal.ca/cgi-bin/mailman/listinfo/gambit-list
> 





More information about the Gambit-list mailing list