2
internal.h -- Structures and functions that are not meant for the end user
5
Copyright (c) 2001, Juan Jose Garcia Ripoll.
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.
12
See file '../Copyright' for full details.
19
/* -------------------------------------------------------------------- *
20
* FUNCTIONS, VARIABLES AND TYPES NOT FOR GENERAL USE *
21
* -------------------------------------------------------------------- */
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);
30
extern void init_clos(void);
32
extern void init_error(void);
33
extern void init_eval(void);
34
extern void init_file(void);
36
extern void init_GC(void);
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);
45
extern void init_compiler(void);
47
extern void ecl_init_env(struct cl_env_struct *);
48
extern void init_LSP(cl_object);
49
extern void init_CLOS(cl_object);
51
/* alloc.d/alloc_2.d */
53
extern cl_object ecl_alloc_bytecodes(cl_index data_size, cl_index code_size);
57
struct cl_compiler_env {
60
cl_fixnum lexical_level;
68
#define cl_stack_ref(n) cl_env.stack[n]
69
#define cl_stack_index() (cl_env.stack_top-cl_env.stack)
73
#define ECL_FFICALL_LIMIT 256
77
ECL_FFI_UNSIGNED_CHAR,
79
ECL_FFI_UNSIGNED_BYTE,
81
ECL_FFI_UNSIGNED_SHORT,
85
ECL_FFI_UNSIGNED_LONG,
94
union ecl_ffi_values {
112
enum ecl_ffi_calling_convention {
113
ECL_FFI_CC_CDECL = 0,
120
union ecl_ffi_values output;
121
enum ecl_ffi_calling_convention cc;
122
char buffer[ECL_FFICALL_LIMIT];
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);
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);
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
151
#define OPEN_RW "w+b"
153
#define OPEN_RA "a+b"
157
#ifndef ECL_CMU_FORMAT
158
extern cl_object si_formatter_aux _ARGS((cl_narg narg, cl_object strm, cl_object string, ...));
162
extern void ecl_extend_hashtable(cl_object hashtable);
164
/* gfun.d, kernel.lsp */
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])
173
extern cl_object ecl_find_symbol_nolock(cl_object name, cl_object p, int *intern_flag);
177
#define ECL_PPRINT_QUEUE_SIZE 128
178
#define ECL_PPRINT_INDENTATION_STACK_SIZE 256
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);
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)
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("")
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 */
210
#define RTABSIZE CHAR_CODE_LIMIT /* read table size */
214
#define UTC_time_to_universal_time(x) number_plus(make_integer(x),cl_core.Jan1st1970UT)
215
extern cl_fixnum ecl_runtime(void);
219
extern bool ecl_interrupt_enable;
221
#if defined(_MSC_VER) || defined(mingw32)
223
# if defined(_MSC_VER)
224
# define FE_DIVBYZERO EM_ZERODIVIDE
225
# define FE_OVERFLOW EM_OVERFLOW
226
# define FE_UNDERFLOW EM_UNDERFLOW
229
# define MCW_EM _MCW_EM
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)
240
#if defined(_MSC_VER) || defined(mingw32)
241
extern cl_object si_get_library_pathname(void);