From 529e12a1ed1f1c8a02afe8b6801f44e890f03cdd Mon Sep 17 00:00:00 2001 From: Juan Jose Garcia Ripoll Date: Sat, 28 Feb 2009 13:14:41 +0100 Subject: [PATCH] Replaced some stack frame functions by internal and faster macros. --- src/c/eval.d | 2 +- src/c/gfun.d | 6 ++-- src/c/interpreter.d | 52 --------------------------- src/c/mapfun.d | 85 ++++++++++++++++++++++----------------------- src/h/external.h | 7 +--- src/h/internal.h | 21 +++++++++++ src/h/stacks.h | 11 ++++++ 7 files changed, 80 insertions(+), 104 deletions(-) diff --git a/src/c/eval.d b/src/c/eval.d index 86efab233..c3c09015c 100644 --- a/src/c/eval.d +++ b/src/c/eval.d @@ -145,7 +145,7 @@ cl_funcall(cl_narg narg, cl_object function, ...) (cl_object)&frame_aux, narg -= 2); for (i = 0; i < narg; i++) { - ecl_stack_frame_elt_set(frame, i, lastarg); + ECL_STACK_FRAME_SET(frame, i, lastarg); lastarg = cl_va_arg(args); } if (type_of(lastarg) == t_frame) { diff --git a/src/c/gfun.d b/src/c/gfun.d index 6e575a42c..6b0cf7bd1 100644 --- a/src/c/gfun.d +++ b/src/c/gfun.d @@ -47,7 +47,7 @@ user_function_dispatch(cl_narg narg, ...) const cl_object frame = ecl_stack_frame_open(env, (cl_object)&frame_aux, narg); cl_va_list args; cl_va_start(args, narg, narg, 0); for (i = 0; i < narg; i++) { - ecl_stack_frame_elt_set(frame, i, cl_va_arg(args)); + ECL_STACK_FRAME_SET(frame, i, cl_va_arg(args)); } fun = fun->instance.slots[fun->instance.length - 1]; output = ecl_apply_from_stack_frame(frame, fun); @@ -383,7 +383,9 @@ _ecl_standard_dispatch(cl_object frame, cl_object gf) #if !defined(ECL_USE_VARARG_AS_POINTER) struct ecl_stack_frame frame_aux; if (frame->frame.stack == (void*)0x1) { - frame = ecl_stack_frame_copy((cl_object)&frame_aux, frame); + const cl_object new_frame = (cl_object)&frame_aux; + ECL_STACK_FRAME_COPY(new_frame, frame); + frame = new_frame; } #endif diff --git a/src/c/interpreter.d b/src/c/interpreter.d index 94be24fd1..a7f9b8179 100644 --- a/src/c/interpreter.d +++ b/src/c/interpreter.d @@ -118,19 +118,6 @@ ecl_stack_frame_open(cl_env_ptr env, cl_object f, cl_index size) return f; } -void -ecl_stack_frame_enlarge(cl_object f, cl_index size) -{ - cl_env_ptr env = f->frame.env; - cl_object *top = env->stack_top; - if ((env->stack_limit - top) < size) { - top = ecl_stack_set_size(env, env->stack_size + size); - } - env->stack_top = (top += size); - f->frame.base = top - (f->frame.size += size); - f->frame.stack = env->stack; -} - void ecl_stack_frame_push(cl_object f, cl_object o) { @@ -168,35 +155,6 @@ ecl_stack_frame_pop_values(cl_object f) return o; } -cl_object -ecl_stack_frame_elt(cl_object f, cl_index ndx) -{ - if (ndx >= f->frame.size) { - FEtype_error_index(f, ecl_make_unsigned_integer(ndx)); - } - return f->frame.base[ndx]; -} - -void -ecl_stack_frame_elt_set(cl_object f, cl_index ndx, cl_object o) -{ - if (ndx >= f->frame.size) { - FEtype_error_index(f, ecl_make_unsigned_integer(ndx)); - } - f->frame.base[ndx] = o; -} - -cl_object -ecl_stack_frame_from_va_list(cl_env_ptr env, cl_object frame, cl_va_list args) -{ - cl_index i, nargs = args[0].narg; - ecl_stack_frame_open(env, frame, nargs); - for (i = 0; i < nargs; i++) { - frame->frame.base[i] = cl_va_arg(args); - } - return frame; -} - void ecl_stack_frame_close(cl_object f) { @@ -205,16 +163,6 @@ ecl_stack_frame_close(cl_object f) } } -cl_object -ecl_stack_frame_copy(cl_object dest, cl_object orig) -{ - cl_index size = orig->frame.size; - dest = ecl_stack_frame_open(orig->frame.env, dest, size); - memcpy(dest->frame.base, orig->frame.base, size * sizeof(cl_object)); - return dest; -} - - /* ------------------------------ LEXICAL ENV. ------------------------------ */ #define bind_var(env, var, val) CONS(CONS(var, val), (env)) diff --git a/src/c/mapfun.d b/src/c/mapfun.d index d224d99cc..787ed6922 100644 --- a/src/c/mapfun.d +++ b/src/c/mapfun.d @@ -17,37 +17,36 @@ #include #include +#include -#define PREPARE_MAP(list, cdrs_frame, cars_frame, nargs) \ - struct ecl_stack_frame cdrs_frame_aux, cars_frame_aux; \ - cl_object cdrs_frame, cars_frame; \ - cl_index nargs; \ - cdrs_frame = ecl_stack_frame_from_va_list(ecl_process_env(),\ - (cl_object)&cdrs_frame_aux, list); \ - cars_frame = ecl_stack_frame_copy((cl_object)&cars_frame_aux, cdrs_frame); \ - nargs = cars_frame->frame.size; \ - if (nargs == 0) { \ - FEprogram_error("MAP*: Too few arguments", 0); \ +#define PREPARE_MAP(env, list, cdrs_frame, cars_frame, narg) \ + struct ecl_stack_frame frames_aux[2]; \ + const cl_object cdrs_frame = (cl_object)frames_aux; \ + const cl_object cars_frame = (cl_object)(frames_aux+1); \ + ECL_STACK_FRAME_FROM_VA_LIST(env,cdrs_frame,list); \ + ECL_STACK_FRAME_COPY(cars_frame, cdrs_frame); \ + narg = cars_frame->frame.size; \ + if (narg == 0) { \ + FEprogram_error("MAP*: Too few arguments", 0); \ } - @(defun mapcar (fun &rest lists) cl_object res, *val = &res; cl_index i; @ { - PREPARE_MAP(lists, cdrs_frame, cars_frame, nargs); + PREPARE_MAP(the_env, lists, cdrs_frame, cars_frame, narg); res = Cnil; while (TRUE) { cl_index i; - for (i = 0; i < nargs; i++) { - cl_object cdr = ecl_stack_frame_elt(cdrs_frame, i); + for (i = 0; i < narg; i++) { + cl_object cdr = ECL_STACK_FRAME_REF(cdrs_frame, i); if (ecl_endp(cdr)) { ecl_stack_frame_close(cars_frame); ecl_stack_frame_close(cdrs_frame); @(return res) } - ecl_stack_frame_elt_set(cars_frame, i, CAR(cdr)); - ecl_stack_frame_elt_set(cdrs_frame, i, CDR(cdr)); + ECL_STACK_FRAME_SET(cars_frame, i, CAR(cdr)); + ECL_STACK_FRAME_SET(cdrs_frame, i, CDR(cdr)); } *val = ecl_list1(ecl_apply_from_stack_frame(cars_frame, fun)); val = &ECL_CONS_CDR(*val); @@ -57,19 +56,19 @@ @(defun maplist (fun &rest lists) cl_object res, *val = &res; @ { - PREPARE_MAP(lists, cdrs_frame, cars_frame, nargs); + PREPARE_MAP(the_env, lists, cdrs_frame, cars_frame, narg); res = Cnil; while (TRUE) { cl_index i; - for (i = 0; i < nargs; i++) { - cl_object cdr = ecl_stack_frame_elt(cdrs_frame, i); + for (i = 0; i < narg; i++) { + cl_object cdr = ECL_STACK_FRAME_REF(cdrs_frame, i); if (ecl_endp(cdr)) { ecl_stack_frame_close(cars_frame); ecl_stack_frame_close(cdrs_frame); @(return res) } - ecl_stack_frame_elt_set(cars_frame, i, cdr); - ecl_stack_frame_elt_set(cdrs_frame, i, CDR(cdr)); + ECL_STACK_FRAME_SET(cars_frame, i, cdr); + ECL_STACK_FRAME_SET(cdrs_frame, i, CDR(cdr)); } *val = ecl_list1(ecl_apply_from_stack_frame(cars_frame, fun)); val = &ECL_CONS_CDR(*val); @@ -79,19 +78,19 @@ @(defun mapc (fun &rest lists) cl_object onelist; @ { - PREPARE_MAP(lists, cdrs_frame, cars_frame, nargs); - onelist = ecl_stack_frame_elt(cdrs_frame, 0); + PREPARE_MAP(the_env, lists, cdrs_frame, cars_frame, narg); + onelist = ECL_STACK_FRAME_REF(cdrs_frame, 0); while (TRUE) { cl_index i; - for (i = 0; i < nargs; i++) { - cl_object cdr = ecl_stack_frame_elt(cdrs_frame, i); + for (i = 0; i < narg; i++) { + cl_object cdr = ECL_STACK_FRAME_REF(cdrs_frame, i); if (ecl_endp(cdr)) { ecl_stack_frame_close(cars_frame); ecl_stack_frame_close(cdrs_frame); @(return onelist) } - ecl_stack_frame_elt_set(cars_frame, i, CAR(cdr)); - ecl_stack_frame_elt_set(cdrs_frame, i, CDR(cdr)); + ECL_STACK_FRAME_SET(cars_frame, i, CAR(cdr)); + ECL_STACK_FRAME_SET(cdrs_frame, i, CDR(cdr)); } ecl_apply_from_stack_frame(cars_frame, fun); } @@ -100,19 +99,19 @@ @(defun mapl (fun &rest lists) cl_object onelist; @ { - PREPARE_MAP(lists, cdrs_frame, cars_frame, nargs); - onelist = ecl_stack_frame_elt(cdrs_frame, 0); + PREPARE_MAP(the_env, lists, cdrs_frame, cars_frame, narg); + onelist = ECL_STACK_FRAME_REF(cdrs_frame, 0); while (TRUE) { cl_index i; - for (i = 0; i < nargs; i++) { - cl_object cdr = ecl_stack_frame_elt(cdrs_frame, i); + for (i = 0; i < narg; i++) { + cl_object cdr = ECL_STACK_FRAME_REF(cdrs_frame, i); if (ecl_endp(cdr)) { ecl_stack_frame_close(cars_frame); ecl_stack_frame_close(cdrs_frame); @(return onelist) } - ecl_stack_frame_elt_set(cars_frame, i, cdr); - ecl_stack_frame_elt_set(cdrs_frame, i, CDR(cdr)); + ECL_STACK_FRAME_SET(cars_frame, i, cdr); + ECL_STACK_FRAME_SET(cdrs_frame, i, CDR(cdr)); } ecl_apply_from_stack_frame(cars_frame, fun); } @@ -121,19 +120,19 @@ @(defun mapcan (fun &rest lists) cl_object res, *val = &res; @ { - PREPARE_MAP(lists, cdrs_frame, cars_frame, nargs); + PREPARE_MAP(the_env, lists, cdrs_frame, cars_frame, narg); res = Cnil; while (TRUE) { cl_index i; - for (i = 0; i < nargs; i++) { - cl_object cdr = ecl_stack_frame_elt(cdrs_frame, i); + for (i = 0; i < narg; i++) { + cl_object cdr = ECL_STACK_FRAME_REF(cdrs_frame, i); if (ecl_endp(cdr)) { ecl_stack_frame_close(cars_frame); ecl_stack_frame_close(cdrs_frame); @(return res) } - ecl_stack_frame_elt_set(cars_frame, i, CAR(cdr)); - ecl_stack_frame_elt_set(cdrs_frame, i, CDR(cdr)); + ECL_STACK_FRAME_SET(cars_frame, i, CAR(cdr)); + ECL_STACK_FRAME_SET(cdrs_frame, i, CDR(cdr)); } *val = ecl_apply_from_stack_frame(cars_frame, fun); while (CONSP(*val)) @@ -144,19 +143,19 @@ @(defun mapcon (fun &rest lists) cl_object res, *val = &res; @ { - PREPARE_MAP(lists, cdrs_frame, cars_frame, nargs); + PREPARE_MAP(the_env, lists, cdrs_frame, cars_frame, narg); res = Cnil; while (TRUE) { cl_index i; - for (i = 0; i < nargs; i++) { - cl_object cdr = ecl_stack_frame_elt(cdrs_frame, i); + for (i = 0; i < narg; i++) { + cl_object cdr = ECL_STACK_FRAME_REF(cdrs_frame, i); if (ecl_endp(cdr)) { ecl_stack_frame_close(cars_frame); ecl_stack_frame_close(cdrs_frame); @(return res) } - ecl_stack_frame_elt_set(cars_frame, i, cdr); - ecl_stack_frame_elt_set(cdrs_frame, i, CDR(cdr)); + ECL_STACK_FRAME_SET(cars_frame, i, cdr); + ECL_STACK_FRAME_SET(cdrs_frame, i, CDR(cdr)); } *val = ecl_apply_from_stack_frame(cars_frame, fun); while (CONSP(*val)) diff --git a/src/h/external.h b/src/h/external.h index 81d0b3992..43514c6f6 100644 --- a/src/h/external.h +++ b/src/h/external.h @@ -462,14 +462,9 @@ extern ECL_API cl_object si_eval_with_env _ARGS((cl_narg narg, cl_object form, . extern ECL_API cl_object si_interpreter_stack _ARGS((cl_narg narg)); extern ECL_API cl_object ecl_stack_frame_open(cl_env_ptr env, cl_object f, cl_index size); -extern ECL_API void ecl_stack_frame_enlarge(cl_object f, cl_index size); extern ECL_API void ecl_stack_frame_push(cl_object f, cl_object o); extern ECL_API void ecl_stack_frame_push_values(cl_object f); -extern ECL_API cl_object ecl_stack_frame_from_va_list(cl_env_ptr env, cl_object f, cl_va_list args); extern ECL_API cl_object ecl_stack_frame_pop_values(cl_object f); -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); #define si_apply_from_stack_frame ecl_apply_from_stack_frame @@ -494,7 +489,7 @@ extern ECL_API cl_object si_bc_file(cl_object v); extern ECL_API cl_object cl_error _ARGS((cl_narg narg, cl_object eformat, ...)) /*__attribute__((noreturn))*/; extern ECL_API cl_object cl_cerror _ARGS((cl_narg narg, cl_object cformat, cl_object eformat, ...)); - extern ECL_API void ecl_inter,nal_error(const char *s) /*__attribute__((noreturn))*/; +extern ECL_API void ecl_internal_error(const char *s) /*__attribute__((noreturn))*/; extern ECL_API void ecl_cs_overflow(void) /*__attribute__((noreturn))*/; extern ECL_API void FEprogram_error(const char *s, int narg, ...) /*__attribute__((noreturn))*/; extern ECL_API void FEcontrol_error(const char *s, int narg, ...) /*__attribute__((noreturn))*/; diff --git a/src/h/internal.h b/src/h/internal.h index 607c66c9f..27cd3fee6 100644 --- a/src/h/internal.h +++ b/src/h/internal.h @@ -95,6 +95,27 @@ typedef struct cl_compiler_env *cl_compiler_env_ptr; struct ecl_stack_frame frame;\ cl_object name = ecl_stack_frame_open(env, (cl_object)&frame, 0); +#ifdef ECL_USE_VARARG_AS_POINTER +#define ECL_STACK_FRAME_FROM_VA_LIST(e,f,va) do { \ + const cl_object __frame = (f); \ + __frame->frame.t = t_frame; \ + __frame->frame.stack = 0; \ + __frame->frame.env = (e); \ + __frame->frame.size = va[0].narg; \ + __frame->frame.base = va[0].sp? va[0].sp : \ + (cl_object*)va[0].args; \ + } while(0) +#else +#define ECL_STACK_FRAME_FROM_VA_LIST(e,f,va) do { \ + const cl_object __frame = (f); \ + cl_index i, nargs = va[0].narg; \ + ecl_stack_frame_open((e), __frame, nargs); \ + for (i = 0; i < __nargs; i++) { \ + __frame->frame.base[i] = cl_va_arg(va); \ + } \ + } while (0) +#endif + #ifdef ECL_USE_VARARG_AS_POINTER #define ECL_STACK_FRAME_VARARGS_BEGIN(narg,lastarg,frame) \ struct ecl_frame __ecl_frame; \ diff --git a/src/h/stacks.h b/src/h/stacks.h index e4f5b543d..4082808e0 100644 --- a/src/h/stacks.h +++ b/src/h/stacks.h @@ -253,6 +253,17 @@ extern ECL_API ecl_frame_ptr _ecl_frs_push(register cl_env_ptr, register cl_obje } \ __env->stack_top = __new_top + __aux; } while (0) +#define ECL_STACK_FRAME_COPY(dest,orig) do { \ + cl_object __dest = (dest); \ + cl_object __orig = (orig); \ + cl_index __size = __orig->frame.size; \ + ecl_stack_frame_open(__orig->frame.env, __dest, __size); \ + memcpy(__dest->frame.base, __orig->frame.base, __size * sizeof(cl_object)); \ + } while (0); + +#define ECL_STACK_FRAME_SET(f,ndx,o) do { (f)->frame.base[(ndx)] = (o); } while(0) +#define ECL_STACK_FRAME_REF(f,ndx) ((f)->frame.base[(ndx)]) + /********************************* * HIGH LEVEL CONTROL STRUCTURES * *********************************/