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