mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-01-24 05:21:20 -08:00
Merge branch 'cmp-fix-macrolet' into develop
This commit is contained in:
Daniel Kochmanski
commit
76b78660b2
12 changed files with 294 additions and 135 deletions
|
|
@ -35,31 +35,44 @@
|
|||
(error 'simple-type-error
|
||||
:datum thing
|
||||
:expected-type '(OR FUNCTION (SATISFIES SI:VALID-FUNCTION-NAME-P))
|
||||
:format-control "DISASSEMBLE cannot accept ~A"
|
||||
:format-control "DISASSEMBLE cannot accept ~A."
|
||||
:format-arguments (list thing))))
|
||||
nil)
|
||||
|
||||
(defun bc-compile (name &optional (def nil supplied-p) &aux form)
|
||||
(cond ((and supplied-p def)
|
||||
(when (functionp def)
|
||||
(unless (function-lambda-expression def)
|
||||
(return-from bc-compile (values def nil nil)))
|
||||
(setf def (function-lambda-expression def)))
|
||||
(setq form (if name
|
||||
`(progn (setf (symbol-function ',name) #',def) ',name)
|
||||
`(setq GAZONK #',def))))
|
||||
((not (fboundp name))
|
||||
(error "Symbol ~s is unbound." name))
|
||||
((typep (setf def (symbol-function name)) 'standard-generic-function)
|
||||
(warn "COMPILE can not compile generic functions yet")
|
||||
(return-from bc-compile (values def t nil)))
|
||||
((null (setq form (function-lambda-expression def)))
|
||||
(warn "We have lost the original function definition for ~s. Compilation failed"
|
||||
name)
|
||||
(return-from bc-compile (values def t nil)))
|
||||
(t
|
||||
(setq form `(progn (setf (symbol-function ',name) #',form) ',name))))
|
||||
(values (eval form) nil nil))
|
||||
(defun bc-compile (name &optional (definition nil def-p) &aux (*print-pretty* nil))
|
||||
(check-type name (or (satisfies si:valid-function-name-p) nil))
|
||||
(when def-p (check-type definition (or function cons)))
|
||||
(cond ((functionp definition)
|
||||
(multiple-value-bind (form lexenv) (function-lambda-expression definition)
|
||||
(when form
|
||||
(if lexenv
|
||||
(setf definition (si:eval-with-env form lexenv))
|
||||
(setf definition (si:eval-with-env form nil nil nil t)))))
|
||||
(when name (setf (fdefinition name) definition))
|
||||
(return-from bc-compile (values (or name definition) nil nil)))
|
||||
((not (null definition))
|
||||
(unless (member (car definition) '(LAMBDA EXT:LAMBDA-BLOCK))
|
||||
(format t "~&;;; Error: Not a valid lambda expression: ~s." definition)
|
||||
(return-from bc-compile (values nil t t)))
|
||||
(setq definition (si:eval-with-env definition nil nil nil t))
|
||||
(when name (setf (fdefinition name) definition))
|
||||
(return-from bc-compile (values (or name definition) nil nil)))
|
||||
((not (fboundp name))
|
||||
(error "Function name ~s is unbound." name))
|
||||
((typep (fdefinition name) 'standard-generic-function)
|
||||
(warn "COMPILE can not compile generic functions yet.")
|
||||
(return-from bc-compile (values name t nil)))
|
||||
(T
|
||||
(multiple-value-bind (form lexenv)
|
||||
(function-lambda-expression (fdefinition name))
|
||||
(when form
|
||||
(if lexenv
|
||||
(setf definition (si:eval-with-env form lexenv))
|
||||
(setf definition (si:eval-with-env form nil nil nil t)))))
|
||||
(when (null definition)
|
||||
(warn "We have lost the original function definition for ~s." name)
|
||||
(return-from bc-compile (values name t nil)))
|
||||
(return-from bc-compile (values name nil nil)))))
|
||||
|
||||
(defun bc-compile-file-pathname (name &key (output-file name) (type :fasl)
|
||||
verbose print c-file h-file data-file
|
||||
|
|
@ -83,7 +96,7 @@
|
|||
(pathname output-file)
|
||||
(bc-compile-file-pathname input)))
|
||||
(when *compile-verbose*
|
||||
(format t "~&;;; Compiling ~A" input))
|
||||
(format t "~&;;; Compiling ~A." input))
|
||||
(cond ((not (streamp input))
|
||||
(let* ((ext:*source-location* (cons (truename input) 0))
|
||||
(*compile-file-pathname* (pathname (merge-pathnames input)))
|
||||
|
|
@ -129,11 +142,10 @@
|
|||
|
||||
#-ecl-min
|
||||
(progn
|
||||
#+(and dlopen (not windows))
|
||||
(sys::autoload "SYS:cmp" 'compile-file 'compile 'compile-file-pathname 'disassemble)
|
||||
#-(and dlopen (not windows))
|
||||
(install-bytecodes-compiler)
|
||||
)
|
||||
#+(and dlopen (not windows))
|
||||
(sys::autoload "SYS:cmp" 'compile-file 'compile 'compile-file-pathname 'disassemble)
|
||||
#-(and dlopen (not windows))
|
||||
(install-bytecodes-compiler))
|
||||
|
||||
(provide '#:BYTECMP)
|
||||
|
||||
|
|
|
|||
|
|
@ -393,38 +393,35 @@ asm_op2c(cl_env_ptr env, int code, cl_object o) {
|
|||
* (:function function-name used-p [location]) |
|
||||
* (var-name {:special | nil} bound-p [location]) |
|
||||
* (symbol si::symbol-macro macro-function) |
|
||||
* CB | LB | UNWIND-PROTECT |
|
||||
* ECI:FUNCTION | ECI:UNWIND-PROTECT |
|
||||
* (:declare declaration-arguments*)
|
||||
* macro-record = (function-name FUNCTION [| function-object]) |
|
||||
* (macro-name si::macro macro-function)
|
||||
* CB | LB | UNWIND-PROTECT
|
||||
* ECI:FUNCTION | ECI:UNWIND-PROTECT
|
||||
*
|
||||
* A *-NAME is a symbol. A TAG-ID is either a symbol or a number. A
|
||||
* MACRO-FUNCTION is a function that provides us with the expansion
|
||||
* for that local macro or symbol macro. BOUND-P is true when the
|
||||
* variable has been bound by an enclosing form, while it is NIL if
|
||||
* the variable-record corresponds just to a special declaration.
|
||||
* CB, LB and UNWIND-PROTECT are only used by the C compiler and they
|
||||
* denote closure, lexical environment and unwind-protect boundaries.
|
||||
* MACRO-FUNCTION is a function that provides us with the expansion for that
|
||||
* local macro or symbol macro. BOUND-P is true when the variable has been bound
|
||||
* by an enclosing form, while it is NIL if the variable-record corresponds just
|
||||
* to a special declaration. ECI:FUNCTION and ECIUNWIND-PROTECT are only used
|
||||
* by the C compiler and they denote function and unwind-protect boundaries.
|
||||
*
|
||||
* The brackets [] denote differences between the bytecodes and C
|
||||
* compiler environments, with the first option belonging to the
|
||||
* interpreter and the second alternative to the compiler.
|
||||
* The brackets [] denote differences between the bytecodes and C compiler
|
||||
* environments, with the first option belonging to the interpreter and the
|
||||
* second alternative to the compiler.
|
||||
*
|
||||
* A LOCATION object is proper to the bytecodes compiler and denotes
|
||||
* the position of this variable, block, tag or function, in the
|
||||
* lexical environment. Currently, it is a CONS with two integers
|
||||
* (DEPTH . ORDER), denoting the depth of the nested environments and
|
||||
* the position in the environment (from the beginning, not from the
|
||||
* tail).
|
||||
* A LOCATION object is proper to the bytecodes compiler and denotes the
|
||||
* position of this variable, block, tag or function, in the lexical
|
||||
* environment. Currently, it is a CONS with two integers (DEPTH . ORDER),
|
||||
* denoting the depth of the nested environments and the position in the
|
||||
* environment (from the beginning, not from the tail).
|
||||
*
|
||||
* The BLOCK-, TAG- and FUNCTION- objects are proper of the compiler
|
||||
* and carry further information.
|
||||
* The BLOCK-, TAG- and FUNCTION- objects are proper of the compiler and carry
|
||||
* further information.
|
||||
*
|
||||
* The last variable records are devoted to declarations and are only
|
||||
* used by the C compiler. Read cmpenv.lsp for more details on the
|
||||
* structure of these declaration forms, as they do not completely
|
||||
* match those of Common-Lisp.
|
||||
* The last variable records are devoted to declarations and are only used by
|
||||
* the C compiler. Read cmpenv.lsp for more details on the structure of these
|
||||
* declaration forms, as they do not completely match those of Common-Lisp.
|
||||
*/
|
||||
|
||||
#if 0
|
||||
|
|
@ -970,12 +967,12 @@ c_funcall(cl_env_ptr env, cl_object args, int flags) {
|
|||
cl_object kind = ECL_CONS_CAR(name);
|
||||
if (kind == @'function') {
|
||||
if (cl_list_length(name) != ecl_make_fixnum(2))
|
||||
FEprogram_error("FUNCALL: Invalid function name ~S", 1, name);
|
||||
FEprogram_error("FUNCALL: Invalid function name ~S.", 1, name);
|
||||
return c_call(env, CONS(CADR(name), args), flags);
|
||||
}
|
||||
if (kind == @'quote') {
|
||||
if (cl_list_length(name) != ecl_make_fixnum(2))
|
||||
FEprogram_error("FUNCALL: Invalid function name ~S", 1, name);
|
||||
FEprogram_error("FUNCALL: Invalid function name ~S.", 1, name);
|
||||
return c_call(env, CONS(CADR(name), args), flags | FLAG_GLOBAL);
|
||||
}
|
||||
}
|
||||
|
|
@ -1397,14 +1394,11 @@ c_flet(cl_env_ptr env, cl_object args, int flags) {
|
|||
|
||||
|
||||
/*
|
||||
There are two operators that produce functions. The first one
|
||||
is
|
||||
[OP_FUNCTION + name]
|
||||
which takes the function binding of SYMBOL. The second one is
|
||||
OP_CLOSE
|
||||
interpreted
|
||||
which encloses the INTERPRETED function in the current lexical
|
||||
environment.
|
||||
There are two operators that produce functions. The first one is
|
||||
[OP_FUNCTION + name] which takes the function binding of SYMBOL.
|
||||
|
||||
The second one is OP_CLOSE interpreted which encloses the INTERPRETED
|
||||
function in the current lexical environment.
|
||||
*/
|
||||
static int
|
||||
c_function(cl_env_ptr env, cl_object args, int flags) {
|
||||
|
|
@ -1440,12 +1434,12 @@ asm_function(cl_env_ptr env, cl_object function, int flags) {
|
|||
} else {
|
||||
goto ERROR;
|
||||
}
|
||||
{
|
||||
const cl_compiler_ptr c_env = env->c_env;
|
||||
asm_op2c(env,
|
||||
(Null(c_env->variables) && Null(c_env->macros)) ? OP_QUOTE : OP_CLOSE,
|
||||
ecl_make_lambda(env, name, body));
|
||||
}
|
||||
|
||||
const cl_compiler_ptr c_env = env->c_env;
|
||||
asm_op2c(env,
|
||||
(Null(c_env->variables) && Null(c_env->macros)) ? OP_QUOTE : OP_CLOSE,
|
||||
ecl_make_lambda(env, name, body));
|
||||
|
||||
return FLAG_REG0;
|
||||
}
|
||||
ERROR:
|
||||
|
|
@ -2977,7 +2971,7 @@ ecl_make_lambda(cl_env_ptr env, cl_object name, cl_object lambda) {
|
|||
|
||||
/* Transform (SETF fname) => fname */
|
||||
if (!Null(name) && Null(si_valid_function_name_p(name)))
|
||||
FEprogram_error("LAMBDA: Not a valid function name ~S",1,name);
|
||||
FEprogram_error("LAMBDA: Not a valid function name ~S.",1,name);
|
||||
|
||||
/* We register as special variable a symbol which is not
|
||||
* to be used. We use this to mark the boundary of a function
|
||||
|
|
|
|||
|
|
@ -436,7 +436,7 @@ void
|
|||
FEinvalid_function_name(cl_object fname)
|
||||
{
|
||||
cl_error(9, @'simple-type-error', @':format-control',
|
||||
make_constant_base_string("Not a valid function name ~D"),
|
||||
make_constant_base_string("Not a valid function name ~D."),
|
||||
@':format-arguments', cl_list(1, fname),
|
||||
@':expected-type', cl_list(2, @'satisfies', @'si::valid-function-name-p'),
|
||||
@':datum', fname);
|
||||
|
|
|
|||
|
|
@ -206,9 +206,11 @@ _ecl_bclosure_dispatch_vararg(cl_narg narg, ...)
|
|||
|
||||
static cl_object
|
||||
close_around(cl_object fun, cl_object lex) {
|
||||
cl_object v = ecl_alloc_object(t_bclosure);
|
||||
cl_object v;
|
||||
if (Null(lex)) return fun;
|
||||
if (ecl_t_of(fun) != t_bytecodes)
|
||||
FEerror("!!!", 0);
|
||||
FEerror("Internal error: close_around should be called on t_bytecodes.", 0);
|
||||
v = ecl_alloc_object(t_bclosure);
|
||||
v->bclosure.code = fun;
|
||||
v->bclosure.lex = lex;
|
||||
v->bclosure.entry = _ecl_bclosure_dispatch_vararg;
|
||||
|
|
|
|||
|
|
@ -58,9 +58,8 @@ search_macro_function(cl_object name, cl_object env)
|
|||
{
|
||||
int type = ecl_symbol_type(name);
|
||||
if (env != ECL_NIL) {
|
||||
/* When the environment has been produced by the
|
||||
compiler, there might be atoms/symbols signalling
|
||||
closure and block boundaries. */
|
||||
/* When the environment has been produced by the compiler, there might be
|
||||
atoms/symbols signaling function and unwind-protect boundaries. */
|
||||
while (!Null(env = CDR(env))) {
|
||||
cl_object record = CAR(env);
|
||||
if (CONSP(record) && CAR(record) == name) {
|
||||
|
|
|
|||
|
|
@ -68,6 +68,9 @@
|
|||
(unoptimized-long-call `#',fname args)))
|
||||
((setq fd (local-function-ref fname))
|
||||
(c1call-local fname fd args))
|
||||
((and macros-allowed ; macrolet
|
||||
(setq fd (cmp-env-search-macro fname)))
|
||||
(cmp-expand-macro fd (list* fname args)))
|
||||
((and (setq can-inline (inline-possible fname))
|
||||
(setq fd (compiler-macro-function fname))
|
||||
(progn
|
||||
|
|
@ -81,8 +84,8 @@
|
|||
(clos-compiler-macro-expand fname args))
|
||||
success))
|
||||
fd)
|
||||
((and macros-allowed
|
||||
(setq fd (cmp-macro-function fname)))
|
||||
((and macros-allowed ; global macro
|
||||
(setq fd (macro-function fname)))
|
||||
(cmp-expand-macro fd (list* fname args)))
|
||||
((and (setq can-inline (declared-inline-p fname))
|
||||
(consp can-inline)
|
||||
|
|
|
|||
|
|
@ -755,7 +755,7 @@ If NAME is NIL, then the compiled function is not installed but is simply
|
|||
returned as the value of COMPILE. In any case, COMPILE creates temporary
|
||||
files, whose filenames begin with \"gazonk\", which are automatically deleted
|
||||
after compilation."
|
||||
(unless (symbolp name) (error "~s is not a symbol." name))
|
||||
(unless (si:valid-function-name-p name) (error "~s is not a valid function name." name))
|
||||
|
||||
(cond ((and supplied-p def)
|
||||
(when (functionp def)
|
||||
|
|
@ -763,11 +763,11 @@ after compilation."
|
|||
(return-from compile def))
|
||||
(setf def (function-lambda-expression def)))
|
||||
(setq form (if name
|
||||
`(setf (symbol-function ',name) #',def)
|
||||
`(setf (fdefinition ',name) #',def)
|
||||
`(set 'GAZONK #',def))))
|
||||
((not (fboundp name))
|
||||
(error "Symbol ~s is unbound." name))
|
||||
((typep (setf def (symbol-function name)) 'standard-generic-function)
|
||||
((typep (setf def (fdefinition name)) 'standard-generic-function)
|
||||
(warn "COMPILE can not compile generic functions yet")
|
||||
(return-from compile (values def t nil)))
|
||||
((null (setq form (function-lambda-expression def)))
|
||||
|
|
@ -775,7 +775,7 @@ after compilation."
|
|||
name)
|
||||
(return-from compile (values def t nil)))
|
||||
(t
|
||||
(setq form `(setf (symbol-function ',name) #',form))))
|
||||
(setq form `(setf (fdefinition ',name) #',form))))
|
||||
|
||||
(let*((*load-time-values* 'values) ;; Only the value is kept
|
||||
(tmp-names (safe-mkstemp (format nil "TMP:ECL~3,'0x" (incf *gazonk-counter*))))
|
||||
|
|
|
|||
|
|
@ -965,6 +965,9 @@ compiled function is notated in either of the following formats:
|
|||
#<compiled-closure nil>
|
||||
where S is actually the symbol that names the function.")
|
||||
|
||||
(docfun si::compiled-function-file function (function) "
|
||||
Returns two values: a pathname and a position of the function definition.")
|
||||
|
||||
(docfun si::compiled-function-name function (compiled-function) "
|
||||
ECL specific.
|
||||
Returns the function name associated with COMPILED-FUNCTION.")
|
||||
|
|
@ -1256,9 +1259,17 @@ Evaluates FORM and returns all values.")
|
|||
(docfun eval-when special ((&rest situation) &body forms) "
|
||||
Specifies when to evaluate FORMs. Each SITUATION must be one of the following
|
||||
symbols.
|
||||
COMPILE (compile-time)
|
||||
LOAD (load-time of the fasl file)
|
||||
EVAL (load-time of the source file)")
|
||||
:COMPILE-TOPLEVEL (compile-time)
|
||||
:LOAD-TOPLEVEL (load-time of the fasl file)
|
||||
:EXECUTE (load-time of the source file)")
|
||||
|
||||
(docfun si::eval-with-env function
|
||||
(form &optional env stepping compiler-env-p (execute t)) "
|
||||
Evaluates FORM in provided env. ENV is either lexical environment or compiler
|
||||
environment (depends on flag COMPILER-ENV-P).
|
||||
|
||||
STEPPING = T augments all calls with OP_STEPCALL
|
||||
EXECUTE = NIL compiles form to bytecode without executing it.")
|
||||
|
||||
(docfun evalhook function (form fun1 fun2 &optional (env nil)) "
|
||||
Evaluates FORM with *EVALHOOK* bound to FUN1 and *APPLYHOOK* bound to FUN2,
|
||||
|
|
|
|||
|
|
@ -91,9 +91,9 @@ Let us see an example. Suppose the following function has been compiled.
|
|||
|
||||
@verbatim
|
||||
(defun foo (x)
|
||||
(let ((a #'(lambda () (incf x)))
|
||||
(y x))
|
||||
(values a #'(lambda () (incf x y)))))
|
||||
(let ((a #'(lambda () (incf x)))
|
||||
(y x))
|
||||
(values a #'(lambda () (incf x y)))))
|
||||
@end verbatim
|
||||
|
||||
@code{foo} returns two compiled closures. The first closure increments @var{x} by one, whereas the second closure increments @var{x} by the initial value of @var{x}. Both closures return the incremented value of @var{x}.
|
||||
|
|
@ -126,23 +126,22 @@ After this, the two compiled closures look like:
|
|||
|
||||
* : address of the compiled code for #'(lambda () (incf x))
|
||||
** : address of the compiled code for #'(lambda () (incf x y))
|
||||
|
||||
@end verbatim
|
||||
|
||||
@subsection Use of Declarations to Improve Efficiency
|
||||
Declarations, especially type and function declarations, increase the efficiency of the compiled code. For example, for the following Lisp source file, with two Common-Lisp declarations added,
|
||||
|
||||
@verbatim
|
||||
(eval-when (compile)
|
||||
(proclaim '(function tak (fixnum fixnum fixnum) fixnum))
|
||||
(eval-when (:compile-toplevel)
|
||||
(proclaim '(function tak (fixnum fixnum fixnum) fixnum))
|
||||
|
||||
(defun tak (x y z)
|
||||
(declare (fixnum x y z))
|
||||
(if (not (< y x))
|
||||
z
|
||||
(tak (tak (1- x) y z)
|
||||
(tak (1- y) z x)
|
||||
(tak (1- z) x y))))
|
||||
(declare (fixnum x y z))
|
||||
(if (not (< y x))
|
||||
z
|
||||
(tak (tak (1- x) y z)
|
||||
(tak (1- y) z x)
|
||||
(tak (1- z) x y))))
|
||||
@end verbatim
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -15,49 +15,85 @@ ECL uses the following stacks:
|
|||
@end multitable
|
||||
|
||||
@subsection Procedure Call Conventions
|
||||
ECL employs standard C calling conventions to achieve efficiency and interoperability with other languages. Each Lisp function is implemented as a C function which takes as many argument as the Lisp original plus one additional integer argument which holds the number of actual arguments. The function sets @code{NValues} to the number of Lisp values produced, it returns the first one and the remaining ones are kept in a global (per thread) array (@code{VALUES}).
|
||||
ECL employs standard C calling conventions to achieve efficiency and
|
||||
interoperability with other languages. Each Lisp function is
|
||||
implemented as a C function which takes as many argument as the Lisp
|
||||
original plus one additional integer argument which holds the number
|
||||
of actual arguments. The function sets @code{NValues} to the number of
|
||||
Lisp values produced, it returns the first one and the remaining ones
|
||||
are kept in a global (per thread) array (@code{VALUES}).
|
||||
|
||||
To show the argument/value passing mechanism, here we list the actual code for the Common-Lisp function cons.
|
||||
To show the argument/value passing mechanism, here we list the actual
|
||||
code for the Common-Lisp function cons.
|
||||
|
||||
@verbatim
|
||||
cl_cons(int narg, object car, object cdr)
|
||||
{ object x;
|
||||
check_arg(2);
|
||||
x = alloc_object(t_cons);
|
||||
CAR(x) = car;
|
||||
CDR(x) = cdr;
|
||||
NValues = 1;
|
||||
return x;
|
||||
}
|
||||
cl_cons(int narg, object car, object cdr) {
|
||||
object x;
|
||||
check_arg(2);
|
||||
x = alloc_object(t_cons);
|
||||
CAR(x) = car;
|
||||
CDR(x) = cdr;
|
||||
NValues = 1;
|
||||
return x;
|
||||
}
|
||||
@end verbatim
|
||||
|
||||
ECL adopts the convention that the name of a function that implements a Common-Lisp function begins with a short package name (@code{cl} for @code{COMMON-LISP}, @code{si} for @code{SYSTEM}, etc), followed by @code{L}, and followed by the name of the Common-Lisp function. (Strictly speaking, `@code{-}' and `@code{*}' in the Common-Lisp function name are replaced by `@code{_}' and `@code{A}', respectively, to obey the syntax of C.)
|
||||
ECL adopts the convention that the name of a function that implements
|
||||
a Common-Lisp function begins with a short package name (@code{cl} for
|
||||
@code{COMMON-LISP}, @code{si} for @code{SYSTEM}, etc), followed by
|
||||
@code{L}, and followed by the name of the Common-Lisp
|
||||
function. (Strictly speaking, `@code{-}' and `@code{*}' in the
|
||||
Common-Lisp function name are replaced by `@code{_}' and `@code{A}',
|
||||
respectively, to obey the syntax of C.)
|
||||
|
||||
@code{check_arg(2)} in the code of @code{cl_cons} checks that exactly two arguments are supplied to @code{cons}. That is, it checks that @code{narg} is 2, and otherwise, it causes an error. @code{allocate_object(t_cons)} allocates a cons cell in the heap and returns the pointer to the cell. After the @code{CAR} and the @code{CDR} fields of the cell are set, the cell pointer is returned directly. The number assigned to @code{NValues} set by the function (1 in this case) represents the number of values of the function.
|
||||
@code{check_arg(2)} in the code of @code{cl_cons} checks that exactly
|
||||
two arguments are supplied to @code{cons}. That is, it checks that
|
||||
@code{narg} is 2, and otherwise, it causes an
|
||||
error. @code{allocate_object(t_cons)} allocates a cons cell in the
|
||||
heap and returns the pointer to the cell. After the @code{CAR} and the
|
||||
@code{CDR} fields of the cell are set, the cell pointer is returned
|
||||
directly. The number assigned to @code{NValues} set by the function (1
|
||||
in this case) represents the number of values of the function.
|
||||
|
||||
In general, if one is to play with the C kernel of ECL there is no need to know about all these conventions. There is a preprocessor that takes care of the details, by using a lisp representation of the statements that output values, and of the function definitions. For instance, the actual source code for @code{cl_cons} in @code{src/c/lists.d}
|
||||
In general, if one is to play with the C kernel of ECL there is no
|
||||
need to know about all these conventions. There is a preprocessor that
|
||||
takes care of the details, by using a lisp representation of the
|
||||
statements that output values, and of the function definitions. For
|
||||
instance, the actual source code for @code{cl_cons} in
|
||||
@code{src/c/lists.d}
|
||||
|
||||
@verbatim
|
||||
@(defun cons (car cdr)
|
||||
@
|
||||
@(return CONS(car, cdr))
|
||||
@)
|
||||
@(defun cons (car cdr)
|
||||
@
|
||||
@(return CONS(car, cdr))
|
||||
@)
|
||||
@end verbatim
|
||||
|
||||
@subsection The lexical environment
|
||||
The ECL interpreter uses two A-lists (Association lists) to represent lexical environments.
|
||||
The ECL interpreter uses two A-lists (Association lists) to represent
|
||||
lexical environments.
|
||||
|
||||
@itemize
|
||||
@item One for variable bindings
|
||||
@item One for local function/macro/tag/block bindings
|
||||
@end itemize
|
||||
|
||||
When a function closure is created, the current two A-lists are saved in the closure along with the lambda expression. Later, when the closure is invoked, the saved A-lists are used to recover the lexical environment.
|
||||
When a function closure is created, the current two A-lists are saved
|
||||
in the closure along with the lambda expression. Later, when the
|
||||
closure is invoked, the saved A-lists are used to recover the lexical
|
||||
environment.
|
||||
|
||||
@subsection The interpreter stack
|
||||
The bytecodes interpreter uses a stack of its own to save and restore values from intermediate calculations. This Forth-like data stack is also used in other parts of the C kernel for various purposes, such as saving compiled code, keeping arguments to @code{FORMAT}, etc.
|
||||
|
||||
However, one of the most important roles of the Interpreter Stack is to keep a log of the functions which are called during the execution of bytecodes. For each function invoked, the interpreter keeps three lisp objects on the stack:
|
||||
The bytecodes interpreter uses a stack of its own to save and restore
|
||||
values from intermediate calculations. This Forth-like data stack is
|
||||
also used in other parts of the C kernel for various purposes, such as
|
||||
saving compiled code, keeping arguments to @code{FORMAT}, etc.
|
||||
|
||||
However, one of the most important roles of the Interpreter Stack is
|
||||
to keep a log of the functions which are called during the execution
|
||||
of bytecodes. For each function invoked, the interpreter keeps three
|
||||
lisp objects on the stack:
|
||||
|
||||
@verbatim
|
||||
+----------+------------------------------------------------+
|
||||
|
|
@ -65,25 +101,30 @@ However, one of the most important roles of the Interpreter Stack is to keep a l
|
|||
+----------+---------------------+--------------------------+
|
||||
@end verbatim
|
||||
|
||||
The first item is the object which is funcalled. It can be a bytecodes object, a compiled function or a generic function. In the last two cases the lexical environment is just @code{NIL}. In the first case, the second item on the stack is the lexical environment on which the code is executed. Each of these records are popped out of the stack after function invocation.
|
||||
The first item is the object which is funcalled. It can be a bytecodes
|
||||
object, a compiled function or a generic function. In the last two
|
||||
cases the lexical environment is just @code{NIL}. In the first case,
|
||||
the second item on the stack is the lexical environment on which the
|
||||
code is executed. Each of these records are popped out of the stack
|
||||
after function invocation.
|
||||
|
||||
Let us see how these invocation records are used for debugging.
|
||||
|
||||
@verbatim
|
||||
>(defun fact (x) ;;; Wrong definition of the
|
||||
(if (= x 0) ;;; factorial function.
|
||||
one ;;; one should be 1.
|
||||
(* x (fact (1- x)))))
|
||||
> (defun fact (x) ;;; Wrong definition of the
|
||||
(if (= x 0) ;;; factorial function.
|
||||
one ;;; one should be 1.
|
||||
(* x (fact (1- x)))))
|
||||
FACT
|
||||
|
||||
>(fact 3) ;;; Tries 3!
|
||||
> (fact 3) ;;; Tries 3!
|
||||
Error: The variable ONE is unbound.
|
||||
Error signalled by IF.
|
||||
Broken at IF.
|
||||
>>:b ;;; Backtrace.
|
||||
>> :b ;;; Backtrace.
|
||||
Backtrace: eval > fact > if > fact > if > fact > if > fact > IF
|
||||
;;; Currently at the last IF.
|
||||
>>:h ;;; Help.
|
||||
>> :h ;;; Help.
|
||||
|
||||
Break commands:
|
||||
:q(uit) Return to some previous break level.
|
||||
|
|
@ -119,23 +160,23 @@ Let us see how these invocation records are used for debugging.
|
|||
:doc(ument) Document.
|
||||
:h(elp) or ? Help. Type ":help help" for more information.
|
||||
|
||||
>>:p ;;; Move to the last call of FACT.
|
||||
>> :p ;;; Move to the last call of FACT.
|
||||
Broken at IF.
|
||||
|
||||
>>:b
|
||||
>> :b
|
||||
Backtrace: eval > fact > if > fact > if > fact > if > FACT > if
|
||||
;;; Now at the last FACT.
|
||||
>>:v ;;; The environment at the last call
|
||||
>> :v ;;; The environment at the last call
|
||||
Local variables: ;;; to FACT is recovered.
|
||||
X: 0 ;;; X is the only bound variable.
|
||||
X: 0 ;;; X is the only bound variable.
|
||||
Block names: FACT. ;;; The block FACT is established.
|
||||
|
||||
>>x
|
||||
>> x
|
||||
0 ;;; The value of x is 0.
|
||||
|
||||
>>(return-from fact 1) ;;; Return from the last call of
|
||||
6 ;;; FACT with the value of 0.
|
||||
;;; The execution is resumed and
|
||||
;;; The execution is resumed and
|
||||
> ;;; the value 6 is returned.
|
||||
;;; Again at the top-level loop.
|
||||
@end verbatim
|
||||
|
|
|
|||
|
|
@ -22,13 +22,13 @@ The number in the @ecl{} banner identifies the revision of
|
|||
@ecl{}. @code{0.0e} is the value of the function
|
||||
@code{lisp-implementation-version}.
|
||||
|
||||
Unless user specifies @code{-norc} flag when invoking the @ecl{}, it
|
||||
Unless user specifies @code{--norc} flag when invoking the @ecl{}, it
|
||||
will look for the initialization files @file{~/.ecl} and
|
||||
@file{~/.eclrc}. If he wants to load his own file from the current
|
||||
directory, then he should pass the file path to the @code{-load}
|
||||
parameter:
|
||||
@example
|
||||
% ecl -norc -load init.lisp
|
||||
% ecl --norc --load init.lisp
|
||||
@end example
|
||||
|
||||
After the initialization, @ecl{} enters the @dfn{top-level loop} and
|
||||
|
|
@ -62,7 +62,7 @@ To exit from @ecl{}, call the function @code{quit}.
|
|||
%
|
||||
@end example
|
||||
|
||||
Alternatively, you may type @myctrl{D} , i.e. press the key @key{D}
|
||||
Alternatively, you may type @code{^D} , i.e. press the key @key{D}
|
||||
while pressing down the control key (@key{Ctrl}).
|
||||
|
||||
@example
|
||||
|
|
@ -96,7 +96,7 @@ foo
|
|||
bar
|
||||
> (foo 'lish)
|
||||
Condition of type: UNDEFINED-FUNCTION
|
||||
The function BAR is undefined.
|
||||
The function BEE is undefined.
|
||||
|
||||
Available restarts:
|
||||
|
||||
|
|
|
|||
|
|
@ -1331,3 +1331,101 @@
|
|||
(GO :G124)))))
|
||||
(compile 'fooman)
|
||||
(finishes (fooman)))
|
||||
|
||||
;;; Date 2018-02-10
|
||||
;;; Description
|
||||
;;;
|
||||
;;; Compiler macros do not get shadowed by lexical function bindings.
|
||||
;;;
|
||||
;;; Spec: http://www.lispworks.com/documentation/HyperSpec/Body/03_bba.htm
|
||||
;;; Bug https://gitlab.com/embeddable-common-lisp/ecl/issues/83
|
||||
;;; Bug https://gitlab.com/embeddable-common-lisp/ecl/issues/237
|
||||
(test cmp.0063.lexical-macrolet
|
||||
(defun foo () :function)
|
||||
(define-compiler-macro foo () :compiler-macro)
|
||||
(let ((result (funcall (compile nil '(lambda ()
|
||||
(macrolet ((foo () :macrolet))
|
||||
(foo)))))))
|
||||
(is (eq :macrolet result) "Expected :MACROLET, got ~s." result)))
|
||||
|
||||
;;; Date 2018-02-11
|
||||
;;; Description
|
||||
;;;
|
||||
;;; ecl_bclosure lexenv is not used during complation (both bytecmp and ccmp).
|
||||
;;; That leads to dangling references in compiled code.
|
||||
;;;
|
||||
;;; Bug https://gitlab.com/embeddable-common-lisp/ecl/issues/429
|
||||
(test cmp.0064.bytecmp-compile-bclosure
|
||||
(let ((fun-1 (lambda () :fun-1-nil))
|
||||
(fun-2 (let ((fun-2-var :var)) (lambda () fun-2-var)))
|
||||
(fun-3 (flet ((fun-3-fun () :fun)) (lambda () (fun-3-fun))))
|
||||
(fun-4 (macrolet ((fun-4-mac () :mac)) (lambda () (fun-4-mac)))))
|
||||
(is (eq :fun-1-nil (funcall fun-1)))
|
||||
(is (eq :var (funcall fun-2)))
|
||||
(is (eq :fun (funcall fun-3)))
|
||||
(is (eq :mac (funcall fun-4)))
|
||||
(let ((fun-1 (ext::bc-compile nil fun-1))
|
||||
(fun-2 (ext::bc-compile nil fun-2))
|
||||
(fun-3 (ext::bc-compile nil fun-3))
|
||||
(fun-4 (ext::bc-compile nil fun-4)))
|
||||
(is (eq :fun-1-nil (funcall fun-1)))
|
||||
(is (eq :var (ignore-errors (funcall fun-2))) "fun-2-var from lexenv is not used.")
|
||||
(is (eq :fun (ignore-errors (funcall fun-3))) "fun-3-fun from lexenv is not used.")
|
||||
(is (eq :mac (ignore-errors (funcall fun-4))) "fun-4-mac from lexenv is not used."))))
|
||||
|
||||
(test cmp.0065.cmp-compile-bclosure
|
||||
(let ((fun-1 (lambda () :fun-1-nil))
|
||||
(fun-2 (let ((fun-2-var :var)) (lambda () fun-2-var)))
|
||||
(fun-3 (flet ((fun-3-fun () :fun)) (lambda () (fun-3-fun))))
|
||||
(fun-4 (macrolet ((fun-4-mac () :mac)) (lambda () (fun-4-mac)))))
|
||||
(is (eq :fun-1-nil (funcall fun-1)))
|
||||
(is (eq :var (funcall fun-2)))
|
||||
(is (eq :fun (funcall fun-3)))
|
||||
(is (eq :mac (funcall fun-4)))
|
||||
(let ((fun-1 (compile nil fun-1))
|
||||
(fun-2 (compile nil fun-2))
|
||||
(fun-3 (compile nil fun-3))
|
||||
(fun-4 (compile nil fun-4)))
|
||||
(is (eq :fun-1-nil (funcall fun-1)))
|
||||
(is (eq :var (ignore-errors (funcall fun-2))) "fun-2-var from lexenv is not used.")
|
||||
(is (eq :fun (ignore-errors (funcall fun-3))) "fun-3-fun from lexenv is not used.")
|
||||
(is (eq :mac (ignore-errors (funcall fun-4))) "fun-4-mac from lexenv is not used."))))
|
||||
|
||||
;;; Date 2018-02-12
|
||||
;;; Description
|
||||
;;;
|
||||
;;; bytecmp always makes flet functions closures even if lexenv is empty.
|
||||
(test cmp.0066.bytecodes-flet-closure
|
||||
(let ((fun-1 (flet ((a () 1)) #'a))
|
||||
(fun-2 (let ((b 3)) ; this make break if we replace B with a constant
|
||||
(flet ((a () b)) #'a))))
|
||||
(is (null (nth-value 1 (function-lambda-expression fun-1))))
|
||||
(is (nth-value 1 (function-lambda-expression fun-2)))))
|
||||
|
||||
;;; Date 2018-02-13
|
||||
;;; Description
|
||||
;;;
|
||||
;;; ext::bc-compile executed compiled form.
|
||||
(test cmp.0067.bytecodes-compile-exec
|
||||
(multiple-value-bind (fun warn err)
|
||||
(ext::bc-compile nil '(flet ((a () 3)) #'a))
|
||||
(is (and (null fun) warn err)
|
||||
"bc-compile: invalid lambda expression should signal error.")))
|
||||
|
||||
;;; Date 2018-02-13
|
||||
;;; Description
|
||||
;;;
|
||||
;;; compile / ext::bc-compile doesn't accept (setf foo).
|
||||
(ext:with-clean-symbols (foo bar)
|
||||
(test cmp.0068.bytecmp-setf-foo
|
||||
(defun (setf foo) (x) x)
|
||||
(multiple-value-bind (fun warn err)
|
||||
(ext::bc-compile '(setf foo))
|
||||
(is (and fun (null warn) (null err))
|
||||
"bc-compile: (setf foo) is a valid function name.")))
|
||||
(test cmp.0069.cmp-setf-foo
|
||||
(defun (setf foo) (x) x)
|
||||
(multiple-value-bind (fun warn err)
|
||||
(compile '(setf foo))
|
||||
(is (and fun (null warn) (null err))
|
||||
"compile: (setf foo) is a valid function name."))))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue