mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-27 06:51:44 -08:00
Code Issues Projects Releases Packages Wiki Activity

cmp: fix progv for return during evaluation of symbol and value arguments

Browse source 
Closes #620.
This commit is contained in:
Marius Gerbershagen 2021-01-02 16:38:21 +01:00
parent 2cac9642d4
commit ecb4ed10ea
2 changed files with 29 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

11
src/cmp/cmpvar.lsp
View file

@ -394,16 +394,15 @@
(let* ((*lcl* *lcl*)
(lcl (next-lcl))
(sym-loc (make-lcl-var))
(val-loc (make-lcl-var))
(*unwind-exit* (cons lcl *unwind-exit*)))
(val-loc (make-lcl-var)))
(wt-nl-open-brace)
(wt-nl "cl_object " sym-loc ", " val-loc "; cl_index " lcl ";")
(let ((*destination* sym-loc)) (c2expr* symbols))
(let ((*destination* val-loc)) (c2expr* values))
(wt-nl lcl " = ecl_progv(cl_env_copy, " sym-loc ", " val-loc ");")
(c2expr body)
(wt-nl-close-brace)
))
(let ((*unwind-exit* (cons lcl *unwind-exit*)))
(wt-nl lcl " = ecl_progv(cl_env_copy, " sym-loc ", " val-loc ");")
(c2expr body)
(wt-nl-close-brace))))
(defun c1psetq (old-args &aux (args nil) (use-psetf nil))
;; A first pass ensures that none of the assigned locations is