;;; Allocate an indirect value cell. Maybe do some clever stack
;;; allocation someday.
-(defevent make-value-cell "Allocate heap value cell for lexical var.")
+;;;
+;;; FIXME: DO-MAKE-VALUE-CELL is a bad name, since it doesn't make
+;;; clear what's the distinction between it and the MAKE-VALUE-CELL
+;;; VOP, and since the DO- further connotes iteration, which has
+;;; nothing to do with this. Clearer, more systematic names, anyone?
+(defevent make-value-cell-event "Allocate heap value cell for lexical var.")
(defun do-make-value-cell (node block value res)
- (event make-value-cell node)
+ (event make-value-cell-event node)
(vop make-value-cell node block value res))
\f
;;;; leaf reference
(declare (type unsigned-byte n))
(collect ((res))
(dotimes (i n)
- (res (standard-argument-location i)))
+ (res (standard-arg-location i)))
(res)))
;;; Return a list of TNs wired to the standard value passing
;;; arguments are returned in the second value as a list rather than
;;; being accessed as a normal argument. NODE and BLOCK provide the
;;; context for emitting any necessary type-checking code.
-(defun reference-arguments (node block args template)
+(defun reference-args (node block args template)
(declare (type node node) (type ir2-block block) (list args)
(type template template))
(collect ((info-args))
(cont (node-cont call))
(rtypes (template-result-types template)))
(multiple-value-bind (args info-args)
- (reference-arguments call block (combination-args call) template)
+ (reference-args call block (combination-args call) template)
(aver (not (template-more-results-type template)))
(if (eq rtypes :conditional)
(ir2-convert-conditional call block template args info-args
(results (make-template-result-tns call cont template rtypes))
(r-refs (reference-tn-list results t)))
(multiple-value-bind (args info-args)
- (reference-arguments call block (cddr (combination-args call))
- template)
+ (reference-args call block (cddr (combination-args call)) template)
(aver (not (template-more-results-type template)))
(aver (not (eq rtypes :conditional)))
(aver (null info-args))
;;; -- Known to be a function, no check needed: return the
;;; continuation loc.
;;; -- Not known what it is.
-(defun function-continuation-tn (node block cont)
+(defun fun-continuation-tn (node block cont)
(declare (type continuation cont))
(let ((2cont (continuation-info cont)))
(if (eq (ir2-continuation-kind 2cont) :delayed)
(last nil)
(first nil))
(dotimes (num (length args))
- (let ((loc (standard-argument-location num)))
+ (let ((loc (standard-arg-location num)))
(emit-move node block (continuation-tn node block (elt args num)) loc)
(let ((ref (reference-tn loc nil)))
(if last
(return-pc (ir2-physenv-return-pc env)))
(multiple-value-bind (fun-tn named)
- (function-continuation-tn node block (basic-combination-fun node))
+ (fun-continuation-tn node block (basic-combination-fun node))
(if named
(vop* tail-call-named node block
(fun-tn old-fp return-pc pass-refs)
(let ((last nil)
(first nil))
(dotimes (num nargs)
- (locs (standard-argument-location num))
+ (locs (standard-arg-location num))
(let ((ref (reference-tn (continuation-tn node block (elt args num))
nil)))
(if last
(loc-refs (reference-tn-list locs t))
(nvals (length locs)))
(multiple-value-bind (fun-tn named)
- (function-continuation-tn node block (basic-combination-fun node))
+ (fun-continuation-tn node block (basic-combination-fun node))
(if named
(vop* call-named node block (fp fun-tn args) (loc-refs)
arg-locs nargs nvals)
(locs (ir2-continuation-locs (continuation-info cont)))
(loc-refs (reference-tn-list locs t)))
(multiple-value-bind (fun-tn named)
- (function-continuation-tn node block (basic-combination-fun node))
+ (fun-continuation-tn node block (basic-combination-fun node))
(if named
(vop* multiple-call-named node block (fp fun-tn args) (loc-refs)
arg-locs nargs)
(let ((vars (lambda-vars fun))
(n 0))
(when (leaf-refs (first vars))
- (emit-move node block (make-argument-count-location)
+ (emit-move node block (make-arg-count-location)
(leaf-info (first vars))))
(dolist (arg (rest vars))
(when (leaf-refs arg)
- (let ((pass (standard-argument-location n))
+ (let ((pass (standard-arg-location n))
(home (leaf-info arg)))
(if (lambda-var-indirect arg)
(do-make-value-cell node block pass home)
(cont (node-cont node))
(2cont (continuation-info cont)))
(multiple-value-bind (fun named)
- (function-continuation-tn node block (basic-combination-fun node))
+ (fun-continuation-tn node block (basic-combination-fun node))
(aver (and (not named)
(eq (ir2-continuation-kind start-cont) :unknown)))
(cond
(2cont (continuation-info cont))
(2info (nlx-info-info info))
(top-loc (ir2-nlx-info-save-sp 2info))
- (start-loc (make-nlx-entry-argument-start-location))
- (count-loc (make-argument-count-location))
+ (start-loc (make-nlx-entry-arg-start-location))
+ (count-loc (make-arg-count-location))
(target (ir2-nlx-info-target 2info)))
(ecase (cleanup-kind (nlx-info-cleanup info))
(length locs))
(move-continuation-result node block locs cont))))
(:unwind-protect
- (let ((block-loc (standard-argument-location 0)))
+ (let ((block-loc (standard-arg-location 0)))
(vop uwp-entry node block target block-loc start-loc count-loc)
(move-continuation-result
node block
\f
;;;; n-argument functions
-(macrolet ((def-frob (name)
+(macrolet ((def (name)
`(defoptimizer (,name ir2-convert) ((&rest args) node block)
(let* ((refs (move-tail-full-call-args node block))
(cont (node-cont node))
(vop* ,name node block (refs) ((first res) nil)
(length args))
(move-continuation-result node block res cont)))))
- (def-frob list)
- (def-frob list*))
-\f
-;;;; structure accessors
-;;;;
-;;;; These guys have to bizarrely determine the slot offset by looking
-;;;; at the called function.
-
-(defoptimizer (%slot-accessor ir2-convert) ((str) node block)
- (let* ((cont (node-cont node))
- (res (continuation-result-tns cont
- (list *backend-t-primitive-type*))))
- (vop instance-ref node block
- (continuation-tn node block str)
- (dsd-index
- (slot-accessor-slot
- (ref-leaf
- (continuation-use
- (combination-fun node)))))
- (first res))
- (move-continuation-result node block res cont)))
-
-(defoptimizer (%slot-setter ir2-convert) ((value str) node block)
- (let ((val (continuation-tn node block value)))
- (vop instance-set node block
- (continuation-tn node block str)
- val
- (dsd-index
- (slot-accessor-slot
- (ref-leaf
- (continuation-use
- (combination-fun node))))))
-
- (move-continuation-result node block (list val) (node-cont node))))
+ (def list)
+ (def list*))
\f
;;; Convert the code in a component into VOPs.
(defun ir2-convert (component)
(unless (or (node-tail-p last)
(info :function :info name)
(policy last (zerop safety)))
- (vop nil-function-returned-error last 2block
+ (vop nil-fun-returned-error last 2block
(if name
(emit-constant name)
(multiple-value-bind (tn named)
- (function-continuation-tn last 2block fun)
+ (fun-continuation-tn last 2block fun)
(aver (not named))
tn)))))))
((not (eq (ir2-block-next 2block) (block-info target)))
(:full
(ir2-convert-full-call node 2block))
(t
- (let ((fun (function-info-ir2-convert kind)))
+ (let ((fun (fun-info-ir2-convert kind)))
(cond (fun
(funcall fun node 2block))
((eq (basic-combination-info node) :full)
projects / sbcl.git / blobdiff