From 5a41a55a2d82ecc2eaebca62be742e5a0513fdb4 Mon Sep 17 00:00:00 2001
From: Juan Jose Garcia Ripoll <jjgarcia@jjgr.(none)>
Date: Sat, 11 Oct 2008 23:47:40 +0200
Subject: [PATCH] Since dpp now generates code that uses 'the_env', it has to
 be defined in functions that use @(return)

---
 src/c/alloc_2.d      |  3 +++
 src/c/array.d        |  7 +++++++
 src/c/assignment.d   |  1 +
 src/c/cfun.d         |  2 ++
 src/c/disassembler.d |  2 ++
 src/c/hash.d         |  1 +
 src/c/num_co.d       | 19 +++++++++++++++++++
 src/c/package.d      |  1 +
 src/c/symbol.d       |  2 ++
 src/c/tcp.d          |  1 +
 src/configure        |  2 +-
 src/configure.in     |  2 +-
 12 files changed, 41 insertions(+), 2 deletions(-)

diff --git a/src/c/alloc_2.d b/src/c/alloc_2.d
index c111d234c..25f97f273 100644
--- a/src/c/alloc_2.d
+++ b/src/c/alloc_2.d
@@ -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();
diff --git a/src/c/array.d b/src/c/array.d
index b7b3f21e0..e92403af5 100644
--- a/src/c/array.d
+++ b/src/c/array.d
@@ -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))
diff --git a/src/c/assignment.d b/src/c/assignment.d
index 1ca072d48..3293d22e6 100644
--- a/src/c/assignment.d
+++ b/src/c/assignment.d
@@ -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) {
diff --git a/src/c/cfun.d b/src/c/cfun.d
index 315a911c4..e648b1287 100644
--- a/src/c/cfun.d
+++ b/src/c/cfun.d
@@ -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)) {
diff --git a/src/c/disassembler.d b/src/c/disassembler.d
index 47c44e4e0..78f777b99 100644
--- a/src/c/disassembler.d
+++ b/src/c/disassembler.d
@@ -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;
 	}
diff --git a/src/c/hash.d b/src/c/hash.d
index 5227d5db5..7cd08570f 100644
--- a/src/c/hash.d
+++ b/src/c/hash.d
@@ -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;
diff --git a/src/c/num_co.d b/src/c/num_co.d
index cf5805412..4096e7eeb 100644
--- a/src/c/num_co.d
+++ b/src/c/num_co.d
@@ -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:
diff --git a/src/c/package.d b/src/c/package.d
index e14b10ab9..3e214c7fe 100644
--- a/src/c/package.d
+++ b/src/c/package.d
@@ -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);
diff --git a/src/c/symbol.d b/src/c/symbol.d
index 943b3394a..dca61b4aa 100644
--- a/src/c/symbol.d
+++ b/src/c/symbol.d
@@ -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))
 }
diff --git a/src/c/tcp.d b/src/c/tcp.d
index b64bc3f86..60cea2fd4 100644
--- a/src/c/tcp.d
+++ b/src/c/tcp.d
@@ -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];
diff --git a/src/configure b/src/configure
index 1a15e8990..907fe3933 100755
--- a/src/configure
+++ b/src/configure
@@ -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
diff --git a/src/configure.in b/src/configure.in
index 3423901ef..4b9e3a06e 100644
--- a/src/configure.in
+++ b/src/configure.in
@@ -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