0.8.9.10:
[sbcl.git] / src / compiler / alpha / call.lisp
index 371ea18..79d4c7d 100644 (file)
@@ -15,7 +15,7 @@
 
 ;;; Return a wired TN describing the N'th full call argument passing
 ;;; location.
-(!def-vm-support-routine standard-argument-location (n)
+(!def-vm-support-routine standard-arg-location (n)
   (declare (type unsigned-byte n))
   (if (< n register-arg-count)
       (make-wired-tn *backend-t-primitive-type*
@@ -62,7 +62,7 @@
 ;;; Make a TN for the standard argument count passing location. We
 ;;; only need to make the standard location, since a count is never
 ;;; passed when we are using non-standard conventions.
-(!def-vm-support-routine make-argument-count-location ()
+(!def-vm-support-routine make-arg-count-location ()
   (make-wired-tn *fixnum-primitive-type* immediate-arg-scn nargs-offset))
 
 
@@ -85,9 +85,9 @@
        (make-normal-tn *fixnum-primitive-type*)))
 
 
-;;; This function is called by the Entry-Analyze phase, allowing
-;;; VM-dependent initialization of the IR2-Component structure. We
-;;; push placeholder entries in the Constants to leave room for
+;;; This function is called by the ENTRY-ANALYZE phase, allowing
+;;; VM-dependent initialization of the IR2-COMPONENT structure. We
+;;; push placeholder entries in the CONSTANTS to leave room for
 ;;; additional noise in the code object header.
 (!def-vm-support-routine select-component-format (component)
   (declare (type component component))
 ;;; bytes on the PMAX.
 (defun bytes-needed-for-non-descriptor-stack-frame ()
   (* (logandc2 (1+ (sb-allocated-size 'non-descriptor-stack)) 1)
-     word-bytes))
+     n-word-bytes))
 
 ;;; This is used for setting up the Old-FP in local call.
 (define-vop (current-fp)
   (:generator 1
     ;; Make sure the function is aligned, and drop a label pointing to
     ;; this function header.
-    (align lowtag-bits)
-    (trace-table-entry trace-table-function-prologue)
+    (align n-lowtag-bits)
+    (trace-table-entry trace-table-fun-prologue)
     (emit-label start-lab)
     ;; Allocate function header.
     (inst simple-fun-header-word)
       ;; collector won't forget about us if we call anyone else.
       )
     ;; Build our stack frames.
-    (inst lda csp-tn (* word-bytes (sb-allocated-size 'control-stack)) cfp-tn)
+    (inst lda
+         csp-tn
+         (* n-word-bytes (sb-allocated-size 'control-stack))
+         cfp-tn)
     (let ((nfp (current-nfp-tn vop)))
       (when nfp
        (inst subq nsp-tn (bytes-needed-for-non-descriptor-stack-frame)
            (nfp :scs (any-reg)))
   (:info callee)
   (:generator 2
-    (trace-table-entry trace-table-function-prologue)
+    (trace-table-entry trace-table-fun-prologue)
     (move csp-tn res)
-    (inst lda csp-tn (* word-bytes (sb-allocated-size 'control-stack)) csp-tn)
+    (inst lda
+         csp-tn
+         (* n-word-bytes (sb-allocated-size 'control-stack))
+         csp-tn)
     (when (ir2-physenv-number-stack-p callee)
       (inst subq nsp-tn (bytes-needed-for-non-descriptor-stack-frame)
            nsp-tn)
   (:generator 2
     (when (> nargs register-arg-count)
       (move csp-tn res)
-      (inst lda csp-tn (* nargs word-bytes) csp-tn))))
+      (inst lda csp-tn (* nargs n-word-bytes) csp-tn))))
 
 ;;; Emit code needed at the return-point from an unknown-values call
-;;; for a fixed number of values. Values is the head of the TN-Ref
+;;; for a fixed number of values. Values is the head of the TN-REF
 ;;; list for the locations that the values are to be received into.
 ;;; Nvals is the number of values that are to be received (should
 ;;; equal the length of Values).
@@ -301,7 +307,7 @@ default-value-8
                (defaults (cons default-lab tn))
                
                (inst blt temp default-lab)
-               (inst ldl move-temp (* i word-bytes) ocfp-tn)
+               (inst ldl move-temp (* i n-word-bytes) ocfp-tn)
                (inst subq temp (fixnumize 1) temp)
                (store-stack-tn tn move-temp)))
            
@@ -316,9 +322,8 @@ default-value-8
                    ((null remaining))
                  (let ((def (car remaining)))
                    (emit-label (car def))
-                   (when (null (cdr remaining))
-                     (inst br zero-tn defaulting-done))
-                   (store-stack-tn (cdr def) null-tn)))))))
+                   (store-stack-tn (cdr def) null-tn)))
+               (inst br zero-tn defaulting-done)))))
 
        (when lra-label
          (inst compute-code-from-lra code-tn code-tn lra-label temp))))
@@ -527,7 +532,7 @@ default-value-8
         (return-pc :target return-pc-temp)
         (vals :more t))
   (:temporary (:sc any-reg :from (:argument 0)) ocfp-temp)
