mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-01-13 12:52:08 -08:00
First steps towards an implementation of the compiler that uses SERIALIZABLE
This commit is contained in:
Juan Jose Garcia Ripoll
parent
3141204d54
commit
bd0bd20f98
6 changed files with 73 additions and 28 deletions
|
|
@ -178,6 +178,9 @@ static const char *feature_names[] = {
|
|||
#endif
|
||||
#ifdef ecl_long_long_t
|
||||
"LONG-LONG",
|
||||
#endif
|
||||
#ifdef ECL_EXTERNALIZABLE
|
||||
"EXTERNALIZABLE",
|
||||
#endif
|
||||
0
|
||||
};
|
||||
|
|
|
|||
15
src/c/read.d
15
src/c/read.d
|
|
@ -2471,8 +2471,18 @@ read_VV(cl_object block, void (*entry_point)(cl_object))
|
|||
memset(VVtemp, 0, temp_len * sizeof(*VVtemp));
|
||||
|
||||
/* Read all data for the library */
|
||||
in=ecl_make_string_input_stream(make_constant_base_string(block->cblock.data_text),
|
||||
0, block->cblock.data_text_size);
|
||||
#ifdef ECL_EXTERNALIZABLE
|
||||
{
|
||||
cl_object v = ecl_deserialize(block->cblock.data_text);
|
||||
unlikely_if (v->vector.dim < len)
|
||||
FEreader_error("Not enough data while loading"
|
||||
"binary file", in, 0);
|
||||
memcpy(VV, v->vector.self.t, len * sizeof(cl_object));
|
||||
}
|
||||
#else
|
||||
in=ecl_make_string_input_stream
|
||||
(make_constant_base_string(block->cblock.data_text),
|
||||
0, block->cblock.data_text_size);
|
||||
progv_list = ECL_SYM_VAL(env, @'si::+ecl-syntax-progv-list+');
|
||||
bds_ndx = ecl_progv(env, ECL_CONS_CAR(progv_list),
|
||||
ECL_CONS_CDR(progv_list));
|
||||
|
|
@ -2498,6 +2508,7 @@ read_VV(cl_object block, void (*entry_point)(cl_object))
|
|||
unlikely_if (i < len)
|
||||
FEreader_error("Not enough data while loading"
|
||||
"binary file", in, 0);
|
||||
#endif
|
||||
NO_DATA_LABEL:
|
||||
for (i = 0; i < block->cblock.cfuns_size; i++) {
|
||||
const struct ecl_cfun *prototype = block->cblock.cfuns+i;
|
||||
|
|
|
|||
|
|
@ -118,7 +118,7 @@ static cl_object
|
|||
enqueue(pool_t pool, cl_object what)
|
||||
{
|
||||
cl_object record, index;
|
||||
if (FIXNUMP(what) || CHARACTERP(what)) {
|
||||
if (FIXNUMP(what) || CHARACTERP(what) || what == OBJNULL) {
|
||||
return what;
|
||||
}
|
||||
#ifdef ECL_SMALL_CONS
|
||||
|
|
@ -154,11 +154,11 @@ serialize_bits(pool_t pool, void *data, cl_index size)
|
|||
}
|
||||
|
||||
static void
|
||||
serialize_object_ptr(pool_t pool, cl_object *ptr, cl_index size)
|
||||
serialize_object_ptr(pool_t pool, cl_object *ptr, cl_index dim)
|
||||
{
|
||||
cl_index index = serialize_bits(pool, ptr, size*sizeof(cl_object));
|
||||
cl_object *p;
|
||||
for (p = pool->data->vector.self.t + index; index; p++, index--) {
|
||||
cl_index index = serialize_bits(pool, ptr, dim*sizeof(cl_object));
|
||||
for (; dim; dim--, index += sizeof(cl_object)) {
|
||||
cl_object *p = (cl_object)(pool->data->vector.self.b8 + index);
|
||||
*p = enqueue(pool, *p);
|
||||
p++;
|
||||
}
|
||||
|
|
@ -224,6 +224,11 @@ serialize_one(pool_t pool, cl_object what)
|
|||
buffer = (cl_object)(pool->data->vector.self.b8 + index);
|
||||
memcpy(buffer, what, bytes);
|
||||
switch (buffer->d.t) {
|
||||
case t_singlefloat:
|
||||
case t_doublefloat:
|
||||
#ifdef ECL_LONG_FLOAT
|
||||
case t_longfloat:
|
||||
#endif
|
||||
#ifndef ECL_SMALL_CONS
|
||||
case t_cons:
|
||||
buffer->cons.car = enqueue(pool, buffer->cons.car);
|
||||
|
|
@ -247,10 +252,22 @@ serialize_one(pool_t pool, cl_object what)
|
|||
buffer->complex.imag = enqueue(pool, buffer->complex.imag);
|
||||
break;
|
||||
}
|
||||
#ifdef ECL_UNICODE
|
||||
case t_string:
|
||||
#endif
|
||||
case t_vector:
|
||||
case t_bitvector:
|
||||
case t_base_string: {
|
||||
serialize_vector(pool, buffer);
|
||||
break;
|
||||
}
|
||||
case t_array: {
|
||||
cl_index bytes = ROUND_TO_WORD(buffer->array.rank *
|
||||
sizeof(cl_index));
|
||||
serialize_bits(pool, buffer->array.dims, bytes);
|
||||
serialize_vector(pool, buffer);
|
||||
break;
|
||||
}
|
||||
case t_package: {
|
||||
struct fake_package *p = (struct fake_package *)buffer;
|
||||
p->name = enqueue(pool, what->pack.name);
|
||||
|
|
@ -488,11 +505,12 @@ fixup(cl_object o, cl_object *o_list)
|
|||
}
|
||||
|
||||
cl_object
|
||||
si_deserialize(cl_object data)
|
||||
ecl_deserialize(uint8_t *raw)
|
||||
{
|
||||
cl_index i, num_el = data->vector.self.index[1];
|
||||
cl_index *data = (cl_index*)raw;
|
||||
cl_index i, num_el = data[1];
|
||||
cl_object *output = ecl_alloc(sizeof(cl_object) * num_el);
|
||||
uint8_t *raw = (uint8_t*)(data->vector.self.index + 2);
|
||||
raw += 2*sizeof(cl_index);
|
||||
for (i = 0; i < num_el; i++) {
|
||||
raw = reconstruct_one(raw, output+i);
|
||||
}
|
||||
|
|
@ -517,14 +535,11 @@ si_deserialize(cl_object data)
|
|||
for (i = 0; i < num_el; i++) {
|
||||
fixup(output[i], output);
|
||||
}
|
||||
#if 0
|
||||
{
|
||||
cl_object v = output[0];
|
||||
GC_FREE(output);
|
||||
//ecl_dealloc(output);
|
||||
@(return v);
|
||||
}
|
||||
#else
|
||||
@(return output[0])
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
cl_object
|
||||
si_deserialize(cl_object data)
|
||||
{
|
||||
@(return ecl_deserialize(data->vector.self.b8))
|
||||
}
|
||||
|
|
|
|||
|
|
@ -79,21 +79,35 @@
|
|||
(*compiler-constants*
|
||||
(format stream "~%#define compiler_data_text NULL~%#define compiler_data_text_size 0~%")
|
||||
(setf output (concatenate 'vector (data-get-all-objects))))
|
||||
#+externalizable
|
||||
((plusp (data-size))
|
||||
(wt-data-begin stream)
|
||||
(wt-filtered-data
|
||||
(subseq (prin1-to-string (data-get-all-objects)) 1)
|
||||
stream)
|
||||
(wt-data-end stream)))
|
||||
(let* ((data (concatenate 'vector (data-get-all-objects)))
|
||||
(raw (si::serialize data))
|
||||
(l (length raw)))
|
||||
(format stream "~%#define compiler_data_text_size ~D~%static const uint8_t compiler_data_text[~D] = {" l l)
|
||||
(loop for byte across raw
|
||||
for i from 0
|
||||
when (zerop (mod i 20))
|
||||
do (terpri stream)
|
||||
do (format stream "~D," byte))
|
||||
(format stream "};")))
|
||||
#-externalizable
|
||||
((plusp (data-size))
|
||||
(let ((*wt-string-size* 0)
|
||||
(*wt-data-column* 80))
|
||||
(princ "static const char compiler_data_text[] = " stream)
|
||||
(wt-filtered-data
|
||||
(subseq (prin1-to-string (data-get-all-objects)) 1)
|
||||
stream)
|
||||
(princ #\; stream)
|
||||
(format stream "~%#define compiler_data_text_size ~D~%"
|
||||
*wt-string-size*))))
|
||||
(when must-close
|
||||
(close must-close))
|
||||
(data-init)
|
||||
output)))
|
||||
|
||||
(defun wt-data-begin (stream)
|
||||
(setq *wt-string-size* 0)
|
||||
(setq *wt-data-column* 80)
|
||||
(princ "static const char compiler_data_text[] = " stream)
|
||||
nil)
|
||||
|
||||
(defun wt-data-end (stream)
|
||||
|
|
|
|||
|
|
@ -339,6 +339,7 @@ extern ECL_API cl_index_pair ecl_sequence_start_end(cl_object fun, cl_object s,
|
|||
|
||||
extern cl_object si_serialize(cl_object root);
|
||||
extern cl_object si_deserialize(cl_object root);
|
||||
extern cl_object ecl_deserialize(uint8_t *data);
|
||||
|
||||
/* string.d */
|
||||
#define ecl_vector_start_end ecl_sequence_start_end
|
||||
|
|
|
|||
|
|
@ -34,6 +34,7 @@ typedef unsigned char byte;
|
|||
#ifdef ECL_SHORT_FLOAT
|
||||
#undef ECL_SHORT_FLOAT
|
||||
#endif
|
||||
#define ECL_EXTERNALIZABLE
|
||||
|
||||
/*
|
||||
Implementation types.
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue