projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
0.8alpha.0.32:
[sbcl.git]
/
src
/
compiler
/
ir2tran.lisp
diff --git
a/src/compiler/ir2tran.lisp
b/src/compiler/ir2tran.lisp
index
b916025
..
c614cbc
100644
(file)
--- a/
src/compiler/ir2tran.lisp
+++ b/
src/compiler/ir2tran.lisp
@@
-291,7
+291,7
@@
(cond ((and (eq (continuation-type-check cont) t)
(multiple-value-bind (check types)
(cond ((and (eq (continuation-type-check cont) t)
(multiple-value-bind (check types)
- (continuation-check-types cont)
+ (continuation-check-types cont nil)
(aver (eq check :simple))
;; If the proven type is a subtype of the possibly
;; weakened type check then it's always true and is
(aver (eq check :simple))
;; If the proven type is a subtype of the possibly
;; weakened type check then it's always true and is
@@
-323,7
+323,7
@@
(nlocs (length locs)))
(aver (= nlocs (length ptypes)))
(if (eq (continuation-type-check cont) t)
(nlocs (length locs)))
(aver (= nlocs (length ptypes)))
(if (eq (continuation-type-check cont) t)
- (multiple-value-bind (check types) (continuation-check-types cont)
+ (multiple-value-bind (check types) (continuation-check-types cont nil)
(aver (eq check :simple))
(let ((ntypes (length types)))
(mapcar (lambda (from to-type assertion)
(aver (eq check :simple))
(let ((ntypes (length types)))
(mapcar (lambda (from to-type assertion)
@@
-1039,9
+1039,11
@@
(bug "full call to ~S" fname)))
(when (consp fname)
(bug "full call to ~S" fname)))
(when (consp fname)
- (destructuring-bind (setf stem) fname
- (aver (eq setf 'setf))
- (setf (gethash stem *setf-assumed-fboundp*) t)))))
+ (destructuring-bind (setfoid &rest stem) fname
+ (aver (member setfoid
+ '(setf sb!pcl::class-predicate sb!pcl::slot-accessor)))
+ (when (eq setfoid 'setf)
+ (setf (gethash (car stem) *setf-assumed-fboundp*) t))))))
;;; If the call is in a tail recursive position and the return
;;; convention is standard, then do a tail full call. If one or fewer
;;; If the call is in a tail recursive position and the return
;;; convention is standard, then do a tail full call. If one or fewer
@@
-1333,8
+1335,7
@@
(def-ir1-translator progv ((vars vals &body body) start cont)
(ir1-convert
start cont
(def-ir1-translator progv ((vars vals &body body) start cont)
(ir1-convert
start cont
- (let ((bind (gensym "BIND"))
- (unbind (gensym "UNBIND")))
+ (with-unique-names (bind unbind)
(once-only ((n-save-bs '(%primitive current-binding-pointer)))
`(unwind-protect
(progn
(once-only ((n-save-bs '(%primitive current-binding-pointer)))
`(unwind-protect
(progn
@@
-1347,7
+1348,9
@@
(declare (optimize (speed 2) (debug 0)))
(cond ((null vars))
((null vals) (,unbind vars))
(declare (optimize (speed 2) (debug 0)))
(cond ((null vars))
((null vals) (,unbind vars))
- (t (%primitive bind (car vals) (car vars))
+ (t (%primitive bind
+ (car vals)
+ (car vars))
(,bind (cdr vars) (cdr vals))))))
(,bind ,vars ,vals))
nil
(,bind (cdr vars) (cdr vals))))))
(,bind ,vars ,vals))
nil