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

Functions can now carry information about the source file and its position.

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2009-06-07 01:14:16 +02:00
parent 481873981d
commit f682dda3f4
7 changed files with 78 additions and 23 deletions
Download patch file Download diff file Expand all files Collapse all files

67
src/c/cfun.d
View file

@ -30,6 +30,8 @@ ecl_make_cfun(cl_objectfn_fixed c_function, cl_object name, cl_object cblock, in
cf->cfunfixed.entry_fixed = c_function;
cf->cfunfixed.name = name;
cf->cfunfixed.block = cblock;
cf->cfunfixed.file = Cnil;
cf->cfunfixed.file_position = MAKE_FIXNUM(-1);
cf->cfunfixed.narg = narg;
if (narg < 0 || narg > C_ARGUMENTS_LIMIT)
FEprogram_error("ecl_make_cfun: function requires too many arguments.",0);
@ -46,7 +48,9 @@ ecl_make_cfun_va(cl_objectfn c_function, cl_object name, cl_object cblock)
cf->cfun.name = name;
cf->cfun.block = cblock;
cf->cfun.narg = -1;
return(cf);
cf->cfun.file = Cnil;
cf->cfun.file_position = MAKE_FIXNUM(-1);
return cf;
}
cl_object
@ -58,7 +62,9 @@ ecl_make_cclosure_va(cl_objectfn c_function, cl_object env, cl_object block)
cc->cclosure.entry = c_function;
cc->cclosure.env = env;
cc->cclosure.block = block;
return(cc);
cc->cclosure.file = Cnil;
cc->cclosure.file_position = MAKE_FIXNUM(-1);
return cc;
}
void
@ -166,16 +172,69 @@ si_compiled_function_block(cl_object fun)
switch(type_of(fun)) {
case t_cfun:
case t_cfunfixed:
output = fun->cfun.block; break;
case t_cfunfixed:
output = fun->cfunfixed.block; break;
case t_cclosure:
output = fun->cclosure.block; break;
default:
FEerror("~S is not a compiled-function.", 1, fun);
FEerror("~S is not a C compiled function.", 1, fun);
}
@(return output)
}
cl_object
si_compiled_function_file(cl_object b)
{
cl_env_ptr the_env = ecl_process_env();
BEGIN:
switch (type_of(b)) {
case t_bclosure:
b = b->bclosure.code;
goto BEGIN;
case t_bytecodes:
@(return b->bytecodes.file b->bytecodes.file_position);
case t_cfun:
@(return b->cfun.file b->cfun.file_position);
case t_cfunfixed:
@(return b->cfunfixed.file b->cfunfixed.file_position);
case t_cclosure:
@(return b->cclosure.file b->cclosure.file_position);
default:
@(return Cnil Cnil);
}
}
cl_object
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:
b = b->bclosure.code;
goto BEGIN;
case t_bytecodes:
b->bytecodes.file = source;
b->bytecodes.file_position = position;
break;
case t_cfun:
b->cfun.file = source;
b->cfun.file_position = position;
break;
case t_cfunfixed:
b->cfunfixed.file = source;
b->cfunfixed.file_position = position;
break;
case t_cclosure:
b->cclosure.file = source;
b->cclosure.file_position = position;
break;
default:
FEerror("~S is not a compiled function.", 1, b);
}
}
void
ecl_cmp_defmacro(cl_object fun)
{

4
src/c/compiler.d
View file

@ -173,8 +173,6 @@ asm_end(cl_env_ptr env, cl_index beginning) {
bytecodes->bytecodes.data_size = data_size;
bytecodes->bytecodes.code = ecl_alloc_atomic(code_size * sizeof(cl_opcode));
bytecodes->bytecodes.data = (cl_object*)ecl_alloc(data_size * sizeof(cl_object));
bytecodes->bytecodes.file = (file == OBJNULL)? Cnil : file;
bytecodes->bytecodes.file_position = (position == OBJNULL)? Cnil : position;
for (i = 0, code = (cl_opcode *)bytecodes->bytecodes.code; i < code_size; i++) {
code[i] = (cl_opcode)(cl_fixnum)(env->stack[beginning+i]);
}
@ -183,6 +181,8 @@ asm_end(cl_env_ptr env, cl_index beginning) {
c_env->constants = ECL_CONS_CDR(c_env->constants);
}
bytecodes->bytecodes.entry = _ecl_bytecodes_dispatch_vararg;
ecl_set_function_source_file_info(bytecodes, (file == OBJNULL)? Cnil : file,
(file == OBJNULL)? Cnil : position);
asm_clear(env, beginning);
return bytecodes;
}

14
src/c/disassembler.d
View file

@ -631,17 +631,3 @@ si_bc_split(cl_object b)
data->vector.self.t = b->bytecodes.data;
@(return lex vector data)
}
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;
}
if (type_of(b) != t_bytecodes) {
@(return Cnil Cnil);
} else {
@(return b->bytecodes.file b->bytecodes.file_position);
}
}

