summaryrefslogtreecommitdiff
path: root/libguile/_scm.h
blob: a7a3ad254ec7a599e2ad97af1863170f1054b84f (about) (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
/* classes: h_files */

#ifndef SCM__SCM_H
#define SCM__SCM_H

/* Copyright (C) 1995,1996,2000,2001, 2002, 2006, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
 *
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Lesser General Public License
 * as published by the Free Software Foundation; either version 3 of
 * the License, or (at your option) any later version.
 *
 * This library is distributed in the hope that it will be useful, but
 * WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
 * Lesser General Public License for more details.
 *
 * You should have received a copy of the GNU Lesser General Public
 * License along with this library; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
 * 02110-1301 USA
 */



/**********************************************************************
 This file is Guile's central private header.

 When included by other files, this file should preceed any include
 other than __scm.h.  See __scm.h for details regarding the purpose of
 and differences between _scm.h and __scm.h.
 **********************************************************************/

#if defined(__ia64) && !defined(__ia64__)
# define __ia64__
#endif

#if HAVE_CONFIG_H
#  include <config.h>
#endif

/* The size of `scm_t_bits'.  */
#define SIZEOF_SCM_T_BITS SIZEOF_VOID_P

/* Undefine HAVE_STRUCT_TIMESPEC, because the libguile C code doesn't
   need it anymore, and because on MinGW:

   - the definition of struct timespec is provided (if at all) by
     pthread.h

   - pthread.h will _not_ define struct timespec if
     HAVE_STRUCT_TIMESPEC is 1, because then it thinks that it doesn't
     need to.

   The libguile C code doesn't need HAVE_STRUCT_TIMESPEC anymore,
   because the value of HAVE_STRUCT_TIMESPEC has already been
   incorporated in how scm_t_timespec is defined (in scmconfig.h), and
   the rest of the libguile C code now just uses scm_t_timespec.
 */
#ifdef HAVE_STRUCT_TIMESPEC
#undef HAVE_STRUCT_TIMESPEC
#endif

#include <errno.h>
#include <verify.h>
#include <alignof.h>
#include "libguile/__scm.h"

/* Include headers for those files central to the implementation.  The
   rest should be explicitly #included in the C files themselves.  */
#include "libguile/error.h"	/* Everyone signals errors.  */
#include "libguile/print.h"	/* Everyone needs to print.  */
#include "libguile/pairs.h"	/* Everyone conses.  */
#include "libguile/list.h"	/* Everyone makes lists.  */
#include "libguile/gc.h"	/* Everyone allocates.  */
#include "libguile/gsubr.h"	/* Everyone defines global functions.  */
#include "libguile/procs.h"	/* Same.  */
#include "libguile/numbers.h"	/* Everyone deals with fixnums.  */
#include "libguile/symbols.h"	/* For length, chars, values, miscellany.  */
#include "libguile/boolean.h"	/* Everyone wonders about the truth.  */
#include "libguile/threads.h"	/* You are not alone. */
#include "libguile/snarf.h"	/* Everyone snarfs. */
#include "libguile/foreign.h"	/* Snarfing needs the foreign data structures. */
#include "libguile/programs.h"	/* ... and program.h. */
#include "libguile/variable.h"
#include "libguile/modules.h"
#include "libguile/inline.h"
#include "libguile/strings.h"

/* ASYNC_TICK after finding EINTR in order to handle pending signals, if
   any. See comment in scm_syserror. */
#ifndef SCM_SYSCALL
#ifdef vms
# ifndef __GNUC__
#  include <ssdef.h>
#   define SCM_SYSCALL(line)                                    \
  do                                                            \
    {                                                           \
      errno = 0;                                                \
      line;                                                     \
      if (EVMSERR==errno && (vaxc$errno>>3)==(SS$_CONTROLC>>3)) \
        {                                                       \
          SCM_ASYNC_TICK;                                       \
          continue;                                             \
        }                                                       \
    }                                                           \
  while(0)
# endif /* ndef __GNUC__ */
#endif /* def vms */
#endif /* ndef SCM_SYSCALL  */

#ifndef SCM_SYSCALL
# ifdef EINTR
#  if (EINTR > 0)
#   define SCM_SYSCALL(line)                    \
  do                                            \
    {                                           \
      errno = 0;                                \
      line;                                     \
      if (errno == EINTR)                       \
        {                                       \
          SCM_ASYNC_TICK;                       \
          continue;                             \
        }                                       \
    }                                           \
  while(0)
#  endif /*  (EINTR > 0) */
# endif /* def EINTR */
#endif /* ndef SCM_SYSCALL */

#ifndef SCM_SYSCALL
# define SCM_SYSCALL(line) line;
#endif /* ndef SCM_SYSCALL */



#ifndef min
#define min(A, B) ((A) <= (B) ? (A) : (B))
#endif
#ifndef max
#define max(A, B) ((A) >= (B) ? (A) : (B))
#endif

/* Return the first integer greater than or equal to LEN such that
   LEN % ALIGN == 0.  Return LEN if ALIGN is zero.  */
#define ROUND_UP(len, align)					\
  ((align) ? (((len) - 1UL) | ((align) - 1UL)) + 1UL : (len))


#if defined GUILE_USE_64_CALLS && GUILE_USE_64_CALLS && defined(HAVE_STAT64)
#define CHOOSE_LARGEFILE(foo,foo64)     foo64
#else
#define CHOOSE_LARGEFILE(foo,foo64)     foo
#endif

/* These names are a bit long, but they make it clear what they represent. */
#if SCM_HAVE_STRUCT_DIRENT64 == 1
# define dirent_or_dirent64             CHOOSE_LARGEFILE(dirent,dirent64)
#else
# define dirent_or_dirent64             dirent
#endif
#define fstat_or_fstat64                CHOOSE_LARGEFILE(fstat,fstat64)
#define ftruncate_or_ftruncate64        CHOOSE_LARGEFILE(ftruncate,ftruncate64)
#define lseek_or_lseek64                CHOOSE_LARGEFILE(lseek,lseek64)
#define lstat_or_lstat64                CHOOSE_LARGEFILE(lstat,lstat64)
#define off_t_or_off64_t                CHOOSE_LARGEFILE(off_t,off64_t)
#define open_or_open64                  CHOOSE_LARGEFILE(open,open64)
#define readdir_or_readdir64            CHOOSE_LARGEFILE(readdir,readdir64)
#if SCM_HAVE_READDIR64_R == 1
# define readdir_r_or_readdir64_r       CHOOSE_LARGEFILE(readdir_r,readdir64_r)
#else
# define readdir_r_or_readdir64_r       readdir_r
#endif
#define stat_or_stat64                  CHOOSE_LARGEFILE(stat,stat64)
#define truncate_or_truncate64          CHOOSE_LARGEFILE(truncate,truncate64)
#define scm_from_off_t_or_off64_t       CHOOSE_LARGEFILE(scm_from_off_t,scm_from_int64)
#define scm_from_ino_t_or_ino64_t       CHOOSE_LARGEFILE(scm_from_ulong,scm_from_uint64)
#define scm_from_blkcnt_t_or_blkcnt64_t CHOOSE_LARGEFILE(scm_from_ulong,scm_from_uint64)
#define scm_to_off_t_or_off64_t         CHOOSE_LARGEFILE(scm_to_off_t,scm_to_int64)

#if SIZEOF_OFF_T == 4
#  define scm_to_off_t    scm_to_int32
#  define scm_from_off_t  scm_from_int32
#elif SIZEOF_OFF_T == 8
#  define scm_to_off_t    scm_to_int64
#  define scm_from_off_t  scm_from_int64
#else
#  error sizeof(off_t) is not 4 or 8.
#endif
#define scm_to_off64_t    scm_to_int64
#define scm_from_off64_t  scm_from_int64




#if defined (vms)
/* VMS: Implement SCM_I_SETJMP in terms of setjump.  */
extern int setjump(scm_i_jmp_buf env);
extern int longjump(scm_i_jmp_buf env, int ret);
#define SCM_I_SETJMP setjump
#define SCM_I_LONGJMP longjump

#elif defined (_CRAY1)
/* Cray: Implement SCM_I_SETJMP in terms of setjump.  */
extern int setjump(scm_i_jmp_buf env);
extern int longjump(scm_i_jmp_buf env, int ret);
#define SCM_I_SETJMP setjump
#define SCM_I_LONGJMP longjump

#elif defined (__ia64__)
/* IA64: Implement SCM_I_SETJMP in terms of getcontext. */
# define SCM_I_SETJMP(JB)			        \
  ( (JB).fresh = 1,				        \
    getcontext (&((JB).ctx)),                           \
    ((JB).fresh ? ((JB).fresh = 0, 0) : 1) )
# define SCM_I_LONGJMP(JB,VAL) scm_ia64_longjmp (&(JB), VAL)
void scm_ia64_longjmp (scm_i_jmp_buf *, int);

#else
/* All other systems just use setjmp and longjmp.  */

#define SCM_I_SETJMP setjmp
#define SCM_I_LONGJMP longjmp
#endif



#define SCM_ASYNC_TICK                                                  \
  do                                                                    \
    {                                                                   \
      if (SCM_UNLIKELY (SCM_I_CURRENT_THREAD->pending_asyncs))          \
        scm_async_tick ();                                              \
    }                                                                   \
  while (0)

#define SCM_ASYNC_TICK_WITH_CODE(thr, stmt)                             \
  do                                                                    \
    {                                                                   \
      if (SCM_UNLIKELY (thr->pending_asyncs))                           \
        {                                                               \
          stmt;                                                         \
          scm_async_tick ();                                            \
        }                                                               \
    }                                                                   \
  while (0)




/* The endianness marker in objcode.  */
#ifdef WORDS_BIGENDIAN
# define SCM_OBJCODE_ENDIANNESS "BE"
#else
# define SCM_OBJCODE_ENDIANNESS "LE"
#endif

#define _SCM_CPP_STRINGIFY(x)  # x
#define SCM_CPP_STRINGIFY(x)   _SCM_CPP_STRINGIFY (x)

/* The word size marker in objcode.  */
#define SCM_OBJCODE_WORD_SIZE  SCM_CPP_STRINGIFY (SIZEOF_VOID_P)

/* Major and minor versions must be single characters. */
#define SCM_OBJCODE_MAJOR_VERSION 3
#define SCM_OBJCODE_MINOR_VERSION 0
#define SCM_OBJCODE_MAJOR_VERSION_STRING        \
  SCM_CPP_STRINGIFY(SCM_OBJCODE_MAJOR_VERSION)
#define SCM_OBJCODE_MINOR_VERSION_STRING        \
  SCM_CPP_STRINGIFY(SCM_OBJCODE_MINOR_VERSION)
#define SCM_OBJCODE_VERSION_STRING                                      \
  SCM_OBJCODE_MAJOR_VERSION_STRING "." SCM_OBJCODE_MINOR_VERSION_STRING
#define SCM_OBJCODE_MACHINE_VERSION_STRING                              \
  SCM_OBJCODE_ENDIANNESS "-" SCM_OBJCODE_WORD_SIZE "-" SCM_OBJCODE_VERSION_STRING

/* The objcode magic header.  */
#define SCM_OBJCODE_COOKIE                              \
  "GOOF----" SCM_OBJCODE_MACHINE_VERSION_STRING
#define SCM_OBJCODE_ENDIANNESS_OFFSET 8
#define SCM_OBJCODE_WORD_SIZE_OFFSET 11


#endif  /* SCM__SCM_H */

/*
  Local Variables:
  c-file-style: "gnu"
  End:
*/