mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 03:30:27 +02:00
Code Activity

SCM_I_IS_VECTOR only true for tc7_vector, not weak vectors

Browse source 
* libguile/tags.h (SCM_TYP7S, SCM_HAS_TYP7S): Remove these, as we no
  longer do the differs-by-one-bit thing for vectors and weak vectors.
* libguile/vectors.h (SCM_I_IS_VECTOR): Use SCM_HAS_TYP7.
  (SCM_I_IS_NONWEAK_VECTOR): Remove.
* libguile/vm-engine.c (vector-length, vector-ref, vector-set!)
  (vector-ref/immediate, vector-set!/immediate): We can inline these
  instructions completely now.

* libguile/vm.c (vm_error_not_a_vector, vm_error_out_of_range): New
  error conditions.
This commit is contained in:
Andy Wingo 2014-02-08 17:14:47 +01:00
parent 787f7b644f
commit a32488ba13
5 changed files with 50 additions and 56 deletions
Download patch file Download diff file Expand all files Collapse all files

15
libguile/tags.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_TAGS_H #ifndef SCM_TAGS_H
#define SCM_TAGS_H #define SCM_TAGS_H
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2011,2012,2013 /* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2008,2009,2010,2011,2012,2013,2014
* Free Software Foundation, Inc. * 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
@ -335,14 +335,9 @@ typedef union SCM { struct { scm_t_bits n; } n; } SCM;
* 111: the cell belongs to some other heap object. * 111: the cell belongs to some other heap object.
* *
* tc7 (for tc3==1x1): * tc7 (for tc3==1x1):
* See below for the list of types. Note the special case of scm_tc7_vector * See below for the list of types. Three special tc7-codes are of
* and scm_tc7_wvect: vectors and weak vectors are treated the same in many * interest: numbers, ports and smobs in fact each represent
* cases. Thus, their tc7-codes are chosen to only differ in one bit. This * collections of types, which are subdivided using tc16-codes.
* makes it possible to check an object at the same time for being a vector
* or a weak vector by comparing its tc7 code with that bit masked (using
* the TYP7S macro). Three more special tc7-codes are of interest:
* numbers, ports and smobs in fact each represent collections of types,
* which are subdivided using tc16-codes.
* *
* tc16 (for tc7==scm_tc7_smob): * tc16 (for tc7==scm_tc7_smob):
* The largest part of the space of smob types is not subdivided in a * The largest part of the space of smob types is not subdivided in a
@ -396,11 +391,9 @@ typedef union SCM { struct { scm_t_bits n; } n; } SCM;
#define SCM_ITAG7(x) (127 & SCM_UNPACK (x)) #define SCM_ITAG7(x) (127 & SCM_UNPACK (x))
#define SCM_TYP7(x) (0x7f & SCM_CELL_TYPE (x)) #define SCM_TYP7(x) (0x7f & SCM_CELL_TYPE (x))
#define SCM_TYP7S(x) ((0x7f & ~2) & SCM_CELL_TYPE (x))
#define SCM_HAS_HEAP_TYPE(x, type, tag) \ #define SCM_HAS_HEAP_TYPE(x, type, tag) \
(SCM_NIMP (x) && type (x) == (tag)) (SCM_NIMP (x) && type (x) == (tag))
#define SCM_HAS_TYP7(x, tag) (SCM_HAS_HEAP_TYPE (x, SCM_TYP7, tag)) #define SCM_HAS_TYP7(x, tag) (SCM_HAS_HEAP_TYPE (x, SCM_TYP7, tag))
#define SCM_HAS_TYP7S(x, tag) (SCM_HAS_HEAP_TYPE (x, SCM_TYP7S, tag))
/* If you change these numbers, change them also in (system vm /* If you change these numbers, change them also in (system vm
assembler). */ assembler). */

4
libguile/vectors.c
View file

@ -46,13 +46,13 @@
int int
scm_is_vector (SCM obj) scm_is_vector (SCM obj)
{ {
return SCM_I_IS_NONWEAK_VECTOR (obj); return SCM_I_IS_VECTOR (obj);
} }
int int
scm_is_simple_vector (SCM obj) scm_is_simple_vector (SCM obj)
{ {
return SCM_I_IS_NONWEAK_VECTOR (obj); return SCM_I_IS_VECTOR (obj);
} }
const SCM * const SCM *

5
libguile/vectors.h
View file

