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, 2008, 2009 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 License
  10  * as published by the Free Software Foundation; either version 3 of
  11  * the License, or (at your option) any later version.
  12  *
  13  * This library is distributed in the hope that it will be useful, but
  14  * 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
  21  * 02110-1301 USA
  22  */
  23
  24 /* This file is for inline functions.  On platforms that don't support
  25    inlining functions, they are turned into ordinary functions.  See
  26    "inline.c".
  27 */
  28
  29 #include <stdio.h>
  30 #include <string.h>
  31
  32 #include "libguile/__scm.h"
  33
  34 #include "libguile/pairs.h"
  35 #include "libguile/gc.h"
  36 #include "libguile/threads.h"
  37 #include "libguile/array-handle.h"
  38 #include "libguile/ports.h"
  39 #include "libguile/numbers.h"
  40 #include "libguile/error.h"
  41
  42
  43 #ifndef SCM_INLINE_C_INCLUDING_INLINE_H
  44
  45 /* GCC has `__inline__' in all modes, including strict ansi.  GCC 4.3 and
  46    above with `-std=c99' or `-std=gnu99' implements ISO C99 inline semantics,
  47    unless `-fgnu89-inline' is used.  Here we want GNU "extern inline"
  48    semantics, hence the `__gnu_inline__' attribute, in accordance with:
  49    http://gcc.gnu.org/gcc-4.3/porting_to.html .
  50
  51    With GCC 4.2, `__GNUC_STDC_INLINE__' is never defined (because C99 inline
  52    semantics are not supported), but a warning is issued in C99 mode if
  53    `__gnu_inline__' is not used.
  54
  55    Apple's GCC build >5400 (since Xcode 3.0) doesn't support GNU inline in
  56    C99 mode and doesn't define `__GNUC_STDC_INLINE__'.  Fall back to "static
  57    inline" in that case.  */
  58
  59 # if (defined __GNUC__) && (!(((defined __APPLE_CC__) && (__APPLE_CC__ > 5400)) && __STDC_VERSION__ >= 199901L))
  60 #  define SCM_C_USE_EXTERN_INLINE 1
  61 #  if (defined __GNUC_STDC_INLINE__) || (__GNUC__ == 4 && __GNUC_MINOR__ == 2)
  62 #   define SCM_C_EXTERN_INLINE                                  \
  63            extern __inline__ __attribute__ ((__gnu_inline__))
  64 #  else
  65 #   define SCM_C_EXTERN_INLINE extern __inline__
  66 #  endif
  67 # elif (defined SCM_C_INLINE)
  68 #  define SCM_C_EXTERN_INLINE static SCM_C_INLINE
  69 # endif
  70
  71 #endif /* SCM_INLINE_C_INCLUDING_INLINE_H */
  72
  73
  74 #if (!defined SCM_C_INLINE) || (defined SCM_INLINE_C_INCLUDING_INLINE_H) \
  75     || (defined SCM_C_USE_EXTERN_INLINE)
  76
  77 /* The `extern' declarations.  They should only appear when used from
  78    "inline.c", when `inline' is not supported at all or when "extern inline"
  79    is used.  */
  80
  81 #include "libguile/boehm-gc.h"
  82
  83
  84 SCM_API SCM scm_cell (scm_t_bits car, scm_t_bits cdr);
  85 SCM_API SCM scm_immutable_cell (scm_t_bits car, scm_t_bits cdr);
  86 SCM_API SCM scm_double_cell (scm_t_bits car, scm_t_bits cbr,
  87                              scm_t_bits ccr, scm_t_bits cdr);
  88 SCM_API SCM scm_immutable_double_cell (scm_t_bits car, scm_t_bits cbr,
  89                                        scm_t_bits ccr, scm_t_bits cdr);
  90
  91 SCM_API SCM scm_array_handle_ref (scm_t_array_handle *h, ssize_t pos);
  92 SCM_API void scm_array_handle_set (scm_t_array_handle *h, ssize_t pos, SCM val);
  93
  94 SCM_API int scm_is_pair (SCM x);
  95
  96 SCM_API int scm_get_byte_or_eof (SCM port);
  97 SCM_API void scm_putc (char c, SCM port);
  98 SCM_API void scm_puts (const char *str_data, SCM port);
  99
 100 #endif
 101
 102
 103 #if defined SCM_C_EXTERN_INLINE || defined SCM_INLINE_C_INCLUDING_INLINE_H
 104 /* either inlining, or being included from inline.c.  We use (and
 105    repeat) this long #if test here and below so that we don't have to
 106    introduce any extraneous symbols into the public namespace.  We
 107    only need SCM_C_INLINE to be seen publically . */
 108
 109 extern unsigned scm_newcell2_count;
 110 extern unsigned scm_newcell_count;
 111
 112
 113 #ifndef SCM_INLINE_C_INCLUDING_INLINE_H
 114 SCM_C_EXTERN_INLINE
 115 #endif
 116
 117 SCM
 118 scm_cell (scm_t_bits car, scm_t_bits cdr)
 119 {
 120   SCM cell = SCM_PACK ((scm_t_bits) (GC_MALLOC (sizeof (scm_t_cell))));
 121
 122   /* Initialize the type slot last so that the cell is ignored by the GC
 123      until it is completely initialized.  This is only relevant when the GC
 124      can actually run during this code, which it can't since the GC only runs
 125      when all other threads are stopped.  */
 126   SCM_GC_SET_CELL_WORD (cell, 1, cdr);
 127   SCM_GC_SET_CELL_WORD (cell, 0, car);
 128
 129   return cell;
 130 }
 131
 132 #ifndef SCM_INLINE_C_INCLUDING_INLINE_H
 133 SCM_C_EXTERN_INLINE
 134 #endif
 135 SCM
 136 scm_immutable_cell (scm_t_bits car, scm_t_bits cdr)
 137 {
 138   SCM cell = SCM_PACK ((scm_t_bits) (GC_MALLOC_STUBBORN (sizeof (scm_t_cell))));
 139
 140   /* Initialize the type slot last so that the cell is ignored by the GC
 141      until it is completely initialized.  This is only relevant when the GC
 142      can actually run during this code, which it can't since the GC only runs
 143      when all other threads are stopped.  */
 144   SCM_GC_SET_CELL_WORD (cell, 1, cdr);
 145   SCM_GC_SET_CELL_WORD (cell, 0, car);
 146
 147   GC_END_STUBBORN_CHANGE ((void *) cell);
 148
 149   return cell;
 150 }
 151
 152 #ifndef SCM_INLINE_C_INCLUDING_INLINE_H
 153 SCM_C_EXTERN_INLINE
 154 #endif
 155 SCM
 156 scm_double_cell (scm_t_bits car, scm_t_bits cbr,
 157                  scm_t_bits ccr, scm_t_bits cdr)
 158 {
 159   SCM z;
 160
 161   z = SCM_PACK ((scm_t_bits) (GC_MALLOC (2 * sizeof (scm_t_cell))));
 162   /* Initialize the type slot last so that the cell is ignored by the
 163      GC until it is completely initialized.  This is only relevant
 164      when the GC can actually run during this code, which it can't
 165      since the GC only runs when all other threads are stopped.
 166   */
 167   SCM_GC_SET_CELL_WORD (z, 1, cbr);
 168   SCM_GC_SET_CELL_WORD (z, 2, ccr);
 169   SCM_GC_SET_CELL_WORD (z, 3, cdr);
 170   SCM_GC_SET_CELL_WORD (z, 0, car);
 171
 172   /* When this function is inlined, it's possible that the last
 173      SCM_GC_SET_CELL_WORD above will be adjacent to a following
 174      initialization of z.  E.g., it occurred in scm_make_real.  GCC
 175      from around version 3 (e.g., certainly 3.2) began taking
 176      advantage of strict C aliasing rules which say that it's OK to
 177      interchange the initialization above and the one below when the
 178      pointer types appear to differ sufficiently.  We don't want that,
 179      of course.  GCC allows this behaviour to be disabled with the
 180      -fno-strict-aliasing option, but would also need to be supplied
 181      by Guile users.  Instead, the following statements prevent the
 182      reordering.
 183    */
 184 #ifdef __GNUC__
 185   __asm__ volatile ("" : : : "memory");
 186 #else
 187   /* portable version, just in case any other compiler does the same
 188      thing.  */
 189   scm_remember_upto_here_1 (z);
 190 #endif
 191
 192   return z;
 193 }
 194
 195 #ifndef SCM_INLINE_C_INCLUDING_INLINE_H
 196 SCM_C_EXTERN_INLINE
 197 #endif
 198 SCM
 199 scm_immutable_double_cell (scm_t_bits car, scm_t_bits cbr,
 200                            scm_t_bits ccr, scm_t_bits cdr)
 201 {
 202   SCM z;
 203
 204   z = SCM_PACK ((scm_t_bits) (GC_MALLOC_STUBBORN (2 * sizeof (scm_t_cell))));
 205   /* Initialize the type slot last so that the cell is ignored by the
 206      GC until it is completely initialized.  This is only relevant
 207      when the GC can actually run during this code, which it can't
 208      since the GC only runs when all other threads are stopped.
 209   */
 210   SCM_GC_SET_CELL_WORD (z, 1, cbr);
 211   SCM_GC_SET_CELL_WORD (z, 2, ccr);
 212   SCM_GC_SET_CELL_WORD (z, 3, cdr);
 213   SCM_GC_SET_CELL_WORD (z, 0, car);
 214
 215   GC_END_STUBBORN_CHANGE ((void *) z);
 216
 217   /* When this function is inlined, it's possible that the last
 218      SCM_GC_SET_CELL_WORD above will be adjacent to a following
 219      initialization of z.  E.g., it occurred in scm_make_real.  GCC
 220      from around version 3 (e.g., certainly 3.2) began taking
 221      advantage of strict C aliasing rules which say that it's OK to
 222      interchange the initialization above and the one below when the
 223      pointer types appear to differ sufficiently.  We don't want that,
 224      of course.  GCC allows this behaviour to be disabled with the
 225      -fno-strict-aliasing option, but would also need to be supplied
 226      by Guile users.  Instead, the following statements prevent the
 227      reordering.
 228    */
 229 #ifdef __GNUC__
 230   __asm__ volatile ("" : : : "memory");
 231 #else
 232   /* portable version, just in case any other compiler does the same
 233      thing.  */
 234   scm_remember_upto_here_1 (z);
 235 #endif
 236
 237   return z;
 238 }
 239
 240 #ifndef SCM_INLINE_C_INCLUDING_INLINE_H
 241 SCM_C_EXTERN_INLINE
 242 #endif
 243 SCM
 244 scm_array_handle_ref (scm_t_array_handle *h, ssize_t p)
 245 {
 246   if (SCM_UNLIKELY (p < 0 && -p > h->base))
 247     /* catch overflow */
 248     scm_out_of_range (NULL, scm_from_ssize_t (p));
 249   /* perhaps should catch overflow here too */
 250   return h->impl->vref (h, h->base + p);
 251 }
 252
 253 #ifndef SCM_INLINE_C_INCLUDING_INLINE_H
 254 SCM_C_EXTERN_INLINE
 255 #endif
 256 void
 257 scm_array_handle_set (scm_t_array_handle *h, ssize_t p, SCM v)
 258 {
 259   if (SCM_UNLIKELY (p < 0 && -p > h->base))
 260     /* catch overflow */
 261     scm_out_of_range (NULL, scm_from_ssize_t (p));
 262   /* perhaps should catch overflow here too */
 263   h->impl->vset (h, h->base + p, v);
 264 }
 265
 266 #ifndef SCM_INLINE_C_INCLUDING_INLINE_H
 267 SCM_C_EXTERN_INLINE
 268 #endif
 269 int
 270 scm_is_pair (SCM x)
 271 {
 272   /* The following "workaround_for_gcc_295" avoids bad code generated by
 273      i386 gcc 2.95.4 (the Debian packaged 2.95.4-24 at least).
 274
 275      Under the default -O2 the inlined SCM_I_CONSP test gets "optimized" so
 276      the fetch of the tag word from x is done before confirming it's a
 277      non-immediate (SCM_NIMP).  Needless to say that bombs badly if x is a
 278      immediate.  This was seen to afflict scm_srfi1_split_at and something
 279      deep in the bowels of ceval().  In both cases segvs resulted from
 280      deferencing a random immediate value.  srfi-1.test exposes the problem
 281      through a short list, the immediate being SCM_EOL in that case.
 282      Something in syntax.test exposed the ceval() problem.
 283
 284      Just "volatile SCM workaround_for_gcc_295 = lst" is enough to avoid the
 285      problem, without even using that variable.  The "w=w" is just to
 286      prevent a warning about it being unused.
 287      */
 288 #if defined (__GNUC__) && __GNUC__ == 2 && __GNUC_MINOR__ == 95
 289   volatile SCM workaround_for_gcc_295 = x;
 290   workaround_for_gcc_295 = workaround_for_gcc_295;
 291 #endif
 292
 293   return SCM_I_CONSP (x);
 294 }
 295
 296
 297 /* Port I/O.  */
 298
 299 #ifndef SCM_INLINE_C_INCLUDING_INLINE_H
 300 SCM_C_EXTERN_INLINE
 301 #endif
 302 int
 303 scm_get_byte_or_eof (SCM port)
 304 {
 305   int c;
 306   scm_t_port *pt = SCM_PTAB_ENTRY (port);
 307
 308   if (pt->rw_active == SCM_PORT_WRITE)
 309     /* may be marginally faster than calling scm_flush.  */
 310     scm_ptobs[SCM_PTOBNUM (port)].flush (port);
 311
 312   if (pt->rw_random)
 313     pt->rw_active = SCM_PORT_READ;
 314
 315   if (pt->read_pos >= pt->read_end)
 316     {
 317       if (scm_fill_input (port) == EOF)
 318         return EOF;
 319     }
 320
 321   c = *(pt->read_pos++);
 322
 323   return c;
 324 }
 325
 326 #ifndef SCM_INLINE_C_INCLUDING_INLINE_H
 327 SCM_C_EXTERN_INLINE
 328 #endif
 329 void
 330 scm_putc (char c, SCM port)
 331 {
 332   SCM_ASSERT_TYPE (SCM_OPOUTPORTP (port), port, 0, NULL, "output port");
 333   scm_lfwrite (&c, 1, port);
 334 }
 335
 336 #ifndef SCM_INLINE_C_INCLUDING_INLINE_H
 337 SCM_C_EXTERN_INLINE
 338 #endif
 339 void
 340 scm_puts (const char *s, SCM port)
 341 {
 342   SCM_ASSERT_TYPE (SCM_OPOUTPORTP (port), port, 0, NULL, "output port");
 343   scm_lfwrite (s, strlen (s), port);
 344 }
 345
 346
 347 #endif
 348 #endif