-  (:temporary (:sc descriptor-reg any-reg :from (:argument 1))
+  (:temporary (:sc any-reg :from (:argument 1))
              return-pc-temp)
   (:temporary (:scs (interior-reg)) lip)
   (:move-args :known-return)
@@ -535,7 +540,7 @@ default-value-8
   (:ignore val-locs vals)
   (:vop-var vop)
   (:generator 6
-    (trace-table-entry trace-table-function-epilogue)
+    (trace-table-entry trace-table-fun-epilogue)
     (maybe-load-stack-tn ocfp-temp ocfp)
     (maybe-load-stack-tn return-pc-temp return-pc)
     (move cfp-tn csp-tn)
@@ -543,7 +548,7 @@ default-value-8
       (when cur-nfp
        (inst addq cur-nfp (bytes-needed-for-non-descriptor-stack-frame)
              nsp-tn)))
-    (inst subq return-pc-temp (- other-pointer-lowtag word-bytes) lip)
+    (inst subq return-pc-temp (- other-pointer-lowtag n-word-bytes) lip)
     (move ocfp-temp cfp-tn)
     (inst ret zero-tn lip 1)
     (trace-table-entry trace-table-normal)))
@@ -569,20 +574,20 @@ default-value-8
 ;;; Named is true if the first argument is a symbol whose global
 ;;; function definition is to be called.
 ;;;
-;;; Return is either :Fixed, :Unknown or :Tail:
-;;; -- If :Fixed, then the call is for a fixed number of values, returned in
-;;;    the standard passing locations (passed as result operands).
-;;; -- If :Unknown, then the result values are pushed on the stack, and the
-;;;    result values are specified by the Start and Count as in the
+;;; Return is either :FIXED, :UNKNOWN or :TAIL:
+;;; -- If :FIXED, then the call is for a fixed number of values, returned
+;;;    in the standard passing locations (passed as result operands).
+;;; -- If :UNKNOWN, then the result values are pushed on the stack, and 
+;;;    the result values are specified by the Start and Count as in the
 ;;;    unknown-values continuation representation.
-;;; -- If :Tail, then do a tail-recursive call.  No values are returned.
+;;; -- If :TAIL, then do a tail-recursive call.  No values are returned.
 ;;;    The Ocfp and Return-PC are passed as the second and third arguments.
 ;;;
 ;;; In non-tail calls, the pointer to the stack arguments is passed as
 ;;; the last fixed argument. If Variable is false, then the passing
 ;;; locations are passed as a more arg. Variable is true if there are
 ;;; a variable number of arguments passed on the stack. Variable
