From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED.blaine.gmane.org!not-for-mail From: =?utf-8?Q?Ludovic_Court=C3=A8s?= Newsgroups: gmane.lisp.guile.devel Subject: For a cheaper =?utf-8?Q?=E2=80=98bytevector-=3Epointer=E2=80=99?= Date: Sun, 24 Nov 2019 11:52:41 +0100 Message-ID: <87zhglzgue.fsf@gnu.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: blaine.gmane.org; posting-host="blaine.gmane.org:195.159.176.226"; logging-data="93376"; mail-complaints-to="usenet@blaine.gmane.org" User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.3 (gnu/linux) Cc: Guile Devel To: Andy Wingo , David Thompson Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Sun Nov 24 11:52:53 2019 Return-path: Envelope-to: guile-devel@m.gmane.org Original-Received: from lists.gnu.org ([209.51.188.17]) by blaine.gmane.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.89) (envelope-from ) id 1iYpVb-000O8y-Nd for guile-devel@m.gmane.org; Sun, 24 Nov 2019 11:52:51 +0100 Original-Received: from localhost ([::1]:34760 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1iYpVa-0000A2-7b for guile-devel@m.gmane.org; Sun, 24 Nov 2019 05:52:50 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]:56841) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1iYpVW-00009w-68 for guile-devel@gnu.org; Sun, 24 Nov 2019 05:52:47 -0500 Original-Received: from fencepost.gnu.org ([2001:470:142:3::e]:45778) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1iYpVV-0001KH-Ek; Sun, 24 Nov 2019 05:52:45 -0500 Original-Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=46906 helo=ribbon) by fencepost.gnu.org with esmtpsa (TLS1.2:RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1iYpVT-0008D7-Hg; Sun, 24 Nov 2019 05:52:44 -0500 X-URL: http://www.fdn.fr/~lcourtes/ X-Revolutionary-Date: 4 Frimaire an 228 de la =?utf-8?Q?R=C3=A9volution?= X-PGP-Key-ID: 0x090B11993D9AEBB5 X-PGP-Key: http://www.fdn.fr/~lcourtes/ludovic.asc X-PGP-Fingerprint: 3CE4 6455 8A84 FDC6 9DB4 0CFB 090B 1199 3D9A EBB5 X-OS: x86_64-pc-linux-gnu X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.23 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Original-Sender: "guile-devel" Xref: news.gmane.org gmane.lisp.guile.devel:20158 Archived-At: --=-=-= Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable Hello! A few days ago David was explaining on #guile how =E2=80=98bytevector->poin= ter=E2=80=99 was generating too much garbage for his use case. An idea we came up with was to embed the pointer object in the bytevector. The patch below does that but it leads to segfaults because I=E2=80=99m gue= ssing there=E2=80=99s generated bytecode somewhere that still uses the wrong offs= et; I adjusted code that emits =E2=80=98pointer-ref/immediate=E2=80=99, what else= did I miss? Also, since we disable internal pointers, we=E2=80=99d need to register an additional displacement, and I=E2=80=99m not sure if this is a good idea. Thoughts? Thanks, Ludo=E2=80=99. --=-=-= Content-Type: text/x-patch Content-Disposition: inline diff --git a/libguile/bytevectors.c b/libguile/bytevectors.c index 7dfdab499..00aab6911 100644 --- a/libguile/bytevectors.c +++ b/libguile/bytevectors.c @@ -196,10 +196,15 @@ SCM_SET_BYTEVECTOR_FLAGS ((bv), SCM_BYTEVECTOR_FLAGS (bv) | flag) #define SCM_BYTEVECTOR_SET_LENGTH(_bv, _len) \ SCM_SET_CELL_WORD_1 ((_bv), (scm_t_bits) (_len)) -#define SCM_BYTEVECTOR_SET_CONTENTS(_bv, _contents) \ - SCM_SET_CELL_WORD_2 ((_bv), (scm_t_bits) (_contents)) +#define SCM_BYTEVECTOR_SET_CONTENTS(_bv, _contents) \ + do \ + { \ + SCM_SET_CELL_WORD_2 ((_bv), scm_tc7_pointer); \ + SCM_SET_CELL_WORD_3 ((_bv), (scm_t_bits) (_contents)); \ + } \ + while (0) #define SCM_BYTEVECTOR_SET_PARENT(_bv, _parent) \ - SCM_SET_CELL_OBJECT_3 ((_bv), (_parent)) + SCM_SET_CELL_OBJECT ((_bv), 4, (_parent)) #define SCM_VALIDATE_MUTABLE_BYTEVECTOR(pos, v) \ SCM_MAKE_VALIDATE_MSG (pos, v, MUTABLE_BYTEVECTOR_P, "mutable bytevector") diff --git a/libguile/bytevectors.h b/libguile/bytevectors.h index 980d6e267..77a0ef2f3 100644 --- a/libguile/bytevectors.h +++ b/libguile/bytevectors.h @@ -1,7 +1,7 @@ #ifndef SCM_BYTEVECTORS_H #define SCM_BYTEVECTORS_H -/* Copyright 2009,2011,2018 +/* Copyright 2009,2011,2018,2019 Free Software Foundation, Inc. This file is part of Guile. @@ -26,20 +26,23 @@ #include "libguile/gc.h" #include "libguile/uniform.h" +#include "libguile/foreign.h" /* R6RS bytevectors. */ /* The size in words of the bytevector header (type tag and flags, length, and pointer to the underlying buffer). */ -#define SCM_BYTEVECTOR_HEADER_SIZE 4U +#define SCM_BYTEVECTOR_HEADER_SIZE 5U #define SCM_BYTEVECTOR_LENGTH(_bv) \ ((size_t) SCM_CELL_WORD_1 (_bv)) +#define SCM_BYTEVECTOR_POINTER(_bv) \ + (SCM_PACK_POINTER (SCM_CELL_OBJECT_LOC ((_bv), 2))) #define SCM_BYTEVECTOR_CONTENTS(_bv) \ - ((signed char *) SCM_CELL_WORD_2 (_bv)) + ((signed char *) SCM_POINTER_VALUE (SCM_BYTEVECTOR_POINTER (_bv))) #define SCM_BYTEVECTOR_PARENT(_bv) \ - (SCM_CELL_OBJECT_3 (_bv)) + (SCM_CELL_OBJECT_4 (_bv)) SCM_API SCM scm_endianness_big; diff --git a/libguile/foreign.c b/libguile/foreign.c index 1368cc9da..1879c23bc 100644 --- a/libguile/foreign.c +++ b/libguile/foreign.c @@ -1,4 +1,4 @@ -/* Copyright 2010-2016,2018 +/* Copyright 2010-2016,2018,2019 Free Software Foundation, Inc. This file is part of Guile. @@ -313,8 +313,15 @@ SCM_DEFINE (scm_bytevector_to_pointer, "bytevector->pointer", 1, 1, 0, boffset = scm_to_unsigned_integer (offset, 0, SCM_BYTEVECTOR_LENGTH (bv) - 1); - ret = scm_from_pointer (ptr + boffset, NULL); - register_weak_reference (ret, bv); + if (boffset == 0) + /* The fast path: return the pre-allocated pointer. */ + ret = SCM_BYTEVECTOR_POINTER (bv); + else + { + ret = scm_from_pointer (ptr + boffset, NULL); + register_weak_reference (ret, bv); + } + return ret; } #undef FUNC_NAME diff --git a/module/language/tree-il/compile-cps.scm b/module/language/tree-il/compile-cps.scm index 8f048a504..c164f606b 100644 --- a/module/language/tree-il/compile-cps.scm +++ b/module/language/tree-il/compile-cps.scm @@ -883,7 +883,7 @@ (letk k ($kargs ('ptr) (ptr) ,body)) (build-term ($continue k src - ($primcall 'pointer-ref/immediate '(bytevector . 2) + ($primcall 'pointer-ref/immediate '(bytevector . 3) (bv)))))))) (letk k ($kargs ('rlen) (rlen) ,access)) (letk kassume diff --git a/module/system/base/types.scm b/module/system/base/types.scm index 418c9fed4..438aee9df 100644 --- a/module/system/base/types.scm +++ b/module/system/base/types.scm @@ -1,5 +1,5 @@ ;;; 'SCM' type tag decoding. -;;; Copyright (C) 2014, 2015, 2017, 2018 Free Software Foundation, Inc. +;;; Copyright (C) 2014, 2015, 2017, 2018, 2019 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 @@ -415,7 +415,7 @@ using BACKEND." (match (native-endianness) ('little "UTF-32LE") ('big "UTF-32BE"))))) - (((_ & #x7f = %tc7-bytevector) len address) + (((_ & #x7f = %tc7-bytevector) len pointer-tag address) (let ((bv-port (memory-port backend address len))) (get-bytevector-n bv-port len))) ((((len << 8) || %tc7-vector)) --=-=-=--