(defmacro read-var-integer (vec index)
(once-only ((vec vec))
- `(multiple-value-bind (vector new-index)
+ `(multiple-value-bind (value new-index)
(%read-var-integer ,vec ,index)
(setf ,index new-index)
- vector)))
+ value)))
;;; Take an adjustable vector VEC with a fill pointer and push the
;;; variable length representation of INT on the end.
(:generator 0
(error "BRANCH-IF not yet implemented")))
-(defun
- convert-conditional-move-p (node dst-tn x-tn y-tn)
+(defun convert-conditional-move-p (node dst-tn x-tn y-tn)
(declare (ignore node dst-tn x-tn y-tn))
nil)
(:generator 0
(error "BRANCH-IF not yet implemented")))
-(defun
- convert-conditional-move-p (node dst-tn x-tn y-tn)
+(defun convert-conditional-move-p (node dst-tn x-tn y-tn)
(declare (ignore node dst-tn x-tn y-tn))
nil)
(delete-vop vop)
(flet ((load-and-coerce (dst src)
(when (and dst (neq dst src))
- (let ((end (ir2-block-last-vop 2block))
- (move (template-or-lose 'move)))
- (multiple-value-bind (first last)
- (emit-vop node 2block move
- (reference-tn src nil)
- (reference-tn dst t))
- (insert-vop-sequence first last 2block end))))))
+ (emit-and-insert-vop node 2block
+ (template-or-lose 'move)
+ (reference-tn src nil)
+ (reference-tn dst t)
+ (ir2-block-last-vop 2block)))))
(load-and-coerce arg-if value-if)
(load-and-coerce arg-else value-else))
(emit-template node 2block (template-or-lose cmove-vop)
;;; Call the emit function for TEMPLATE, linking the result in at the
;;; end of BLOCK.
(defmacro emit-template (node block template args results &optional info)
- (with-unique-names (first last)
- (once-only ((n-node node)
- (n-block block)
- (n-template template))
- `(multiple-value-bind (,first ,last)
- (emit-vop ,n-node ,n-block ,n-template ,args ,results
- ,@(when info `(,info)))
- (insert-vop-sequence ,first ,last ,n-block nil)))))
+ `(emit-and-insert-vop ,node ,block ,template ,args ,results nil
+ ,@(when info `(,info))))
;;; VOP Name Node Block Arg* Info* Result*
;;;
(:generator 0
(error "BRANCH-IF not yet implemented")))
-(defun
- convert-conditional-move-p (node dst-tn x-tn y-tn)
+(defun convert-conditional-move-p (node dst-tn x-tn y-tn)
(declare (ignore node dst-tn x-tn y-tn))
nil)
(:generator 0
(error "BRANCH-IF not yet implemented")))
-(defun
- convert-conditional-move-p (node dst-tn x-tn y-tn)
+(defun convert-conditional-move-p (node dst-tn x-tn y-tn)
(declare (ignore node dst-tn x-tn y-tn))
nil)
(:generator 0
(error "BRANCH-IF not yet implemented")))
-(defun
- convert-conditional-move-p (node dst-tn x-tn y-tn)
+(defun convert-conditional-move-p (node dst-tn x-tn y-tn)
(declare (ignore node dst-tn x-tn y-tn))
nil)
(type template template) (type tn x y))
(let ((arg (reference-tn x nil))
(result (reference-tn y t)))
- (multiple-value-bind (first last)
- (emit-vop node block template arg result)
- (insert-vop-sequence first last block before)
- last)))
+ (emit-and-insert-vop node block template arg result before)))
;;; like EMIT-MOVE-TEMPLATE, except that we pass in INFO args too
(defun emit-load-template (node block template x y info &optional before)
(type template template) (type tn x y))
(let ((arg (reference-tn x nil))
(result (reference-tn y t)))
- (multiple-value-bind (first last)
- (emit-vop node block template arg result info)
- (insert-vop-sequence first last block before)
- last)))
+ (emit-and-insert-vop node block template arg result before info)))
;;; like EMIT-MOVE-TEMPLATE, except that the VOP takes two args
(defun emit-move-arg-template (node block template x f y &optional before)
(f-ref (reference-tn f nil))
(y-ref (reference-tn y t)))
(setf (tn-ref-across x-ref) f-ref)
- (multiple-value-bind (first last)
- (emit-vop node block template x-ref y-ref)
- (insert-vop-sequence first last block before)
- last)))
+ (emit-and-insert-vop node block template x-ref y-ref before)))
;;; like EMIT-MOVE-TEMPLATE, except that the VOP takes no args
(defun emit-context-template (node block template y &optional before)
(declare (type node node) (type ir2-block block)
(type template template) (type tn y))
(let ((y-ref (reference-tn y t)))
- (multiple-value-bind (first last)
- (emit-vop node block template nil y-ref)
- (insert-vop-sequence first last block before)
- last)))
+ (emit-and-insert-vop node block template nil y-ref before)))
;;; Return the label marking the start of Block, assigning one if necessary.
(defun block-label (block)
(setf (ir2-block-dropped-thru-to 2block) t))
nil)
-;;; Link a list of VOPs from First to Last into Block, Before the specified
-;;; VOP. If Before is NIL, insert at the end.
-(defun insert-vop-sequence (first last block before)
- (declare (type vop first last) (type ir2-block block)
+;;; Insert a VOP into BLOCK, before the specified
+;;; BEFORE VOP. If BEFORE is NIL, insert at the end.
+(defun insert-vop (vop block before)
+ (declare (type vop vop) (type ir2-block block)
(type (or vop null) before))
(if before
(let ((prev (vop-prev before)))
- (setf (vop-prev first) prev)
+ (setf (vop-prev vop) prev)
(if prev
- (setf (vop-next prev) first)
- (setf (ir2-block-start-vop block) first))
- (setf (vop-next last) before)
- (setf (vop-prev before) last))
+ (setf (vop-next prev) vop)
+ (setf (ir2-block-start-vop block) vop))
+ (setf (vop-next vop) before)
+ (setf (vop-prev before) vop))
(let ((current (ir2-block-last-vop block)))
- (setf (vop-prev first) current)
- (setf (ir2-block-last-vop block) last)
+ (setf (vop-prev vop) current)
+ (setf (ir2-block-last-vop block) vop)
(if current
- (setf (vop-next current) first)
- (setf (ir2-block-start-vop block) first))))
+ (setf (vop-next current) vop)
+ (setf (ir2-block-start-vop block) vop))))
(values))
+(defun emit-and-insert-vop (node block template arg result before
+ &optional info)
+ (let ((vop (emit-vop node block template arg result info)))
+ (insert-vop vop block before)
+ vop))
+
;;; Delete all of the TN-REFs associated with VOP and remove VOP from the IR2.
(defun delete-vop (vop)
(declare (type vop vop))
(def!constant sc-bits (integer-length (1- sc-number-limit)))
-;; a function that emits the VOPs for this template. Arguments:
-;; 1] Node for source context.
-;; 2] IR2-BLOCK that we place the VOP in.
-;; 3] This structure.
-;; 4] Head of argument TN-REF list.
-;; 5] Head of result TN-REF list.
-;; 6] If INFO-ARG-COUNT is non-zero, then a list of the magic
-;; arguments.
-;;
-;; Two values are returned: the first and last VOP emitted. This vop
-;; sequence must be linked into the VOP Next/Prev chain for the
-;; block. At least one VOP is always emitted.
+;;; Emit a VOP for TEMPLATE. Arguments:
+;;; NODE Node for source context.
+;;; BLOCK IR2-BLOCK that we place the VOP in.
+;;; TEMPLATE: VOP template
+;;; ARGS Head of argument TN-REF list.
+;;; RESULT Head of result TN-REF list.
+;;; INFO If INFO-ARG-COUNT is non-zero, then a list of the magic arguments.
+;;;
+;;; Return the emitted vop
(defun emit-vop (node block template args results &optional info)
(let* ((vop (make-vop block node template args results))
(num-args (vop-info-num-args template))
(target-if-desirable
(aref refs (ldb (byte 8 8) target))
(aref refs (ldb (byte 8 0) target)))))))
- (values vop vop))
+ vop)
(fill *vop-tn-refs* nil))))
\f
;;;; function translation stuff
the values, and VOP-name the name of the VOP that will be used
to execute the conditional move.")
-(defun
- convert-conditional-move-p (node dst-tn x-tn y-tn)
+(defun convert-conditional-move-p (node dst-tn x-tn y-tn)
(declare (ignore node))
(let* ((ptype (sb!c::tn-primitive-type dst-tn))
(name (sb!c::primitive-type-name ptype))
the values, and VOP-name the name of the VOP that will be used
to execute the conditional move.")
-(defun
- convert-conditional-move-p (node dst-tn x-tn y-tn)
+(defun convert-conditional-move-p (node dst-tn x-tn y-tn)
(declare (ignore node))
(let* ((ptype (sb!c::tn-primitive-type dst-tn))
(name (sb!c::primitive-type-name ptype))
projects / sbcl.git / commitdiff