mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-16 00:30:21 +02:00
Code Activity

Optimize struct initialization and accessors for the common case.

Browse source 
* libguile/struct.c (set_vtable_layout_flags): New function.
  (scm_i_struct_inherit_vtable_magic): Use it.
  (scm_struct_init): Optimize the case where HANDLE's vtable has the
  `SCM_VTABLE_FLAG_SIMPLE' flag.
  (scm_struct_ref): Likewise.
  (scm_struct_ref): Likewise, when `SCM_VTABLE_FLAG_SIMPLE_RW' is also set.

* libguile/struct.h (SCM_VTABLE_BASE_LAYOUT): Update comment for the
  next-to-last hidden field.
  (scm_vtable_index_reserved_6): Rename to...
  (scm_vtable_index_size): ... this.
  (SCM_VTABLE_FLAG_RESERVED_0): Rename to...
  (SCM_VTABLE_FLAG_SIMPLE): ... this.
  (SCM_VTABLE_FLAG_RESERVED_1): Rename to...
  (SCM_VTABLE_FLAG_SIMPLE_RW): ... this.

* test-suite/tests/structs.test ("low-level struct
  procedures")["struct-ref", "struct-set!", "struct-ref out-of-range",
  "struct-set! out-of-range"]: New tests.
This commit is contained in:
Ludovic Courtès 2010-01-23 16:21:13 +01:00
parent 0e64cbea3d
commit aa42c03669
3 changed files with 266 additions and 154 deletions
Download patch file Download diff file Expand all files Collapse all files

371
libguile/struct.c
View file

