~ubuntu-branches/ubuntu/intrepid/ecl/intrepid

« back to all changes in this revision

Viewing changes to src/h/internal.h

  • Committer: Bazaar Package Importer
  • Author(s): Peter Van Eynde
  • Date: 2006-05-17 02:46:26 UTC
  • Revision ID: james.westby@ubuntu.com-20060517024626-lljr08ftv9g9vefl
Tags: upstream-0.9h-20060510
ImportĀ upstreamĀ versionĀ 0.9h-20060510

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
/*
 
2
    internal.h -- Structures and functions that are not meant for the end user
 
3
*/
 
4
/*
 
5
    Copyright (c) 2001, Juan Jose Garcia Ripoll.
 
6
 
 
7
    ECL is free software; you can redistribute it and/or
 
8
    modify it under the terms of the GNU Library General Public
 
9
    License as published by the Free Software Foundation; either
 
10
    version 2 of the License, or (at your option) any later version.
 
11
 
 
12
    See file '../Copyright' for full details.
 
13
*/
 
14
 
 
15
#ifdef __cplusplus
 
16
extern "C" {
 
17
#endif
 
18
 
 
19
/* -------------------------------------------------------------------- *
 
20
 *      FUNCTIONS, VARIABLES AND TYPES NOT FOR GENERAL USE              *
 
21
 * -------------------------------------------------------------------- */
 
22
 
 
23
/* booting */
 
24
extern void init_all_symbols(void);
 
25
extern void init_alloc(void);
 
26
extern void init_backq(void);
 
27
extern void init_big(void);
 
28
extern void init_big_registers(void);
 
29
#ifdef CLOS
 
30
extern void init_clos(void);
 
31
#endif
 
32
extern void init_error(void);
 
33
extern void init_eval(void);
 
34
extern void init_file(void);
 
35
#ifndef GBC_BOEHM
 
36
extern void init_GC(void);
 
37
#endif
 
38
extern void init_macros(void);
 
39
extern void init_number(void);
 
40
extern void init_read(void);
 
41
extern void init_stacks(int *);
 
42
extern void init_unixint(void);
 
43
extern void init_unixtime(void);
 
44
#ifdef mingw32
 
45
extern void init_compiler(void);
 
46
#endif
 
47
extern void ecl_init_env(struct cl_env_struct *);
 
48
extern void init_LSP(cl_object);
 
49
extern void init_CLOS(cl_object);
 
50
 
 
51
/* alloc.d/alloc_2.d */
 
52
 
 
53
extern cl_object ecl_alloc_bytecodes(cl_index data_size, cl_index code_size);
 
54
 
 
55
/* compiler.d */
 
56
 
 
57
struct cl_compiler_env {
 
58
        cl_object variables;
 
59
        cl_object macros;
 
60
        cl_fixnum lexical_level;
 
61
        cl_object constants;
 
62
        bool coalesce;
 
63
        bool stepping;
 
64
};
 
65
 
 
66
/* interpreter.d */
 
67
 
 
68
#define cl_stack_ref(n) cl_env.stack[n]
 
69
#define cl_stack_index() (cl_env.stack_top-cl_env.stack)
 
70
 
 
71
/* ffi.d */
 
72
 
 
73
#define ECL_FFICALL_LIMIT 256
 
74
 
 
75
enum ecl_ffi_tag {
 
76
        ECL_FFI_CHAR = 0,
 
77
        ECL_FFI_UNSIGNED_CHAR,
 
78
        ECL_FFI_BYTE,
 
79
        ECL_FFI_UNSIGNED_BYTE,
 
80
        ECL_FFI_SHORT,
 
81
        ECL_FFI_UNSIGNED_SHORT,
 
82
        ECL_FFI_INT,
 
83
        ECL_FFI_UNSIGNED_INT,
 
84
        ECL_FFI_LONG,
 
85
        ECL_FFI_UNSIGNED_LONG,
 
86
        ECL_FFI_POINTER_VOID,
 
87
        ECL_FFI_CSTRING,
 
88
        ECL_FFI_OBJECT,
 
89
        ECL_FFI_FLOAT,
 
90
        ECL_FFI_DOUBLE,
 
91
        ECL_FFI_VOID
 
92
};
 
93
 
 
94
union ecl_ffi_values {
 
95
        char c;
 
96
        unsigned char uc;
 
97
        int8_t b;
 
98
        uint8_t ub;
 
99
        int i;
 
100
        unsigned int ui;
 
101
        short s;
 
102
        unsigned short us;
 
103
        long l;
 
104
        unsigned long ul;
 
105
        void *pv;
 
106
        char *pc;
 
107
        cl_object o;
 
108
        float f;
 
109
        double d;
 
110
};
 
111
 
 
112
enum ecl_ffi_calling_convention {
 
113
        ECL_FFI_CC_CDECL = 0,
 
114
        ECL_FFI_CC_STDCALL
 
115
};
 
116
 
 
117
struct ecl_fficall {
 
118
        char *buffer_sp;
 
119
        size_t buffer_size;
 
120
        union ecl_ffi_values output;
 
121
        enum ecl_ffi_calling_convention cc;
 
122
        char buffer[ECL_FFICALL_LIMIT];
 
123
        cl_object cstring;
 
124
};
 
125
 
 
126
enum ecl_ffi_tag ecl_foreign_type_code(cl_object type);
 
127
enum ecl_ffi_calling_convention ecl_foreign_cc_code(cl_object cc_type);
 
128
void ecl_fficall_prepare(cl_object return_type, cl_object arg_types, cl_object cc_type);
 
129
void ecl_fficall_push_bytes(void *data, size_t bytes);
 
130
void ecl_fficall_push_int(int word);
 
131
void ecl_fficall_align(int data);
 
132
cl_object ecl_foreign_data_ref_elt(void *p, enum ecl_ffi_tag type);
 
133
void ecl_foreign_data_set_elt(void *p, enum ecl_ffi_tag type, cl_object value);
 
134
 
 
135
void ecl_fficall_push_arg(union ecl_ffi_values *data, enum ecl_ffi_tag type);
 
136
void ecl_fficall_execute(void *f_ptr, struct ecl_fficall *fficall, enum ecl_ffi_tag return_type);
 
137
void ecl_dynamic_callback_call(cl_object callback_info, char* buffer);
 
138
void* ecl_dynamic_callback_make(cl_object data, enum ecl_ffi_calling_convention cc_type);
 
139
 
 
140
/* file.d */
 
141
 
 
142
/*
 
143
 * POSIX specifies that the "b" flag is ignored. This is good, because
 
144
 * under MSDOS and Apple's OS we need to open text files in binary mode,
 
145
 * so that we get both the carriage return and the linefeed characters.
 
146
 * Otherwise, it would be complicated to implement file-position and
 
147
 * seek operations.
 
148
 */
 
149
#define OPEN_R  "rb"
 
150
#define OPEN_W  "wb"
 
151
#define OPEN_RW "w+b"
 
152
#define OPEN_A  "ab"
 
153
#define OPEN_RA "a+b"
 
154
 
 
155
/* format.d */
 
156
 
 
157
#ifndef ECL_CMU_FORMAT
 
158
extern cl_object si_formatter_aux _ARGS((cl_narg narg, cl_object strm, cl_object string, ...));
 
159
#endif
 
160
 
 
161
/* hash.d */
 
162
extern void ecl_extend_hashtable(cl_object hashtable);
 
163
 
 
164
/* gfun.d, kernel.lsp */
 
165
 
 
166
#define GFUN_NAME(x) ((x)->instance.slots[0])
 
167
#define GFUN_HASH(x) ((x)->instance.slots[1])
 
168
#define GFUN_SPEC(x) ((x)->instance.slots[2])
 
169
#define GFUN_COMB(x) ((x)->instance.slots[3])
 
170
 
 
171
/* package.d */
 
172
 
 
173
extern cl_object ecl_find_symbol_nolock(cl_object name, cl_object p, int *intern_flag);
 
174
 
 
175
/* print.d */
 
176
 
 
177
#define ECL_PPRINT_QUEUE_SIZE                   128
 
178
#define ECL_PPRINT_INDENTATION_STACK_SIZE       256
 
179
 
 
180
extern int edit_double(int n, double d, int *sp, char *s, int *ep);
 
181
extern void cl_write_object(cl_object x, cl_object stream);
 
182
 
 
183
/* global locks */
 
184
 
 
185
#ifdef ECL_THREADS
 
186
# if defined(_MSC_VER) || defined(mingw32)
 
187
#  define pthread_mutex_lock(x) \
 
188
         (WaitForSingleObject(*(HANDLE*)(x), INFINITE) != WAIT_OBJECT_0)
 
189
#  define pthread_mutex_unlock(x) (ReleaseMutex(*(HANDLE*)(x)) == 0)
 
190
# endif
 
191
# define HASH_TABLE_LOCK(h) if ((h)->hash.lockable) if (pthread_mutex_lock(&(h)->hash.lock)) internal_error("")
 
192
# define PACKAGE_LOCK(p) if (pthread_mutex_lock(&(p)->pack.lock)) internal_error("")
 
193
# define PACKAGE_OP_LOCK() if (pthread_mutex_lock(&cl_core.global_lock)) internal_error("")
 
194
# define THREAD_OP_LOCK() if (pthread_mutex_lock(&cl_core.global_lock)) internal_error("")
 
195
# define HASH_TABLE_UNLOCK(h) if ((h)->hash.lockable) if (pthread_mutex_unlock(&(h)->hash.lock)) internal_error("")
 
196
# define PACKAGE_UNLOCK(p) if (pthread_mutex_unlock(&(p)->pack.lock)) internal_error("")
 
197
# define PACKAGE_OP_UNLOCK() if (pthread_mutex_unlock(&cl_core.global_lock)) internal_error("")
 
198
# define THREAD_OP_UNLOCK() if (pthread_mutex_unlock(&cl_core.global_lock)) internal_error("")
 
199
#else
 
200
# define HASH_TABLE_LOCK(h)
 
201
# define HASH_TABLE_UNLOCK(h)
 
202
# define PACKAGE_LOCK(p)
 
203
# define PACKAGE_UNLOCK(p)
 
204
# define PACKAGE_OP_LOCK()
 
205
# define PACKAGE_OP_UNLOCK()
 
206
#endif /* ECL_THREADS */
 
207
 
 
208
 
 
209
/* read.d */
 
210
#define RTABSIZE        CHAR_CODE_LIMIT /*  read table size  */
 
211
 
 
212
/* time.d */
 
213
 
 
214
#define UTC_time_to_universal_time(x) number_plus(make_integer(x),cl_core.Jan1st1970UT)
 
215
extern cl_fixnum ecl_runtime(void);
 
216
 
 
217
/* unixint.d */
 
218
 
 
219
extern bool ecl_interrupt_enable;
 
220
 
 
221
#if defined(_MSC_VER) || defined(mingw32)
 
222
# include <float.h>
 
223
# if defined(_MSC_VER)
 
224
#   define FE_DIVBYZERO EM_ZERODIVIDE
 
225
#   define FE_OVERFLOW  EM_OVERFLOW
 
226
#   define FE_UNDERFLOW EM_UNDERFLOW
 
227
typedef int fenv_t;
 
228
# else
 
229
#   define MCW_EM _MCW_EM
 
230
#   define fenv_t int
 
231
# endif
 
232
# define feenableexcept(bits) { int cw = _controlfp(0,0); cw &= ~(bits); _controlfp(cw,MCW_EM); }
 
233
# define fedisableexcept(bits) { int cw = _controlfp(0,0); cw |= (bits); _controlfp(cw,MCW_EM); }
 
234
# define feholdexcept(bits) { *(bits) = _controlfp(0,0); _controlfp(0xffffffff, MCW_EM); }
 
235
# define fesetenv(bits) _controlfp(*(bits), MCW_EM)
 
236
#endif
 
237
 
 
238
/* unixfsys.d */
 
239
 
 
240
#if defined(_MSC_VER) || defined(mingw32)
 
241
extern cl_object si_get_library_pathname(void);
 
242
#endif
 
243
 
 
244
 
 
245
#ifdef __cplusplus
 
246
}
 
247
#endif