From f096fdac519c3b4ef043d5db67ddb516cacd5871 Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Fri, 13 Feb 2009 17:05:21 +0100 Subject: [PATCH] Initial changes for a common dispatch function --- src/c/alloc_2.d | 2 +- src/c/cfun.d | 5 +- src/c/cfun_dispatch.d | 454 ++++++++++++++++++++++++++++++++++++++++++ src/c/eval.d | 136 ++++++------- src/c/gfun.d | 3 +- src/c/interpreter.d | 9 +- src/cmp/cmpcall.lsp | 27 ++- src/cmp/cmptop.lsp | 6 +- src/h/external.h | 5 +- src/h/object.h | 8 + 10 files changed, 555 insertions(+), 100 deletions(-) create mode 100644 src/c/cfun_dispatch.d diff --git a/src/c/alloc_2.d b/src/c/alloc_2.d index 16f59d2bb..3c7c73e6a 100644 --- a/src/c/alloc_2.d +++ b/src/c/alloc_2.d @@ -338,7 +338,7 @@ init_alloc(void) init_tm(t_random, "RANDOM-STATE", sizeof(struct ecl_random)); init_tm(t_readtable, "READTABLE", sizeof(struct ecl_readtable)); init_tm(t_cfun, "CFUN", sizeof(struct ecl_cfun)); - init_tm(t_cfunfixed, "CFUN", sizeof(struct ecl_cfun)); + init_tm(t_cfunfixed, "CFUN", sizeof(struct ecl_cfunfixed)); init_tm(t_cclosure, "CCLOSURE", sizeof(struct ecl_cclosure)); #ifndef CLOS init_tm(t_structure, "STRUCTURE", sizeof(struct ecl_structure)); diff --git a/src/c/cfun.d b/src/c/cfun.d index e648b1287..a6f7e2df8 100644 --- a/src/c/cfun.d +++ b/src/c/cfun.d @@ -18,13 +18,16 @@ #include #include /* for memmove() */ +#include "cfun_dispatch.d" + cl_object cl_make_cfun(void *c_function, cl_object name, cl_object cblock, int narg) { cl_object cf; cf = ecl_alloc_object(t_cfunfixed); - cf->cfun.entry = c_function; + cf->cfun.entry = dispatch_table[narg]; + cf->cfun.orig = c_function; cf->cfun.name = name; cf->cfun.block = cblock; cf->cfun.narg = narg; diff --git a/src/c/cfun_dispatch.d b/src/c/cfun_dispatch.d new file mode 100644 index 000000000..00baf0d33 --- /dev/null +++ b/src/c/cfun_dispatch.d @@ -0,0 +1,454 @@ +/* -*- mode: c; c-basic-offset: 8 -*- */ +/* + cfun_dispatch.c -- Trampolines for functions +*/ + +static cl_object dispatch0 (cl_nargs nargs, cl_object x0) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 0) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0); +} + +static cl_object dispatch1 (cl_nargs nargs, cl_object x0, cl_object x1) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 1) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1); +} + +static cl_object dispatch2 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 2) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2); +} + +static cl_object dispatch3 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 3) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3); +} + +static cl_object dispatch4 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 4) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4); +} + +static cl_object dispatch5 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 5) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5); +} + +static cl_object dispatch6 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 6) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6); +} + +static cl_object dispatch7 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 7) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7); +} + +static cl_object dispatch8 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 8) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8); +} + +static cl_object dispatch9 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 9) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9); +} + +static cl_object dispatch10 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 10) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10); +} + +static cl_object dispatch11 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 11) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11); +} + +static cl_object dispatch12 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 12) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12); +} + +static cl_object dispatch13 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 13) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13); +} + +static cl_object dispatch14 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 14) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14); +} + +static cl_object dispatch15 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 15) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15); +} + +static cl_object dispatch16 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 16) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16); +} + +static cl_object dispatch17 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 17) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17); +} + +static cl_object dispatch18 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 18) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18); +} + +static cl_object dispatch19 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 19) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19); +} + +static cl_object dispatch20 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 20) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20); +} + +static cl_object dispatch21 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 21) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21); +} + +static cl_object dispatch22 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 22) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22); +} + +static cl_object dispatch23 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 23) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23); +} + +static cl_object dispatch24 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 24) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24); +} + +static cl_object dispatch25 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24, cl_object x25) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 25) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25); +} + +static cl_object dispatch26 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24, cl_object x25, cl_object x26) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 26) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26); +} + +static cl_object dispatch27 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24, cl_object x25, cl_object x26, cl_object x27) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 27) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27); +} + +static cl_object dispatch28 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24, cl_object x25, cl_object x26, cl_object x27, cl_object x28) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 28) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27, x28); +} + +static cl_object dispatch29 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24, cl_object x25, cl_object x26, cl_object x27, cl_object x28, cl_object x29) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 29) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27, x28, x29); +} + +static cl_object dispatch30 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24, cl_object x25, cl_object x26, cl_object x27, cl_object x28, cl_object x29, cl_object x30) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 30) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27, x28, x29, x30); +} + +static cl_object dispatch31 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24, cl_object x25, cl_object x26, cl_object x27, cl_object x28, cl_object x29, cl_object x30, cl_object x31) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 31) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27, x28, x29, x30, x31); +} + +static cl_object dispatch32 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24, cl_object x25, cl_object x26, cl_object x27, cl_object x28, cl_object x29, cl_object x30, cl_object x31, cl_object x32) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 32) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27, x28, x29, x30, x31, x32); +} + +static cl_object dispatch33 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24, cl_object x25, cl_object x26, cl_object x27, cl_object x28, cl_object x29, cl_object x30, cl_object x31, cl_object x32, cl_object x33) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 33) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27, x28, x29, x30, x31, x32, x33); +} + +static cl_object dispatch34 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24, cl_object x25, cl_object x26, cl_object x27, cl_object x28, cl_object x29, cl_object x30, cl_object x31, cl_object x32, cl_object x33, cl_object x34) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 34) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27, x28, x29, x30, x31, x32, x33, x34); +} + +static cl_object dispatch35 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24, cl_object x25, cl_object x26, cl_object x27, cl_object x28, cl_object x29, cl_object x30, cl_object x31, cl_object x32, cl_object x33, cl_object x34, cl_object x35) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 35) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27, x28, x29, x30, x31, x32, x33, x34, x35); +} + +static cl_object dispatch36 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24, cl_object x25, cl_object x26, cl_object x27, cl_object x28, cl_object x29, cl_object x30, cl_object x31, cl_object x32, cl_object x33, cl_object x34, cl_object x35, cl_object x36) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 36) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27, x28, x29, x30, x31, x32, x33, x34, x35, x36); +} + +static cl_object dispatch37 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24, cl_object x25, cl_object x26, cl_object x27, cl_object x28, cl_object x29, cl_object x30, cl_object x31, cl_object x32, cl_object x33, cl_object x34, cl_object x35, cl_object x36, cl_object x37) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 37) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27, x28, x29, x30, x31, x32, x33, x34, x35, x36, x37); +} + +static cl_object dispatch38 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24, cl_object x25, cl_object x26, cl_object x27, cl_object x28, cl_object x29, cl_object x30, cl_object x31, cl_object x32, cl_object x33, cl_object x34, cl_object x35, cl_object x36, cl_object x37, cl_object x38) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 38) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27, x28, x29, x30, x31, x32, x33, x34, x35, x36, x37, x38); +} + +static cl_object dispatch39 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24, cl_object x25, cl_object x26, cl_object x27, cl_object x28, cl_object x29, cl_object x30, cl_object x31, cl_object x32, cl_object x33, cl_object x34, cl_object x35, cl_object x36, cl_object x37, cl_object x38, cl_object x39) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 39) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27, x28, x29, x30, x31, x32, x33, x34, x35, x36, x37, x38, x39); +} + +static cl_object dispatch40 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24, cl_object x25, cl_object x26, cl_object x27, cl_object x28, cl_object x29, cl_object x30, cl_object x31, cl_object x32, cl_object x33, cl_object x34, cl_object x35, cl_object x36, cl_object x37, cl_object x38, cl_object x39, cl_object x40) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 40) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27, x28, x29, x30, x31, x32, x33, x34, x35, x36, x37, x38, x39, x40); +} + +static cl_object dispatch41 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24, cl_object x25, cl_object x26, cl_object x27, cl_object x28, cl_object x29, cl_object x30, cl_object x31, cl_object x32, cl_object x33, cl_object x34, cl_object x35, cl_object x36, cl_object x37, cl_object x38, cl_object x39, cl_object x40, cl_object x41) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 41) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27, x28, x29, x30, x31, x32, x33, x34, x35, x36, x37, x38, x39, x40, x41); +} + +static cl_object dispatch42 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24, cl_object x25, cl_object x26, cl_object x27, cl_object x28, cl_object x29, cl_object x30, cl_object x31, cl_object x32, cl_object x33, cl_object x34, cl_object x35, cl_object x36, cl_object x37, cl_object x38, cl_object x39, cl_object x40, cl_object x41, cl_object x42) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 42) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27, x28, x29, x30, x31, x32, x33, x34, x35, x36, x37, x38, x39, x40, x41, x42); +} + +static cl_object dispatch43 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24, cl_object x25, cl_object x26, cl_object x27, cl_object x28, cl_object x29, cl_object x30, cl_object x31, cl_object x32, cl_object x33, cl_object x34, cl_object x35, cl_object x36, cl_object x37, cl_object x38, cl_object x39, cl_object x40, cl_object x41, cl_object x42, cl_object x43) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 43) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27, x28, x29, x30, x31, x32, x33, x34, x35, x36, x37, x38, x39, x40, x41, x42, x43); +} + +static cl_object dispatch44 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24, cl_object x25, cl_object x26, cl_object x27, cl_object x28, cl_object x29, cl_object x30, cl_object x31, cl_object x32, cl_object x33, cl_object x34, cl_object x35, cl_object x36, cl_object x37, cl_object x38, cl_object x39, cl_object x40, cl_object x41, cl_object x42, cl_object x43, cl_object x44) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 44) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27, x28, x29, x30, x31, x32, x33, x34, x35, x36, x37, x38, x39, x40, x41, x42, x43, x44); +} + +static cl_object dispatch45 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24, cl_object x25, cl_object x26, cl_object x27, cl_object x28, cl_object x29, cl_object x30, cl_object x31, cl_object x32, cl_object x33, cl_object x34, cl_object x35, cl_object x36, cl_object x37, cl_object x38, cl_object x39, cl_object x40, cl_object x41, cl_object x42, cl_object x43, cl_object x44, cl_object x45) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 45) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27, x28, x29, x30, x31, x32, x33, x34, x35, x36, x37, x38, x39, x40, x41, x42, x43, x44, x45); +} + +static cl_object dispatch46 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24, cl_object x25, cl_object x26, cl_object x27, cl_object x28, cl_object x29, cl_object x30, cl_object x31, cl_object x32, cl_object x33, cl_object x34, cl_object x35, cl_object x36, cl_object x37, cl_object x38, cl_object x39, cl_object x40, cl_object x41, cl_object x42, cl_object x43, cl_object x44, cl_object x45, cl_object x46) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 46) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27, x28, x29, x30, x31, x32, x33, x34, x35, x36, x37, x38, x39, x40, x41, x42, x43, x44, x45, x46); +} + +static cl_object dispatch47 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24, cl_object x25, cl_object x26, cl_object x27, cl_object x28, cl_object x29, cl_object x30, cl_object x31, cl_object x32, cl_object x33, cl_object x34, cl_object x35, cl_object x36, cl_object x37, cl_object x38, cl_object x39, cl_object x40, cl_object x41, cl_object x42, cl_object x43, cl_object x44, cl_object x45, cl_object x46, cl_object x47) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 47) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27, x28, x29, x30, x31, x32, x33, x34, x35, x36, x37, x38, x39, x40, x41, x42, x43, x44, x45, x46, x47); +} + +static cl_object dispatch48 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24, cl_object x25, cl_object x26, cl_object x27, cl_object x28, cl_object x29, cl_object x30, cl_object x31, cl_object x32, cl_object x33, cl_object x34, cl_object x35, cl_object x36, cl_object x37, cl_object x38, cl_object x39, cl_object x40, cl_object x41, cl_object x42, cl_object x43, cl_object x44, cl_object x45, cl_object x46, cl_object x47, cl_object x48) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 48) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27, x28, x29, x30, x31, x32, x33, x34, x35, x36, x37, x38, x39, x40, x41, x42, x43, x44, x45, x46, x47, x48); +} + +static cl_object dispatch49 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24, cl_object x25, cl_object x26, cl_object x27, cl_object x28, cl_object x29, cl_object x30, cl_object x31, cl_object x32, cl_object x33, cl_object x34, cl_object x35, cl_object x36, cl_object x37, cl_object x38, cl_object x39, cl_object x40, cl_object x41, cl_object x42, cl_object x43, cl_object x44, cl_object x45, cl_object x46, cl_object x47, cl_object x48, cl_object x49) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 49) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27, x28, x29, x30, x31, x32, x33, x34, x35, x36, x37, x38, x39, x40, x41, x42, x43, x44, x45, x46, x47, x48, x49); +} + +static cl_object dispatch50 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24, cl_object x25, cl_object x26, cl_object x27, cl_object x28, cl_object x29, cl_object x30, cl_object x31, cl_object x32, cl_object x33, cl_object x34, cl_object x35, cl_object x36, cl_object x37, cl_object x38, cl_object x39, cl_object x40, cl_object x41, cl_object x42, cl_object x43, cl_object x44, cl_object x45, cl_object x46, cl_object x47, cl_object x48, cl_object x49, cl_object x50) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 50) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27, x28, x29, x30, x31, x32, x33, x34, x35, x36, x37, x38, x39, x40, x41, x42, x43, x44, x45, x46, x47, x48, x49, x50); +} + +static cl_object dispatch51 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24, cl_object x25, cl_object x26, cl_object x27, cl_object x28, cl_object x29, cl_object x30, cl_object x31, cl_object x32, cl_object x33, cl_object x34, cl_object x35, cl_object x36, cl_object x37, cl_object x38, cl_object x39, cl_object x40, cl_object x41, cl_object x42, cl_object x43, cl_object x44, cl_object x45, cl_object x46, cl_object x47, cl_object x48, cl_object x49, cl_object x50, cl_object x51) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 51) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27, x28, x29, x30, x31, x32, x33, x34, x35, x36, x37, x38, x39, x40, x41, x42, x43, x44, x45, x46, x47, x48, x49, x50, x51); +} + +static cl_object dispatch52 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24, cl_object x25, cl_object x26, cl_object x27, cl_object x28, cl_object x29, cl_object x30, cl_object x31, cl_object x32, cl_object x33, cl_object x34, cl_object x35, cl_object x36, cl_object x37, cl_object x38, cl_object x39, cl_object x40, cl_object x41, cl_object x42, cl_object x43, cl_object x44, cl_object x45, cl_object x46, cl_object x47, cl_object x48, cl_object x49, cl_object x50, cl_object x51, cl_object x52) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 52) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27, x28, x29, x30, x31, x32, x33, x34, x35, x36, x37, x38, x39, x40, x41, x42, x43, x44, x45, x46, x47, x48, x49, x50, x51, x52); +} + +static cl_object dispatch53 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24, cl_object x25, cl_object x26, cl_object x27, cl_object x28, cl_object x29, cl_object x30, cl_object x31, cl_object x32, cl_object x33, cl_object x34, cl_object x35, cl_object x36, cl_object x37, cl_object x38, cl_object x39, cl_object x40, cl_object x41, cl_object x42, cl_object x43, cl_object x44, cl_object x45, cl_object x46, cl_object x47, cl_object x48, cl_object x49, cl_object x50, cl_object x51, cl_object x52, cl_object x53) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 53) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27, x28, x29, x30, x31, x32, x33, x34, x35, x36, x37, x38, x39, x40, x41, x42, x43, x44, x45, x46, x47, x48, x49, x50, x51, x52, x53); +} + +static cl_object dispatch54 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24, cl_object x25, cl_object x26, cl_object x27, cl_object x28, cl_object x29, cl_object x30, cl_object x31, cl_object x32, cl_object x33, cl_object x34, cl_object x35, cl_object x36, cl_object x37, cl_object x38, cl_object x39, cl_object x40, cl_object x41, cl_object x42, cl_object x43, cl_object x44, cl_object x45, cl_object x46, cl_object x47, cl_object x48, cl_object x49, cl_object x50, cl_object x51, cl_object x52, cl_object x53, cl_object x54) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 54) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27, x28, x29, x30, x31, x32, x33, x34, x35, x36, x37, x38, x39, x40, x41, x42, x43, x44, x45, x46, x47, x48, x49, x50, x51, x52, x53, x54); +} + +static cl_object dispatch55 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24, cl_object x25, cl_object x26, cl_object x27, cl_object x28, cl_object x29, cl_object x30, cl_object x31, cl_object x32, cl_object x33, cl_object x34, cl_object x35, cl_object x36, cl_object x37, cl_object x38, cl_object x39, cl_object x40, cl_object x41, cl_object x42, cl_object x43, cl_object x44, cl_object x45, cl_object x46, cl_object x47, cl_object x48, cl_object x49, cl_object x50, cl_object x51, cl_object x52, cl_object x53, cl_object x54, cl_object x55) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 55) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27, x28, x29, x30, x31, x32, x33, x34, x35, x36, x37, x38, x39, x40, x41, x42, x43, x44, x45, x46, x47, x48, x49, x50, x51, x52, x53, x54, x55); +} + +static cl_object dispatch56 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24, cl_object x25, cl_object x26, cl_object x27, cl_object x28, cl_object x29, cl_object x30, cl_object x31, cl_object x32, cl_object x33, cl_object x34, cl_object x35, cl_object x36, cl_object x37, cl_object x38, cl_object x39, cl_object x40, cl_object x41, cl_object x42, cl_object x43, cl_object x44, cl_object x45, cl_object x46, cl_object x47, cl_object x48, cl_object x49, cl_object x50, cl_object x51, cl_object x52, cl_object x53, cl_object x54, cl_object x55, cl_object x56) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 56) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27, x28, x29, x30, x31, x32, x33, x34, x35, x36, x37, x38, x39, x40, x41, x42, x43, x44, x45, x46, x47, x48, x49, x50, x51, x52, x53, x54, x55, x56); +} + +static cl_object dispatch57 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24, cl_object x25, cl_object x26, cl_object x27, cl_object x28, cl_object x29, cl_object x30, cl_object x31, cl_object x32, cl_object x33, cl_object x34, cl_object x35, cl_object x36, cl_object x37, cl_object x38, cl_object x39, cl_object x40, cl_object x41, cl_object x42, cl_object x43, cl_object x44, cl_object x45, cl_object x46, cl_object x47, cl_object x48, cl_object x49, cl_object x50, cl_object x51, cl_object x52, cl_object x53, cl_object x54, cl_object x55, cl_object x56, cl_object x57) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 57) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27, x28, x29, x30, x31, x32, x33, x34, x35, x36, x37, x38, x39, x40, x41, x42, x43, x44, x45, x46, x47, x48, x49, x50, x51, x52, x53, x54, x55, x56, x57); +} + +static cl_object dispatch58 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24, cl_object x25, cl_object x26, cl_object x27, cl_object x28, cl_object x29, cl_object x30, cl_object x31, cl_object x32, cl_object x33, cl_object x34, cl_object x35, cl_object x36, cl_object x37, cl_object x38, cl_object x39, cl_object x40, cl_object x41, cl_object x42, cl_object x43, cl_object x44, cl_object x45, cl_object x46, cl_object x47, cl_object x48, cl_object x49, cl_object x50, cl_object x51, cl_object x52, cl_object x53, cl_object x54, cl_object x55, cl_object x56, cl_object x57, cl_object x58) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 58) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27, x28, x29, x30, x31, x32, x33, x34, x35, x36, x37, x38, x39, x40, x41, x42, x43, x44, x45, x46, x47, x48, x49, x50, x51, x52, x53, x54, x55, x56, x57, x58); +} + +static cl_object dispatch59 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24, cl_object x25, cl_object x26, cl_object x27, cl_object x28, cl_object x29, cl_object x30, cl_object x31, cl_object x32, cl_object x33, cl_object x34, cl_object x35, cl_object x36, cl_object x37, cl_object x38, cl_object x39, cl_object x40, cl_object x41, cl_object x42, cl_object x43, cl_object x44, cl_object x45, cl_object x46, cl_object x47, cl_object x48, cl_object x49, cl_object x50, cl_object x51, cl_object x52, cl_object x53, cl_object x54, cl_object x55, cl_object x56, cl_object x57, cl_object x58, cl_object x59) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 59) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27, x28, x29, x30, x31, x32, x33, x34, x35, x36, x37, x38, x39, x40, x41, x42, x43, x44, x45, x46, x47, x48, x49, x50, x51, x52, x53, x54, x55, x56, x57, x58, x59); +} + +static cl_object dispatch60 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24, cl_object x25, cl_object x26, cl_object x27, cl_object x28, cl_object x29, cl_object x30, cl_object x31, cl_object x32, cl_object x33, cl_object x34, cl_object x35, cl_object x36, cl_object x37, cl_object x38, cl_object x39, cl_object x40, cl_object x41, cl_object x42, cl_object x43, cl_object x44, cl_object x45, cl_object x46, cl_object x47, cl_object x48, cl_object x49, cl_object x50, cl_object x51, cl_object x52, cl_object x53, cl_object x54, cl_object x55, cl_object x56, cl_object x57, cl_object x58, cl_object x59, cl_object x60) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 60) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27, x28, x29, x30, x31, x32, x33, x34, x35, x36, x37, x38, x39, x40, x41, x42, x43, x44, x45, x46, x47, x48, x49, x50, x51, x52, x53, x54, x55, x56, x57, x58, x59, x60); +} + +static cl_object dispatch61 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24, cl_object x25, cl_object x26, cl_object x27, cl_object x28, cl_object x29, cl_object x30, cl_object x31, cl_object x32, cl_object x33, cl_object x34, cl_object x35, cl_object x36, cl_object x37, cl_object x38, cl_object x39, cl_object x40, cl_object x41, cl_object x42, cl_object x43, cl_object x44, cl_object x45, cl_object x46, cl_object x47, cl_object x48, cl_object x49, cl_object x50, cl_object x51, cl_object x52, cl_object x53, cl_object x54, cl_object x55, cl_object x56, cl_object x57, cl_object x58, cl_object x59, cl_object x60, cl_object x61) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 61) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27, x28, x29, x30, x31, x32, x33, x34, x35, x36, x37, x38, x39, x40, x41, x42, x43, x44, x45, x46, x47, x48, x49, x50, x51, x52, x53, x54, x55, x56, x57, x58, x59, x60, x61); +} + +static cl_object dispatch62 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24, cl_object x25, cl_object x26, cl_object x27, cl_object x28, cl_object x29, cl_object x30, cl_object x31, cl_object x32, cl_object x33, cl_object x34, cl_object x35, cl_object x36, cl_object x37, cl_object x38, cl_object x39, cl_object x40, cl_object x41, cl_object x42, cl_object x43, cl_object x44, cl_object x45, cl_object x46, cl_object x47, cl_object x48, cl_object x49, cl_object x50, cl_object x51, cl_object x52, cl_object x53, cl_object x54, cl_object x55, cl_object x56, cl_object x57, cl_object x58, cl_object x59, cl_object x60, cl_object x61, cl_object x62) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 62) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27, x28, x29, x30, x31, x32, x33, x34, x35, x36, x37, x38, x39, x40, x41, x42, x43, x44, x45, x46, x47, x48, x49, x50, x51, x52, x53, x54, x55, x56, x57, x58, x59, x60, x61, x62); +} + +static cl_object dispatch63 (cl_nargs nargs, cl_object x0, cl_object x1, cl_object x2, cl_object x3, cl_object x4, cl_object x5, cl_object x6, cl_object x7, cl_object x8, cl_object x9, cl_object x10, cl_object x11, cl_object x12, cl_object x13, cl_object x14, cl_object x15, cl_object x16, cl_object x17, cl_object x18, cl_object x19, cl_object x20, cl_object x21, cl_object x22, cl_object x23, cl_object x24, cl_object x25, cl_object x26, cl_object x27, cl_object x28, cl_object x29, cl_object x30, cl_object x31, cl_object x32, cl_object x33, cl_object x34, cl_object x35, cl_object x36, cl_object x37, cl_object x38, cl_object x39, cl_object x40, cl_object x41, cl_object x42, cl_object x43, cl_object x44, cl_object x45, cl_object x46, cl_object x47, cl_object x48, cl_object x49, cl_object x50, cl_object x51, cl_object x52, cl_object x53, cl_object x54, cl_object x55, cl_object x56, cl_object x57, cl_object x58, cl_object x59, cl_object x60, cl_object x61, cl_object x62, cl_object x63) { + const cl_env_ptr the_env = ecl_process_env(); + cl_object fun = the_env->function; + if (narg != 63) FEwrong_num_arguments(fun); + return fun->cfunfixed.orig(x0, x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11, x12, x13, x14, x15, x16, x17, x18, x19, x20, x21, x22, x23, x24, x25, x26, x27, x28, x29, x30, x31, x32, x33, x34, x35, x36, x37, x38, x39, x40, x41, x42, x43, x44, x45, x46, x47, x48, x49, x50, x51, x52, x53, x54, x55, x56, x57, x58, x59, x60, x61, x62, x63); +} + +static dispatch_table[64] = {dispatch0, dispatch1, dispatch2, dispatch3, dispatch4, dispatch5, dispatch6, dispatch7, dispatch8, dispatch9, dispatch10, dispatch11, dispatch12, dispatch13, dispatch14, dispatch15, dispatch16, dispatch17, dispatch18, dispatch19, dispatch20, dispatch21, dispatch22, dispatch23, dispatch24, dispatch25, dispatch26, dispatch27, dispatch28, dispatch29, dispatch30, dispatch31, dispatch32, dispatch33, dispatch34, dispatch35, dispatch36, dispatch37, dispatch38, dispatch39, dispatch40, dispatch41, dispatch42, dispatch43, dispatch44, dispatch45, dispatch46, dispatch47, dispatch48, dispatch49, dispatch50, dispatch51, dispatch52, dispatch53, dispatch54, dispatch55, dispatch56, dispatch57, dispatch58, dispatch59, dispatch60, dispatch61, dispatch62, dispatch63}; diff --git a/src/c/eval.d b/src/c/eval.d index 6476e216b..82f8e9bf8 100644 --- a/src/c/eval.d +++ b/src/c/eval.d @@ -61,7 +61,7 @@ build_funcall_frame(cl_object f, cl_va_list args) */ cl_object -ecl_apply_from_stack_frame(cl_object frame, cl_object x) +ecl_apply_from_stack_frame(cl_env_ptr env, cl_object frame, cl_object x) { cl_object *sp = frame->frame.bottom; cl_index narg = frame->frame.top - sp; @@ -71,19 +71,22 @@ ecl_apply_from_stack_frame(cl_object frame, cl_object x) FEundefined_function(x); switch (type_of(fun)) { case t_cfunfixed: + env->function = fun; if (narg != (cl_index)fun->cfun.narg) FEwrong_num_arguments(fun); - return APPLY_fixed(narg, (cl_objectfn_fixed)fun->cfun.entry, sp); + return APPLY_fixed(narg, fun->cfun.orig, sp); case t_cfun: + env->function = fun; return APPLY(narg, fun->cfun.entry, sp); case t_cclosure: - return APPLY_closure(narg, fun->cclosure.entry, - fun->cclosure.env, sp); + env->function = fun->cclosure.env; + return APPLY(narg, fun->cclosure.entry, sp); #ifdef CLOS case t_instance: switch (fun->instance.isgf) { case ECL_STANDARD_DISPATCH: - return _ecl_standard_dispatch(frame, fun); + env->function = fun; + return _ecl_standard_dispatch(env, frame, fun); case ECL_USER_DISPATCH: fun = fun->instance.slots[fun->instance.length - 1]; default: @@ -106,96 +109,79 @@ ecl_apply_from_stack_frame(cl_object frame, cl_object x) } } -/*----------------------------------------------------------------------* - * Linking mechanism * - *----------------------------------------------------------------------*/ - -cl_object -_ecl_link_call(cl_object sym, cl_objectfn *pLK, cl_object cblock, int narg, cl_va_list args) +static cl_object +_ecl_clos_dispatch(cl_narg narg, ...) { - cl_object out, fun = ecl_fdefinition(sym); + cl_env_ptr env = ecl_process_env(); struct ecl_stack_frame frame_aux; - cl_object frame; + const cl_object frame = ecl_stack_frame_open(env, (cl_object)&frame_aux, narg); + return _ecl_standard_dispatch(env, frame, env->function); +} - if (fun == OBJNULL) - FEerror("Undefined function.", 0); - AGAIN: - if (fun == OBJNULL) - goto ERROR; +static cl_object +_ecl_bytecodes_dispatch(cl_narg narg, ...) +{ + cl_env_ptr env = ecl_process_env(); + struct ecl_stack_frame frame_aux; + const cl_object frame = ecl_stack_frame_open(env, (cl_object)&frame_aux, narg); + return _ecl_interpret(frame, Cnil, env->function, 0); +} + +static cl_object +_ecl_bclosure_dispatch(cl_narg narg, ...) +{ + cl_env_ptr env = ecl_process_env(); + cl_object fun = env->function; + struct ecl_stack_frame frame_aux; + const cl_object frame = ecl_stack_frame_open(env, (cl_object)&frame_aux, narg); + return _ecl_interpret(frame, fun->bclosure.lex, fun, 0); +} + +cl_objectfn +ecl_function_dispatch(cl_env_ptr env, cl_object x) +{ + cl_object fun = x; + AGAIN: + if (fun == OBJNULL || fun == Cnil) + FEundefined_function(x); switch (type_of(fun)) { case t_cfunfixed: - if (narg != fun->cfun.narg) - FEwrong_num_arguments(fun); - frame = build_funcall_frame((cl_object)&frame_aux, args); - out = APPLY_fixed(narg, (cl_objectfn_fixed)fun->cfun.entry, - frame->frame.bottom); - break; + env->function = fun; + return fun->cfunfixed.entry; case t_cfun: - if (pLK) { - si_put_sysprop(sym, @'si::link-from', - CONS(CONS(ecl_make_unsigned_integer((cl_index)pLK), - ecl_make_unsigned_integer((cl_index)*pLK)), - si_get_sysprop(sym, @'si::link-from'))); - *pLK = fun->cfun.entry; - cblock->cblock.links = - CONS(sym, cblock->cblock.links); - } - frame = build_funcall_frame((cl_object)&frame_aux, args); - out = APPLY(narg, fun->cfun.entry, frame->frame.bottom); - break; + env->function = fun; + return fun->cfun.entry; + case t_cclosure: + env->function = fun->cclosure.env; + return fun->cclosure.entry; #ifdef CLOS case t_instance: switch (fun->instance.isgf) { case ECL_STANDARD_DISPATCH: - frame = build_funcall_frame((cl_object)&frame_aux, args); - out = _ecl_standard_dispatch(frame, fun); - break; + env->function = fun; + return _ecl_clos_dispatch; case ECL_USER_DISPATCH: fun = fun->instance.slots[fun->instance.length - 1]; - goto AGAIN; default: FEinvalid_function(fun); } - break; -#endif /* CLOS */ - case t_cclosure: - frame = build_funcall_frame((cl_object)&frame_aux, args); - out = APPLY_closure(narg, fun->cclosure.entry, - fun->cclosure.env, frame->frame.bottom); - break; + goto AGAIN; +#endif + case t_symbol: + if (fun->symbol.stype & stp_macro) + FEundefined_function(x); + fun = SYM_FUN(fun); + goto AGAIN; case t_bytecodes: - frame = build_funcall_frame((cl_object)&frame_aux, args); - out = ecl_interpret(frame, Cnil, fun, 0); - break; + env->function = fun; + return _ecl_interpret_dispatch; case t_bclosure: - frame = build_funcall_frame((cl_object)&frame_aux, args); - out = ecl_interpret(frame, fun->bclosure.lex, fun->bclosure.code, 0); - break; + env->function = fun; + return _ecl_closure_dispatch; default: ERROR: - FEinvalid_function(fun); + FEinvalid_function(x); } - return out; -} - -cl_object -si_unlink_symbol(cl_object s) -{ - cl_object pl; - - if (!SYMBOLP(s)) - FEtype_error_symbol(s); - pl = si_get_sysprop(s, @'si::link-from'); - if (!ecl_endp(pl)) { - for (; !ecl_endp(pl); pl = CDR(pl)) { - cl_object record = CAR(pl); - void **location = (void **)fixnnint(CAR(record)); - void *original = (void *)fixnnint(CDR(record)); - *location = original; - } - si_rem_sysprop(s, @'si::link-from'); - } - @(return) } @(defun funcall (function &rest funargs) diff --git a/src/c/gfun.d b/src/c/gfun.d index be48510e8..410fe6d0c 100644 --- a/src/c/gfun.d +++ b/src/c/gfun.d @@ -330,9 +330,8 @@ compute_applicable_method(cl_object frame, cl_object gf) } cl_object -_ecl_standard_dispatch(cl_object frame, cl_object gf) +_ecl_standard_dispatch(cl_env_ptr env, cl_object frame, cl_object gf) { - const cl_env_ptr env = ecl_process_env(); cl_object func, vector; /* * We have to copy the frame because it might be stored in cl_env.values diff --git a/src/c/interpreter.d b/src/c/interpreter.d index 890d8a291..91f5aa12e 100644 --- a/src/c/interpreter.d +++ b/src/c/interpreter.d @@ -713,21 +713,20 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes, cl_index offs case t_cfunfixed: if (narg != (cl_index)reg0->cfun.narg) FEwrong_num_arguments(reg0); - reg0 = APPLY_fixed(narg, (cl_objectfn_fixed)reg0->cfun.entry, - frame_aux.bottom); + reg0 = APPLY_fixed(narg, reg0->cfun.orig, frame_aux.bottom); break; case t_cfun: reg0 = APPLY(narg, reg0->cfun.entry, frame_aux.bottom); break; case t_cclosure: - reg0 = APPLY_closure(narg, reg0->cclosure.entry, - reg0->cclosure.env, frame_aux.bottom); + the_env->function = reg0->cclosure.env; + reg0 = APPLY_closure(narg, reg0->cclosure.entry, frame_aux.bottom); break; #ifdef CLOS case t_instance: switch (reg0->instance.isgf) { case ECL_STANDARD_DISPATCH: - reg0 = _ecl_standard_dispatch(frame, reg0); + reg0 = _ecl_standard_dispatch(the_env, frame, reg0); break; case ECL_USER_DISPATCH: reg0 = reg0->instance.slots[reg0->instance.length - 1]; diff --git a/src/cmp/cmpcall.lsp b/src/cmp/cmpcall.lsp index 01540b318..7bff03173 100644 --- a/src/cmp/cmpcall.lsp +++ b/src/cmp/cmpcall.lsp @@ -301,13 +301,19 @@ (defun wt-stack-pointer (narg) (wt "cl_env_copy->stack_top-" narg)) -(defun wt-call (fun args &optional fname) - (wt fun "(") - (let ((comma "")) - (dolist (arg args) - (wt comma arg) - (setf comma ","))) - (wt ")") +(defun wt-call (fun args &optional fname env) + (if env + (progn + (wt "(cl_env_copy->function=" env ",") + (wt-call fun args) + (wt ")")) + (progn + (wt fun "(") + (let ((comma "")) + (dolist (arg args) + (wt comma arg) + (setf comma ","))) + (wt ")"))) (when fname (wt-comment fname))) (defun wt-call-normal (fun args) @@ -317,10 +323,11 @@ (maxarg (fun-maxarg fun)) (fun-c-name (fun-cfun fun)) (fun-lisp-name (fun-name fun)) - (narg (length args))) + (narg (length args)) + (env nil)) (case (fun-closure fun) (CLOSURE - (push (environment-accessor fun) args)) + (setf env (environment-accessor fun))) (LEXICAL (let ((lex-lvl (fun-level fun))) (dotimes (n lex-lvl) @@ -335,7 +342,7 @@ (or fun-lisp-name 'ANONYMOUS))) (when (fun-needs-narg fun) (push narg args)) - (wt-call fun-c-name args fun-lisp-name))) + (wt-call fun-c-name args fun-lisp-name env))) ;;; ---------------------------------------------------------------------- diff --git a/src/cmp/cmptop.lsp b/src/cmp/cmptop.lsp index 62811b5ea..cd1e33a82 100644 --- a/src/cmp/cmptop.lsp +++ b/src/cmp/cmptop.lsp @@ -558,10 +558,6 @@ (wt-h comma "volatile cl_object *") (wt comma "volatile cl_object *lex" n) (setf comma ", ")) - (when (eq (fun-closure fun) 'CLOSURE) - (wt-h comma "cl_object " *volatile*) - (wt comma "cl_object " *volatile* "env0") - (setf comma ", ")) (let ((lcl 0)) (declare (fixnum lcl)) (dolist (var requireds) @@ -589,6 +585,8 @@ " CLSR" *reservation-cmacro* " STCK" *reservation-cmacro*) (wt-nl "const cl_env_ptr cl_env_copy = ecl_process_env();") + (when (eq (fun-closure fun) 'CLOSURE) + (wt "cl_object " *volatile* "env0 = cl_env_copy->function;")) (wt-nl *volatile* "cl_object value0;") (when (>= (fun-debug fun) 2) (wt-nl "struct ihs_frame ihs;")) diff --git a/src/h/external.h b/src/h/external.h index 21cb60f8b..346eab47f 100644 --- a/src/h/external.h +++ b/src/h/external.h @@ -468,7 +468,6 @@ extern ECL_API cl_object ecl_stack_frame_elt(cl_object f, cl_index n); extern ECL_API void ecl_stack_frame_elt_set(cl_object f, cl_index n, cl_object o); extern ECL_API cl_object ecl_stack_frame_copy(cl_object f, cl_object size); extern ECL_API void ecl_stack_frame_close(cl_object f); -extern ECL_API cl_object ecl_apply_from_stack_frame(cl_object f, cl_object o); #define ECL_STACK_FRAME_SIZE(f) ((f)->frame.top - (f)->frame.bottom) #define si_apply_from_stack_frame ecl_apply_from_stack_frame @@ -537,6 +536,8 @@ extern ECL_API cl_object cl_constantp(cl_narg narg, cl_object arg, ...); #define funcall cl_funcall extern ECL_API cl_object cl_apply_from_stack(cl_index narg, cl_object fun); +extern ECL_API cl_object ecl_apply_from_stack_frame(cl_env_ptr env, cl_object f, cl_object o); +extern ECL_API cl_objectfn ecl_function_dispatch(cl_env_ptr env, cl_object f); extern ECL_API cl_object _ecl_link_call(cl_object sym, cl_objectfn *pLK, cl_object cblock, int narg, cl_va_list args); /* ffi.c */ @@ -678,7 +679,7 @@ extern ECL_API cl_object si_clear_gfun_hash(cl_object what); extern ECL_API cl_object clos_set_funcallable_instance_function(cl_object x, cl_object function_or_t); extern ECL_API cl_object si_generic_function_p(cl_object instance); -extern ECL_API cl_object _ecl_standard_dispatch(cl_object frame, cl_object fun); +extern ECL_API cl_object _ecl_standard_dispatch(cl_env_ptr env, cl_object frame, cl_object fun); #endif /* CLOS */ diff --git a/src/h/object.h b/src/h/object.h index 1853143a9..bcf072067 100644 --- a/src/h/object.h +++ b/src/h/object.h @@ -667,6 +667,14 @@ struct ecl_cfun { /* compiled function header */ cl_object block; /* descriptor of C code block for GC */ }; +struct ecl_cfunfixed { /* compiled function header */ + HEADER1(narg); + cl_object name; /* compiled function name */ + cl_objectfn entry; /* entry address */ + cl_object block; /* descriptor of C code block for GC */ + cl_objectfn_fixed orig; /* entry address */ +}; + struct ecl_cclosure { /* compiled closure header */ HEADER; cl_object env; /* environment */