-;;; cannot be specified with :Tail return. TR variable argument call
+;;; cannot be specified with :TAIL return. TR variable argument call
 ;;; is implemented separately.
 ;;;
 ;;; In tail call with fixed arguments, the passing locations are
@@ -655,11 +660,11 @@ default-value-8
                 nargs-pass)
 
      ,@(when variable
-        (mapcar #'(lambda (name offset)
-                    `(:temporary (:sc descriptor-reg
-                                  :offset ,offset
-                                  :to :eval)
-                        ,name))
+        (mapcar (lambda (name offset)
+                  `(:temporary (:sc descriptor-reg
+                                    :offset ,offset
+                                    :to :eval)
+                               ,name))
                 register-arg-names *register-arg-offsets*))
      ,@(when (eq return :fixed)
         '((:temporary (:scs (descriptor-reg) :from :eval) move-temp)))
@@ -703,11 +708,11 @@ default-value-8
                       ,@(if variable
                             `((inst subq csp-tn new-fp nargs-pass)
                               ,@(let ((index -1))
-                                  (mapcar #'(lambda (name)
-                                              `(inst ldl ,name
-                                                     ,(ash (incf index)
-                                                           word-shift)
-                                                     new-fp))
+                                  (mapcar (lambda (name)
+                                            `(inst ldl ,name
+                                                   ,(ash (incf index)
+                                                         word-shift)
+                                                   new-fp))
                                           register-arg-names)))
                             '((inst li (fixnumize nargs) nargs-pass))))
                      ,@(if (eq return :tail)
@@ -879,7 +884,7 @@ default-value-8
   (:vop-var vop)
   (:generator 6
     ;; Clear the number stack.
-    (trace-table-entry trace-table-function-epilogue)
+    (trace-table-entry trace-table-fun-epilogue)
     (let ((cur-nfp (current-nfp-tn vop)))
       (when cur-nfp
        (inst addq cur-nfp (bytes-needed-for-non-descriptor-stack-frame)
@@ -891,7 +896,7 @@ default-value-8
     #!-gengc (lisp-return return-pc lip :offset 2)
     #!+gengc
     (progn
-      (inst addq return-pc (* 2 word-bytes) temp)
+      (inst addq return-pc (* 2 n-word-bytes) temp)
       (unless (location= ra return-pc)
        (inst move ra return-pc))
       (inst ret zero-tn temp 1))
@@ -930,7 +935,7 @@ default-value-8
   (:vop-var vop)
   (:generator 6
     ;; Clear the number stack.
-    (trace-table-entry trace-table-function-epilogue)
+    (trace-table-entry trace-table-fun-epilogue)
     (let ((cur-nfp (current-nfp-tn vop)))
       (when cur-nfp
        (inst addq cur-nfp (bytes-needed-for-non-descriptor-stack-frame)
@@ -941,7 +946,7 @@ default-value-8
     ;; restore the frame pointer and clear as much of the control
     ;; stack as possible.
     (move ocfp cfp-tn)
-    (inst addq val-ptr (* nvals word-bytes) csp-tn)
+    (inst addq val-ptr (* nvals n-word-bytes) csp-tn)
     ;; pre-default any argument register that need it.
     (when (< nvals register-arg-count)
       (dolist (reg (subseq (list a0 a1 a2 a3 a4 a5) nvals))
@@ -977,7 +982,7 @@ default-value-8
   (:vop-var vop)
 
   (:generator 13
-    (trace-table-entry trace-table-function-epilogue)
+    (trace-table-entry trace-table-fun-epilogue)
     (let ((not-single (gen-label)))
       ;; Clear the number stack.
       (let ((cur-nfp (current-nfp-tn vop)))
@@ -1067,10 +1072,10 @@ default-value-8
 
       (emit-label loop)
       ;; *--dst = *--src, --count
-      (inst subq src word-bytes src)
+      (inst subq src n-word-bytes src)
       (inst subq count (fixnumize 1) count)
       (loadw temp src)
-      (inst subq dst word-bytes dst)
+      (inst subq dst n-word-bytes dst)
       (storew temp dst)
       (inst bgt count loop)
 
@@ -1099,7 +1104,9 @@ default-value-8
 (define-vop (listify-rest-args)
   (:args (context-arg :target context :scs (descriptor-reg))
         (count-arg :target count :scs (any-reg)))
-  (:arg-types * tagged-num)
+  (:info dx)
+  (:ignore dx)
+  (:arg-types * tagged-num (:constant t))
   (:temporary (:scs (any-reg) :from (:argument 0)) context)
   (:temporary (:scs (any-reg) :from (:argument 1)) count)
   (:temporary (:scs (descriptor-reg) :from :eval) temp dst)
@@ -1127,13 +1134,13 @@ default-value-8
 
        ;; Store the current cons in the cdr of the previous cons.
        (emit-label loop)
-       (inst addq dst (* 2 word-bytes) dst)
+       (inst addq dst (* 2 n-word-bytes) dst)
        (storew dst dst -1 list-pointer-lowtag)
 
        (emit-label enter)
        ;; Grab one value.
        (loadw temp context)
-       (inst addq context word-bytes context)
+       (inst addq context n-word-bytes context)
 
        ;; Store the value in the car (in delay slot)
        (storew temp dst 0 list-pointer-lowtag)
@@ -1171,9 +1178,9 @@ default-value-8
     (inst subq csp-tn count context)))
 
 ;;; Signal wrong argument count error if NARGS isn't equal to COUNT.
-(define-vop (verify-argument-count)
+(define-vop (verify-arg-count)
   (:policy :fast-safe)
-  (:translate sb!c::%verify-argument-count)
+  (:translate sb!c::%verify-arg-count)
   (:args (nargs :scs (any-reg)))
   (:arg-types positive-fixnum (:constant t))
   (:temporary (:scs (any-reg) :type fixnum) temp)
@@ -1182,7 +1189,7 @@ default-value-8
   (:save-p :compute-only)
   (:generator 3
     (let ((err-lab
-          (generate-error-code vop invalid-argument-count-error nargs)))
+          (generate-error-code vop invalid-arg-count-error nargs)))
       (cond ((zerop count)
             (inst bne nargs err-lab))
            (t
@@ -1195,21 +1202,21 @@ default-value-8
                ,@(when translate
                    `((:policy :fast-safe)
                      (:translate ,translate)))
-               (:args ,@(mapcar #'(lambda (arg)
-                                    `(,arg :scs (any-reg descriptor-reg)))
+               (:args ,@(mapcar (lambda (arg)
+                                  `(,arg :scs (any-reg descriptor-reg)))
                                 args))
                (:vop-var vop)
                (:save-p :compute-only)
                (:generator 1000
                  (error-call vop ,error ,@args)))))
-  (frob argument-count-error invalid-argument-count-error
-    sb!c::%argument-count-error nargs)
+  (frob arg-count-error invalid-arg-count-error
+    sb!c::%arg-count-error nargs)
   (frob type-check-error object-not-type-error sb!c::%type-check-error
     object type)
   (frob layout-invalid-error layout-invalid-error sb!c::%layout-invalid-error
     object layout)
-  (frob odd-key-arguments-error odd-key-arguments-error
-    sb!c::%odd-key-arguments-error)
-  (frob unknown-key-argument-error unknown-key-argument-error
-    sb!c::%unknown-key-argument-error key)
-  (frob nil-function-returned-error nil-function-returned-error nil fun))
+  (frob odd-key-args-error odd-key-args-error
+    sb!c::%odd-key-args-error)
+  (frob unknown-key-arg-error unknown-key-arg-error
+    sb!c::%unknown-key-arg-error key)
+  (frob nil-fun-returned-error nil-fun-returned-error nil fun))