mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-03-09 06:30:32 -07:00
stacks: refactor the code in stacks.d
- {run,bds,frs}_set_size functions were very similar; I've updated them to
follow the same naming convention and execution order to indicate that.
- these functions are now renamed to xxx_set_limit -that simplifies some code
- there were inconsistencies in how we've treated boot sizes (limit vs size)
- rename some more ecl_stack_* functions to ecl_vms_* for clarity
This commit is contained in:
Daniel Kochmański
parent
2d8331fca4
commit
2f98265062
8 changed files with 148 additions and 158 deletions
|
|
@ -2813,7 +2813,7 @@ save_bytecodes(cl_env_ptr env, cl_index start, cl_index end)
|
|||
cl_object bytecodes = ecl_alloc_simple_vector(l, ecl_aet_index);
|
||||
cl_index *p;
|
||||
for (p = bytecodes->vector.self.index; end > start; end--, p++) {
|
||||
*p = (cl_index)ecl_vms_pop_unsafe(env);
|
||||
*p = (cl_index)ecl_vms_popu(env);
|
||||
}
|
||||
return bytecodes;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -506,8 +506,7 @@ universal_error_handler(cl_object continue_string, cl_object datum,
|
|||
ecl_bds_bind(the_env, @'*print-length*', ecl_make_fixnum(8));
|
||||
ecl_bds_bind(the_env, @'*print-circle*', ECL_NIL);
|
||||
ecl_bds_bind(the_env, @'*print-base*', ecl_make_fixnum(10));
|
||||
writestr_stream("\n;;; Unhandled lisp initialization error",
|
||||
stream);
|
||||
writestr_stream("\n;;; Unhandled lisp initialization error", stream);
|
||||
writestr_stream("\n;;; Message:\n", stream);
|
||||
si_write_ugly_object(datum, stream);
|
||||
writestr_stream("\n;;; Arguments:\n", stream);
|
||||
|
|
|
|||
|
|
@ -421,7 +421,7 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
|
|||
Inlined forms for some functions which act on reg0 and stack.
|
||||
*/
|
||||
CASE(OP_CONS); {
|
||||
cl_object car = ecl_vms_pop_unsafe(the_env);
|
||||
cl_object car = ecl_vms_popu(the_env);
|
||||
reg0 = CONS(car, reg0);
|
||||
THREAD_NEXT;
|
||||
}
|
||||
|
|
@ -447,7 +447,7 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
|
|||
cl_index n;
|
||||
GET_OPARG(n, vector);
|
||||
while (--n) {
|
||||
reg0 = CONS(ecl_vms_pop_unsafe(the_env), reg0);
|
||||
reg0 = CONS(ecl_vms_popu(the_env), reg0);
|
||||
}
|
||||
THREAD_NEXT;
|
||||
}
|
||||
|
|
@ -540,7 +540,7 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
|
|||
the_env->function = ECL_SYM_FUN(s);
|
||||
f = ECL_SYM_FUN(s)->cfun.entry;
|
||||
SETUP_ENV(the_env);
|
||||
reg0 = f(2, ecl_vms_pop_unsafe(the_env), reg0);
|
||||
reg0 = f(2, ecl_vms_popu(the_env), reg0);
|
||||
THREAD_NEXT;
|
||||
}
|
||||
|
||||
|
|
@ -584,7 +584,7 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
|
|||
the stack (They all have been deposited by OP_PUSHVALUES)
|
||||
*/
|
||||
CASE(OP_MCALL); {
|
||||
narg = ecl_fixnum(ecl_vms_pop_unsafe(the_env));
|
||||
narg = ecl_fixnum(ecl_vms_popu(the_env));
|
||||
reg0 = ECL_VMS_REF(the_env,-narg-1);
|
||||
INTERPRET_FUNCALL(reg0, the_env, frame_aux, narg, reg0);
|
||||
THREAD_NEXT;
|
||||
|
|
@ -594,14 +594,14 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
|
|||
Pops a single value pushed by a OP_PUSH* operator.
|
||||
*/
|
||||
CASE(OP_POP); {
|
||||
reg0 = ecl_vms_pop_unsafe(the_env);
|
||||
reg0 = ecl_vms_popu(the_env);
|
||||
THREAD_NEXT;
|
||||
}
|
||||
/* OP_POP1
|
||||
Pops a single value pushed by a OP_PUSH* operator, ignoring it.
|
||||
*/
|
||||
CASE(OP_POP1); {
|
||||
(void)ecl_vms_pop_unsafe(the_env);
|
||||
(void)ecl_vms_popu(the_env);
|
||||
THREAD_NEXT;
|
||||
}
|
||||
/* OP_POPREQ
|
||||
|
|
@ -859,7 +859,7 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
|
|||
output values are left in VALUES(...).
|
||||
*/
|
||||
CASE(OP_THROW); {
|
||||
cl_object tag_name = ecl_vms_pop_unsafe(the_env);
|
||||
cl_object tag_name = ecl_vms_popu(the_env);
|
||||
the_env->values[0] = reg0;
|
||||
cl_throw(tag_name);
|
||||
THREAD_NEXT;
|
||||
|
|
@ -954,7 +954,7 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
|
|||
CASE(OP_PBIND); {
|
||||
cl_object var_name;
|
||||
GET_DATA(var_name, vector, data);
|
||||
bind_var(lcl_env, var_name, ecl_vms_pop_unsafe(the_env));
|
||||
bind_var(lcl_env, var_name, ecl_vms_popu(the_env));
|
||||
THREAD_NEXT;
|
||||
}
|
||||
CASE(OP_VBIND); {
|
||||
|
|
@ -975,7 +975,7 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
|
|||
CASE(OP_PBINDS); {
|
||||
cl_object var_name;
|
||||
GET_DATA(var_name, vector, data);
|
||||
ecl_bds_bind(the_env, var_name, ecl_vms_pop_unsafe(the_env));
|
||||
ecl_bds_bind(the_env, var_name, ecl_vms_popu(the_env));
|
||||
THREAD_NEXT;
|
||||
}
|
||||
CASE(OP_VBINDS); {
|
||||
|
|
@ -1027,20 +1027,20 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
|
|||
CASE(OP_PSETQ); {
|
||||
int ndx;
|
||||
GET_OPARG(ndx, vector);
|
||||
ecl_lcl_env_set_var(lcl_env, ndx, ecl_vms_pop_unsafe(the_env));
|
||||
ecl_lcl_env_set_var(lcl_env, ndx, ecl_vms_popu(the_env));
|
||||
THREAD_NEXT;
|
||||
}
|
||||
CASE(OP_PSETQC); {
|
||||
int ndx;
|
||||
GET_OPARG(ndx, vector);
|
||||
ecl_lex_env_set_var(lex_env, ndx, ecl_vms_pop_unsafe(the_env));
|
||||
ecl_lex_env_set_var(lex_env, ndx, ecl_vms_popu(the_env));
|
||||
THREAD_NEXT;
|
||||
}
|
||||
CASE(OP_PSETQS); {
|
||||
cl_object var;
|
||||
GET_DATA(var, vector, data);
|
||||
/* INV: Not NIL, and of type t_symbol */
|
||||
ECL_SETQ(the_env, var, ecl_vms_pop_unsafe(the_env));
|
||||
ECL_SETQ(the_env, var, ecl_vms_popu(the_env));
|
||||
THREAD_NEXT;
|
||||
}
|
||||
CASE(OP_VSETQ); {
|
||||
|
|
@ -1158,7 +1158,7 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
|
|||
CASE(OP_EXIT_FRAME); {
|
||||
DO_EXIT_FRAME:
|
||||
ecl_frs_pop(the_env);
|
||||
ecl_vms_pop_n_unsafe(the_env, 2);
|
||||
ecl_vms_drop(the_env, 2);
|
||||
THREAD_NEXT;
|
||||
}
|
||||
CASE(OP_NIL); {
|
||||
|
|
@ -1181,7 +1181,7 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
|
|||
PUSH_VALUES:
|
||||
CASE(OP_PUSHVALUES); {
|
||||
cl_index i = the_env->nvalues;
|
||||
ecl_vms_push_n(the_env, i+1);
|
||||
ecl_vms_grow(the_env, i+1);
|
||||
the_env->values[0] = reg0;
|
||||
memcpy(&ECL_VMS_REF(the_env, -(i+1)), the_env->values, i * sizeof(cl_object));
|
||||
ECL_VMS_REF(the_env, -1) = ecl_make_fixnum(the_env->nvalues);
|
||||
|
|
@ -1193,7 +1193,7 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
|
|||
CASE(OP_PUSHMOREVALUES); {
|
||||
cl_index n = ecl_fixnum(ECL_VMS_REF(the_env,-1));
|
||||
cl_index i = the_env->nvalues;
|
||||
ecl_vms_push_n(the_env, i);
|
||||
ecl_vms_grow(the_env, i);
|
||||
the_env->values[0] = reg0;
|
||||
memcpy(&ECL_VMS_REF(the_env, -(i+1)), the_env->values, i * sizeof(cl_object));
|
||||
ECL_VMS_REF(the_env, -1) = ecl_make_fixnum(n + i);
|
||||
|
|
@ -1204,15 +1204,15 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
|
|||
*/
|
||||
CASE(OP_POPVALUES); {
|
||||
cl_object *dest = the_env->values;
|
||||
int n = the_env->nvalues = ecl_fixnum(ecl_vms_pop_unsafe(the_env));
|
||||
int n = the_env->nvalues = ecl_fixnum(ecl_vms_popu(the_env));
|
||||
if (n == 0) {
|
||||
*dest = reg0 = ECL_NIL;
|
||||
THREAD_NEXT;
|
||||
} else if (n == 1) {
|
||||
*dest = reg0 = ecl_vms_pop_unsafe(the_env);
|
||||
*dest = reg0 = ecl_vms_popu(the_env);
|
||||
THREAD_NEXT;
|
||||
} else {
|
||||
ecl_vms_pop_n_unsafe(the_env,n);
|
||||
ecl_vms_drop(the_env,n);
|
||||
memcpy(dest, &ECL_VMS_REF(the_env,0), n * sizeof(cl_object));
|
||||
reg0 = *dest;
|
||||
THREAD_NEXT;
|
||||
|
|
@ -1226,7 +1226,7 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
|
|||
cl_fixnum n;
|
||||
GET_OPARG(n, vector);
|
||||
the_env->nvalues = n;
|
||||
ecl_vms_pop_n_unsafe(the_env, n);
|
||||
ecl_vms_drop(the_env, n);
|
||||
memcpy(the_env->values, &ECL_VMS_REF(the_env, 0), n * sizeof(cl_object));
|
||||
reg0 = the_env->values[0];
|
||||
THREAD_NEXT;
|
||||
|
|
@ -1236,7 +1236,7 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
|
|||
The index N-th is extracted from the top of the stack.
|
||||
*/
|
||||
CASE(OP_NTHVAL); {
|
||||
cl_fixnum n = ecl_fixnum(ecl_vms_pop_unsafe(the_env));
|
||||
cl_fixnum n = ecl_fixnum(ecl_vms_popu(the_env));
|
||||
if (ecl_unlikely(n < 0)) {
|
||||
VEwrong_arg_type_nth_val(n);
|
||||
} else if ((cl_index)n >= the_env->nvalues) {
|
||||
|
|
@ -1267,8 +1267,8 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
|
|||
ecl_frs_push(the_env,ECL_PROTECT_TAG);
|
||||
if (__ecl_frs_push_result != 0) {
|
||||
ecl_frs_pop(the_env);
|
||||
vector = (cl_opcode *)ecl_vms_pop_unsafe(the_env);
|
||||
unwind_lcl(lcl_env, ecl_vms_pop_unsafe(the_env));
|
||||
vector = (cl_opcode *)ecl_vms_popu(the_env);
|
||||
unwind_lcl(lcl_env, ecl_vms_popu(the_env));
|
||||
reg0 = the_env->values[0];
|
||||
ecl_vms_push(the_env, ecl_make_fixnum(the_env->frs_stack.nlj_fr - the_env->frs_stack.top));
|
||||
goto PUSH_VALUES;
|
||||
|
|
@ -1278,17 +1278,17 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
|
|||
CASE(OP_PROTECT_NORMAL); {
|
||||
ecl_bds_unwind(the_env, the_env->frs_stack.top->frs_bds_ndx);
|
||||
ecl_frs_pop(the_env);
|
||||
(void)ecl_vms_pop_unsafe(the_env);
|
||||
unwind_lcl(lcl_env, ecl_vms_pop_unsafe(the_env));
|
||||
(void)ecl_vms_popu(the_env);
|
||||
unwind_lcl(lcl_env, ecl_vms_popu(the_env));
|
||||
ecl_vms_push(the_env, ecl_make_fixnum(1));
|
||||
goto PUSH_VALUES;
|
||||
}
|
||||
CASE(OP_PROTECT_EXIT); {
|
||||
volatile cl_fixnum n = the_env->nvalues = ecl_fixnum(ecl_vms_pop_unsafe(the_env));
|
||||
volatile cl_fixnum n = the_env->nvalues = ecl_fixnum(ecl_vms_popu(the_env));
|
||||
while (n--)
|
||||
the_env->values[n] = ecl_vms_pop_unsafe(the_env);
|
||||
the_env->values[n] = ecl_vms_popu(the_env);
|
||||
reg0 = the_env->values[0];
|
||||
n = ecl_fixnum(ecl_vms_pop_unsafe(the_env));
|
||||
n = ecl_fixnum(ecl_vms_popu(the_env));
|
||||
if (n <= 0)
|
||||
ecl_unwind(the_env, the_env->frs_stack.top + n);
|
||||
THREAD_NEXT;
|
||||
|
|
@ -1302,13 +1302,13 @@ ecl_interpret(cl_object frame, cl_object closure, cl_object bytecodes)
|
|||
*/
|
||||
CASE(OP_PROGV); {
|
||||
cl_object values = reg0;
|
||||
cl_object vars = ecl_vms_pop_unsafe(the_env);
|
||||
cl_object vars = ecl_vms_popu(the_env);
|
||||
cl_index n = ecl_progv(the_env, vars, values);
|
||||
ecl_vms_push(the_env, ecl_make_fixnum(n));
|
||||
THREAD_NEXT;
|
||||
}
|
||||
CASE(OP_EXIT_PROGV); {
|
||||
cl_index n = ecl_fixnum(ecl_vms_pop_unsafe(the_env));
|
||||
cl_index n = ecl_fixnum(ecl_vms_popu(the_env));
|
||||
ecl_bds_unwind(the_env, n);
|
||||
THREAD_NEXT;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -960,7 +960,7 @@ sharp_asterisk_reader(cl_object in, cl_object c, cl_object d)
|
|||
else
|
||||
x->vector.self.bit[i/CHAR_BIT] |= 0200 >> i%CHAR_BIT;
|
||||
}
|
||||
ecl_vms_pop_n_unsafe(env, dimcount);
|
||||
ecl_vms_drop(env, dimcount);
|
||||
@(return x);
|
||||
}
|
||||
|
||||
|
|
|
|||
226
src/c/stacks.d
226
src/c/stacks.d
|
|
@ -2,7 +2,7 @@
|
|||
/* vim: set filetype=c tabstop=2 shiftwidth=2 expandtab: */
|
||||
|
||||
/*
|
||||
* stacks.d - binding/history/frame stacks
|
||||
* stacks.d - runtime, binding, history and frame stacks
|
||||
*
|
||||
* Copyright (c) 1984 Taiichi Yuasa and Masami Hagiya
|
||||
* Copyright (c) 1990 Giuseppe Attardi
|
||||
|
|
@ -19,6 +19,7 @@
|
|||
# include <sys/time.h>
|
||||
# include <sys/resource.h>
|
||||
#endif
|
||||
#include <ecl/ecl-inl.h>
|
||||
#include <ecl/internal.h>
|
||||
#include <ecl/stack-resize.h>
|
||||
|
||||
|
|
@ -146,67 +147,47 @@ run_init(cl_env_ptr env)
|
|||
{
|
||||
cl_index size, limit_size, margin;
|
||||
margin = ecl_option_values[ECL_OPT_LISP_STACK_SAFETY_AREA];
|
||||
size = ecl_option_values[ECL_OPT_LISP_STACK_SIZE];
|
||||
size = ((size + LISP_PAGESIZE - 1) / LISP_PAGESIZE) * LISP_PAGESIZE;
|
||||
limit_size = size - 2*margin;
|
||||
env->run_stack.size = size;
|
||||
env->run_stack.limit_size = limit_size;
|
||||
limit_size = ecl_option_values[ECL_OPT_LISP_STACK_SIZE];
|
||||
size = limit_size + 2 * margin;
|
||||
env->run_stack.org = (cl_object *)ecl_malloc(size * sizeof(cl_object));
|
||||
env->run_stack.top = env->run_stack.org;
|
||||
env->run_stack.limit = &env->run_stack.org[limit_size];
|
||||
env->run_stack.size = size;
|
||||
env->run_stack.limit_size = limit_size;
|
||||
/* A stack always has at least one element. This is assumed by cl__va_start
|
||||
and friends, which take a sp=0 to have no arguments. */
|
||||
*(env->run_stack.top++) = ecl_make_fixnum(0);
|
||||
}
|
||||
|
||||
cl_object *
|
||||
ecl_vms_set_size(cl_env_ptr env, cl_index tentative_new_size)
|
||||
{
|
||||
cl_index top = env->run_stack.top - env->run_stack.org;
|
||||
cl_object *new_stack, *old_stack;
|
||||
cl_index safety_area = ecl_option_values[ECL_OPT_LISP_STACK_SAFETY_AREA];
|
||||
cl_index nsize = tentative_new_size + 2*safety_area;
|
||||
cl_index osize = env->run_stack.size;
|
||||
|
||||
/* Round to page size */
|
||||
nsize = ((nsize + LISP_PAGESIZE - 1) / LISP_PAGESIZE) * LISP_PAGESIZE;
|
||||
|
||||
if (ecl_unlikely(top > nsize)) {
|
||||
FEerror("Internal error: cannot shrink stack below stack top.",0);
|
||||
}
|
||||
|
||||
old_stack = env->run_stack.org;
|
||||
new_stack = (cl_object *)ecl_realloc(old_stack,
|
||||
osize * sizeof(cl_object),
|
||||
nsize * sizeof(cl_object));
|
||||
|
||||
ECL_STACK_RESIZE_DISABLE_INTERRUPTS(env);
|
||||
env->run_stack.size = nsize;
|
||||
env->run_stack.limit_size = nsize - 2*safety_area;
|
||||
env->run_stack.org = new_stack;
|
||||
env->run_stack.top = env->run_stack.org + top;
|
||||
env->run_stack.limit = env->run_stack.org + (nsize - 2*safety_area);
|
||||
|
||||
/* A stack always has at least one element. This is assumed by cl__va_start
|
||||
* and friends, which take a sp=0 to have no arguments.
|
||||
*/
|
||||
if (top == 0) {
|
||||
*(env->run_stack.top++) = ecl_make_fixnum(0);
|
||||
}
|
||||
ECL_STACK_RESIZE_ENABLE_INTERRUPTS(env);
|
||||
return env->run_stack.top;
|
||||
}
|
||||
|
||||
void
|
||||
FEstack_underflow(void)
|
||||
vms_set_limit(cl_env_ptr env, cl_index new_lim_size)
|
||||
{
|
||||
FEerror("Internal error: stack underflow.",0);
|
||||
cl_index margin = ecl_option_values[ECL_OPT_LISP_STACK_SAFETY_AREA];
|
||||
cl_object *old_org = env->run_stack.org;
|
||||
cl_object *new_org = NULL;
|
||||
cl_index osize = env->run_stack.size;
|
||||
cl_index nsize = new_lim_size + 2*margin;
|
||||
cl_index current_size = env->run_stack.top - old_org;
|
||||
if (current_size > new_lim_size)
|
||||
ecl_internal_error("Cannot shrink frame stack below its minimal element");
|
||||
new_org = ecl_realloc(old_org,
|
||||
osize * sizeof(*old_org),
|
||||
nsize * sizeof(*old_org));
|
||||
ECL_STACK_RESIZE_DISABLE_INTERRUPTS(env);
|
||||
env->run_stack.org = new_org;
|
||||
env->run_stack.top = new_org + current_size;
|
||||
env->run_stack.limit = new_org + new_lim_size;
|
||||
/* Update indexes */
|
||||
env->run_stack.size = nsize;
|
||||
env->run_stack.limit_size = new_lim_size;
|
||||
ECL_STACK_RESIZE_ENABLE_INTERRUPTS(env);
|
||||
}
|
||||
|
||||
cl_object *
|
||||
ecl_vms_grow(cl_env_ptr env)
|
||||
ecl_vms_extend(cl_env_ptr env)
|
||||
{
|
||||
return ecl_vms_set_size(env, env->run_stack.size + env->run_stack.size / 2);
|
||||
vms_set_limit(env, env->run_stack.limit_size + env->run_stack.limit_size / 2);
|
||||
return env->run_stack.top;
|
||||
}
|
||||
|
||||
cl_index
|
||||
|
|
@ -215,11 +196,11 @@ ecl_vms_push_values(cl_env_ptr env) {
|
|||
cl_object *b = env->run_stack.top;
|
||||
cl_object *p = b + i;
|
||||
if (p >= env->run_stack.limit) {
|
||||
b = ecl_vms_grow(env);
|
||||
b = ecl_vms_extend(env);
|
||||
p = b + i;
|
||||
}
|
||||
env->run_stack.top = p;
|
||||
memcpy(b, env->values, i * sizeof(cl_object));
|
||||
ecl_copy(b, env->values, i * sizeof(cl_object));
|
||||
return i;
|
||||
}
|
||||
|
||||
|
|
@ -227,10 +208,10 @@ void
|
|||
ecl_vms_pop_values(cl_env_ptr env, cl_index n) {
|
||||
cl_object *p = env->run_stack.top - n;
|
||||
if (ecl_unlikely(p < env->run_stack.org))
|
||||
FEstack_underflow();
|
||||
ecl_internal_error("vms: stack underflow.");
|
||||
env->nvalues = n;
|
||||
env->run_stack.top = p;
|
||||
memcpy(env->values, p, n * sizeof(cl_object));
|
||||
ecl_copy(env->values, p, n * sizeof(cl_object));
|
||||
}
|
||||
|
||||
cl_object
|
||||
|
|
@ -240,7 +221,8 @@ ecl_stack_frame_open(cl_env_ptr env, cl_object f, cl_index size)
|
|||
cl_index bindex;
|
||||
if (size) {
|
||||
if ((env->run_stack.limit - base) < size) {
|
||||
base = ecl_vms_set_size(env, env->run_stack.size + size);
|
||||
vms_set_limit(env, env->run_stack.limit_size + size);
|
||||
base = env->run_stack.top;
|
||||
}
|
||||
}
|
||||
bindex = ECL_STACK_INDEX(env);
|
||||
|
|
@ -260,7 +242,7 @@ ecl_stack_frame_push(cl_object f, cl_object o)
|
|||
cl_env_ptr env = f->frame.env;
|
||||
cl_object *top = env->run_stack.top;
|
||||
if (top >= env->run_stack.limit) {
|
||||
top = ecl_vms_grow(env);
|
||||
top = ecl_vms_extend(env);
|
||||
}
|
||||
env->run_stack.top = ++top;
|
||||
*(top-1) = o;
|
||||
|
|
@ -309,39 +291,39 @@ ecl_bds_unwind_n(cl_env_ptr env, int n)
|
|||
static void
|
||||
bds_init(cl_env_ptr env)
|
||||
{
|
||||
cl_index size, margin;
|
||||
cl_index size, margin, limit_size;
|
||||
margin = ecl_option_values[ECL_OPT_BIND_STACK_SAFETY_AREA];
|
||||
size = ecl_option_values[ECL_OPT_BIND_STACK_SIZE] + 2 * margin;
|
||||
env->bds_stack.size = size;
|
||||
limit_size = ecl_option_values[ECL_OPT_BIND_STACK_SIZE];
|
||||
size = limit_size + 2 * margin;
|
||||
env->bds_stack.org = (ecl_bds_ptr)ecl_malloc(size * sizeof(*env->bds_stack.org));
|
||||
env->bds_stack.top = env->bds_stack.org-1;
|
||||
env->bds_stack.limit = &env->bds_stack.org[size - 2*margin];
|
||||
env->bds_stack.limit = &env->bds_stack.org[limit_size];
|
||||
env->bds_stack.size = size;
|
||||
env->bds_stack.limit_size = limit_size;
|
||||
}
|
||||
|
||||
static void
|
||||
bds_set_size(cl_env_ptr env, cl_index nsize)
|
||||
bds_set_limit(cl_env_ptr env, cl_index new_lim_size)
|
||||
{
|
||||
cl_index margin = ecl_option_values[ECL_OPT_BIND_STACK_SAFETY_AREA];
|
||||
ecl_bds_ptr old_org = env->bds_stack.org;
|
||||
cl_index limit = env->bds_stack.top - old_org;
|
||||
ecl_bds_ptr new_org = NULL;
|
||||
cl_index osize = env->bds_stack.size;
|
||||
if (nsize <= limit) {
|
||||
FEerror("Cannot shrink the binding stack below ~D.", 1,
|
||||
ecl_make_unsigned_integer(limit));
|
||||
} else {
|
||||
ecl_bds_ptr org;
|
||||
cl_index margin = ecl_option_values[ECL_OPT_BIND_STACK_SAFETY_AREA];
|
||||
org = ecl_realloc(old_org,
|
||||
osize * sizeof(*org),
|
||||
nsize * sizeof(*org));
|
||||
ECL_STACK_RESIZE_DISABLE_INTERRUPTS(env);
|
||||
memcpy(org, old_org, (limit + 1) * sizeof(*org));
|
||||
env->bds_stack.top = org + limit;
|
||||
env->bds_stack.org = org;
|
||||
env->bds_stack.limit = org + (nsize - 2*margin);
|
||||
env->bds_stack.size = nsize;
|
||||
env->bds_stack.limit_size = nsize - 2*margin;
|
||||
ECL_STACK_RESIZE_ENABLE_INTERRUPTS(env);
|
||||
}
|
||||
cl_index nsize = new_lim_size + 2*margin;
|
||||
cl_index current_size = env->bds_stack.top - old_org;
|
||||
if (current_size > new_lim_size)
|
||||
ecl_internal_error("Cannot shrink frame stack below its minimal element");
|
||||
new_org = ecl_realloc(old_org,
|
||||
osize * sizeof(*old_org),
|
||||
nsize * sizeof(*old_org));
|
||||
ECL_STACK_RESIZE_DISABLE_INTERRUPTS(env);
|
||||
env->bds_stack.org = new_org;
|
||||
env->bds_stack.top = new_org + current_size;
|
||||
env->bds_stack.limit = new_org + new_lim_size;
|
||||
/* Update indexes */
|
||||
env->bds_stack.size = nsize;
|
||||
env->bds_stack.limit_size = new_lim_size;
|
||||
ECL_STACK_RESIZE_ENABLE_INTERRUPTS(env);
|
||||
}
|
||||
|
||||
ecl_bds_ptr
|
||||
|
|
@ -354,6 +336,7 @@ ecl_bds_overflow(void)
|
|||
cl_env_ptr env = ecl_process_env();
|
||||
cl_index margin = ecl_option_values[ECL_OPT_BIND_STACK_SAFETY_AREA];
|
||||
cl_index size = env->bds_stack.size;
|
||||
cl_index limit_size = env->bds_stack.limit_size;
|
||||
ecl_bds_ptr org = env->bds_stack.org;
|
||||
ecl_bds_ptr last = org + size;
|
||||
if (env->bds_stack.limit >= last) {
|
||||
|
|
@ -366,9 +349,9 @@ ecl_bds_overflow(void)
|
|||
@':type', @'ext::binding-stack');
|
||||
} ECL_UNWIND_PROTECT_EXIT {
|
||||
/* reset margin */
|
||||
bds_set_size(env, size);
|
||||
bds_set_limit(env, limit_size);
|
||||
} ECL_UNWIND_PROTECT_END;
|
||||
bds_set_size(env, size + (size / 2));
|
||||
bds_set_limit(env, limit_size + (limit_size / 2));
|
||||
return env->bds_stack.top;
|
||||
}
|
||||
|
||||
|
|
@ -681,38 +664,39 @@ si_ihs_env(cl_object arg)
|
|||
static void
|
||||
frs_init(cl_env_ptr env)
|
||||
{
|
||||
cl_index size, margin;
|
||||
cl_index size, margin, limit_size;
|
||||
margin = ecl_option_values[ECL_OPT_FRAME_STACK_SAFETY_AREA];
|
||||
size = ecl_option_values[ECL_OPT_FRAME_STACK_SIZE] + 2 * margin;
|
||||
env->frs_stack.size = size;
|
||||
limit_size = ecl_option_values[ECL_OPT_FRAME_STACK_SIZE];
|
||||
size = limit_size + 2 * margin;
|
||||
env->frs_stack.org = (ecl_frame_ptr)ecl_malloc(size * sizeof(*env->frs_stack.org));
|
||||
env->frs_stack.top = env->frs_stack.org-1;
|
||||
env->frs_stack.limit = &env->frs_stack.org[size - 2*margin];
|
||||
env->frs_stack.limit = &env->frs_stack.org[limit_size];
|
||||
env->frs_stack.size = size;
|
||||
env->frs_stack.limit_size = limit_size;
|
||||
}
|
||||
|
||||
static void
|
||||
frs_set_size(cl_env_ptr env, cl_index nsize)
|
||||
frs_set_limit(cl_env_ptr env, cl_index new_lim_size)
|
||||
{
|
||||
cl_index margin = ecl_option_values[ECL_OPT_FRAME_STACK_SAFETY_AREA];
|
||||
ecl_frame_ptr old_org = env->frs_stack.org;
|
||||
cl_index limit = env->frs_stack.top - old_org;
|
||||
if (nsize <= limit) {
|
||||
FEerror("Cannot shrink frame stack below ~D.", 1,
|
||||
ecl_make_unsigned_integer(limit));
|
||||
} else {
|
||||
ecl_frame_ptr org;
|
||||
cl_index margin = ecl_option_values[ECL_OPT_FRAME_STACK_SAFETY_AREA];
|
||||
cl_index osize = env->frs_stack.size;
|
||||
org = ecl_realloc(old_org,
|
||||
osize * sizeof(*org),
|
||||
nsize * sizeof(*org));
|
||||
ECL_STACK_RESIZE_DISABLE_INTERRUPTS(env);
|
||||
env->frs_stack.top = org + limit;
|
||||
env->frs_stack.org = org;
|
||||
env->frs_stack.limit = org + (nsize - 2*margin);
|
||||
env->frs_stack.size = nsize;
|
||||
env->frs_stack.limit_size = nsize - 2*margin;
|
||||
ECL_STACK_RESIZE_ENABLE_INTERRUPTS(env);
|
||||
}
|
||||
ecl_frame_ptr new_org = NULL;
|
||||
cl_index osize = env->frs_stack.size;
|
||||
cl_index nsize = new_lim_size + 2*margin;
|
||||
cl_index current_size = env->frs_stack.top - old_org;
|
||||
if(current_size > new_lim_size)
|
||||
ecl_internal_error("Cannot shrink frame stack below its minimal element");
|
||||
new_org = ecl_realloc(old_org,
|
||||
osize * sizeof(*old_org),
|
||||
nsize * sizeof(*old_org));
|
||||
ECL_STACK_RESIZE_DISABLE_INTERRUPTS(env);
|
||||
env->frs_stack.org = new_org;
|
||||
env->frs_stack.top = new_org + current_size;
|
||||
env->frs_stack.limit = new_org + new_lim_size;
|
||||
/* Update indexes. */
|
||||
env->frs_stack.size = nsize;
|
||||
env->frs_stack.limit_size = new_lim_size;
|
||||
ECL_STACK_RESIZE_ENABLE_INTERRUPTS(env);
|
||||
}
|
||||
|
||||
static void
|
||||
|
|
@ -725,6 +709,7 @@ frs_overflow(void) /* used as condition in list.d */
|
|||
cl_env_ptr env = ecl_process_env();
|
||||
cl_index margin = ecl_option_values[ECL_OPT_FRAME_STACK_SAFETY_AREA];
|
||||
cl_index size = env->frs_stack.size;
|
||||
cl_index limit_size = env->frs_stack.limit_size;
|
||||
ecl_frame_ptr org = env->frs_stack.org;
|
||||
ecl_frame_ptr last = org + size;
|
||||
if (env->frs_stack.limit >= last) {
|
||||
|
|
@ -737,9 +722,9 @@ frs_overflow(void) /* used as condition in list.d */
|
|||
@':type', @'ext::frame-stack');
|
||||
} ECL_UNWIND_PROTECT_EXIT {
|
||||
/* reset margin */
|
||||
frs_set_size(env, size);
|
||||
frs_set_limit(env, limit_size);
|
||||
} ECL_UNWIND_PROTECT_END;
|
||||
frs_set_size(env, size + size / 2);
|
||||
frs_set_limit(env, limit_size + limit_size / 2);
|
||||
}
|
||||
|
||||
ecl_frame_ptr
|
||||
|
|
@ -854,20 +839,27 @@ si_set_limit(cl_object type, cl_object limit)
|
|||
cl_env_ptr env = ecl_process_env();
|
||||
cl_index margin;
|
||||
if (type == @'ext::frame-stack') {
|
||||
cl_index the_size = ecl_to_size(limit);
|
||||
margin = ecl_option_values[ECL_OPT_FRAME_STACK_SAFETY_AREA];
|
||||
frs_set_size(env, the_size + 2*margin);
|
||||
cl_index current_size = env->frs_stack.top - env->frs_stack.org;
|
||||
cl_index request_size = ecl_to_size(limit);
|
||||
if(current_size > request_size)
|
||||
FEerror("Cannot shrink FRS stack below ~D.", 1, limit);
|
||||
frs_set_limit(env, request_size);
|
||||
} else if (type == @'ext::binding-stack') {
|
||||
cl_index the_size = ecl_to_size(limit);
|
||||
margin = ecl_option_values[ECL_OPT_BIND_STACK_SAFETY_AREA];
|
||||
bds_set_size(env, the_size + 2*margin);
|
||||
cl_index current_size = env->bds_stack.top - env->bds_stack.org;
|
||||
cl_index request_size = ecl_to_size(limit);
|
||||
if(current_size > request_size)
|
||||
FEerror("Cannot shrink BDS stack below ~D.", 1, limit);
|
||||
bds_set_limit(env, request_size);
|
||||
} else if (type == @'ext::lisp-stack') {
|
||||
cl_index current_size = env->run_stack.top - env->run_stack.org;
|
||||
cl_index request_size = ecl_to_size(limit);
|
||||
if(current_size > request_size)
|
||||
FEerror("Cannot shrink VMS stack below ~D.", 1, limit);
|
||||
vms_set_limit(env, request_size);
|
||||
} else if (type == @'ext::c-stack') {
|
||||
cl_index the_size = ecl_to_size(limit);
|
||||
margin = ecl_option_values[ECL_OPT_C_STACK_SAFETY_AREA];
|
||||
cs_set_size(env, the_size + 2*margin);
|
||||
} else if (type == @'ext::lisp-stack') {
|
||||
cl_index the_size = ecl_to_size(limit);
|
||||
ecl_vms_set_size(env, the_size);
|
||||
} else if (type == @'ext::heap-size') {
|
||||
/*
|
||||
* size_t can be larger than cl_index, and ecl_to_size()
|
||||
|
|
@ -889,10 +881,10 @@ si_get_limit(cl_object type)
|
|||
output = env->frs_stack.limit_size;
|
||||
else if (type == @'ext::binding-stack')
|
||||
output = env->bds_stack.limit_size;
|
||||
else if (type == @'ext::c-stack')
|
||||
output = env->c_stack.limit_size;
|
||||
else if (type == @'ext::lisp-stack')
|
||||
output = env->run_stack.limit_size;
|
||||
else if (type == @'ext::c-stack')
|
||||
output = env->c_stack.limit_size;
|
||||
else if (type == @'ext::heap-size') {
|
||||
/* size_t can be larger than cl_index */
|
||||
ecl_return1(env, ecl_make_unsigned_integer(cl_core.max_heap_size));
|
||||
|
|
|
|||
|
|
@ -888,7 +888,7 @@ nstring_case(cl_narg narg, cl_object fun, ecl_casefun casefun, ecl_va_list ARGS)
|
|||
/* Do actual copying by recovering those strings */
|
||||
output = ecl_alloc_simple_base_string(l);
|
||||
while (l) {
|
||||
cl_object s = ecl_vms_pop_unsafe(the_env);
|
||||
cl_object s = ecl_vms_popu(the_env);
|
||||
size_t bytes = s->base_string.fillp;
|
||||
l -= bytes;
|
||||
memcpy(output->base_string.self + l, s->base_string.self, bytes);
|
||||
|
|
|
|||
|
|
@ -541,8 +541,7 @@ extern ECL_API cl_object ecl_stack_frame_pop_values(cl_object f);
|
|||
extern ECL_API void ecl_stack_frame_close(cl_object f);
|
||||
#define si_apply_from_stack_frame ecl_apply_from_stack_frame
|
||||
|
||||
extern ECL_API void FEstack_underflow(void) ecl_attr_noreturn;
|
||||
extern ECL_API cl_object *ecl_vms_grow(cl_env_ptr env);
|
||||
extern ECL_API cl_object *ecl_vms_extend(cl_env_ptr env);
|
||||
extern ECL_API cl_object *ecl_vms_set_size(cl_env_ptr env, cl_index new_size);
|
||||
extern ECL_API cl_index ecl_vms_push_values(cl_env_ptr env);
|
||||
extern ECL_API void ecl_vms_pop_values(cl_env_ptr env, cl_index n);
|
||||
|
|
|
|||
|
|
@ -370,29 +370,29 @@ static inline void
|
|||
ecl_vms_push(cl_env_ptr env, cl_object o) {
|
||||
cl_object *new_top = env->run_stack.top;
|
||||
if (ecl_unlikely(new_top >= env->run_stack.limit)) {
|
||||
new_top = ecl_vms_grow(env);
|
||||
new_top = ecl_vms_extend(env);
|
||||
}
|
||||
env->run_stack.top = new_top+1;
|
||||
*new_top = (o);
|
||||
}
|
||||
|
||||
static inline void
|
||||
ecl_vms_push_n(cl_env_ptr env, cl_index n) {
|
||||
ecl_vms_grow(cl_env_ptr env, cl_index n) {
|
||||
cl_object *new_top = env->run_stack.top;
|
||||
while (ecl_unlikely((env->run_stack.limit - new_top) <= n)) {
|
||||
new_top = ecl_vms_grow(env);
|
||||
new_top = ecl_vms_extend(env);
|
||||
}
|
||||
env->run_stack.top = new_top + n;
|
||||
}
|
||||
|
||||
static inline cl_object
|
||||
ecl_vms_pop_unsafe(cl_env_ptr env)
|
||||
ecl_vms_popu(cl_env_ptr env)
|
||||
{
|
||||
return *(--((env)->run_stack.top));
|
||||
}
|
||||
|
||||
static inline void
|
||||
ecl_vms_pop_n_unsafe(cl_env_ptr env, cl_index n)
|
||||
ecl_vms_drop(cl_env_ptr env, cl_index n)
|
||||
{
|
||||
env->run_stack.top -= n;
|
||||
}
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue