diff --git a/src/c/assignment.d b/src/c/assignment.d index 57ac82468..d12864c04 100644 --- a/src/c/assignment.d +++ b/src/c/assignment.d @@ -25,7 +25,7 @@ cl_set(cl_object var, cl_object val) const cl_env_ptr env = ecl_process_env(); if (ecl_symbol_type(var) & ecl_stp_constant) FEinvalid_variable("Cannot assign to the constant ~S.", var); - return1(ECL_SETQ(env, var, val)); + ecl_return1(env, ECL_SETQ(env, var, val)); } static cl_object diff --git a/src/c/character.d b/src/c/character.d index 5ac84e3f2..29206dea6 100644 --- a/src/c/character.d +++ b/src/c/character.d @@ -450,8 +450,9 @@ ecl_digit_char(cl_fixnum w, cl_fixnum r) cl_object cl_char_int(cl_object c) { + const cl_env_ptr the_env = ecl_process_env(); /* INV: ecl_char_code() checks the type of `c' */ - return1(ecl_make_fixnum(ecl_char_code(c))); + ecl_return1(the_env, ecl_make_fixnum(ecl_char_code(c))); } /* here we give every character an implicit name of the form 'u#' where # is a hexadecimal number, diff --git a/src/c/cons.d b/src/c/cons.d index f693d89ea..30f1cbd0a 100644 --- a/src/c/cons.d +++ b/src/c/cons.d @@ -814,152 +814,182 @@ cl_object ecl_cddddr(cl_object x) cl_object cl_car(cl_object x) { - return1(ecl_car(x)); + const cl_env_ptr the_env = ecl_process_env(); + ecl_return1(the_env, ecl_car(x)); } cl_object cl_cdr(cl_object x) { - return1(ecl_cdr(x)); + const cl_env_ptr the_env = ecl_process_env(); + ecl_return1(the_env, ecl_cdr(x)); } cl_object cl_caar(cl_object x) { - return1(ecl_caar(x)); + const cl_env_ptr the_env = ecl_process_env(); + ecl_return1(the_env, ecl_caar(x)); } cl_object cl_cdar(cl_object x) { - return1(ecl_cdar(x)); + const cl_env_ptr the_env = ecl_process_env(); + ecl_return1(the_env, ecl_cdar(x)); } cl_object cl_cadr(cl_object x) { - return1(ecl_cadr(x)); + const cl_env_ptr the_env = ecl_process_env(); + ecl_return1(the_env, ecl_cadr(x)); } cl_object cl_cddr(cl_object x) { - return1(ecl_cddr(x)); + const cl_env_ptr the_env = ecl_process_env(); + ecl_return1(the_env, ecl_cddr(x)); } cl_object cl_caaar(cl_object x) { - return1(ecl_caaar(x)); + const cl_env_ptr the_env = ecl_process_env(); + ecl_return1(the_env, ecl_caaar(x)); } cl_object cl_cdaar(cl_object x) { - return1(ecl_cdaar(x)); + const cl_env_ptr the_env = ecl_process_env(); + ecl_return1(the_env, ecl_cdaar(x)); } cl_object cl_cadar(cl_object x) { - return1(ecl_cadar(x)); + const cl_env_ptr the_env = ecl_process_env(); + ecl_return1(the_env, ecl_cadar(x)); } cl_object cl_cddar(cl_object x) { - return1(ecl_cddar(x)); + const cl_env_ptr the_env = ecl_process_env(); + ecl_return1(the_env, ecl_cddar(x)); } cl_object cl_caadr(cl_object x) { - return1(ecl_caadr(x)); + const cl_env_ptr the_env = ecl_process_env(); + ecl_return1(the_env, ecl_caadr(x)); } cl_object cl_cdadr(cl_object x) { - return1(ecl_cdadr(x)); + const cl_env_ptr the_env = ecl_process_env(); + ecl_return1(the_env, ecl_cdadr(x)); } cl_object cl_caddr(cl_object x) { - return1(ecl_caddr(x)); + const cl_env_ptr the_env = ecl_process_env(); + ecl_return1(the_env, ecl_caddr(x)); } cl_object cl_cdddr(cl_object x) { - return1(ecl_cdddr(x)); + const cl_env_ptr the_env = ecl_process_env(); + ecl_return1(the_env, ecl_cdddr(x)); } cl_object cl_caaaar(cl_object x) { - return1(ecl_caaaar(x)); + const cl_env_ptr the_env = ecl_process_env(); + ecl_return1(the_env, ecl_caaaar(x)); } cl_object cl_cdaaar(cl_object x) { - return1(ecl_cdaaar(x)); + const cl_env_ptr the_env = ecl_process_env(); + ecl_return1(the_env, ecl_cdaaar(x)); } cl_object cl_cadaar(cl_object x) { - return1(ecl_cadaar(x)); + const cl_env_ptr the_env = ecl_process_env(); + ecl_return1(the_env, ecl_cadaar(x)); } cl_object cl_cddaar(cl_object x) { - return1(ecl_cddaar(x)); + const cl_env_ptr the_env = ecl_process_env(); + ecl_return1(the_env, ecl_cddaar(x)); } cl_object cl_caadar(cl_object x) { - return1(ecl_caadar(x)); + const cl_env_ptr the_env = ecl_process_env(); + ecl_return1(the_env, ecl_caadar(x)); } cl_object cl_cdadar(cl_object x) { - return1(ecl_cdadar(x)); + const cl_env_ptr the_env = ecl_process_env(); + ecl_return1(the_env, ecl_cdadar(x)); } cl_object cl_caddar(cl_object x) { - return1(ecl_caddar(x)); + const cl_env_ptr the_env = ecl_process_env(); + ecl_return1(the_env, ecl_caddar(x)); } cl_object cl_cdddar(cl_object x) { - return1(ecl_cdddar(x)); + const cl_env_ptr the_env = ecl_process_env(); + ecl_return1(the_env, ecl_cdddar(x)); } cl_object cl_caaadr(cl_object x) { - return1(ecl_caaadr(x)); + const cl_env_ptr the_env = ecl_process_env(); + ecl_return1(the_env, ecl_caaadr(x)); } cl_object cl_cdaadr(cl_object x) { - return1(ecl_cdaadr(x)); + const cl_env_ptr the_env = ecl_process_env(); + ecl_return1(the_env, ecl_cdaadr(x)); } cl_object cl_cadadr(cl_object x) { - return1(ecl_cadadr(x)); + const cl_env_ptr the_env = ecl_process_env(); + ecl_return1(the_env, ecl_cadadr(x)); } cl_object cl_cddadr(cl_object x) { - return1(ecl_cddadr(x)); + const cl_env_ptr the_env = ecl_process_env(); + ecl_return1(the_env, ecl_cddadr(x)); } cl_object cl_caaddr(cl_object x) { - return1(ecl_caaddr(x)); + const cl_env_ptr the_env = ecl_process_env(); + ecl_return1(the_env, ecl_caaddr(x)); } cl_object cl_cdaddr(cl_object x) { - return1(ecl_cdaddr(x)); + const cl_env_ptr the_env = ecl_process_env(); + ecl_return1(the_env, ecl_cdaddr(x)); } cl_object cl_cadddr(cl_object x) { - return1(ecl_cadddr(x)); + const cl_env_ptr the_env = ecl_process_env(); + ecl_return1(the_env, ecl_cadddr(x)); } cl_object cl_cddddr(cl_object x) { - return1(ecl_cddddr(x)); + const cl_env_ptr the_env = ecl_process_env(); + ecl_return1(the_env, ecl_cddddr(x)); } /* END-GENERATED */ diff --git a/src/c/list.d b/src/c/list.d index db8ec2650..4e8e40bc7 100644 --- a/src/c/list.d +++ b/src/c/list.d @@ -215,9 +215,10 @@ ecl_append(cl_object x, cl_object y) return head; } -#define LENTH(n) (cl_object x) {\ - return1(ecl_nth(n, x));\ -} +#define LENTH(n) (cl_object x) { \ + const cl_env_ptr the_env = ecl_process_env(); \ + ecl_return1(the_env, ecl_nth(n, x)); \ + } cl_object @fifth LENTH(4) cl_object @sixth LENTH(5) cl_object @seventh LENTH(6) diff --git a/src/h/legacy.h b/src/h/legacy.h index 8bb995f4c..8e54472e0 100644 --- a/src/h/legacy.h +++ b/src/h/legacy.h @@ -139,3 +139,7 @@ #define CHAR_CODE_LIMIT ECL_CHAR_CODE_LIMIT #define NVALUES cl_env.nvalues + +#define return0() return ((NVALUES = 0),Cnil) +#define return1(x) return ((VALUES(0)=(x)),(NVALUES=1),VALUES(0)) +#define returnn(x) return x diff --git a/src/h/stacks.h b/src/h/stacks.h index cb1a674f7..5e53e522e 100755 --- a/src/h/stacks.h +++ b/src/h/stacks.h @@ -285,9 +285,6 @@ extern ECL_API ecl_frame_ptr _ecl_frs_push(register cl_env_ptr, register cl_obje ***********************/ #define VALUES(n) cl_env.values[n] -#define return0() return ((NVALUES = 0),Cnil) -#define return1(x) return ((VALUES(0)=(x)),(NVALUES=1),VALUES(0)) -#define returnn(x) return x #define ecl_nth_value(env,n) ((env)->values[n]) #define ecl_nvalues(env) ((env)->nvalues) #define ecl_return0(env) \