libguile/_scm.h

   1 /* classes: h_files */
   2
   3 #ifndef SCM__SCM_H
   4 #define SCM__SCM_H
   5
   6 /* Copyright (C) 1995, 1996, 2000, 2001, 2002, 2006, 2008, 2009, 2010,
   7  *   2011, 2013, 2014 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 \f
  26
  27 /**********************************************************************
  28  This file is Guile's central private header.
  29
  30  When included by other files, this file should preceed any include
  31  other than __scm.h.  See __scm.h for details regarding the purpose of
  32  and differences between _scm.h and __scm.h.
  33  **********************************************************************/
  34
  35 #if defined(__ia64) && !defined(__ia64__)
  36 # define __ia64__
  37 #endif
  38
  39 #if HAVE_CONFIG_H
  40 #  include <config.h>
  41 #endif
  42
  43 /* The size of `scm_t_bits'.  */
  44 #define SIZEOF_SCM_T_BITS SIZEOF_VOID_P
  45
  46 /* Undefine HAVE_STRUCT_TIMESPEC, because the libguile C code doesn't
  47    need it anymore, and because on MinGW:
  48
  49    - the definition of struct timespec is provided (if at all) by
  50      pthread.h
  51
  52    - pthread.h will _not_ define struct timespec if
  53      HAVE_STRUCT_TIMESPEC is 1, because then it thinks that it doesn't
  54      need to.
  55
  56    The libguile C code doesn't need HAVE_STRUCT_TIMESPEC anymore,
  57    because the value of HAVE_STRUCT_TIMESPEC has already been
  58    incorporated in how scm_t_timespec is defined (in scmconfig.h), and
  59    the rest of the libguile C code now just uses scm_t_timespec.
  60  */
  61 #ifdef HAVE_STRUCT_TIMESPEC
  62 #undef HAVE_STRUCT_TIMESPEC
  63 #endif
  64
  65 #include <errno.h>
  66 #include <verify.h>
  67 #include <alignof.h>
  68 #include "libguile/__scm.h"
  69
  70 /* Include headers for those files central to the implementation.  The
  71    rest should be explicitly #included in the C files themselves.  */
  72 #include "libguile/error.h"     /* Everyone signals errors.  */
  73 #include "libguile/print.h"     /* Everyone needs to print.  */
  74 #include "libguile/pairs.h"     /* Everyone conses.  */
  75 #include "libguile/list.h"      /* Everyone makes lists.  */
  76 #include "libguile/gc.h"        /* Everyone allocates.  */
  77 #include "libguile/gsubr.h"     /* Everyone defines global functions.  */
  78 #include "libguile/procs.h"     /* Same.  */
  79 #include "libguile/numbers.h"   /* Everyone deals with fixnums.  */
  80 #include "libguile/symbols.h"   /* For length, chars, values, miscellany.  */
  81 #include "libguile/boolean.h"   /* Everyone wonders about the truth.  */
  82 #include "libguile/threads.h"   /* You are not alone. */
  83 #include "libguile/snarf.h"     /* Everyone snarfs. */
  84 #include "libguile/foreign.h"   /* Snarfing needs the foreign data structures. */
  85 #include "libguile/programs.h"  /* ... and program.h. */
  86 #include "libguile/variable.h"
  87 #include "libguile/modules.h"
  88 #include "libguile/inline.h"
  89 #include "libguile/strings.h"
  90
  91 /* ASYNC_TICK after finding EINTR in order to handle pending signals, if
  92    any. See comment in scm_syserror. */
  93 #ifndef SCM_SYSCALL
  94 #ifdef vms
  95 # ifndef __GNUC__
  96 #  include <ssdef.h>
  97 #   define SCM_SYSCALL(line)                                            \
  98   do                                                                    \
  99     {                                                                   \
 100       errno = 0;                                                        \
 101       line;                                                             \
 102       if (EVMSERR == errno && (vaxc$errno>>3)==(SS$_CONTROLC>>3))       \
 103         SCM_ASYNC_TICK;                                                 \
 104       else                                                              \
 105         break;                                                          \
 106     }                                                                   \
 107   while (1)
 108 # endif /* ndef __GNUC__ */
 109 #endif /* def vms */
 110 #endif /* ndef SCM_SYSCALL  */
 111
 112 #ifndef SCM_SYSCALL
 113 # ifdef EINTR
 114 #  if (EINTR > 0)
 115 #   define SCM_SYSCALL(line)                    \
 116   do                                            \
 117     {                                           \
 118       errno = 0;                                \
 119       line;                                     \
 120       if (errno == EINTR)                       \
 121         {                                       \
 122           SCM_ASYNC_TICK;                       \
 123           errno = EINTR;                        \
 124         }                                       \
 125     }                                           \
 126   while (errno == EINTR)
 127 #  endif /*  (EINTR > 0) */
 128 # endif /* def EINTR */
 129 #endif /* ndef SCM_SYSCALL */
 130
 131 #ifndef SCM_SYSCALL
 132 # define SCM_SYSCALL(line) line;
 133 #endif /* ndef SCM_SYSCALL */
 134
 135 \f
 136
 137 #ifndef min
 138 #define min(A, B) ((A) <= (B) ? (A) : (B))
 139 #endif
 140 #ifndef max
 141 #define max(A, B) ((A) >= (B) ? (A) : (B))
 142 #endif
 143
 144 /* Return the first integer greater than or equal to LEN such that
 145    LEN % ALIGN == 0.  Return LEN if ALIGN is zero.  */
 146 #define ROUND_UP(len, align)                                    \
 147   ((align) ? (((len) - 1UL) | ((align) - 1UL)) + 1UL : (len))
 148
 149
 150 #if defined GUILE_USE_64_CALLS && GUILE_USE_64_CALLS && defined(HAVE_STAT64)
 151 #define CHOOSE_LARGEFILE(foo,foo64)     foo64
 152 #else
 153 #define CHOOSE_LARGEFILE(foo,foo64)     foo
 154 #endif
 155
 156 /* These names are a bit long, but they make it clear what they represent. */
 157 #if SCM_HAVE_STRUCT_DIRENT64 == 1
 158 # define dirent_or_dirent64             CHOOSE_LARGEFILE(dirent,dirent64)
 159 #else
 160 # define dirent_or_dirent64             dirent
 161 #endif
 162 #define fstat_or_fstat64                CHOOSE_LARGEFILE(fstat,fstat64)
 163 #define ftruncate_or_ftruncate64        CHOOSE_LARGEFILE(ftruncate,ftruncate64)
 164 #define lseek_or_lseek64                CHOOSE_LARGEFILE(lseek,lseek64)
 165 #define lstat_or_lstat64                CHOOSE_LARGEFILE(lstat,lstat64)
 166 #define off_t_or_off64_t                CHOOSE_LARGEFILE(off_t,off64_t)
 167 #define open_or_open64                  CHOOSE_LARGEFILE(open,open64)
 168 #define readdir_or_readdir64            CHOOSE_LARGEFILE(readdir,readdir64)
 169 #if SCM_HAVE_READDIR64_R == 1
 170 # define readdir_r_or_readdir64_r       CHOOSE_LARGEFILE(readdir_r,readdir64_r)
 171 #else
 172 # define readdir_r_or_readdir64_r       readdir_r
 173 #endif
 174 #define stat_or_stat64                  CHOOSE_LARGEFILE(stat,stat64)
 175 #define truncate_or_truncate64          CHOOSE_LARGEFILE(truncate,truncate64)
 176 #define scm_from_off_t_or_off64_t       CHOOSE_LARGEFILE(scm_from_off_t,scm_from_int64)
 177 #define scm_from_ino_t_or_ino64_t       CHOOSE_LARGEFILE(scm_from_ulong,scm_from_uint64)
 178 #define scm_from_blkcnt_t_or_blkcnt64_t CHOOSE_LARGEFILE(scm_from_ulong,scm_from_uint64)
 179 #define scm_to_off_t_or_off64_t         CHOOSE_LARGEFILE(scm_to_off_t,scm_to_int64)
 180
 181 #if SIZEOF_OFF_T == 4
 182 #  define scm_to_off_t    scm_to_int32
 183 #  define scm_from_off_t  scm_from_int32
 184 #elif SIZEOF_OFF_T == 8
 185 #  define scm_to_off_t    scm_to_int64
 186 #  define scm_from_off_t  scm_from_int64
 187 #else
 188 #  error sizeof(off_t) is not 4 or 8.
 189 #endif
 190 #define scm_to_off64_t    scm_to_int64
 191 #define scm_from_off64_t  scm_from_int64
 192
 193
 194 \f
 195
 196 #if defined (vms)
 197 /* VMS: Implement SCM_I_SETJMP in terms of setjump.  */
 198 extern int setjump(scm_i_jmp_buf env);
 199 extern int longjump(scm_i_jmp_buf env, int ret);
 200 #define SCM_I_SETJMP setjump
 201 #define SCM_I_LONGJMP longjump
 202
 203 #elif defined (_CRAY1)
 204 /* Cray: Implement SCM_I_SETJMP in terms of setjump.  */
 205 extern int setjump(scm_i_jmp_buf env);
 206 extern int longjump(scm_i_jmp_buf env, int ret);
 207 #define SCM_I_SETJMP setjump
 208 #define SCM_I_LONGJMP longjump
 209
 210 #elif defined (__ia64__)
 211 /* IA64: Implement SCM_I_SETJMP in terms of getcontext. */
 212 # define SCM_I_SETJMP(JB)                               \
 213   ( (JB).fresh = 1,                                     \
 214     getcontext (&((JB).ctx)),                           \
 215     ((JB).fresh ? ((JB).fresh = 0, 0) : 1) )
 216 # define SCM_I_LONGJMP(JB,VAL) scm_ia64_longjmp (&(JB), VAL)
 217 void scm_ia64_longjmp (scm_i_jmp_buf *, int);
 218
 219 #else
 220 /* All other systems just use setjmp and longjmp.  */
 221
 222 #define SCM_I_SETJMP setjmp
 223 #define SCM_I_LONGJMP longjmp
 224 #endif
 225
 226 \f
 227
 228 #define SCM_ASYNC_TICK_WITH_GUARD_CODE(thr, pre, post)                  \
 229   do                                                                    \
 230     {                                                                   \
 231       if (SCM_UNLIKELY (thr->pending_asyncs))                           \
 232         {                                                               \
 233           pre;                                                          \
 234           scm_async_tick ();                                            \
 235           post;                                                         \
 236         }                                                               \
 237     }                                                                   \
 238   while (0)
 239
 240 #define SCM_ASYNC_TICK_WITH_CODE(thr, stmt) \
 241   SCM_ASYNC_TICK_WITH_GUARD_CODE (thr, stmt, (void) 0)
 242 #define SCM_ASYNC_TICK \
 243   SCM_ASYNC_TICK_WITH_CODE (SCM_I_CURRENT_THREAD, (void) 0)
 244
 245
 246 \f
 247
 248 #if (defined __GNUC__)
 249 # define SCM_NOINLINE __attribute__ ((__noinline__))
 250 #else
 251 # define SCM_NOINLINE /* noinline */
 252 #endif
 253
 254 \f
 255
 256 /* The endianness marker in objcode.  */
 257 #ifdef WORDS_BIGENDIAN
 258 # define SCM_OBJCODE_ENDIANNESS "BE"
 259 #else
 260 # define SCM_OBJCODE_ENDIANNESS "LE"
 261 #endif
 262
 263 #define _SCM_CPP_STRINGIFY(x)  # x
 264 #define SCM_CPP_STRINGIFY(x)   _SCM_CPP_STRINGIFY (x)
 265
 266 /* The word size marker in objcode.  */
 267 #define SCM_OBJCODE_WORD_SIZE  SCM_CPP_STRINGIFY (SIZEOF_VOID_P)
 268
 269 /* Major and minor versions must be single characters. */
 270 #define SCM_OBJCODE_MAJOR_VERSION 3
 271 #define SCM_OBJCODE_MINOR_VERSION 6
 272 #define SCM_OBJCODE_MAJOR_VERSION_STRING        \
 273   SCM_CPP_STRINGIFY(SCM_OBJCODE_MAJOR_VERSION)
 274 #define SCM_OBJCODE_MINOR_VERSION_STRING        \
 275   SCM_CPP_STRINGIFY(SCM_OBJCODE_MINOR_VERSION)
 276 #define SCM_OBJCODE_VERSION_STRING                                      \
 277   SCM_OBJCODE_MAJOR_VERSION_STRING "." SCM_OBJCODE_MINOR_VERSION_STRING
 278 #define SCM_OBJCODE_MACHINE_VERSION_STRING                              \
 279   SCM_OBJCODE_ENDIANNESS "-" SCM_OBJCODE_WORD_SIZE "-" SCM_OBJCODE_VERSION_STRING
 280
 281 #endif  /* SCM__SCM_H */
 282
 283 /*
 284   Local Variables:
 285   c-file-style: "gnu"
 286   End:
 287 */