@ -3,7 +3,7 @@
#ifndef SCM_VECTORS_H #ifndef SCM_VECTORS_H
#define SCM_VECTORS_H #define SCM_VECTORS_H
/* Copyright (C) 1995,1996,1998,2000,2001,2002,2004,2005, 2006, 2008, 2009, 2011 Free Software Foundation, Inc. /* Copyright (C) 1995,1996,1998,2000,2001,2002,2004,2005, 2006, 2008, 2009, 2011, 2014 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
@ -63,8 +63,7 @@ SCM_API SCM *scm_vector_writable_elements (SCM vec,
/* Internals */ /* Internals */
#define SCM_I_IS_VECTOR(x) (SCM_HAS_TYP7S (x, scm_tc7_vector)) #define SCM_I_IS_VECTOR(x) (SCM_HAS_TYP7 (x, scm_tc7_vector))
#define SCM_I_IS_NONWEAK_VECTOR(x) (SCM_HAS_TYP7 (x, scm_tc7_vector))
#define SCM_I_VECTOR_ELTS(x) ((const SCM *) SCM_I_VECTOR_WELTS (x)) #define SCM_I_VECTOR_ELTS(x) ((const SCM *) SCM_I_VECTOR_WELTS (x))
#define SCM_I_VECTOR_WELTS(x) (SCM_CELL_OBJECT_LOC (x, 1)) #define SCM_I_VECTOR_WELTS(x) (SCM_CELL_OBJECT_LOC (x, 1))
#define SCM_I_VECTOR_LENGTH(x) (((size_t) SCM_CELL_WORD_0 (x)) >> 8) #define SCM_I_VECTOR_LENGTH(x) (((size_t) SCM_CELL_WORD_0 (x)) >> 8)

53
libguile/vm-engine.c
View file

