mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-01-15 05:43:19 -08:00
Eliminate more uses of fake variable cl_env
This commit is contained in:
Juan Jose Garcia Ripoll
parent
7c5ab4f1fb
commit
0126a558fb
11 changed files with 133 additions and 118 deletions
|
|
@ -151,6 +151,7 @@ pop_maybe_nil(cl_object *l) {
|
|||
|
||||
static cl_object
|
||||
asm_end(cl_index beginning) {
|
||||
cl_env_ptr env = ecl_process_env();
|
||||
cl_object bytecodes;
|
||||
cl_index code_size, data_size, i;
|
||||
cl_opcode *code;
|
||||
|
|
@ -169,7 +170,7 @@ asm_end(cl_index beginning) {
|
|||
bytecodes->bytecodes.file = (file == OBJNULL)? Cnil : file;
|
||||
bytecodes->bytecodes.file_position = (position == OBJNULL)? Cnil : position;
|
||||
for (i = 0, code = (cl_opcode *)bytecodes->bytecodes.code; i < code_size; i++) {
|
||||
code[i] = (cl_opcode)(cl_fixnum)cl_env.stack[beginning+i];
|
||||
code[i] = (cl_opcode)(cl_fixnum)(env->stack[beginning+i]);
|
||||
}
|
||||
for (i=0; i < data_size; i++) {
|
||||
bytecodes->bytecodes.data[i] = CAR(ENV->constants);
|
||||
|
|
@ -219,6 +220,7 @@ asm_jmp(register int op) {
|
|||
|
||||
static void
|
||||
asm_complete(register int op, register cl_index pc) {
|
||||
cl_env_ptr env = ecl_process_env();
|
||||
cl_fixnum delta = current_pc() - pc; /* [1] */
|
||||
if (op && (asm_ref(pc-1) != op))
|
||||
FEprogram_error("Non matching codes in ASM-COMPLETE2", 0);
|
||||
|
|
@ -229,14 +231,14 @@ asm_complete(register int op, register cl_index pc) {
|
|||
unsigned char low = delta & 0xFF;
|
||||
char high = delta >> 8;
|
||||
# ifdef WORDS_BIGENDIAN
|
||||
cl_env.stack[pc] = (cl_object)(cl_fixnum)high;
|
||||
cl_env.stack[pc+1] = (cl_object)(cl_fixnum)low;
|
||||
env->stack[pc] = (cl_object)(cl_fixnum)high;
|
||||
env->stack[pc+1] = (cl_object)(cl_fixnum)low;
|
||||
# else
|
||||
cl_env.stack[pc] = (cl_object)(cl_fixnum)low;
|
||||
cl_env.stack[pc+1] = (cl_object)(cl_fixnum)high;
|
||||
env->stack[pc] = (cl_object)(cl_fixnum)low;
|
||||
env->stack[pc+1] = (cl_object)(cl_fixnum)high;
|
||||
# endif
|
||||
#else
|
||||
cl_env.stack[pc] = (cl_object)(cl_fixnum)delta;
|
||||
env->stack[pc] = (cl_object)(cl_fixnum)delta;
|
||||
#endif
|
||||
}
|
||||
}
|
||||
|
|
@ -1010,7 +1012,8 @@ c_catch(cl_object args, int flags) {
|
|||
static int
|
||||
c_compiler_let(cl_object args, int flags) {
|
||||
cl_object bindings;
|
||||
cl_index old_bds_top_index = cl_env.bds_top - cl_env.bds_org;
|
||||
cl_env_ptr env = ecl_process_env();
|
||||
cl_index old_bds_top_index = env->bds_top - env->bds_org;
|
||||
|
||||
for (bindings = pop(&args); !ecl_endp(bindings); ) {
|
||||
cl_object form = pop(&bindings);
|
||||
|
|
@ -2350,7 +2353,7 @@ si_process_lambda_list(cl_object org_lambda_list, cl_object context)
|
|||
#define AT_KEYS 3
|
||||
#define AT_OTHER_KEYS 4
|
||||
#define AT_AUXS 5
|
||||
|
||||
const cl_env_ptr the_env = ecl_process_env();
|
||||
cl_object v, key, init, spp, lambda_list = org_lambda_list;
|
||||
cl_object reqs = Cnil, opts = Cnil, keys = Cnil, rest = Cnil, auxs = Cnil;
|
||||
int nreq = 0, nopt = 0, nkey = 0, naux = 0, stage = 0;
|
||||
|
|
|
|||
|
|
@ -776,10 +776,10 @@ put_return(void)
|
|||
fprintf(out, "cl_object __value%d = %s;\n", i, result[i]);
|
||||
}
|
||||
put_tabs(t);
|
||||
fprintf(out, "NVALUES = %d;\n", nres);
|
||||
fprintf(out, "the_env->nvalues = %d;\n", nres);
|
||||
for (i = nres-1; i > 0; i--) {
|
||||
put_tabs(t);
|
||||
fprintf(out, "VALUES(%d) = __value%d;\n", i, i);
|
||||
fprintf(out, "the_env->values[%d] = __value%d;\n", i, i);
|
||||
}
|
||||
put_tabs(t);
|
||||
fprintf(out, "return __value0;\n");
|
||||
|
|
|
|||
|
|
@ -22,7 +22,7 @@
|
|||
cl_object *
|
||||
_ecl_va_sp(cl_narg narg)
|
||||
{
|
||||
return cl_env.stack_top - narg;
|
||||
return ecl_process_env()->stack_top - narg;
|
||||
}
|
||||
|
||||
static cl_object
|
||||
|
|
@ -37,7 +37,7 @@ build_funcall_frame(cl_object f, cl_va_list args)
|
|||
p = (cl_object*)(args[0].args);
|
||||
#else
|
||||
cl_index i;
|
||||
p = cl_env.values;
|
||||
p = env->values;
|
||||
for (i = 0; i < n; i++) {
|
||||
p[i] = va_arg(args[0].args, cl_object);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -102,16 +102,17 @@ static cl_object doformat(cl_narg narg, cl_object strm, cl_object string, cl_va_
|
|||
static cl_object
|
||||
get_aux_stream(void)
|
||||
{
|
||||
cl_env_ptr env = ecl_process_env();
|
||||
cl_object stream;
|
||||
|
||||
ecl_disable_interrupts();
|
||||
if (cl_env.fmt_aux_stream == Cnil) {
|
||||
ecl_disable_interrupts_env(env);
|
||||
if (env->fmt_aux_stream == Cnil) {
|
||||
stream = ecl_make_string_output_stream(64);
|
||||
} else {
|
||||
stream = cl_env.fmt_aux_stream;
|
||||
cl_env.fmt_aux_stream = Cnil;
|
||||
stream = env->fmt_aux_stream;
|
||||
env->fmt_aux_stream = Cnil;
|
||||
}
|
||||
ecl_enable_interrupts();
|
||||
ecl_enable_interrupts_env(env);
|
||||
return stream;
|
||||
}
|
||||
|
||||
|
|
@ -1872,7 +1873,7 @@ doformat(cl_narg narg, cl_object strm, cl_object string, cl_va_list args, bool i
|
|||
format(&fmt, string->string.self, string->string.fillp);
|
||||
ecl_force_output(strm);
|
||||
}
|
||||
cl_env.fmt_aux_stream = fmt.aux_stream;
|
||||
ecl_process_env()->fmt_aux_stream = fmt.aux_stream;
|
||||
if (!in_formatter)
|
||||
output = Cnil;
|
||||
return output;
|
||||
|
|
|
|||
|
|
@ -746,6 +746,7 @@ cl_object (*GC_exit_hook)() = NULL;
|
|||
void
|
||||
ecl_gc(cl_type t)
|
||||
{
|
||||
const cl_env_ptr env = ecl_process_env();
|
||||
int i, j;
|
||||
int tm;
|
||||
int gc_start = ecl_runtime();
|
||||
|
|
@ -775,8 +776,8 @@ ecl_gc(cl_type t)
|
|||
#error "We need to stop all other threads"
|
||||
#endif /* THREADS */
|
||||
|
||||
interrupts = cl_env.disable_interrupts;
|
||||
cl_env.disable_interrupts = 1;
|
||||
interrupts = env->disable_interrupts;
|
||||
env->disable_interrupts = 1;
|
||||
|
||||
collect_blocks = t > t_end;
|
||||
if (collect_blocks)
|
||||
|
|
@ -863,7 +864,7 @@ ecl_gc(cl_type t)
|
|||
fflush(stdout);
|
||||
}
|
||||
|
||||
cl_env.disable_interrupts = interrupts;
|
||||
env->disable_interrupts = interrupts;
|
||||
|
||||
if (GC_exit_hook != NULL)
|
||||
(*GC_exit_hook)();
|
||||
|
|
@ -884,7 +885,7 @@ ecl_gc(cl_type t)
|
|||
fflush(stdout);
|
||||
}
|
||||
|
||||
if (cl_env.interrupt_pending) ecl_check_pending_interrupts();
|
||||
if (env->interrupt_pending) ecl_check_pending_interrupts();
|
||||
}
|
||||
|
||||
/*
|
||||
|
|
|
|||
29
src/c/gfun.d
29
src/c/gfun.d
|
|
@ -201,8 +201,9 @@ vector_hash_key(cl_object keys)
|
|||
*/
|
||||
|
||||
static cl_object *
|
||||
search_method_hash(cl_object keys, cl_object table)
|
||||
search_method_hash(cl_env_ptr env, cl_object keys)
|
||||
{
|
||||
cl_object table = env->method_hash;
|
||||
cl_index argno = keys->vector.fillp;
|
||||
cl_index i = vector_hash_key(keys);
|
||||
cl_index total_size = table->vector.dim;
|
||||
|
|
@ -211,7 +212,7 @@ search_method_hash(cl_object keys, cl_object table)
|
|||
int k;
|
||||
i = i % total_size;
|
||||
i = i - (i % 3);
|
||||
min_gen = cl_env.method_generation;
|
||||
min_gen = env->method_generation;
|
||||
min_e = 0;
|
||||
for (k = 20; k--; ) {
|
||||
cl_object *e = table->vector.self.t + i;
|
||||
|
|
@ -253,7 +254,7 @@ search_method_hash(cl_object keys, cl_object table)
|
|||
ecl_internal_error("search_method_hash");
|
||||
}
|
||||
RECORD_KEY(min_e) = OBJNULL;
|
||||
cl_env.method_generation++;
|
||||
env->method_generation++;
|
||||
FOUND:
|
||||
/*
|
||||
* Once we have reached here, we set the new generation of
|
||||
|
|
@ -261,12 +262,12 @@ search_method_hash(cl_object keys, cl_object table)
|
|||
* generation number does not become too large and we can
|
||||
* expire some elements.
|
||||
*/
|
||||
gen = cl_env.method_generation;
|
||||
gen = env->method_generation;
|
||||
RECORD_GEN_SET(min_e, gen);
|
||||
if (gen >= total_size/2) {
|
||||
cl_object *e = table->vector.self.t;
|
||||
gen = 0.5*gen;
|
||||
cl_env.method_generation -= gen;
|
||||
env->method_generation -= gen;
|
||||
for (i = table->vector.dim; i; i-= 3, e += 3) {
|
||||
cl_fixnum g = RECORD_GEN(e) - gen;
|
||||
if (g <= 0) {
|
||||
|
|
@ -281,12 +282,12 @@ search_method_hash(cl_object keys, cl_object table)
|
|||
}
|
||||
|
||||
static cl_object
|
||||
get_spec_vector(cl_object frame, cl_object gf)
|
||||
get_spec_vector(cl_env_ptr env, cl_object frame, cl_object gf)
|
||||
{
|
||||
cl_object *args = frame->frame.bottom;
|
||||
cl_index narg = frame->frame.top - args;
|
||||
cl_object spec_how_list = GFUN_SPEC(gf);
|
||||
cl_object vector = cl_env.method_spec_vector;
|
||||
cl_object vector = env->method_spec_vector;
|
||||
cl_object *argtype = vector->vector.self.t;
|
||||
int spec_no = 1;
|
||||
argtype[0] = gf;
|
||||
|
|
@ -331,6 +332,7 @@ compute_applicable_method(cl_object frame, cl_object gf)
|
|||
cl_object
|
||||
_ecl_standard_dispatch(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
|
||||
|
|
@ -346,23 +348,22 @@ _ecl_standard_dispatch(cl_object frame, cl_object gf)
|
|||
|
||||
#ifdef ECL_THREADS
|
||||
/* See whether we have to clear the hash from some generic functions right now. */
|
||||
if (cl_env.method_hash_clear_list != Cnil) {
|
||||
if (env->method_hash_clear_list != Cnil) {
|
||||
cl_object clear_list;
|
||||
THREAD_OP_LOCK();
|
||||
clear_list = cl_env.method_hash_clear_list;
|
||||
clear_list = env->method_hash_clear_list;
|
||||
loop_for_on_unsafe(clear_list) {
|
||||
do_clear_method_hash(&cl_env, ECL_CONS_CAR(clear_list));
|
||||
} end_loop_for_on;
|
||||
cl_env.method_hash_clear_list = Cnil;
|
||||
env->method_hash_clear_list = Cnil;
|
||||
THREAD_OP_UNLOCK();
|
||||
}
|
||||
#endif
|
||||
vector = get_spec_vector(frame, gf);
|
||||
vector = get_spec_vector(env, frame, gf);
|
||||
if (vector == OBJNULL) {
|
||||
func = compute_applicable_method(frame, gf);
|
||||
} else {
|
||||
cl_object table = cl_env.method_hash;
|
||||
cl_object *e = search_method_hash(vector, table);
|
||||
cl_object *e = search_method_hash(env, vector);
|
||||
if (RECORD_KEY(e) != OBJNULL) {
|
||||
func = RECORD_VALUE(e);
|
||||
} else {
|
||||
|
|
@ -371,7 +372,7 @@ _ecl_standard_dispatch(cl_object frame, cl_object gf)
|
|||
if (RECORD_KEY(e) != OBJNULL) {
|
||||
/* The cache might have changed while we
|
||||
* computed applicable methods */
|
||||
e = search_method_hash(vector, table);
|
||||
e = search_method_hash(env, vector);
|
||||
}
|
||||
RECORD_KEY(e) = keys;
|
||||
RECORD_VALUE(e) = func;
|
||||
|
|
|
|||
128
src/c/print.d
128
src/c/print.d
|
|
@ -73,59 +73,60 @@ static void flush_queue(bool force, cl_object stream);
|
|||
static void
|
||||
writec_queue(int c, cl_object stream)
|
||||
{
|
||||
if (cl_env.qc >= ECL_PPRINT_QUEUE_SIZE)
|
||||
const cl_env_ptr env = ecl_process_env();
|
||||
if (env->qc >= ECL_PPRINT_QUEUE_SIZE)
|
||||
flush_queue(FALSE, stream);
|
||||
if (cl_env.qc >= ECL_PPRINT_QUEUE_SIZE)
|
||||
if (env->qc >= ECL_PPRINT_QUEUE_SIZE)
|
||||
FEerror("Can't pretty-print.", 0);
|
||||
cl_env.queue[cl_env.qt] = c;
|
||||
cl_env.qt = mod(cl_env.qt+1);
|
||||
cl_env.qc++;
|
||||
env->queue[env->qt] = c;
|
||||
env->qt = mod(env->qt+1);
|
||||
env->qc++;
|
||||
}
|
||||
|
||||
static void
|
||||
flush_queue(bool force, cl_object stream)
|
||||
{
|
||||
const cl_env_ptr env = ecl_process_env();
|
||||
int c, i, j, k, l, i0;
|
||||
|
||||
BEGIN:
|
||||
while (cl_env.qc > 0) {
|
||||
c = cl_env.queue[cl_env.qh];
|
||||
while (env->qc > 0) {
|
||||
c = env->queue[env->qh];
|
||||
if (c < 0400) {
|
||||
ecl_write_char(c, stream);
|
||||
} else if (c == MARK)
|
||||
goto DO_MARK;
|
||||
else if (c == UNMARK)
|
||||
cl_env.isp -= 2;
|
||||
env->isp -= 2;
|
||||
else if (c == SET_INDENT)
|
||||
cl_env.indent_stack[cl_env.isp] = ecl_file_column(stream);
|
||||
env->indent_stack[env->isp] = ecl_file_column(stream);
|
||||
else if (c == INDENT) {
|
||||
goto DO_INDENT;
|
||||
} else if (c == INDENT1) {
|
||||
i = ecl_file_column(stream)-cl_env.indent_stack[cl_env.isp];
|
||||
if (i < 8 && cl_env.indent_stack[cl_env.isp] < LINE_LENGTH/2) {
|
||||
i = ecl_file_column(stream)-env->indent_stack[env->isp];
|
||||
if (i < 8 && env->indent_stack[env->isp] < LINE_LENGTH/2) {
|
||||
ecl_write_char(' ', stream);
|
||||
cl_env.indent_stack[cl_env.isp]
|
||||
env->indent_stack[env->isp]
|
||||
= ecl_file_column(stream);
|
||||
} else {
|
||||
if (cl_env.indent_stack[cl_env.isp] < LINE_LENGTH/2) {
|
||||
cl_env.indent_stack[cl_env.isp]
|
||||
= cl_env.indent_stack[cl_env.isp-1] + 4;
|
||||
if (env->indent_stack[env->isp] < LINE_LENGTH/2) {
|
||||
env->indent_stack[env->isp]
|
||||
= env->indent_stack[env->isp-1] + 4;
|
||||
}
|
||||
goto DO_INDENT;
|
||||
}
|
||||
} else if (c == INDENT2) {
|
||||
cl_env.indent_stack[cl_env.isp] = cl_env.indent_stack[cl_env.isp-1] + 2;
|
||||
env->indent_stack[env->isp] = env->indent_stack[env->isp-1] + 2;
|
||||
goto PUT_INDENT;
|
||||
}
|
||||
cl_env.qh = mod(cl_env.qh+1);
|
||||
--cl_env.qc;
|
||||
env->qh = mod(env->qh+1);
|
||||
--env->qc;
|
||||
}
|
||||
return;
|
||||
|
||||
DO_MARK:
|
||||
k = LINE_LENGTH - 1 - ecl_file_column(stream);
|
||||
for (i = 1, j = 0, l = 1; l > 0 && i < cl_env.qc && j < k; i++) {
|
||||
c = cl_env.queue[mod(cl_env.qh + i)];
|
||||
for (i = 1, j = 0, l = 1; l > 0 && i < env->qc && j < k; i++) {
|
||||
c = env->queue[mod(env->qh + i)];
|
||||
if (c == MARK)
|
||||
l++;
|
||||
else if (c == UNMARK)
|
||||
|
|
@ -137,23 +138,23 @@ DO_MARK:
|
|||
}
|
||||
if (l == 0)
|
||||
goto FLUSH;
|
||||
if (i == cl_env.qc && !force)
|
||||
if (i == env->qc && !force)
|
||||
return;
|
||||
cl_env.qh = mod(cl_env.qh+1);
|
||||
--cl_env.qc;
|
||||
if (cl_env.isp >= ECL_PPRINT_INDENTATION_STACK_SIZE-2)
|
||||
env->qh = mod(env->qh+1);
|
||||
--env->qc;
|
||||
if (env->isp >= ECL_PPRINT_INDENTATION_STACK_SIZE-2)
|
||||
FEerror("Can't pretty-print.", 0);
|
||||
cl_env.isp+=2;
|
||||
cl_env.indent_stack[cl_env.isp-1] = ecl_file_column(stream);
|
||||
cl_env.indent_stack[cl_env.isp] = cl_env.indent_stack[cl_env.isp-1];
|
||||
env->isp+=2;
|
||||
env->indent_stack[env->isp-1] = ecl_file_column(stream);
|
||||
env->indent_stack[env->isp] = env->indent_stack[env->isp-1];
|
||||
goto BEGIN;
|
||||
|
||||
DO_INDENT:
|
||||
if (cl_env.iisp > cl_env.isp)
|
||||
if (env->iisp > env->isp)
|
||||
goto PUT_INDENT;
|
||||
k = LINE_LENGTH - 1 - ecl_file_column(stream);
|
||||
for (i0 = 0, i = 1, j = 0, l = 1; i < cl_env.qc && j < k; i++) {
|
||||
c = cl_env.queue[mod(cl_env.qh + i)];
|
||||
for (i0 = 0, i = 1, j = 0, l = 1; i < env->qc && j < k; i++) {
|
||||
c = env->queue[mod(env->qh + i)];
|
||||
if (c == MARK)
|
||||
l++;
|
||||
else if (c == UNMARK) {
|
||||
|
|
@ -179,7 +180,7 @@ DO_INDENT:
|
|||
} else if (c < 0400)
|
||||
j++;
|
||||
}
|
||||
if (i == cl_env.qc && !force)
|
||||
if (i == env->qc && !force)
|
||||
return;
|
||||
if (i0 == 0)
|
||||
goto PUT_INDENT;
|
||||
|
|
@ -187,23 +188,23 @@ DO_INDENT:
|
|||
goto FLUSH;
|
||||
|
||||
PUT_INDENT:
|
||||
cl_env.qh = mod(cl_env.qh+1);
|
||||
--cl_env.qc;
|
||||
env->qh = mod(env->qh+1);
|
||||
--env->qc;
|
||||
ecl_write_char('\n', stream);
|
||||
for (i = cl_env.indent_stack[cl_env.isp]; i > 0; --i)
|
||||
for (i = env->indent_stack[env->isp]; i > 0; --i)
|
||||
ecl_write_char(' ', stream);
|
||||
cl_env.iisp = cl_env.isp;
|
||||
env->iisp = env->isp;
|
||||
goto BEGIN;
|
||||
|
||||
FLUSH:
|
||||
for (j = 0; j < i; j++) {
|
||||
c = cl_env.queue[cl_env.qh];
|
||||
c = env->queue[env->qh];
|
||||
if (c == INDENT || c == INDENT1 || c == INDENT2)
|
||||
ecl_write_char(' ', stream);
|
||||
else if (c < 0400)
|
||||
ecl_write_char(c, stream);
|
||||
cl_env.qh = mod(cl_env.qh+1);
|
||||
--cl_env.qc;
|
||||
env->qh = mod(env->qh+1);
|
||||
--env->qc;
|
||||
}
|
||||
goto BEGIN;
|
||||
}
|
||||
|
|
@ -211,7 +212,8 @@ FLUSH:
|
|||
static void
|
||||
write_ch(int c, cl_object stream)
|
||||
{
|
||||
if (cl_env.print_pretty)
|
||||
const cl_env_ptr env = ecl_process_env();
|
||||
if (env->print_pretty)
|
||||
writec_queue(c, stream);
|
||||
else if (c == INDENT || c == INDENT1)
|
||||
ecl_write_char(' ', stream);
|
||||
|
|
@ -226,18 +228,19 @@ call_print_object(cl_object x, cl_object stream)
|
|||
call_structure_print_function(cl_object f, cl_object x, cl_object stream)
|
||||
#endif
|
||||
{
|
||||
const cl_env_ptr env = ecl_process_env();
|
||||
short ois[ECL_PPRINT_INDENTATION_STACK_SIZE];
|
||||
volatile bool p = cl_env.print_pretty;
|
||||
volatile bool p = env->print_pretty;
|
||||
volatile int oqh, oqt, oqc, oisp, oiisp;
|
||||
|
||||
if ((p = cl_env.print_pretty)) {
|
||||
if ((p = env->print_pretty)) {
|
||||
flush_queue(TRUE, stream);
|
||||
oqh = cl_env.qh;
|
||||
oqt = cl_env.qt;
|
||||
oqc = cl_env.qc;
|
||||
oisp = cl_env.isp;
|
||||
oiisp = cl_env.iisp;
|
||||
memcpy(ois, cl_env.indent_stack, cl_env.isp * sizeof(*ois));
|
||||
oqh = env->qh;
|
||||
oqt = env->qt;
|
||||
oqc = env->qc;
|
||||
oisp = env->isp;
|
||||
oiisp = env->iisp;
|
||||
memcpy(ois, env->indent_stack, env->isp * sizeof(*ois));
|
||||
}
|
||||
CL_UNWIND_PROTECT_BEGIN {
|
||||
#ifdef CLOS
|
||||
|
|
@ -246,13 +249,13 @@ call_structure_print_function(cl_object f, cl_object x, cl_object stream)
|
|||
funcall(4, f, x, stream, MAKE_FIXNUM(0));
|
||||
#endif
|
||||
} CL_UNWIND_PROTECT_EXIT {
|
||||
if ((cl_env.print_pretty = p)) {
|
||||
memcpy(cl_env.indent_stack, ois, oisp * sizeof(*ois));
|
||||
cl_env.iisp = oiisp;
|
||||
cl_env.isp = oisp;
|
||||
cl_env.qc = oqc;
|
||||
cl_env.qt = oqt;
|
||||
cl_env.qh = oqh;
|
||||
if ((env->print_pretty = p)) {
|
||||
memcpy(env->indent_stack, ois, oisp * sizeof(*ois));
|
||||
env->iisp = oiisp;
|
||||
env->isp = oisp;
|
||||
env->qc = oqc;
|
||||
env->qt = oqt;
|
||||
env->qh = oqh;
|
||||
}
|
||||
} CL_UNWIND_PROTECT_END;
|
||||
}
|
||||
|
|
@ -1251,7 +1254,7 @@ si_write_ugly_object(cl_object x, cl_object stream)
|
|||
write_ch('(', stream);
|
||||
WRITE_SET_INDENT(stream);
|
||||
#if !defined(ECL_CMU_FORMAT)
|
||||
if (cl_env.print_pretty && CAR(x) != OBJNULL &&
|
||||
if (ecl_process_env()->print_pretty && CAR(x) != OBJNULL &&
|
||||
type_of(CAR(x)) == t_symbol &&
|
||||
(r = si_get_sysprop(CAR(x), @'si::pretty-print-format')) != Cnil)
|
||||
goto PRETTY_PRINT_FORMAT;
|
||||
|
|
@ -1673,16 +1676,17 @@ si_write_object_recursive(cl_object x, cl_object stream)
|
|||
#if !defined(ECL_CMU_FORMAT)
|
||||
cl_object
|
||||
si_write_object(cl_object x, cl_object stream) {
|
||||
const cl_env_ptr env = ecl_process_env();
|
||||
if (ecl_symbol_value(@'*print-pretty*') == Cnil) {
|
||||
cl_env.print_pretty = 0;
|
||||
env->print_pretty = 0;
|
||||
} else {
|
||||
cl_env.print_pretty = 1;
|
||||
cl_env.qh = cl_env.qt = cl_env.qc = 0;
|
||||
cl_env.isp = cl_env.iisp = 0;
|
||||
cl_env.indent_stack[0] = 0;
|
||||
env->print_pretty = 1;
|
||||
env->qh = env->qt = env->qc = 0;
|
||||
env->isp = env->iisp = 0;
|
||||
env->indent_stack[0] = 0;
|
||||
}
|
||||
si_write_object_recursive(x, stream);
|
||||
if (cl_env.print_pretty)
|
||||
if (env->print_pretty)
|
||||
flush_queue(TRUE, stream);
|
||||
}
|
||||
#endif /* !ECL_CMU_FORMAT */
|
||||
|
|
|
|||
10
src/c/read.d
10
src/c/read.d
|
|
@ -43,13 +43,14 @@ read_table_entry(cl_object rdtbl, cl_object c);
|
|||
cl_object
|
||||
si_get_buffer_string()
|
||||
{
|
||||
cl_object pool = cl_env.string_pool;
|
||||
const cl_env_ptr env = ecl_process_env();
|
||||
cl_object pool = env->string_pool;
|
||||
cl_object output;
|
||||
if (pool == Cnil) {
|
||||
output = cl_alloc_adjustable_base_string(ECL_BUFFER_STRING_SIZE);
|
||||
} else {
|
||||
output = CAR(pool);
|
||||
cl_env.string_pool = CDR(pool);
|
||||
env->string_pool = CDR(pool);
|
||||
}
|
||||
output->base_string.fillp = 0;
|
||||
@(return output)
|
||||
|
|
@ -59,7 +60,8 @@ cl_object
|
|||
si_put_buffer_string(cl_object string)
|
||||
{
|
||||
if (string != Cnil) {
|
||||
cl_object pool = cl_env.string_pool;
|
||||
const cl_env_ptr env = ecl_process_env();
|
||||
cl_object pool = env->string_pool;
|
||||
cl_index l = 0;
|
||||
if (pool != Cnil) {
|
||||
/* We store the size of the pool in the string index */
|
||||
|
|
@ -71,7 +73,7 @@ si_put_buffer_string(cl_object string)
|
|||
string = cl_alloc_adjustable_base_string(ECL_BUFFER_STRING_SIZE);
|
||||
}
|
||||
string->base_string.fillp = l+1;
|
||||
cl_env.string_pool = CONS(string, pool);
|
||||
env->string_pool = CONS(string, pool);
|
||||
}
|
||||
}
|
||||
@(return)
|
||||
|
|
|
|||
|
|
@ -79,7 +79,7 @@ void
|
|||
bds_bind(cl_object s, cl_object value)
|
||||
{
|
||||
cl_env_ptr env = ecl_process_env();
|
||||
struct ecl_hashtable_entry *h = ecl_search_hash(s, cl_env.bindings_hash);
|
||||
struct ecl_hashtable_entry *h = ecl_search_hash(s, env->bindings_hash);
|
||||
struct bds_bd *slot = ++env->bds_top;
|
||||
if (slot >= env->bds_limit) {
|
||||
bds_overflow();
|
||||
|
|
|
|||
|
|
@ -91,7 +91,7 @@ ecl_set_process_env(cl_env_ptr env)
|
|||
cl_object
|
||||
mp_current_process(void)
|
||||
{
|
||||
return cl_env.own_process;
|
||||
return ecl_process_env()->own_process;
|
||||
}
|
||||
|
||||
/*----------------------------------------------------------------------
|
||||
|
|
@ -119,7 +119,7 @@ thread_cleanup(void *env)
|
|||
* mp_process_kill().
|
||||
*/
|
||||
THREAD_OP_LOCK();
|
||||
cl_core.processes = ecl_remove_eq(cl_env.own_process,
|
||||
cl_core.processes = ecl_remove_eq(mp_current_process(),
|
||||
cl_core.processes);
|
||||
THREAD_OP_UNLOCK();
|
||||
}
|
||||
|
|
@ -177,6 +177,7 @@ alloc_process(cl_object name)
|
|||
static void
|
||||
initialize_process_bindings(cl_object process, cl_object initial_bindings)
|
||||
{
|
||||
const cl_env_ptr this_env = ecl_process_env();
|
||||
cl_object hash;
|
||||
/* FIXME! Here we should either use INITIAL-BINDINGS or copy lexical
|
||||
* bindings */
|
||||
|
|
@ -186,7 +187,7 @@ initialize_process_bindings(cl_object process, cl_object initial_bindings)
|
|||
ecl_make_singlefloat(0.7),
|
||||
Cnil); /* no need for locking */
|
||||
} else {
|
||||
hash = si_copy_hash_table(cl_env.bindings_hash);
|
||||
hash = si_copy_hash_table(this_env->bindings_hash);
|
||||
}
|
||||
process->process.env->bindings_hash = hash;
|
||||
}
|
||||
|
|
@ -338,7 +339,7 @@ mp_exit_process(void)
|
|||
back to the thread entry point, going through all possible
|
||||
UNWIND-PROTECT.
|
||||
*/
|
||||
ecl_unwind(cl_env.frs_org);
|
||||
ecl_unwind(ecl_process_env()->frs_org);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -449,12 +450,13 @@ mp_lock_holder(cl_object lock)
|
|||
cl_object
|
||||
mp_giveup_lock(cl_object lock)
|
||||
{
|
||||
cl_object own_process = mp_current_process();
|
||||
int code;
|
||||
if (type_of(lock) != t_lock)
|
||||
FEwrong_type_argument(@'mp::lock', lock);
|
||||
if (lock->lock.holder != cl_env.own_process) {
|
||||
if (lock->lock.holder != own_process) {
|
||||
FEerror("Attempt to give up a lock ~S that is not owned by ~S.", 2,
|
||||
lock, cl_env.own_process);
|
||||
lock, own_process);
|
||||
}
|
||||
if (--lock->lock.counter == 0) {
|
||||
lock->lock.holder = Cnil;
|
||||
|
|
@ -476,13 +478,13 @@ mp_giveup_lock(cl_object lock)
|
|||
FEwrong_type_argument(@'mp::lock', lock);
|
||||
/* In Windows, all locks are recursive. We simulate the other case. */
|
||||
/* We will complain always if recursive=0 and try to lock recursively. */
|
||||
if (!lock->lock.recursive && (lock->lock.holder == cl_env.own_process)) {
|
||||
if (!lock->lock.recursive && (lock->lock.holder == the_env->own_process)) {
|
||||
FEerror("A recursive attempt was made to hold lock ~S", 1, lock);
|
||||
}
|
||||
#ifdef ECL_WINDOWS_THREADS
|
||||
switch (WaitForSingleObject(lock->lock.mutex, (wait==Ct?INFINITE:0))) {
|
||||
case WAIT_OBJECT_0:
|
||||
lock->lock.holder = cl_env.own_process;
|
||||
lock->lock.holder = env->own_process;
|
||||
lock->lock.counter++;
|
||||
output = Ct;
|
||||
break;
|
||||
|
|
@ -503,7 +505,7 @@ mp_giveup_lock(cl_object lock)
|
|||
rc = pthread_mutex_trylock(&lock->lock.mutex);
|
||||
}
|
||||
if (rc == 0) {
|
||||
lock->lock.holder = cl_env.own_process;
|
||||
lock->lock.holder = the_env->own_process;
|
||||
lock->lock.counter++;
|
||||
output = Ct;
|
||||
} else {
|
||||
|
|
@ -548,7 +550,7 @@ mp_condition_variable_wait(cl_object cv, cl_object lock)
|
|||
FEwrong_type_argument(@'mp::lock', lock);
|
||||
if (pthread_cond_wait(&cv->condition_variable.cv,
|
||||
&lock->lock.mutex) == 0)
|
||||
lock->lock.holder = cl_env.own_process;
|
||||
lock->lock.holder = mp_current_process();
|
||||
#endif
|
||||
@(return Ct)
|
||||
}
|
||||
|
|
@ -589,7 +591,7 @@ mp_condition_variable_timedwait(cl_object cv, cl_object lock, cl_object seconds)
|
|||
}
|
||||
if (pthread_cond_timedwait(&cv->condition_variable.cv,
|
||||
&lock->lock.mutex, &ts) == 0) {
|
||||
lock->lock.holder = cl_env.own_process;
|
||||
lock->lock.holder = mp_current_process();
|
||||
@(return Ct)
|
||||
} else {
|
||||
@(return Cnil)
|
||||
|
|
|
|||
|
|
@ -456,11 +456,12 @@ si_check_pending_interrupts(void)
|
|||
void
|
||||
ecl_check_pending_interrupts(void)
|
||||
{
|
||||
const cl_env_ptr env = ecl_process_env();
|
||||
int sig;
|
||||
void *info;
|
||||
cl_env.disable_interrupts = 0;
|
||||
info = cl_env.interrupt_info;
|
||||
sig = cl_env.interrupt_pending;
|
||||
env->disable_interrupts = 0;
|
||||
info = env->interrupt_info;
|
||||
sig = env->interrupt_pending;
|
||||
if (sig) {
|
||||
call_handler(handle_signal_now, sig, info, 0);
|
||||
}
|
||||
|
|
@ -647,6 +648,6 @@ init_unixint(int pass)
|
|||
si_trap_fpe(Ct, Ct);
|
||||
}
|
||||
#endif
|
||||
cl_env.disable_interrupts = 0;
|
||||
ecl_process_env()->disable_interrupts = 0;
|
||||
}
|
||||
}
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue