From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: ludo@gnu.org (Ludovic =?iso-8859-1?Q?Court=E8s?=) Newsgroups: gmane.lisp.guile.devel Subject: Immediate pointers Date: Sun, 30 Jan 2011 23:46:01 +0100 Message-ID: <87ipx6vwly.fsf@gnu.org> NNTP-Posting-Host: lo.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: dough.gmane.org 1296427717 10212 80.91.229.12 (30 Jan 2011 22:48:37 GMT) X-Complaints-To: usenet@dough.gmane.org NNTP-Posting-Date: Sun, 30 Jan 2011 22:48:37 +0000 (UTC) To: guile-devel@gnu.org Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Sun Jan 30 23:48:31 2011 Return-path: Envelope-to: guile-devel@m.gmane.org Original-Received: from lists.gnu.org ([199.232.76.165]) by lo.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1Pjg3u-00047b-Hy for guile-devel@m.gmane.org; Sun, 30 Jan 2011 23:48:30 +0100 Original-Received: from localhost ([127.0.0.1]:59802 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1Pjg3f-0007tK-LX for guile-devel@m.gmane.org; Sun, 30 Jan 2011 17:47:47 -0500 Original-Received: from [140.186.70.92] (port=40744 helo=eggs.gnu.org) by lists.gnu.org with esmtp (Exim 4.43) id 1Pjg3V-0007ot-Nd for guile-devel@gnu.org; Sun, 30 Jan 2011 17:47:44 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1Pjg2D-0006V8-V7 for guile-devel@gnu.org; Sun, 30 Jan 2011 17:46:19 -0500 Original-Received: from lo.gmane.org ([80.91.229.12]:59312) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1Pjg2D-0006Uy-Fj for guile-devel@gnu.org; Sun, 30 Jan 2011 17:46:17 -0500 Original-Received: from list by lo.gmane.org with local (Exim 4.69) (envelope-from ) id 1Pjg2B-0003RY-7M for guile-devel@gnu.org; Sun, 30 Jan 2011 23:46:15 +0100 Original-Received: from reverse-83.fdn.fr ([80.67.176.83]) by main.gmane.org with esmtp (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Sun, 30 Jan 2011 23:46:15 +0100 Original-Received: from ludo by reverse-83.fdn.fr with local (Gmexim 0.1 (Debian)) id 1AlnuQ-0007hv-00 for ; Sun, 30 Jan 2011 23:46:15 +0100 X-Injected-Via-Gmane: http://gmane.org/ Original-Lines: 296 Original-X-Complaints-To: usenet@dough.gmane.org X-Gmane-NNTP-Posting-Host: reverse-83.fdn.fr X-URL: http://www.fdn.fr/~lcourtes/ X-Revolutionary-Date: 11 =?iso-8859-1?Q?Pluvi=F4se?= an 219 de la =?iso-8859-1?Q?R=E9volution?= X-PGP-Key-ID: 0xEA52ECF4 X-PGP-Key: http://www.fdn.fr/~lcourtes/ludovic.asc X-PGP-Fingerprint: 83C4 F8E5 10A3 3B4C 5BEA D15D 77DD 95E2 EA52 ECF4 X-OS: x86_64-unknown-linux-gnu User-Agent: Gnus/5.110011 (No Gnus v0.11) Emacs/23.2 (gnu/linux) Cancel-Lock: sha1:jR1otvc1+IXO/jNctxASHj/hEyc= X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6 (newer, 3) X-Received-From: 80.91.229.12 X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.5 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Original-Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.devel:11441 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: 8bit 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 .) 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’. --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0001-Attempt-to-support-immediate-pointers.patch Content-Description: the patch >From c705f743031b305051549928cd91e5cfdfef7ec7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= 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 --=-=-=--