3
src/c/symbols_list.h
View file

@ -1705,7 +1705,8 @@ cl_symbols[] = {
{"LOG1P", SI_ORDINARY, si_log1p, 1, OBJNULL},
{EXT_ "BC-FILE", EXT_ORDINARY, si_bc_file, 1, Cnil},
{EXT_ "BC-FILE", EXT_ORDINARY, si_compiled_function_file, 1, Cnil},
{EXT_ "COMPILED-FUNCTION-FILE", EXT_ORDINARY, si_compiled_function_file, 1, Cnil},
{SYS_ "PROPERTY-LIST", SI_ORDINARY, NULL, 1, OBJNULL},

3
src/c/symbols_list2.h
View file

@ -1705,7 +1705,8 @@ cl_symbols[] = {
{"LOG1P","si_log1p"},
{EXT_ "BC-FILE","si_bc_file"},
{EXT_ "BC-FILE","si_compiled_function_file"},
{EXT_ "COMPILED-FUNCTION-FILE","si_compiled_function_file"},
{SYS_ "PROPERTY-LIST",NULL},

4
src/h/external.h
View file

@ -363,6 +363,7 @@ extern ECL_API double big_to_double(cl_object x);
extern ECL_API cl_object si_compiled_function_name(cl_object fun);
extern ECL_API cl_object si_compiled_function_block(cl_object fun);
extern ECL_API cl_object cl_function_lambda_expression(cl_object fun);
extern ECL_API cl_object si_compiled_function_file(cl_object fun);
extern ECL_API cl_object ecl_make_cfun(cl_objectfn_fixed c_function, cl_object name, cl_object block, int narg);
extern ECL_API cl_object ecl_make_cfun_va(cl_objectfn c_function, cl_object name, cl_object block);
@ -371,6 +372,7 @@ extern ECL_API void ecl_def_c_function(cl_object sym, cl_objectfn_fixed c_functi
extern ECL_API void ecl_def_c_macro(cl_object sym, cl_objectfn_fixed c_function, int narg);
extern ECL_API void ecl_def_c_macro_va(cl_object sym, cl_objectfn c_function);
extern ECL_API void ecl_def_c_function_va(cl_object sym, cl_objectfn c_function);
extern ECL_API cl_object ecl_set_function_source_file_info(cl_object fun, cl_object source, cl_object position);
extern ECL_API void ecl_cmp_defmacro(cl_object data);
extern ECL_API void ecl_cmp_defun(cl_object data);
@ -492,7 +494,6 @@ extern ECL_API cl_object _ecl_bclosure_dispatch(cl_narg narg, ...);
extern ECL_API cl_object si_bc_disassemble(cl_object v);
extern ECL_API cl_object si_bc_split(cl_object v);
extern ECL_API cl_object si_bc_file(cl_object v);
/* error.c */
@ -1903,6 +1904,7 @@ extern ECL_API cl_object clos_standard_instance_set _ARGS((cl_narg narg, cl_obje
#define cl_make_cfun(fun,name,block,narg) ecl_make_cfun(fun,name,block,narg)
#define cl_make_cfun_va(fun,name,block) ecl_make_cfun_va(fun,name,block)
#define cl_make_cclosure_va(fun,name,block) ecl_make_cclosure_va(fun,name,block)
#define si_bc_file(o) si_compiled_function_file(o)
#ifdef __cplusplus
}

6
src/h/object.h
View file

@ -687,6 +687,8 @@ struct ecl_cfun { /* compiled function header */
cl_object name; /* compiled function name */
cl_object block; /* descriptor of C code block for GC */
cl_objectfn entry; /* entry address */
cl_object file; /* file where it was defined... */
cl_object file_position;/* and where it was created */
};
struct ecl_cfunfixed { /* compiled function header */
@ -695,6 +697,8 @@ struct ecl_cfunfixed { /* compiled function header */
cl_object block; /* descriptor of C code block for GC */
cl_objectfn entry; /* entry address */
cl_objectfn_fixed entry_fixed; /* entry address */
cl_object file; /* file where it was defined... */
cl_object file_position;/* and where it was created */
};
struct ecl_cclosure { /* compiled closure header */
@ -702,6 +706,8 @@ struct ecl_cclosure { /* compiled closure header */
cl_object env; /* environment */
cl_object block; /* descriptor of C code block for GC */
cl_objectfn entry; /* entry address */
cl_object file; /* file where it was defined... */
cl_object file_position;/* and where it was created */
};
#define ECL_FFICALL_LIMIT 256