mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-03-15 01:10:53 -07:00
Since dpp now generates code that uses 'the_env', it has to be defined in functions that use @(return)
This commit is contained in:
parent
ed584a62c5
commit
5a41a55a2d
12 changed files with 41 additions and 2 deletions
|
|
@ -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();
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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) {
|
||||
|
|
|
|||
|
|
@ -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)) {
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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:
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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
2
src/configure
vendored
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue