[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: For a cheaper ‘bytevector->pointer’
From: |
Ludovic Courtès |
Subject: |
Re: For a cheaper ‘bytevector->pointer’ |
Date: |
Mon, 25 Nov 2019 23:03:59 +0100 |
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/26.3 (gnu/linux) |
Hello!
Andy Wingo <address@hidden> skribis:
> Honestly I would prefer not to do this. If I understand correctly, the
> problem is in FFI calls -- you have a bytevector and you want to pass it
> as a pointer. In that case the "right" optimization is to avoid the
> scm_tc7_pointer altogether and instead having an unboxed raw pointer.
> The idioms used in FFI are local enough that a compiler can do this.
I agree! I have a patch from the 2.0 era (attached), but it doesn’t
work because all the tc3s are already taken. I don’t think this has
changed but I could well be missing something about the tag space.
WDYT?
> More broadly -- the current FFI is an interpreter but it should be a
> compiler. When a call happens, the code interprets the description of
> the ABI. Instead, pointer->function should ideally *compile* a
> trampoline. In an ideal world this compilation can happen
> ahead-of-time, when the .go file is compiled.
Yes, agreed.
> In the short term, what about allowing bytevectors as arguments
> whereever a pointer is allowed? Perhaps it's bad to expand the domain
> of these functions but it may be the right trade-off.
So in practice, every time there’s '* in the FFI, it’d accept a
bytevector, right?
I would prefer immediate pointers if that’s possible, and then one of
the two other solutions.
Thanks!
Ludo’.
commit c705f743031b305051549928cd91e5cfdfef7ec7
Author: Ludovic Courtès <address@hidden>
Date: Sun Jan 30 23:28:13 2011 +0100
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.
diff --git a/libguile/evalext.c b/libguile/evalext.c
index ff2ff0ec0..c9dcf8b96 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 52da23f6e..d00d4a975 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 b29001962..bf16126e5 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 91250ba57..1754f6b1d 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 c597044f5..feb61ff22 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 0dcd1c29e..7ceea43e0 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 679327a8a..f5af19131 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 9e0e3059d..913064d9f 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)