mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2025-12-05 18:30:24 -08:00
Code Issues Projects Releases Packages Wiki Activity
ecl/src/h/object.h

1181 lines
41 KiB
C
Raw Blame History

/* -*- Mode: C; c-basic-offset: 8; indent-tabs-mode: nil -*- */
/* vim: set filetype=c tabstop=8 shiftwidth=4 expandtab: */
/*
* Copyright (c) 1984, Taiichi Yuasa and Masami Hagiya.
* Copyright (c) 1990, Giuseppe Attardi.
* Copyright (c) 2001, Juan Jose Garcia Ripoll.
*
* See file 'LICENSE' for the copyright details.
*
*/
/* object.h -- Data structure definitions. */
#ifdef __cplusplus
extern "C" {
#endif
/*
Integer and boolean types (see config.h)
*/
#define TRUE 1 /* boolean true value */
#define FALSE 0 /* boolean false value */
#if !defined(__cplusplus) && !defined(bool)
typedef int bool;
#endif
typedef unsigned char byte;
/*
Implementation types.
Verify that it matches printer/write_ugly.d
*/
typedef enum {
t_start = 0,
t_list = 1,
/* The most specific numeric types come first. Assumed by
some routines, like cl_expt. See ANSI 12.1.1.2. */
t_character = 2, /* immediate character */
t_fixnum = 3, /* immediate fixnum */
t_bignum = 4,
t_ratio,
/* t_shortfloat, */
t_singlefloat,
t_doublefloat,
t_longfloat,
t_complex,
#ifdef ECL_COMPLEX_FLOAT
t_csfloat,
t_cdfloat,
t_clfloat,
t_last_number = t_clfloat,
#else
t_last_number = t_complex,
#endif
t_symbol,
t_package,
t_hashtable,
t_array,
t_vector,
#ifdef ECL_UNICODE
t_string,
#endif
t_base_string,
t_bitvector,
t_stream,
t_random,
t_readtable,
t_pathname,
t_bytecodes,
t_bclosure,
t_cfun,
t_cfunfixed,
t_cclosure,
t_instance,
t_structure = t_instance,
#ifdef ECL_THREADS
t_process,
t_lock,
t_rwlock,
t_condition_variable,
t_semaphore,
t_barrier,
t_mailbox,
#endif
t_codeblock,
t_foreign,
t_frame,
t_weak_pointer,
#ifdef ECL_SSE2
t_sse_pack,
#endif
t_end,
t_other,
t_contiguous, /* contiguous block */
FREE = 127 /* free object */
} cl_type;
/*
Definition of the type of LISP objects.
*/
typedef union cl_lispunion *cl_object;
typedef cl_object cl_return;
typedef cl_fixnum cl_narg;
typedef cl_object (*cl_objectfn)(cl_narg narg, ...);
typedef cl_object (*cl_objectfn_fixed)();
/*
OBJect NULL value.
It should not coincide with any legal object value.
*/
#define OBJNULL ((cl_object)NULL)
/*
Definition of each implementation type.
*/
#define ECL_TAG_BITS 2
#define ECL_IMMEDIATE(o) ((cl_fixnum)(o) & 3)
#define ECL_IMMEDIATE_TAG 3
#define ecl_to_bool(x) ((x)!=ECL_NIL)
#define ecl_make_bool(x) ((x)? ECL_T : ECL_NIL)
/* Immediate fixnums: */
#define ECL_FIXNUM_TAG t_fixnum
#define ECL_FIXNUMP(o) (ECL_IMMEDIATE(o) == t_fixnum)
#define ecl_make_fixnum(n) ((cl_object)(((cl_fixnum)(n) << 2) | t_fixnum))
#define ecl_fixnum_lower(a,b) ((cl_fixnum)(a) < (cl_fixnum)(b))
#define ecl_fixnum_greater(a,b) ((cl_fixnum)(a) > (cl_fixnum)(b))
#define ecl_fixnum_leq(a,b) ((cl_fixnum)(a) <= (cl_fixnum)(b))
#define ecl_fixnum_geq(a,b) ((cl_fixnum)(a) >= (cl_fixnum)(b))
#define ecl_fixnum_plusp(a) ((cl_fixnum)(a) > (cl_fixnum)ecl_make_fixnum(0))
#define ecl_fixnum_minusp(a) ((cl_fixnum)(a) < (cl_fixnum)(0))
#define ecl_fixnum(a) (((cl_fixnum)(a)) >> 2)
/* Immediate characters: */
#define ECL_CHARACTER_TAG t_character
#define ECL_CHARACTERP(o) (ECL_IMMEDIATE(o) == t_character)
#ifdef ECL_UNICODE
#define ECL_BASE_CHAR_P(obje) ((((cl_fixnum)(obje)) & 0xFFFFFC03) == ECL_CHARACTER_TAG)
#define ECL_BASE_CHAR_CODE_P(x) ((x & ~((cl_fixnum)0xFF)) == 0)
#define ECL_CODE_CHAR(c) ((cl_object)(((cl_fixnum)(c << 2)|ECL_CHARACTER_TAG)))
#define ECL_CHAR_CODE(obje) (((cl_fixnum)(obje)) >> 2)
#else
#define ECL_BASE_CHAR_P(o) ECL_CHARACTERP(o)
#define ECL_CODE_CHAR(c) ((cl_object)(((cl_fixnum)((c & 0xff) << 2)|ECL_CHARACTER_TAG)))
#define ECL_CHAR_CODE(obje) ((((cl_fixnum)(obje)) >> 2) & 0xff)
#endif
#define ECL_CHAR_CODE_RETURN 13
#define ECL_CHAR_CODE_NEWLINE 10
#define ECL_CHAR_CODE_LINEFEED 10
#define ECL_NUMBER_TYPE_P(t) (t >= t_fixnum && t <= t_last_number)
#define ECL_REAL_TYPE_P(t) (t >= t_fixnum && t < t_complex)
#define ECL_ARRAYP(x) ((ECL_IMMEDIATE(x) == 0) && (x)->d.t >= t_array && (x)->d.t <= t_bitvector)
#define ECL_VECTORP(x) ((ECL_IMMEDIATE(x) == 0) && (x)->d.t >= t_vector && (x)->d.t <= t_bitvector)
#define ECL_BIT_VECTOR_P(x) ((ECL_IMMEDIATE(x) == 0) && ((x)->d.t == t_bitvector))
#ifdef ECL_UNICODE
#define ECL_STRINGP(x) ((ECL_IMMEDIATE(x) == 0) && \
((x)->d.t == t_base_string || (x)->d.t == t_string))
#define ECL_EXTENDED_STRING_P(x) ((ECL_IMMEDIATE(x) == 0) && (x)->d.t == t_string)
#else
#define ECL_STRINGP(x) ((ECL_IMMEDIATE(x) == 0) && ((x)->d.t == t_base_string))
#define ECL_EXTENDED_STRING_P(x) 0
#endif
#define ECL_BASE_STRING_P(x) ((ECL_IMMEDIATE(x) == 0) && ((x)->d.t == t_base_string))
#define ECL_HASH_TABLE_P(x) ((ECL_IMMEDIATE(x) == 0) && ((x)->d.t == t_hashtable))
#define ECL_BIGNUMP(x) ((ECL_IMMEDIATE(x) == 0) && ((x)->d.t == t_bignum))
#ifdef ECL_COMPLEX_FLOAT
#define ECL_COMPLEXP(x) ((ECL_IMMEDIATE(x) == 0) && ((x)->d.t >= t_complex) && ((x)->d.t <= t_clfloat))
#define ECL_COMPLEX_SINGLE_FLOAT_P(x) ((ECL_IMMEDIATE(x) == 0) && ((x)->d.t == t_csfloat))
#define ECL_COMPLEX_DOUBLE_FLOAT_P(x) ((ECL_IMMEDIATE(x) == 0) && ((x)->d.t == t_cdfloat))
#define ECL_COMPLEX_LONG_FLOAT_P(x) ((ECL_IMMEDIATE(x) == 0) && ((x)->d.t == t_clfloat))
#else
#define ECL_COMPLEXP(x) ((ECL_IMMEDIATE(x) == 0) && ((x)->d.t == t_complex))
#endif
#define ECL_RANDOM_STATE_P(x) ((ECL_IMMEDIATE(x) == 0) && ((x)->d.t == t_random))
#define ECL_SINGLE_FLOAT_P(x) ((ECL_IMMEDIATE(x) == 0) && ((x)->d.t == t_singlefloat))
#define ECL_DOUBLE_FLOAT_P(x) ((ECL_IMMEDIATE(x) == 0) && ((x)->d.t == t_doublefloat))
#define ECL_LONG_FLOAT_P(x) ((ECL_IMMEDIATE(x) == 0) && ((x)->d.t == t_longfloat))
#define ECL_PACKAGEP(x) ((ECL_IMMEDIATE(x) == 0) && ((x)->d.t == t_package))
#define ECL_PATHNAMEP(x) ((ECL_IMMEDIATE(x) == 0) && ((x)->d.t == t_pathname))
#define ECL_READTABLEP(x) ((ECL_IMMEDIATE(x) == 0) && ((x)->d.t == t_readtable))
#define ECL_FOREIGN_DATA_P(x) ((ECL_IMMEDIATE(x) == 0) && ((x)->d.t == t_foreign))
#ifdef ECL_SSE2
#define ECL_SSE_PACK_P(x) ((ECL_IMMEDIATE(x) == 0) && ((x)->d.t == t_sse_pack))
#endif
#define _ECL_HDR int8_t t, m, padding1, padding2
#define _ECL_HDR1(field) int8_t t, m, field, padding
#define _ECL_HDR2(field1,field2) int8_t t, m, field1, field2
struct ecl_singlefloat {
_ECL_HDR;
float SFVAL; /* singlefloat value */
};
#define ecl_single_float(o) ((o)->SF.SFVAL)
struct ecl_doublefloat {
_ECL_HDR;
double DFVAL; /* doublefloat value */
};
#define ecl_double_float(o) ((o)->DF.DFVAL)
struct ecl_long_float {
_ECL_HDR;
long double value;
};
#define ecl_long_float(o) ((o)->longfloat.value)
typedef mpz_t big_num_t;
struct ecl_bignum {
_ECL_HDR;
big_num_t value;
};
#define ecl_bignum(o) ((o)->big.value)
struct ecl_ratio {
_ECL_HDR;
cl_object den; /* denominator, must be an integer */
cl_object num; /* numerator, must be an integer */
};
struct ecl_complex {
_ECL_HDR;
cl_object real; /* real part, must be a number */
cl_object imag; /* imaginary part, must be a number */
};
#ifdef ECL_COMPLEX_FLOAT
struct ecl_csfloat {
_ECL_HDR;
float _Complex value;
};
#define ecl_csfloat(o) ((o)->csfloat.value)
struct ecl_cdfloat {
_ECL_HDR;
double _Complex value;
};
#define ecl_cdfloat(o) ((o)->cdfloat.value)
struct ecl_clfloat {
_ECL_HDR;
long double _Complex value;
};
#define ecl_clfloat(o) ((o)->clfloat.value)
#endif
enum ecl_stype { /* symbol type */
ecl_stp_ordinary = 0,
ecl_stp_constant = 1,
ecl_stp_special = 2,
ecl_stp_macro = 4,
ecl_stp_special_form = 8
};
#define ECL_NIL ((cl_object)t_list)
#define ECL_NIL_SYMBOL ((cl_object)cl_symbols)
#define ECL_T ((cl_object)(cl_symbols+1))
#define ECL_UNBOUND ((cl_object)(cl_symbols+2))
#define ECL_PROTECT_TAG ((cl_object)(cl_symbols+3))
#define ECL_DUMMY_TAG ((cl_object)(cl_symbols+4))
#define ECL_RESTART_CLUSTERS ((cl_object)(cl_symbols+5))
#define ECL_HANDLER_CLUSTERS ((cl_object)(cl_symbols+6))
#define ECL_INTERRUPTS_ENABLED ((cl_object)(cl_symbols+7))
#define ECL_NO_TL_BINDING ((cl_object)(1 << ECL_TAG_BITS))
struct ecl_symbol {
_ECL_HDR1(stype); /* symbol type */
cl_object value; /* global value of the symbol */
/* Coincides with cons.car */
cl_object gfdef; /* global function definition */
/* For a macro, */
/* its expansion function */
/* is to be stored. */
/* Coincides with cons.cdr */
cl_object plist; /* property list */
/* This field coincides with cons.car */
cl_object name; /* print name */
cl_object cname; /* associated C name (or NIL) */
cl_object hpack; /* home package */
/* ECL_NIL for uninterned symbols */
#ifdef ECL_THREADS
cl_index binding; /* index into the bindings array */
#endif
};
#define ECL_SYM_FUN(sym) ((sym)->symbol.gfdef)
struct ecl_package {
_ECL_HDR1(locked);
cl_object name; /* package name, a string */
cl_object nicknames; /* nicknames, list of strings */
cl_object local_nicknames; /* local nicknames, assoc list */
cl_object nicknamedby; /* nicknamed-by-list of packages */
cl_object shadowings; /* shadowing symbol list */
cl_object uses; /* use-list of packages */
cl_object usedby; /* used-by-list of packages */
cl_object internal; /* hashtable for internal symbols */
cl_object external; /* hashtable for external symbols */
};
/*
The values returned by intern and find_symbol.
File_symbol may return 0.
*/
enum {
ECL_INTERNAL = 1,
ECL_EXTERNAL,
ECL_INHERITED
};
/*
* CONSES
*
* We implement two variants. The "small cons" type carries the type
* information in the least significant bits of the pointer. We have
* to do some pointer arithmetics to find out the CAR / CDR of the
* cons but the overall result is faster and memory efficient, only
* using two words per cons.
*
* The other scheme stores conses as three-words objects, the first
* word carrying the type information. This is kept for backward
* compatibility and also because the oldest garbage collector does
* not yet support the smaller datatype.
*
* To make code portable and independent of the representation, only
* access the objects using the common macros below (that is all
* except ECL_CONS_PTR or ECL_PTR_CONS).
*/
#ifdef ECL_SMALL_CONS
#define ECL_LISTP(x) (ECL_IMMEDIATE(x) == t_list)
#define ECL_CONSP(x) (LISTP(x) && !Null(x))
#define ECL_ATOM(x) (Null(x) || !LISTP(x))
#define ECL_SYMBOLP(x) (Null(x) || ((ECL_IMMEDIATE(x) == 0) && ((x)->d.t == t_symbol)))
#define ECL_PTR_CONS(x) (cl_object)((char*)(x) + t_list)
#define ECL_CONS_PTR(x) ((struct ecl_cons *)((char *)(x) - t_list))
#define ECL_CONS_CAR(x) (*(cl_object*)((char *)(x) - t_list))
#define ECL_CONS_CDR(x) (*(cl_object*)((char *)(x) + sizeof(cl_object) - t_list))
#define ECL_RPLACA(x,v) (ECL_CONS_CAR(x)=(v))
#define ECL_RPLACD(x,v) (ECL_CONS_CDR(x)=(v))
struct ecl_cons {
cl_object car; /* car */
cl_object cdr; /* cdr */
};
#else
#define ECL_LISTP(x) (ECL_IMMEDIATE(x)? Null(x) : ((x)->d.t == t_list))
#define ECL_CONSP(x) ((ECL_IMMEDIATE(x) == 0) && ((x)->d.t == t_list))
#define ECL_ATOM(x) (ECL_IMMEDIATE(x) || ((x)->d.t != t_list))
#define ECL_SYMBOLP(x) (Null(x) || ((ECL_IMMEDIATE(x) == 0) && ((x)->d.t == t_symbol)))
#define ECL_CONS_CAR(x) ((x)->cons.car)
#define ECL_CONS_CDR(x) ((x)->cons.cdr)
#define ECL_RPLACA(x,v) (ECL_CONS_CAR(x)=(v))
#define ECL_RPLACD(x,v) (ECL_CONS_CDR(x)=(v))
struct ecl_cons {
_ECL_HDR;
cl_object car; /* car */
cl_object cdr; /* cdr */
};
#endif
enum ecl_httest { /* hash table key test function */
ecl_htt_eq, /* eq */
ecl_htt_eql, /* eql */
ecl_htt_equal, /* equal */
ecl_htt_equalp, /* equalp */
ecl_htt_pack, /* symbol hash */
ecl_htt_generic /* generic user-supplied test */
};
enum ecl_htweak {
ecl_htt_not_weak = 0,
ecl_htt_weak_key,
ecl_htt_weak_value,
ecl_htt_weak_key_and_value,
ecl_htt_weak_key_or_value
};
struct ecl_hashtable_entry { /* hash table entry */
cl_object key; /* key */
cl_object value; /* value */
};
struct ecl_hashtable { /* hash table header */
_ECL_HDR2(test,weak);
struct ecl_hashtable_entry *data; /* pointer to the hash table */
cl_object sync_lock; /* synchronization lock */
cl_object generic_test; /* generic test function */
cl_object generic_hash; /* generic hashing function */
cl_index entries; /* number of entries */
cl_index size; /* hash table size */
cl_index limit; /* hash table threshold (integer value) */
cl_object rehash_size; /* rehash size */
cl_object threshold; /* rehash threshold */
double factor; /* cached value of threshold */
cl_object (*get)(cl_object, cl_object, cl_object);
cl_object (*set)(cl_object, cl_object, cl_object);
bool (*rem)(cl_object, cl_object);
/* Unsafe variants are used to store the real accessors when
the synchronized variant is bound to get/set/rem. */
cl_object (*get_unsafe)(cl_object, cl_object, cl_object);
cl_object (*set_unsafe)(cl_object, cl_object, cl_object);
bool (*rem_unsafe)(cl_object, cl_object);
};
typedef enum { /* array element type */
ecl_aet_object, /* t */
ecl_aet_sf, /* single-float */
ecl_aet_df, /* double-float */
ecl_aet_lf, /* long-float */
#ifdef ECL_COMPLEX_FLOAT
ecl_aet_csf, /* complex-single-float */
ecl_aet_cdf, /* complex-double-float */
ecl_aet_clf, /* complex-long-float */
#endif
ecl_aet_bit, /* bit */
ecl_aet_fix, /* cl_fixnum */
ecl_aet_index, /* cl_index */
/* Below here, list types accepted by streams (i.e. OPEN) */
ecl_aet_b8, /* byte8 */
ecl_aet_i8, /* integer8 */
#ifdef ecl_uint16_t
ecl_aet_b16,
ecl_aet_i16,
#endif
#ifdef ecl_uint32_t
ecl_aet_b32,
ecl_aet_i32,
#endif
#ifdef ecl_uint64_t
ecl_aet_b64,
ecl_aet_i64,
#endif
#ifdef ECL_UNICODE
ecl_aet_ch, /* character */
#endif
ecl_aet_bc, /* base-char */
ecl_aet_last_type = ecl_aet_bc
} cl_elttype;
union ecl_array_data {
cl_object *t;
ecl_base_char *bc;
#ifdef ECL_UNICODE
ecl_character *c;
#endif
uint8_t *b8;
int8_t *i8;
#ifdef ecl_uint16_t
ecl_uint16_t *b16;
ecl_int16_t *i16;
#endif
#ifdef ecl_uint32_t
ecl_uint32_t *b32;
ecl_int32_t *i32;
#endif
#ifdef ecl_uint64_t
ecl_uint64_t *b64;
ecl_int64_t *i64;
#endif
float *sf;
double *df;
long double *lf;
#ifdef ECL_COMPLEX_FLOAT
float _Complex *csf;
double _Complex *cdf;
long double _Complex *clf;
#endif
cl_fixnum *fix;
cl_index *index;
byte *bit;
};
#define ECL_FLAG_HAS_FILL_POINTER 1
#define ECL_FLAG_ADJUSTABLE 2
#define ECL_ADJUSTABLE_ARRAY_P(x) ((x)->array.flags & ECL_FLAG_ADJUSTABLE)
#define ECL_ARRAY_HAS_FILL_POINTER_P(x) ((x)->array.flags & ECL_FLAG_HAS_FILL_POINTER)
struct ecl_array { /* array header */
/* adjustable flag */
/* has-fill-pointer flag */
_ECL_HDR2(elttype,flags); /* array element type, has fill ptr, adjustable-p */
cl_object displaced; /* displaced */
cl_index dim; /* dimension */
cl_index *dims; /* table of dimensions */
union ecl_array_data self; /* pointer to the array */
byte offset; /* bitvector offset */
byte rank; /* rank of array = # of dimensions */
};
struct ecl_vector { /* vector header */
/* adjustable flag */
/* has-fill-pointer flag */
_ECL_HDR2(elttype,flags); /* array element type, has fill ptr, adjustable-p */
cl_object displaced; /* displaced */
cl_index dim; /* dimension */
cl_index fillp; /* fill pointer */
/* For simple vectors, fillp is equal to dim. */
union ecl_array_data self; /* pointer to the vector */
byte offset;
};
struct ecl_base_string { /* string header */
/* adjustable flag */
/* has-fill-pointer flag */
_ECL_HDR2(elttype,flags); /* array element type, has fill ptr, adjustable-p */
cl_object displaced; /* displaced */
cl_index dim; /* dimension */
/* string length */
cl_index fillp; /* fill pointer */
/* For simple strings, */
/* st_fillp is equal to st_dim-1. */
ecl_base_char *self; /* pointer to the string */
};
#ifdef ECL_UNICODE
struct ecl_string { /* string header */
/* adjustable flag */
/* has-fill-pointer flag */
_ECL_HDR2(elttype,flags); /* array element type, has fill ptr, adjustable-p */
cl_object displaced; /* displaced */
cl_index dim; /* dimension, string length */
cl_index fillp; /* fill pointer */
/* For simple strings, fillp is equal to dim-1. */
ecl_character *self; /* pointer to the string */
};
#endif
#define T_STRUCTURE t_instance
#define ECL_STRUCT_TYPE(x) ECL_CLASS_OF(x)
#define ECL_STRUCT_SLOTS(x) (x)->instance.slots
#define ECL_STRUCT_LENGTH(x) (x)->instance.length
#define ECL_STRUCT_SLOT(x,i) (x)->instance.slots[i]
#define ECL_STRUCT_NAME(x) ECL_CLASS_NAME(ECL_CLASS_OF(x))
enum ecl_smmode { /* stream mode */
ecl_smm_input, /* input */
ecl_smm_input_file, /* input */
ecl_smm_output, /* output */
ecl_smm_output_file, /* output */
ecl_smm_io, /* input-output */
ecl_smm_io_file, /* input-output */
ecl_smm_synonym, /* synonym */
ecl_smm_broadcast, /* broadcast */
ecl_smm_concatenated, /* concatenated */
ecl_smm_two_way, /* two way */
ecl_smm_echo, /* echo */
ecl_smm_string_input, /* string input */
ecl_smm_string_output, /* string output */
ecl_smm_probe, /* probe (only used in open_stream()) */
#if defined(ECL_WSOCK)
ecl_smm_input_wsock, /* input socket (Win32) */
ecl_smm_output_wsock, /* output socket (Win32) */
ecl_smm_io_wsock, /* input/output socket (Win32) */
#endif
#if defined(ECL_MS_WINDOWS_HOST)
ecl_smm_io_wcon, /* windows console (Win32) */
#endif
ecl_smm_sequence_input, /* sequence input */
ecl_smm_sequence_output /* sequence output */
};
struct ecl_file_ops {
cl_index (*write_byte8)(cl_object strm, unsigned char *c, cl_index n);
cl_index (*read_byte8)(cl_object strm, unsigned char *c, cl_index n);
void (*write_byte)(cl_object c, cl_object strm);
cl_object (*read_byte)(cl_object strm);
int (*read_char)(cl_object strm);
int (*write_char)(cl_object strm, int c);
void (*unread_char)(cl_object strm, int c);
int (*peek_char)(cl_object strm);
cl_index (*read_vector)(cl_object strm, cl_object data, cl_index start, cl_index end);
cl_index (*write_vector)(cl_object strm, cl_object data, cl_index start, cl_index end);
int (*listen)(cl_object strm);
void (*clear_input)(cl_object strm);
void (*clear_output)(cl_object strm);
void (*finish_output)(cl_object strm);
void (*force_output)(cl_object strm);
int (*input_p)(cl_object strm);
int (*output_p)(cl_object strm);
int (*interactive_p)(cl_object strm);
cl_object (*element_type)(cl_object strm);
cl_object (*length)(cl_object strm);
cl_object (*get_position)(cl_object strm);
cl_object (*set_position)(cl_object strm, cl_object pos);
int (*column)(cl_object strm);
cl_object (*close)(cl_object strm);
};
enum {
ECL_STREAM_BINARY = 0,
ECL_STREAM_FORMAT = 0xF,
#ifndef ECL_UNICODE
ECL_STREAM_DEFAULT_FORMAT = 1,
#else
ECL_STREAM_DEFAULT_FORMAT = 2,
ECL_STREAM_ISO_8859_1 = 1,
ECL_STREAM_LATIN_1 = 1,
ECL_STREAM_UTF_8 = 2,
ECL_STREAM_UCS_2 = 3,
ECL_STREAM_UCS_2LE = 5 + 128,
ECL_STREAM_UCS_2BE = 5,
ECL_STREAM_UCS_4 = 6,
ECL_STREAM_UCS_4LE = 7 + 128,
ECL_STREAM_UCS_4BE = 7,
ECL_STREAM_USER_FORMAT = 8,
ECL_STREAM_US_ASCII = 10,
#endif
ECL_STREAM_CR = 16,
ECL_STREAM_LF = 32,
ECL_STREAM_SIGNED_BYTES = 64,
ECL_STREAM_LITTLE_ENDIAN = 128,
ECL_STREAM_C_STREAM = 256,
ECL_STREAM_MIGHT_SEEK = 512,
ECL_STREAM_CLOSE_COMPONENTS = 1024,
ECL_STREAM_CLOSE_ON_EXEC = 2048,
ECL_STREAM_NONBLOCK = 4096
};
/* buffer points to an array of bytes ending at buffer_end. Decode one
character from this array and advance buffer by the number of bytes
consumed. If not enough bytes are available, return EOF and don't
advance buffer. */
typedef ecl_character (*cl_eformat_decoder)(cl_object stream, unsigned char **buffer, unsigned char *buffer_end);
/* Encode the character c and store the result in buffer. Return the
number of bytes used */
typedef int (*cl_eformat_encoder)(cl_object stream, unsigned char *buffer, ecl_character c);
#define ECL_ANSI_STREAM_P(o) \
(ECL_IMMEDIATE(o) == 0 && ((o)->d.t == t_stream))
#define ECL_ANSI_STREAM_TYPE_P(o,m) \
(ECL_IMMEDIATE(o) == 0 && ((o)->d.t == t_stream) && ((o)->stream.mode == (m)))
struct ecl_stream {
_ECL_HDR2(mode,closed); /* stream mode of enum smmode */
/* closed stream? */
struct ecl_file_ops *ops; /* dispatch table */
union {
FILE *stream; /* ANSI C streams */
cl_fixnum descriptor; /* POSIX files */
} file;
cl_object object0; /* some object */
cl_object object1; /* some object */
cl_object byte_stack; /* buffer for unread bytes */
cl_index column; /* file column */
cl_fixnum last_char; /* last character read */
cl_fixnum last_code[2]; /* actual composition of last character */
cl_fixnum int0; /* some int */
cl_fixnum int1; /* some int */
cl_index byte_size; /* size of byte in binary streams */
cl_fixnum last_op; /* 0: unknown, 1: reading, -1: writing */
char *buffer; /* buffer for FILE */
cl_object format; /* external format */
cl_eformat_encoder encoder;
cl_eformat_decoder decoder;
cl_object format_table;
int flags; /* character table, flags, etc */
ecl_character eof_char;
};
struct ecl_random {
_ECL_HDR;
cl_object value; /* random state value */
};
enum ecl_chattrib { /* character attribute */
cat_whitespace, /* whitespace */
cat_terminating, /* terminating macro */
cat_non_terminating, /* non-terminating macro */
cat_single_escape, /* single-escape */
cat_multiple_escape, /* multiple-escape */
cat_constituent /* constituent */
};
struct ecl_readtable_entry { /* read table entry */
enum ecl_chattrib syntax_type; /* character attribute */
cl_object dispatch; /* a macro, a hash or NIL */
};
enum ecl_readtable_case {
ecl_case_upcase,
ecl_case_downcase,
ecl_case_invert,
ecl_case_preserve
};
struct ecl_readtable { /* read table */
_ECL_HDR1(locked);
enum ecl_readtable_case read_case; /* readtable-case */
struct ecl_readtable_entry *table; /* read table itself */
#ifdef ECL_UNICODE
cl_object hash; /* hash for values outside base-char range */
#endif
};
struct ecl_pathname {
_ECL_HDR1(logical); /* logical pathname? */
cl_object host; /* host */
cl_object device; /* device */
cl_object directory; /* directory */
cl_object name; /* name */
cl_object type; /* type */
cl_object version; /* version */
};
struct ecl_codeblock {
_ECL_HDR2(self_destruct,locked); /* delete DLL after gc */
/* do not garbage collect this library */
void *handle; /* handle returned by dlopen */
void *entry; /* entry point */
cl_object *data; /* data vector */
int data_size;
cl_object *temp_data; /* data vector for toplevel forms */
int temp_data_size;
const cl_object *data_text; /* strings with objects to be defined */
cl_object next; /* next codeblock within same library */
cl_object name;
cl_object links; /* list of symbols with linking calls */
cl_index cfuns_size; /* number of functions defined */
const struct ecl_cfunfixed *cfuns;
cl_object source; /* common debug information for this block */
cl_object refs; /* reference counter for the library */
cl_object error; /* error message when loading */
};
struct ecl_bytecodes {
_ECL_HDR;
cl_object name; /* function name */
cl_object definition; /* function definition in list form */
cl_objectfn entry; /* entry address (must match the position of
* the equivalent field in cfun) */
cl_index code_size; /* number of bytecodes */
char *code; /* the intermediate language */
cl_object data; /* non-inmediate constants used in the code */
cl_object file; /* file where it was defined... */
cl_object file_position;/* and where it was created */
};
struct ecl_bclosure {
_ECL_HDR;
cl_object code;
cl_object lex;
cl_objectfn entry; /* entry address */
};
struct ecl_cfun { /* compiled function header */
_ECL_HDR1(narg); /* number of fixed arguments */
cl_object name; /* compiled function name */
cl_object block; /* descriptor of C code block for GC */
cl_objectfn entry; /* entry address */
#ifdef ECL_C_COMPATIBLE_VARIADIC_DISPATCH
/* Some architectures (i.e. ARM64 on iOS/Mac OS X) use a different
* calling convention for the fixed and variadic arguments of
* a variadic function. The only portable way to allow for
* function redefinitions during runtime in these
* architectures is to set entry to a dispatch function
* calling entry_variadic with the correct calling conventions
* (see cfun.d). -- mg 2019-12-02 */
cl_objectfn entry_variadic;
#endif
cl_object file; /* file where it was defined... */
cl_object file_position;/* and where it was created */
};
struct ecl_cfunfixed { /* compiled function header */
_ECL_HDR1(narg); /* number of arguments */
cl_object name; /* compiled function name */
cl_object block; /* descriptor of C code block for GC */
cl_objectfn entry; /* entry address (must match the position of
* the equivalent field in cfun) */
cl_objectfn_fixed entry_fixed; /* entry address */
cl_object file; /* file where it was defined... */
cl_object file_position;/* and where it was created */
};
struct ecl_cclosure { /* compiled closure header */
_ECL_HDR1(narg); /* number of fixed arguments */
cl_object env; /* environment */
cl_object block; /* descriptor of C code block for GC */
cl_objectfn entry; /* entry address (must match the position of
* the equivalent field in cfun) */
#ifdef ECL_C_COMPATIBLE_VARIADIC_DISPATCH
cl_objectfn entry_variadic; /* see struct ecl_cfun above */
#endif
cl_object file; /* file where it was defined... */
cl_object file_position;/* and where it was created */
};
#define ECL_FFICALL_LIMIT 256
enum ecl_ffi_tag {
ECL_FFI_CHAR = 0,
ECL_FFI_UNSIGNED_CHAR,
ECL_FFI_BYTE,
ECL_FFI_UNSIGNED_BYTE,
ECL_FFI_SHORT,
ECL_FFI_UNSIGNED_SHORT,
ECL_FFI_INT,
ECL_FFI_UNSIGNED_INT,
ECL_FFI_LONG,
ECL_FFI_UNSIGNED_LONG,
#ifdef ecl_uint8_t
ECL_FFI_INT8_T,
ECL_FFI_UINT8_T,
#endif
#ifdef ecl_uint16_t
ECL_FFI_INT16_T,
ECL_FFI_UINT16_T,
#endif
#ifdef ecl_uint32_t
ECL_FFI_INT32_T,
ECL_FFI_UINT32_T,
#endif
#ifdef ecl_uint64_t
ECL_FFI_INT64_T,
ECL_FFI_UINT64_T,
#endif
#ifdef ecl_long_long_t
ECL_FFI_LONG_LONG,
ECL_FFI_UNSIGNED_LONG_LONG,
#endif
ECL_FFI_POINTER_VOID,
ECL_FFI_CSTRING,
ECL_FFI_OBJECT,
ECL_FFI_FLOAT,
ECL_FFI_DOUBLE,
ECL_FFI_LONG_DOUBLE,
#ifdef ECL_COMPLEX_FLOAT
ECL_FFI_CSFLOAT,
ECL_FFI_CDFLOAT,
ECL_FFI_CLFLOAT,
#endif
ECL_FFI_VOID
};
union ecl_ffi_values {
char c;
unsigned char uc;
int8_t b;
uint8_t ub;
int i;
unsigned int ui;
short s;
unsigned short us;
long l;
unsigned long ul;
#ifdef ecl_uint8_t
ecl_int8_t i8;
ecl_uint8_t u8;
#endif
#ifdef ecl_uint16_t
ecl_int16_t i16;
ecl_uint16_t u16;
#endif
#ifdef ecl_uint32_t
ecl_int32_t i32;
ecl_uint32_t u32;
#endif
#ifdef ecl_uint64_t
ecl_int64_t i64;
ecl_uint64_t u64;
#endif
#ifdef ecl_long_long_t
ecl_long_long_t ll;
ecl_ulong_long_t ull;
unsigned long l2[2];
#endif
void *pv;
char *pc;
cl_object o;
float f;
double d;
long double lf;
#ifdef ECL_COMPLEX_FLOAT
float _Complex csf;
double _Complex cdf;
long double _Complex clf;
#endif
};
struct ecl_foreign { /* user defined datatype */
_ECL_HDR;
cl_object tag; /* a tag identifying the type */
cl_index size; /* the amount of memory allocated */
char *data; /* the data itself */
};
struct ecl_stack_frame {
_ECL_HDR;
cl_object *stack; /* Is this relative to the lisp stack? */
cl_object *base; /* Start of frame */
cl_index size; /* Number of arguments */
struct cl_env_struct *env;
};
struct ecl_weak_pointer { /* weak pointer to value */
_ECL_HDR;
cl_object value;
};
#define ecl_weak_pointer(o) ((o)->weak.value)
/*
dummy type
*/
struct ecl_dummy {
_ECL_HDR;
};
#ifdef ECL_THREADS
#ifdef ECL_WINDOWS_THREADS
typedef HANDLE ecl_thread_t;
typedef HANDLE ecl_mutex_t;
typedef struct ecl_cond_var_t {
HANDLE broadcast_event;
HANDLE signal_event;
cl_index state;
} ecl_cond_var_t;
typedef SRWLOCK ecl_rwlock_t;
#else
typedef pthread_t ecl_thread_t;
typedef pthread_mutex_t ecl_mutex_t;
typedef pthread_cond_t ecl_cond_var_t;
# ifdef HAVE_POSIX_RWLOCK
typedef pthread_rwlock_t ecl_rwlock_t;
# else
typedef struct ecl_rwlock_t {
pthread_mutex_t mutex;
pthread_cond_t reader_cv;
pthread_cond_t writer_cv;
/* reader_count = 0: lock is free
* reader_count =-1: writer holds the lock
* reader_count > 0: number of readers */
cl_fixnum reader_count;
} ecl_rwlock_t;
# endif
#endif
enum {
ECL_PROCESS_INACTIVE = 0,
ECL_PROCESS_BOOTING,
ECL_PROCESS_ACTIVE,
ECL_PROCESS_EXITING
};
struct ecl_process {
_ECL_HDR;
cl_object name;
cl_object function;
cl_object args;
struct cl_env_struct *env;
cl_object interrupt;
cl_object initial_bindings;
cl_object parent;
cl_object exit_values;
cl_object woken_up;
ecl_mutex_t start_stop_lock; /* phase is updated only when we hold this lock */
ecl_cond_var_t exit_barrier; /* process-join waits on this barrier */
cl_index phase;
ecl_thread_t thread;
int trap_fpe_bits;
};
enum {
ECL_WAKEUP_ONE = 0,
ECL_WAKEUP_ALL = 1,
ECL_WAKEUP_RESET_FLAG = 2,
ECL_WAKEUP_KILL = 4,
ECL_WAKEUP_DELETE = 8
};
struct ecl_semaphore {
_ECL_HDR;
cl_object name;
cl_fixnum counter;
cl_fixnum wait_count;
ecl_mutex_t mutex;
ecl_cond_var_t cv;
};
#define ECL_BARRIER_WAKEUP_NORMAL 1
#define ECL_BARRIER_WAKEUP_KILL 2
struct ecl_barrier {
_ECL_HDR2(disabled,wakeup);
cl_object name;
cl_index count;
cl_index arrivers_count;
ecl_mutex_t mutex;
ecl_cond_var_t cv;
};
struct ecl_lock {
_ECL_HDR1(recursive);
ecl_mutex_t mutex;
cl_object owner; /* thread holding the lock or NIL */
cl_object name;
cl_fixnum counter;
};
struct ecl_mailbox {
_ECL_HDR;
cl_object name;
cl_object data;
ecl_mutex_t mutex;
ecl_cond_var_t reader_cv;
ecl_cond_var_t writer_cv;
cl_index message_count;
cl_index read_pointer;
cl_index write_pointer;
};
struct ecl_rwlock {
_ECL_HDR;
cl_object name;
ecl_rwlock_t mutex;
};
struct ecl_condition_variable {
_ECL_HDR;
ecl_cond_var_t cv;
};
#endif /* ECL_THREADS */
#define ECL_CLASS_OF(x) (x)->instance.clas
#define ECL_SPEC_FLAG(x) (x)->instance.slots[0]
#define ECL_SPEC_OBJECT(x) (x)->instance.slots[3]
#define ECL_CLASS_NAME(x) (x)->instance.slots[3+0]
#define ECL_CLASS_SUPERIORS(x) (x)->instance.slots[3+1]
#define ECL_CLASS_INFERIORS(x) (x)->instance.slots[3+2]
#define ECL_CLASS_SLOTS(x) (x)->instance.slots[3+3]
#define ECL_CLASS_CPL(x) (x)->instance.slots[3+4]
#define ECL_INSTANCEP(x) ((ECL_IMMEDIATE(x)==0) && ((x)->d.t==t_instance))
#define ECL_NOT_FUNCALLABLE 0
#define ECL_STANDARD_DISPATCH 1
#define ECL_RESTRICTED_DISPATCH 2
#define ECL_READER_DISPATCH 3
#define ECL_WRITER_DISPATCH 4
#define ECL_USER_DISPATCH 5
struct ecl_instance { /* -- instance header -- */
_ECL_HDR1(isgf); /* gf type */
cl_index length; /* instance length */
cl_object clas; /* instance class */
cl_objectfn entry; /* entry address */
cl_object slotds; /* slot definitions */
cl_object *slots; /* instance slots */
cl_index stamp; /* instance stamp */
cl_index class_stamp; /* class stamp */
};
#ifdef ECL_SSE2
union ecl_sse_data {
/* This member must be first in order for
ecl_def_ct_sse_pack to work properly. */
uint8_t b8[16];
int8_t i8[16];
__m128 vf;
__m128i vi;
__m128d vd;
#ifdef ecl_uint16_t
ecl_uint16_t b16[8];
ecl_int16_t i16[8];
#endif
#ifdef ecl_uint32_t
ecl_uint32_t b32[4];
ecl_int32_t i32[4];
#endif
#ifdef ecl_uint64_t
ecl_uint64_t b64[2];
ecl_int64_t i64[2];
#endif
float sf[4];
double df[2];
};
struct ecl_sse_pack {
_ECL_HDR1(elttype);
union ecl_sse_data data;
};
#endif
/*
Definition of lispunion.
*/
union cl_lispunion {
#ifndef ECL_SMALL_CONS
struct ecl_cons cons; /* unoptimized cons */
#endif
struct ecl_bignum big; /* bignum */
struct ecl_ratio ratio; /* ratio */
struct ecl_singlefloat SF; /* single floating-point number */
struct ecl_doublefloat DF; /* double floating-point number */
struct ecl_long_float longfloat; /* long-float */
struct ecl_complex gencomplex; /* generic complex number */
#ifdef ECL_COMPLEX_FLOAT
struct ecl_csfloat csfloat; /* complex single float */
struct ecl_cdfloat cdfloat; /* complex double float */
struct ecl_clfloat clfloat; /* complex long float */
#endif
struct ecl_symbol symbol; /* symbol */
struct ecl_package pack; /* package */
struct ecl_hashtable hash; /* hash table */
struct ecl_array array; /* array */
struct ecl_vector vector; /* vector */
struct ecl_base_string base_string; /* base-string */
#ifdef ECL_UNICODE
struct ecl_string string; /* string */
#endif
struct ecl_stream stream; /* stream */
struct ecl_random random; /* random-states */
struct ecl_readtable readtable; /* read table */
struct ecl_pathname pathname; /* path name */
struct ecl_bytecodes bytecodes; /* bytecompiled function / code */
struct ecl_bclosure bclosure; /* bytecompiled closure */
struct ecl_cfun cfun; /* compiled function */
struct ecl_cfunfixed cfunfixed; /* compiled function */
struct ecl_cclosure cclosure; /* compiled closure */
struct ecl_dummy d; /* dummy */
struct ecl_instance instance; /* clos instance */
#ifdef ECL_THREADS
struct ecl_process process; /* process */
struct ecl_lock lock; /* lock */
struct ecl_rwlock rwlock; /* read/write lock */
struct ecl_condition_variable condition_variable; /* condition-variable */
struct ecl_semaphore semaphore; /* semaphore */
struct ecl_barrier barrier; /* barrier */
struct ecl_mailbox mailbox; /* mailbox */
#endif
struct ecl_codeblock cblock; /* codeblock */
struct ecl_foreign foreign; /* user defined data type */
struct ecl_stack_frame frame; /* stack frame */
struct ecl_weak_pointer weak; /* weak pointers */
#ifdef ECL_SSE2
struct ecl_sse_pack sse;
#endif
};
/*
Type_of.
*/
#if defined(__cplusplus) || (defined(__GNUC__) && !defined(__STRICT_ANSI__))
static inline cl_type ecl_t_of(cl_object o) {
int i = ECL_IMMEDIATE(o);
return (i? (cl_type)i : (cl_type)(o->d.t));
}
#else
#define ecl_t_of(o) \
((cl_type)(ECL_IMMEDIATE(o) ? ECL_IMMEDIATE(o) : ((o)->d.t)))
#endif
/*
This is used to retrieve optional arguments
*/
typedef struct {
va_list args;
cl_object *sp;
int narg;
} ecl_va_list[1];
#ifdef __cplusplus
}
#endif
Reference in a new issue View git blame Copy permalink