diff --git a/src/CHANGELOG b/src/CHANGELOG index 839c32aa6..48a76fa09 100644 --- a/src/CHANGELOG +++ b/src/CHANGELOG @@ -16,6 +16,20 @@ ECL 0.9k: to [[device:[//hostname]]/]... The reason is that this allows proper parsing of Unix pathnames such as "//usr/". + - In interpreted functions, blocks are only created when used. The current + algorithm for detecting unused blocks is inefficient, with a performance + penalty 2^{# unused blocks}, but this seems to pay off when running the + interpreted code, due to decreased consing + > (defun foo () ) + FOO + > (time (dotimes (i 100000) (foo))) + real time : 0.045 secs + run time : 0.048 secs + gc count : 1 times + consed : 160 bytes + Formerly, this would cons 3200192 bytes. + + * CLOS: - When caching generic function calls, ECL now uses a thread-local hash table diff --git a/src/c/compiler.d b/src/c/compiler.d index 52522d0d9..c70feb265 100644 --- a/src/c/compiler.d +++ b/src/c/compiler.d @@ -346,7 +346,7 @@ asm_op2c(register int code, register cl_object o) { static void c_register_block(cl_object name) { - ENV->variables = CONS(cl_list(2, @':block', name), ENV->variables); + ENV->variables = CONS(cl_list(3, @':block', name, Cnil), ENV->variables); } static void @@ -358,7 +358,7 @@ c_register_tags(cl_object all_tags) static void c_register_function(cl_object name) { - ENV->variables = CONS(cl_list(2, @':function', name), ENV->variables); + ENV->variables = CONS(cl_list(3, @':function', name, Cnil), ENV->variables); ENV->macros = CONS(cl_list(2, name, @'function'), ENV->macros); } @@ -468,8 +468,11 @@ c_tag_ref(cl_object the_tag, cl_object the_type) n++; } else if (type == @':block' || type == @':function') { /* We compare with EQUAL, because of (SETF fname) */ - if (type == the_type && ecl_equal(name, the_tag)) + if (type == the_type && ecl_equal(name, the_tag)) { + /* Mark as used */ + CADDR(record) = Ct; return MAKE_FIXNUM(n); + } n++; } else if (Null(name)) { n++; @@ -692,29 +695,42 @@ maybe_reg0(int flags) { */ static int -c_block(cl_object body, int flags) { +c_block(cl_object body, int old_flags) { + struct cl_compiler_env old_env; cl_object name = pop(&body); - cl_object old_env = ENV->variables; - cl_index labelz; + cl_object block_record; + cl_index labelz, pc; + int flags; if (!SYMBOLP(name)) FEprogram_error("BLOCK: Not a valid block name, ~S", 1, name); - flags = maybe_values_or_reg0(flags); + old_env = *ENV; + pc = current_pc(); + + flags = maybe_values_or_reg0(old_flags); c_register_block(name); - if (Null(name)) + block_record = CAR(ENV->variables); + if (Null(name)) { labelz = asm_jmp(OP_DO); - else { + } else { asm_op(OP_BLOCK); asm_c(name); labelz = current_pc(); asm_arg(0); } compile_body(body, flags); - asm_op(OP_EXIT_FRAME); - asm_complete(Null(name)? OP_DO : 0, labelz); - ENV->variables = old_env; - return flags; + if (CADDR(block_record) == Cnil) { + /* Block unused. We remove the enclosing OP_BLOCK/OP_DO */ + *ENV = old_env; + set_pc(pc); + return compile_body(body, old_flags); + } else { + asm_op(OP_EXIT_FRAME); + asm_complete(Null(name)? OP_DO : 0, labelz); + ENV->variables = old_env.variables; + return flags; + } } /* @@ -2116,14 +2132,14 @@ si_process_lambda(cl_object lambda) * VALUES(5) = allow-other-keys ; flag &allow-other-keys * VALUES(6) = (N aux1 init1 ... ) ; auxiliary variables * - * 1°) The prefix "N" is an integer value denoting the number of + * 1°) The prefix "N" is an integer value denoting the number of * variables which are declared within this section of the lambda * list. * - * 2°) The INIT* arguments are lisp forms which are evaluated when + * 2°) The INIT* arguments are lisp forms which are evaluated when * no value is provided. * - * 3°) The FLAG* arguments is the name of a variable which holds a + * 3°) The FLAG* arguments is the name of a variable which holds a * boolean value in case an optional or keyword argument was * provided. If it is NIL, no such variable exists. */ diff --git a/src/c/interpreter.d b/src/c/interpreter.d index 05acd7a54..1fd90a3b6 100644 --- a/src/c/interpreter.d +++ b/src/c/interpreter.d @@ -341,7 +341,6 @@ ecl_apply_lambda(cl_narg narg, cl_object fun) /* Establish bindings */ lambda_bind(narg, fun, args); - /* If it is a named lambda, set a block for RETURN-FROM */ VALUES(0) = Cnil; NVALUES = 0; name = fun->bytecodes.name; diff --git a/src/lsp/config.lsp.in b/src/lsp/config.lsp.in index dbe4f7379..8cf44a865 100644 --- a/src/lsp/config.lsp.in +++ b/src/lsp/config.lsp.in @@ -24,7 +24,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-01-14 22:35)") + "@PACKAGE_VERSION@ (CVS 2008-01-26 14:29)") (defun machine-type () "Args: ()