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