mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-01-02 23:50:56 -08:00
Most structure and enumeration types are renamed to avoid clashes with other libraries (most notably C++).
This commit is contained in:
jjgarcia
parent
fc8deffa71
commit
dfe6fb3213
16 changed files with 270 additions and 209 deletions
|
|
@ -1601,6 +1601,10 @@ ECL 0.9c
|
|||
provides information about the usual name conventions for
|
||||
executables, libraries, object files, C files, etc.
|
||||
|
||||
- Many internal types, such as those used to represent arrays,
|
||||
vectors, etc, and which do not need to be used directly, have
|
||||
received the prefix "ecl" to avoid name clashes with C/C++ libraries.
|
||||
|
||||
* Errors fixed:
|
||||
|
||||
- The compiler was too eager when replacing variables, so that
|
||||
|
|
@ -1624,6 +1628,18 @@ ECL 0.9c
|
|||
- READ/WRITE-SEQUENCE would read or write one element more than
|
||||
required.
|
||||
|
||||
* ANSI compatibility:
|
||||
|
||||
- Hashtables can now have EQUALP as test function.
|
||||
|
||||
- The compiler no longer handles IN-PACKAGE and DEFPACKAGE specially.
|
||||
When a symbol is loaded from a compiled file, and the home package
|
||||
of this symbol does not exist, a new incomplete package is
|
||||
created. If MAKE-PACKAGE is invoked subsequently in this binary
|
||||
file, the incomplete package is finished and returned. If at the
|
||||
end of the load process there are still incomplete packages, a
|
||||
correctable error is signaled.
|
||||
|
||||
TODO:
|
||||
=====
|
||||
|
||||
|
|
|
|||
|
|
@ -139,7 +139,7 @@ static void
|
|||
make_this_symbol(int i, cl_object s, int code, const char *name,
|
||||
cl_objectfn fun, int narg, cl_object value)
|
||||
{
|
||||
enum stype stp;
|
||||
enum ecl_stype stp;
|
||||
cl_object package;
|
||||
|
||||
switch (code & 3) {
|
||||
|
|
|
|||
|
|
@ -693,39 +693,39 @@ init_alloc(void)
|
|||
|
||||
/* Initialization must be done in increasing size order: */
|
||||
init_tm(t_shortfloat, "FSHORT-FLOAT", /* 8 */
|
||||
sizeof(struct shortfloat_struct), 1);
|
||||
sizeof(struct ecl_shortfloat), 1);
|
||||
init_tm(t_cons, ".CONS", sizeof(struct cons), 384); /* 12 */
|
||||
init_tm(t_longfloat, "LLONG-FLOAT", /* 16 */
|
||||
sizeof(struct longfloat_struct), 1);
|
||||
init_tm(t_bytecodes, "bBYTECODES", sizeof(struct bytecodes), 64);
|
||||
init_tm(t_string, "\"STRING", sizeof(struct string), 64); /* 20 */
|
||||
init_tm(t_array, "aARRAY", sizeof(struct array), 64); /* 24 */
|
||||
init_tm(t_pathname, "pPATHNAME", sizeof(struct pathname), 1); /* 28 */
|
||||
init_tm(t_symbol, "|SYMBOL", sizeof(struct symbol), 64); /* 32 */
|
||||
init_tm(t_package, ":PACKAGE", sizeof(struct package), 1); /* 36 */
|
||||
init_tm(t_codeblock, "#CODEBLOCK", sizeof(struct codeblock), 1);
|
||||
init_tm(t_bignum, "BBIGNUM", sizeof(struct bignum), 16);
|
||||
init_tm(t_ratio, "RRATIO", sizeof(struct ratio), 1);
|
||||
init_tm(t_complex, "CCOMPLEX", sizeof(struct complex), 1);
|
||||
init_tm(t_hashtable, "hHASH-TABLE", sizeof(struct hashtable), 1);
|
||||
init_tm(t_vector, "vVECTOR", sizeof(struct vector), 2);
|
||||
init_tm(t_bitvector, "bBIT-VECTOR", sizeof(struct vector), 1);
|
||||
init_tm(t_stream, "sSTREAM", sizeof(struct stream), 1);
|
||||
init_tm(t_random, "$RANDOM-STATE", sizeof(struct random), 1);
|
||||
init_tm(t_readtable, "rREADTABLE", sizeof(struct readtable), 1);
|
||||
init_tm(t_cfun, "fCFUN", sizeof(struct cfun), 32);
|
||||
init_tm(t_cclosure, "cCCLOSURE", sizeof(struct cclosure), 1);
|
||||
sizeof(struct ecl_longfloat), 1);
|
||||
init_tm(t_bytecodes, "bBYTECODES", sizeof(struct ecl_bytecodes), 64);
|
||||
init_tm(t_string, "\"STRING", sizeof(struct ecl_string), 64); /* 20 */
|
||||
init_tm(t_array, "aARRAY", sizeof(struct ecl_array), 64); /* 24 */
|
||||
init_tm(t_pathname, "pPATHNAME", sizeof(struct ecl_pathname), 1); /* 28 */
|
||||
init_tm(t_symbol, "|SYMBOL", sizeof(struct ecl_symbol), 64); /* 32 */
|
||||
init_tm(t_package, ":PACKAGE", sizeof(struct ecl_package), 1); /* 36 */
|
||||
init_tm(t_codeblock, "#CODEBLOCK", sizeof(struct ecl_codeblock), 1);
|
||||
init_tm(t_bignum, "BBIGNUM", sizeof(struct ecl_bignum), 16);
|
||||
init_tm(t_ratio, "RRATIO", sizeof(struct ecl_ratio), 1);
|
||||
init_tm(t_complex, "CCOMPLEX", sizeof(struct ecl_complex), 1);
|
||||
init_tm(t_hashtable, "hHASH-TABLE", sizeof(struct ecl_hashtable), 1);
|
||||
init_tm(t_vector, "vVECTOR", sizeof(struct ecl_vector), 2);
|
||||
init_tm(t_bitvector, "bBIT-VECTOR", sizeof(struct ecl_vector), 1);
|
||||
init_tm(t_stream, "sSTREAM", sizeof(struct ecl_stream), 1);
|
||||
init_tm(t_random, "$RANDOM-STATE", sizeof(struct ecl_random), 1);
|
||||
init_tm(t_readtable, "rREADTABLE", sizeof(struct ecl_readtable), 1);
|
||||
init_tm(t_cfun, "fCFUN", sizeof(struct ecl_cfun), 32);
|
||||
init_tm(t_cclosure, "cCCLOSURE", sizeof(struct ecl_cclosure), 1);
|
||||
#ifndef CLOS
|
||||
init_tm(t_structure, "SSTRUCTURE", sizeof(struct structure), 32);
|
||||
init_tm(t_structure, "SSTRUCTURE", sizeof(struct ecl_structure), 32);
|
||||
#else
|
||||
init_tm(t_instance, "IINSTANCE", sizeof(struct instance), 32);
|
||||
init_tm(t_instance, "IINSTANCE", sizeof(struct ecl_instance), 32);
|
||||
#endif /* CLOS */
|
||||
#ifdef ECL_FFI
|
||||
init_tm(t_foreign, "LFOREIGN", sizeof(struct foreign), 1);
|
||||
init_tm(t_foreign, "LFOREIGN", sizeof(struct ecl_foreign), 1);
|
||||
#endif
|
||||
#ifdef THREADS
|
||||
init_tm(t_cont, "?CONT", sizeof(struct cont), 2);
|
||||
init_tm(t_thread, "tTHREAD", sizeof(struct thread), 2);
|
||||
init_tm(t_cont, "?CONT", sizeof(struct ecl_cont), 2);
|
||||
init_tm(t_thread, "tTHREAD", sizeof(struct ecl_thread), 2);
|
||||
#endif /* THREADS */
|
||||
|
||||
ncb = 0;
|
||||
|
|
|
|||
|
|
@ -97,7 +97,7 @@ make_cons(cl_object a, cl_object d)
|
|||
{
|
||||
cl_object obj;
|
||||
|
||||
obj = (cl_object)GC_MALLOC(sizeof(struct cons));
|
||||
obj = (cl_object)GC_MALLOC(sizeof(struct ecl_cons));
|
||||
obj->d.t = (short)t_cons;
|
||||
CAR(obj) = a;
|
||||
CDR(obj) = d;
|
||||
|
|
@ -141,39 +141,39 @@ init_alloc(void)
|
|||
#endif
|
||||
|
||||
init_tm(t_shortfloat, "SHORT-FLOAT", /* 8 */
|
||||
sizeof(struct shortfloat_struct));
|
||||
init_tm(t_cons, "CONS", sizeof(struct cons)); /* 12 */
|
||||
sizeof(struct ecl_shortfloat));
|
||||
init_tm(t_cons, "CONS", sizeof(struct ecl_cons)); /* 12 */
|
||||
init_tm(t_longfloat, "LONG-FLOAT", /* 16 */
|
||||
sizeof(struct longfloat_struct));
|
||||
init_tm(t_bytecodes, "bBYTECODES", sizeof(struct bytecodes));
|
||||
init_tm(t_string, "STRING", sizeof(struct string)); /* 20 */
|
||||
init_tm(t_array, "ARRAY", sizeof(struct array)); /* 24 */
|
||||
init_tm(t_pathname, "PATHNAME", sizeof(struct pathname)); /* 28 */
|
||||
init_tm(t_symbol, "SYMBOL", sizeof(struct symbol)); /* 32 */
|
||||
init_tm(t_package, "PACKAGE", sizeof(struct package)); /* 36 */
|
||||
init_tm(t_codeblock, "CODEBLOCK", sizeof(struct codeblock));
|
||||
init_tm(t_bignum, "BIGNUM", sizeof(struct bignum));
|
||||
init_tm(t_ratio, "RATIO", sizeof(struct ratio));
|
||||
init_tm(t_complex, "COMPLEX", sizeof(struct complex));
|
||||
init_tm(t_hashtable, "HASH-TABLE", sizeof(struct hashtable));
|
||||
init_tm(t_vector, "VECTOR", sizeof(struct vector));
|
||||
init_tm(t_bitvector, "BIT-VECTOR", sizeof(struct vector));
|
||||
init_tm(t_stream, "STREAM", sizeof(struct stream));
|
||||
init_tm(t_random, "RANDOM-STATE", sizeof(struct random));
|
||||
init_tm(t_readtable, "READTABLE", sizeof(struct readtable));
|
||||
init_tm(t_cfun, "CFUN", sizeof(struct cfun));
|
||||
init_tm(t_cclosure, "CCLOSURE", sizeof(struct cclosure));
|
||||
sizeof(struct ecl_longfloat));
|
||||
init_tm(t_bytecodes, "bBYTECODES", sizeof(struct ecl_bytecodes));
|
||||
init_tm(t_string, "STRING", sizeof(struct ecl_string)); /* 20 */
|
||||
init_tm(t_array, "ARRAY", sizeof(struct ecl_array)); /* 24 */
|
||||
init_tm(t_pathname, "PATHNAME", sizeof(struct ecl_pathname)); /* 28 */
|
||||
init_tm(t_symbol, "SYMBOL", sizeof(struct ecl_symbol)); /* 32 */
|
||||
init_tm(t_package, "PACKAGE", sizeof(struct ecl_package)); /* 36 */
|
||||
init_tm(t_codeblock, "CODEBLOCK", sizeof(struct ecl_codeblock));
|
||||
init_tm(t_bignum, "BIGNUM", sizeof(struct ecl_bignum));
|
||||
init_tm(t_ratio, "RATIO", sizeof(struct ecl_ratio));
|
||||
init_tm(t_complex, "COMPLEX", sizeof(struct ecl_complex));
|
||||
init_tm(t_hashtable, "HASH-TABLE", sizeof(struct ecl_hashtable));
|
||||
init_tm(t_vector, "VECTOR", sizeof(struct ecl_vector));
|
||||
init_tm(t_bitvector, "BIT-VECTOR", sizeof(struct ecl_vector));
|
||||
init_tm(t_stream, "STREAM", sizeof(struct ecl_stream));
|
||||
init_tm(t_random, "RANDOM-STATE", sizeof(struct ecl_random));
|
||||
init_tm(t_readtable, "READTABLE", sizeof(struct ecl_readtable));
|
||||
init_tm(t_cfun, "CFUN", sizeof(struct ecl_cfun));
|
||||
init_tm(t_cclosure, "CCLOSURE", sizeof(struct ecl_cclosure));
|
||||
#ifndef CLOS
|
||||
init_tm(t_structure, "STRUCTURE", sizeof(struct structure));
|
||||
init_tm(t_structure, "STRUCTURE", sizeof(struct ecl_structure));
|
||||
#else
|
||||
init_tm(t_instance, "INSTANCE", sizeof(struct instance));
|
||||
init_tm(t_instance, "INSTANCE", sizeof(struct ecl_instance));
|
||||
#endif /* CLOS */
|
||||
#ifdef ECL_FFI
|
||||
init_tm(t_instance, "FOREIGN", sizeof(struct foreign));
|
||||
init_tm(t_instance, "FOREIGN", sizeof(struct ecl_foreign));
|
||||
#endif
|
||||
#ifdef THREADS
|
||||
init_tm(t_cont, "CONT", sizeof(struct cont));
|
||||
init_tm(t_thread, "THREAD", sizeof(struct thread));
|
||||
init_tm(t_cont, "CONT", sizeof(struct ecl_cont));
|
||||
init_tm(t_thread, "THREAD", sizeof(struct ecl_thread));
|
||||
#endif /* THREADS */
|
||||
|
||||
old_GC_push_other_roots = GC_push_other_roots;
|
||||
|
|
|
|||
|
|
@ -64,7 +64,7 @@ cl_makunbound(cl_object sym)
|
|||
{
|
||||
if (!SYMBOLP(sym))
|
||||
FEtype_error_symbol(sym);
|
||||
if ((enum stype)sym->symbol.stype == stp_constant)
|
||||
if ((enum ecl_stype)sym->symbol.stype == stp_constant)
|
||||
FEinvalid_variable("Cannot unbind the constant ~S.", sym);
|
||||
SYM_VAL(sym) = OBJNULL;
|
||||
@(return sym)
|
||||
|
|
|
|||
|
|
@ -35,7 +35,7 @@ kwote(cl_object x)
|
|||
{
|
||||
cl_type t = type_of(x);
|
||||
if ((t == t_symbol &&
|
||||
((enum stype)x->symbol.stype != stp_constant || SYM_VAL(x) != x))
|
||||
((enum ecl_stype)x->symbol.stype != stp_constant || SYM_VAL(x) != x))
|
||||
|| t == t_cons || t == t_vector)
|
||||
return(CONS(@'quote', CONS(x, Cnil)));
|
||||
else return(x);
|
||||
|
|
|
|||
42
src/c/file.d
42
src/c/file.d
|
|
@ -59,7 +59,7 @@ BEGIN:
|
|||
#endif
|
||||
if (type_of(strm) != t_stream)
|
||||
FEtype_error_stream(strm);
|
||||
switch ((enum smmode)strm->stream.mode) {
|
||||
switch ((enum ecl_smmode)strm->stream.mode) {
|
||||
case smm_closed:
|
||||
FEclosed_stream(strm);
|
||||
break;
|
||||
|
|
@ -105,7 +105,7 @@ BEGIN:
|
|||
#endif
|
||||
if (type_of(strm) != t_stream)
|
||||
FEtype_error_stream(strm);
|
||||
switch ((enum smmode)strm->stream.mode) {
|
||||
switch ((enum ecl_smmode)strm->stream.mode) {
|
||||
case smm_closed:
|
||||
FEclosed_stream(strm);
|
||||
return(FALSE);
|
||||
|
|
@ -151,7 +151,7 @@ BEGIN:
|
|||
#endif
|
||||
if (type_of(strm) != t_stream)
|
||||
FEtype_error_stream(strm);
|
||||
switch ((enum smmode)strm->stream.mode) {
|
||||
switch ((enum ecl_smmode)strm->stream.mode) {
|
||||
case smm_closed:
|
||||
FEclosed_stream(strm);
|
||||
|
||||
|
|
@ -242,7 +242,7 @@ wrong_file_handler(cl_object strm)
|
|||
*----------------------------------------------------------------------
|
||||
*/
|
||||
cl_object
|
||||
open_stream(cl_object fn, enum smmode smm, cl_object if_exists,
|
||||
open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists,
|
||||
cl_object if_does_not_exist)
|
||||
{
|
||||
cl_object x;
|
||||
|
|
@ -356,7 +356,7 @@ close_stream(cl_object strm, bool abort_flag) /* Not used now! */
|
|||
if (type_of(strm) != t_stream)
|
||||
FEtype_error_stream(strm);
|
||||
fp = strm->stream.file;
|
||||
switch ((enum smmode)strm->stream.mode) {
|
||||
switch ((enum ecl_smmode)strm->stream.mode) {
|
||||
case smm_closed:
|
||||
/* It is permissible to close a closed stream, although the output
|
||||
is unspecified in those cases. */
|
||||
|
|
@ -525,7 +525,7 @@ BEGIN:
|
|||
if (type_of(strm) != t_stream)
|
||||
FEtype_error_stream(strm);
|
||||
fp = strm->stream.file;
|
||||
switch ((enum smmode)strm->stream.mode) {
|
||||
switch ((enum ecl_smmode)strm->stream.mode) {
|
||||
case smm_closed:
|
||||
FEclosed_stream(strm);
|
||||
break;
|
||||
|
|
@ -614,7 +614,7 @@ BEGIN:
|
|||
if (type_of(strm) != t_stream)
|
||||
FEtype_error_stream(strm);
|
||||
fp = strm->stream.file;
|
||||
switch ((enum smmode)strm->stream.mode) {
|
||||
switch ((enum ecl_smmode)strm->stream.mode) {
|
||||
case smm_closed:
|
||||
FEclosed_stream(strm);
|
||||
break;
|
||||
|
|
@ -685,7 +685,7 @@ BEGIN:
|
|||
if (type_of(strm) != t_stream)
|
||||
FEtype_error_stream(strm);
|
||||
fp = strm->stream.file;
|
||||
switch ((enum smmode)strm->stream.mode) {
|
||||
switch ((enum ecl_smmode)strm->stream.mode) {
|
||||
case smm_closed:
|
||||
FEclosed_stream(strm);
|
||||
break;
|
||||
|
|
@ -882,7 +882,7 @@ BEGIN:
|
|||
if (type_of(strm) != t_stream)
|
||||
FEtype_error_stream(strm);
|
||||
fp = strm->stream.file;
|
||||
switch ((enum smmode)strm->stream.mode) {
|
||||
switch ((enum ecl_smmode)strm->stream.mode) {
|
||||
case smm_closed:
|
||||
FEclosed_stream(strm);
|
||||
break;
|
||||
|
|
@ -941,7 +941,7 @@ BEGIN:
|
|||
if (type_of(strm) != t_stream)
|
||||
FEtype_error_stream(strm);
|
||||
fp = strm->stream.file;
|
||||
switch ((enum smmode)strm->stream.mode) {
|
||||
switch ((enum ecl_smmode)strm->stream.mode) {
|
||||
case smm_closed:
|
||||
FEclosed_stream(strm);
|
||||
break;
|
||||
|
|
@ -1001,7 +1001,7 @@ BEGIN:
|
|||
if (type_of(strm) != t_stream)
|
||||
FEtype_error_stream(strm);
|
||||
fp = strm->stream.file;
|
||||
switch ((enum smmode)strm->stream.mode) {
|
||||
switch ((enum ecl_smmode)strm->stream.mode) {
|
||||
case smm_closed:
|
||||
FEclosed_stream(strm);
|
||||
break;
|
||||
|
|
@ -1057,7 +1057,7 @@ BEGIN:
|
|||
if (type_of(strm) != t_stream)
|
||||
FEtype_error_stream(strm);
|
||||
fp = strm->stream.file;
|
||||
switch ((enum smmode)strm->stream.mode) {
|
||||
switch ((enum ecl_smmode)strm->stream.mode) {
|
||||
case smm_closed:
|
||||
FEclosed_stream(strm);
|
||||
return(TRUE);
|
||||
|
|
@ -1161,7 +1161,7 @@ BEGIN:
|
|||
#endif
|
||||
if (type_of(strm) != t_stream)
|
||||
FEtype_error_stream(strm);
|
||||
switch ((enum smmode)strm->stream.mode) {
|
||||
switch ((enum ecl_smmode)strm->stream.mode) {
|
||||
case smm_closed:
|
||||
FEclosed_stream(strm);
|
||||
return(FALSE);
|
||||
|
|
@ -1214,7 +1214,7 @@ BEGIN:
|
|||
#endif
|
||||
if (type_of(strm) != t_stream)
|
||||
FEtype_error_stream(strm);
|
||||
switch ((enum smmode)strm->stream.mode) {
|
||||
switch ((enum ecl_smmode)strm->stream.mode) {
|
||||
case smm_closed:
|
||||
FEclosed_stream(strm);
|
||||
return(-1);
|
||||
|
|
@ -1259,7 +1259,7 @@ BEGIN:
|
|||
#endif
|
||||
if (type_of(strm) != t_stream)
|
||||
FEtype_error_stream(strm);
|
||||
switch ((enum smmode)strm->stream.mode) {
|
||||
switch ((enum ecl_smmode)strm->stream.mode) {
|
||||
case smm_closed:
|
||||
FEclosed_stream(strm);
|
||||
return(-1);
|
||||
|
|
@ -1314,7 +1314,7 @@ BEGIN:
|
|||
#endif
|
||||
if (type_of(strm) != t_stream)
|
||||
FEtype_error_stream(strm);
|
||||
switch ((enum smmode)strm->stream.mode) {
|
||||
switch ((enum ecl_smmode)strm->stream.mode) {
|
||||
case smm_closed:
|
||||
FEclosed_stream(strm);
|
||||
return(-1);
|
||||
|
|
@ -1363,7 +1363,7 @@ BEGIN:
|
|||
#endif
|
||||
if (type_of(strm) != t_stream)
|
||||
FEtype_error_stream(strm);
|
||||
switch ((enum smmode)strm->stream.mode) {
|
||||
switch ((enum ecl_smmode)strm->stream.mode) {
|
||||
case smm_closed:
|
||||
FEclosed_stream(strm);
|
||||
return(-1);
|
||||
|
|
@ -1533,7 +1533,7 @@ cl_object
|
|||
cl_get_output_stream_string(cl_object strm)
|
||||
{
|
||||
if (type_of(strm) != t_stream ||
|
||||
(enum smmode)strm->stream.mode != smm_string_output)
|
||||
(enum ecl_smmode)strm->stream.mode != smm_string_output)
|
||||
FEerror("~S is not a string-output stream.", 1, strm);
|
||||
@(return get_output_stream_string(strm))
|
||||
}
|
||||
|
|
@ -1549,7 +1549,7 @@ cl_object
|
|||
si_output_stream_string(cl_object strm)
|
||||
{
|
||||
if (type_of(strm) != t_stream ||
|
||||
(enum smmode)strm->stream.mode != smm_string_output)
|
||||
(enum ecl_smmode)strm->stream.mode != smm_string_output)
|
||||
FEerror("~S is not a string-output stream.", 1, strm);
|
||||
@(return strm->stream.object0)
|
||||
}
|
||||
|
|
@ -1585,7 +1585,7 @@ cl_output_stream_p(cl_object strm)
|
|||
(if_does_not_exist Cnil idnesp)
|
||||
(external_format @':default')
|
||||
&aux strm)
|
||||
enum smmode smm;
|
||||
enum ecl_smmode smm;
|
||||
@
|
||||
if (external_format != @':default')
|
||||
FEerror("~S is not a valid stream external format.", 1,
|
||||
|
|
@ -1671,7 +1671,7 @@ cl_open_stream_p(cl_object strm)
|
|||
cl_object
|
||||
si_get_string_input_stream_index(cl_object strm)
|
||||
{
|
||||
if ((enum smmode)strm->stream.mode != smm_string_input)
|
||||
if ((enum ecl_smmode)strm->stream.mode != smm_string_input)
|
||||
FEerror("~S is not a string-input stream.", 1, strm);
|
||||
@(return MAKE_FIXNUM(strm->stream.int0))
|
||||
}
|
||||
|
|
|
|||
|
|
@ -36,11 +36,11 @@ si_generic_function_p(cl_object instance)
|
|||
* It also assumes that entries are never removed except by clrhash.
|
||||
*/
|
||||
|
||||
static struct hashtable_entry *
|
||||
static struct ecl_hashtable_entry *
|
||||
get_meth_hash(cl_object *keys, int argno, cl_object hashtable)
|
||||
{
|
||||
int hsize;
|
||||
struct hashtable_entry *e, *htable;
|
||||
struct ecl_hashtable_entry *e, *htable;
|
||||
cl_object hkey, tlist;
|
||||
register cl_index i = 0;
|
||||
int k, n; /* k added by chou */
|
||||
|
|
@ -70,7 +70,7 @@ get_meth_hash(cl_object *keys, int argno, cl_object hashtable)
|
|||
static void
|
||||
set_meth_hash(cl_object *keys, int argno, cl_object hashtable, cl_object value)
|
||||
{
|
||||
struct hashtable_entry *e;
|
||||
struct ecl_hashtable_entry *e;
|
||||
cl_object keylist, *p;
|
||||
cl_index i;
|
||||
bool over;
|
||||
|
|
@ -107,7 +107,7 @@ compute_method(int narg, cl_object gf, cl_object *args)
|
|||
{
|
||||
cl_object func;
|
||||
int i, spec_no;
|
||||
struct hashtable_entry *e;
|
||||
struct ecl_hashtable_entry *e;
|
||||
cl_object spec_how_list = GFUN_SPEC(gf);
|
||||
cl_object table = GFUN_HASH(gf);
|
||||
cl_object argtype[narg]; /* __GNUC__ */
|
||||
|
|
|
|||
24
src/c/hash.d
24
src/c/hash.d
|
|
@ -220,12 +220,12 @@ hash_equal(cl_object key)
|
|||
return _hash_equal(~(cl_hashkey)0, 0, key);
|
||||
}
|
||||
|
||||
static struct hashtable_entry *
|
||||
static struct ecl_hashtable_entry *
|
||||
search_hash(cl_object key, cl_object hashtable)
|
||||
{
|
||||
cl_hashkey h;
|
||||
cl_index hsize, i, j, k;
|
||||
struct hashtable_entry *e;
|
||||
struct ecl_hashtable_entry *e;
|
||||
cl_object hkey;
|
||||
int htest;
|
||||
bool b;
|
||||
|
|
@ -287,7 +287,7 @@ gethash(cl_object key, cl_object hashtable)
|
|||
cl_object
|
||||
gethash_safe(cl_object key, cl_object hashtable, cl_object def)
|
||||
{
|
||||
struct hashtable_entry *e;
|
||||
struct ecl_hashtable_entry *e;
|
||||
|
||||
/* INV: search_hash() checks the type of hashtable */
|
||||
e = search_hash(key, hashtable);
|
||||
|
|
@ -303,7 +303,7 @@ add_new_to_hash(cl_object key, cl_object hashtable, cl_object value)
|
|||
int htest;
|
||||
cl_hashkey h;
|
||||
cl_index i, hsize;
|
||||
struct hashtable_entry *e;
|
||||
struct ecl_hashtable_entry *e;
|
||||
|
||||
/* INV: hashtable has the right type */
|
||||
htest = hashtable->hash.test;
|
||||
|
|
@ -335,7 +335,7 @@ sethash(cl_object key, cl_object hashtable, cl_object value)
|
|||
{
|
||||
cl_index i;
|
||||
bool over;
|
||||
struct hashtable_entry *e;
|
||||
struct ecl_hashtable_entry *e;
|
||||
|
||||
/* INV: search_hash() checks the type of hashtable */
|
||||
e = search_hash(key, hashtable);
|
||||
|
|
@ -385,8 +385,8 @@ extend_hashtable(cl_object hashtable)
|
|||
hashtable->hash.threshold =
|
||||
MAKE_FIXNUM(fix(hashtable->hash.threshold) +
|
||||
(new_size - old->hash.size));
|
||||
hashtable->hash.data = (struct hashtable_entry *)
|
||||
cl_alloc(new_size * sizeof(struct hashtable_entry));
|
||||
hashtable->hash.data = (struct ecl_hashtable_entry *)
|
||||
cl_alloc(new_size * sizeof(struct ecl_hashtable_entry));
|
||||
for (i = 0; i < new_size; i++) {
|
||||
hashtable->hash.data[i].key = OBJNULL;
|
||||
hashtable->hash.data[i].value = OBJNULL;
|
||||
|
|
@ -412,7 +412,7 @@ cl_object
|
|||
cl__make_hash_table(cl_object test, cl_object size, cl_object rehash_size,
|
||||
cl_object rehash_threshold)
|
||||
{
|
||||
enum httest htt;
|
||||
int htt;
|
||||
cl_index hsize;
|
||||
cl_object h;
|
||||
|
||||
|
|
@ -454,8 +454,8 @@ cl__make_hash_table(cl_object test, cl_object size, cl_object rehash_size,
|
|||
h->hash.threshold = rehash_threshold;
|
||||
h->hash.entries = 0;
|
||||
h->hash.data = NULL; /* for GC sake */
|
||||
h->hash.data = (struct hashtable_entry *)
|
||||
cl_alloc(hsize * sizeof(struct hashtable_entry));
|
||||
h->hash.data = (struct ecl_hashtable_entry *)
|
||||
cl_alloc(hsize * sizeof(struct ecl_hashtable_entry));
|
||||
return cl_clrhash(h);
|
||||
}
|
||||
|
||||
|
|
@ -466,7 +466,7 @@ cl_hash_table_p(cl_object ht)
|
|||
}
|
||||
|
||||
@(defun gethash (key ht &optional (no_value Cnil))
|
||||
struct hashtable_entry *e;
|
||||
struct ecl_hashtable_entry *e;
|
||||
@
|
||||
/* INV: search_hash() checks the type of hashtable */
|
||||
e = search_hash(key, ht);
|
||||
|
|
@ -487,7 +487,7 @@ si_hash_set(cl_object key, cl_object ht, cl_object val)
|
|||
bool
|
||||
remhash(cl_object key, cl_object hashtable)
|
||||
{
|
||||
struct hashtable_entry *e;
|
||||
struct ecl_hashtable_entry *e;
|
||||
|
||||
/* INV: search_hash() checks the type of hashtable */
|
||||
e = search_hash(key, hashtable);
|
||||
|
|
|
|||
|
|
@ -16,6 +16,7 @@
|
|||
|
||||
|
||||
#include "ecl.h"
|
||||
#include "internal.h"
|
||||
|
||||
/******************************* EXPORTS ******************************/
|
||||
|
||||
|
|
@ -36,8 +37,8 @@ cl_object tk_package;
|
|||
#define EXTERNAL 2
|
||||
#define INHERITED 3
|
||||
|
||||
static cl_object package_list = Cnil;
|
||||
static cl_object uninterned_list = Cnil;
|
||||
cl_object ecl_package_list = Cnil;
|
||||
static uninterned_list = Cnil;
|
||||
|
||||
static void
|
||||
FEpackage_error(char *message, cl_object package, int narg, ...)
|
||||
|
|
@ -96,7 +97,7 @@ make_package_hashtable()
|
|||
h->hash.threshold = make_shortfloat(0.7);
|
||||
h->hash.entries = 0;
|
||||
h->hash.data = NULL; /* for GC sake */
|
||||
h->hash.data = (struct hashtable_entry *)cl_alloc(hsize * sizeof(struct hashtable_entry));
|
||||
h->hash.data = (struct ecl_hashtable_entry *)cl_alloc(hsize * sizeof(struct ecl_hashtable_entry));
|
||||
return cl_clrhash(h);
|
||||
}
|
||||
|
||||
|
|
@ -109,6 +110,18 @@ make_package(cl_object name, cl_object nicknames, cl_object use_list)
|
|||
assert_type_proper_list(nicknames);
|
||||
assert_type_proper_list(use_list);
|
||||
|
||||
if (ecl_packages_to_be_created != OBJNULL) {
|
||||
cl_object *p = &ecl_packages_to_be_created;
|
||||
for (x = *p; x != Cnil; ) {
|
||||
if (equal(CAAR(x), name)) {
|
||||
*p = CDR(x);
|
||||
x = CDAR(x);
|
||||
goto INTERN;
|
||||
}
|
||||
p = &CDR(x);
|
||||
x = *p;
|
||||
}
|
||||
}
|
||||
if ((other = find_package(name)) != Cnil) {
|
||||
ERROR: cl_cerror(8,
|
||||
make_simple_string("Return existing package"),
|
||||
|
|
@ -120,7 +133,10 @@ make_package(cl_object name, cl_object nicknames, cl_object use_list)
|
|||
return other;
|
||||
}
|
||||
x = cl_alloc_object(t_package);
|
||||
x->pack.internal = make_package_hashtable();
|
||||
x->pack.external = make_package_hashtable();
|
||||
x->pack.name = name;
|
||||
INTERN:
|
||||
x->pack.nicknames = Cnil;
|
||||
x->pack.shadowings = Cnil;
|
||||
x->pack.uses = Cnil;
|
||||
|
|
@ -139,9 +155,7 @@ make_package(cl_object name, cl_object nicknames, cl_object use_list)
|
|||
x->pack.uses = CONS(y, x->pack.uses);
|
||||
y->pack.usedby = CONS(x, y->pack.usedby);
|
||||
}
|
||||
x->pack.internal = make_package_hashtable();
|
||||
x->pack.external = make_package_hashtable();
|
||||
package_list = CONS(x, package_list);
|
||||
ecl_package_list = CONS(x, ecl_package_list);
|
||||
return(x);
|
||||
}
|
||||
|
||||
|
|
@ -197,8 +211,8 @@ find_package(cl_object name)
|
|||
if (type_of(name) == t_package)
|
||||
return name;
|
||||
name = cl_string(name);
|
||||
/* INV: package_list is a proper list */
|
||||
for (l = package_list; CONSP(l); l = CDR(l)) {
|
||||
/* INV: ecl_package_list is a proper list */
|
||||
for (l = ecl_package_list; CONSP(l); l = CDR(l)) {
|
||||
p = CAR(l);
|
||||
if (string_eq(name, p->pack.name))
|
||||
return p;
|
||||
|
|
@ -214,9 +228,10 @@ si_coerce_to_package(cl_object p)
|
|||
/* INV: find_package() signals an error if "p" is neither a package
|
||||
nor a string */
|
||||
cl_object pp = find_package(p);
|
||||
if (!Null(pp))
|
||||
@(return pp);
|
||||
FEpackage_error("There exists no package with name ~S", p, 0);
|
||||
if (Null(pp)) {
|
||||
FEpackage_error("There exists no package with name ~S", p, 0);
|
||||
}
|
||||
@(return pp);
|
||||
}
|
||||
|
||||
cl_object
|
||||
|
|
@ -446,7 +461,7 @@ cl_delete_package(cl_object p)
|
|||
for (hash = p->pack.external, i = 0; i < hash->hash.size; i++)
|
||||
if (hash->hash.data[i].key != OBJNULL)
|
||||
unintern(hash->hash.data[i].value, p);
|
||||
delete_eq(p, &package_list);
|
||||
delete_eq(p, &ecl_package_list);
|
||||
p->pack.shadowings = Cnil;
|
||||
p->pack.name = Cnil;
|
||||
@(return Ct)
|
||||
|
|
@ -562,7 +577,7 @@ shadow(cl_object s, cl_object p)
|
|||
void
|
||||
use_package(cl_object x, cl_object p)
|
||||
{
|
||||
struct hashtable_entry *hash_entries;
|
||||
struct ecl_hashtable_entry *hash_entries;
|
||||
cl_index i, hash_length;
|
||||
int intern_flag;
|
||||
|
||||
|
|
@ -684,7 +699,7 @@ si_package_lock(cl_object p, cl_object t)
|
|||
cl_object
|
||||
cl_list_all_packages()
|
||||
{
|
||||
return cl_copy_list(package_list);
|
||||
return cl_copy_list(ecl_package_list);
|
||||
}
|
||||
|
||||
@(defun intern (strng &optional (p current_package()) &aux sym)
|
||||
|
|
@ -905,7 +920,7 @@ si_package_hash_tables(cl_object p)
|
|||
void
|
||||
init_package(void)
|
||||
{
|
||||
ecl_register_static_root(&package_list);
|
||||
ecl_register_static_root(&ecl_package_list);
|
||||
ecl_register_static_root(&uninterned_list);
|
||||
|
||||
lisp_package = make_package(make_simple_string("COMMON-LISP"),
|
||||
|
|
|
|||
|
|
@ -441,7 +441,7 @@ L:
|
|||
return1(x);
|
||||
|
||||
case t_stream:
|
||||
switch ((enum smmode)x->stream.mode) {
|
||||
switch ((enum ecl_smmode)x->stream.mode) {
|
||||
case smm_closed:
|
||||
case smm_input:
|
||||
case smm_output:
|
||||
|
|
@ -708,7 +708,7 @@ L:
|
|||
break;
|
||||
|
||||
case t_stream:
|
||||
switch ((enum smmode)x->stream.mode) {
|
||||
switch ((enum ecl_smmode)x->stream.mode) {
|
||||
case smm_input:
|
||||
case smm_output:
|
||||
case smm_probe:
|
||||
|
|
@ -768,7 +768,7 @@ L:
|
|||
break;
|
||||
|
||||
case t_stream:
|
||||
switch ((enum smmode)x->stream.mode) {
|
||||
switch ((enum ecl_smmode)x->stream.mode) {
|
||||
case smm_input:
|
||||
case smm_output:
|
||||
case smm_probe:
|
||||
|
|
|
|||
|
|
@ -1057,7 +1057,7 @@ _write_object(cl_object x, int level)
|
|||
|
||||
case t_stream:
|
||||
if (PRINTreadably) FEprint_not_readable(x);
|
||||
switch ((enum smmode)x->stream.mode) {
|
||||
switch ((enum ecl_smmode)x->stream.mode) {
|
||||
case smm_closed:
|
||||
write_str("#<closed stream ");
|
||||
_write_object(x->stream.object1, level);
|
||||
|
|
|
|||
84
src/c/read.d
84
src/c/read.d
|
|
@ -25,6 +25,7 @@
|
|||
/******************************* EXPORTS ******************************/
|
||||
|
||||
cl_object standard_readtable;
|
||||
cl_object ecl_packages_to_be_created;
|
||||
|
||||
/******************************* ------- ******************************/
|
||||
|
||||
|
|
@ -72,7 +73,7 @@ read_object_with_delimiter(cl_object in, int delimiter)
|
|||
{
|
||||
cl_object x;
|
||||
int c, base;
|
||||
enum chattrib a;
|
||||
enum ecl_chattrib a;
|
||||
cl_object p;
|
||||
cl_index length, i, colon;
|
||||
int colon_type, intern_flag;
|
||||
|
|
@ -172,9 +173,10 @@ SYMBOL:
|
|||
else {
|
||||
cl_token->string.fillp = colon;
|
||||
p = find_package(cl_token);
|
||||
if (Null(p))
|
||||
FEerror("There is no package with the name ~A.",
|
||||
1, copy_simple_string(cl_token));
|
||||
if (Null(p)) {
|
||||
FEerror("There is no package with the name ~A.",
|
||||
1, copy_simple_string(cl_token));
|
||||
}
|
||||
}
|
||||
cl_token->string.fillp = length - (colon + 1);
|
||||
memmove(cl_token->string.self,
|
||||
|
|
@ -191,9 +193,25 @@ SYMBOL:
|
|||
} else if (colon_type == 2 /* && colon > 0 && length > colon + 2 */) {
|
||||
cl_token->string.fillp = colon;
|
||||
p = find_package(cl_token);
|
||||
if (Null(p))
|
||||
FEerror("There is no package with the name ~A.",
|
||||
1, copy_simple_string(cl_token));
|
||||
if (Null(p)) {
|
||||
/* When loading binary files, we sometimes must create
|
||||
symbols whose package has not yet been maked. We
|
||||
allow it, but later on in read_VV we make sure that
|
||||
all referenced packages have been properly built.
|
||||
*/
|
||||
cl_object name = copy_simple_string(cl_token);
|
||||
if (ecl_packages_to_be_created == OBJNULL) {
|
||||
FEerror("There is no package with the name ~A.",
|
||||
1, name);
|
||||
} else if (!Null(p = assoc(name, ecl_packages_to_be_created))) {
|
||||
p = CDR(p);
|
||||
} else {
|
||||
p = make_package(name,Cnil,Cnil);
|
||||
ecl_package_list = CDR(ecl_package_list);
|
||||
ecl_packages_to_be_created =
|
||||
cl_acons(name, p, ecl_packages_to_be_created);
|
||||
}
|
||||
}
|
||||
cl_token->string.fillp = length - (colon + 2);
|
||||
memmove(cl_token->string.self,
|
||||
cl_token->string.self + colon + 2,
|
||||
|
|
@ -804,7 +822,7 @@ static cl_object
|
|||
sharp_colon_reader(cl_object in, cl_object ch, cl_object d)
|
||||
{
|
||||
cl_object rtbl = ecl_current_readtable();
|
||||
enum chattrib a;
|
||||
enum ecl_chattrib a;
|
||||
bool escape_flag;
|
||||
int c;
|
||||
|
||||
|
|
@ -881,13 +899,14 @@ sharp_exclamation_reader(cl_object in, cl_object c, cl_object d)
|
|||
switch (code) {
|
||||
case 0: {
|
||||
cl_object name = read_object(in);
|
||||
si_select_package(name);
|
||||
break;
|
||||
}
|
||||
case 1: {
|
||||
cl_object name = read_object(in);
|
||||
cl_object p = find_package(name);
|
||||
if (Null(p)) make_package(name,Cnil,Cnil);
|
||||
cl_object package = find_package(name);
|
||||
if (Null(package)) {
|
||||
package = make_package(name, Cnil, Cnil);
|
||||
ecl_package_list = CDR(ecl_package_list);
|
||||
ecl_packages_to_be_created =
|
||||
cl_acons(name, package, ecl_packages_to_be_created);
|
||||
}
|
||||
si_select_package(package);
|
||||
break;
|
||||
}
|
||||
default: {
|
||||
|
|
@ -1165,7 +1184,7 @@ sharp_dollar_reader(cl_object in, cl_object c, cl_object d)
|
|||
cl_object
|
||||
copy_readtable(cl_object from, cl_object to)
|
||||
{
|
||||
struct readtable_entry *rtab;
|
||||
struct ecl_readtable_entry *rtab;
|
||||
cl_index i;
|
||||
|
||||
if (Null(to)) {
|
||||
|
|
@ -1174,9 +1193,9 @@ copy_readtable(cl_object from, cl_object to)
|
|||
/* Saving for GC. */
|
||||
to->readtable.table
|
||||
= rtab
|
||||
= (struct readtable_entry *)cl_alloc_align(RTABSIZE * sizeof(struct readtable_entry), sizeof(struct readtable_entry));
|
||||
= (struct ecl_readtable_entry *)cl_alloc_align(RTABSIZE * sizeof(struct ecl_readtable_entry), sizeof(struct ecl_readtable_entry));
|
||||
memcpy(rtab, from->readtable.table,
|
||||
RTABSIZE * sizeof(struct readtable_entry));
|
||||
RTABSIZE * sizeof(struct ecl_readtable_entry));
|
||||
/*
|
||||
for (i = 0; i < RTABSIZE; i++)
|
||||
rtab[i] = from->readtable.table[i];
|
||||
|
|
@ -1544,7 +1563,7 @@ cl_readtablep(cl_object readtable)
|
|||
|
||||
/* FIXME! READTABLE-CASE is missing! */
|
||||
|
||||
static struct readtable_entry*
|
||||
static struct ecl_readtable_entry*
|
||||
read_table_entry(cl_object rdtbl, cl_object c)
|
||||
{
|
||||
/* INV: char_code() checks the type of `c' */
|
||||
|
|
@ -1555,7 +1574,7 @@ read_table_entry(cl_object rdtbl, cl_object c)
|
|||
@(defun set_syntax_from_char (tochr fromchr
|
||||
&o (tordtbl ecl_current_readtable())
|
||||
fromrdtbl)
|
||||
struct readtable_entry*torte, *fromrte;
|
||||
struct ecl_readtable_entry*torte, *fromrte;
|
||||
@
|
||||
/* INV: read_table_entry() checks all values */
|
||||
if (Null(fromrdtbl))
|
||||
|
|
@ -1576,7 +1595,7 @@ read_table_entry(cl_object rdtbl, cl_object c)
|
|||
@(defun set_macro_character (chr fnc
|
||||
&optional ntp
|
||||
(rdtbl ecl_current_readtable()))
|
||||
struct readtable_entry*entry;
|
||||
struct ecl_readtable_entry*entry;
|
||||
@
|
||||
/* INV: read_table_entry() checks our arguments */
|
||||
entry = read_table_entry(rdtbl, chr);
|
||||
|
|
@ -1589,7 +1608,7 @@ read_table_entry(cl_object rdtbl, cl_object c)
|
|||
@)
|
||||
|
||||
@(defun get_macro_character (chr &o (rdtbl ecl_current_readtable()))
|
||||
struct readtable_entry*entry;
|
||||
struct ecl_readtable_entry*entry;
|
||||
cl_object m;
|
||||
@
|
||||
|
||||
|
|
@ -1606,7 +1625,7 @@ read_table_entry(cl_object rdtbl, cl_object c)
|
|||
|
||||
@(defun make_dispatch_macro_character (chr
|
||||
&optional ntp (rdtbl ecl_current_readtable()))
|
||||
struct readtable_entry*entry;
|
||||
struct ecl_readtable_entry*entry;
|
||||
cl_object *table;
|
||||
int i;
|
||||
@
|
||||
|
|
@ -1626,7 +1645,7 @@ read_table_entry(cl_object rdtbl, cl_object c)
|
|||
|
||||
@(defun set_dispatch_macro_character (dspchr subchr fnc
|
||||
&optional (rdtbl ecl_current_readtable()))
|
||||
struct readtable_entry*entry;
|
||||
struct ecl_readtable_entry*entry;
|
||||
cl_fixnum subcode;
|
||||
@
|
||||
entry = read_table_entry(rdtbl, dspchr);
|
||||
|
|
@ -1641,7 +1660,7 @@ read_table_entry(cl_object rdtbl, cl_object c)
|
|||
|
||||
@(defun get_dispatch_macro_character (dspchr subchr
|
||||
&optional (rdtbl ecl_current_readtable()))
|
||||
struct readtable_entry*entry;
|
||||
struct ecl_readtable_entry*entry;
|
||||
cl_fixnum subcode;
|
||||
@
|
||||
if (Null(rdtbl))
|
||||
|
|
@ -1694,7 +1713,7 @@ extra_argument(int c, cl_object stream, cl_object d)
|
|||
void
|
||||
init_read(void)
|
||||
{
|
||||
struct readtable_entry *rtab;
|
||||
struct ecl_readtable_entry *rtab;
|
||||
cl_object *dtab;
|
||||
int i;
|
||||
|
||||
|
|
@ -1703,7 +1722,7 @@ init_read(void)
|
|||
|
||||
standard_readtable->readtable.table
|
||||
= rtab
|
||||
= (struct readtable_entry *)cl_alloc(RTABSIZE * sizeof(struct readtable_entry));
|
||||
= (struct ecl_readtable_entry *)cl_alloc(RTABSIZE * sizeof(struct ecl_readtable_entry));
|
||||
for (i = 0; i < RTABSIZE; i++) {
|
||||
rtab[i].syntax_type = cat_constituent;
|
||||
rtab[i].macro = OBJNULL;
|
||||
|
|
@ -1800,6 +1819,8 @@ init_read(void)
|
|||
= @'single-float';
|
||||
SYM_VAL(@'*read_base*') = MAKE_FIXNUM(10);
|
||||
SYM_VAL(@'*read_suppress*') = Cnil;
|
||||
|
||||
ecl_register_static_root(&ecl_packages_to_be_created);
|
||||
}
|
||||
|
||||
/*
|
||||
|
|
@ -1816,6 +1837,7 @@ init_read(void)
|
|||
cl_object
|
||||
read_VV(cl_object block, void *entry)
|
||||
{
|
||||
volatile cl_object old_eptbc = ecl_packages_to_be_created;
|
||||
typedef void (*entry_point_ptr)(cl_object);
|
||||
volatile cl_object x;
|
||||
cl_index i, len;
|
||||
|
|
@ -1830,6 +1852,8 @@ read_VV(cl_object block, void *entry)
|
|||
in = OBJNULL;
|
||||
CL_UNWIND_PROTECT_BEGIN {
|
||||
bds_bind(@'si::*cblock*', block);
|
||||
if (ecl_packages_to_be_created == OBJNULL)
|
||||
ecl_packages_to_be_created = Cnil;
|
||||
|
||||
/* Communicate the library which Cblock we are using, and get
|
||||
* back the amount of data to be processed.
|
||||
|
|
@ -1863,8 +1887,14 @@ read_VV(cl_object block, void *entry)
|
|||
NO_DATA:
|
||||
/* Execute top-level code */
|
||||
(*entry_point)(MAKE_FIXNUM(0));
|
||||
if (ecl_packages_to_be_created != Cnil) {
|
||||
CEerror("The following packages were referenced in a~"
|
||||
"compiled file, but they have not been created: ~A",
|
||||
1, ecl_packages_to_be_created);
|
||||
}
|
||||
bds_unwind1;
|
||||
} CL_UNWIND_PROTECT_EXIT {
|
||||
ecl_packages_to_be_created = old_eptbc;
|
||||
if (in != OBJNULL)
|
||||
close_stream(in, 0);
|
||||
} CL_UNWIND_PROTECT_END;
|
||||
|
|
|
|||
|
|
@ -387,7 +387,7 @@ cl_object
|
|||
@si::*make_special(cl_object sym)
|
||||
{
|
||||
assert_type_symbol(sym);
|
||||
if ((enum stype)sym->symbol.stype == stp_constant)
|
||||
if ((enum ecl_stype)sym->symbol.stype == stp_constant)
|
||||
FEerror("~S is a constant.", 1, sym);
|
||||
sym->symbol.stype = (short)stp_special;
|
||||
cl_remprop(sym, @'si::symbol-macro');
|
||||
|
|
@ -398,7 +398,7 @@ cl_object
|
|||
@si::*make_constant(cl_object sym, cl_object val)
|
||||
{
|
||||
assert_type_symbol(sym);
|
||||
if ((enum stype)sym->symbol.stype == stp_special)
|
||||
if ((enum ecl_stype)sym->symbol.stype == stp_special)
|
||||
FEerror(
|
||||
"The argument ~S to DEFCONSTANT is a special variable.",
|
||||
1, sym);
|
||||
|
|
|
|||
|
|
@ -68,7 +68,7 @@ typedef union {
|
|||
short narg;
|
||||
cl_object value;
|
||||
} init;
|
||||
struct symbol data;
|
||||
struct ecl_symbol data;
|
||||
} cl_symbol_initializer;
|
||||
extern cl_symbol_initializer cl_symbols[];
|
||||
extern cl_index cl_num_symbols_in_core;
|
||||
|
|
@ -355,7 +355,7 @@ extern cl_object si_file_column(cl_object strm);
|
|||
extern bool input_stream_p(cl_object strm);
|
||||
extern bool output_stream_p(cl_object strm);
|
||||
extern cl_object stream_element_type(cl_object strm);
|
||||
extern cl_object open_stream(cl_object fn, enum smmode smm, cl_object if_exists, cl_object if_does_not_exist);
|
||||
extern cl_object open_stream(cl_object fn, enum ecl_smmode smm, cl_object if_exists, cl_object if_does_not_exist);
|
||||
extern void close_stream(cl_object strm, bool abort_flag);
|
||||
extern cl_object make_two_way_stream(cl_object istrm, cl_object ostrm);
|
||||
extern cl_object make_echo_stream(cl_object istrm, cl_object ostrm);
|
||||
|
|
@ -1201,7 +1201,7 @@ extern cl_object si_open_client_stream(cl_object host, cl_object port);
|
|||
extern cl_object si_open_server_stream(cl_object port);
|
||||
extern cl_object si_open_unix_socket_stream(cl_object path);
|
||||
extern cl_object si_lookup_host_entry(cl_object host_or_address);
|
||||
extern cl_object make_stream(cl_object host, int fd, enum smmode smm);
|
||||
extern cl_object make_stream(cl_object host, int fd, enum ecl_smmode smm);
|
||||
#endif
|
||||
|
||||
|
||||
|
|
|
|||
132
src/h/object.h
132
src/h/object.h
|
|
@ -35,7 +35,7 @@ typedef unsigned char byte;
|
|||
/*
|
||||
Definition of the type of LISP objects.
|
||||
*/
|
||||
typedef union lispunion *cl_object;
|
||||
typedef union cl_lispunion *cl_object;
|
||||
typedef cl_object cl_return;
|
||||
typedef cl_object (*cl_objectfn)(int narg, ...);
|
||||
|
||||
|
|
@ -77,19 +77,19 @@ typedef cl_object (*cl_objectfn)(int narg, ...);
|
|||
#define HEADER2(field1,field2) int8_t t, m, field1, field2
|
||||
#define HEADER3(field1,flag2,flag3) int8_t t, m, field1; unsigned flag2:4, flag3:4
|
||||
|
||||
struct shortfloat_struct {
|
||||
struct ecl_shortfloat {
|
||||
HEADER;
|
||||
float SFVAL; /* shortfloat value */
|
||||
};
|
||||
#define sf(obje) (obje)->SF.SFVAL
|
||||
|
||||
struct longfloat_struct {
|
||||
struct ecl_longfloat {
|
||||
HEADER;
|
||||
double LFVAL; /* longfloat value */
|
||||
};
|
||||
#define lf(obje) (obje)->LF.LFVAL
|
||||
|
||||
struct bignum {
|
||||
struct ecl_bignum {
|
||||
HEADER;
|
||||
mpz_t big_num;
|
||||
};
|
||||
|
|
@ -97,19 +97,19 @@ struct bignum {
|
|||
#define big_size big_num->_mp_size
|
||||
#define big_limbs big_num->_mp_d
|
||||
|
||||
struct ratio {
|
||||
struct ecl_ratio {
|
||||
HEADER;
|
||||
cl_object den; /* denominator, must be an integer */
|
||||
cl_object num; /* numerator, must be an integer */
|
||||
};
|
||||
|
||||
struct complex {
|
||||
struct ecl_complex {
|
||||
HEADER;
|
||||
cl_object real; /* real part, must be a number */
|
||||
cl_object imag; /* imaginary part, must be a number */
|
||||
};
|
||||
|
||||
enum stype { /* symbol type */
|
||||
enum ecl_stype { /* symbol type */
|
||||
stp_ordinary, /* ordinary */
|
||||
stp_constant, /* constant */
|
||||
stp_special /* special */
|
||||
|
|
@ -118,7 +118,7 @@ enum stype { /* symbol type */
|
|||
#define Cnil ((cl_object)cl_symbols)
|
||||
#define Ct ((cl_object)(cl_symbols+1))
|
||||
|
||||
struct symbol {
|
||||
struct ecl_symbol {
|
||||
HEADER3(stype, mflag, isform);
|
||||
/* symbol type and whether it names a macro */
|
||||
cl_object dbind; /* dynamic binding */
|
||||
|
|
@ -135,7 +135,7 @@ struct symbol {
|
|||
#define SYM_VAL(sym) ((sym)->symbol.dbind)
|
||||
#define SYM_FUN(sym) ((sym)->symbol.gfdef)
|
||||
|
||||
struct package {
|
||||
struct ecl_package {
|
||||
HEADER1(locked);
|
||||
cl_object name; /* package name, a string */
|
||||
cl_object nicknames; /* nicknames, list of strings */
|
||||
|
|
@ -158,13 +158,13 @@ struct package {
|
|||
#define CONSP(x) ((IMMEDIATE(x) == 0) && ((x)->d.t == t_cons))
|
||||
#define ATOM(x) ((IMMEDIATE(x) != 0) || ((x)->d.t != t_cons))
|
||||
#define SYMBOLP(x) ((IMMEDIATE(x) == 0) && ((x)->d.t == t_symbol))
|
||||
struct cons {
|
||||
struct ecl_cons {
|
||||
HEADER;
|
||||
cl_object cdr; /* cdr */
|
||||
cl_object car; /* car */
|
||||
};
|
||||
|
||||
enum httest { /* hash table key test function */
|
||||
enum ecl_httest { /* hash table key test function */
|
||||
htt_eq, /* eq */
|
||||
htt_eql, /* eql */
|
||||
htt_equal, /* equal */
|
||||
|
|
@ -172,14 +172,14 @@ enum httest { /* hash table key test function */
|
|||
htt_pack /* symbol hash */
|
||||
};
|
||||
|
||||
struct hashtable_entry { /* hash table entry */
|
||||
struct ecl_hashtable_entry { /* hash table entry */
|
||||
cl_object key; /* key */
|
||||
cl_object value; /* value */
|
||||
};
|
||||
|
||||
struct hashtable { /* hash table header */
|
||||
struct ecl_hashtable { /* hash table header */
|
||||
HEADER1(test);
|
||||
struct hashtable_entry *data; /* pointer to the hash table */
|
||||
struct ecl_hashtable_entry *data; /* pointer to the hash table */
|
||||
cl_object rehash_size; /* rehash size */
|
||||
cl_object threshold; /* rehash threshold */
|
||||
cl_index entries; /* number of entries */
|
||||
|
|
@ -201,7 +201,7 @@ typedef enum { /* array element type */
|
|||
#endif
|
||||
} cl_elttype;
|
||||
|
||||
union array_data {
|
||||
union ecl_array_data {
|
||||
cl_object *t;
|
||||
unsigned char *ch;
|
||||
uint8_t *b8;
|
||||
|
|
@ -212,19 +212,19 @@ union array_data {
|
|||
byte *bit;
|
||||
};
|
||||
|
||||
struct array { /* array header */
|
||||
struct ecl_array { /* array header */
|
||||
/* adjustable flag */
|
||||
/* has-fill-pointer flag */
|
||||
HEADER2(adjustable,rank);
|
||||
cl_object displaced; /* displaced */
|
||||
cl_index dim; /* dimension */
|
||||
cl_index *dims; /* table of dimensions */
|
||||
union array_data self; /* pointer to the array */
|
||||
union ecl_array_data self; /* pointer to the array */
|
||||
byte elttype; /* element type */
|
||||
byte offset; /* bitvector offset */
|
||||
};
|
||||
|
||||
struct vector { /* vector header */
|
||||
struct ecl_vector { /* vector header */
|
||||
/* adjustable flag */
|
||||
/* has-fill-pointer flag */
|
||||
HEADER2(adjustable,hasfillp);
|
||||
|
|
@ -233,12 +233,12 @@ struct vector { /* vector header */
|
|||
cl_index fillp; /* fill pointer */
|
||||
/* For simple vectors, */
|
||||
/* v_fillp is equal to v_dim. */
|
||||
union array_data self; /* pointer to the vector */
|
||||
union ecl_array_data self; /* pointer to the vector */
|
||||
byte elttype; /* element type */
|
||||
byte offset;
|
||||
};
|
||||
|
||||
struct string { /* string header */
|
||||
struct ecl_string { /* string header */
|
||||
/* adjustable flag */
|
||||
/* has-fill-pointer flag */
|
||||
HEADER2(adjustable,hasfillp);
|
||||
|
|
@ -259,7 +259,7 @@ struct string { /* string header */
|
|||
#define SLOT(x,i) (x)->instance.slots[i]
|
||||
#define SNAME(x) CLASS_NAME(CLASS_OF(x))
|
||||
#else
|
||||
struct structure { /* structure header */
|
||||
struct ecl_structure { /* structure header */
|
||||
HEADER;
|
||||
cl_object name; /* structure name */
|
||||
cl_object *self; /* structure self */
|
||||
|
|
@ -274,7 +274,7 @@ struct structure { /* structure header */
|
|||
#define SNAME(x) x->str.name
|
||||
#endif
|
||||
|
||||
enum smmode { /* stream mode */
|
||||
enum ecl_smmode { /* stream mode */
|
||||
smm_closed, /* closed */
|
||||
smm_input, /* input */
|
||||
smm_output, /* output */
|
||||
|
|
@ -289,7 +289,7 @@ enum smmode { /* stream mode */
|
|||
smm_string_output /* string output */
|
||||
};
|
||||
|
||||
struct stream {
|
||||
struct ecl_stream {
|
||||
HEADER1(mode); /* stream mode of enum smmode */
|
||||
FILE *file; /* file pointer */
|
||||
cl_object object0; /* some object */
|
||||
|
|
@ -301,12 +301,12 @@ struct stream {
|
|||
#endif
|
||||
};
|
||||
|
||||
struct random {
|
||||
struct ecl_random {
|
||||
HEADER;
|
||||
unsigned value; /* random state value */
|
||||
};
|
||||
|
||||
enum chattrib { /* character attribute */
|
||||
enum ecl_chattrib { /* character attribute */
|
||||
cat_whitespace, /* whitespace */
|
||||
cat_terminating, /* terminating macro */
|
||||
cat_non_terminating, /* non-terminating macro */
|
||||
|
|
@ -315,8 +315,8 @@ enum chattrib { /* character attribute */
|
|||
cat_constituent /* constituent */
|
||||
};
|
||||
|
||||
struct readtable_entry { /* read table entry */
|
||||
enum chattrib syntax_type; /* character attribute */
|
||||
struct ecl_readtable_entry { /* read table entry */
|
||||
enum ecl_chattrib syntax_type; /* character attribute */
|
||||
cl_object macro; /* macro function */
|
||||
cl_object *dispatch_table; /* pointer to the */
|
||||
/* dispatch table */
|
||||
|
|
@ -326,12 +326,12 @@ struct readtable_entry { /* read table entry */
|
|||
/* non-macro character */
|
||||
};
|
||||
|
||||
struct readtable { /* read table */
|
||||
struct ecl_readtable { /* read table */
|
||||
HEADER;
|
||||
struct readtable_entry *table; /* read table itself */
|
||||
struct ecl_readtable_entry *table; /* read table itself */
|
||||
};
|
||||
|
||||
struct pathname {
|
||||
struct ecl_pathname {
|
||||
HEADER1(logical); /* logical pathname? */
|
||||
cl_object host; /* host */
|
||||
cl_object device; /* device */
|
||||
|
|
@ -341,7 +341,7 @@ struct pathname {
|
|||
cl_object version; /* version */
|
||||
};
|
||||
|
||||
struct codeblock {
|
||||
struct ecl_codeblock {
|
||||
HEADER;
|
||||
void *handle; /* handle returned by dlopen */
|
||||
void *entry; /* entry point */
|
||||
|
|
@ -357,7 +357,7 @@ struct codeblock {
|
|||
cl_object links; /* list of symbols with linking calls */
|
||||
};
|
||||
|
||||
struct bytecodes {
|
||||
struct ecl_bytecodes {
|
||||
HEADER;
|
||||
cl_object name; /* function name */
|
||||
cl_object lex; /* lexical environment */
|
||||
|
|
@ -369,14 +369,14 @@ struct bytecodes {
|
|||
cl_object *data; /* non-inmediate constants used in the code */
|
||||
};
|
||||
|
||||
struct cfun { /* compiled function header */
|
||||
struct ecl_cfun { /* compiled function header */
|
||||
HEADER1(narg);
|
||||
cl_object name; /* compiled function name */
|
||||
cl_objectfn entry; /* entry address */
|
||||
cl_object block; /* descriptor of C code block for GC */
|
||||
};
|
||||
|
||||
struct cclosure { /* compiled closure header */
|
||||
struct ecl_cclosure { /* compiled closure header */
|
||||
HEADER;
|
||||
cl_object env; /* environment */
|
||||
cl_objectfn entry; /* entry address */
|
||||
|
|
@ -384,7 +384,7 @@ struct cclosure { /* compiled closure header */
|
|||
};
|
||||
|
||||
#ifdef ECL_FFI
|
||||
struct foreign { /* user defined datatype */
|
||||
struct ecl_foreign { /* user defined datatype */
|
||||
HEADER;
|
||||
cl_object tag; /* a tag identifying the type */
|
||||
cl_index size; /* the amount of memory allocated */
|
||||
|
|
@ -395,19 +395,19 @@ struct foreign { /* user defined datatype */
|
|||
/*
|
||||
dummy type
|
||||
*/
|
||||
struct dummy {
|
||||
struct ecl_dummy {
|
||||
HEADER;
|
||||
};
|
||||
|
||||
#ifdef THREADS
|
||||
struct cont {
|
||||
struct ecl_cont {
|
||||
/* already resumed */
|
||||
/* timed out */
|
||||
HEADER(resumed, timed_out);
|
||||
cl_object thread; /* its thread */
|
||||
};
|
||||
|
||||
struct thread {
|
||||
struct ecl_thread {
|
||||
HEADER;
|
||||
struct pd *self; /* the thread itself (really a *pd) */
|
||||
cl_index size; /* its size */
|
||||
|
|
@ -425,7 +425,7 @@ struct thread {
|
|||
#define CLASS_SLOTS(x) (x)->instance.slots[3]
|
||||
#define CLASS_CPL(x) (x)->instance.slots[4]
|
||||
|
||||
struct instance { /* instance header */
|
||||
struct ecl_instance { /* instance header */
|
||||
HEADER1(isgf);
|
||||
cl_index length; /* instance length */
|
||||
cl_object clas; /* instance class */
|
||||
|
|
@ -436,40 +436,40 @@ struct instance { /* instance header */
|
|||
/*
|
||||
Definition of lispunion.
|
||||
*/
|
||||
union lispunion {
|
||||
struct bignum big; /* bignum */
|
||||
struct ratio ratio; /* ratio */
|
||||
struct shortfloat_struct SF; /* short floating-point number */
|
||||
struct longfloat_struct LF; /* long floating-point number */
|
||||
struct complex complex;/* complex number */
|
||||
struct symbol symbol; /* symbol */
|
||||
struct package pack; /* package */
|
||||
struct cons cons; /* cons */
|
||||
struct hashtable hash; /* hash table */
|
||||
struct array array; /* array */
|
||||
struct vector vector; /* vector */
|
||||
struct string string; /* string */
|
||||
struct stream stream; /* stream */
|
||||
struct random random; /* random-states */
|
||||
struct readtable readtable; /* read table */
|
||||
struct pathname pathname; /* path name */
|
||||
struct bytecodes bytecodes; /* bytecompiled closure */
|
||||
struct cfun cfun; /* compiled function */
|
||||
struct cclosure cclosure; /* compiled closure */
|
||||
union cl_lispunion {
|
||||
struct ecl_bignum big; /* bignum */
|
||||
struct ecl_ratio ratio; /* ratio */
|
||||
struct ecl_shortfloat SF; /* short floating-point number */
|
||||
struct ecl_longfloat LF; /* long floating-point number */
|
||||
struct ecl_complex complex;/* complex number */
|
||||
struct ecl_symbol symbol; /* symbol */
|
||||
struct ecl_package pack; /* package */
|
||||
struct ecl_cons cons; /* cons */
|
||||
struct ecl_hashtable hash; /* hash table */
|
||||
struct ecl_array array; /* array */
|
||||
struct ecl_vector vector; /* vector */
|
||||
struct ecl_string string; /* string */
|
||||
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 closure */
|
||||
struct ecl_cfun cfun; /* compiled function */
|
||||
struct ecl_cclosure cclosure; /* compiled closure */
|
||||
|
||||
struct dummy d; /* dummy */
|
||||
struct ecl_dummy d; /* dummy */
|
||||
#ifdef CLOS
|
||||
struct instance instance; /* clos instance */
|
||||
struct ecl_instance instance; /* clos instance */
|
||||
#else
|
||||
struct structure str; /* structure */
|
||||
struct ecl_structure str; /* structure */
|
||||
#endif /* CLOS */
|
||||
#ifdef THREADS
|
||||
struct cont cont; /* continuation */
|
||||
struct thread thread; /* thread */
|
||||
struct ecl_cont cont; /* continuation */
|
||||
struct ecl_thread thread; /* thread */
|
||||
#endif /* THREADS */
|
||||
struct codeblock cblock; /* codeblock */
|
||||
struct ecl_codeblock cblock; /* codeblock */
|
||||
#ifdef ECL_FFI
|
||||
struct foreign foreign; /* user defined data type */
|
||||
struct ecl_foreign foreign; /* user defined data type */
|
||||
#endif
|
||||
};
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue