X-Git-Url: https://git.hcoop.net/bpt/guile.git/blobdiff_plain/bf6de59d5b491c9a11fd394fd3d09d7e9af40872..fbb857a472eb4e69c1cba05e86646b7004f32df6:/libguile/inline.h diff --git a/libguile/inline.h b/libguile/inline.h index 49f99a1da..09ee1429f 100644 --- a/libguile/inline.h +++ b/libguile/inline.h @@ -3,21 +3,22 @@ #ifndef SCM_INLINE_H #define SCM_INLINE_H -/* Copyright (C) 2001, 2002, 2003, 2004 Free Software Foundation, Inc. +/* Copyright (C) 2001, 2002, 2003, 2004, 2006, 2008 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 2.1 of the License, or (at your option) any later version. + * modify it under the terms of the GNU Lesser General Public License + * as published by the Free Software Foundation; either version 3 of + * the License, or (at your option) any later version. * - * This library is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of + * This library is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software - * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA + * 02110-1301 USA */ /* This file is for inline functions. On platforms that don't support @@ -25,27 +26,80 @@ "inline.c". */ -#include "libguile/__scm.h" - -#if (SCM_DEBUG_CELL_ACCESSES == 1) #include -#endif +#include + +#include "libguile/__scm.h" #include "libguile/pairs.h" #include "libguile/gc.h" #include "libguile/threads.h" #include "libguile/unif.h" +#include "libguile/ports.h" +#include "libguile/error.h" + + +#ifndef SCM_INLINE_C_INCLUDING_INLINE_H + +/* GCC has `__inline__' in all modes, including strict ansi. GCC 4.3 and + above with `-std=c99' or `-std=gnu99' implements ISO C99 inline semantics, + unless `-fgnu89-inline' is used. Here we want GNU "extern inline" + semantics, hence the `__gnu_inline__' attribute, in accordance with: + http://gcc.gnu.org/gcc-4.3/porting_to.html . + + With GCC 4.2, `__GNUC_STDC_INLINE__' is never defined (because C99 inline + semantics are not supported), but a warning is issued in C99 mode if + `__gnu_inline__' is not used. + + Apple's GCC build >5400 (since Xcode 3.0) doesn't support GNU inline in + C99 mode and doesn't define `__GNUC_STDC_INLINE__'. Fall back to "static + inline" in that case. */ + +# if (defined __GNUC__) && (!(((defined __APPLE_CC__) && (__APPLE_CC__ > 5400)) && __STDC_VERSION__ >= 199901L)) +# define SCM_C_USE_EXTERN_INLINE 1 +# if (defined __GNUC_STDC_INLINE__) || (__GNUC__ == 4 && __GNUC_MINOR__ == 2) +# define SCM_C_EXTERN_INLINE \ + extern __inline__ __attribute__ ((__gnu_inline__)) +# else +# define SCM_C_EXTERN_INLINE extern __inline__ +# endif +# elif (defined SCM_C_INLINE) +# define SCM_C_EXTERN_INLINE static SCM_C_INLINE +# endif + +#endif /* SCM_INLINE_C_INCLUDING_INLINE_H */ + + +#if (!defined SCM_C_INLINE) || (defined SCM_INLINE_C_INCLUDING_INLINE_H) \ + || (defined SCM_C_USE_EXTERN_INLINE) + +/* The `extern' declarations. They should only appear when used from + "inline.c", when `inline' is not supported at all or when "extern inline" + is used. */ + +#include "libguile/boehm-gc.h" SCM_API SCM scm_cell (scm_t_bits car, scm_t_bits cdr); +SCM_API SCM scm_immutable_cell (scm_t_bits car, scm_t_bits cdr); SCM_API SCM scm_double_cell (scm_t_bits car, scm_t_bits cbr, scm_t_bits ccr, scm_t_bits cdr); +SCM_API SCM scm_immutable_double_cell (scm_t_bits car, scm_t_bits cbr, + scm_t_bits ccr, scm_t_bits cdr); SCM_API SCM scm_array_handle_ref (scm_t_array_handle *h, ssize_t pos); SCM_API void scm_array_handle_set (scm_t_array_handle *h, ssize_t pos, SCM val); +SCM_API int scm_is_pair (SCM x); + +SCM_API int scm_getc (SCM port); +SCM_API void scm_putc (char c, SCM port); +SCM_API void scm_puts (const char *str_data, SCM port); -#if defined SCM_C_INLINE || defined SCM_INLINE_C_INCLUDING_INLINE_H +#endif + + +#if defined SCM_C_EXTERN_INLINE || defined SCM_INLINE_C_INCLUDING_INLINE_H /* either inlining, or being included from inline.c. We use (and repeat) this long #if test here and below so that we don't have to introduce any extraneous symbols into the public namespace. We @@ -54,168 +108,110 @@ SCM_API void scm_array_handle_set (scm_t_array_handle *h, ssize_t pos, SCM val); extern unsigned scm_newcell2_count; extern unsigned scm_newcell_count; -#if defined SCM_C_INLINE && ! defined SCM_INLINE_C_INCLUDING_INLINE_H -/* definitely inlining */ -#ifdef __GNUC__ -extern -#else -static -#endif -SCM_C_INLINE + +#ifndef SCM_INLINE_C_INCLUDING_INLINE_H +SCM_C_EXTERN_INLINE #endif + SCM scm_cell (scm_t_bits car, scm_t_bits cdr) { - SCM z; - SCM *freelist = SCM_FREELIST_LOC (scm_i_freelist); + SCM cell = SCM_PACK ((scm_t_bits) (GC_MALLOC (sizeof (scm_t_cell)))); - if (scm_gc_running_p) - { - abort(); - } - - if (scm_is_null (*freelist)) - z = scm_gc_for_newcell (&scm_i_master_freelist, freelist); - else - { - z = *freelist; - *freelist = SCM_FREE_CELL_CDR (*freelist); - } + /* Initialize the type slot last so that the cell is ignored by the GC + until it is completely initialized. This is only relevant when the GC + can actually run during this code, which it can't since the GC only runs + when all other threads are stopped. */ + SCM_GC_SET_CELL_WORD (cell, 1, cdr); + SCM_GC_SET_CELL_WORD (cell, 0, car); - /* - We update scm_cells_allocated from this function. If we don't - update this explicitly, we will have to walk a freelist somewhere - later on, which seems a lot more expensive. - */ - scm_cells_allocated += 1; - -#if (SCM_DEBUG_CELL_ACCESSES == 1) - if (scm_debug_cell_accesses_p) - { - if (SCM_GC_MARK_P (z)) - { - fprintf(stderr, "scm_cell tried to allocate a marked cell.\n"); - abort(); - } - else if (SCM_GC_CELL_WORD(z, 0) != scm_tc_free_cell) - { - fprintf(stderr, "cell from freelist is not a free cell.\n"); - abort(); - } - } - - /* - Always set mark. Otherwise cells that are alloced before - scm_debug_cell_accesses_p is toggled seem invalid. - */ - SCM_SET_GC_MARK (z); - - /* - TODO: figure out if this use of mark bits is valid with - threading. What if another thread is doing GC at this point - ... ? - */ - + return cell; +} + +#ifndef SCM_INLINE_C_INCLUDING_INLINE_H +SCM_C_EXTERN_INLINE #endif +SCM +scm_immutable_cell (scm_t_bits car, scm_t_bits cdr) +{ + SCM cell = SCM_PACK ((scm_t_bits) (GC_MALLOC_STUBBORN (sizeof (scm_t_cell)))); - - /* Initialize the type slot last so that the cell is ignored by the - GC until it is completely initialized. This is only relevant - when the GC can actually run during this code, which it can't for - cooperating threads, but it might be important when we get true - preemptive threads. - */ - SCM_GC_SET_CELL_WORD (z, 1, cdr); - SCM_GC_SET_CELL_WORD (z, 0, car); + /* Initialize the type slot last so that the cell is ignored by the GC + until it is completely initialized. This is only relevant when the GC + can actually run during this code, which it can't since the GC only runs + when all other threads are stopped. */ + SCM_GC_SET_CELL_WORD (cell, 1, cdr); + SCM_GC_SET_CELL_WORD (cell, 0, car); -#if 0 /*fixme* Hmm... let's consider this later. */ -#if !defined(SCM_USE_COOP_THREADS) && !defined(SCM_USE_NULL_THREADS) && !defined(SCM_USE_COPT_THREADS) - /* When we are using preemtive threads, we might need to make - sure that the initial values for the slots are protected until - the cell is completely initialized. - */ -#error review me - scm_remember_upto_here_1 (SCM_PACK (cdr)); -#endif -#endif + GC_END_STUBBORN_CHANGE ((void *) cell); -#if (SCM_DEBUG_CELL_ACCESSES == 1) - if (scm_expensive_debug_cell_accesses_p ) - scm_i_expensive_validation_check (z); -#endif - - return z; + return cell; } -#if defined SCM_C_INLINE && ! defined SCM_INLINE_C_INCLUDING_INLINE_H -/* definitely inlining */ -#ifdef __GNUC__ -extern -#else -static -#endif -SCM_C_INLINE +#ifndef SCM_INLINE_C_INCLUDING_INLINE_H +SCM_C_EXTERN_INLINE #endif SCM scm_double_cell (scm_t_bits car, scm_t_bits cbr, scm_t_bits ccr, scm_t_bits cdr) { SCM z; - SCM *freelist = SCM_FREELIST_LOC (scm_i_freelist2); - - if (scm_gc_running_p) - { - abort(); - } - - if (scm_is_null (*freelist)) - z = scm_gc_for_newcell (&scm_i_master_freelist2, freelist); - else - { - z = *freelist; - *freelist = SCM_FREE_CELL_CDR (*freelist); - } - - scm_cells_allocated += 2; + z = SCM_PACK ((scm_t_bits) (GC_MALLOC (2 * sizeof (scm_t_cell)))); /* Initialize the type slot last so that the cell is ignored by the GC until it is completely initialized. This is only relevant - when the GC can actually run during this code, which it can't for - cooperating threads, but it might be important when we get true - preemptive threads. + when the GC can actually run during this code, which it can't + since the GC only runs when all other threads are stopped. */ SCM_GC_SET_CELL_WORD (z, 1, cbr); SCM_GC_SET_CELL_WORD (z, 2, ccr); SCM_GC_SET_CELL_WORD (z, 3, cdr); SCM_GC_SET_CELL_WORD (z, 0, car); -#if 0 /*fixme* Hmm... let's consider this later. */ -#if !defined(SCM_USE_COOP_THREADS) && !defined(SCM_USE_NULL_THREADS) && !defined(SCM_USE_COPT_THREADS) - /* When we are using non-cooperating threads, we might need to make - sure that the initial values for the slots are protected until - the cell is completely initialized. - */ -#error review me - scm_remember_upto_here_3 (SCM_PACK (cbr), SCM_PACK (ccr), SCM_PACK (cdr)); -#endif + /* When this function is inlined, it's possible that the last + SCM_GC_SET_CELL_WORD above will be adjacent to a following + initialization of z. E.g., it occurred in scm_make_real. GCC + from around version 3 (e.g., certainly 3.2) began taking + advantage of strict C aliasing rules which say that it's OK to + interchange the initialization above and the one below when the + pointer types appear to differ sufficiently. We don't want that, + of course. GCC allows this behaviour to be disabled with the + -fno-strict-aliasing option, but would also need to be supplied + by Guile users. Instead, the following statements prevent the + reordering. + */ +#ifdef __GNUC__ + __asm__ volatile ("" : : : "memory"); +#else + /* portable version, just in case any other compiler does the same + thing. */ + scm_remember_upto_here_1 (z); #endif + return z; +} -#if (SCM_DEBUG_CELL_ACCESSES == 1) - if (scm_debug_cell_accesses_p) - { - if (SCM_GC_MARK_P (z)) - { - fprintf(stderr, - "scm_double_cell tried to allocate a marked cell.\n"); - abort(); - } - } +#ifndef SCM_INLINE_C_INCLUDING_INLINE_H +SCM_C_EXTERN_INLINE +#endif +SCM +scm_immutable_double_cell (scm_t_bits car, scm_t_bits cbr, + scm_t_bits ccr, scm_t_bits cdr) +{ + SCM z; - /* see above. */ - SCM_SET_GC_MARK (z); + z = SCM_PACK ((scm_t_bits) (GC_MALLOC_STUBBORN (2 * sizeof (scm_t_cell)))); + /* Initialize the type slot last so that the cell is ignored by the + GC until it is completely initialized. This is only relevant + when the GC can actually run during this code, which it can't + since the GC only runs when all other threads are stopped. + */ + SCM_GC_SET_CELL_WORD (z, 1, cbr); + SCM_GC_SET_CELL_WORD (z, 2, ccr); + SCM_GC_SET_CELL_WORD (z, 3, cdr); + SCM_GC_SET_CELL_WORD (z, 0, car); -#endif + GC_END_STUBBORN_CHANGE ((void *) z); /* When this function is inlined, it's possible that the last SCM_GC_SET_CELL_WORD above will be adjacent to a following @@ -230,7 +226,7 @@ scm_double_cell (scm_t_bits car, scm_t_bits cbr, reordering. */ #ifdef __GNUC__ - asm volatile ("" : : : "memory"); + __asm__ volatile ("" : : : "memory"); #else /* portable version, just in case any other compiler does the same thing. */ @@ -240,14 +236,8 @@ scm_double_cell (scm_t_bits car, scm_t_bits cbr, return z; } -#if defined SCM_C_INLINE && ! defined SCM_INLINE_C_INCLUDING_INLINE_H -/* definitely inlining */ -#ifdef __GNUC__ -extern -#else -static -#endif -SCM_C_INLINE +#ifndef SCM_INLINE_C_INCLUDING_INLINE_H +SCM_C_EXTERN_INLINE #endif SCM scm_array_handle_ref (scm_t_array_handle *h, ssize_t p) @@ -255,14 +245,8 @@ scm_array_handle_ref (scm_t_array_handle *h, ssize_t p) return h->ref (h, p); } -#if defined SCM_C_INLINE && ! defined SCM_INLINE_C_INCLUDING_INLINE_H -/* definitely inlining */ -#ifdef __GNUC__ -extern -#else -static -#endif -SCM_C_INLINE +#ifndef SCM_INLINE_C_INCLUDING_INLINE_H +SCM_C_EXTERN_INLINE #endif void scm_array_handle_set (scm_t_array_handle *h, ssize_t p, SCM v) @@ -270,5 +254,107 @@ scm_array_handle_set (scm_t_array_handle *h, ssize_t p, SCM v) h->set (h, p, v); } +#ifndef SCM_INLINE_C_INCLUDING_INLINE_H +SCM_C_EXTERN_INLINE +#endif +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); +} + + +/* Port I/O. */ + +#ifndef SCM_INLINE_C_INCLUDING_INLINE_H +SCM_C_EXTERN_INLINE +#endif +int +scm_getc (SCM port) +{ + int c; + scm_t_port *pt = SCM_PTAB_ENTRY (port); + + if (pt->rw_active == SCM_PORT_WRITE) + /* may be marginally faster than calling scm_flush. */ + scm_ptobs[SCM_PTOBNUM (port)].flush (port); + + if (pt->rw_random) + pt->rw_active = SCM_PORT_READ; + + if (pt->read_pos >= pt->read_end) + { + if (scm_fill_input (port) == EOF) + return EOF; + } + + c = *(pt->read_pos++); + + switch (c) + { + case '\a': + break; + case '\b': + SCM_DECCOL (port); + break; + case '\n': + SCM_INCLINE (port); + break; + case '\r': + SCM_ZEROCOL (port); + break; + case '\t': + SCM_TABCOL (port); + break; + default: + SCM_INCCOL (port); + break; + } + + return c; +} + +#ifndef SCM_INLINE_C_INCLUDING_INLINE_H +SCM_C_EXTERN_INLINE +#endif +void +scm_putc (char c, SCM port) +{ + SCM_ASSERT_TYPE (SCM_OPOUTPORTP (port), port, 0, NULL, "output port"); + scm_lfwrite (&c, 1, port); +} + +#ifndef SCM_INLINE_C_INCLUDING_INLINE_H +SCM_C_EXTERN_INLINE +#endif +void +scm_puts (const char *s, SCM port) +{ + SCM_ASSERT_TYPE (SCM_OPOUTPORTP (port), port, 0, NULL, "output port"); + scm_lfwrite (s, strlen (s), port); +} + + #endif #endif