libguile/inline.h

   1 /* classes: h_files */
   2
   3 #ifndef SCM_INLINE_H
   4 #define SCM_INLINE_H
   5
   6 /* Copyright (C) 2001, 2002, 2003, 2004, 2006 Free Software Foundation, Inc.
   7  *
   8  * This library is free software; you can redistribute it and/or
   9  * modify it under the terms of the GNU Lesser General Public
  10  * License as published by the Free Software Foundation; either
  11  * version 2.1 of the License, or (at your option) any later version.
  12  *
  13  * This library is distributed in the hope that it will be useful,
  14  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  15  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16  * Lesser General Public License for more details.
  17  *
  18  * You should have received a copy of the GNU Lesser General Public
  19  * License along with this library; if not, write to the Free Software
  20  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  21  */
  22
  23 /* This file is for inline functions.  On platforms that don't support
  24    inlining functions, they are turned into ordinary functions.  See
  25    "inline.c".
  26 */
  27
  28 #include "libguile/__scm.h"
  29
  30 #if (SCM_DEBUG_CELL_ACCESSES == 1)
  31 #include <stdio.h>
  32 #endif
  33
  34 #include "libguile/pairs.h"
  35 #include "libguile/gc.h"
  36 #include "libguile/threads.h"
  37 #include "libguile/unif.h"
  38 #include "libguile/pairs.h"
  39
  40
  41 #include "libguile/boehm-gc.h"
  42
  43
  44 SCM_API SCM scm_cell (scm_t_bits car, scm_t_bits cdr);
  45 SCM_API SCM scm_double_cell (scm_t_bits car, scm_t_bits cbr,
  46                              scm_t_bits ccr, scm_t_bits cdr);
  47
  48 SCM_API SCM scm_array_handle_ref (scm_t_array_handle *h, ssize_t pos);
  49 SCM_API void scm_array_handle_set (scm_t_array_handle *h, ssize_t pos, SCM val);
  50
  51
  52 #if defined SCM_C_INLINE || defined SCM_INLINE_C_INCLUDING_INLINE_H
  53 /* either inlining, or being included from inline.c.  We use (and
  54    repeat) this long #if test here and below so that we don't have to
  55    introduce any extraneous symbols into the public namespace.  We
  56    only need SCM_C_INLINE to be seen publically . */
  57
  58 extern unsigned scm_newcell2_count;
  59 extern unsigned scm_newcell_count;
  60
  61 #if defined SCM_C_INLINE && ! defined SCM_INLINE_C_INCLUDING_INLINE_H
  62 /* definitely inlining */
  63 #ifdef __GNUC__
  64 extern
  65 #else
  66 static
  67 #endif
  68 SCM_C_INLINE
  69 #endif
  70
  71 SCM
  72 scm_cell (scm_t_bits car, scm_t_bits cdr)
  73 {
  74   SCM cell = SCM_PACK ((scm_t_bits) (GC_MALLOC (sizeof (scm_t_cell))));
  75
  76   /* Initialize the type slot last so that the cell is ignored by the GC
  77      until it is completely initialized.  This is only relevant when the GC
  78      can actually run during this code, which it can't since the GC only runs
  79      when all other threads are stopped.  */
  80   SCM_GC_SET_CELL_WORD (cell, 1, cdr);
  81   SCM_GC_SET_CELL_WORD (cell, 0, car);
  82
  83   return cell;
  84 }
  85
  86 #if defined SCM_C_INLINE && ! defined SCM_INLINE_C_INCLUDING_INLINE_H
  87 /* definitely inlining */
  88 #ifdef __GNUC__
  89 extern
  90 #else
  91 static
  92 #endif
  93 SCM_C_INLINE
  94 #endif
  95 SCM
  96 scm_double_cell (scm_t_bits car, scm_t_bits cbr,
  97                  scm_t_bits ccr, scm_t_bits cdr)
  98 {
  99   SCM z;
 100
 101   z = SCM_PACK ((scm_t_bits) (GC_MALLOC (2 * sizeof (scm_t_cell))));
 102   /* Initialize the type slot last so that the cell is ignored by the
 103      GC until it is completely initialized.  This is only relevant
 104      when the GC can actually run during this code, which it can't
 105      since the GC only runs when all other threads are stopped.
 106   */
 107   SCM_GC_SET_CELL_WORD (z, 1, cbr);
 108   SCM_GC_SET_CELL_WORD (z, 2, ccr);
 109   SCM_GC_SET_CELL_WORD (z, 3, cdr);
 110   SCM_GC_SET_CELL_WORD (z, 0, car);
 111
 112   /* When this function is inlined, it's possible that the last
 113      SCM_GC_SET_CELL_WORD above will be adjacent to a following
 114      initialization of z.  E.g., it occurred in scm_make_real.  GCC
 115      from around version 3 (e.g., certainly 3.2) began taking
 116      advantage of strict C aliasing rules which say that it's OK to
 117      interchange the initialization above and the one below when the
 118      pointer types appear to differ sufficiently.  We don't want that,
 119      of course.  GCC allows this behaviour to be disabled with the
 120      -fno-strict-aliasing option, but would also need to be supplied
 121      by Guile users.  Instead, the following statements prevent the
 122      reordering.
 123    */
 124 #ifdef __GNUC__
 125   __asm__ volatile ("" : : : "memory");
 126 #else
 127   /* portable version, just in case any other compiler does the same
 128      thing.  */
 129   scm_remember_upto_here_1 (z);
 130 #endif
 131
 132   return z;
 133 }
 134
 135 #if defined SCM_C_INLINE && ! defined SCM_INLINE_C_INCLUDING_INLINE_H
 136 /* definitely inlining */
 137 #ifdef __GNUC__
 138 extern
 139 #else
 140 static
 141 #endif
 142 SCM_C_INLINE
 143 #endif
 144 SCM
 145 scm_array_handle_ref (scm_t_array_handle *h, ssize_t p)
 146 {
 147   return h->ref (h, p);
 148 }
 149
 150 #if defined SCM_C_INLINE && ! defined SCM_INLINE_C_INCLUDING_INLINE_H
 151 /* definitely inlining */
 152 #ifdef __GNUC__
 153 extern
 154 #else
 155 static
 156 #endif
 157 SCM_C_INLINE
 158 #endif
 159 void
 160 scm_array_handle_set (scm_t_array_handle *h, ssize_t p, SCM v)
 161 {
 162   h->set (h, p, v);
 163 }
 164
 165 #if defined SCM_C_INLINE && ! defined SCM_INLINE_C_INCLUDING_INLINE_H
 166 /* definitely inlining */
 167 #ifdef __GNUC__
 168 extern
 169 #else
 170 static
 171 #endif
 172 SCM_C_INLINE
 173 #endif
 174 int
 175 scm_is_pair (SCM x)
 176 {
 177   /* The following "workaround_for_gcc_295" avoids bad code generated by
 178      i386 gcc 2.95.4 (the Debian packaged 2.95.4-24 at least).
 179
 180      Under the default -O2 the inlined SCM_I_CONSP test gets "optimized" so
 181      the fetch of the tag word from x is done before confirming it's a
 182      non-immediate (SCM_NIMP).  Needless to say that bombs badly if x is a
 183      immediate.  This was seen to afflict scm_srfi1_split_at and something
 184      deep in the bowels of ceval().  In both cases segvs resulted from
 185      deferencing a random immediate value.  srfi-1.test exposes the problem
 186      through a short list, the immediate being SCM_EOL in that case.
 187      Something in syntax.test exposed the ceval() problem.
 188
 189      Just "volatile SCM workaround_for_gcc_295 = lst" is enough to avoid the
 190      problem, without even using that variable.  The "w=w" is just to
 191      prevent a warning about it being unused.
 192      */
 193 #if defined (__GNUC__) && __GNUC__ == 2 && __GNUC_MINOR__ == 95
 194   volatile SCM workaround_for_gcc_295 = x;
 195   workaround_for_gcc_295 = workaround_for_gcc_295;
 196 #endif
 197
 198   return SCM_I_CONSP (x);
 199 }
 200
 201 #endif
 202 #endif