mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-02 07:30:55 -08:00
Code Issues Projects Releases Packages Wiki Activity

Factor out some error calls to make code faster in Mac OS X (avoids references to cl_env in some functions)

Browse source
This commit is contained in:
jgarcia 2008-05-12 08:12:31 +00:00
parent bd09f93e3c
commit 87a6367939
4 changed files with 15 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

13
src/c/dpp.c
View file

@ -101,6 +101,7 @@ char pool[POOLSIZE];
char *poolp;
char *function;
int function_code;
char *function_symbol;
char *function_c_name;
@ -248,7 +249,7 @@ search_keyword(const char *name)
}
char *
search_symbol(char *name)
search_symbol(char *name, int *symbol_code)
{
int i;
for (i = 0; cl_symbols[i].name != NULL; i++) {
@ -271,6 +272,8 @@ search_symbol(char *name)
pushstr(")");
pushc(0);
}
if (symbol_code)
*symbol_code = i;
return name;
}
}
@ -290,7 +293,7 @@ read_symbol()
}
pushc(0);
name = search_symbol(poolp = name);
name = search_symbol(poolp = name, 0);
if (name == NULL) {
name = poolp;
printf("\nUnknown symbol: %s\n", name);
@ -442,7 +445,7 @@ void
get_function(void)
{
function = read_function();
function_symbol = search_symbol(function);
function_symbol = search_symbol(function, &function_code);
if (function_symbol == NULL) {
function_symbol = poolp;
pushstr("Cnil");
@ -667,7 +670,7 @@ put_declaration(void)
}
if (nopt == 0 && !rest_flag && !key_flag) {
put_lineno();
fprintf(out, "\tif (narg!=%d) FEwrong_num_arguments(%s);\n", nreq, function_symbol);
fprintf(out, "\tif (narg!=%d) FEwrong_num_arguments(MAKE_FIXNUM(%d));\n", nreq, function_code);
} else {
simple_varargs = !rest_flag && !key_flag && ((nreq + nopt) < 32);
if (key_flag) {
@ -692,7 +695,7 @@ put_declaration(void)
if (nopt > 0 && !rest_flag && !key_flag) {
fprintf(out, "|| narg > %d", nreq + nopt);
}
fprintf(out, ") FEwrong_num_arguments(%s);\n", function_symbol);
fprintf(out, ") FEwrong_num_arguments(MAKE_FIXNUM(%d));\n", function_code);
for (i = 0; i < nopt; i++) {
put_lineno();
fprintf(out, "\tif (narg > %d) {\n", nreq+i);

3
src/c/error.d
View file

@ -174,6 +174,9 @@ FEundefined_function(cl_object fname)
void
FEwrong_num_arguments(cl_object fun)
{
if (FIXNUMP(fun)) {
fun = (cl_object)(cl_symbols + fix(fun));
}
FEprogram_error("Wrong number of arguments passed to function ~S.",
1, fun);
}

2
src/h/external.h
View file

@ -512,7 +512,7 @@ extern ECL_API cl_object cl_funcall _ARGS((cl_narg narg, cl_object fun, ...));
extern ECL_API cl_object cl_apply _ARGS((cl_narg narg, cl_object fun, cl_object arg, ...));
extern ECL_API cl_object si_safe_eval _ARGS((cl_narg narg, cl_object form, cl_object env, cl_object value, ...));
#define cl_safe_eval(form,env,value) si_safe_eval(3,form,env,value)
extern ECL_API cl_object *_ecl_va_sp(cl_narg narg);
extern ECL_API cl_object si_unlink_symbol(cl_object s);
extern ECL_API cl_object cl_eval(cl_object form);
extern ECL_API cl_object cl_constantp(cl_narg narg, cl_object arg, ...);

10
src/h/stacks.h
View file

@ -151,13 +151,9 @@ extern ECL_API ecl_frame_ptr _frs_push(register cl_object val);
*/
#define cl_va_start(a,p,n,k) { \
a[0].narg = (n)-(k); \
if ((n) <= C_ARGUMENTS_LIMIT) { \
va_start(a[0].args,p); \
a[0].sp = 0; \
} else { \
a[0].sp = cl_env.stack_top - a[0].narg; \
}}
a[0].narg = (n)-(k); \
va_start(a[0].args,p); \
a[0].sp = ((n) <= C_ARGUMENTS_LIMIT)? 0 : _ecl_va_sp(a[0].narg); }
#define cl_va_arg(a) \
(a[0].narg--,(a[0].sp? *(a[0].sp++) : va_arg(a[0].args,cl_object)))
#define cl_va_copy(dest,orig) { \