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, 2010 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/bdw-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 SCM_API SCM scm_words (scm_t_bits car, scm_t_uint16 n_words);
  91 /* no immutable words for now, would require initialization at the same time as
  92    allocation */
  93
  94 SCM_API SCM scm_array_handle_ref (scm_t_array_handle *h, ssize_t pos);
  95 SCM_API void scm_array_handle_set (scm_t_array_handle *h, ssize_t pos, SCM val);
  96
  97 SCM_API int scm_is_pair (SCM x);
  98 SCM_API int scm_is_string (SCM x);
  99
 100 SCM_API int scm_get_byte_or_eof (SCM port);
 101 SCM_API void scm_putc (char c, SCM port);
 102 SCM_API void scm_puts (const char *str_data, SCM port);
 103
 104 #endif
 105
 106
 107 #if defined SCM_C_EXTERN_INLINE || defined SCM_INLINE_C_INCLUDING_INLINE_H
 108 /* either inlining, or being included from inline.c.  We use (and
 109    repeat) this long #if test here and below so that we don't have to
 110    introduce any extraneous symbols into the public namespace.  We
 111    only need SCM_C_INLINE to be seen publically . */
 112
 113 extern unsigned scm_newcell2_count;
 114 extern unsigned scm_newcell_count;
 115
 116
 117 #ifndef SCM_INLINE_C_INCLUDING_INLINE_H
 118 SCM_C_EXTERN_INLINE
 119 #endif
 120
 121 SCM
 122 scm_cell (scm_t_bits car, scm_t_bits cdr)
 123 {
 124   SCM cell = SCM_PACK ((scm_t_bits) (GC_MALLOC (sizeof (scm_t_cell))));
 125
 126   /* Initialize the type slot last so that the cell is ignored by the GC
 127      until it is completely initialized.  This is only relevant when the GC
 128      can actually run during this code, which it can't since the GC only runs
 129      when all other threads are stopped.  */
 130   SCM_GC_SET_CELL_WORD (cell, 1, cdr);
 131   SCM_GC_SET_CELL_WORD (cell, 0, car);
 132
 133   return cell;
 134 }
 135
 136 #ifndef SCM_INLINE_C_INCLUDING_INLINE_H
 137 SCM_C_EXTERN_INLINE
 138 #endif
 139 SCM
 140 scm_immutable_cell (scm_t_bits car, scm_t_bits cdr)
 141 {
 142   SCM cell = SCM_PACK ((scm_t_bits) (GC_MALLOC_STUBBORN (sizeof (scm_t_cell))));
 143
 144   /* Initialize the type slot last so that the cell is ignored by the GC
 145      until it is completely initialized.  This is only relevant when the GC
 146      can actually run during this code, which it can't since the GC only runs
 147      when all other threads are stopped.  */
 148   SCM_GC_SET_CELL_WORD (cell, 1, cdr);
 149   SCM_GC_SET_CELL_WORD (cell, 0, car);
 150
 151   GC_END_STUBBORN_CHANGE ((void *) cell);
 152
 153   return cell;
 154 }
 155
 156 #ifndef SCM_INLINE_C_INCLUDING_INLINE_H
 157 SCM_C_EXTERN_INLINE
 158 #endif
 159 SCM
 160 scm_double_cell (scm_t_bits car, scm_t_bits cbr,
 161                  scm_t_bits ccr, scm_t_bits cdr)
 162 {
 163   SCM z;
 164
 165   z = SCM_PACK ((scm_t_bits) (GC_MALLOC (2 * sizeof (scm_t_cell))));
 166   /* Initialize the type slot last so that the cell is ignored by the
 167      GC until it is completely initialized.  This is only relevant
 168      when the GC can actually run during this code, which it can't
 169      since the GC only runs when all other threads are stopped.
 170   */
 171   SCM_GC_SET_CELL_WORD (z, 1, cbr);
 172   SCM_GC_SET_CELL_WORD (z, 2, ccr);
 173   SCM_GC_SET_CELL_WORD (z, 3, cdr);
 174   SCM_GC_SET_CELL_WORD (z, 0, car);
 175
 176   /* When this function is inlined, it's possible that the last
 177      SCM_GC_SET_CELL_WORD above will be adjacent to a following
 178      initialization of z.  E.g., it occurred in scm_make_real.  GCC
 179      from around version 3 (e.g., certainly 3.2) began taking
 180      advantage of strict C aliasing rules which say that it's OK to
 181      interchange the initialization above and the one below when the
 182      pointer types appear to differ sufficiently.  We don't want that,
 183      of course.  GCC allows this behaviour to be disabled with the
 184      -fno-strict-aliasing option, but would also need to be supplied
 185      by Guile users.  Instead, the following statements prevent the
 186      reordering.
 187    */
 188 #ifdef __GNUC__
 189   __asm__ volatile ("" : : : "memory");
 190 #else
 191   /* portable version, just in case any other compiler does the same
 192      thing.  */
 193   scm_remember_upto_here_1 (z);
 194 #endif
 195
 196   return z;
 197 }
 198
 199 #ifndef SCM_INLINE_C_INCLUDING_INLINE_H
 200 SCM_C_EXTERN_INLINE
 201 #endif
 202 SCM
 203 scm_immutable_double_cell (scm_t_bits car, scm_t_bits cbr,
 204                            scm_t_bits ccr, scm_t_bits cdr)
 205 {
 206   SCM z;
 207
 208   z = SCM_PACK ((scm_t_bits) (GC_MALLOC_STUBBORN (2 * sizeof (scm_t_cell))));
 209   /* Initialize the type slot last so that the cell is ignored by the
 210      GC until it is completely initialized.  This is only relevant
 211      when the GC can actually run during this code, which it can't
 212      since the GC only runs when all other threads are stopped.
 213   */
 214   SCM_GC_SET_CELL_WORD (z, 1, cbr);
 215   SCM_GC_SET_CELL_WORD (z, 2, ccr);
 216   SCM_GC_SET_CELL_WORD (z, 3, cdr);
 217   SCM_GC_SET_CELL_WORD (z, 0, car);
 218
 219   GC_END_STUBBORN_CHANGE ((void *) z);
 220
 221   /* When this function is inlined, it's possible that the last
 222      SCM_GC_SET_CELL_WORD above will be adjacent to a following
 223      initialization of z.  E.g., it occurred in scm_make_real.  GCC
 224      from around version 3 (e.g., certainly 3.2) began taking
 225      advantage of strict C aliasing rules which say that it's OK to
 226      interchange the initialization above and the one below when the
 227      pointer types appear to differ sufficiently.  We don't want that,
 228      of course.  GCC allows this behaviour to be disabled with the
 229      -fno-strict-aliasing option, but would also need to be supplied
 230      by Guile users.  Instead, the following statements prevent the
 231      reordering.
 232    */
 233 #ifdef __GNUC__
 234   __asm__ volatile ("" : : : "memory");
 235 #else
 236   /* portable version, just in case any other compiler does the same
 237      thing.  */
 238   scm_remember_upto_here_1 (z);
 239 #endif
 240
 241   return z;
 242 }
 243
 244 #ifndef SCM_INLINE_C_INCLUDING_INLINE_H
 245 SCM_C_EXTERN_INLINE
 246 #endif
 247 SCM
 248 scm_words (scm_t_bits car, scm_t_uint16 n_words)
 249 {
 250   SCM z;
 251
 252   z = SCM_PACK ((scm_t_bits) (GC_MALLOC (sizeof (scm_t_bits) * n_words)));
 253   SCM_GC_SET_CELL_WORD (z, 0, car);
 254
 255   /* FIXME: is the following concern even relevant with BDW-GC? */
 256
 257   /* When this function is inlined, it's possible that the last
 258      SCM_GC_SET_CELL_WORD above will be adjacent to a following
 259      initialization of z.  E.g., it occurred in scm_make_real.  GCC
 260      from around version 3 (e.g., certainly 3.2) began taking
 261      advantage of strict C aliasing rules which say that it's OK to
 262      interchange the initialization above and the one below when the
 263      pointer types appear to differ sufficiently.  We don't want that,
 264      of course.  GCC allows this behaviour to be disabled with the
 265      -fno-strict-aliasing option, but would also need to be supplied
 266      by Guile users.  Instead, the following statements prevent the
 267      reordering.
 268    */
 269 #ifdef __GNUC__
 270   __asm__ volatile ("" : : : "memory");
 271 #else
 272   /* portable version, just in case any other compiler does the same
 273      thing.  */
 274   scm_remember_upto_here_1 (z);
 275 #endif
 276
 277   return z;
 278 }
 279
 280 #ifndef SCM_INLINE_C_INCLUDING_INLINE_H
 281 SCM_C_EXTERN_INLINE
 282 #endif
 283 SCM
 284 scm_array_handle_ref (scm_t_array_handle *h, ssize_t p)
 285 {
 286   if (SCM_UNLIKELY (p < 0 && ((size_t)-p) > h->base))
 287     /* catch overflow */
 288     scm_out_of_range (NULL, scm_from_ssize_t (p));
 289   /* perhaps should catch overflow here too */
 290   return h->impl->vref (h, h->base + p);
 291 }
 292
 293 #ifndef SCM_INLINE_C_INCLUDING_INLINE_H
 294 SCM_C_EXTERN_INLINE
 295 #endif
 296 void
 297 scm_array_handle_set (scm_t_array_handle *h, ssize_t p, SCM v)
 298 {
 299   if (SCM_UNLIKELY (p < 0 && ((size_t)-p) > h->base))
 300     /* catch overflow */
 301     scm_out_of_range (NULL, scm_from_ssize_t (p));
 302   /* perhaps should catch overflow here too */
 303   h->impl->vset (h, h->base + p, v);
 304 }
 305
 306 #ifndef SCM_INLINE_C_INCLUDING_INLINE_H
 307 SCM_C_EXTERN_INLINE
 308 #endif
 309 int
 310 scm_is_pair (SCM x)
 311 {
 312   /* The following "workaround_for_gcc_295" avoids bad code generated by
 313      i386 gcc 2.95.4 (the Debian packaged 2.95.4-24 at least).
 314
 315      Under the default -O2 the inlined SCM_I_CONSP test gets "optimized" so
 316      the fetch of the tag word from x is done before confirming it's a
 317      non-immediate (SCM_NIMP).  Needless to say that bombs badly if x is a
 318      immediate.  This was seen to afflict scm_srfi1_split_at and something
 319      deep in the bowels of ceval().  In both cases segvs resulted from
 320      deferencing a random immediate value.  srfi-1.test exposes the problem
 321      through a short list, the immediate being SCM_EOL in that case.
 322      Something in syntax.test exposed the ceval() problem.
 323
 324      Just "volatile SCM workaround_for_gcc_295 = lst" is enough to avoid the
 325      problem, without even using that variable.  The "w=w" is just to
 326      prevent a warning about it being unused.
 327      */
 328 #if defined (__GNUC__) && __GNUC__ == 2 && __GNUC_MINOR__ == 95
 329   volatile SCM workaround_for_gcc_295 = x;
 330   workaround_for_gcc_295 = workaround_for_gcc_295;
 331 #endif
 332
 333   return SCM_I_CONSP (x);
 334 }
 335
 336 #ifndef SCM_INLINE_C_INCLUDING_INLINE_H
 337 SCM_C_EXTERN_INLINE
 338 #endif
 339 int
 340 scm_is_string (SCM x)
 341 {
 342   return SCM_NIMP (x) && (SCM_TYP7 (x) == scm_tc7_string);
 343 }
 344
 345 /* Port I/O.  */
 346
 347 #ifndef SCM_INLINE_C_INCLUDING_INLINE_H
 348 SCM_C_EXTERN_INLINE
 349 #endif
 350 int
 351 scm_get_byte_or_eof (SCM port)
 352 {
 353   int c;
 354   scm_t_port *pt = SCM_PTAB_ENTRY (port);
 355
 356   if (pt->rw_active == SCM_PORT_WRITE)
 357     /* may be marginally faster than calling scm_flush.  */
 358     scm_ptobs[SCM_PTOBNUM (port)].flush (port);
 359
 360   if (pt->rw_random)
 361     pt->rw_active = SCM_PORT_READ;
 362
 363   if (pt->read_pos >= pt->read_end)
 364     {
 365       if (scm_fill_input (port) == EOF)
 366         return EOF;
 367     }
 368
 369   c = *(pt->read_pos++);
 370
 371   return c;
 372 }
 373
 374 #ifndef SCM_INLINE_C_INCLUDING_INLINE_H
 375 SCM_C_EXTERN_INLINE
 376 #endif
 377 void
 378 scm_putc (char c, SCM port)
 379 {
 380   SCM_ASSERT_TYPE (SCM_OPOUTPORTP (port), port, 0, NULL, "output port");
 381   scm_lfwrite (&c, 1, port);
 382 }
 383
 384 #ifndef SCM_INLINE_C_INCLUDING_INLINE_H
 385 SCM_C_EXTERN_INLINE
 386 #endif
 387 void
 388 scm_puts (const char *s, SCM port)
 389 {
 390   SCM_ASSERT_TYPE (SCM_OPOUTPORTP (port), port, 0, NULL, "output port");
 391   scm_lfwrite (s, strlen (s), port);
 392 }
 393
 394
 395 #endif
 396 #endif