mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-03-11 23:40:36 -07:00
Code Issues Projects Releases Packages Wiki Activity

core: add a new utility 'si_adjust_vector' to arrays.d

Browse source 
This function is added to avoid using in the core the f unction CL:ADJUST-ARRAY,
that is not defined during bootstrapping.
This commit is contained in:
Daniel Kochmański 2022-04-27 13:35:40 +02:00
parent 8d90e31ecc
commit fe27ab8600
6 changed files with 41 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

21
src/c/array.d
View file

@ -420,7 +420,7 @@ ecl_aset1(cl_object x, cl_index index, cl_object value)
/*
Internal function for making arrays of more than one dimension:
(si:make-pure-array dimension-list element-type adjustable
(si:make-pure-array element-type dimension-list adjustable
displaced-to displaced-index-offset)
*/
cl_object
@ -550,6 +550,23 @@ si_make_vector(cl_object etype, cl_object dim, cl_object adj,
@(return x);
}
cl_object
si_adjust_vector(cl_object vector, cl_object new_dim) {
cl_object new_vector;
if (!ECL_ADJUSTABLE_ARRAY_P(vector)) {
FEerror("The vector is not adjustable.", 0);
}
new_vector = si_make_vector(ecl_elttype_to_symbol(ecl_array_elttype(vector)),
new_dim,
ECL_T,
ecl_make_fixnum(vector->vector.fillp),
ECL_NIL,
ECL_NIL);
ecl_copy_subarray(new_vector, 0, vector, 0, vector->vector.dim);
si_replace_array(vector, new_vector);
return vector;
}
cl_object *
alloc_pointerfull_memory(cl_index l)
{
@ -1187,7 +1204,7 @@ si_fill_pointer_set(cl_object a, cl_object fp)
(si:replace-array old-array new-array).
Used in ADJUST-ARRAY.
Used in ADJUST-ARRAY and SI:ADJUST-VECTOR.
*/
cl_object
si_replace_array(cl_object olda, cl_object newa)