Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
ecl
ecl
Commits
246f0a6d
Commit
246f0a6d
authored
Sep 19, 2020
by
Daniel Kochmański
Browse files
Merge branch 'fix-594' into 'develop'
Fix #594 Closes #594 See merge request embeddable-common-lisp/ecl!227
parents
ec8d6369
0f751776
Changes
5
Hide whitespace changes
Inline
Side-by-side
contrib/bytecmp/bytecmp.lsp
View file @
246f0a6d
...
...
@@ -49,14 +49,14 @@
(warn "COMPILE can not compile C closures")
(return-from bc-compile (values definition t nil)))
(lexenv (setf definition (si:eval-with-env form lexenv)))
(t (setf definition (si:eval-with-env form nil nil nil
t
))))))
(t (setf definition (si:eval-with-env form nil nil nil
:execute
))))))
(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
))
(setq definition (si:eval-with-env definition nil nil nil
:execute
))
(when name (setf (fdefinition name) definition))
(return-from bc-compile (values (or name definition) nil nil)))
((not (fboundp name))
...
...
@@ -72,7 +72,7 @@
(warn "The bytecodes compiler can not compile C closures")
(return-from bc-compile (values definition t nil)))
(lexenv (setf definition (si:eval-with-env form lexenv)))
(t (setf definition (si:eval-with-env form nil nil nil
t
))))))
(t (setf definition (si:eval-with-env form nil nil nil
:execute
))))))
(when (null definition)
(warn "We have lost the original function definition for ~s." name)
(return-from bc-compile (values name t nil)))
...
...
@@ -122,7 +122,7 @@
until (eq form :EOF)
do (when ext::*source-location*
(rplacd ext:*source-location* position))
collect (si:eval-with-env form nil nil nil
ni
l))))
collect (si:eval-with-env form nil nil nil
:load-topleve
l))))
(sys:with-ecl-io-syntax
(write binary :stream sout :circle t :escape t :readably t :pretty nil))
(terpri sout)))))
...
...
src/c/compiler.d
View file @
246f0a6d
...
...
@@ -1630,7 +1630,7 @@ c_load_time_value(cl_env_ptr env, cl_object args, int flags)
unlikely_if
(
Null
(
args
)
||
cl_cddr
(
args
)
!=
ECL_NIL
)
FEprogram_error
(
"LOAD-TIME-VALUE: Wrong number of arguments."
,
0
);
value
=
ECL_CONS_CAR
(
args
);
if
(
c_env
->
mode
!
=
FLAG_
LOAD
)
{
if
(
c_env
->
mode
=
=
FLAG_
EXECUTE
)
{
value
=
si_eval_with_env
(
1
,
value
);
}
else
if
(
ECL_SYMBOLP
(
value
)
||
ECL_LISTP
(
value
))
{
/* Using the form as constant, we force the system to coalesce multiple
...
...
@@ -3200,14 +3200,24 @@ si_make_lambda(cl_object name, cl_object rest)
}
@
(
defun
si
::
eval
-
with
-
env
(
form
&
optional
(
env
ECL_NIL
)
(
stepping
ECL_NIL
)
(
compiler_env_p
ECL_NIL
)
(
execute
ECL_T
))
(
compiler_env_p
ECL_NIL
)
(
mode
@
'
:
execute
'
))
volatile
cl_compiler_env_ptr
old_c_env
;
struct
cl_compiler_env
new_c_env
;
cl_object
interpreter_env
,
compiler_env
;
@
/*
* Compile to bytecodes.
* Parameter mode is interpreted as follows:
* - execute: Execute the compiled form
* - load-toplevel: Compile the form without executing. Calls
* make-load-form for literal objects encountered during
* compilation.
* - compile-toplevel: Compile the form without executing, do not
* call make-load-form. Useful for code walking.
*/
if
(!(
mode
==
@
'
:
execute
'
||
mode
==
@
'
:
load
-
toplevel
'
||
mode
==
@
'
:
compile
-
toplevel
'
))
{
FEerror
(
"Invalid mode in SI:EVAL-WITH-ENV"
,
0
);
}
if
(
compiler_env_p
==
ECL_NIL
)
{
interpreter_env
=
env
;
compiler_env
=
ECL_NIL
;
...
...
@@ -3225,15 +3235,15 @@ si_make_lambda(cl_object name, cl_object rest)
}
new_c_env
.
stepping
=
stepping
!=
ECL_NIL
;
ECL_UNWIND_PROTECT_BEGIN
(
the_env
)
{
if
(
Null
(
execute
))
{
if
(
mode
==
@
'
:
execute
'
)
{
eval_form
(
the_env
,
form
);
}
else
{
cl_index
handle
=
asm_begin
(
the_env
);
new_c_env
.
mode
=
FLAG_LOAD
;
new_c_env
.
mode
=
(
mode
==
@
'
:
load
-
toplevel
'
)
?
FLAG_LOAD
:
FLAG_COMPILE
;
compile_with_load_time_forms
(
the_env
,
form
,
FLAG_VALUES
);
asm_op
(
the_env
,
OP_EXIT
);
the_env
->
values
[
0
]
=
asm_end
(
the_env
,
handle
,
form
);
the_env
->
nvalues
=
1
;
}
else
{
eval_form
(
the_env
,
form
);
}
}
ECL_UNWIND_PROTECT_EXIT
{
/* Clear up */
...
...
src/clos/method.lsp
View file @
246f0a6d
...
...
@@ -252,9 +252,9 @@
(
let
((
si::*code-walker*
#'
code-walker
))
;; Instead of (coerce method-lambda 'function) we use
;; explicitely the bytecodes compiler with an environment, no
;; stepping, compiler-env-p = t and
execute = nil, so that the
;; form does not get executed.
(
si::eval-with-env
method-lambda
env
nil
t
ni
l
)))
;; stepping, compiler-env-p = t and
mode = :compile-toplevel,
;;
so that the
form does not get executed.
(
si::eval-with-env
method-lambda
env
nil
t
:compile-topleve
l
)))
(
values
call-next-method-p
next-method-p-p
in-closure-p
)))
...
...
src/cmp/cmputil.lsp
View file @
246f0a6d
...
...
@@ -357,7 +357,7 @@
(
when
throw-flag
,
error-form
))))
(
defun
cmp-eval
(
form
&optional
(
env
*cmp-env*
))
(
handler-case
(
si::eval-with-env
form
env
nil
t
t
)
(
handler-case
(
si::eval-with-env
form
env
nil
t
:execute
)
(
serious-condition
(
c
)
(
when
*compiler-break-enable*
(
invoke-debugger
c
))
...
...
src/tests/normal-tests/compiler.lsp
View file @
246f0a6d
...
...
@@ -1921,3 +1921,20 @@
(
multiple-value-setq
(
*a*
*b*
)
(
foo
))
(
and
(
eq
*a*
:right-a
)
(
eq
*b*
:right-b
))))))))
;;; Date 2020-08-14
;;; URL: https://gitlab.com/embeddable-common-lisp/ecl/-/issues/594
;;; Description
;;;
;;; The code walker used in DEFMETHOD would call MAKE-LOAD-VALUE
;;; for literal objects encountered during code walking, even while
;;; loading a file or using eval.
(
ext:with-clean-symbols
(
test-class
test-method
)
(
eval
'
(
defclass
test-class
()
()))
(
eval
'
(
defmethod
make-load-form
((
obj
test-class
)
&optional
env
)
(
error
"We shouldn't have called MAKE-LOAD-FORM here."
)))
(
test
cmp.0082.defmethod-make-load-form
(
let*
((
test-obj
(
make-instance
'test-class
))
(
code
`
(
defmethod
test-method
()
,
test-obj
)))
(
finishes
(
eval
code
)))))
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment