Let interpreted forms remember the file they come from

src/CHANGELOG

@@ -70,6 +70,9 @@ ECL 0.9k:
    or shadow import the symbols associated to generic versions in the packages
    where methods on these functions are defined.
 
+ - Interpreted forms now remember the file in which they were defined
+   and what form number they represent.
+
 * CLOS:
 
  - When caching generic function calls, ECL now uses a thread-local hash table

src/c/compiler.d

@@ -144,6 +144,8 @@ asm_end(cl_index beginning) {
 	cl_object bytecodes;
 	cl_index code_size, data_size, i;
 	cl_opcode *code;
+	cl_object file = SYM_VAL(@'*load-pathname*');
+	cl_object position = SYM_VAL(@'ext::*load-position*');
 
 	/* Save bytecodes from this session in a new vector */
 	code_size = current_pc() - beginning;
@@ -154,6 +156,8 @@ asm_end(cl_index beginning) {
 	bytecodes->bytecodes.code = cl_alloc_atomic(code_size * sizeof(cl_opcode));
 	bytecodes->bytecodes.data = (cl_object*)cl_alloc(data_size * sizeof(cl_object));
 	bytecodes->bytecodes.lex = Cnil;
+	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_fixnum)cl_env.stack[beginning+i];

src/c/disassembler.d

@@ -671,3 +671,13 @@ si_bc_split(cl_object b)
 	data->vector.self.t = b->bytecodes.data;
 	@(return b->bytecodes.lex vector data)
 }
+
+cl_object
+si_bc_file(cl_object b)
+{
+	if (type_of(b) != t_bytecodes) {
+		@(return Cnil Cnil);
+	} else {
+		@(return b->bytecodes.file b->bytecodes.file_position);
+	}
+}

src/c/load.d

@@ -390,6 +390,8 @@ si_load_source(cl_object source, cl_object verbose, cl_object print)
 			@(return Cnil)
 	}
 	CL_UNWIND_PROTECT_BEGIN {
+		cl_object form_index = MAKE_FIXNUM(0);
+		bds_bind(@'ext::*load-position*', MAKE_FIXNUM(0));
 		for (;;) {
 			x = cl_read(3, strm, Cnil, OBJNULL);
 			if (x == OBJNULL)
@@ -399,7 +401,10 @@ si_load_source(cl_object source, cl_object verbose, cl_object print)
 				@write(1, x);
 				@terpri(0);
 			}
+			form_index = ecl_plus(MAKE_FIXNUM(1),form_index);
+			ECL_SETQ(@'ext::*load-position*', form_index);
 		}
+		bds_unwind1();
 	} CL_UNWIND_PROTECT_EXIT {
 		/* We do not want to come back here if close_stream fails,
 		   therefore, first we frs_pop() current jump point, then

src/c/symbols_list.h

@@ -1690,6 +1690,9 @@ cl_symbols[] = {
 
 {"LOG1P", SI_ORDINARY, si_log1p, 1, OBJNULL},
 
+{EXT_ "*LOAD-POSITION*", SI_SPECIAL, NULL, -1, Cnil},
+{EXT_ "BC-FILE", SI_ORDINARY, si_bc_file, 1, Cnil},
+
 /* Tag for end of list */
 {NULL, CL_ORDINARY, NULL, -1, OBJNULL}};
 

src/c/symbols_list2.h

@@ -1690,6 +1690,9 @@ cl_symbols[] = {
 
 {"LOG1P","si_log1p"},
 
+{EXT_ "*LOAD-POSITION*",NULL},
+{EXT_ "BC-FILE","si_bc_file"},
+
 /* Tag for end of list */
 {NULL,NULL}};
 

src/h/external.h

@@ -465,6 +465,7 @@ extern ECL_API void *ecl_interpret(cl_object bytecodes, void *pc);
 
 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 */
 

src/h/object.h

@@ -464,6 +464,8 @@ struct ecl_bytecodes {
 	cl_index data_size;	/*  number of constants  */
 	char *code;		/*  the intermediate language  */
 	cl_object *data;	/*  non-inmediate constants used in the code  */
+	cl_object file;		/*  file where it was defined...  */
+	cl_index file_position;	/*  and where it was created  */
 };
 
 struct ecl_cfun {		/*  compiled function header  */

src/lsp/config.lsp.in

@@ -46,7 +46,7 @@ Returns, as a string, the location of the machine on which ECL runs."
 (defun lisp-implementation-version ()
   "Args:()
 Returns the version of your ECL as a string."
-  "@PACKAGE_VERSION@ (CVS 2008-04-22 12:25)")
+  "@PACKAGE_VERSION@ (CVS 2008-04-22 14:29)")
 
 (defun machine-type ()
   "Args: ()