@ -1,4 +1,4 @@
/* Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. /* Copyright (C) 1996,1997,1998,1999,2000,2001, 2003, 2004, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
* *
* This library is free software; you can redistribute it and/or * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * modify it under the terms of the GNU Lesser General Public License
@ -22,6 +22,7 @@
#endif #endif
#include <alloca.h> #include <alloca.h>
#include <assert.h>
#include "libguile/_scm.h" #include "libguile/_scm.h"
#include "libguile/async.h" #include "libguile/async.h"
@ -151,6 +152,61 @@ SCM_DEFINE (scm_make_struct_layout, "make-struct-layout", 1, 0, 0,
#undef FUNC_NAME #undef FUNC_NAME
/* Check whether VTABLE instances have a simple layout (i.e., either only "pr"
or only "pw" fields) and update its flags accordingly. */
static void
set_vtable_layout_flags (SCM vtable)
{
size_t len, field;
SCM layout;
const char *c_layout;
scm_t_bits flags = SCM_VTABLE_FLAG_SIMPLE;
layout = SCM_VTABLE_LAYOUT (vtable);
c_layout = scm_i_symbol_chars (layout);
len = scm_i_symbol_length (layout);
assert (len % 2 == 0);
/* Update FLAGS according to LAYOUT. */
for (field = 0;
field < len && flags & SCM_VTABLE_FLAG_SIMPLE;
field += 2)
{
if (c_layout[field] != 'p')
flags = 0;
else
switch (c_layout[field + 1])
{
case 'w':
case 'W':
if (!(flags & SCM_VTABLE_FLAG_SIMPLE_RW) && field > 0)
/* There's a mixture of `w' and `r' flags. */
flags = 0;
else
flags |= SCM_VTABLE_FLAG_SIMPLE_RW;
break;
case 'r':
case 'R':
if (flags & SCM_VTABLE_FLAG_SIMPLE_RW)
/* There's a mixture of `w' and `r' flags. */
flags = 0;
break;
default:
flags = 0;
}
}
if (flags & SCM_VTABLE_FLAG_SIMPLE)
{
/* VTABLE is simple so update its flags and record the size of its
instances. */
SCM_SET_VTABLE_FLAGS (vtable, flags);
SCM_STRUCT_DATA_SET (vtable, scm_vtable_index_size, len / 2);
}
}
void void
scm_i_struct_inherit_vtable_magic (SCM vtable, SCM obj) scm_i_struct_inherit_vtable_magic (SCM vtable, SCM obj)
@ -171,6 +227,8 @@ scm_i_struct_inherit_vtable_magic (SCM vtable, SCM obj)
scm_misc_error (FUNC_NAME, "invalid layout for new vtable", scm_misc_error (FUNC_NAME, "invalid layout for new vtable",
scm_list_1 (SCM_VTABLE_LAYOUT (obj))); scm_list_1 (SCM_VTABLE_LAYOUT (obj)));
set_vtable_layout_flags (obj);
/* if obj's vtable is compatible with the required vtable (class) layout, it /* if obj's vtable is compatible with the required vtable (class) layout, it
is a metaclass */ is a metaclass */
olayout = scm_symbol_to_string (SCM_VTABLE_LAYOUT (obj)); olayout = scm_symbol_to_string (SCM_VTABLE_LAYOUT (obj));
@ -215,60 +273,74 @@ static void
scm_struct_init (SCM handle, SCM layout, size_t n_tail, scm_struct_init (SCM handle, SCM layout, size_t n_tail,
size_t n_inits, scm_t_bits *inits) size_t n_inits, scm_t_bits *inits)
{ {
scm_t_wchar prot = 0; SCM vtable;
int n_fields = scm_i_symbol_length (layout) / 2; scm_t_bits *mem;
int tailp = 0;
int i;
size_t inits_idx = 0;
scm_t_bits *mem = SCM_STRUCT_DATA (handle);
i = -2; vtable = SCM_STRUCT_VTABLE (handle);
while (n_fields) mem = SCM_STRUCT_DATA (handle);
if (SCM_UNPACK (vtable) != 0
&& SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_SIMPLE)
&& n_tail == 0
&& n_inits == SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size))
/* The fast path: HANDLE has N_INITS "p" fields. */
memcpy (mem, inits, n_inits * sizeof (SCM));
else
{ {
if (!tailp) scm_t_wchar prot = 0;
int n_fields = scm_i_symbol_length (layout) / 2;
int tailp = 0;
int i;
size_t inits_idx = 0;
i = -2;
while (n_fields)
{ {
i += 2; if (!tailp)
prot = scm_i_symbol_ref (layout, i+1);
if (SCM_LAYOUT_TAILP (prot))
{ {
tailp = 1; i += 2;
prot = prot == 'R' ? 'r' : prot == 'W' ? 'w' : 'o'; prot = scm_i_symbol_ref (layout, i+1);
*mem++ = (scm_t_bits)n_tail; if (SCM_LAYOUT_TAILP (prot))
n_fields += n_tail - 1; {
if (n_fields == 0) tailp = 1;
break; prot = prot == 'R' ? 'r' : prot == 'W' ? 'w' : 'o';
*mem++ = (scm_t_bits)n_tail;
n_fields += n_tail - 1;
if (n_fields == 0)
break;
}
} }
switch (scm_i_symbol_ref (layout, i))
{
case 'u':
if ((prot != 'r' && prot != 'w') || inits_idx == n_inits)
*mem = 0;
else
{
*mem = scm_to_ulong (SCM_PACK (inits[inits_idx]));
inits_idx++;
}
break;
case 'p':
if ((prot != 'r' && prot != 'w') || inits_idx == n_inits)
*mem = SCM_UNPACK (SCM_BOOL_F);
else
{
*mem = inits[inits_idx];
inits_idx++;
}
break;
case 's':
*mem = SCM_UNPACK (handle);
break;
}
n_fields--;
mem++;
} }
switch (scm_i_symbol_ref (layout, i))
{
case 'u':
if ((prot != 'r' && prot != 'w') || inits_idx == n_inits)
*mem = 0;
else
{
*mem = scm_to_ulong (SCM_PACK (inits[inits_idx]));
inits_idx++;
}
break;
case 'p':
if ((prot != 'r' && prot != 'w') || inits_idx == n_inits)
*mem = SCM_UNPACK (SCM_BOOL_F);
else
{
*mem = inits[inits_idx];
inits_idx++;
}
break;
case 's':
*mem = SCM_UNPACK (handle);
break;
}
n_fields--;
mem++;
} }
} }
@ -627,71 +699,81 @@ SCM_DEFINE (scm_struct_ref, "struct-ref", 2, 0, 0,
"integer value small enough to fit in one machine word.") "integer value small enough to fit in one machine word.")
#define FUNC_NAME s_scm_struct_ref #define FUNC_NAME s_scm_struct_ref
{ {
SCM answer = SCM_UNDEFINED; SCM vtable, answer = SCM_UNDEFINED;
scm_t_bits * data; scm_t_bits *data;
SCM layout;
size_t layout_len;
size_t p; size_t p;
scm_t_bits n_fields;
scm_t_wchar field_type = 0;
SCM_VALIDATE_STRUCT (1, handle); SCM_VALIDATE_STRUCT (1, handle);
layout = SCM_STRUCT_LAYOUT (handle); vtable = SCM_STRUCT_VTABLE (handle);
data = SCM_STRUCT_DATA (handle); data = SCM_STRUCT_DATA (handle);
p = scm_to_size_t (pos); p = scm_to_size_t (pos);
layout_len = scm_i_symbol_length (layout); if (SCM_LIKELY (SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_SIMPLE)
n_fields = layout_len / 2; && p < SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size)))
if (SCM_LAYOUT_TAILP (scm_i_symbol_ref (layout, layout_len - 1)))
n_fields += data[n_fields - 1];
SCM_ASSERT_RANGE(1, pos, p < n_fields);
if (p * 2 < layout_len)
{ {
scm_t_wchar ref; /* The fast path: HANDLE is a struct with only "p" fields. */
field_type = scm_i_symbol_ref (layout, p * 2); answer = SCM_PACK (data[p]);
ref = scm_i_symbol_ref (layout, p * 2 + 1);
if ((ref != 'r') && (ref != 'w') && (ref != 'h'))
{
if ((ref == 'R') || (ref == 'W'))
field_type = 'u';
else
SCM_MISC_ERROR ("ref denied for field ~A", scm_list_1 (pos));
}
} }
else if (scm_i_symbol_ref (layout, layout_len - 1) != 'O')
field_type = scm_i_symbol_ref(layout, layout_len - 2);
else else
SCM_MISC_ERROR ("ref denied for field ~A", scm_list_1 (pos));
switch (field_type)
{ {
case 'u': SCM layout;
answer = scm_from_ulong (data[p]); size_t layout_len, n_fields;
break; scm_t_wchar field_type = 0;
layout = SCM_STRUCT_LAYOUT (handle);
layout_len = scm_i_symbol_length (layout);
n_fields = layout_len / 2;
if (SCM_LAYOUT_TAILP (scm_i_symbol_ref (layout, layout_len - 1)))
n_fields += data[n_fields - 1];
SCM_ASSERT_RANGE (1, pos, p < n_fields);
if (p * 2 < layout_len)
{
scm_t_wchar ref;
field_type = scm_i_symbol_ref (layout, p * 2);
ref = scm_i_symbol_ref (layout, p * 2 + 1);
if ((ref != 'r') && (ref != 'w') && (ref != 'h'))
{
if ((ref == 'R') || (ref == 'W'))
field_type = 'u';
else
SCM_MISC_ERROR ("ref denied for field ~A", scm_list_1 (pos));
}
}
else if (scm_i_symbol_ref (layout, layout_len - 1) != 'O')
field_type = scm_i_symbol_ref(layout, layout_len - 2);
else
SCM_MISC_ERROR ("ref denied for field ~A", scm_list_1 (pos));
switch (field_type)
{
case 'u':
answer = scm_from_ulong (data[p]);
break;
#if 0 #if 0
case 'i': case 'i':
answer = scm_from_long (data[p]); answer = scm_from_long (data[p]);
break; break;
case 'd': case 'd':
answer = scm_make_real (*((double *)&(data[p]))); answer = scm_make_real (*((double *)&(data[p])));
break; break;
#endif #endif
case 's': case 's':
case 'p': case 'p':
answer = SCM_PACK (data[p]); answer = SCM_PACK (data[p]);
break; break;
default: default:
SCM_MISC_ERROR ("unrecognized field type: ~S", SCM_MISC_ERROR ("unrecognized field type: ~S",
scm_list_1 (SCM_MAKE_CHAR (field_type))); scm_list_1 (SCM_MAKE_CHAR (field_type)));
}
} }
return answer; return answer;
@ -706,65 +788,76 @@ SCM_DEFINE (scm_struct_set_x, "struct-set!", 3, 0, 0,
"to.") "to.")
#define FUNC_NAME s_scm_struct_set_x #define FUNC_NAME s_scm_struct_set_x
{ {
scm_t_bits * data; SCM vtable;
SCM layout; scm_t_bits *data;
size_t layout_len;
size_t p; size_t p;
int n_fields;
scm_t_wchar field_type = 0;
SCM_VALIDATE_STRUCT (1, handle); SCM_VALIDATE_STRUCT (1, handle);
layout = SCM_STRUCT_LAYOUT (handle); vtable = SCM_STRUCT_VTABLE (handle);
data = SCM_STRUCT_DATA (handle); data = SCM_STRUCT_DATA (handle);
p = scm_to_size_t (pos); p = scm_to_size_t (pos);
layout_len = scm_i_symbol_length (layout); if (SCM_LIKELY (SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_SIMPLE)
n_fields = layout_len / 2; && SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_SIMPLE_RW)
if (SCM_LAYOUT_TAILP (scm_i_symbol_ref (layout, layout_len - 1))) && p < SCM_STRUCT_DATA_REF (vtable, scm_vtable_index_size)))
n_fields += data[n_fields - 1]; /* The fast path: HANDLE is a struct with only "p" fields. */
data[p] = SCM_UNPACK (val);
SCM_ASSERT_RANGE (1, pos, p < n_fields);
if (p * 2 < layout_len)
{
char set_x;
field_type = scm_i_symbol_ref (layout, p * 2);
set_x = scm_i_symbol_ref (layout, p * 2 + 1);
if (set_x != 'w' && set_x != 'h')
SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos));
}
else if (scm_i_symbol_ref (layout, layout_len - 1) == 'W')
field_type = scm_i_symbol_ref (layout, layout_len - 2);
else else
SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos));
switch (field_type)
{ {
case 'u': SCM layout;
data[p] = SCM_NUM2ULONG (3, val); size_t layout_len, n_fields;
break; scm_t_wchar field_type = 0;
layout = SCM_STRUCT_LAYOUT (handle);
layout_len = scm_i_symbol_length (layout);
n_fields = layout_len / 2;
if (SCM_LAYOUT_TAILP (scm_i_symbol_ref (layout, layout_len - 1)))
n_fields += data[n_fields - 1];
SCM_ASSERT_RANGE (1, pos, p < n_fields);
if (p * 2 < layout_len)
{
char set_x;
field_type = scm_i_symbol_ref (layout, p * 2);
set_x = scm_i_symbol_ref (layout, p * 2 + 1);
if (set_x != 'w' && set_x != 'h')
SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos));
}
else if (scm_i_symbol_ref (layout, layout_len - 1) == 'W')
field_type = scm_i_symbol_ref (layout, layout_len - 2);
else
SCM_MISC_ERROR ("set! denied for field ~A", scm_list_1 (pos));
switch (field_type)
{
case 'u':
data[p] = SCM_NUM2ULONG (3, val);
break;
#if 0 #if 0
case 'i': case 'i':
data[p] = SCM_NUM2LONG (3, val); data[p] = SCM_NUM2LONG (3, val);
break; break;
case 'd': case 'd':
*((double *)&(data[p])) = scm_num2dbl (val, (char *)SCM_ARG3); *((double *)&(data[p])) = scm_num2dbl (val, (char *)SCM_ARG3);
break; break;
#endif #endif
case 'p': case 'p':
data[p] = SCM_UNPACK (val); data[p] = SCM_UNPACK (val);
break; break;
case 's': case 's':
SCM_MISC_ERROR ("self fields immutable", SCM_EOL); SCM_MISC_ERROR ("self fields immutable", SCM_EOL);
default: default:
SCM_MISC_ERROR ("unrecognized field type: ~S", SCM_MISC_ERROR ("unrecognized field type: ~S",
scm_list_1 (SCM_MAKE_CHAR (field_type))); scm_list_1 (SCM_MAKE_CHAR (field_type)));
}
} }
return val; return val;

