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

lwp: add new types CONTINUATION and THREAD

Browse source
This commit is contained in:
Daniel Kochmański 2026-03-12 21:46:01 +01:00
parent e4b66f0740
commit 7a4589ff7f
11 changed files with 103 additions and 1 deletions
Download patch file Download diff file Expand all files Collapse all files

2
src/c/Makefile.in
View file

@ -89,7 +89,7 @@ OBJS = main.o symbol.o package.o cons.o list.o apply.o eval.o interpreter.o
string.o cfun.o typespec.o assignment.o memory.o predicate.o array.o \
vector_push.o sequence.o cmpaux.o macros.o backq.o stack2.o time.o \
unixint.o mapfun.o multival.o hash.o format.o pathname.o structure.o \
load.o unixfsys.o unixsys.o serialize.o sse2.o atomic.o process.o \
load.o unixfsys.o unixsys.o serialize.o sse2.o atomic.o process.o lwp.o \
$(BOOT_OBJS) $(NUM_OBJS) $(WRITER_OBJS) $(READER_OBJS) $(STREAM_OBJS) \
$(CLOS_OBJS) $(FFI_OBJS) $(THREAD_OBJS) $(UNICODE_OBJS) @EXTRA_OBJS@

6
src/c/clos/instance.d
View file

@ -413,6 +413,8 @@ enum ecl_built_in_classes {
ECL_BUILTIN_HASH_TABLE,
ECL_BUILTIN_RANDOM_STATE,
ECL_BUILTIN_READTABLE,
ECL_BUILTIN_CONTINUATION,
ECL_BUILTIN_THREAD,
ECL_BUILTIN_CODE_BLOCK,
ECL_BUILTIN_FOREIGN_DATA,
ECL_BUILTIN_FRAME,
@ -530,6 +532,10 @@ cl_class_of(cl_object x)
case t_mailbox:
index = ECL_BUILTIN_MAILBOX; break;
#endif
case t_cont:
index = ECL_BUILTIN_CONTINUATION; break;
case t_thread:
index = ECL_BUILTIN_THREAD; break;
case t_codeblock:
index = ECL_BUILTIN_CODE_BLOCK; break;
case t_foreign:

34
src/c/lwp.d Normal file
View file

@ -0,0 +1,34 @@
/* -*- Mode: C; c-basic-offset: 2; indent-tabs-mode: nil -*- */
/* vim: set filetype=c tabstop=2 shiftwidth=2 expandtab: */
/*
* lwp.c - light-weight processes and delimited continuations
*
* Copyright (c) 1990, Giuseppe Attardi.
* Copyright (c) 2001, Juan Jose Garcia Ripoll.
* Copyright (c) 2026, Daniel Kochmański
*
* See file 'LICENSE' for the copyright details.
*
*/
#include <ecl/ecl.h>
cl_object
si_make_thread(cl_object fun)
{
const cl_env_ptr the_env = ecl_process_env();
cl_object o = ecl_alloc_object(t_thread);
o->thread.fun = fun;
o->thread.cont = ECL_NIL;
ecl_return1(the_env, o);
}
cl_object
si_make_continuation(cl_object thread)
{
const cl_env_ptr the_env = ecl_process_env();
cl_object o = ecl_alloc_object(t_cont);
o->cont.thread = thread;
ecl_return1(the_env, o);
}

7
src/c/memory.d
View file

@ -262,6 +262,13 @@ init_type_info_database(void)
to_bitmap(&o, &(o.mailbox.name)) |
to_bitmap(&o, &(o.mailbox.data)));
#endif
init_tm(t_cont, "CONTINUATION", ecl_cont,
to_bitmap(&o, &(o.cont.thread)) |
to_bitmap(&o, &(o.cont.stack)) |
to_bitmap(&o, &(o.cont.env)));
init_tm(t_thread, "THREAD", ecl_thread,
to_bitmap(&o, &(o.thread.fun)) |
to_bitmap(&o, &(o.thread.cont)));
init_tm(t_codeblock, "CODEBLOCK", ecl_codeblock,
to_bitmap(&o, &(o.cblock.data)) |
to_bitmap(&o, &(o.cblock.temp_data)) |

14
src/c/printer/write_ugly.d
View file

@ -335,6 +335,18 @@ write_cfun(cl_object x, cl_object stream)
_ecl_write_unreadable(x, "compiled-function", x->cfun.name, stream);
}
static void
write_cont(cl_object x, cl_object stream)
{
_ecl_write_unreadable(x, "continuation", ECL_NIL, stream);
}
static void
write_thread(cl_object x, cl_object stream)
{
_ecl_write_unreadable(x, "thread", ECL_NIL, stream);
}
static void
write_codeblock(cl_object x, cl_object stream)
{
@ -495,6 +507,8 @@ static printer dispatch[FREE+1] = {
write_barrier, /* t_barrier */
write_mailbox, /* t_mailbox */
#endif
write_cont, /* t_cont */
write_thread, /* t_thread */
write_codeblock, /* t_codeblock */
write_foreign, /* t_foreign */
write_frame, /* t_frame */

2
src/c/serialize.d
View file

@ -73,6 +73,8 @@ static cl_index object_size[] = {
ROUNDED_SIZE(ecl_barrier), /* t_barrier */
ROUNDED_SIZE(ecl_mailbox), /* t_mailbox */
#endif
ROUNDED_SIZE(ecl_cont), /* t_cont */
ROUNDED_SIZE(ecl_thread), /* t_thread */
ROUNDED_SIZE(ecl_codeblock), /* t_codeblock */
ROUNDED_SIZE(ecl_foreign), /* t_foreign */
ROUNDED_SIZE(ecl_stack_frame), /* t_frame */

6
src/c/symbols_list.h
View file

@ -1848,6 +1848,12 @@ cl_symbols[] = {
{SYS_ "CODE-BLOCK" ECL_FUN(NULL, NULL, -1) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "CONTINUATION" ECL_FUN(NULL, NULL, -1) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "THREAD" ECL_FUN(NULL, NULL, -1) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "MAKE-CONTINUATION" ECL_FUN("si_make_continuation", ECL_NAME(si_make_continuation), 1) ECL_VAR(EXT_ORDINARY, OBJNULL)},
{SYS_ "MAKE-THREAD" ECL_FUN("si_make_thread", ECL_NAME(si_make_thread), 1) ECL_VAR(EXT_ORDINARY, OBJNULL)},
{SYS_ "TOKEN" ECL_FUN(NULL, NULL, -1) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "MODULE" ECL_FUN(NULL, NULL, -1) ECL_VAR(SI_ORDINARY, OBJNULL)},
{SYS_ "EXCEPTION" ECL_FUN(NULL, NULL, -1) ECL_VAR(SI_ORDINARY, OBJNULL)},

4
src/c/typespec.d
View file

@ -175,6 +175,10 @@ ecl_type_to_symbol(cl_type t)
case t_mailbox:
return @'mp::mailbox';
#endif
case t_cont:
return @'si::continuation';
case t_thread:
return @'si::thread';
case t_codeblock:
return @'si::code-block';
case t_foreign:

2
src/clos/hierarchy.lsp
View file

@ -225,6 +225,8 @@
(hash-table)
(random-state)
(readtable)
(si::continuation)
(si::thread)
(si::code-block)
(si::foreign-data)
(si::frame)

3
src/h/external.h
View file

@ -1811,6 +1811,9 @@ extern ECL_API cl_object si_lookup_host_entry(cl_object host_or_address);
extern ECL_API void ecl_tcp_close_all(void);
#endif
/* lwp.c */
extern ECL_API cl_object si_make_thread(cl_object fun);
extern ECL_API cl_object si_make_continuation(cl_object thread);
/* threads.c */

24
src/h/object.h
View file

@ -81,6 +81,8 @@ typedef enum {
t_barrier,
t_mailbox,
#endif
t_cont,
t_thread,
t_codeblock,
t_foreign,
t_frame,
@ -1059,6 +1061,26 @@ struct ecl_dummy {
_ECL_HDR;
};
/*
coroutines
*/
struct ecl_cont {
/* already resumed */
/* timed out */
_ECL_HDR2(resumed, timed_out);
cl_object thread; /* its thread */
ucontext_t uc;
char stack[16*1024];
cl_env_ptr env;
};
struct ecl_thread {
_ECL_HDR;
cl_object fun; /* initial function */
cl_object cont; /* its continuation */
};
#ifdef ECL_THREADS
#ifdef ECL_WINDOWS_THREADS
@ -1283,6 +1305,8 @@ union cl_lispunion {
struct ecl_barrier barrier; /* barrier */
struct ecl_mailbox mailbox; /* mailbox */
#endif
struct ecl_cont cont; /* continuation */
struct ecl_thread thread; /* green thread */
struct ecl_codeblock cblock; /* codeblock */
struct ecl_foreign foreign; /* user defined data type */
struct ecl_stack_frame frame; /* stack frame */