Immediate pointers

Immediate pointers

[Ludovic Courtès]

[-- Attachment #1: Type: text/plain, Size: 2270 bytes --]

Hello!

While using (system foreign) in a couple of projects I found myself
doing quite a bit of pointer arithmetic in Scheme:

--8<---------------cut here---------------start------------->8---
(define (foreign-array->list array-pointer element-count)
  (let ((array (pointer->bytevector array-pointer
                                    (* element-count (sizeof '*)))))
    (unfold (cut >= <> element-count)
            (lambda (element)
              (let ((start (* element (sizeof '*))))
                (bytevector->pointer array start)))
            1+
            0)))

(define (pointer+ array-pointer type index)
  (let ((offset (* index (align (sizeof type) (alignof type)))))
    (make-pointer (+ (pointer-address array-pointer) offset))))

(define (foreign-string-array->list array len)
  ;; Return a list of string comprising the LEN strings pointed to by the
  ;; elements of ARRAY, a pointer to an array of pointers.
  (unfold (cut < <> 0)
          (lambda (index)
            (let ((ptr (make-pointer (+ (pointer-address array)
                                        (* index (sizeof '*))))))
             (pointer->string (dereference-pointer ptr))))
          1-
          (- len 1)))
--8<---------------cut here---------------end--------------->8---

(Examples from
<https://gforge.inria.fr/plugins/scmgit/cgi-bin/gitweb.cgi?p=hubble/hubble.git;a=blob;f=modules/simgrid.scm>.)

The problem is that each ‘make-pointer’ call (and ‘dereference-pointer’,
etc.) conses.  This can make conversion to/from C quite inefficient.

In addition, 90% of the C pointers of interest are 8-byte aligned---that’s
on x86_64-linux-gnu, but it surely holds on most platforms, at least for
pointers returned by ‘malloc’.

So, here comes the idea of “immediate pointers”, which would fit in a
word.  A 3-bit tag is used, as for immediate numbers & co; pointers that
aren’t 8-byte aligned are still stored in an scm_tc7_pointer cell.

I experimented with it using ‘scm_tc3_unused’ (== 3).  Alas, that can’t
work, because it makes it impossible to use such an object as the ‘car’
of a pair:

  #define SCM_I_CONSP(x)  (!SCM_IMP (x) && ((1 & SCM_CELL_TYPE (x)) == 0))

I would welcome feedback and help from tag-savvy people.

Thanks,
Ludo’.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: the patch --]
[-- Type: text/x-patch, Size: 7904 bytes --]

From c705f743031b305051549928cd91e5cfdfef7ec7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Sun, 30 Jan 2011 23:28:13 +0100
Subject: [PATCH] Attempt to support "immediate pointers".

Problem is, 3 is not a valid "immediate tag", because that would prevent
using an immediate number as the car of a pair.
---
 libguile/evalext.c |    7 +++++--
 libguile/foreign.c |    8 ++++----
 libguile/foreign.h |   12 +++++++++---
 libguile/gc.c      |    6 ++++--
 libguile/goops.c   |    3 +++
 libguile/hash.c    |   25 +++++++++++++++----------
 libguile/print.c   |    3 +++
 libguile/tags.h    |    6 +++---
 8 files changed, 46 insertions(+), 24 deletions(-)

diff --git a/libguile/evalext.c b/libguile/evalext.c
index ff2ff0e..c9dcf8b 100644
--- a/libguile/evalext.c
+++ b/libguile/evalext.c
@@ -1,5 +1,6 @@
-/* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006, 2008, 2009, 2010 Free Software Foundation, Inc.
- * 
+/* Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2006, 2008,
+ *   2009, 2010, 2011 Free Software Foundation, Inc.
+ *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
  * as published by the Free Software Foundation; either version 3 of
@@ -72,6 +73,8 @@ SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0, 0,
     case scm_tc3_imm24:
 	/* characters, booleans, other immediates */
       return scm_from_bool (!scm_is_null_and_not_nil (obj));
+    case scm_tc3_aligned_pointer:
+      return SCM_BOOL_T;
     case scm_tc3_cons:
       switch (SCM_TYP7 (obj))
 	{
diff --git a/libguile/foreign.c b/libguile/foreign.c
index 52da23f..d00d4a9 100644
--- a/libguile/foreign.c
+++ b/libguile/foreign.c
@@ -60,7 +60,7 @@ SCM_SYMBOL (sym_null, "%null-pointer");
 SCM_SYMBOL (sym_null_pointer_error, "null-pointer-error");
 
 /* The cell representing the null pointer.  */
-static SCM null_pointer;
+static SCM null_pointer =  SCM_PACK (scm_tc3_aligned_pointer);
 
 #if SIZEOF_VOID_P == 4
 # define scm_to_uintptr   scm_to_uint32
@@ -139,8 +139,9 @@ scm_from_pointer (void *ptr, scm_t_pointer_finalizer finalizer)
 {
   SCM ret;
 
-  if (ptr == NULL && finalizer == NULL)
-    ret = null_pointer;
+  if (SCM_LIKELY (((scm_t_uintptr) ptr & 3) == 0 && finalizer == NULL))
+    /* Return an immediate pointer.  */
+    ret = SCM_PACK ((scm_t_bits) ptr | scm_tc3_aligned_pointer);
   else
     {
       ret = scm_cell (scm_tc7_pointer, (scm_t_bits) ptr);
@@ -1125,7 +1126,6 @@ scm_init_foreign (void)
 #endif
 	      );
 
-  null_pointer = scm_cell (scm_tc7_pointer, 0);
   scm_define (sym_null, null_pointer);
 }
 
diff --git a/libguile/foreign.h b/libguile/foreign.h
index b290019..bf16126 100644
--- a/libguile/foreign.h
+++ b/libguile/foreign.h
@@ -49,12 +49,18 @@ typedef enum scm_t_foreign_type scm_t_foreign_type;
 
 typedef void (*scm_t_pointer_finalizer) (void *);
 
-#define SCM_POINTER_P(x)                                                \
-  (!SCM_IMP (x) && SCM_TYP7(x) == scm_tc7_pointer)
+#define SCM_POINTER_P(x)			\
+  (SCM_IMP (x)					\
+   ? SCM_ITAG3 (x) == scm_tc3_aligned_pointer	\
+   : SCM_TYP7 (x) == scm_tc7_pointer)
+
 #define SCM_VALIDATE_POINTER(pos, x)		\
   SCM_MAKE_VALIDATE (pos, x, POINTER_P)
+
 #define SCM_POINTER_VALUE(x)			\
-  ((void *) SCM_CELL_WORD_1 (x))
+  (SCM_IMP (x)					\
+   ? (void *) ((scm_t_uintptr) (x) & ~3UL)	\
+   : (void *) SCM_CELL_WORD_1 (x))
 
 SCM_API SCM scm_from_pointer (void *, scm_t_pointer_finalizer);
 
diff --git a/libguile/gc.c b/libguile/gc.c
index 91250ba..1754f6b 100644
--- a/libguile/gc.c
+++ b/libguile/gc.c
@@ -1,4 +1,5 @@
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001, 2002, 2003, 2006, 2008, 2009, 2010 Free Software Foundation, Inc.
+/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
+ *   2006, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -746,8 +747,9 @@ scm_i_tag_name (scm_t_bits tag)
       return "cons (immediate car)";
     case scm_tcs_cons_nimcar:
       return "cons (non-immediate car)";
+    case scm_tc3_aligned_pointer:
     case scm_tc7_pointer:
-      return "foreign";
+      return "pointer";
     case scm_tc7_hashtable:
       return "hashtable";
     case scm_tc7_fluid:
diff --git a/libguile/goops.c b/libguile/goops.c
index c597044..feb61ff 100644
--- a/libguile/goops.c
+++ b/libguile/goops.c
@@ -211,6 +211,9 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0,
       else
         return scm_class_unknown;
 
+    case scm_tc3_aligned_pointer:
+      return class_foreign;
+
     case scm_tc3_cons:
       switch (SCM_TYP7 (x))
 	{
diff --git a/libguile/hash.c b/libguile/hash.c
index 0dcd1c2..7ceea43 100644
--- a/libguile/hash.c
+++ b/libguile/hash.c
@@ -143,6 +143,18 @@ scm_i_utf8_string_hash (const char *str, size_t len)
   return h;
 }
 
+static unsigned long
+pointer_hash (SCM obj)
+{
+  /* Pointer objects are typically used to store addresses of heap
+     objects.  On most platforms, these are at least 3-byte
+     aligned (on x86_64-*-gnu, `malloc' returns 4-byte aligned
+     addresses), so get rid of the least significant bits.  */
+  scm_t_uintptr significant_bits;
+
+  significant_bits = (scm_t_uintptr) SCM_POINTER_VALUE (obj) >> 4UL;
+  return (size_t) significant_bits;
+}
 
 /* Dirk:FIXME:: why downcase for characters? (2x: scm_hasher, scm_ihashv) */
 /* Dirk:FIXME:: scm_hasher could be made static. */
@@ -155,6 +167,8 @@ scm_hasher(SCM obj, unsigned long n, size_t d)
   case scm_tc3_int_1: 
   case scm_tc3_int_2:
     return SCM_I_INUM(obj) % n;   /* SCM_INUMP(obj) */
+  case scm_tc3_aligned_pointer:
+    return pointer_hash (obj) % n;
   case scm_tc3_imm24:
     if (SCM_CHARP(obj))
       return (unsigned)(scm_c_downcase(SCM_CHAR(obj))) % n;
@@ -214,16 +228,7 @@ scm_hasher(SCM obj, unsigned long n, size_t d)
     case scm_tc7_symbol:
       return scm_i_symbol_hash (obj) % n;
     case scm_tc7_pointer:
-      {
-	/* Pointer objects are typically used to store addresses of heap
-	   objects.  On most platforms, these are at least 3-byte
-	   aligned (on x86_64-*-gnu, `malloc' returns 4-byte aligned
-	   addresses), so get rid of the least significant bits.  */
-	scm_t_uintptr significant_bits;
-
-	significant_bits = (scm_t_uintptr) SCM_POINTER_VALUE (obj) >> 4UL;
-	return (size_t) significant_bits  % n;
-      }
+      return pointer_hash (obj) % n;
     case scm_tc7_wvect:
     case scm_tc7_vector:
       {
diff --git a/libguile/print.c b/libguile/print.c
index 679327a..f5af191 100644
--- a/libguile/print.c
+++ b/libguile/print.c
@@ -499,6 +499,9 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate)
 	  scm_ipruk ("immediate", exp, port);
 	}
       break;
+    case scm_tc3_aligned_pointer:
+      scm_i_pointer_print (exp, port, pstate);
+      break;
     case scm_tc3_cons:
       switch (SCM_TYP7 (exp))
 	{
diff --git a/libguile/tags.h b/libguile/tags.h
index 9e0e305..913064d 100644
--- a/libguile/tags.h
+++ b/libguile/tags.h
@@ -3,8 +3,8 @@
 #ifndef SCM_TAGS_H
 #define SCM_TAGS_H
 
-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2008,2009,2010
- * Free Software Foundation, Inc.
+/* Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
+ *   2003, 2004, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -386,7 +386,7 @@ typedef scm_t_uintptr scm_t_bits;
 #define scm_tc3_cons	 	 0
 #define scm_tc3_struct    	 1
 #define scm_tc3_int_1		 (scm_tc2_int + 0)
-#define scm_tc3_unused		 3
+#define scm_tc3_aligned_pointer  3
 #define scm_tc3_imm24		 4
 #define scm_tc3_tc7_1		 5
 #define scm_tc3_int_2		 (scm_tc2_int + 4)
-- 
1.7.3.2

Re: Immediate pointers

[Stefan Israelsson Tampe]

Hi,

I cannot say that I'm in the tag savy bin. But out of the 
box I remember that I kind of needed this in the guile-unify
project. 

The solution I'm trying there is to look at address ranges when checking 
for the object type and use that to dispatch to a unify object or to
work with a SCM pointer. This is hacky and works well enough to be able 
to debug errors and test out concepts. 

It looks like the test for adress range is not the heavy part in 
this application so it can be tolerated there.

What I really would like though is a retake on the tagging mechanism to 
allow for some innovative modifications of the scheme engine.

/Stefan

On Sunday, January 30, 2011 11:46:01 pm Ludovic Courtès wrote:
> Hello!
> 
> While using (system foreign) in a couple of projects I found myself
> doing quite a bit of pointer arithmetic in Scheme:
> 
> --8<---------------cut here---------------start------------->8---
> (define (foreign-array->list array-pointer element-count)
>   (let ((array (pointer->bytevector array-pointer
>                                     (* element-count (sizeof '*)))))
>     (unfold (cut >= <> element-count)
>             (lambda (element)
>               (let ((start (* element (sizeof '*))))
>                 (bytevector->pointer array start)))
>             1+
>             0)))
> 
> (define (pointer+ array-pointer type index)
>   (let ((offset (* index (align (sizeof type) (alignof type)))))
>     (make-pointer (+ (pointer-address array-pointer) offset))))
> 
> (define (foreign-string-array->list array len)
>   ;; Return a list of string comprising the LEN strings pointed to by the
>   ;; elements of ARRAY, a pointer to an array of pointers.
>   (unfold (cut < <> 0)
>           (lambda (index)
>             (let ((ptr (make-pointer (+ (pointer-address array)
>                                         (* index (sizeof '*))))))
>              (pointer->string (dereference-pointer ptr))))
>           1-
>           (- len 1)))
> --8<---------------cut here---------------end--------------->8---
> 
> (Examples from
> <https://gforge.inria.fr/plugins/scmgit/cgi-bin/gitweb.cgi?p=hubble/hubble.
> git;a=blob;f=modules/simgrid.scm>.)
> 
> The problem is that each ‘make-pointer’ call (and ‘dereference-pointer’,
> etc.) conses.  This can make conversion to/from C quite inefficient.
> 
> In addition, 90% of the C pointers of interest are 8-byte aligned---that’s
> on x86_64-linux-gnu, but it surely holds on most platforms, at least for
> pointers returned by ‘malloc’.
> 
> So, here comes the idea of “immediate pointers”, which would fit in a
> word.  A 3-bit tag is used, as for immediate numbers & co; pointers that
> aren’t 8-byte aligned are still stored in an scm_tc7_pointer cell.
> 
> I experimented with it using ‘scm_tc3_unused’ (== 3).  Alas, that can’t
> work, because it makes it impossible to use such an object as the ‘car’
> of a pair:
> 
>   #define SCM_I_CONSP(x)  (!SCM_IMP (x) && ((1 & SCM_CELL_TYPE (x)) == 0))
> 
> I would welcome feedback and help from tag-savvy people.
> 
> Thanks,
> Ludo’.

Re: Immediate pointers

[Andy Wingo]

On Sun 30 Jan 2011 23:46, ludo@gnu.org (Ludovic Courtès) writes:

> The problem is that each ‘make-pointer’ call (and ‘dereference-pointer’,
> etc.) conses.  This can make conversion to/from C quite inefficient.

We could simply allow Scheme integers to work as pointers.  It's not
very nice though.

Also, arguably, floating-point numbers are a bigger deal to get as
immediate objects...

Andy
-- 
http://wingolog.org/