12
libguile/struct.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_STRUCT_H #ifndef SCM_STRUCT_H
#define SCM_STRUCT_H #define SCM_STRUCT_H
/* Copyright (C) 1995,1997,1999,2000,2001, 2006, 2007, 2008, 2009 Free Software Foundation, Inc. /* Copyright (C) 1995,1997,1999,2000,2001, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
* *
* This library is free software; you can redistribute it and/or * This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public License * modify it under the terms of the GNU Lesser General Public License
@ -41,12 +41,12 @@
/* All vtables have the following fields. */ /* All vtables have the following fields. */
#define SCM_VTABLE_BASE_LAYOUT \ #define SCM_VTABLE_BASE_LAYOUT \
"pr" /* layout */ \ "pr" /* layout */ \
"uh" /* flags */ \ "uh" /* flags */ \
"sr" /* self */ \ "sr" /* self */ \
"uh" /* finalizer */ \ "uh" /* finalizer */ \
"pw" /* printer */ \ "pw" /* printer */ \
"ph" /* name (hidden from make-struct for back-compat reasons) */ \ "ph" /* name (hidden from make-struct for back-compat reasons) */ \
"uh" /* reserved */ \ "uh" /* size */ \
"uh" /* reserved */ "uh" /* reserved */
#define scm_vtable_index_layout 0 /* A symbol describing the physical arrangement of this type. */ #define scm_vtable_index_layout 0 /* A symbol describing the physical arrangement of this type. */
@ -55,7 +55,7 @@
#define scm_vtable_index_instance_finalize 3 /* Finalizer for instances of this struct type. */ #define scm_vtable_index_instance_finalize 3 /* Finalizer for instances of this struct type. */
#define scm_vtable_index_instance_printer 4 /* A printer for this struct type. */ #define scm_vtable_index_instance_printer 4 /* A printer for this struct type. */
#define scm_vtable_index_name 5 /* Name of this vtable. */ #define scm_vtable_index_name 5 /* Name of this vtable. */
#define scm_vtable_index_reserved_6 6 #define scm_vtable_index_size 6 /* Number of fields, for simple structs. */
#define scm_vtable_index_reserved_7 7 #define scm_vtable_index_reserved_7 7
#define scm_vtable_offset_user 8 /* Where do user fields start in the vtable? */ #define scm_vtable_offset_user 8 /* Where do user fields start in the vtable? */
@ -79,8 +79,8 @@
#define SCM_VTABLE_FLAG_APPLICABLE (1L << 2) /* instances of this vtable are applicable? */ #define SCM_VTABLE_FLAG_APPLICABLE (1L << 2) /* instances of this vtable are applicable? */
#define SCM_VTABLE_FLAG_SETTER_VTABLE (1L << 3) /* instances of this vtable are applicable-with-setter vtables? */ #define SCM_VTABLE_FLAG_SETTER_VTABLE (1L << 3) /* instances of this vtable are applicable-with-setter vtables? */
#define SCM_VTABLE_FLAG_SETTER (1L << 4) /* instances of this vtable are applicable-with-setters? */ #define SCM_VTABLE_FLAG_SETTER (1L << 4) /* instances of this vtable are applicable-with-setters? */
#define SCM_VTABLE_FLAG_RESERVED_0 (1L << 5) #define SCM_VTABLE_FLAG_SIMPLE (1L << 5) /* instances of this vtable have only "pr" fields */
#define SCM_VTABLE_FLAG_RESERVED_1 (1L << 6) #define SCM_VTABLE_FLAG_SIMPLE_RW (1L << 6) /* instances of this vtable have only "pw" fields */
#define SCM_VTABLE_FLAG_SMOB_0 (1L << 7) #define SCM_VTABLE_FLAG_SMOB_0 (1L << 7)
#define SCM_VTABLE_FLAG_GOOPS_0 (1L << 8) #define SCM_VTABLE_FLAG_GOOPS_0 (1L << 8)
#define SCM_VTABLE_FLAG_GOOPS_1 (1L << 9) #define SCM_VTABLE_FLAG_GOOPS_1 (1L << 9)

