In structures ecl_{array,vector,base_string,string}, replaced the bitfields...

In structures ecl_{array,vector,base_string,string}, replaced the bitfields hasfillp and adjustable with a single integer holding all flags. This solves several problems with Microsoft C compiler.
parent 92d5aac5
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:
==========
......
......@@ -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;
......
......@@ -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;
......
......@@ -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;
......
......@@ -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;
......
......@@ -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);
}
}
......
......@@ -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
......
......@@ -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;
......
......@@ -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)
......
......@@ -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
......
......@@ -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
......
......@@ -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 {
......
......@@ -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 */
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment