X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Falpha%2Fcall.lisp;h=2acd3cbb0142ee1de7507dffcfc73d09bbc0fd00;hb=104ee7ee303efa16e415f5e75df635ac54dba733;hp=9b402ae4763f4f3193bb8ad60026cca72cf65de7;hpb=f143939b1dbaf38ebd4f92c851fbc4ecddf37af1;p=sbcl.git

diff --git a/src/compiler/alpha/call.lisp b/src/compiler/alpha/call.lisp
index 9b402ae..2acd3cb 100644
--- a/src/compiler/alpha/call.lisp
+++ b/src/compiler/alpha/call.lisp
@@ -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))
@@ -104,7 +104,7 @@
 ;;; 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)
@@ -131,8 +131,8 @@
   (: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)
@@ -147,7 +147,10 @@
       ;; 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)
@@ -160,9 +163,12 @@
 	    (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)
@@ -178,7 +184,7 @@
   (: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
@@ -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)))
 	    
@@ -527,7 +533,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 +541,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 +549,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-type 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)))
@@ -655,11 +661,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 +709,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)
@@ -760,11 +766,11 @@ default-value-8
 		     (constant
 		      (inst ldl name-pass
 			    (- (ash (tn-offset name) word-shift)
-			       other-pointer-type) code-tn)
+			       other-pointer-lowtag) code-tn)
 		      (do-next-filler)))
 		   (inst ldl entry-point
 			 (- (ash fdefn-raw-addr-slot word-shift)
-			    other-pointer-type) name-pass)
+			    other-pointer-lowtag) name-pass)
 		   (do-next-filler))
 		 `((sc-case arg-fun
 		     (descriptor-reg (move arg-fun lexenv))
@@ -775,22 +781,22 @@ default-value-8
 		     (constant
 		      (inst ldl lexenv
 			    (- (ash (tn-offset arg-fun) word-shift)
-			       other-pointer-type) code-tn)
+			       other-pointer-lowtag) code-tn)
 		      (do-next-filler)))
 		   #!-gengc
 		   (inst ldl function
 			 (- (ash closure-fun-slot word-shift)
-			    fun-pointer-type) lexenv)
+			    fun-pointer-lowtag) lexenv)
 		   #!-gengc
 		   (do-next-filler)
 		   #!-gengc
 		   (inst addq function
 			 (- (ash simple-fun-code-offset word-shift)
-			    fun-pointer-type) entry-point)
+			    fun-pointer-lowtag) entry-point)
 		   #!+gengc
 		   (inst ldl entry-point
 			 (- (ash closure-entry-point-slot word-shift)
-			    fun-pointer-type) lexenv)
+			    fun-pointer-lowtag) lexenv)
 		   #!+gengc
 		   (do-next-filler)))
 	   (loop
@@ -879,7 +885,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 +897,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 +936,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 +947,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 +983,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 +1073,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)
 
@@ -1119,7 +1125,7 @@ default-value-8
       ;; We need to do this atomically.
       (pseudo-atomic ()
 	;; Allocate a cons (2 words) for each item.
-	(inst bis alloc-tn list-pointer-type result)
+	(inst bis alloc-tn list-pointer-lowtag result)
 	(move result dst)
 	(inst sll count 1 temp)
 	(inst addq alloc-tn temp alloc-tn)
@@ -1127,23 +1133,23 @@ default-value-8
 
 	;; Store the current cons in the cdr of the previous cons.
 	(emit-label loop)
-	(inst addq dst (* 2 word-bytes) dst)
-	(storew dst dst -1 list-pointer-type)
+	(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-type)
+	(storew temp dst 0 list-pointer-lowtag)
 
 	;; Decrement count, and if != zero, go back for more.
 	(inst subq count (fixnumize 1) count)
 	(inst bne count loop)
 
 	;; NIL out the last cons.
-	(storew null-tn dst 1 list-pointer-type))
+	(storew null-tn dst 1 list-pointer-lowtag))
       (emit-label done))))
 
 ;;; Return the location and size of the &MORE arg glob created by
@@ -1171,9 +1177,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 +1188,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 +1201,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))