37
test-suite/tests/structs.test
View file

@ -1,7 +1,7 @@
;;;; structs.test --- Test suite for Guile's structures. -*- Scheme -*- ;;;; structs.test --- Structures. -*- mode: scheme; coding: utf-8; -*-
;;;; Ludovic Courtès <ludovic.courtes@laas.fr>, 2006-06-12. ;;;; Ludovic Courtès <ludo@gnu.org>, 2006-06-12.
;;;; ;;;;
;;;; Copyright (C) 2006, 2007, 2009 Free Software Foundation, Inc. ;;;; Copyright (C) 2006, 2007, 2009, 2010 Free Software Foundation, Inc.
;;;; ;;;;
;;;; This library is free software; you can redistribute it and/or ;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public ;;;; modify it under the terms of the GNU Lesser General Public
@ -80,9 +80,33 @@
(pass-if "struct-set!" (pass-if "struct-set!"
(let ((ball (make-ball green "Bob"))) (let ((ball (make-ball green "Bob")))
(set-owner! ball "Bill") (set-owner! ball "Bill")
(string=? (owner ball) "Bill")))) (string=? (owner ball) "Bill")))
(pass-if "struct-ref"
(let ((ball (make-ball red "Alice")))
(equal? (struct-ref ball 0) "Alice")))
(pass-if "struct-set!"
(let* ((v (make-vtable "pw"))
(s (make-struct v 0))
(r (struct-set! s 0 'a)))
(eq? r
(struct-ref s 0)
'a)))
(pass-if-exception "struct-ref out-of-range"
exception:out-of-range
(let* ((v (make-vtable "prpr"))
(s (make-struct v 0 'a 'b)))
(struct-ref s 2)))
(pass-if-exception "struct-set! out-of-range"
exception:out-of-range
(let* ((v (make-vtable "pwpw"))
(s (make-struct v 0 'a 'b)))
(struct-set! s 2 'c))))
(with-test-prefix "equal?" (with-test-prefix "equal?"
(pass-if "simple structs" (pass-if "simple structs"
@ -153,8 +177,3 @@
(lambda (port) (lambda (port)
(display struct port))))) (display struct port)))))
(equal? str "hello"))))) (equal? str "hello")))))
;;; Local Variables:
;;; coding: latin-1
;;; End: