diff --git a/src/CHANGELOG b/src/CHANGELOG index dc6da2d64..47a4fac3b 100644 --- a/src/CHANGELOG +++ b/src/CHANGELOG @@ -1,6 +1,16 @@ ECL 9.7.2: ========== +* Ports: + + - The MSVC port now boots also when built without support for Unicode. + + - The mingw32 port builds without threads. For multithreading, the user will + have to build version 7.2-alpha2 of the garbage collector manually. + + - The NetBSD port builds with default values using the garbage collector + supplied with the pkgsrc distribution. + * Compiler: - The compiler now understands FFI types :[u]int{8,16,32,64}-t. @@ -11,14 +21,19 @@ ECL 9.7.2: * Visible changes: - - Cygwin now uses the 'flatinstall' model in which all ECL files are - stored in the same directory. This solves problems related to locating - the ECL.DLL library and other files. - - New functions ecl_make_[u]int(), ecl_make_[u]long(), ecl_to_[u]int(), ecl_to_[u]long(), ecl_to_bool(), ecl_make_bool(), convert between C types and cl_object. + - The C structures ecl_array, ecl_vector, ecl_base_string and ecl_string have + changed. Instead of using bitfields for hasfillp and adjustable we now + use a single integer field, and handle the bits manually. See the + new macros ECL_ADJUSTABLE_ARRAY_P and ECL_ARRAY_HAS_FILL_POINTER_P. + +* Bugs fixed: + + - SI:GET-LIBRARY-PATHNAME did not work properly in Windows. + ECL 9.7.1: ========== diff --git a/src/c/array.d b/src/c/array.d index 791303dff..01a3cd737 100644 --- a/src/c/array.d +++ b/src/c/array.d @@ -421,7 +421,7 @@ si_make_pure_array(cl_object etype, cl_object dims, cl_object adj, x->array.self.t = NULL; /* for GC sake */ x->array.rank = r; x->array.elttype = (short)ecl_symbol_to_elttype(etype); - x->array.hasfillp = 0; + x->array.flags = 0; /* no fill pointer, no adjustable */ x->array.dims = (cl_index *)ecl_alloc_atomic_align(sizeof(cl_index)*r, sizeof(cl_index)); for (i = 0, s = 1; i < r; i++, dims = ECL_CONS_CDR(dims)) { j = ecl_fixnum_in_range(@'make-array', "dimension", @@ -431,7 +431,9 @@ si_make_pure_array(cl_object etype, cl_object dims, cl_object adj, FEerror("The array total size, ~D, is too large.", 1, MAKE_FIXNUM(s)); } x->array.dim = s; - x->array.adjustable = adj != Cnil; + if (adj != Cnil) { + x->array.flags |= ECL_FLAG_ADJUSTABLE; + } if (Null(displ)) ecl_array_allocself(x); else @@ -473,15 +475,17 @@ si_make_vector(cl_object etype, cl_object dim, cl_object adj, x->vector.self.t = NULL; /* for GC sake */ x->vector.displaced = Cnil; x->vector.dim = d; - x->vector.adjustable = adj != Cnil; + x->vector.flags = 0; + if (adj != Cnil) { + x->vector.flags |= ECL_FLAG_ADJUSTABLE; + } if (Null(fillp)) { - x->vector.hasfillp = FALSE; f = d; } else if (fillp == Ct) { - x->vector.hasfillp = TRUE; + x->vector.flags |= ECL_FLAG_HAS_FILL_POINTER; f = d; } else if (FIXNUMP(fillp) && ((f = fix(fillp)) <= d) && (f >= 0)) { - x->vector.hasfillp = TRUE; + x->vector.flags |= ECL_FLAG_HAS_FILL_POINTER; } else { fillp = ecl_type_error(@'make-array',"fill pointer",fillp, cl_list(3,@'or',cl_list(3,@'member',Cnil,Ct), @@ -759,7 +763,7 @@ cl_object cl_adjustable_array_p(cl_object a) { assert_type_array(a); - @(return (a->array.adjustable ? Ct : Cnil)) + @(return (ECL_ADJUSTABLE_ARRAY_P(a) ? Ct : Cnil)) } /* @@ -844,8 +848,7 @@ cl_svref(cl_object x, cl_object index) cl_index i; while (type_of(x) != t_vector || - x->vector.adjustable || - x->vector.hasfillp || + (x->vector.flags & (ECL_FLAG_ADJUSTABLE | ECL_FLAG_HAS_FILL_POINTER)) || CAR(x->vector.displaced) != Cnil || (cl_elttype)x->vector.elttype != aet_object) { @@ -862,8 +865,7 @@ si_svset(cl_object x, cl_object index, cl_object v) cl_index i; while (type_of(x) != t_vector || - x->vector.adjustable || - x->vector.hasfillp || + (x->vector.flags & (ECL_FLAG_ADJUSTABLE | ECL_FLAG_HAS_FILL_POINTER)) || CAR(x->vector.displaced) != Cnil || (cl_elttype)x->vector.elttype != aet_object) { @@ -888,7 +890,7 @@ cl_array_has_fill_pointer_p(cl_object a) case t_string: #endif case t_base_string: - r = a->vector.hasfillp? Ct : Cnil; + r = ECL_ARRAY_HAS_FILL_POINTER_P(a)? Ct : Cnil; break; default: a = ecl_type_error(@'array-has-fill-pointer-p',"argument", @@ -903,7 +905,7 @@ cl_fill_pointer(cl_object a) { const cl_env_ptr the_env = ecl_process_env(); assert_type_vector(a); - if (!a->vector.hasfillp) { + if (!ECL_ARRAY_HAS_FILL_POINTER_P(a)) { a = ecl_type_error(@'fill-pointer', "argument", a, c_string_to_object("(AND VECTOR (SATISFIES ARRAY-HAS-FILL-POINTER-P))")); } @@ -918,8 +920,7 @@ si_fill_pointer_set(cl_object a, cl_object fp) { const cl_env_ptr the_env = ecl_process_env(); assert_type_vector(a); - AGAIN: - if (a->vector.hasfillp) { + if (ECL_ARRAY_HAS_FILL_POINTER_P(a)) { a->vector.fillp = ecl_fixnum_in_range(@'adjust-array',"fill pointer",fp, 0,a->vector.dim); @@ -944,7 +945,7 @@ si_replace_array(cl_object olda, cl_object newa) if (type_of(olda) != type_of(newa) || (type_of(olda) == t_array && olda->array.rank != newa->array.rank)) goto CANNOT; - if (!olda->array.adjustable) { + if (!ECL_ADJUSTABLE_ARRAY_P(olda)) { /* When an array is not adjustable, we simply output the new array */ olda = newa; goto OUTPUT; diff --git a/src/c/ffi.d b/src/c/ffi.d index df8dd9ad5..8c69a445c 100644 --- a/src/c/ffi.d +++ b/src/c/ffi.d @@ -127,7 +127,7 @@ ecl_base_string_pointer_safe(cl_object f) /* FIXME! Is there a better function name? */ f = ecl_check_cl_type(@'si::make-foreign-data-from-array', f, t_base_string); s = f->base_string.self; - if (f->base_string.hasfillp && s[f->base_string.fillp] != 0) { + if (ECL_ARRAY_HAS_FILL_POINTER_P(f) && s[f->base_string.fillp] != 0) { FEerror("Cannot coerce a string with fill pointer to (char *)", 0); } return (char *)s; @@ -138,7 +138,8 @@ ecl_null_terminated_base_string(cl_object f) { /* FIXME! Is there a better function name? */ f = ecl_check_cl_type(@'si::make-foreign-data-from-array', f, t_base_string); - if (f->base_string.hasfillp && f->base_string.self[f->base_string.fillp] != 0) { + if (ECL_ARRAY_HAS_FILL_POINTER_P(f) && + f->base_string.self[f->base_string.fillp] != 0) { return cl_copy_seq(f); } else { return f; diff --git a/src/c/file.d b/src/c/file.d index d1318081a..745187a72 100644 --- a/src/c/file.d +++ b/src/c/file.d @@ -1421,7 +1421,7 @@ cl_object si_make_string_output_stream_from_string(cl_object s) { cl_object strm = alloc_stream(); - if (!ecl_stringp(s) || !s->base_string.hasfillp) + if (!ecl_stringp(s) || !ECL_ARRAY_HAS_FILL_POINTER_P(s)) FEerror("~S is not a -string with a fill-pointer.", 1, s); strm->stream.ops = duplicate_dispatch_table(&str_out_ops); strm->stream.mode = (short)smm_string_output; diff --git a/src/c/format.d b/src/c/format.d index 7adc32b78..91c11052e 100644 --- a/src/c/format.d +++ b/src/c/format.d @@ -2116,14 +2116,14 @@ DIRECTIVE: } if (ecl_stringp(strm)) { output = strm; - if (!output->base_string.hasfillp) { + if (!ECL_ARRAY_HAS_FILL_POINTER_P(output)) { cl_error(7, @'si::format-error', @':format-control', make_constant_base_string( "Cannot output to a non adjustable string."), @':control-string', string, @':offset', MAKE_FIXNUM(0)); - } + } strm = si_make_string_output_stream_from_string(strm); if (null_strm == 0) output = Cnil; diff --git a/src/c/num_log.d b/src/c/num_log.d index 0dd611d81..b224f8017 100644 --- a/src/c/num_log.d +++ b/src/c/num_log.d @@ -855,7 +855,7 @@ si_bit_array_op(cl_object o, cl_object x, cl_object y, cl_object r) r->array.dims = x->array.dims; r->array.elttype = aet_bit; r->array.dim = x->array.dim; - r->array.adjustable = FALSE; + r->array.flags = 0; /* no fill pointer, not adjustable */ ecl_array_allocself(r); } } diff --git a/src/c/predicate.d b/src/c/predicate.d index c2e127d9b..a70da6d47 100644 --- a/src/c/predicate.d +++ b/src/c/predicate.d @@ -169,14 +169,14 @@ cl_simple_string_p(cl_object x) #ifdef ECL_UNICODE cl_type t = type_of(x); @(return (((t == t_base_string || (t == t_string)) && - !x->string.adjustable && - !x->string.hasfillp && - Null(CAR(x->string.displaced))) ? Ct : Cnil)) + !ECL_ADJUSTABLE_ARRAY_P(x) && + !ECL_ARRAY_HAS_FILL_POINTER_P(x) && + Null(CAR(x->string.displaced))) ? Ct : Cnil)) #else @(return ((type_of(x) == t_base_string && - !x->base_string.adjustable && - !x->base_string.hasfillp && - Null(CAR(x->base_string.displaced))) ? Ct : Cnil)) + !ECL_ADJUSTABLE_ARRAY_P(x) && + !ECL_ARRAY_HAS_FILL_POINTER_P(x) && + Null(CAR(x->base_string.displaced))) ? Ct : Cnil)) #endif } @@ -193,9 +193,9 @@ cl_object cl_simple_bit_vector_p(cl_object x) { @(return ((type_of(x) == t_bitvector && - !x->vector.adjustable && - !x->vector.hasfillp && - Null(CAR(x->vector.displaced))) ? Ct : Cnil)) + !ECL_ADJUSTABLE_ARRAY_P(x) && + !ECL_ARRAY_HAS_FILL_POINTER_P(x) && + Null(CAR(x->vector.displaced))) ? Ct : Cnil)) } cl_object @@ -203,10 +203,10 @@ cl_simple_vector_p(cl_object x) { cl_type t = type_of(x); @(return ((t == t_vector && - !x->vector.adjustable && - !x->vector.hasfillp && - Null(CAR(x->vector.displaced)) && - (cl_elttype)x->vector.elttype == aet_object) ? Ct : Cnil)) + !ECL_ADJUSTABLE_ARRAY_P(x) && + !ECL_ARRAY_HAS_FILL_POINTER_P(x) && + Null(CAR(x->vector.displaced)) && + (cl_elttype)x->vector.elttype == aet_object) ? Ct : Cnil)) } cl_object diff --git a/src/c/sequence.d b/src/c/sequence.d index 98ce294aa..c60dde973 100644 --- a/src/c/sequence.d +++ b/src/c/sequence.d @@ -36,8 +36,7 @@ ecl_alloc_simple_vector(cl_index l, cl_elttype aet) #endif case aet_bit: x = ecl_alloc_object(t_bitvector); - x->vector.hasfillp = FALSE; - x->vector.adjustable = FALSE; + x->vector.flags = 0; /* no fill pointer, not adjustable */ x->vector.displaced = Cnil; x->vector.dim = x->vector.fillp = l; x->vector.offset = 0; @@ -46,8 +45,7 @@ ecl_alloc_simple_vector(cl_index l, cl_elttype aet) break; default: x = ecl_alloc_object(t_vector); - x->vector.hasfillp = FALSE; - x->vector.adjustable = FALSE; + x->vector.flags = 0; /* no fill pointer, not adjustable */ x->vector.displaced = Cnil; x->vector.dim = x->vector.fillp = l; x->vector.self.t = NULL; diff --git a/src/c/string.d b/src/c/string.d index 86bcdf33c..fee42843a 100644 --- a/src/c/string.d +++ b/src/c/string.d @@ -79,8 +79,7 @@ cl_alloc_simple_base_string(cl_index length) x = ecl_alloc_object(t_base_string); x->base_string.elttype = aet_bc; - x->base_string.hasfillp = FALSE; - x->base_string.adjustable = FALSE; + x->base_string.flags = 0; /* no fill pointer, no adjustable */ x->base_string.displaced = Cnil; x->base_string.dim = (x->base_string.fillp = length); x->base_string.self = (ecl_base_char *)ecl_alloc_atomic(length+1); @@ -97,8 +96,7 @@ cl_alloc_simple_extended_string(cl_index length) /* should this call si_make_vector? */ x = ecl_alloc_object(t_string); x->string.elttype = aet_ch; - x->string.hasfillp = FALSE; - x->string.adjustable = FALSE; + x->string.flags = 0; /* no fill pointer, no adjustable */ x->string.displaced = Cnil; x->string.dim = x->string.fillp = length; x->string.self = (ecl_character *) @@ -118,8 +116,7 @@ cl_alloc_adjustable_base_string(cl_index l) { cl_object output = cl_alloc_simple_base_string(l); output->base_string.fillp = 0; - output->base_string.hasfillp = TRUE; - output->base_string.adjustable = TRUE; + output->base_string.flags = ECL_FLAG_HAS_FILL_POINTER | ECL_FLAG_ADJUSTABLE; return output; } @@ -128,9 +125,8 @@ cl_object ecl_alloc_adjustable_extended_string(cl_index l) { cl_object output = cl_alloc_simple_extended_string(l); - output->base_string.fillp = 0; - output->base_string.hasfillp = TRUE; - output->base_string.adjustable = TRUE; + output->string.fillp = 0; + output->string.flags = ECL_FLAG_HAS_FILL_POINTER | ECL_FLAG_ADJUSTABLE; return output; } #endif @@ -146,8 +142,7 @@ make_simple_base_string(char *s) x = ecl_alloc_object(t_base_string); x->base_string.elttype = aet_bc; - x->base_string.hasfillp = FALSE; - x->base_string.adjustable = FALSE; + x->base_string.flags = 0; /* no fill pointer, no adjustable */ x->base_string.displaced = Cnil; x->base_string.dim = (x->base_string.fillp = l); x->base_string.self = (ecl_base_char *)s; @@ -985,7 +980,7 @@ ecl_string_push_extend(cl_object s, ecl_character c) if (s->base_string.fillp >= s->base_string.dim) { cl_object other; cl_index new_length; - if (!s->base_string.adjustable) + if (!ECL_ADJUSTABLE_ARRAY_P(s)) FEerror("string-push-extend: the string ~S is not adjustable.", 1, s); if (s->base_string.dim >= ADIMLIM) diff --git a/src/c/typespec.d b/src/c/typespec.d index 3c343d136..8f4ef4fd3 100644 --- a/src/c/typespec.d +++ b/src/c/typespec.d @@ -367,7 +367,7 @@ cl_type_of(cl_object x) t = @'symbol'; break; case t_array: - if (x->array.adjustable || + if (ECL_ADJUSTABLE_ARRAY_P(x) || !Null(CAR(x->array.displaced))) t = @'array'; else @@ -375,11 +375,11 @@ cl_type_of(cl_object x) t = cl_list(3, t, ecl_elttype_to_symbol(ecl_array_elttype(x)), cl_array_dimensions(1, x)); break; case t_vector: - if (x->vector.adjustable || + if (ECL_ADJUSTABLE_ARRAY_P(x) || !Null(CAR(x->vector.displaced))) { t = cl_list(3, @'vector', ecl_elttype_to_symbol(ecl_array_elttype(x)), MAKE_FIXNUM(x->vector.dim)); - } else if (x->vector.hasfillp || + } else if (ECL_ARRAY_HAS_FILL_POINTER_P(x) || (cl_elttype)x->vector.elttype != aet_object) { t = cl_list(3, @'simple-array', ecl_elttype_to_symbol(ecl_array_elttype(x)), cl_array_dimensions(1, x)); @@ -389,8 +389,8 @@ cl_type_of(cl_object x) break; #ifdef ECL_UNICODE case t_string: - if (x->string.adjustable || - x->string.hasfillp || + if (ECL_ADJUSTABLE_ARRAY_P(x) || + ECL_ARRAY_HAS_FILL_POINTER_P(x) || !Null(CAR(x->string.displaced))) t = @'array'; else @@ -399,8 +399,8 @@ cl_type_of(cl_object x) break; #endif case t_base_string: - if (x->base_string.adjustable || - x->base_string.hasfillp || + if (ECL_ADJUSTABLE_ARRAY_P(x) || + ECL_ARRAY_HAS_FILL_POINTER_P(x) || !Null(CAR(x->base_string.displaced))) t = @'array'; else @@ -408,8 +408,8 @@ cl_type_of(cl_object x) t = cl_list(3, t, @'base-char', cl_list(1, MAKE_FIXNUM(x->base_string.dim))); break; case t_bitvector: - if (x->vector.adjustable || - x->vector.hasfillp || + if (ECL_ADJUSTABLE_ARRAY_P(x) || + ECL_ARRAY_HAS_FILL_POINTER_P(x) || !Null(CAR(x->vector.displaced))) t = @'array'; else diff --git a/src/gc/configure b/src/gc/configure index 603b587b1..002d616a5 100755 --- a/src/gc/configure +++ b/src/gc/configure @@ -4912,7 +4912,7 @@ echo "$as_me: error: \"Pthreads not supported by the GC on this platform.\"" >&2 cat >>confdefs.h <<\_ACEOF #define GC_WIN32_THREADS 1 _ACEOF - + win32_threads=1 cat >>confdefs.h <<\_ACEOF #define NO_GETENV 1 _ACEOF diff --git a/src/h/ecl-cmp.h b/src/h/ecl-cmp.h index f19b4191a..1202a9462 100644 --- a/src/h/ecl-cmp.h +++ b/src/h/ecl-cmp.h @@ -28,7 +28,7 @@ #define ecl_def_ct_base_string(name,chars,len,static,const) \ static const struct ecl_base_string name ## data = { \ - (int8_t)t_base_string, 0, aet_bc, FALSE, FALSE, \ + (int8_t)t_base_string, 0, aet_bc, 0, \ Cnil, (cl_index)(len), (cl_index)(len), \ (ecl_base_char*)(chars) }; \ static const cl_object name = (cl_object)(& name ## data) @@ -46,10 +46,10 @@ static const cl_object name = (cl_object)(& name ## data) #define ecl_def_ct_vector(name,type,raw,len,static,const) \ - static const struct ecl_vector name ## data = { \ - (int8_t)t_vector, 0, FALSE, FALSE, \ + static const struct ecl_vector name ## data = { \ + (int8_t)t_vector, 0, (type), 0, \ Cnil, (cl_index)(len), (cl_index)(len), \ - (ecl_base_char*)(raw), (type), 0 }; \ + (ecl_base_char*)(raw), 0 }; \ static const cl_object name = (cl_object)(& name ## data) enum ecl_locative_type { diff --git a/src/h/object.h b/src/h/object.h index 0434c66cb..2c4b1b633 100644 --- a/src/h/object.h +++ b/src/h/object.h @@ -153,7 +153,6 @@ typedef cl_object (*cl_objectfn_fixed)(); #define HEADER int8_t t, m, padding[2] #define HEADER1(field) int8_t t, m, field, padding #define HEADER2(field1,field2) int8_t t, m, field1, field2 -#define HEADER3(field1,flag2,flag3) int8_t t, m, field1; unsigned flag2:1, flag3:1 #define HEADER4(field1,flag2,flag3,flag4) int8_t t, m, field1; unsigned flag2:4, flag3:2, flag4:2 struct ecl_singlefloat { @@ -412,10 +411,15 @@ union ecl_array_data { 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 */ - HEADER3(elttype,adjustable,hasfillp); + HEADER2(elttype,flags); /* array element type, has fill ptr, adjustable-p */ cl_object displaced; /* displaced */ cl_index dim; /* dimension */ cl_index *dims; /* table of dimensions */ @@ -427,7 +431,7 @@ struct ecl_array { /* array header */ struct ecl_vector { /* vector header */ /* adjustable flag */ /* has-fill-pointer flag */ - HEADER3(elttype,adjustable,hasfillp); + HEADER2(elttype,flags); /* array element type, has fill ptr, adjustable-p */ cl_object displaced; /* displaced */ cl_index dim; /* dimension */ cl_index fillp; /* fill pointer */ @@ -440,7 +444,7 @@ struct ecl_vector { /* vector header */ struct ecl_base_string { /* string header */ /* adjustable flag */ /* has-fill-pointer flag */ - HEADER3(elttype,adjustable,hasfillp); + HEADER2(elttype,flags); /* array element type, has fill ptr, adjustable-p */ cl_object displaced; /* displaced */ cl_index dim; /* dimension */ /* string length */ @@ -454,7 +458,7 @@ struct ecl_base_string { /* string header */ struct ecl_string { /* string header */ /* adjustable flag */ /* has-fill-pointer flag */ - HEADER3(elttype,adjustable,hasfillp); + HEADER2(elttype,flags); /* array element type, has fill ptr, adjustable-p */ cl_object displaced; /* displaced */ cl_index dim; /* dimension */ /* string length */