mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2025-12-15 15:21:03 -08:00
Code Issues Projects Releases Packages Wiki Activity

bytevm: introduce unsafe primops SI:CONS-CAR and SI:CONS-CDR

Browse source
This commit is contained in:
Daniel Kochmański 2025-01-08 12:50:50 +01:00
parent 497ece5a77
commit 32dfca42e5
4 changed files with 52 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

37
src/c/compiler.d
View file

@ -122,6 +122,8 @@ static int c_car(cl_env_ptr env, cl_object args, int push);
static int c_cdr(cl_env_ptr env, cl_object args, int push);
static int c_list(cl_env_ptr env, cl_object args, int push);
static int c_listA(cl_env_ptr env, cl_object args, int push);
static int c_cons_car(cl_env_ptr env, cl_object args, int push);
static int c_cons_cdr(cl_env_ptr env, cl_object args, int push);
static cl_object ecl_make_lambda(cl_env_ptr env, cl_object name, cl_object lambda);
@ -296,9 +298,7 @@ static compiler_record database[] = {
{@'si::while', c_while, 0},
{@'ext::with-backend', c_with_backend, 0},
{@'si::until', c_until, 0},
/* Extras */
/* Inlined functions */
{@'cons', c_cons, 1},
{@'car', c_car, 1},
{@'cdr', c_cdr, 1},
@ -307,8 +307,10 @@ static compiler_record database[] = {
{@'list', c_list, 1},
{@'list*', c_listA, 1},
{@'endp', c_endp, 1},
{@'si::cons-car', c_car, 1},
{@'si::cons-cdr', c_cdr, 1},
/* Primops */
{@'si::cons-car', c_cons_car, 1},
{@'si::cons-cdr', c_cons_cdr, 1},
{NULL, NULL, 1}
};
@ -2703,6 +2705,31 @@ c_listA(cl_env_ptr env, cl_object args, int flags)
return c_list_listA(env, args, flags, OP_LISTA);
}
/* -- Primops --------------------------------------------------------------- */
static int
c_cons_car(cl_env_ptr env, cl_object args, int flags)
{
cl_object list = pop(&args);
if (args != ECL_NIL) {
FEprogram_error("CAR: Too many arguments", 0);
}
compile_form(env, list, FLAG_REG0);
asm_op(env, OP_CONS_CAR);
return FLAG_REG0;
}
static int
c_cons_cdr(cl_env_ptr env, cl_object args, int flags)
{
cl_object list = pop(&args);
if (args != ECL_NIL) {
FEprogram_error("CDR: Too many arguments", 0);
}
compile_form(env, list, FLAG_REG0);
asm_op(env, OP_CONS_CDR);
return FLAG_REG0;
}
/* ----------------------------- PUBLIC INTERFACE ---------------------------- */

3
src/c/disassembler.d
View file

@ -582,6 +582,9 @@ disassemble(cl_object bytecodes, cl_opcode *vector) {
case OP_LISTA: string = "LIST*\t";
GET_OPARG(n, vector);
goto OPARG;
case OP_CONS_CAR: string = "CONS-CAR\tREG0"; goto NOARG;
case OP_CONS_CDR: string = "CONS-CDR\tREG0"; goto NOARG;
case OP_CALLG1: string = "CALLG1\t";
GET_DATA(o, vector, data);
goto ARG;

14
src/c/interpreter.d
View file

@ -274,7 +274,6 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes)
/* OP_CONS, OP_CAR, OP_CDR, etc
Inlined forms for some functions which act on reg0 and stack.
*/
CASE(OP_CONS); {
cl_object car = ECL_STACK_POP_UNSAFE(the_env);
reg0 = CONS(car, reg0);
@ -307,6 +306,19 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes)
THREAD_NEXT;
}
/* OP_CONS_CAR and OP_CONS_CDR
(Unsafe) primops that act on reg0 and stack.
*/
CASE(OP_CONS_CAR); {
reg0 = ECL_CONS_CAR(reg0);
THREAD_NEXT;
}
CASE(OP_CONS_CDR); {
reg0 = ECL_CONS_CDR(reg0);
THREAD_NEXT;
}
CASE(OP_INT); {
cl_fixnum n;
GET_OPARG(n, vector);

4
src/h/bytecodes.h
View file

@ -19,6 +19,8 @@ enum {
OP_CDR,
OP_LIST,
OP_LISTA,
OP_CONS_CAR,
OP_CONS_CDR,
OP_INT,
OP_PINT,
OP_VAR,
@ -172,6 +174,8 @@ typedef int16_t cl_opcode;
&&LBL_OP_CDR - &&LBL_OP_NOP,\
&&LBL_OP_LIST - &&LBL_OP_NOP,\
&&LBL_OP_LISTA - &&LBL_OP_NOP,\
&&LBL_OP_CONS_CAR - &&LBL_OP_NOP,\
&&LBL_OP_CONS_CDR - &&LBL_OP_NOP,\
&&LBL_OP_INT - &&LBL_OP_NOP,\
&&LBL_OP_PINT - &&LBL_OP_NOP,\
&&LBL_OP_VAR - &&LBL_OP_NOP,\