mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-16 14:21:48 -08:00
Code Issues Projects Releases Packages Wiki Activity

Renamed ecl_bds_ptr and ecl_ihs_ptr and the corresponding structs

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2012-06-30 21:39:22 +02:00
parent efadef99dc
commit 0131e2131d
10 changed files with 46 additions and 43 deletions
Download patch file Download diff file Expand all files Collapse all files

8
src/c/error.d
View file

@ -265,7 +265,7 @@ FEwrong_type_only_arg(cl_object function, cl_object value, cl_object type)
"the value of the only argument is~& ~S~&which is "
"not of the expected type ~A";
cl_env_ptr env = ecl_process_env();
struct ihs_frame tmp_ihs;
struct ecl_ihs_frame tmp_ihs;
function = cl_symbol_or_object(function);
type = cl_symbol_or_object(type);
if (!Null(function) && env->ihs_top && env->ihs_top->function != function) {
@ -288,7 +288,7 @@ FEwrong_type_nth_arg(cl_object function, cl_narg narg, cl_object value, cl_objec
"the value of the ~:R argument is~& ~S~&which is "
"not of the expected type ~A";
cl_env_ptr env = ecl_process_env();
struct ihs_frame tmp_ihs;
struct ecl_ihs_frame tmp_ihs;
function = cl_symbol_or_object(function);
type = cl_symbol_or_object(type);
if (!Null(function) && env->ihs_top && env->ihs_top->function != function) {
@ -312,7 +312,7 @@ FEwrong_type_key_arg(cl_object function, cl_object key, cl_object value, cl_obje
"the value of the argument ~S is~& ~S~&which is "
"not of the expected type ~A";
cl_env_ptr env = ecl_process_env();
struct ihs_frame tmp_ihs;
struct ecl_ihs_frame tmp_ihs;
function = cl_symbol_or_object(function);
type = cl_symbol_or_object(type);
key = cl_symbol_or_object(key);
@ -344,7 +344,7 @@ FEwrong_index(cl_object function, cl_object a, int which, cl_object ndx,
cl_object type = ecl_make_integer_type(ecl_make_fixnum(0), limit);
cl_object message = make_constant_base_string((which<0) ? message1 : message2);
cl_env_ptr env = ecl_process_env();
struct ihs_frame tmp_ihs;
struct ecl_ihs_frame tmp_ihs;
function = cl_symbol_or_object(function);
if (!Null(function) && env->ihs_top && env->ihs_top->function != function) {
ecl_ihs_push(env,&tmp_ihs,function,Cnil);

4
src/c/gbc-new.d
View file

@ -450,9 +450,9 @@ mark_phase(void)
{
register int i;
register struct package *pp;
register bds_ptr bdp;
register ecl_bds_ptr bdp;
register ecl_frame_ptr frp;
register ihs_ptr ihsp;
register ecl_ihs_ptr ihsp;
mark_object(Cnil);
mark_object(Ct);

4
src/c/gbc.d
View file

@ -476,9 +476,9 @@ mark_cl_env(struct cl_env_struct *env)
{
int i = 0;
cl_object where = 0;
bds_ptr bdp = 0;
ecl_bds_ptr bdp = 0;
ecl_frame_ptr frp = 0;
struct ihs_frame *ihs = 0;
ecl_ihs_ptr ihs = 0;
mark_contblock(env, sizeof(*env));

2
src/c/interpreter.d
View file

@ -276,7 +276,7 @@ ecl_interpret(cl_object frame, cl_object env, cl_object bytecodes)
cl_object reg0, reg1, lex_env = env;
cl_index narg;
struct ecl_stack_frame frame_aux;
volatile struct ihs_frame ihs;
volatile struct ecl_ihs_frame ihs;
/* INV: bytecodes is of type t_bytecodes */

32
src/c/stacks.d
View file

@ -116,14 +116,14 @@ ecl_bds_unwind_n(cl_env_ptr env, int n)
static void
ecl_bds_set_size(cl_env_ptr env, cl_index size)
{
bds_ptr old_org = env->bds_org;
ecl_bds_ptr old_org = env->bds_org;
cl_index limit = env->bds_top - old_org;
if (size <= limit) {
FEerror("Cannot shrink the binding stack below ~D.", 1,
ecl_make_unsigned_integer(limit));
} else {
cl_index margin = ecl_option_values[ECL_OPT_BIND_STACK_SAFETY_AREA];
bds_ptr org;
ecl_bds_ptr org;
org = ecl_alloc_atomic(size * sizeof(*org));
ecl_disable_interrupts_env(env);
@ -138,7 +138,7 @@ ecl_bds_set_size(cl_env_ptr env, cl_index size)
}
}
struct bds_bd *
ecl_bds_ptr
ecl_bds_overflow(void)
{
static const char *stack_overflow_msg =
@ -148,8 +148,8 @@ 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_size;
bds_ptr org = env->bds_org;
bds_ptr last = org + size;
ecl_bds_ptr org = env->bds_org;
ecl_bds_ptr last = org + size;
if (env->bds_limit >= last) {
ecl_unrecoverable_error(env, stack_overflow_msg);
}
@ -164,8 +164,8 @@ ecl_bds_overflow(void)
void
ecl_bds_unwind(cl_env_ptr env, cl_index new_bds_top_index)
{
bds_ptr new_bds_top = new_bds_top_index + env->bds_org;
bds_ptr bds = env->bds_top;
ecl_bds_ptr new_bds_top = new_bds_top_index + env->bds_org;
ecl_bds_ptr bds = env->bds_top;
for (; bds > new_bds_top; bds--)
#ifdef ECL_THREADS
ecl_bds_unwind1(env);
@ -198,12 +198,12 @@ ecl_progv(cl_env_ptr env, cl_object vars0, cl_object values0)
2, vars0, values0);
}
static bds_ptr
static ecl_bds_ptr
get_bds_ptr(cl_object x)
{
if (ECL_FIXNUMP(x)) {
cl_env_ptr env = ecl_process_env();
bds_ptr p = env->bds_org + ecl_fixnum(x);
ecl_bds_ptr p = env->bds_org + ecl_fixnum(x);
if (env->bds_org <= p && p <= env->bds_top)
return(p);
}
@ -296,7 +296,7 @@ ecl_bds_bind(cl_env_ptr env, cl_object s, cl_object v)
{
#ifdef ECL_THREADS
cl_object *location;
struct bds_bd *slot;
ecl_bds_ptr slot;
cl_index index = s->symbol.binding;
if (index >= env->thread_local_bindings_size) {
index = invalid_or_too_large_binding_index(env,s);
@ -320,7 +320,7 @@ ecl_bds_push(cl_env_ptr env, cl_object s)
{
#ifdef ECL_THREADS
cl_object *location;
struct bds_bd *slot;
ecl_bds_ptr slot;
cl_index index = s->symbol.binding;
if (index >= env->thread_local_bindings_size) {
index = invalid_or_too_large_binding_index(env,s);
@ -341,7 +341,7 @@ ecl_bds_push(cl_env_ptr env, cl_object s)
void
ecl_bds_unwind1(cl_env_ptr env)
{
struct bds_bd *slot = env->bds_top--;
ecl_bds_ptr slot = env->bds_top--;
cl_object s = slot->symbol;
#ifdef ECL_THREADS
cl_object *location = env->thread_local_bindings + s->symbol.binding;
@ -406,11 +406,11 @@ ihs_function_name(cl_object x)
}
}
static ihs_ptr
static ecl_ihs_ptr
get_ihs_ptr(cl_index n)
{
cl_env_ptr env = ecl_process_env();
ihs_ptr p = env->ihs_top;
ecl_ihs_ptr p = env->ihs_top;
if (n > p->index)
FEerror("~D is an illegal IHS index.", 1, ecl_make_fixnum(n));
while (n < p->index)
@ -643,7 +643,7 @@ si_get_limit(cl_object type)
void
init_stacks(cl_env_ptr env)
{
static struct ihs_frame ihs_org = { NULL, NULL, NULL, 0};
static struct ecl_ihs_frame ihs_org = { NULL, NULL, NULL, 0};
cl_index size, margin;
margin = ecl_option_values[ECL_OPT_FRAME_STACK_SAFETY_AREA];
@ -656,7 +656,7 @@ init_stacks(cl_env_ptr env)
margin = ecl_option_values[ECL_OPT_BIND_STACK_SAFETY_AREA];
size = ecl_option_values[ECL_OPT_BIND_STACK_SIZE] + 2 * margin;
env->bds_size = size;
env->bds_org = (bds_ptr)ecl_alloc_atomic(size * sizeof(*env->bds_org));
env->bds_org = (ecl_bds_ptr)ecl_alloc_atomic(size * sizeof(*env->bds_org));
env->bds_top = env->bds_org-1;
env->bds_limit = &env->bds_org[size - 2*margin];

2
src/cmp/cmptop.lsp
View file

@ -426,7 +426,7 @@ return f2;
(wt-h ";"))
(when *ihs-used-p*
(wt-h " \\")
(wt-nl-h "struct ihs_frame ihs; \\")
(wt-nl-h "struct ecl_ihs_frame ihs; \\")
(wt-nl-h "const cl_object _ecl_debug_env = Cnil;"))
(wt-nl-h "#define VLEX" *reservation-cmacro*)
;; There should be no need to mark lex as volatile, since we

2
src/cmp/test.lsp
View file

@ -1,4 +1,4 @@
y;;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: C -*-
all_y;;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: C -*-
;;;;
(in-package 'system)

8
src/h/external.h
View file

@ -45,16 +45,16 @@ struct cl_env_struct {
cl_object bindings_array;
#endif
cl_index bds_size;
struct bds_bd *bds_org;
struct bds_bd *bds_top;
struct bds_bd *bds_limit;
struct ecl_bds_bd *bds_org;
struct ecl_bds_bd *bds_top;
struct ecl_bds_bd *bds_limit;
/*
* The Invocation History Stack (IHS) keeps a list of the names of the
* functions that are invoked, together with their lexical
* environments.
*/
struct ihs_frame *ihs_top;
struct ecl_ihs_frame *ihs_top;
/*
* The FRames Stack (FRS) is a list of frames or jump points, and it

3
src/h/legacy.h
View file

@ -153,3 +153,6 @@
#define CL_CATCH_END ECL_CATCH_END
#define CL_CATCH_ALL_BEGIN ECL_CATCH_ALL_BEGIN
#define CL_CATCH_ALL_END ECL_CATCH_ALL_END
typedef struct ecl_bds_bd *bds_ptr;
typedef struct ecl_ihs_frame *ihs_ptr;

24
src/h/stacks.h
View file

@ -35,17 +35,17 @@ extern "C" {
* BIND STACK
**************/
typedef struct bds_bd {
typedef struct ecl_bds_bd {
cl_object symbol; /* symbol */
cl_object value; /* previous value of the symbol */
} *bds_ptr;
} *ecl_bds_ptr;
#define ecl_bds_check(env) \
(ecl_unlikely(env->bds_top >= env->bds_limit)? (ecl_bds_overflow(),1) : 0)
#define ECL_MISSING_SPECIAL_BINDING (~((cl_index)0))
extern ECL_API struct bds_bd *ecl_bds_overflow(void);
extern ECL_API ecl_bds_ptr ecl_bds_overflow(void);
extern ECL_API void ecl_bds_bind(cl_env_ptr env, cl_object symbol, cl_object v);
extern ECL_API void ecl_bds_push(cl_env_ptr env, cl_object symbol);
extern ECL_API void ecl_bds_unwind1(cl_env_ptr env);
@ -65,7 +65,7 @@ extern ECL_API cl_object ecl_bds_set(cl_env_ptr env, cl_object s, cl_object v);
#ifdef __GNUC__
static inline void ecl_bds_bind_inl(cl_env_ptr env, cl_object s, cl_object v)
{
struct bds_bd *slot;
ecl_bds_ptr slot;
# ifdef ECL_THREADS
cl_object *location;
const cl_index index = s->symbol.binding;
@ -90,7 +90,7 @@ static inline void ecl_bds_bind_inl(cl_env_ptr env, cl_object s, cl_object v)
static inline void ecl_bds_push_inl(cl_env_ptr env, cl_object s)
{
struct bds_bd *slot;
ecl_bds_ptr slot;
# ifdef ECL_THREADS
cl_object *location;
const cl_index index = s->symbol.binding;
@ -114,7 +114,7 @@ static inline void ecl_bds_push_inl(cl_env_ptr env, cl_object s)
static inline void ecl_bds_unwind1_inl(cl_env_ptr env)
{
struct bds_bd *slot = env->bds_top--;
ecl_bds_ptr slot = env->bds_top--;
cl_object s = slot->symbol;
# ifdef ECL_THREADS
cl_object *location = env->thread_local_bindings + s->symbol.binding;
@ -178,17 +178,17 @@ static inline cl_object ecl_bds_set_inl(cl_env_ptr env, cl_object s, cl_object v
* INVOCATION HISTORY STACK
****************************/
typedef struct ihs_frame {
struct ihs_frame *next;
typedef struct ecl_ihs_frame {
struct ecl_ihs_frame *next;
cl_object function;
cl_object lex_env;
cl_index index;
cl_index bds;
} *ihs_ptr;
} *ecl_ihs_ptr;
#define ecl_ihs_push(env,rec,fun,lisp_env) do { \
const cl_env_ptr __the_env = (env); \
struct ihs_frame * const r = (rec); \
ecl_ihs_ptr const r = (rec); \
r->next=__the_env->ihs_top; \
r->function=(fun); \
r->lex_env=(lisp_env); \
@ -199,7 +199,7 @@ typedef struct ihs_frame {
#define ecl_ihs_pop(env) do { \
const cl_env_ptr __the_env = (env); \
struct ihs_frame *r = __the_env->ihs_top; \
ecl_ihs_ptr r = __the_env->ihs_top; \
if (r) __the_env->ihs_top = r->next; \
} while(0)
@ -232,7 +232,7 @@ typedef struct ecl_frame {
jmp_buf frs_jmpbuf;
cl_object frs_val;
cl_index frs_bds_top_index;
ihs_ptr frs_ihs;
ecl_ihs_ptr frs_ihs;
cl_index frs_sp;
} *ecl_frame_ptr;