memory: move ecl_cons to memory.d

ecl_cons requires a separate allocator because it may be a small cons.
This commit is contained in:
Daniel Kochmański 2025-05-20 11:49:29 +02:00
parent a435f69b1f
commit 2bcb475df4
2 changed files with 37 additions and 23 deletions

View file

@ -283,10 +283,12 @@ alloc_object(cl_type t)
/* GC_MALLOC already resets objects */
switch (t) {
case t_fixnum:
return ecl_make_fixnum(0); /* Immediate fixnum */
case t_list: /* Small cons (no d.t) */
return ecl_cons(ECL_NIL, ECL_NIL);
case t_character:
return ECL_CODE_CHAR(' '); /* Immediate character */
return ECL_CODE_CHAR(' '); /* Immediate character */
case t_fixnum:
return ecl_make_fixnum(0); /* Immediate fixnum */
#ifdef ECL_SSE2
case t_sse_pack:
#endif
@ -368,26 +370,6 @@ ecl_alloc_compact_object(cl_type t, cl_index extra_space)
return x;
}
cl_object
ecl_cons(cl_object a, cl_object d)
{
const cl_env_ptr the_env = ecl_process_env();
struct ecl_cons *obj;
ecl_disable_interrupts_env(the_env);
obj = GC_MALLOC(sizeof(struct ecl_cons));
ecl_enable_interrupts_env(the_env);
#ifdef ECL_SMALL_CONS
obj->car = a;
obj->cdr = d;
return ECL_PTR_CONS(obj);
#else
obj->t = t_list;
obj->car = a;
obj->cdr = d;
return (cl_object)obj;
#endif
}
cl_object
ecl_alloc_instance(cl_index slots)
{

View file

@ -117,6 +117,38 @@ ecl_free_memory(void *ptr)
return ecl_core.allocator->free_memory(ptr);
}
/* -- Helpers --------------------------------------------------------------- */
cl_object
ecl_cons(cl_object a, cl_object d)
{
struct ecl_cons *obj = ecl_alloc_memory(sizeof(struct ecl_cons));
#ifdef ECL_SMALL_CONS
obj->car = a;
obj->cdr = d;
return ECL_PTR_CONS(obj);
#else
obj->t = t_list;
obj->car = a;
obj->cdr = d;
return (cl_object)obj;
#endif
}
cl_object
ecl_append_unsafe(cl_object x, cl_object y)
{
cl_object head = ECL_NIL, cons;
cl_object *tail = &head;
loop_for_on_unsafe(x) {
cons = ecl_list1(ECL_CONS_CAR(x));
*tail = cons;
tail = &ECL_CONS_CDR(cons);
} end_loop_for_on_unsafe(x);
*tail = y;
return head;
}
/* -- Rudimentary manual memory allocator ----------------------------------- */
static cl_object