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