mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-28 16:00:22 +02:00
inline scm_cons, scm_car, scm_cdr
* libguile/pairs.h (scm_cons, scm_car, scm_cdr): Define these as inline functions. (scm_is_pair): Move here from inline.h. * libguile/pairs.c: Remove definitions here, and define gsubrs. * libguile/inline.h: Remove scm_is_pair implementation. * libguile/inline.c: Include pairs.h to residualize inlines from pairs.h.
This commit is contained in:
parent
688291fe19
commit
730af462c3
4 changed files with 68 additions and 55 deletions
|
@ -1,4 +1,4 @@
|
||||||
/* Copyright (C) 2001, 2006, 2008, 2011 Free Software Foundation, Inc.
|
/* Copyright (C) 2001, 2006, 2008, 2011, 2012 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
|
||||||
|
@ -25,4 +25,5 @@
|
||||||
#include "libguile/inline.h"
|
#include "libguile/inline.h"
|
||||||
#include "libguile/gc.h"
|
#include "libguile/gc.h"
|
||||||
#include "libguile/smob.h"
|
#include "libguile/smob.h"
|
||||||
|
#include "libguile/pairs.h"
|
||||||
#include "libguile/ports.h"
|
#include "libguile/ports.h"
|
||||||
|
|
|
@ -29,7 +29,6 @@
|
||||||
|
|
||||||
#include "libguile/__scm.h"
|
#include "libguile/__scm.h"
|
||||||
|
|
||||||
#include "libguile/pairs.h"
|
|
||||||
#include "libguile/gc.h"
|
#include "libguile/gc.h"
|
||||||
#include "libguile/threads.h"
|
#include "libguile/threads.h"
|
||||||
#include "libguile/array-handle.h"
|
#include "libguile/array-handle.h"
|
||||||
|
@ -41,7 +40,6 @@
|
||||||
SCM_INLINE SCM scm_array_handle_ref (scm_t_array_handle *h, ssize_t pos);
|
SCM_INLINE SCM scm_array_handle_ref (scm_t_array_handle *h, ssize_t pos);
|
||||||
SCM_INLINE void scm_array_handle_set (scm_t_array_handle *h, ssize_t pos, SCM val);
|
SCM_INLINE void scm_array_handle_set (scm_t_array_handle *h, ssize_t pos, SCM val);
|
||||||
|
|
||||||
SCM_INLINE int scm_is_pair (SCM x);
|
|
||||||
SCM_INLINE int scm_is_string (SCM x);
|
SCM_INLINE int scm_is_string (SCM x);
|
||||||
|
|
||||||
SCM_INLINE SCM scm_cell (scm_t_bits car, scm_t_bits cdr);
|
SCM_INLINE SCM scm_cell (scm_t_bits car, scm_t_bits cdr);
|
||||||
|
@ -72,33 +70,6 @@ scm_array_handle_set (scm_t_array_handle *h, ssize_t p, SCM v)
|
||||||
h->impl->vset (h, h->base + p, v);
|
h->impl->vset (h, h->base + p, v);
|
||||||
}
|
}
|
||||||
|
|
||||||
SCM_INLINE_IMPLEMENTATION int
|
|
||||||
scm_is_pair (SCM x)
|
|
||||||
{
|
|
||||||
/* The following "workaround_for_gcc_295" avoids bad code generated by
|
|
||||||
i386 gcc 2.95.4 (the Debian packaged 2.95.4-24 at least).
|
|
||||||
|
|
||||||
Under the default -O2 the inlined SCM_I_CONSP test gets "optimized" so
|
|
||||||
the fetch of the tag word from x is done before confirming it's a
|
|
||||||
non-immediate (SCM_NIMP). Needless to say that bombs badly if x is a
|
|
||||||
immediate. This was seen to afflict scm_srfi1_split_at and something
|
|
||||||
deep in the bowels of ceval(). In both cases segvs resulted from
|
|
||||||
deferencing a random immediate value. srfi-1.test exposes the problem
|
|
||||||
through a short list, the immediate being SCM_EOL in that case.
|
|
||||||
Something in syntax.test exposed the ceval() problem.
|
|
||||||
|
|
||||||
Just "volatile SCM workaround_for_gcc_295 = lst" is enough to avoid the
|
|
||||||
problem, without even using that variable. The "w=w" is just to
|
|
||||||
prevent a warning about it being unused.
|
|
||||||
*/
|
|
||||||
#if defined (__GNUC__) && __GNUC__ == 2 && __GNUC_MINOR__ == 95
|
|
||||||
volatile SCM workaround_for_gcc_295 = x;
|
|
||||||
workaround_for_gcc_295 = workaround_for_gcc_295;
|
|
||||||
#endif
|
|
||||||
|
|
||||||
return SCM_I_CONSP (x);
|
|
||||||
}
|
|
||||||
|
|
||||||
SCM_INLINE_IMPLEMENTATION int
|
SCM_INLINE_IMPLEMENTATION int
|
||||||
scm_is_string (SCM x)
|
scm_is_string (SCM x)
|
||||||
{
|
{
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
/* Copyright (C) 1995,1996,2000,2001, 2004, 2005, 2006, 2008, 2009, 2011 Free Software Foundation, Inc.
|
/* Copyright (C) 1995,1996,2000,2001, 2004, 2005, 2006, 2008, 2009, 2011, 2012 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
|
||||||
|
@ -67,18 +67,6 @@ void scm_error_pair_access (SCM non_pair)
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
SCM_DEFINE (scm_cons, "cons", 2, 0, 0,
|
|
||||||
(SCM x, SCM y),
|
|
||||||
"Return a newly allocated pair whose car is @var{x} and whose\n"
|
|
||||||
"cdr is @var{y}. The pair is guaranteed to be different (in the\n"
|
|
||||||
"sense of @code{eq?}) from every previously existing object.")
|
|
||||||
#define FUNC_NAME s_scm_cons
|
|
||||||
{
|
|
||||||
return scm_cell (SCM_UNPACK (x), SCM_UNPACK (y));
|
|
||||||
}
|
|
||||||
#undef FUNC_NAME
|
|
||||||
|
|
||||||
|
|
||||||
SCM
|
SCM
|
||||||
scm_cons2 (SCM w, SCM x, SCM y)
|
scm_cons2 (SCM w, SCM x, SCM y)
|
||||||
{
|
{
|
||||||
|
@ -143,14 +131,6 @@ SCM_DEFINE (scm_set_cdr_x, "set-cdr!", 2, 0, 0,
|
||||||
return tree
|
return tree
|
||||||
|
|
||||||
|
|
||||||
SCM_DEFINE (scm_cdr, "cdr", 1, 0, 0, (SCM x), "")
|
|
||||||
{
|
|
||||||
CHASE_PAIRS (x, "cdr", 0x02); /* 00000010 */
|
|
||||||
}
|
|
||||||
SCM_DEFINE (scm_car, "car", 1, 0, 0, (SCM x), "")
|
|
||||||
{
|
|
||||||
CHASE_PAIRS (x, "car", 0x03); /* 00000011 */
|
|
||||||
}
|
|
||||||
SCM_DEFINE (scm_cddr, "cddr", 1, 0, 0, (SCM x), "")
|
SCM_DEFINE (scm_cddr, "cddr", 1, 0, 0, (SCM x), "")
|
||||||
{
|
{
|
||||||
CHASE_PAIRS (x, "cddr", 0x0a); /* 00001010 */
|
CHASE_PAIRS (x, "cddr", 0x0a); /* 00001010 */
|
||||||
|
@ -270,6 +250,9 @@ void
|
||||||
scm_init_pairs ()
|
scm_init_pairs ()
|
||||||
{
|
{
|
||||||
#include "libguile/pairs.x"
|
#include "libguile/pairs.x"
|
||||||
|
scm_c_define_gsubr ("cons", 2, 0, 0, scm_cons);
|
||||||
|
scm_c_define_gsubr ("car", 1, 0, 0, scm_car);
|
||||||
|
scm_c_define_gsubr ("cdr", 1, 0, 0, scm_cdr);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
|
@ -3,7 +3,7 @@
|
||||||
#ifndef SCM_PAIRS_H
|
#ifndef SCM_PAIRS_H
|
||||||
#define SCM_PAIRS_H
|
#define SCM_PAIRS_H
|
||||||
|
|
||||||
/* Copyright (C) 1995,1996,2000,2001, 2004, 2006, 2008, 2009, 2010 Free Software Foundation, Inc.
|
/* Copyright (C) 1995,1996,2000,2001, 2004, 2006, 2008, 2009, 2010, 2012 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
|
||||||
|
@ -25,6 +25,8 @@
|
||||||
|
|
||||||
#include "libguile/__scm.h"
|
#include "libguile/__scm.h"
|
||||||
|
|
||||||
|
#include "libguile/gc.h"
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
#if (SCM_DEBUG_PAIR_ACCESSES == 1)
|
#if (SCM_DEBUG_PAIR_ACCESSES == 1)
|
||||||
|
@ -115,11 +117,67 @@
|
||||||
SCM_API void scm_error_pair_access (SCM);
|
SCM_API void scm_error_pair_access (SCM);
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
SCM_API SCM scm_cons (SCM x, SCM y);
|
SCM_INLINE int scm_is_pair (SCM x);
|
||||||
|
SCM_INLINE SCM scm_cons (SCM x, SCM y);
|
||||||
|
SCM_INLINE SCM scm_car (SCM x);
|
||||||
|
SCM_INLINE SCM scm_cdr (SCM x);
|
||||||
|
|
||||||
|
#if SCM_CAN_INLINE || defined SCM_INLINE_C_IMPLEMENTING_INLINES
|
||||||
|
/* Return a newly allocated pair whose car is @var{x} and whose cdr is
|
||||||
|
@var{y}. The pair is guaranteed to be different (in the sense of
|
||||||
|
@code{eq?}) from every previously existing object. */
|
||||||
|
SCM_INLINE_IMPLEMENTATION SCM
|
||||||
|
scm_cons (SCM x, SCM y)
|
||||||
|
{
|
||||||
|
return scm_cell (SCM_UNPACK (x), SCM_UNPACK (y));
|
||||||
|
}
|
||||||
|
|
||||||
|
SCM_INLINE_IMPLEMENTATION int
|
||||||
|
scm_is_pair (SCM x)
|
||||||
|
{
|
||||||
|
/* The following "workaround_for_gcc_295" avoids bad code generated by
|
||||||
|
i386 gcc 2.95.4 (the Debian packaged 2.95.4-24 at least).
|
||||||
|
|
||||||
|
Under the default -O2 the inlined SCM_I_CONSP test gets "optimized" so
|
||||||
|
the fetch of the tag word from x is done before confirming it's a
|
||||||
|
non-immediate (SCM_NIMP). Needless to say that bombs badly if x is a
|
||||||
|
immediate. This was seen to afflict scm_srfi1_split_at and something
|
||||||
|
deep in the bowels of ceval(). In both cases segvs resulted from
|
||||||
|
deferencing a random immediate value. srfi-1.test exposes the problem
|
||||||
|
through a short list, the immediate being SCM_EOL in that case.
|
||||||
|
Something in syntax.test exposed the ceval() problem.
|
||||||
|
|
||||||
|
Just "volatile SCM workaround_for_gcc_295 = lst" is enough to avoid the
|
||||||
|
problem, without even using that variable. The "w=w" is just to
|
||||||
|
prevent a warning about it being unused.
|
||||||
|
*/
|
||||||
|
#if defined (__GNUC__) && __GNUC__ == 2 && __GNUC_MINOR__ == 95
|
||||||
|
volatile SCM workaround_for_gcc_295 = x;
|
||||||
|
workaround_for_gcc_295 = workaround_for_gcc_295;
|
||||||
|
#endif
|
||||||
|
|
||||||
|
return SCM_I_CONSP (x);
|
||||||
|
}
|
||||||
|
|
||||||
|
SCM_INLINE_IMPLEMENTATION SCM
|
||||||
|
scm_car (SCM x)
|
||||||
|
{
|
||||||
|
if (SCM_UNLIKELY (!scm_is_pair (x)))
|
||||||
|
scm_wrong_type_arg_msg ("car", 0, x, "pair");
|
||||||
|
return SCM_CAR (x);
|
||||||
|
}
|
||||||
|
|
||||||
|
SCM_INLINE_IMPLEMENTATION SCM
|
||||||
|
scm_cdr (SCM x)
|
||||||
|
{
|
||||||
|
if (SCM_UNLIKELY (!scm_is_pair (x)))
|
||||||
|
scm_wrong_type_arg_msg ("cdr", 0, x, "pair");
|
||||||
|
return SCM_CDR (x);
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
SCM_API SCM scm_cons2 (SCM w, SCM x, SCM y);
|
SCM_API SCM scm_cons2 (SCM w, SCM x, SCM y);
|
||||||
SCM_API SCM scm_pair_p (SCM x);
|
SCM_API SCM scm_pair_p (SCM x);
|
||||||
SCM_API SCM scm_car (SCM x);
|
|
||||||
SCM_API SCM scm_cdr (SCM x);
|
|
||||||
SCM_API SCM scm_set_car_x (SCM pair, SCM value);
|
SCM_API SCM scm_set_car_x (SCM pair, SCM value);
|
||||||
SCM_API SCM scm_set_cdr_x (SCM pair, SCM value);
|
SCM_API SCM scm_set_cdr_x (SCM pair, SCM value);
|
||||||
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue