[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Guile-commits] GNU Guile branch, master, updated. release_1-9-11-226-g1
|
From: |
Ludovic Courtès |
|
Subject: |
[Guile-commits] GNU Guile branch, master, updated. release_1-9-11-226-g17fc9ef |
|
Date: |
Mon, 26 Jul 2010 17:43:42 +0000 |
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".
http://git.savannah.gnu.org/cgit/guile.git/commit/?id=17fc9efecbc9cb0c7e32664dbd0e2c863194cd7f
The branch, master has been updated
via 17fc9efecbc9cb0c7e32664dbd0e2c863194cd7f (commit)
via d4149a510e4a87915b625255f4de3301510d810c (commit)
via 1af772303bf4eafb632a95bf4015a7736275e9e7 (commit)
via fefd60ba4ba751712c45c95362bbc2f858890678 (commit)
from a2a95453eb62dc489e6376f8e987db668837ba14 (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit 17fc9efecbc9cb0c7e32664dbd0e2c863194cd7f
Author: Ludovic Courtès <address@hidden>
Date: Mon Jul 26 19:36:03 2010 +0200
Add `dereference-pointer' to `(system foreign)'.
* libguile/foreign.c (scm_dereference_pointer): New function.
* libguile/foreign.h (scm_dereference_pointer): New declaration.
* module/system/foreign.scm (dereference-pointer): Likewise.
* test-suite/tests/foreign.test
("foreign<->bytevector")["dereference-pointer"]: New test.
commit d4149a510e4a87915b625255f4de3301510d810c
Author: Ludovic Courtès <address@hidden>
Date: Mon Jul 26 17:44:43 2010 +0200
Simplify the (system foreign) API.
Suggested by Neil Jerram.
* libguile/foreign.h (SCM_FOREIGN_TYPE, SCM_FOREIGN_VALUE_REF,
SCM_FOREIGN_VALUE_SET, SCM_FOREIGN_LEN, SCM_FOREIGN_TYPED_P,
SCM_FOREIGN_VALUE_P, SCM_VALIDATE_FOREIGN_VALUE, scm_foreign_set_x,
scm_foreign_type): Remove.
(scm_foreign_ref): Rename to...
(scm_foreign_address): ... this.
(scm_take_foreign_pointer): Update.
(SCM_FOREIGN_POINTER): Remove CTYPE argument. Update callers.
(scm_make_pointer): New declaration.
* libguile/foreign.c (scm_to_uintptr, scm_from_uintptr): New macros.
(scm_make_pointer): New function.
(scm_take_foreign_pointer): Remove TYPE and LEN arguments. Update
callers.
(scm_foreign_ref): Remove to...
(scm_foreign_address): ... this. Remove type-related code.
(scm_foreign_set_x): Remove.
(scm_foreign_to_bytevector): Change argument order; make LEN argument
compulsory.
(scm_i_foreign_print): Remove type printing.
(unpack): Remove foreign-type checking.
* libguile/deprecated.c (scm_dynamic_args_call): Update accordingly.
* libguile/dynl.c (scm_dynamic_pointer): Remove the TYPE and LEN
arguments; update callers. Update to the new foreign API.
* libguile/dynl.h (scm_dynamic_pointer): Update.
* libguile/gsubr.c (create_gsubr): Update to the new foreign API.
* libguile/gsubr.h (SCM_SUBRF, SCM_SUBR_GENERIC): Ditto.
* libguile/snarf.h (SCM_IMMUTABLE_FOREIGN): Ditto.
* libguile/vm-i-system.c (subr_call): Ditto.
* module/system/foreign.scm (null-pointer?): New procedure.
* test-suite/standalone/test-ffi: Update to the new
`bytevector->foreign' signature.
* test-suite/tests/foreign.test ("null pointer")["null pointer
identity", "null-pointer? %null-pointer"]: New tests.
["foreign-set! other-null-pointer", "foreign->bytevector
other-null-pointer"]: Remove.
("make-pointer", "foreign<->bytevector"): New test prefixes.
commit 1af772303bf4eafb632a95bf4015a7736275e9e7
Author: Ludovic Courtès <address@hidden>
Date: Mon Jul 26 16:36:24 2010 +0200
Import unbound variable reports in the VM.
* libguile/vm-engine.c (VM_NAME)[vm_error_unbound]: Add comment.
* libguile/vm-i-system.c (variable_ref): Attempt provide the name of X
in FINISH_ARGS.
commit fefd60ba4ba751712c45c95362bbc2f858890678
Author: Ludovic Courtès <address@hidden>
Date: Mon Jul 26 11:56:25 2010 +0200
Check for go/scm mtime ordering rather than equality.
* am/guilec (install-data-hook): Remove.
(guile_install_go_files): New variable.
($(guile_install_go_files)): New dependency.
* libguile/load.c (compiled_is_fresh): Check for ordering of STAT_SOURCE
and STAT_COMPILED, not equality.
* module/ice-9/boot-9.scm (load): Ditto.
* module/system/base/compile.scm (call-with-output-file/atomic): Don't
set the timestamp of TEMPLATE.
-----------------------------------------------------------------------
Summary of changes:
am/guilec | 25 +---
libguile/deprecated.c | 4 +-
libguile/dynl.c | 25 +---
libguile/dynl.h | 2 +-
libguile/foreign.c | 284 ++++++++++++----------------------------
libguile/foreign.h | 61 +++-------
libguile/gsubr.c | 6 +-
libguile/gsubr.h | 13 ++-
libguile/load.c | 4 +-
libguile/snarf.h | 6 +-
libguile/vm-engine.c | 2 +
libguile/vm-i-system.c | 11 +-
module/ice-9/boot-9.scm | 2 +-
module/system/base/compile.scm | 5 -
module/system/foreign.scm | 22 +++-
test-suite/standalone/test-ffi | 11 +-
test-suite/tests/foreign.test | 64 ++++++---
17 files changed, 215 insertions(+), 332 deletions(-)
diff --git a/am/guilec b/am/guilec
index 824f105..7e34719 100644
--- a/am/guilec
+++ b/am/guilec
@@ -11,24 +11,13 @@ EXTRA_DIST = $(SOURCES) $(NOCOMP_SOURCES)
CLEANFILES = $(GOBJECTS)
-# Well, shit. We can't have install changing timestamps, can we? But
-# install_sh doesn't know how to preserve timestamps. Soooo, fondle
-# automake to make things happen.
-install-data-hook:
- @$(am__vpath_adj_setup) \
- list='$(nobase_mod_DATA)'; for p in $$list; do \
- if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \
- $(am__vpath_adj) \
- echo " touch -r '$$d$$p' '$(DESTDIR)$(moddir)/$$f'"; \
- touch -r "$$d$$p" "$(DESTDIR)$(moddir)/$$f"; \
- done
- @$(am__vpath_adj_setup) \
- list='$(nobase_ccache_DATA)'; for p in $$list; do \
- if test -f "$$p"; then d=; else d="$(srcdir)/"; fi; \
- $(am__vpath_adj) \
- echo " touch -r '$$d$$p' '$(DESTDIR)$(ccachedir)/$$f'"; \
- touch -r "$$d$$p" "$(DESTDIR)$(ccachedir)/$$f"; \
- done
+# Make sure source files are installed first, so that the mtime of
+# installed compiled files is greater than that of installed source
+# files. See
+# <http://lists.gnu.org/archive/html/guile-devel/2010-07/msg00125.html>
+# for details.
+guile_install_go_files = install-nobase_ccacheDATA
+$(guile_install_go_files): install-nobase_modDATA
AM_V_GUILEC = $(AM_V_GUILEC_$(V))
AM_V_GUILEC_ = $(AM_V_GUILEC_$(AM_DEFAULT_VERBOSITY))
diff --git a/libguile/deprecated.c b/libguile/deprecated.c
index a35e21a..de5ac5b 100644
--- a/libguile/deprecated.c
+++ b/libguile/deprecated.c
@@ -1900,9 +1900,9 @@ SCM_DEFINE (scm_dynamic_args_call, "dynamic-args-call",
3, 0, 0,
if (scm_is_string (func))
func = scm_dynamic_func (func, dobj);
- SCM_VALIDATE_FOREIGN_TYPED (SCM_ARG1, func, VOID);
+ SCM_VALIDATE_FOREIGN (SCM_ARG1, func);
- fptr = SCM_FOREIGN_POINTER (func, void);
+ fptr = SCM_FOREIGN_POINTER (func);
argv = scm_i_allocate_string_pointers (args);
for (argc = 0; argv[argc]; argc++)
diff --git a/libguile/dynl.c b/libguile/dynl.c
index b76e85c..9ee4e2c 100644
--- a/libguile/dynl.c
+++ b/libguile/dynl.c
@@ -235,13 +235,11 @@ SCM_DEFINE (scm_dynamic_unlink, "dynamic-unlink", 1, 0, 0,
#undef FUNC_NAME
-SCM_DEFINE (scm_dynamic_pointer, "dynamic-pointer", 3, 1, 0,
- (SCM name, SCM type, SCM dobj, SCM len),
+SCM_DEFINE (scm_dynamic_pointer, "dynamic-pointer", 2, 0, 0,
+ (SCM name, SCM dobj),
"Return a ``handle'' for the pointer @var{name} in the\n"
"shared object referred to by @var{dobj}. The handle\n"
- "aliases a C value, and is declared to be of type\n"
- "@var{type}. Valid types are defined in the\n"
- "@code{(system foreign)} module.\n\n"
+ "aliases a C object.\n\n"
"This facility works by asking the dynamic linker for\n"
"the address of a symbol, then assuming that it aliases a\n"
"value of a given type. Obviously, the user must be very\n"
@@ -254,11 +252,9 @@ SCM_DEFINE (scm_dynamic_pointer, "dynamic-pointer", 3, 1,
0,
#define FUNC_NAME s_scm_dynamic_pointer
{
void *val;
- scm_t_foreign_type t;
SCM_VALIDATE_STRING (1, name);
- t = scm_to_unsigned_integer (type, 0, SCM_FOREIGN_TYPE_LAST);
- SCM_VALIDATE_SMOB (SCM_ARG3, dobj, dynamic_obj);
+ SCM_VALIDATE_SMOB (SCM_ARG2, dobj, dynamic_obj);
if (DYNL_HANDLE (dobj) == NULL)
SCM_MISC_ERROR ("Already unlinked: ~S", dobj);
@@ -272,9 +268,7 @@ SCM_DEFINE (scm_dynamic_pointer, "dynamic-pointer", 3, 1, 0,
val = sysdep_dynl_value (chars, DYNL_HANDLE (dobj), FUNC_NAME);
scm_dynwind_end ();
- return scm_take_foreign_pointer (t, val,
- SCM_UNBNDP (len) ? 0 : scm_to_size_t
(len),
- NULL);
+ return scm_take_foreign_pointer (val, NULL);
}
}
#undef FUNC_NAME
@@ -292,10 +286,7 @@ SCM_DEFINE (scm_dynamic_func, "dynamic-func", 2, 0, 0,
"since it will be added automatically when necessary.")
#define FUNC_NAME s_scm_dynamic_func
{
- return scm_dynamic_pointer (name,
- scm_from_uint (SCM_FOREIGN_TYPE_VOID),
- dobj,
- SCM_UNDEFINED);
+ return scm_dynamic_pointer (name, dobj);
}
#undef FUNC_NAME
@@ -324,9 +315,9 @@ SCM_DEFINE (scm_dynamic_call, "dynamic-call", 2, 0, 0,
if (scm_is_string (func))
func = scm_dynamic_func (func, dobj);
- SCM_VALIDATE_FOREIGN_TYPED (SCM_ARG1, func, VOID);
+ SCM_VALIDATE_FOREIGN (SCM_ARG1, func);
- fptr = SCM_FOREIGN_POINTER (func, void);
+ fptr = SCM_FOREIGN_POINTER (func);
fptr ();
return SCM_UNSPECIFIED;
}
diff --git a/libguile/dynl.h b/libguile/dynl.h
index 3239d63..e735bcc 100644
--- a/libguile/dynl.h
+++ b/libguile/dynl.h
@@ -30,7 +30,7 @@
SCM_API SCM scm_dynamic_link (SCM fname);
SCM_API SCM scm_dynamic_unlink (SCM dobj);
SCM_API SCM scm_dynamic_object_p (SCM obj);
-SCM_API SCM scm_dynamic_pointer (SCM name, SCM type, SCM dobj, SCM len);
+SCM_API SCM scm_dynamic_pointer (SCM name, SCM dobj);
SCM_API SCM scm_dynamic_func (SCM symb, SCM dobj);
SCM_API SCM scm_dynamic_call (SCM symb, SCM dobj);
diff --git a/libguile/foreign.c b/libguile/foreign.c
index aae4c67..dd77a82 100644
--- a/libguile/foreign.c
+++ b/libguile/foreign.c
@@ -59,6 +59,17 @@ SCM_SYMBOL (sym_null_pointer_error, "null-pointer-error");
/* The cell representing the null pointer. */
static SCM null_pointer;
+#if SIZEOF_VOID_P == 4
+# define scm_to_uintptr scm_to_uint32
+# define scm_from_uintptr scm_from_uint32
+#elif SIZEOF_VOID_P == 8
+# define scm_to_uintptr scm_to_uint64
+# define scm_from_uintptr scm_from_uint64
+#else
+# error unsupported pointer size
+#endif
+
+
/* Raise a null pointer dereference error. */
static void
null_pointer_error (const char *func_name)
@@ -78,25 +89,51 @@ register_weak_reference (SCM from, SCM to)
{
scm_hashq_set_x (foreign_weak_refs, from, to);
}
-
+
static void
foreign_finalizer_trampoline (GC_PTR ptr, GC_PTR data)
{
scm_t_foreign_finalizer finalizer = data;
- finalizer (SCM_FOREIGN_POINTER (PTR2SCM (ptr), void));
+ finalizer (SCM_FOREIGN_POINTER (PTR2SCM (ptr)));
+}
+
+SCM_DEFINE (scm_make_pointer, "make-pointer", 1, 1, 0,
+ (SCM address, SCM finalizer),
+ "Return a foreign pointer object pointing to @var{address}. "
+ "If @var{finalizer} is passed, it should be a pointer to a "
+ "one-argument C function that will be called when the pointer "
+ "object becomes unreachable.")
+#define FUNC_NAME s_scm_make_pointer
+{
+ void *c_finalizer;
+ scm_t_uintptr c_address;
+ SCM result;
+
+ c_address = scm_to_uintptr (address);
+ if (SCM_UNBNDP (finalizer))
+ c_finalizer = NULL;
+ else
+ {
+ SCM_VALIDATE_FOREIGN (2, finalizer);
+ c_finalizer = SCM_FOREIGN_POINTER (finalizer);
+ }
+
+ if (c_address == 0 && c_finalizer == NULL)
+ result = null_pointer;
+ else
+ result = scm_take_foreign_pointer ((void *) c_address, c_finalizer);
+
+ return result;
}
+#undef FUNC_NAME
SCM
-scm_take_foreign_pointer (scm_t_foreign_type type, void *ptr, size_t len,
- scm_t_foreign_finalizer finalizer)
+scm_take_foreign_pointer (void *ptr, scm_t_foreign_finalizer finalizer)
{
SCM ret;
scm_t_bits word0;
-
- word0 = (scm_t_bits)(scm_tc7_foreign | (type<<8)
- | (finalizer ? (1<<16) : 0) | (len<<17));
- if (SCM_UNLIKELY ((word0 >> 17) != len))
- scm_out_of_range ("scm_take_foreign_pointer", scm_from_size_t (len));
+
+ word0 = scm_tc7_foreign | (finalizer ? (1 << 16UL) : 0UL);
ret = scm_cell (word0, (scm_t_bits) ptr);
if (finalizer)
@@ -114,117 +151,32 @@ scm_take_foreign_pointer (scm_t_foreign_type type, void
*ptr, size_t len,
return ret;
}
-SCM_DEFINE (scm_foreign_ref, "foreign-ref", 1, 0, 0,
+SCM_DEFINE (scm_foreign_address, "foreign-address", 1, 0, 0,
(SCM foreign),
- "Reference the foreign value pointed to by @var{foreign}.\n\n"
- "The value will be referenced according to its type.")
-#define FUNC_NAME s_scm_foreign_ref
+ "Return the numerical value of @var{foreign}.")
+#define FUNC_NAME s_scm_foreign_address
{
- scm_t_foreign_type ftype;
- scm_t_uint8 *ptr;
-
SCM_VALIDATE_FOREIGN (1, foreign);
- ptr = SCM_FOREIGN_POINTER (foreign, scm_t_uint8);
- ftype = SCM_FOREIGN_TYPE (foreign);
-
- /* FIXME: is there a window in which we can see ptr but not foreign? */
- /* FIXME: accessing unaligned pointers */
- switch (ftype)
- {
- case SCM_FOREIGN_TYPE_VOID:
- return scm_from_ulong ((unsigned long)ptr);
- case SCM_FOREIGN_TYPE_FLOAT:
- return scm_from_double (*(float*)ptr);
- case SCM_FOREIGN_TYPE_DOUBLE:
- return scm_from_double (*(double*)ptr);
- case SCM_FOREIGN_TYPE_UINT8:
- return scm_from_uint8 (*(scm_t_uint8*)ptr);
- case SCM_FOREIGN_TYPE_INT8:
- return scm_from_int8 (*(scm_t_int8*)ptr);
- case SCM_FOREIGN_TYPE_UINT16:
- return scm_from_uint16 (*(scm_t_uint16*)ptr);
- case SCM_FOREIGN_TYPE_INT16:
- return scm_from_int16 (*(scm_t_int16*)ptr);
- case SCM_FOREIGN_TYPE_UINT32:
- return scm_from_uint32 (*(scm_t_uint32*)ptr);
- case SCM_FOREIGN_TYPE_INT32:
- return scm_from_int32 (*(scm_t_int32*)ptr);
- case SCM_FOREIGN_TYPE_UINT64:
- return scm_from_uint64 (*(scm_t_uint64*)ptr);
- case SCM_FOREIGN_TYPE_INT64:
- return scm_from_int64 (*(scm_t_int64*)ptr);
- default:
- scm_wrong_type_arg_msg (FUNC_NAME, 1, foreign, "foreign");
- }
+
+ return scm_from_uintptr ((scm_t_uintptr) SCM_FOREIGN_POINTER (foreign));
}
#undef FUNC_NAME
-SCM_DEFINE (scm_foreign_set_x, "foreign-set!", 2, 0, 0,
- (SCM foreign, SCM val),
- "Set the foreign value pointed to by @var{foreign}.\n\n"
- "The value will be set according to its type.")
-#define FUNC_NAME s_scm_foreign_set_x
+SCM_DEFINE (scm_dereference_pointer, "dereference-pointer", 1, 0, 0,
+ (SCM foreign),
+ "Return the a foreign object representing the pointer "
+ "pointed to by @var{foreign}.")
+#define FUNC_NAME s_scm_dereference_pointer
{
- scm_t_foreign_type ftype;
- scm_t_uint8 *ptr;
-
SCM_VALIDATE_FOREIGN (1, foreign);
- if (SCM_UNLIKELY (scm_is_eq (foreign, null_pointer)))
- /* Attempting to modify the pointer value of NULL_POINTER (which is
- read-only anyway), so raise an error. */
- null_pointer_error (FUNC_NAME);
-
- ptr = SCM_FOREIGN_POINTER (foreign, scm_t_uint8);
- ftype = SCM_FOREIGN_TYPE (foreign);
-
- /* FIXME: is there a window in which we can see ptr but not foreign? */
- /* FIXME: unaligned access */
- switch (ftype)
- {
- case SCM_FOREIGN_TYPE_VOID:
- SCM_SET_CELL_WORD_1 (foreign, scm_to_ulong (val));
- break;
- case SCM_FOREIGN_TYPE_FLOAT:
- *(float*)ptr = scm_to_double (val);
- break;
- case SCM_FOREIGN_TYPE_DOUBLE:
- *(double*)ptr = scm_to_double (val);
- break;
- case SCM_FOREIGN_TYPE_UINT8:
- *(scm_t_uint8*)ptr = scm_to_uint8 (val);
- break;
- case SCM_FOREIGN_TYPE_INT8:
- *(scm_t_int8*)ptr = scm_to_int8 (val);
- break;
- case SCM_FOREIGN_TYPE_UINT16:
- *(scm_t_uint16*)ptr = scm_to_uint16 (val);
- break;
- case SCM_FOREIGN_TYPE_INT16:
- *(scm_t_int16*)ptr = scm_to_int16 (val);
- break;
- case SCM_FOREIGN_TYPE_UINT32:
- *(scm_t_uint32*)ptr = scm_to_uint32 (val);
- break;
- case SCM_FOREIGN_TYPE_INT32:
- *(scm_t_int32*)ptr = scm_to_int32 (val);
- break;
- case SCM_FOREIGN_TYPE_UINT64:
- *(scm_t_uint64*)ptr = scm_to_uint64 (val);
- break;
- case SCM_FOREIGN_TYPE_INT64:
- *(scm_t_int64*)ptr = scm_to_int64 (val);
- break;
- default:
- scm_wrong_type_arg_msg (FUNC_NAME, 1, val, "foreign");
- }
-
- return SCM_UNSPECIFIED;
+ return scm_take_foreign_pointer (* (void **) SCM_FOREIGN_POINTER (foreign),
+ NULL);
}
#undef FUNC_NAME
-SCM_DEFINE (scm_foreign_to_bytevector, "foreign->bytevector", 1, 3, 0,
- (SCM foreign, SCM uvec_type, SCM offset, SCM len),
+SCM_DEFINE (scm_foreign_to_bytevector, "foreign->bytevector", 2, 2, 0,
+ (SCM foreign, SCM len, SCM offset, SCM uvec_type),
"Return a bytevector aliasing the memory pointed to by\n"
"@var{foreign}.\n\n"
"@var{foreign} must be a void pointer, a foreign whose type is\n"
@@ -247,8 +199,8 @@ SCM_DEFINE (scm_foreign_to_bytevector,
"foreign->bytevector", 1, 3, 0,
size_t boffset, blen;
scm_t_array_element_type btype;
- SCM_VALIDATE_FOREIGN_TYPED (1, foreign, VOID);
- ptr = SCM_FOREIGN_POINTER (foreign, scm_t_int8);
+ SCM_VALIDATE_FOREIGN (1, foreign);
+ ptr = SCM_FOREIGN_POINTER (foreign);
if (SCM_UNLIKELY (ptr == NULL))
null_pointer_error (FUNC_NAME);
@@ -283,32 +235,13 @@ SCM_DEFINE (scm_foreign_to_bytevector,
"foreign->bytevector", 1, 3, 0,
"uniform vector type");
}
}
-
+
if (SCM_UNBNDP (offset))
boffset = 0;
- else if (SCM_FOREIGN_LEN (foreign))
- boffset = scm_to_unsigned_integer (offset, 0,
- SCM_FOREIGN_LEN (foreign) - 1);
else
boffset = scm_to_size_t (offset);
- if (SCM_UNBNDP (len))
- {
- if (SCM_FOREIGN_LEN (foreign))
- blen = SCM_FOREIGN_LEN (foreign) - boffset;
- else
- scm_misc_error (FUNC_NAME,
- "length needed to convert foreign pointer to
bytevector",
- SCM_EOL);
- }
- else
- {
- if (SCM_FOREIGN_LEN (foreign))
- blen = scm_to_unsigned_integer (len, 0,
- SCM_FOREIGN_LEN (foreign) - boffset);
- else
- blen = scm_to_size_t (len);
- }
+ blen = scm_to_size_t (len);
ret = scm_c_take_typed_bytevector (ptr + boffset, blen, btype);
register_weak_reference (ret, foreign);
@@ -347,8 +280,7 @@ SCM_DEFINE (scm_bytevector_to_foreign,
"bytevector->foreign", 1, 2, 0,
blen = scm_to_unsigned_integer (len, 0,
SCM_BYTEVECTOR_LENGTH (bv) - boffset);
- ret = scm_take_foreign_pointer (SCM_FOREIGN_TYPE_VOID, ptr + boffset, blen,
- NULL);
+ ret = scm_take_foreign_pointer (ptr + boffset, NULL);
register_weak_reference (ret, bv);
return ret;
}
@@ -366,10 +298,10 @@ SCM_DEFINE (scm_foreign_set_finalizer_x,
"foreign-set-finalizer!", 2, 0, 0,
GC_finalization_proc prev_finalizer;
GC_PTR prev_finalizer_data;
- SCM_VALIDATE_FOREIGN_TYPED (1, foreign, VOID);
- SCM_VALIDATE_FOREIGN_TYPED (2, finalizer, VOID);
-
- c_finalizer = SCM_FOREIGN_POINTER (finalizer, void);
+ SCM_VALIDATE_FOREIGN (1, foreign);
+ SCM_VALIDATE_FOREIGN (2, finalizer);
+
+ c_finalizer = SCM_FOREIGN_POINTER (finalizer);
SCM_SET_CELL_WORD_0 (foreign, SCM_CELL_WORD_0 (foreign) | (1<<16));
@@ -389,45 +321,7 @@ void
scm_i_foreign_print (SCM foreign, SCM port, scm_print_state *pstate)
{
scm_puts ("#<foreign ", port);
- switch (SCM_FOREIGN_TYPE (foreign))
- {
- case SCM_FOREIGN_TYPE_FLOAT:
- scm_puts ("float ", port);
- break;
- case SCM_FOREIGN_TYPE_DOUBLE:
- scm_puts ("double ", port);
- break;
- case SCM_FOREIGN_TYPE_UINT8:
- scm_puts ("uint8 ", port);
- break;
- case SCM_FOREIGN_TYPE_INT8:
- scm_puts ("int8 ", port);
- break;
- case SCM_FOREIGN_TYPE_UINT16:
- scm_puts ("uint16 ", port);
- break;
- case SCM_FOREIGN_TYPE_INT16:
- scm_puts ("int16 ", port);
- break;
- case SCM_FOREIGN_TYPE_UINT32:
- scm_puts ("uint32 ", port);
- break;
- case SCM_FOREIGN_TYPE_INT32:
- scm_puts ("int32 ", port);
- break;
- case SCM_FOREIGN_TYPE_UINT64:
- scm_puts ("uint64 ", port);
- break;
- case SCM_FOREIGN_TYPE_INT64:
- scm_puts ("int64 ", port);
- break;
- case SCM_FOREIGN_TYPE_VOID:
- scm_puts ("pointer ", port);
- break;
- default:
- scm_wrong_type_arg_msg ("%print-foreign", 1, foreign, "foreign");
- }
- scm_display (scm_foreign_ref (foreign), port);
+ scm_display (scm_foreign_address (foreign), port);
scm_putc ('>', port);
}
@@ -670,7 +564,8 @@ SCM_DEFINE (scm_make_foreign_function,
"make-foreign-function", 3, 0, 0,
ffi_type **type_ptrs;
ffi_type *types;
- SCM_VALIDATE_FOREIGN_TYPED (2, func_ptr, VOID);
+ SCM_VALIDATE_FOREIGN (2, func_ptr);
+
nargs = scm_ilength (arg_types);
SCM_ASSERT (nargs >= 0, arg_types, 3, FUNC_NAME);
/* fixme: assert nargs < 1<<32 */
@@ -699,8 +594,7 @@ SCM_DEFINE (scm_make_foreign_function,
"make-foreign-function", 3, 0, 0,
+ (nargs + n_struct_elts + 1)*sizeof(ffi_type));
mem = scm_gc_malloc_pointerless (cif_len, "foreign");
- scm_cif = scm_take_foreign_pointer (SCM_FOREIGN_TYPE_VOID, mem,
- cif_len, NULL);
+ scm_cif = scm_take_foreign_pointer (mem, NULL);
cif = (ffi_cif *) mem;
/* reuse cif_len to walk through the mem */
@@ -852,9 +746,13 @@ static const SCM objcode_trampolines[10] = {
static SCM
cif_to_procedure (SCM cif, SCM func_ptr)
{
- unsigned nargs = SCM_FOREIGN_POINTER (cif, ffi_cif)->nargs;
+ ffi_cif *c_cif;
+ unsigned int nargs;
SCM objcode, table, ret;
-
+
+ c_cif = (ffi_cif *) SCM_FOREIGN_POINTER (cif);
+ nargs = c_cif->nargs;
+
if (nargs < 10)
objcode = objcode_trampolines[nargs];
else
@@ -906,17 +804,10 @@ unpack (const ffi_type *type, void *loc, SCM x)
*(scm_t_int64 *) loc = scm_to_int64 (x);
break;
case FFI_TYPE_STRUCT:
- if (!SCM_FOREIGN_TYPED_P (x, VOID))
- scm_wrong_type_arg_msg ("foreign-call", 0, x, "foreign void pointer");
- if (SCM_FOREIGN_LEN (x) && SCM_FOREIGN_LEN (x) != type->size)
- scm_wrong_type_arg_msg ("foreign-call", 0, x,
- "foreign void pointer of correct length");
- memcpy (loc, SCM_FOREIGN_POINTER (x, void), type->size);
+ memcpy (loc, SCM_FOREIGN_POINTER (x), type->size);
break;
case FFI_TYPE_POINTER:
- if (!SCM_FOREIGN_TYPED_P (x, VOID))
- scm_wrong_type_arg_msg ("foreign-call", 0, x, "foreign void pointer");
- *(void **) loc = SCM_FOREIGN_POINTER (x, void);
+ *(void **) loc = SCM_FOREIGN_POINTER (x);
break;
default:
abort ();
@@ -955,12 +846,10 @@ pack (const ffi_type * type, const void *loc)
{
void *mem = scm_gc_malloc_pointerless (type->size, "foreign");
memcpy (mem, loc, type->size);
- return scm_take_foreign_pointer (SCM_FOREIGN_TYPE_VOID,
- mem, type->size, NULL);
+ return scm_take_foreign_pointer (mem, NULL);
}
case FFI_TYPE_POINTER:
- return scm_take_foreign_pointer (SCM_FOREIGN_TYPE_VOID,
- *(void **) loc, 0, NULL);
+ return scm_take_foreign_pointer (*(void **) loc, NULL);
default:
abort ();
}
@@ -981,8 +870,8 @@ scm_i_foreign_call (SCM foreign, const SCM *argv)
size_t arg_size;
scm_t_ptrdiff off;
- cif = SCM_FOREIGN_POINTER (SCM_CAR (foreign), ffi_cif);
- func = SCM_FOREIGN_POINTER (SCM_CDR (foreign), void);
+ cif = SCM_FOREIGN_POINTER (SCM_CAR (foreign));
+ func = SCM_FOREIGN_POINTER (SCM_CDR (foreign));
/* Argument pointers. */
args = alloca (sizeof (void *) * cif->nargs);
@@ -1093,8 +982,7 @@ scm_init_foreign (void)
#endif
);
- null_pointer = scm_cell (scm_tc7_foreign | (SCM_FOREIGN_TYPE_VOID << 8UL),
- 0);
+ null_pointer = scm_cell (scm_tc7_foreign, 0);
scm_define (sym_null, null_pointer);
}
diff --git a/libguile/foreign.h b/libguile/foreign.h
index a162d5d..af7f1c9 100644
--- a/libguile/foreign.h
+++ b/libguile/foreign.h
@@ -26,20 +26,13 @@
scm_tc7_foreign typecode and type of the aliased (pointed-to) value in its
lower 16 bits.
- There are numeric types, like uint32 and float, and there is a "generic
- pointer" type, void. Void pointers also have a length associated with them,
- in the high bits of the first word of the SCM object, but since they really
- are pointers out into the wild wooly world of C, perhaps we don't actually
- know how much memory they take up. In that, most general case, the "len"
- will be stored as 0.
-
The basic idea is that we can help the programmer to avoid cutting herself,
- but we won't take away her knives.
-*/
-typedef enum
+ but we won't take away her knives. */
+
+enum scm_t_foreign_type
{
- SCM_FOREIGN_TYPE_VOID, /* a pointer out into the wilderness */
- SCM_FOREIGN_TYPE_FLOAT,
+ SCM_FOREIGN_TYPE_VOID,
+ SCM_FOREIGN_TYPE_FLOAT,
SCM_FOREIGN_TYPE_DOUBLE,
SCM_FOREIGN_TYPE_UINT8,
SCM_FOREIGN_TYPE_INT8,
@@ -50,55 +43,33 @@ typedef enum
SCM_FOREIGN_TYPE_UINT64,
SCM_FOREIGN_TYPE_INT64,
SCM_FOREIGN_TYPE_LAST = SCM_FOREIGN_TYPE_INT64
- } scm_t_foreign_type;
+ };
+typedef enum scm_t_foreign_type scm_t_foreign_type;
typedef void (*scm_t_foreign_finalizer) (void *);
#define SCM_FOREIGN_P(x) \
(!SCM_IMP (x) && SCM_TYP7(x) == scm_tc7_foreign)
-#define SCM_VALIDATE_FOREIGN(pos, x) \
+#define SCM_VALIDATE_FOREIGN(pos, x) \
SCM_MAKE_VALIDATE (pos, x, FOREIGN_P)
-#define SCM_FOREIGN_TYPE(x) \
- ((scm_t_foreign_type)((SCM_CELL_WORD_0 (x) >> 8)&0xff))
-#define SCM_FOREIGN_POINTER(x, ctype) \
- ((ctype*)SCM_CELL_WORD_1 (x))
-#define SCM_FOREIGN_VALUE_REF(x, ctype) \
- (*SCM_FOREIGN_POINTER (x, ctype))
-#define SCM_FOREIGN_VALUE_SET(x, ctype, val) \
- (*SCM_FOREIGN_POINTER (x, ctype) = (val))
-#define SCM_FOREIGN_HAS_FINALIZER(x) \
+#define SCM_FOREIGN_POINTER(x) \
+ ((void *) SCM_CELL_WORD_1 (x))
+#define SCM_FOREIGN_HAS_FINALIZER(x) \
((SCM_CELL_WORD_0 (x) >> 16) & 0x1)
-#define SCM_FOREIGN_LEN(x) \
- ((size_t)(SCM_CELL_WORD_0 (x) >> 17))
-
-#define SCM_FOREIGN_TYPED_P(x, type) \
- (SCM_FOREIGN_P (x) && SCM_FOREIGN_TYPE (x) == SCM_FOREIGN_TYPE_##type)
-#define SCM_VALIDATE_FOREIGN_TYPED(pos, x, type) \
- do { \
- SCM_ASSERT_TYPE (SCM_FOREIGN_TYPED_P (x, type), x, pos, FUNC_NAME, \
- "FOREIGN_"#type"_P"); \
- } while (0)
-
-#define SCM_FOREIGN_VALUE_P(x) \
- (SCM_FOREIGN_P (x) && SCM_FOREIGN_TYPE (x) != SCM_FOREIGN_TYPE_VOID)
-#define SCM_VALIDATE_FOREIGN_VALUE(pos, x) \
- SCM_MAKE_VALIDATE (pos, x, FOREIGN_VALUE_P)
-
-SCM_API SCM scm_take_foreign_pointer (scm_t_foreign_type type, void *ptr,
- size_t len,
- scm_t_foreign_finalizer finalizer);
+
+SCM_API SCM scm_take_foreign_pointer (void *, scm_t_foreign_finalizer);
SCM_API SCM scm_alignof (SCM type);
SCM_API SCM scm_sizeof (SCM type);
-SCM_API SCM scm_foreign_type (SCM foreign);
-SCM_API SCM scm_foreign_ref (SCM foreign);
-SCM_API SCM scm_foreign_set_x (SCM foreign, SCM val);
+SCM_API SCM scm_foreign_address (SCM foreign);
SCM_API SCM scm_foreign_to_bytevector (SCM foreign, SCM type,
SCM offset, SCM len);
SCM_API SCM scm_foreign_set_finalizer_x (SCM foreign, SCM finalizer);
SCM_API SCM scm_bytevector_to_foreign (SCM bv, SCM offset, SCM len);
+SCM_INTERNAL SCM scm_make_pointer (SCM address, SCM finalizer);
+SCM_INTERNAL SCM scm_dereference_pointer (SCM pointer);
SCM_INTERNAL void scm_i_foreign_print (SCM foreign, SCM port,
scm_print_state *pstate);
diff --git a/libguile/gsubr.c b/libguile/gsubr.c
index de4bff6..ed8febd 100644
--- a/libguile/gsubr.c
+++ b/libguile/gsubr.c
@@ -794,13 +794,11 @@ create_gsubr (int define, const char *name,
sname = scm_from_locale_symbol (name);
table = scm_c_make_vector (generic_loc ? 3 : 2, SCM_UNDEFINED);
SCM_SIMPLE_VECTOR_SET (table, 0,
- scm_take_foreign_pointer (SCM_FOREIGN_TYPE_VOID,
- fcn, 0, NULL));
+ scm_take_foreign_pointer (fcn, NULL));
SCM_SIMPLE_VECTOR_SET (table, 1, sname);
if (generic_loc)
SCM_SIMPLE_VECTOR_SET (table, 2,
- scm_take_foreign_pointer (SCM_FOREIGN_TYPE_VOID,
- generic_loc, 0, NULL));
+ scm_take_foreign_pointer (generic_loc, NULL));
/* make program */
ret = scm_make_program (scm_subr_objcode_trampoline (nreq, nopt, rest),
diff --git a/libguile/gsubr.h b/libguile/gsubr.h
index e94d0d0..6907252 100644
--- a/libguile/gsubr.h
+++ b/libguile/gsubr.h
@@ -41,12 +41,19 @@ SCM_API SCM scm_subr_objcode_trampoline (unsigned int nreq,
#define SCM_GSUBR_MAX 10
#define SCM_PRIMITIVE_P(x) (SCM_PROGRAM_P (x) && SCM_PROGRAM_IS_PRIMITIVE (x))
+
#define SCM_PRIMITIVE_GENERIC_P(x) (SCM_PROGRAM_P (x) &&
SCM_PROGRAM_IS_PRIMITIVE_GENERIC (x))
-#define SCM_SUBRF(x) ((SCM (*)()) (SCM_FOREIGN_POINTER (SCM_SIMPLE_VECTOR_REF
(SCM_PROGRAM_OBJTABLE (x), 0), void)))
+#define SCM_SUBRF(x) \
+ ((SCM (*) (void)) \
+ SCM_FOREIGN_POINTER (SCM_SIMPLE_VECTOR_REF (SCM_PROGRAM_OBJTABLE (x), 0)))
+
#define SCM_SUBR_NAME(x) (SCM_SIMPLE_VECTOR_REF (SCM_PROGRAM_OBJTABLE (x), 1))
-#define SCM_SUBR_GENERIC(x) \
- (SCM_FOREIGN_POINTER (SCM_SIMPLE_VECTOR_REF (SCM_PROGRAM_OBJTABLE (x), 2),
SCM))
+
+#define SCM_SUBR_GENERIC(x) \
+ ((SCM *) \
+ SCM_FOREIGN_POINTER (SCM_SIMPLE_VECTOR_REF (SCM_PROGRAM_OBJTABLE (x), 2)))
+
#define SCM_SET_SUBR_GENERIC(x, g) \
(*SCM_SUBR_GENERIC (x) = (g))
diff --git a/libguile/load.c b/libguile/load.c
index f0e5d73..05667af 100644
--- a/libguile/load.c
+++ b/libguile/load.c
@@ -614,10 +614,10 @@ compiled_is_fresh (SCM full_filename, SCM
compiled_filename)
source = scm_to_locale_string (full_filename);
compiled = scm_to_locale_string (compiled_filename);
-
+
if (stat (source, &stat_source) == 0
&& stat (compiled, &stat_compiled) == 0
- && stat_source.st_mtime == stat_compiled.st_mtime)
+ && stat_source.st_mtime <= stat_compiled.st_mtime)
{
res = 1;
}
diff --git a/libguile/snarf.h b/libguile/snarf.h
index 360cb94..9aa99d0 100644
--- a/libguile/snarf.h
+++ b/libguile/snarf.h
@@ -361,10 +361,8 @@ SCM_SNARF_INIT(scm_set_smob_apply((tag), (c_name), (req),
(opt), (rest));)
(scm_t_bits) 0, \
(scm_t_bits) sizeof (contents) - 1)
-#define SCM_IMMUTABLE_FOREIGN(c_name, ptr) \
- SCM_IMMUTABLE_CELL (c_name, \
- scm_tc7_foreign | (SCM_FOREIGN_TYPE_VOID << 8), \
- ptr)
+#define SCM_IMMUTABLE_FOREIGN(c_name, ptr) \
+ SCM_IMMUTABLE_CELL (c_name, scm_tc7_foreign, ptr)
/* for primitive-generics, add a foreign to the end */
#define SCM_STATIC_SUBR_OBJVECT(c_name, foreign) \
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 7f4641a..ff41ce4 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -140,6 +140,8 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
goto vm_error;
vm_error_unbound:
+ /* At this point FINISH_ARGS should be a one-element list containing
+ the name of the unbound variable. */
err_msg = scm_from_locale_string ("VM: Unbound variable: ~s");
goto vm_error;
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 3af6308..8944c84 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -307,10 +307,13 @@ VM_DEFINE_INSTRUCTION (26, variable_ref, "variable-ref",
0, 1, 1)
{
SCM x = *sp;
- if (!VARIABLE_BOUNDP (x))
+ if (SCM_UNLIKELY (!VARIABLE_BOUNDP (x)))
{
- finish_args = scm_list_1 (x);
- /* Was: finish_args = SCM_LIST1 (SCM_CAR (x)); */
+ SCM var_name;
+
+ /* Attempt to provide the variable name in the error message. */
+ var_name = scm_module_reverse_lookup (scm_current_module (), x);
+ finish_args = scm_list_1 (scm_is_true (var_name) ? var_name : x);
goto vm_error_unbound;
}
else
@@ -842,7 +845,7 @@ VM_DEFINE_INSTRUCTION (56, subr_call, "subr-call", 1, -1,
-1)
nargs = FETCH ();
POP (foreign);
- subr = SCM_FOREIGN_POINTER (foreign, void);
+ subr = SCM_FOREIGN_POINTER (foreign);
VM_HANDLE_INTERRUPTS;
SYNC_REGISTER ();
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index e7ef923..d06b230 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -1116,7 +1116,7 @@ If there is no handler at all, Guile prints an error and
then exits."
(lambda ()
(let* ((scmstat (stat name))
(gostat (stat go-path #f)))
- (if (and gostat (= (stat:mtime gostat) (stat:mtime scmstat)))
+ (if (and gostat (>= (stat:mtime gostat) (stat:mtime scmstat)))
go-path
(begin
(if gostat
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index d553975..29c8d52 100644
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -81,11 +81,6 @@
(proc tmp)
(chmod tmp (logand #o0666 (lognot (umask))))
(close-port tmp)
- (if reference
- (let ((st (stat reference)))
- (utime template
- (stat:atime st) (stat:mtime st)
- (stat:atimensec st) (stat:mtimensec st))))
(rename-file template filename))
(lambda args
(delete-file template)))))))
diff --git a/module/system/foreign.scm b/module/system/foreign.scm
index 692dd92..6aa2fe3 100644
--- a/module/system/foreign.scm
+++ b/module/system/foreign.scm
@@ -25,11 +25,15 @@
uint16 int16
uint32 int32
uint64 int64
- %null-pointer
sizeof alignof
- foreign-ref foreign-set!
+ %null-pointer
+ null-pointer?
+ make-pointer
+ foreign-address
+ dereference-pointer
+
foreign->bytevector bytevector->foreign
foreign-set-finalizer!
make-foreign-function
@@ -38,6 +42,20 @@
(load-extension (string-append "libguile-" (effective-version))
"scm_init_foreign")
+
+;;;
+;;; Pointers.
+;;;
+
+(define (null-pointer? pointer)
+ (= (foreign-address pointer) 0))
+
+
+
+;;;
+;;; Structures.
+;;;
+
(define *writers*
`((,float . ,bytevector-ieee-single-native-set!)
(,double . ,bytevector-ieee-double-native-set!)
diff --git a/test-suite/standalone/test-ffi b/test-suite/standalone/test-ffi
index 7c859f2..0466b2f 100755
--- a/test-suite/standalone/test-ffi
+++ b/test-suite/standalone/test-ffi
@@ -165,12 +165,13 @@ exec guile -q -s "$0" "$@"
(define f-memcpy
(make-foreign-function '* (dynamic-func "test_ffi_memcpy" lib)
(list '* '* int32)))
-(let* ((src (bytevector->foreign (u8-list->bytevector '(0 1 2 3 4 5 6 7))))
+(let* ((src* '(0 1 2 3 4 5 6 7))
+ (src (bytevector->foreign (u8-list->bytevector src*)))
(dest (bytevector->foreign (make-bytevector 16 0)))
- (res (f-memcpy dest src (bytevector-length (foreign->bytevector src)))))
- (or (= (foreign-ref dest) (foreign-ref res))
+ (res (f-memcpy dest src (length src*))))
+ (or (= (foreign-address dest) (foreign-address res))
(error "memcpy res not equal to dest"))
- (or (equal? (bytevector->u8-list (foreign->bytevector dest))
+ (or (equal? (bytevector->u8-list (foreign->bytevector dest 16))
'(0 1 2 3 4 5 6 7 0 0 0 0 0 0 0 0))
(error "unexpected dest")))
@@ -196,7 +197,7 @@ exec guile -q -s "$0" "$@"
(let* ((ptr (strerror ENOENT))
(len (strlen ptr))
- (bv (foreign->bytevector ptr 'u8 0 len))
+ (bv (foreign->bytevector ptr len 0 'u8))
(str (utf8->string bv)))
(test #t (not (not (string-contains str "file")))))
diff --git a/test-suite/tests/foreign.test b/test-suite/tests/foreign.test
index 10fdf46..7da4deb 100644
--- a/test-suite/tests/foreign.test
+++ b/test-suite/tests/foreign.test
@@ -23,35 +23,57 @@
(define-module (test-foreign)
#:use-module (system foreign)
#:use-module (rnrs bytevectors)
+ #:use-module (srfi srfi-1)
#:use-module (test-suite lib))
(with-test-prefix "null pointer"
(pass-if "zero"
- (= 0 (foreign-ref %null-pointer)))
+ (= 0 (foreign-address %null-pointer)))
- (pass-if-exception "foreign-set! %null-pointer"
- exception:null-pointer-error
- (foreign-set! %null-pointer 2))
-
- (pass-if "foreign-set! other-null-pointer"
- (let ((f (bytevector->foreign (make-bytevector 2))))
- (and (not (= 0 (foreign-ref f)))
- (begin
- (foreign-set! f 0)
- (= 0 (foreign-ref f)))
- (begin
- ;; Here changing the pointer value of F is perfectly valid.
- (foreign-set! f 777)
- (= 777 (foreign-ref f))))))
+ (pass-if "null pointer identity"
+ (eq? %null-pointer (make-pointer 0)))
+
+ (pass-if "null-pointer? %null-pointer"
+ (null-pointer? %null-pointer))
(pass-if-exception "foreign->bytevector %null-pointer"
exception:null-pointer-error
- (foreign->bytevector %null-pointer))
+ (foreign->bytevector %null-pointer 7)))
- (pass-if-exception "foreign->bytevector other-null-pointer"
- exception:null-pointer-error
- (let ((f (bytevector->foreign (make-bytevector 2))))
- (foreign-set! f 0)
- (foreign->bytevector f))))
+
+(with-test-prefix "make-pointer"
+
+ (pass-if "address preserved"
+ (= 123 (foreign-address (make-pointer 123)))))
+
+
+(with-test-prefix "foreign<->bytevector"
+
+ (pass-if "bijection"
+ (let ((bv #vu8(0 1 2 3 4 5 6 7)))
+ (equal? (foreign->bytevector (bytevector->foreign bv)
+ (bytevector-length bv))
+ bv)))
+
+ (pass-if "pointer from bits"
+ (let* ((bytes (iota (sizeof '*)))
+ (bv (u8-list->bytevector bytes)))
+ (= (foreign-address
+ (make-pointer (bytevector-uint-ref bv 0 (native-endianness)
+ (sizeof '*))))
+ (fold-right (lambda (byte address)
+ (+ byte (* 256 address)))
+ 0
+ bytes))))
+
+ (pass-if "dereference-pointer"
+ (let* ((bytes (iota (sizeof '*)))
+ (bv (u8-list->bytevector bytes)))
+ (= (foreign-address
+ (dereference-pointer (bytevector->foreign bv)))
+ (fold-right (lambda (byte address)
+ (+ byte (* 256 address)))
+ 0
+ bytes)))))
hooks/post-receive
--
GNU Guile
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Guile-commits] GNU Guile branch, master, updated. release_1-9-11-226-g17fc9ef,
Ludovic Courtès <=