X-Git-Url: https://git.hcoop.net/bpt/guile.git/blobdiff_plain/3d7f708f21b109277018e776ec3754975696e390..fbb857a472eb4e69c1cba05e86646b7004f32df6:/libguile/inline.h diff --git a/libguile/inline.h b/libguile/inline.h dissimilarity index 67% index 419c9f0bc..09ee1429f 100644 --- a/libguile/inline.h +++ b/libguile/inline.h @@ -1,240 +1,360 @@ -/* classes: h_files */ - -#ifndef SCM_INLINE_H -#define SCM_INLINE_H - -/* Copyright (C) 2001, 2002 Free Software Foundation, Inc. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2, or (at your option) - * any later version. - * - * This program 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 General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this software; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 59 Temple Place, Suite 330, - * Boston, MA 02111-1307 USA - * - * As a special exception, the Free Software Foundation gives permission - * for additional uses of the text contained in its release of GUILE. - * - * The exception is that, if you link the GUILE library with other files - * to produce an executable, this does not by itself cause the - * resulting executable to be covered by the GNU General Public License. - * Your use of that executable is in no way restricted on account of - * linking the GUILE library code into it. - * - * This exception does not however invalidate any other reasons why - * the executable file might be covered by the GNU General Public License. - * - * This exception applies only to the code released by the - * Free Software Foundation under the name GUILE. If you copy - * code from other Free Software Foundation releases into a copy of - * GUILE, as the General Public License permits, the exception does - * not apply to the code that you add in this way. To avoid misleading - * anyone as to the status of such modified files, you must delete - * this exception notice from them. - * - * If you write modifications of your own for GUILE, it is your choice - * whether to permit this exception to apply to your modifications. - * If you do not wish that, delete this exception notice. */ - -/* This file is for inline functions. On platforms that don't support - inlining functions, they are turned into ordinary functions. See - "inline.c". -*/ - - -#if (SCM_DEBUG_CELL_ACCESSES == 1) -#include - -#endif - -#include "libguile/pairs.h" -#include "libguile/gc.h" - - -SCM_API SCM scm_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); - -#ifdef HAVE_INLINE - -#ifndef EXTERN_INLINE -#define EXTERN_INLINE extern inline -#endif - -extern unsigned scm_newcell2_count; -extern unsigned scm_newcell_count; - - - -EXTERN_INLINE -SCM -scm_cell (scm_t_bits car, scm_t_bits cdr) -{ - SCM z; - - if (SCM_NULLP (scm_i_freelist)) - { - z = scm_gc_for_newcell (&scm_i_master_freelist, &scm_i_freelist); - } - else - { - z = scm_i_freelist; - scm_i_freelist = SCM_FREE_CELL_CDR (scm_i_freelist); - } - - /* - 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_TYPE(z) != 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 - ... ? - */ - -#endif - - - /* 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); - -#if !defined(USE_COOP_THREADS) && !defined(USE_NULL_THREADS) && !defined(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 - - -#if (SCM_DEBUG_CELL_ACCESSES == 1) - if (scm_expensive_debug_cell_accesses_p ) - scm_i_expensive_validation_check (z); -#endif - - return z; -} - -EXTERN_INLINE -SCM -scm_double_cell (scm_t_bits car, scm_t_bits cbr, - scm_t_bits ccr, scm_t_bits cdr) -{ - SCM z; - - - if (SCM_NULLP (scm_i_freelist2)) - { - z = scm_gc_for_newcell (&scm_i_master_freelist2, &scm_i_freelist2); - } - else - { - z = scm_i_freelist2; - scm_i_freelist2 = SCM_FREE_CELL_CDR (scm_i_freelist2); - } - - scm_cells_allocated += 2; - - /* 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, 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 !defined(USE_COOP_THREADS) && !defined(USE_NULL_THREADS) && !defined(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 - - -#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(); - } - } - - /* see above. */ - SCM_SET_GC_MARK (z); - -#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; -} - - - -#endif -#endif +/* classes: h_files */ + +#ifndef SCM_INLINE_H +#define SCM_INLINE_H + +/* 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 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 + * 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., 51 Franklin Street, Fifth Floor, Boston, MA + * 02110-1301 USA + */ + +/* This file is for inline functions. On platforms that don't support + inlining functions, they are turned into ordinary functions. See + "inline.c". +*/ + +#include +#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); + +#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 + only need SCM_C_INLINE to be seen publically . */ + +extern unsigned scm_newcell2_count; +extern unsigned scm_newcell_count; + + +#ifndef SCM_INLINE_C_INCLUDING_INLINE_H +SCM_C_EXTERN_INLINE +#endif + +SCM +scm_cell (scm_t_bits car, scm_t_bits cdr) +{ + SCM cell = SCM_PACK ((scm_t_bits) (GC_MALLOC (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 (cell, 1, cdr); + SCM_GC_SET_CELL_WORD (cell, 0, car); + + 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 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); + + GC_END_STUBBORN_CHANGE ((void *) cell); + + return cell; +} + +#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; + + 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 + 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); + + /* 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; +} + +#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; + + 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); + + 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 + 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; +} + +#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) +{ + return h->ref (h, p); +} + +#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) +{ + 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