47 |
(let ((*value-to-go* 'top)) (c2expr* (car forms))) |
(let ((*value-to-go* 'top)) (c2expr* (car forms))) |
48 |
(c2funcall funob 'args-pushed loc)) |
(c2funcall funob 'args-pushed loc)) |
49 |
(t |
(t |
50 |
(setq top (next-cvar)) |
(setq top (cs-push t t)) |
51 |
(setq sup (next-cvar)) |
(setq sup (cs-push t t)) |
52 |
(setq loc (save-funob funob)) |
(setq loc (save-funob funob)) |
53 |
(base-used) |
(base-used) |
54 |
;; Add (sup .var) handling in unwind-exit -- in |
;; Add (sup .var) handling in unwind-exit -- in |
81 |
;; We may record information here when *value-to-go* = 'top |
;; We may record information here when *value-to-go* = 'top |
82 |
(defvar *top-data* nil) |
(defvar *top-data* nil) |
83 |
|
|
84 |
(defun c2multiple-value-prog1 (form forms &aux (base (next-cvar)) |
(defun c2multiple-value-prog1 (form forms &aux (base (cs-push t t)) |
85 |
(top (next-cvar)) |
(top (cs-push t t)) |
86 |
(sup (next-cvar)) |
(sup (cs-push t t)) |
87 |
top-data) |
top-data) |
88 |
(let ((*value-to-go* 'top) |
(let ((*value-to-go* 'top) |
89 |
*top-data* ) |
*top-data* ) |
214 |
|
|
215 |
|
|
216 |
;;FIXME -- this still uses pass1, while let for performance reasons uses custom change-detection code. |
;;FIXME -- this still uses pass1, while let for performance reasons uses custom change-detection code. |
217 |
(defun declare-multiple-value-bindings (args) |
(defun declare-multiple-value-bindings (args specials) |
218 |
(let ((info (make-info)) |
(let ((info (make-info)) |
219 |
(newvars *vars*)) |
(newvars *vars*)) |
220 |
(dolist (var (car args)) |
(dolist (var (car args)) |
228 |
(list (list expt (caar args)))) :key #'car))) |
(list (list expt (caar args)))) :key #'car))) |
229 |
(let ((decls (remove-if |
(let ((decls (remove-if |
230 |
(lambda (x) |
(lambda (x) |
231 |
(let ((nv (car (member x newvars :key #'var-name :test #'eq)))) |
(or (si::specialp x) (member x specials) |
232 |
(when (is-changed nv info) |
(let ((nv (car (member x newvars :key #'var-name :test #'eq)))) |
233 |
(cmpnote "Multiple-value-binding ~S is changed and cannot be declared~%" x) |
(when (is-changed nv info) |
234 |
t))) decls :key #'cadr))) |
(cmpnote "Multiple-value-binding ~S is changed and cannot be declared~%" x) |
235 |
|
t)))) decls :key #'cadr))) |
236 |
(if decls |
(if decls |
237 |
(progn (cmpnote "Multiple-value bindings ~S of type ~S~%" (car args) decls ) |
(progn (cmpnote "Multiple-value bindings ~S of type ~S~%" (car args) decls ) |
238 |
(cons (car args) (cons (cadr args) (cons (cons 'declare decls) (cddr args))))) |
(cons (car args) (cons (cadr args) (cons (cons 'declare decls) (cddr args))))) |
298 |
(when (or (endp args) (endp (cdr args))) |
(when (or (endp args) (endp (cdr args))) |
299 |
(too-few-args 'multiple-value-bind 2 (length args))) |
(too-few-args 'multiple-value-bind 2 (length args))) |
300 |
|
|
301 |
(setq args (declare-multiple-value-bindings args)) |
(setq args (declare-multiple-value-bindings args ss)) |
302 |
|
|
303 |
(multiple-value-setq (body ss ts is other-decls) (c1body (cddr args) nil)) |
(multiple-value-setq (body ss ts is other-decls) (c1body (cddr args) nil)) |
304 |
|
|
338 |
(let ((kind (c2var-kind var))) |
(let ((kind (c2var-kind var))) |
339 |
(declare (object kind)) |
(declare (object kind)) |
340 |
(if kind |
(if kind |
341 |
(let ((cvar (next-cvar))) |
(let ((cvar (cs-push (var-type var) t))) |
342 |
(setf (var-kind var) kind) |
(setf (var-kind var) kind) |
343 |
(setf (var-loc var) cvar) |
(setf (var-loc var) cvar) |
344 |
(wt-nl) |
(wt-nl) |