From fe27ab860088903cb73c8dc1d7612ffde413b4cc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Wed, 27 Apr 2022 13:35:40 +0200 Subject: [PATCH 1/2] core: add a new utility 'si_adjust_vector' to arrays.d This function is added to avoid using in the core the f unction CL:ADJUST-ARRAY, that is not defined during bootstrapping. --- src/c/array.d | 21 +++++++++++++++++++-- src/c/symbols_list.h | 1 + src/cmp/proclamations.lsp | 1 + src/doc/manual/standards/arrays.txi | 14 ++++++++++++-- src/h/external.h | 1 + src/tests/normal-tests/mixed.lsp | 7 +++++++ 6 files changed, 41 insertions(+), 4 deletions(-) diff --git a/src/c/array.d b/src/c/array.d index f97cd5fbc..bc67e1aa8 100644 --- a/src/c/array.d +++ b/src/c/array.d @@ -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) diff --git a/src/c/symbols_list.h b/src/c/symbols_list.h index 92361f796..9d0df5019 100755 --- a/src/c/symbols_list.h +++ b/src/c/symbols_list.h @@ -1148,6 +1148,7 @@ cl_symbols[] = { {SYS_ "UNQUOTE" ECL_FUN(NULL, NULL, -1) ECL_VAR(SI_ORDINARY, OBJNULL)}, {SYS_ "UNQUOTE-NSPLICE" ECL_FUN(NULL, NULL, -1) ECL_VAR(SI_ORDINARY, OBJNULL)}, {SYS_ "UNQUOTE-SPLICE" ECL_FUN(NULL, NULL, -1) ECL_VAR(SI_ORDINARY, OBJNULL)}, +{SYS_ "ADJUST-VECTOR" ECL_FUN("si_adjust_vector", si_adjust_vector, 2) ECL_VAR(SI_ORDINARY, OBJNULL)}, {SYS_ "ALLOCATE-RAW-INSTANCE" ECL_FUN("si_allocate_raw_instance", si_allocate_raw_instance, 3) ECL_VAR(SI_ORDINARY, OBJNULL)}, {EXT_ "ARGC" ECL_FUN("si_argc", si_argc, 0) ECL_VAR(EXT_ORDINARY, OBJNULL)}, {EXT_ "ARGV" ECL_FUN("si_argv", si_argv, 1) ECL_VAR(EXT_ORDINARY, OBJNULL)}, diff --git a/src/cmp/proclamations.lsp b/src/cmp/proclamations.lsp index 15a8ccfb3..0224b5b88 100644 --- a/src/cmp/proclamations.lsp +++ b/src/cmp/proclamations.lsp @@ -874,6 +874,7 @@ ;; ECL extensions (proclamation si:make-pure-array (t t t t t t) array) (proclamation si:make-vector (t t t t t t) vector) +(proclamation si:adjust-vector (vector ext:array-index) vector) (proclamation si:aset (array t &rest t) t) (proclamation si:row-major-aset (array ext:array-index t) t) (proclamation si:svset (simple-vector ext:array-index t) t) diff --git a/src/doc/manual/standards/arrays.txi b/src/doc/manual/standards/arrays.txi index 184ce0e01..5fd4196ec 100644 --- a/src/doc/manual/standards/arrays.txi +++ b/src/doc/manual/standards/arrays.txi @@ -114,12 +114,18 @@ Creating array and vectors @cppdef ecl_alloc_simple_vector @cppdef si_make_vector @cppdef si_make_array +@cppdef si_adjust_vector @deftypefun cl_object ecl_alloc_simple_vector (cl_index length, cl_elttype element_type); @deftypefunx cl_object si_make_vector (cl_object element_type, cl_object length, cl_object adjustablep, cl_object fill_pointerp, cl_object displaced_to, cl_object displacement); @deftypefunx cl_object si_make_array (cl_object element_type, cl_object dimensions, cl_object adjustablep, cl_object fill_pointerp, cl_object displaced_to, cl_object displacement); +@deftypefunx cl_object si_adjust_vector (cl_object vector, cl_object length); @paragraph Description -The function @coderef{ecl_alloc_simple_vector} is the simplest constructor, creating a simple vector (i.e. non-adjustable and without a fill pointer), of the given size, preallocating the memory for the array data. The first argument, @emph{element_type}, is a C constant that represents a valid array element type (See @coderef{cl_elttype}). +The function @coderef{ecl_alloc_simple_vector} is the simplest +constructor, creating a simple vector (i.e. non-adjustable and without +a fill pointer), of the given size, preallocating the memory for the +array data. The first argument, @emph{element_type}, is a C constant +that represents a valid array element type (See @coderef{cl_elttype}). The function @coderef{si_make_vector} does the same job but allows creating an array with fill pointer, which is adjustable or displaced to another array. @itemize @@ -130,7 +136,11 @@ The function @coderef{si_make_vector} does the same job but allows creating an a @item displacement is either ECL_NIL or a non-negative value with the array displacement. @end itemize -Finally, the function @coderef{si_make_array} does a similar job to @coderef{si_make_vector} but its second argument, @emph{dimension}, can be a list of dimensions, to create a multidimensional array. +Adjustable vector may be adjusted with the function @coderef{si_adjust_vector}. + +Finally, the function @coderef{si_make_array} does a similar job to +@coderef{si_make_vector} but its second argument, @emph{dimension}, +can be a list of dimensions, to create a multidimensional array. @paragraph Examples Create one-dimensional @code{base-string} with room for 11 characters: diff --git a/src/h/external.h b/src/h/external.h index 8066d7827..e3bfc6eee 100755 --- a/src/h/external.h +++ b/src/h/external.h @@ -334,6 +334,7 @@ extern ECL_API cl_object APPLY(cl_narg n, cl_objectfn, cl_object *x); extern ECL_API cl_object cl_row_major_aref(cl_object x, cl_object i); extern ECL_API cl_object si_row_major_aset(cl_object x, cl_object i, cl_object v); extern ECL_API cl_object si_make_vector(cl_object etype, cl_object dim, cl_object adj, cl_object fillp, cl_object displ, cl_object disploff); +extern ECL_API cl_object si_adjust_vector(cl_object vector, cl_object dim); /* for open-coding the access while preserving the bounds and type check: */ extern ECL_API void *ecl_row_major_ptr(cl_object arr, cl_index index, cl_index bytes); diff --git a/src/tests/normal-tests/mixed.lsp b/src/tests/normal-tests/mixed.lsp index 0726ead48..0d7522e39 100644 --- a/src/tests/normal-tests/mixed.lsp +++ b/src/tests/normal-tests/mixed.lsp @@ -422,3 +422,10 @@ (LET ((FU 1) (BAR 2)) (+ FU BAR 7)) A"))) + +;; Created: 2022-04-27 +;; Contains: a smoke test for a new operator si:adjust-vector +(test mix.0022.adjust-vector + (let ((vector (si:make-vector t 10 t nil nil nil))) + (si:adjust-vector vector 20) + (is (= 20 (array-total-size vector))))) From 52d0d64f9ce57595f181de2da6279fde64511eb7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Kochma=C5=84ski?= Date: Wed, 27 Apr 2022 13:40:48 +0200 Subject: [PATCH 2/2] ecl_min: don't use ADJUST-ARRAY in the core The function ADJUST-ARRAY is defined later in Lisp code. Instead of that we use a newly introduced SI:ADJUST-VECTOR. Fixes #678. --- src/c/file.d | 6 +----- src/c/serialize.d | 3 +-- src/c/string.d | 7 +++---- 3 files changed, 5 insertions(+), 11 deletions(-) diff --git a/src/c/file.d b/src/c/file.d index 877b43f64..eb9a05d2b 100755 --- a/src/c/file.d +++ b/src/c/file.d @@ -4667,11 +4667,7 @@ static void seq_out_enlarge_vector(cl_object strm) { cl_object vector = SEQ_OUTPUT_VECTOR(strm); - if (!ECL_ADJUSTABLE_ARRAY_P(vector)) { - FEerror("Can't adjust the dimensions of the sequence of sequence stream ~A", 1, strm); - } - vector = _ecl_funcall3(@'adjust-array', vector, - ecl_ash(ecl_make_fixnum(vector->vector.dim), 1)); + si_adjust_vector(vector, ecl_ash(ecl_make_fixnum(vector->vector.dim), 1)); SEQ_OUTPUT_VECTOR(strm) = vector; } diff --git a/src/c/serialize.d b/src/c/serialize.d index cb289da70..ec20f7a12 100644 --- a/src/c/serialize.d +++ b/src/c/serialize.d @@ -97,8 +97,7 @@ alloc(pool_t pool, cl_index size) cl_index next_fillp = fillp + bytes; if (next_fillp >= pool->data->vector.dim) { cl_index new_dim = next_fillp + next_fillp / 2; - pool->data = _ecl_funcall3(@'adjust-array', pool->data, - ecl_make_fixnum(new_dim)); + pool->data = si_adjust_vector(pool->data, ecl_make_fixnum(new_dim)); } pool->data->vector.fillp = next_fillp; return fillp; diff --git a/src/c/string.d b/src/c/string.d index 2a4dc010c..df1d82d4f 100644 --- a/src/c/string.d +++ b/src/c/string.d @@ -922,10 +922,9 @@ nstring_case(cl_narg narg, cl_object fun, ecl_casefun casefun, ecl_va_list ARGS) if (output_size < output->base_string.dim) { break; } - output = _ecl_funcall3(@'adjust-array', output, - ecl_make_fixnum(input_size > output_size - ? input_size - : output_size + 128)); + output = si_adjust_vector(output, ecl_make_fixnum(input_size > output_size + ? input_size + : output_size + 128)); } while (1); output->base_string.fillp = output_size; if (ecl_fits_in_base_string(output)) {