Since dpp now generates code that uses 'the_env', it has to be defined in functions that use @(return)

This commit is contained in:
Juan Jose Garcia Ripoll 2008-10-11 23:47:40 +02:00
parent ed584a62c5
commit 5a41a55a2d
12 changed files with 41 additions and 2 deletions

View file

@ -435,6 +435,7 @@ si_set_finalizer(cl_object o, cl_object finalizer)
cl_object
si_gc_stats(cl_object enable)
{
const cl_env_ptr the_env = ecl_process_env();
cl_object old_status = cl_core.gc_stats? Ct : Cnil;
cl_core.gc_stats = (enable != Cnil);
if (cl_core.bytes_consed == Cnil) {
@ -585,6 +586,7 @@ ecl_register_root(cl_object *p)
cl_object
si_gc(cl_object area)
{
const cl_env_ptr the_env = ecl_process_env();
ecl_disable_interrupts();
GC_gcollect();
ecl_enable_interrupts();
@ -594,6 +596,7 @@ si_gc(cl_object area)
cl_object
si_gc_dump()
{
const cl_env_ptr the_env = ecl_process_env();
ecl_disable_interrupts();
GC_dump();
ecl_enable_interrupts();

View file

@ -736,6 +736,7 @@ cl_adjustable_array_p(cl_object a)
cl_object
cl_array_displacement(cl_object a)
{
const cl_env_ptr the_env = ecl_process_env();
cl_object to_array;
cl_index offset;
@ -787,6 +788,7 @@ cl_array_displacement(cl_object a)
cl_object
cl_svref(cl_object x, cl_object index)
{
const cl_env_ptr the_env = ecl_process_env();
cl_index i;
while (type_of(x) != t_vector ||
@ -804,6 +806,7 @@ cl_svref(cl_object x, cl_object index)
cl_object
si_svset(cl_object x, cl_object index, cl_object v)
{
const cl_env_ptr the_env = ecl_process_env();
cl_index i;
while (type_of(x) != t_vector ||
@ -821,6 +824,7 @@ si_svset(cl_object x, cl_object index, cl_object v)
cl_object
cl_array_has_fill_pointer_p(cl_object a)
{
const cl_env_ptr the_env = ecl_process_env();
cl_object r;
AGAIN:
switch (type_of(a)) {
@ -845,6 +849,7 @@ cl_array_has_fill_pointer_p(cl_object a)
cl_object
cl_fill_pointer(cl_object a)
{
const cl_env_ptr the_env = ecl_process_env();
assert_type_vector(a);
if (!a->vector.hasfillp) {
a = ecl_type_error(@'fill-pointer', "argument",
@ -859,6 +864,7 @@ cl_fill_pointer(cl_object a)
cl_object
si_fill_pointer_set(cl_object a, cl_object fp)
{
const cl_env_ptr the_env = ecl_process_env();
assert_type_vector(a);
AGAIN:
if (a->vector.hasfillp) {
@ -881,6 +887,7 @@ si_fill_pointer_set(cl_object a, cl_object fp)
cl_object
si_replace_array(cl_object olda, cl_object newa)
{
const cl_env_ptr the_env = ecl_process_env();
cl_object dlist;
if (type_of(olda) != type_of(newa)
|| (type_of(olda) == t_array && olda->array.rank != newa->array.rank))

View file

@ -116,6 +116,7 @@ ecl_clear_compiler_properties(cl_object sym)
cl_object
si_get_sysprop(cl_object sym, cl_object prop)
{
cl_env_ptr the_env = ecl_process_env();
cl_object plist = ecl_gethash_safe(sym, cl_core.system_properties, Cnil);
prop = ecl_getf(plist, prop, OBJNULL);
if (prop == OBJNULL) {

View file

@ -85,6 +85,7 @@ cl_def_c_function_va(cl_object sym, void *c_function)
cl_object
si_compiled_function_name(cl_object fun)
{
cl_env_ptr the_env = ecl_process_env();
cl_object output;
switch(type_of(fun)) {
@ -106,6 +107,7 @@ si_compiled_function_name(cl_object fun)
cl_object
cl_function_lambda_expression(cl_object fun)
{
cl_env_ptr the_env = ecl_process_env();
cl_object output, name = Cnil, lex = Cnil;
switch(type_of(fun)) {

View file

@ -629,6 +629,7 @@ si_bc_disassemble(cl_object v)
cl_object
si_bc_split(cl_object b)
{
const cl_env_ptr the_env = ecl_process_env();
cl_object vector;
cl_object data;
cl_object lex = Cnil;
@ -649,6 +650,7 @@ si_bc_split(cl_object b)
cl_object
si_bc_file(cl_object b)
{
cl_env_ptr the_env = ecl_process_env();
if (type_of(b) == t_bclosure) {
b = b->bclosure.code;
}

View file

@ -579,6 +579,7 @@ cl_hash_table_count(cl_object ht)
static cl_object
si_hash_table_iterate(cl_narg narg, cl_object env)
{
const cl_env_ptr the_env = ecl_process_env();
cl_object index = CAR(env);
cl_object ht = CADR(env);
cl_fixnum i;

View file

@ -126,6 +126,7 @@ cl_numerator(cl_object x)
cl_object
cl_denominator(cl_object x)
{
const cl_env_ptr the_env = ecl_process_env();
AGAIN:
switch (type_of(x)) {
case t_ratio:
@ -145,6 +146,7 @@ cl_denominator(cl_object x)
cl_object
ecl_floor1(cl_object x)
{
const cl_env_ptr the_env = ecl_process_env();
cl_object v0, v1;
AGAIN:
switch (type_of(x)) {
@ -199,6 +201,7 @@ ecl_floor1(cl_object x)
cl_object
ecl_floor2(cl_object x, cl_object y)
{
const cl_env_ptr the_env = ecl_process_env();
cl_object v0, v1;
cl_type ty;
AGAIN:
@ -425,6 +428,7 @@ ecl_floor2(cl_object x, cl_object y)
cl_object
ecl_ceiling1(cl_object x)
{
const cl_env_ptr the_env = ecl_process_env();
cl_object v0, v1;
AGAIN:
switch (type_of(x)) {
@ -479,6 +483,7 @@ ecl_ceiling1(cl_object x)
cl_object
ecl_ceiling2(cl_object x, cl_object y)
{
const cl_env_ptr the_env = ecl_process_env();
cl_object v0, v1;
cl_type ty;
AGAIN:
@ -705,6 +710,7 @@ ecl_ceiling2(cl_object x, cl_object y)
cl_object
ecl_truncate1(cl_object x)
{
const cl_env_ptr the_env = ecl_process_env();
cl_object v0, v1;
AGAIN:
switch (type_of(x)) {
@ -759,6 +765,7 @@ ecl_truncate1(cl_object x)
cl_object
ecl_truncate2(cl_object x, cl_object y)
{
const cl_env_ptr the_env = ecl_process_env();
if (ecl_plusp(x) != ecl_plusp(y))
return ecl_ceiling2(x, y);
else
@ -817,6 +824,7 @@ round_long_double(long double d)
cl_object
ecl_round1(cl_object x)
{
const cl_env_ptr the_env = ecl_process_env();
cl_object v0, v1;
AGAIN:
switch (type_of(x)) {
@ -867,6 +875,7 @@ ecl_round1(cl_object x)
cl_object
ecl_round2(cl_object x, cl_object y)
{
const cl_env_ptr the_env = ecl_process_env();
cl_object v0, v1;
cl_object q;
@ -915,6 +924,7 @@ ecl_round2(cl_object x, cl_object y)
cl_object
cl_mod(cl_object x, cl_object y)
{
const cl_env_ptr the_env = ecl_process_env();
/* INV: #'floor always outputs two values */
@floor(2, x, y);
@(return VALUES(1))
@ -923,6 +933,7 @@ cl_mod(cl_object x, cl_object y)
cl_object
cl_rem(cl_object x, cl_object y)
{
const cl_env_ptr the_env = ecl_process_env();
@truncate(2, x, y);
@(return VALUES(1))
}
@ -930,6 +941,7 @@ cl_rem(cl_object x, cl_object y)
cl_object
cl_decode_float(cl_object x)
{
const cl_env_ptr the_env = ecl_process_env();
int e, s;
cl_type tx = type_of(x);
float f;
@ -989,6 +1001,7 @@ cl_decode_float(cl_object x)
cl_object
cl_scale_float(cl_object x, cl_object y)
{
const cl_env_ptr the_env = ecl_process_env();
cl_fixnum k;
AGAIN:
if (FIXNUMP(y)) {
@ -1024,6 +1037,7 @@ cl_scale_float(cl_object x, cl_object y)
cl_object
cl_float_radix(cl_object x)
{
const cl_env_ptr the_env = ecl_process_env();
while (cl_floatp(x) != Ct) {
x = ecl_type_error(@'float-radix',"argument",x,@'float');
}
@ -1093,6 +1107,7 @@ cl_float_radix(cl_object x)
cl_object
cl_float_digits(cl_object x)
{
const cl_env_ptr the_env = ecl_process_env();
AGAIN:
switch (type_of(x)) {
#ifdef ECL_SHORT_FLOAT
@ -1119,6 +1134,7 @@ cl_float_digits(cl_object x)
cl_object
cl_float_precision(cl_object x)
{
const cl_env_ptr the_env = ecl_process_env();
int precision;
float f; double d;
AGAIN:
@ -1197,6 +1213,7 @@ cl_float_precision(cl_object x)
cl_object
cl_integer_decode_float(cl_object x)
{
const cl_env_ptr the_env = ecl_process_env();
int e, s;
AGAIN:
switch (type_of(x)) {
@ -1297,6 +1314,7 @@ cl_integer_decode_float(cl_object x)
cl_object
cl_realpart(cl_object x)
{
const cl_env_ptr the_env = ecl_process_env();
AGAIN:
switch (type_of(x)) {
case t_fixnum:
@ -1324,6 +1342,7 @@ cl_realpart(cl_object x)
cl_object
cl_imagpart(cl_object x)
{
const cl_env_ptr the_env = ecl_process_env();
AGAIN:
switch (type_of(x)) {
case t_fixnum:

View file

@ -1051,6 +1051,7 @@ BEGIN:
cl_object
si_package_hash_tables(cl_object p)
{
const cl_env_ptr the_env = ecl_process_env();
cl_object he, hi, u;
assert_type_package(p);
PACKAGE_LOCK(p);

View file

@ -288,6 +288,7 @@ cl_symbol_plist(cl_object sym)
cl_object
cl_get_properties(cl_object place, cl_object indicator_list)
{
const cl_env_ptr the_env = ecl_process_env();
cl_object l;
#ifdef ECL_SAFE
@ -408,6 +409,7 @@ cl_keywordp(cl_object sym)
cl_object
si_rem_f(cl_object plist, cl_object indicator)
{
cl_env_ptr the_env = ecl_process_env();
bool found = remf(&plist, indicator);
@(return plist (found? Ct : Cnil))
}

View file

@ -351,6 +351,7 @@ si_open_unix_socket_stream(cl_object path)
cl_object
si_lookup_host_entry(cl_object host_or_address)
{
const cl_env_ptr the_env = ecl_process_env();
struct hostent *he;
unsigned long l;
char address[4];

2
src/configure vendored
View file

@ -5196,7 +5196,7 @@ if test "${with_fpe}" != yes; then
_ACEOF
fi
if test "${with_signed_zero}" == yes; then
if test "${with_signed_zero}" = yes; then
cat >>confdefs.h <<\_ACEOF
#define ECL_SIGNED_ZERO 1
_ACEOF

View file

@ -430,7 +430,7 @@ dnl Deactivate floating point exceptions if asked to
if test "${with_fpe}" != yes; then
AC_DEFINE(ECL_AVOID_FPE_H)
fi
if test "${with_signed_zero}" == yes; then
if test "${with_signed_zero}" = yes; then
AC_DEFINE(ECL_SIGNED_ZERO)
fi