mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-13 21:02:47 -08:00
Code Issues Projects Releases Packages Wiki Activity

The structure of C2FMLA-AND is imposed onto C2FMLA-OR

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2010-05-17 17:30:42 +02:00
parent 8787e482ba
commit 2f36c1901a
1 changed files with 14 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

24
src/cmp/cmpif.lsp
View file

@ -246,20 +246,24 @@
(unwind-exit nil))))
(defun c2fmla-or (butlast last)
(let* ((normal-exit (next-label))
(ue (cons normal-exit *unwind-exit*))
(dest *destination*))
(cond (t
(cond ((jump-true-destination?)
(mapc #'c2expr* butlast)
(c2expr last))
((jump-false-destination?)
(with-exit-label (true-label)
(let ((*destination* `(JUMP-TRUE ,true-label)))
(mapc #'c2expr* butlast))
(c2expr last))
(unwind-exit t))
(t
(with-exit-label (normal-exit)
(dolist (f butlast)
(let ((*destination* 'VALUE0))
(c2expr* f))
(let ((*exit* normal-exit)
(*unwind-exit* ue))
(set-jump-true 'VALUE0 normal-exit)))
(set-jump-true 'VALUE0 normal-exit))
(let ((*destination* 'VALUE0))
(c2expr* last))
(wt-label normal-exit)
(unwind-exit 'VALUE0)))))
(c2expr* last)))
(unwind-exit 'VALUE0))))
(defun set-jump-true (loc label)
(multiple-value-bind (constantp value)