0.9.1.64:
[sbcl.git] / src / compiler / x86-64 / call.lisp
index eb4f7f4..e1a1267 100644 (file)
        ((sap-stack)
         #+nil (format t "*call-local: ret-tn on stack; offset=~S~%"
                       (tn-offset ret-tn))
-        (inst lea return-label (make-fixup nil :code-object return))
+        (inst lea return-label (make-fixup nil :code-object RETURN))
         (storew return-label rbp-tn (- (1+ (tn-offset ret-tn)))))
        ((sap-reg)
-        (inst lea ret-tn (make-fixup nil :code-object return)))))
+        (inst lea ret-tn (make-fixup nil :code-object RETURN)))))
 
     (note-this-location vop :call-site)
     (inst jmp target)
         #+nil (format t "*multiple-call-local: ret-tn on stack; offset=~S~%"
                       (tn-offset ret-tn))
         ;; Stack
-        (inst lea return-label (make-fixup nil :code-object return))
+        (inst lea return-label (make-fixup nil :code-object RETURN))
         (storew return-label rbp-tn (- (1+ (tn-offset ret-tn)))))
        ((sap-reg)
         ;; Register
-        (inst lea ret-tn (make-fixup nil :code-object return)))))
+        (inst lea ret-tn (make-fixup nil :code-object RETURN)))))
 
     (note-this-location vop :call-site)
     (inst jmp target)
         #+nil (format t "*known-call-local: ret-tn on stack; offset=~S~%"
                       (tn-offset ret-tn))
         ;; Stack
-        (inst lea return-label (make-fixup nil :code-object return))
+        (inst lea return-label (make-fixup nil :code-object RETURN))
         (storew return-label rbp-tn (- (1+ (tn-offset ret-tn)))))
        ((sap-reg)
         ;; Register
-        (inst lea ret-tn (make-fixup nil :code-object return)))))
+        (inst lea ret-tn (make-fixup nil :code-object RETURN)))))
 
     (note-this-location vop :call-site)
     (inst jmp target)
   (:generator 20
     ;; Avoid the copy if there are no more args.
     (cond ((zerop fixed)
-          (inst jecxz just-alloc-frame))
+          (inst jecxz JUST-ALLOC-FRAME))
          (t
           (inst cmp rcx-tn (fixnumize fixed))
-          (inst jmp :be just-alloc-frame)))
+          (inst jmp :be JUST-ALLOC-FRAME)))
 
     ;; Allocate the space on the stack.
     ;; stack = rbp - (max 3 frame-size) - (nargs - fixed)
           ;; Number to copy = nargs-3
           (inst sub rcx-tn (fixnumize register-arg-count))
           ;; Everything of interest in registers.
-          (inst jmp :be do-regs))
+          (inst jmp :be DO-REGS))
          (t
           ;; Number to copy = nargs-fixed
           (inst sub rcx-tn (fixnumize fixed))))
              (if (zerop i)
                  (inst test rcx-tn rcx-tn)
                (inst cmp rcx-tn (fixnumize i)))
-             (inst jmp :eq done)))
+             (inst jmp :eq DONE)))
 
-    (inst jmp done)
+    (inst jmp DONE)
 
     JUST-ALLOC-FRAME
     (inst lea rsp-tn
    (inst mov value
         (make-ea :qword :base object :disp (- (* index n-word-bytes))))))
 
-
 ;;; Turn more arg (context, count) into a list.
+(defoptimizer (%listify-rest-args stack-allocate-result) ((&rest args))
+  t)
+
 (define-vop (listify-rest-args)
   (:translate %listify-rest-args)
   (:policy :safe)
   (:generator 20
     (let ((enter (gen-label))
          (loop (gen-label))
-         (done (gen-label)))
+         (done (gen-label))
+         (stack-allocate-p (node-stack-allocate-p node)))
       (move src context)
       (move rcx count)
       ;; Check to see whether there are no args, and just return NIL if so.
       (inst mov result nil-value)
       (inst jecxz done)
       (inst lea dst (make-ea :qword :index rcx :scale 2))
-      (pseudo-atomic
-       (allocation dst dst node)
+      (maybe-pseudo-atomic stack-allocate-p
+       (allocation dst dst node stack-allocate-p)
        (inst lea dst (make-ea :byte :base dst :disp list-pointer-lowtag))
        ;; Convert the count into a raw value, so that we can use the
        ;; LOOP instruction.