@ -2574,13 +2574,9 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
VM_DEFINE_OP (95, vector_length, "vector-length", OP1 (U8_U12_U12) | OP_DST) VM_DEFINE_OP (95, vector_length, "vector-length", OP1 (U8_U12_U12) | OP_DST)
{ {
ARGS1 (vect); ARGS1 (vect);
if (SCM_LIKELY (SCM_I_IS_VECTOR (vect))) VM_ASSERT (SCM_I_IS_VECTOR (vect),
vm_error_not_a_vector ("vector-ref", vect));
RETURN (SCM_I_MAKINUM (SCM_I_VECTOR_LENGTH (vect))); RETURN (SCM_I_MAKINUM (SCM_I_VECTOR_LENGTH (vect)));
else
{
SYNC_IP ();
RETURN (scm_vector_length (vect));
}
} }
/* vector-ref dst:8 src:8 idx:8 /* vector-ref dst:8 src:8 idx:8
@ -2592,16 +2588,13 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
{ {
scm_t_signed_bits i = 0; scm_t_signed_bits i = 0;
ARGS2 (vect, idx); ARGS2 (vect, idx);
if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (vect) VM_ASSERT (SCM_I_IS_VECTOR (vect),
&& SCM_I_INUMP (idx) vm_error_not_a_vector ("vector-ref", vect));
VM_ASSERT ((SCM_I_INUMP (idx)
&& ((i = SCM_I_INUM (idx)) >= 0) && ((i = SCM_I_INUM (idx)) >= 0)
&& i < SCM_I_VECTOR_LENGTH (vect))) && i < SCM_I_VECTOR_LENGTH (vect)),
vm_error_out_of_range ("vector-ref", idx));
RETURN (SCM_I_VECTOR_ELTS (vect)[i]); RETURN (SCM_I_VECTOR_ELTS (vect)[i]);
else
{
SYNC_IP ();
RETURN (scm_vector_ref (vect, idx));
}
} }
/* vector-ref/immediate dst:8 src:8 idx:8 /* vector-ref/immediate dst:8 src:8 idx:8
@ -2616,11 +2609,11 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
UNPACK_8_8_8 (op, dst, src, idx); UNPACK_8_8_8 (op, dst, src, idx);
v = LOCAL_REF (src); v = LOCAL_REF (src);
if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (v) VM_ASSERT (SCM_I_IS_VECTOR (v),
&& idx < SCM_I_VECTOR_LENGTH (v))) vm_error_not_a_vector ("vector-ref", v));
VM_ASSERT (idx < SCM_I_VECTOR_LENGTH (v),
vm_error_out_of_range ("vector-ref", scm_from_size_t (idx)));
LOCAL_SET (dst, SCM_I_VECTOR_ELTS (LOCAL_REF (src))[idx]); LOCAL_SET (dst, SCM_I_VECTOR_ELTS (LOCAL_REF (src))[idx]);
else
LOCAL_SET (dst, scm_c_vector_ref (v, idx));
NEXT (1); NEXT (1);
} }
@ -2639,16 +2632,13 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
idx = LOCAL_REF (idx_var); idx = LOCAL_REF (idx_var);
val = LOCAL_REF (src); val = LOCAL_REF (src);
if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (vect) VM_ASSERT (SCM_I_IS_VECTOR (vect),
&& SCM_I_INUMP (idx) vm_error_not_a_vector ("vector-ref", vect));
VM_ASSERT ((SCM_I_INUMP (idx)
&& ((i = SCM_I_INUM (idx)) >= 0) && ((i = SCM_I_INUM (idx)) >= 0)
&& i < SCM_I_VECTOR_LENGTH (vect))) && i < SCM_I_VECTOR_LENGTH (vect)),
vm_error_out_of_range ("vector-ref", idx));
SCM_I_VECTOR_WELTS (vect)[i] = val; SCM_I_VECTOR_WELTS (vect)[i] = val;
else
{
SYNC_IP ();
scm_vector_set_x (vect, idx, val);
}
NEXT (1); NEXT (1);
} }
@ -2666,14 +2656,11 @@ VM_NAME (scm_i_thread *thread, struct scm_vm *vp,
vect = LOCAL_REF (dst); vect = LOCAL_REF (dst);
val = LOCAL_REF (src); val = LOCAL_REF (src);
if (SCM_LIKELY (SCM_I_IS_NONWEAK_VECTOR (vect) VM_ASSERT (SCM_I_IS_VECTOR (vect),
&& idx < SCM_I_VECTOR_LENGTH (vect))) vm_error_not_a_vector ("vector-ref", vect));
VM_ASSERT (idx < SCM_I_VECTOR_LENGTH (vect),
vm_error_out_of_range ("vector-ref", scm_from_size_t (idx)));
SCM_I_VECTOR_WELTS (vect)[idx] = val; SCM_I_VECTOR_WELTS (vect)[idx] = val;
else
{
SYNC_IP ();
scm_vector_set_x (vect, scm_from_uint8 (idx), val);
}
NEXT (1); NEXT (1);
} }

15
libguile/vm.c
View file

@ -423,6 +423,8 @@ static void vm_error_improper_list (SCM x) SCM_NORETURN SCM_NOINLINE;
static void vm_error_not_a_pair (const char *subr, SCM x) SCM_NORETURN SCM_NOINLINE; static void vm_error_not_a_pair (const char *subr, SCM x) SCM_NORETURN SCM_NOINLINE;
static void vm_error_not_a_bytevector (const char *subr, SCM x) SCM_NORETURN SCM_NOINLINE; static void vm_error_not_a_bytevector (const char *subr, SCM x) SCM_NORETURN SCM_NOINLINE;
static void vm_error_not_a_struct (const char *subr, SCM x) SCM_NORETURN SCM_NOINLINE; static void vm_error_not_a_struct (const char *subr, SCM x) SCM_NORETURN SCM_NOINLINE;
static void vm_error_not_a_vector (const char *subr, SCM v) SCM_NORETURN SCM_NOINLINE;
static void vm_error_out_of_range (const char *subr, SCM k) SCM_NORETURN SCM_NOINLINE;
static void vm_error_no_values (void) SCM_NORETURN SCM_NOINLINE; static void vm_error_no_values (void) SCM_NORETURN SCM_NOINLINE;
static void vm_error_not_enough_values (void) SCM_NORETURN SCM_NOINLINE; static void vm_error_not_enough_values (void) SCM_NORETURN SCM_NOINLINE;
static void vm_error_wrong_number_of_values (scm_t_uint32 expected) SCM_NORETURN SCM_NOINLINE; static void vm_error_wrong_number_of_values (scm_t_uint32 expected) SCM_NORETURN SCM_NOINLINE;
@ -547,6 +549,19 @@ vm_error_not_a_struct (const char *subr, SCM x)
scm_wrong_type_arg_msg (subr, 1, x, "struct"); scm_wrong_type_arg_msg (subr, 1, x, "struct");
} }
static void
vm_error_not_a_vector (const char *subr, SCM x)
{
scm_wrong_type_arg_msg (subr, 1, x, "vector");
}
static void
vm_error_out_of_range (const char *subr, SCM k)
{
scm_to_size_t (k);
scm_out_of_range (subr, k);
}
static void static void
vm_error_no_values (void) vm_error_no_values (void)
{ {