mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-15 05:43:19 -08:00
Code Issues Projects Releases Packages Wiki Activity

Fixes to remove warnings about unused variables. Replaced some uses of @(return) with ecl_return*()

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2012-04-10 23:20:40 +02:00
parent 5c1dca4c67
commit 036cb55928
30 changed files with 104 additions and 132 deletions
Download patch file Download diff file Expand all files Collapse all files

18
src/c/array.d
View file

@ -234,7 +234,7 @@ ecl_aref1(cl_object x, cl_index index)
void *
ecl_row_major_ptr(cl_object x, cl_index index, cl_index bytes)
{
cl_index idx, elt_size, offset;
cl_index elt_size, offset;
cl_elttype elt_type;
if (ecl_unlikely(!ECL_ARRAYP(x))) {
@ -539,7 +539,7 @@ void
ecl_array_allocself(cl_object x)
{
cl_elttype t = x->array.elttype;
cl_index i, d = x->array.dim;
cl_index d = x->array.dim;
switch (t) {
/* assign self field only after it has been filled, for GC sake */
case aet_object:
@ -979,7 +979,7 @@ cl_array_displacement(cl_object a)
FEbad_aet();
}
}
@(return to_array MAKE_FIXNUM(offset));
ecl_return2(the_env, to_array, MAKE_FIXNUM(offset));
}
cl_object
@ -996,7 +996,7 @@ cl_svref(cl_object x, cl_object index)
FEwrong_type_nth_arg(@[svref],1,x,@[simple-vector]);
}
i = checked_index(@[svref], x, -1, index, x->vector.dim);
@(return x->vector.self.t[i])
ecl_return1(the_env, x->vector.self.t[i]);
}
cl_object
@ -1013,7 +1013,7 @@ si_svset(cl_object x, cl_object index, cl_object v)
FEwrong_type_nth_arg(@[si::svset],1,x,@[simple-vector]);
}
i = checked_index(@[svref], x, -1, index, x->vector.dim);
@(return (x->vector.self.t[i] = v))
ecl_return1(the_env, x->vector.self.t[i] = v);
}
cl_object
@ -1035,7 +1035,7 @@ cl_array_has_fill_pointer_p(cl_object a)
default:
FEwrong_type_nth_arg(@[array-has-fill-pointer-p],1,a,@[array]);
}
@(return r)
ecl_return1(the_env, r);
}
cl_object
@ -1048,7 +1048,7 @@ cl_fill_pointer(cl_object a)
const char *type = "(AND VECTOR (SATISFIES ARRAY-HAS-FILL-POINTER-P))";
FEwrong_type_nth_arg(@[fill-pointer], 1, a, ecl_read_from_cstring(type));
}
@(return MAKE_FIXNUM(a->vector.fillp))
ecl_return1(the_env, MAKE_FIXNUM(a->vector.fillp));
}
/*
@ -1071,7 +1071,7 @@ si_fill_pointer_set(cl_object a, cl_object fp)
FEwrong_type_key_arg(@[adjust-array], @[:fill-pointer], fp, type);
}
a->vector.fillp = i;
@(return fp)
ecl_return1(the_env, fp);
}
/*
@ -1119,7 +1119,7 @@ si_replace_array(cl_object olda, cl_object newa)
2, olda, newa);
}
OUTPUT:
@(return olda)
ecl_return1(the_env, olda);
}
void

15
src/c/cfun.d
View file

@ -117,7 +117,7 @@ si_compiled_function_name(cl_object fun)
default:
FEinvalid_function(fun);
}
@(return output)
ecl_return1(the_env, output);
}
cl_object
@ -161,7 +161,7 @@ cl_function_lambda_expression(cl_object fun)
default:
FEinvalid_function(fun);
}
@(return output lex name)
ecl_return3(the_env, output, lex, name);
}
cl_object
@ -192,22 +192,21 @@ si_compiled_function_file(cl_object b)
b = b->bclosure.code;
goto BEGIN;
case t_bytecodes:
@(return b->bytecodes.file b->bytecodes.file_position);
ecl_return2(the_env, b->bytecodes.file, b->bytecodes.file_position);
case t_cfun:
@(return b->cfun.file b->cfun.file_position);
ecl_return2(the_env, b->cfun.file, b->cfun.file_position);
case t_cfunfixed:
@(return b->cfunfixed.file b->cfunfixed.file_position);
ecl_return2(the_env, b->cfunfixed.file, b->cfunfixed.file_position);
case t_cclosure:
@(return b->cclosure.file b->cclosure.file_position);
ecl_return2(the_env, b->cclosure.file, b->cclosure.file_position);
default:
@(return Cnil Cnil);
ecl_return2(the_env, Cnil, Cnil);
}
}
void
ecl_set_function_source_file_info(cl_object b, cl_object source, cl_object position)
{
cl_env_ptr the_env = ecl_process_env();
BEGIN:
switch (type_of(b)) {
case t_bclosure:

5
src/c/compiler.d
View file

@ -745,7 +745,7 @@ c_undo_bindings(cl_env_ptr the_env, cl_object old_vars, int only_specials)
if (name == @':block' || name == @':tag') {
(void)0;
} else if (name == @':function' || Null(special)) {
only_specials || num_lexical++;
if (!only_specials) ++num_lexical;
} else if (name == @':declare') {
/* Ignored */
} else if (special != @'si::symbol-macro') {
@ -1347,7 +1347,7 @@ c_labels_flet(cl_env_ptr env, int op, cl_object args, int flags) {
cl_object l, def_list = pop(&args);
cl_object old_vars = env->c_env->variables;
cl_object old_funs = env->c_env->macros;
cl_index nfun, first = 0;
cl_index nfun;
if (ecl_length(def_list) == 0) {
return c_locally(env, args, flags);
@ -2720,7 +2720,6 @@ si_process_lambda_list(cl_object org_lambda_list, cl_object context)
if (context == @'function') { \
unlikely_if (ecl_symbol_type(v) & stp_constant) \
FEillegal_variable_name(v); }
const cl_env_ptr the_env = ecl_process_env();
cl_object lists[4] = {Cnil, Cnil, Cnil, Cnil};
cl_object *reqs = lists, *opts = lists+1, *keys = lists+2, *auxs = lists+3;
cl_object v, rest = Cnil, lambda_list = org_lambda_list;

4
src/c/disassembler.d
View file

@ -90,7 +90,7 @@ disassemble_lambda(cl_object bytecodes) {
*/
static cl_opcode *
disassemble_flet(cl_object bytecodes, cl_opcode *vector) {
cl_index nfun, first;
cl_index nfun;
cl_object *data = bytecodes->bytecodes.data->vector.self.t;
GET_OPARG(nfun, vector);
print_noarg("FLET");
@ -110,7 +110,7 @@ disassemble_flet(cl_object bytecodes, cl_opcode *vector) {
*/
static cl_opcode *
disassemble_labels(cl_object bytecodes, cl_opcode *vector) {
cl_index nfun, first;
cl_index nfun;
cl_object *data = bytecodes->bytecodes.data->vector.self.t;
GET_OPARG(nfun, vector);
print_noarg("LABELS");

1
src/c/ffi.d
View file

@ -981,6 +981,7 @@ cl_object
si_free_ffi_closure(cl_object closure)
{
ffi_closure_free(ecl_foreign_data_pointer_safe(closure));
@(return);
}
@(defun si::make-dynamic-callback (fun sym return_type arg_types

3
src/c/ffi/libraries.d
View file

@ -217,7 +217,7 @@ static cl_object
ecl_library_open_inner(cl_object filename, bool self_destruct)
{
const cl_env_ptr the_env = ecl_process_env();
cl_object other, block = ecl_alloc_object(t_codeblock);
cl_object block = ecl_alloc_object(t_codeblock);
block->cblock.self_destruct = self_destruct;
block->cblock.locked = 0;
block->cblock.handle = NULL;
@ -435,7 +435,6 @@ ecl_library_close(cl_object block) {
ecl_enable_interrupts();
} ECL_WITH_GLOBAL_LOCK_END;
if (block != Cnil && block->cblock.self_destruct) {
const char *filename;
if (!Null(block->cblock.name)) {
unlink((char*)block->cblock.name->base_string.self);
}

6
src/c/file.d
View file

@ -209,6 +209,7 @@ not_output_finish_output(cl_object strm)
not_an_output_stream(strm);
}
#if defined(ECL_WSOCK)
static cl_object
not_implemented_get_position(cl_object strm)
{
@ -222,6 +223,7 @@ not_implemented_set_position(cl_object strm, cl_object pos)
FEerror("file-position not implemented for stream ~S", 1, strm);
return Cnil;
}
#endif
/**********************************************************************
* CLOSED STREAM OPS
@ -1093,7 +1095,7 @@ utf_8_encoder(cl_object stream, unsigned char *buffer, ecl_character c)
{
int nbytes;
if (c < 0) {
return 0;
nbytes = 0;
} else if (c <= 0x7F) {
buffer[0] = c;
nbytes = 1;
@ -5008,7 +5010,7 @@ file_listen(int fileno)
#if !defined(ECL_MS_WINDOWS_HOST)
# if defined(HAVE_SELECT)
fd_set fds;
int retv, fd;
int retv;
struct timeval tv = { 0, 0 };
/*
* Note that the following code is fragile. If the file is closed (/dev/null)

6
src/c/gfun.d
View file

@ -211,9 +211,9 @@ static cl_object
generic_function_dispatch_vararg(cl_narg narg, ...)
{
cl_object output;
ECL_STACK_FRAME_VARARGS_BEGIN(narg, narg, frame);
output = _ecl_standard_dispatch(frame, frame->frame.env->function);
ECL_STACK_FRAME_VARARGS_END(frame);
ECL_STACK_FRAME_VARARGS_BEGIN(narg, narg, frame) {
output = _ecl_standard_dispatch(frame, frame->frame.env->function);
} ECL_STACK_FRAME_VARARGS_END(frame);
return output;
}

9
src/c/hash.d
View file

@ -25,8 +25,6 @@
#include <ecl/internal.h>
#include "newhash.h"
static void corrupted_hash(cl_object hashtable) /*__attribute__((noreturn))*/;
#define SYMBOL_NAME(x) (Null(x)? Cnil_symbol->symbol.name : (x)->symbol.name)
static void ECL_INLINE
@ -36,12 +34,6 @@ assert_type_hash_table(cl_object function, cl_narg narg, cl_object p)
FEwrong_type_nth_arg(function, narg, p, @[hash-table]);
}
static void
corrupted_hash(cl_object hashtable)
{
FEerror("internal error, corrupted hashtable ~S", 1, hashtable);
}
static cl_hashkey
_hash_eql(cl_hashkey h, cl_object x)
{
@ -1105,7 +1097,6 @@ si_hash_table_content(cl_object ht)
cl_object
si_hash_table_fill(cl_object ht, cl_object values)
{
cl_object pair;
assert_type_hash_table(@[ext::hash-table-fill], 2, ht);
while (!Null(values)) {
cl_object pair = ecl_car(values);

6
src/c/interpreter.d
View file

@ -189,9 +189,9 @@ cl_object
_ecl_bytecodes_dispatch_vararg(cl_narg narg, ...)
{
cl_object output;
ECL_STACK_FRAME_VARARGS_BEGIN(narg, narg, frame);
output = ecl_interpret(frame, Cnil, frame->frame.env->function);
ECL_STACK_FRAME_VARARGS_END(frame);
ECL_STACK_FRAME_VARARGS_BEGIN(narg, narg, frame) {
output = ecl_interpret(frame, Cnil, frame->frame.env->function);
} ECL_STACK_FRAME_VARARGS_END(frame);
return output;
}

2
src/c/load.d
View file

@ -81,7 +81,7 @@ GO_ON:
si_munmap(map);
OUTPUT:
@(return output)
ecl_return1(the_env, output);
}
#endif /* !ENABLE_DLOPEN */

4
src/c/main.d
View file

@ -829,7 +829,7 @@ si_setenv(cl_object var, cl_object value)
if (ret_val == -1)
CEerror(Ct, "SI:SETENV failed: insufficient space in environment.",
1, Cnil);
@(return value)
ecl_return1(the_env, value);
}
#endif
@ -861,7 +861,7 @@ cl_object
si_pointer(cl_object x)
{
const cl_env_ptr the_env = ecl_process_env();
@(return ecl_make_unsigned_integer((cl_index)x))
ecl_return1(the_env, ecl_make_unsigned_integer((cl_index)x));
}
#if defined(ECL_MS_WINDOWS_HOST)

49
src/c/num_co.d
View file

@ -166,7 +166,7 @@ ecl_floor1(cl_object x)
default:
FEwrong_type_nth_arg(@[floor],1,x,@[real]);
}
@(return v0 v1)
ecl_return2(the_env, v0, v1);
}
cl_object
@ -329,16 +329,15 @@ ecl_floor2(cl_object x, cl_object y)
default:
FEwrong_type_nth_arg(@[floor], 1, x, @[real]);
}
@(return v0 v1)
ecl_return2(the_env, v0, v1);
}
@(defun floor (x &optional (y OBJNULL))
@
if (narg == 1)
x = ecl_floor1(x);
return ecl_floor1(x);
else
x = ecl_floor2(x, y);
returnn(x);
return ecl_floor2(x, y);
@)
cl_object
@ -541,16 +540,15 @@ ecl_ceiling2(cl_object x, cl_object y)
default:
FEwrong_type_nth_arg(@[ceiling], 1, x, @[real]);
}
@(return v0 v1)
ecl_return2(the_env, v0, v1);
}
@(defun ceiling (x &optional (y OBJNULL))
@
if (narg == 1)
x = ecl_ceiling1(x);
return ecl_ceiling1(x);
else
x = ecl_ceiling2(x, y);
returnn(x);
return ecl_ceiling2(x, y);
@)
cl_object
@ -594,13 +592,12 @@ ecl_truncate1(cl_object x)
default:
FEwrong_type_nth_arg(@[truncate],1,x,@[real]);
}
@(return v0 v1)
ecl_return2(the_env, v0, v1);
}
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
@ -610,10 +607,9 @@ ecl_truncate2(cl_object x, cl_object y)
@(defun truncate (x &optional (y OBJNULL))
@
if (narg == 1)
x = ecl_truncate1(x);
return ecl_truncate1(x);
else
x = ecl_truncate2(x, y);
returnn(x);
return ecl_truncate2(x, y);
@)
static double
@ -693,7 +689,7 @@ ecl_round1(cl_object x)
default:
FEwrong_type_nth_arg(@[round],1,x,@[real]);
}
@(return v0 v1)
ecl_return2(the_env, v0, v1);
}
cl_object
@ -732,16 +728,15 @@ ecl_round2(cl_object x, cl_object y)
v0 = q = ecl_round1(q);
v1 = number_remainder(x, y, q);
}
@(return v0 v1)
ecl_return2(the_env, v0, v1);
}
@(defun round (x &optional (y OBJNULL))
@
if (narg == 1)
x = ecl_round1(x);
return ecl_round1(x);
else
x = ecl_round2(x, y);
returnn(x);
return ecl_round2(x, y);
@)
@ -751,7 +746,7 @@ 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))
ecl_return1(the_env, the_env->values[1]);
}
cl_object
@ -759,7 +754,7 @@ cl_rem(cl_object x, cl_object y)
{
const cl_env_ptr the_env = ecl_process_env();
@truncate(2, x, y);
@(return VALUES(1))
ecl_return1(the_env, the_env->values[1]);
}
cl_object
@ -813,7 +808,7 @@ cl_decode_float(cl_object x)
default:
FEwrong_type_nth_arg(@[decode-float],1,x,@[float]);
}
@(return x MAKE_FIXNUM(e) ecl_make_singlefloat(s))
ecl_return3(the_env, x, MAKE_FIXNUM(e), ecl_make_singlefloat(s));
}
cl_object
@ -842,7 +837,7 @@ cl_scale_float(cl_object x, cl_object y)
default:
FEwrong_type_nth_arg(@[scale-float],1,x,@[float]);
}
@(return x)
ecl_return1(the_env, x);
}
cl_object
@ -852,7 +847,7 @@ cl_float_radix(cl_object x)
if (ecl_unlikely(cl_floatp(x) != Ct)) {
FEwrong_type_nth_arg(@[float-radix],1,x,@[float]);
}
@(return MAKE_FIXNUM(FLT_RADIX))
ecl_return1(the_env, MAKE_FIXNUM(FLT_RADIX));
}
int
@ -922,7 +917,7 @@ cl_float_digits(cl_object x)
default:
FEwrong_type_nth_arg(@[float-digits],1,x,@[float]);
}
@(return x)
ecl_return1(the_env, x);
}
cl_object
@ -981,7 +976,7 @@ cl_float_precision(cl_object x)
default:
FEwrong_type_nth_arg(@[float-precision],1,x,@[float]);
}
@(return MAKE_FIXNUM(precision))
ecl_return1(the_env, MAKE_FIXNUM(precision));
}
cl_object
@ -1044,7 +1039,7 @@ cl_integer_decode_float(cl_object x)
default:
FEwrong_type_nth_arg(@[integer-decode-float],1,x,@[float]);
}
@(return x MAKE_FIXNUM(e) MAKE_FIXNUM(s))
ecl_return3(the_env, x, MAKE_FIXNUM(e), MAKE_FIXNUM(s));
}

4
src/c/number.d
View file

@ -96,7 +96,6 @@ ecl_to_bit(cl_object x) {
ecl_uint8_t
ecl_to_uint8_t(cl_object x) {
cl_fixnum aux;
if (ecl_likely(ECL_FIXNUMP(x))) {
cl_fixnum aux = ecl_fix(x);
if (ecl_likely(aux >= 0 && aux <= 255))
@ -108,7 +107,6 @@ ecl_to_uint8_t(cl_object x) {
ecl_int8_t
ecl_to_int8_t(cl_object x) {
cl_fixnum aux;
if (ecl_likely(ECL_FIXNUMP(x))) {
cl_fixnum aux = ecl_fix(x);
if (ecl_likely(aux >= -128 && aux <= 127))
@ -697,6 +695,7 @@ prepare_ratio_to_float(cl_object num, cl_object den, int digits, cl_fixnum *scal
} while (1);
}
#if 0 /* Unused, we do not have ecl_to_float() */
static float
ratio_to_float(cl_object num, cl_object den)
{
@ -710,6 +709,7 @@ ratio_to_float(cl_object num, cl_object den)
#endif
return ldexpf(output, scale);
}
#endif
static double
ratio_to_double(cl_object num, cl_object den)

12
src/c/package.d
View file

@ -194,7 +194,7 @@ cl_object
ecl_make_package(cl_object name, cl_object nicknames, cl_object use_list)
{
const cl_env_ptr env = ecl_process_env();
cl_object x, l, other = Cnil;
cl_object x, other = Cnil;
/* Type checking, coercions, and the like, happen before we
* acquire the lock */
@ -357,7 +357,7 @@ _ecl_intern(const char *s, cl_object p)
cl_object
ecl_intern(cl_object name, cl_object p, int *intern_flag)
{
cl_object s, ul;
cl_object s;
bool error, ignore_error = 0;
if (ecl_unlikely(!ECL_STRINGP(name)))
@ -466,7 +466,7 @@ potential_unintern_conflict(cl_object name, cl_object s, cl_object p)
bool
ecl_unintern(cl_object s, cl_object p)
{
cl_object conflict, l, hash;
cl_object conflict;
bool output = FALSE;
cl_object name = ecl_symbol_name(s);
@ -527,7 +527,7 @@ potential_export_conflict(cl_object name, cl_object s, cl_object p)
void
cl_export2(cl_object s, cl_object p)
{
cl_object x, l, hash = OBJNULL;
cl_object x;
int intern_flag, error;
cl_object other_p, name = ecl_symbol_name(s);
p = si_coerce_to_package(p);
@ -838,7 +838,7 @@ si_select_package(cl_object pack_name)
{
const cl_env_ptr the_env = ecl_process_env();
cl_object p = si_coerce_to_package(pack_name);
@(return (ECL_SETQ(the_env, @'*package*', p)))
ecl_return1(the_env, ECL_SETQ(the_env, @'*package*', p));
}
cl_object
@ -1037,7 +1037,6 @@ cl_list_all_packages()
@(defun use_package (pack &o (pa ecl_current_package()))
@
BEGIN:
switch (type_of(pack)) {
case t_symbol:
case t_character:
@ -1060,7 +1059,6 @@ BEGIN:
@(defun unuse_package (pack &o (pa ecl_current_package()))
@
BEGIN:
switch (type_of(pack)) {
case t_symbol:
case t_character:

13
src/c/pathname.d
View file

@ -69,14 +69,6 @@ in_antilocal_case_p(cl_object str, cl_object cas)
return 0;
}
static cl_object
ensure_local_case(cl_object str, cl_object cas)
{
if (cas == @':downcase')
return str;
return cl_string_upcase(1, str);
}
static cl_object
to_local_case(cl_object str, cl_object cas)
{
@ -277,7 +269,6 @@ ecl_make_pathname(cl_object host, cl_object device, cl_object directory,
cl_object fromcase)
{
cl_object x, p, component;
cl_object (*translator)(cl_object);
p = ecl_alloc_object(t_pathname);
if (ecl_stringp(host))
@ -1802,8 +1793,8 @@ copy_list_wildcards(cl_object *wilds, cl_object to)
version = source->pathname.version;
}
}
return ecl_make_pathname(host, device, directory, name, type,
version, tocase);
@(return ecl_make_pathname(host, device, directory, name, type,
version, tocase));
error:
FEerror("~S is not a specialization of path ~S", 2, source, from);
error2:

2
src/c/predicate.d
View file

@ -269,7 +269,6 @@ cl_eq(cl_object x, cl_object y)
bool
ecl_eql(cl_object x, cl_object y)
{
cl_type t;
if (x == y)
return TRUE;
if (IMMEDIATE(x) || IMMEDIATE(y))
@ -508,7 +507,6 @@ BEGIN:
return TRUE;
} else {
cl_object key = env->values[1];
cl_object value = env->values[2];
if (ecl_gethash_safe(key, y, OBJNULL) == OBJNULL)
return FALSE;
}

2
src/c/printer/write_code.d
View file

@ -25,7 +25,7 @@ _ecl_write_bytecodes(cl_object x, cl_object stream)
if (ecl_print_readably()) {
cl_index i;
cl_object lex = Cnil;
cl_object code_l=Cnil, data_l=Cnil;
cl_object code_l=Cnil;
for ( i=x->bytecodes.code_size-1 ; i<(cl_index)(-1l) ; i-- )
code_l = ecl_cons(MAKE_FIXNUM(((cl_opcode*)(x->bytecodes.code))[i]), code_l);
writestr_stream("#Y", stream);

14
src/c/read.d
View file

@ -652,7 +652,7 @@ sharp_C_reader(cl_object in, cl_object c, cl_object d)
static cl_object
sharp_backslash_reader(cl_object in, cl_object c, cl_object d)
{
const cl_env_ptr env = ecl_process_env();
const cl_env_ptr the_env = ecl_process_env();
cl_object token;
if (d != Cnil && !read_suppress) {
unlikely_if (!FIXNUMP(d) || d != MAKE_FIXNUM(0)) {
@ -676,7 +676,7 @@ sharp_backslash_reader(cl_object in, cl_object c, cl_object d)
c = nc;
}
si_put_buffer_string(token);
@(return c)
ecl_return1(the_env, c);
}
static cl_object
@ -1052,7 +1052,7 @@ static cl_object
sharp_eq_reader(cl_object in, cl_object c, cl_object d)
{
const cl_env_ptr the_env = ecl_process_env();
cl_object definition, pair, value;
cl_object pair, value;
cl_object sharp_eq_context = ECL_SYM_VAL(the_env, @'si::*sharp-eq-context*');
if (read_suppress) @(return);
@ -1069,7 +1069,7 @@ sharp_eq_reader(cl_object in, cl_object c, cl_object d)
FEreader_error("#~D# is defined by itself.", in, 1, d);
}
ECL_RPLACD(pair, value);
@(return value)
ecl_return1(the_env, value);
}
static cl_object
@ -1146,7 +1146,6 @@ do_patch_sharp(cl_object x, cl_object table)
break;
}
case t_bytecodes: {
cl_index i = 0;
x->bytecodes.name = do_patch_sharp(x->bytecodes.name, table);
x->bytecodes.definition = do_patch_sharp(x->bytecodes.definition, table);
x->bytecodes.data = do_patch_sharp(x->bytecodes.data, table);
@ -1721,10 +1720,6 @@ cl_readtablep(cl_object readtable)
@(return (ECL_READTABLEP(readtable) ? Ct : Cnil))
}
#ifdef ECL_UNICODE
static struct ecl_readtable_entry default_readtable_entry;
#endif
int
ecl_readtable_get(cl_object readtable, int c, cl_object *macro_or_table)
{
@ -2270,7 +2265,6 @@ ecl_init_module(cl_object block, void (*entry_point)(cl_object))
cl_index fname_location = fix(prototype->block);
cl_object fname = VV[fname_location];
cl_index location = fix(prototype->name);
cl_object source = prototype->file;
cl_object position = prototype->file_position;
int narg = prototype->narg;
VV[location] = narg<0?

4
src/c/reference.d
View file

@ -163,7 +163,7 @@ cl_object
cl_boundp(cl_object sym)
{
const cl_env_ptr the_env = ecl_process_env();
@(return (ecl_boundp(the_env,sym)? Ct : Cnil))
ecl_return1(the_env, ecl_boundp(the_env,sym)? Ct : Cnil);
}
cl_object
@ -171,5 +171,5 @@ cl_special_operator_p(cl_object form)
{
const cl_env_ptr the_env = ecl_process_env();
int special = ecl_symbol_type(form) & stp_special_form;
@(return (special? Ct : Cnil))
ecl_return1(the_env, special? Ct : Cnil);
}

2
src/c/stacks.d
View file

@ -276,8 +276,6 @@ ecl_extend_bindings_array(cl_object vector)
static cl_index
invalid_or_too_large_binding_index(cl_env_ptr env, cl_object s)
{
cl_object *location;
struct bds_bd *slot;
cl_index index = s->symbol.binding;
if (index == ECL_MISSING_SPECIAL_BINDING) {
index = ecl_new_binding_index(env, s);

2
src/c/string.d
View file

@ -425,7 +425,6 @@ compare_base(unsigned char *s1, cl_index l1, unsigned char *s2, cl_index l2,
cl_index s1, e1, s2, e2;
@
{
AGAIN:
string1 = cl_string(string1);
string2 = cl_string(string2);
p = ecl_vector_start_end(@[string=], string1, start1, end1);
@ -521,7 +520,6 @@ ecl_string_eq(cl_object x, cl_object y)
cl_index_pair p;
int output;
@
AGAIN:
string1 = cl_string(string1);
string2 = cl_string(string2);
p = ecl_vector_start_end(@[string=], string1, start1, end1);

8
src/c/symbol.d
View file

@ -292,18 +292,18 @@ cl_get_properties(cl_object place, cl_object indicator_list)
if (!CONSP(cdr_l))
break;
if (ecl_member_eq(ECL_CONS_CAR(l), indicator_list))
@(return ECL_CONS_CAR(l) ECL_CONS_CAR(cdr_l) l)
ecl_return3(the_env,ECL_CONS_CAR(l),ECL_CONS_CAR(cdr_l),l);
l = ECL_CONS_CDR(cdr_l);
}
if (l != Cnil)
FEtype_error_plist(place);
@(return Cnil Cnil Cnil)
ecl_return3(the_env, Cnil, Cnil, Cnil);
}
cl_object
cl_symbol_name(cl_object x)
{
@(return ecl_symbol_name(x))
ecl_return1(ecl_process_env(), ecl_symbol_name(x));
}
@(defun copy_symbol (sym &optional cp &aux x)
@ -406,7 +406,7 @@ 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))
ecl_return2(the_env, plist, (found? Ct : Cnil));
}
cl_object

3
src/c/tcp.d
View file

@ -305,7 +305,6 @@ si_open_server_stream(cl_object port)
{
int fd; /* file descriptor */
cl_index p;
cl_object output;
if (ecl_unlikely(!ECL_FIXNUMP(port) ||
ecl_fixnum_minusp(port) ||
@ -332,7 +331,6 @@ si_open_unix_socket_stream(cl_object path)
FEerror("UNIX socket not supported under Win32 platform", 0);
#else
int fd; /* file descriptor */
cl_object stream;
struct sockaddr_un addr;
if (ecl_unlikely(type_of(path) != t_base_string))
@ -367,7 +365,6 @@ 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];

11
src/c/threads/process.d
View file

@ -310,7 +310,7 @@ alloc_process(cl_object name, cl_object initial_bindings)
bool
ecl_import_current_thread(cl_object name, cl_object bindings)
{
cl_object process, l;
cl_object process;
pthread_t current;
cl_env_ptr env;
#ifdef ECL_WINDOWS_THREADS
@ -410,15 +410,17 @@ mp_suspend_loop()
cl_sleep(MAKE_FIXNUM(100));
}
} CL_CATCH_END;
ecl_return0(env);
}
cl_object
mp_break_suspend_loop()
{
cl_env_ptr the_env = ecl_process_env();
if (frs_sch(@'mp::suspend-loop')) {
cl_throw(@'mp::suspend-loop');
}
@(return)
ecl_return0(the_env);
}
cl_object
@ -536,8 +538,8 @@ mp_exit_process(void)
back to the thread entry point, going through all possible
UNWIND-PROTECT.
*/
const cl_env_ptr env = ecl_process_env();
ecl_unwind(env, env->frs_org);
const cl_env_ptr the_env = ecl_process_env();
ecl_unwind(the_env, the_env->frs_org);
}
cl_object
@ -572,7 +574,6 @@ mp_process_whostate(cl_object process)
cl_object
mp_process_join(cl_object process)
{
bool again = 1;
assert_type_process(process);
if (process->process.phase) {
/* We try to acquire a lock that is only owned by the process

2
src/c/unixfsys.d
View file

@ -401,9 +401,9 @@ file_truename(cl_object pathname, cl_object filename, int flags)
cl_object
cl_truename(cl_object orig_pathname)
{
cl_object kind, filename, dir;
cl_object pathname = make_absolute_pathname(orig_pathname);
cl_object base_dir = make_base_pathname(pathname);
cl_object dir;
/* We process the directory part of the filename, removing all
* possible symlinks. To do so, we inspect recursively the
* directory which contains our file, and come back. We also have to

6
src/c/unixint.d
View file

@ -540,7 +540,6 @@ handler_fn_protype(process_interrupt_handler, int sig, siginfo_t *siginfo, void
{
int old_errno = errno;
cl_env_ptr the_env;
cl_object signal_object;
reinstall_signal(sig, process_interrupt_handler);
/* The lisp environment might not be installed. */
the_env = ecl_process_env();
@ -589,7 +588,6 @@ handler_fn_protype(sigsegv_handler, int sig, siginfo_t *info, void *aux)
if (((char*)the_env <= (char*)info->si_addr) &&
((char*)info->si_addr <= (char*)(the_env+1)))
{
cl_object signal;
mprotect(the_env, sizeof(*the_env), PROT_READ | PROT_WRITE);
the_env->disable_interrupts = 0;
unblock_signal(the_env, sig);
@ -814,6 +812,7 @@ do_interrupt_thread(cl_object process)
FElibc_error("Unable to interrupt process ~A", 1,
process);
}
return 1;
# endif
}
@ -1009,8 +1008,7 @@ asynchronous_signal_servicing_thread()
}
}
} CL_CATCH_ALL_END;
RETURN:
@(return)
ecl_return0(the_env);
}
#endif

5
src/c/unixsys.d
View file

@ -292,8 +292,8 @@ ecl_waitpid(cl_object pid, cl_object wait)
cl_object
si_wait_for_all_processes()
{
#if defined(SIGCHLD) && !defined(ECL_WINDOWS_HOST)
const cl_env_ptr env = ecl_process_env();
#if defined(SIGCHLD) && !defined(ECL_WINDOWS_HOST)
do {
cl_object status = ecl_waitpid(MAKE_FIXNUM(-1), Cnil);
cl_object code = env->values[1];
@ -312,9 +312,8 @@ si_wait_for_all_processes()
}
}
} while (1);
#else
@(return);
#endif
ecl_return0(env);
}
#if defined(ECL_MS_WINDOWS_HOST) || defined(cygwin)

1
src/h/internal.h
View file

@ -201,7 +201,6 @@ extern void _ecl_unexpected_return() ecl_attr_noreturn;
frame->frame.env = env; \
frame->frame.size = narg; \
if (narg < C_ARGUMENTS_LIMIT) { \
cl_index i; \
cl_object *p = frame->frame.base = env->values; \
va_list args; \
va_start(args, lastarg); \

17
src/h/stacks.h
View file

@ -292,7 +292,22 @@ extern ECL_API ecl_frame_ptr _ecl_frs_push(register cl_env_ptr, register cl_obje
#define ecl_return0(env) \
do { (env)->nvalues = 0; return Cnil; } while (0)
#define ecl_return1(env,x) \
do { cl_object __aux = (x); (env)->nvalues = 0; return __aux; } while (0)
do { (env)->nvalues = 1; return (x); } while (0)
#define ecl_return2(env,x,y) \
do { \
cl_env_ptr __ecl_env = (env); \
cl_object __aux1 = (x), __aux2=(y); \
__ecl_env->values[1] = __aux2; \
__ecl_env->nvalues = 2; return __aux1; \
} while (0)
#define ecl_return3(env,x,y,z) \
do { \
cl_env_ptr __ecl_env = (env); \
cl_object __aux1=(x), __aux2=(y), __aux3=(z); \
__ecl_env->values[1] = __aux2; \
__ecl_env->values[2] = __aux3; \
__ecl_env->nvalues = 3; return __aux1; \
} while (0)
/*****************************
* LEXICAL ENVIRONMENT STACK