X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fcall.lisp;h=2af370203f10d0b5c06a0471b7343629b300596b;hb=34dd23563d2f5cf05c72b971da0d0b065a09bf2a;hp=322999ce93872723ed42269270b89919bf430269;hpb=3c65762b927af861c9c8bc416e4cbac9a14ec0c3;p=sbcl.git

diff --git a/src/compiler/x86/call.lisp b/src/compiler/x86/call.lisp
index 322999c..2af3702 100644
--- a/src/compiler/x86/call.lisp
+++ b/src/compiler/x86/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* descriptor-reg-sc-number
@@ -64,7 +64,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* any-reg-sc-number ecx-offset))
 
 ;;; Make a TN to hold the number-stack frame pointer. This is allocated
@@ -84,15 +84,22 @@
   (list (make-stack-pointer-tn)
 	(make-normal-tn *fixnum-primitive-type*)))
 
-;;; This function is called by the Entry-Analyze phase, allowing
+;;; 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
+;;; push placeholder entries in the CONSTANTS to leave room for
 ;;; additional noise in the code object header.
-;;;
-;;; For the x86 the first constant is a pointer to a list of fixups,
-;;; or NIL if the code object has none.
 (!def-vm-support-routine select-component-format (component)
   (declare (type component component))
+  ;; The 1+ here is because for the x86 the first constant is a
+  ;; pointer to a list of fixups, or NIL if the code object has none.
+  ;; (If I understand correctly, the fixups are needed at GC copy
+  ;; time because the X86 code isn't relocatable.)
+  ;;
+  ;; KLUDGE: It'd be cleaner to have the fixups entry be a named
+  ;; element of the CODE (aka component) primitive object. However,
+  ;; it's currently a large, tricky, error-prone chore to change
+  ;; the layout of any primitive object, so for the foreseeable future
+  ;; we'll just live with this ugliness. -- WHN 2002-01-02
   (dotimes (i (1+ code-constants-offset))
     (vector-push-extend nil
 			(ir2-component-constants (component-info component))))
@@ -118,11 +125,11 @@
   (:vop-var vop)
   (:generator 1
     (align n-lowtag-bits)
-    (trace-table-entry trace-table-function-prologue)
+    (trace-table-entry trace-table-fun-prologue)
     (emit-label start-lab)
     ;; Skip space for the function header.
     (inst simple-fun-header-word)
-    (dotimes (i (1- sb!vm:simple-fun-code-offset))
+    (dotimes (i (1- simple-fun-code-offset))
       (inst dword 0))
 
     ;; The start of the actual code.
@@ -136,7 +143,7 @@
       ;; The args fit within the frame so just allocate the frame.
       (inst lea esp-tn
 	    (make-ea :dword :base ebp-tn
-		     :disp (- (* sb!vm:word-bytes
+		     :disp (- (* n-word-bytes
 				 (max 3 (sb-allocated-size 'stack)))))))
 
     (trace-table-entry trace-table-normal)))
@@ -151,7 +158,7 @@
   (:ignore nfp callee)
   (:generator 2
     (move res esp-tn)
-    (inst sub esp-tn (* sb!vm:word-bytes (sb-allocated-size 'stack)))))
+    (inst sub esp-tn (* n-word-bytes (sb-allocated-size 'stack)))))
 
 ;;; Allocate a partial frame for passing stack arguments in a full
 ;;; call. NARGS is the number of arguments passed. We allocate at
@@ -162,7 +169,7 @@
   (:results (res :scs (any-reg control-stack)))
   (:generator 2
     (move res esp-tn)
-    (inst sub esp-tn (* (max nargs 3) sb!vm:word-bytes))))
+    (inst sub esp-tn (* (max nargs 3) n-word-bytes))))
 
 ;;; 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
@@ -264,7 +271,7 @@
 	(let ((defaults (defaults)))
 	  (when defaults
 	    (assemble (*elsewhere*)
-	      (trace-table-entry trace-table-function-prologue)
+	      (trace-table-entry trace-table-fun-prologue)
 	      (emit-label default-stack-slots)
 	      (dolist (default defaults)
 		(emit-label (car default))
@@ -293,7 +300,7 @@
       (emit-label no-stack-args)
       (inst lea edi-tn
 	    (make-ea :dword :base ebp-tn
-		     :disp (* (- (1+ register-arg-count)) word-bytes)))
+		     :disp (* (- (1+ register-arg-count)) n-word-bytes)))
       ;; Load EAX with NIL so we can quickly store it, and set up
       ;; stuff for the loop.
       (inst mov eax-tn nil-value)
@@ -322,12 +329,12 @@
       ;; Compute a pointer to where the stack args go.
       (inst lea edi-tn
 	    (make-ea :dword :base ebp-tn
-		     :disp (* (- (1+ register-arg-count)) word-bytes)))
+		     :disp (* (- (1+ register-arg-count)) n-word-bytes)))
       ;; Save ESI, and compute a pointer to where the args come from.
       (storew esi-tn ebx-tn (- (1+ 2)))
       (inst lea esi-tn
 	    (make-ea :dword :base ebx-tn
-		     :disp (* (- (1+ register-arg-count)) word-bytes)))
+		     :disp (* (- (1+ register-arg-count)) n-word-bytes)))
       ;; Do the copy.
       (inst shr ecx-tn word-shift)		; make word count
       (inst std)
@@ -573,7 +580,7 @@
   (:ignore val-locs vals)
   (:vop-var vop)
   (:generator 6
-    (trace-table-entry trace-table-function-epilogue)
+    (trace-table-entry trace-table-fun-epilogue)
     ;; Save the return-pc in a register 'cause the frame-pointer is
     ;; going away. Note this not in the usual stack location so we
     ;; can't use RET
@@ -606,14 +613,15 @@
   (:ignore val-locs vals)
   (:vop-var vop)
   (:generator 6
-    (trace-table-entry trace-table-function-epilogue)
+    (trace-table-entry trace-table-fun-epilogue)
 
     #+nil (format t "*known-return: old-fp ~S, tn-kind ~S; ~S ~S~%"
 		  old-fp (sb!c::tn-kind old-fp) (sb!c::tn-save-tn old-fp)
 		  (sb!c::tn-kind (sb!c::tn-save-tn old-fp)))
 
     #+nil (format t "*known-return: return-pc ~S, tn-kind ~S; ~S ~S~%"
-		  return-pc (sb!c::tn-kind return-pc) (sb!c::tn-save-tn return-pc)
+		  return-pc (sb!c::tn-kind return-pc)
+		  (sb!c::tn-save-tn return-pc)
 		  (sb!c::tn-kind (sb!c::tn-save-tn return-pc)))
 
     ;; return-pc may be either in a register or on the stack.
@@ -629,7 +637,7 @@
 		 ;; Zot all of the stack except for the old-fp.
 		 (inst lea esp-tn (make-ea :dword :base ebp-tn
 					   :disp (- (* (1+ ocfp-save-offset)
-						       word-bytes))))
+						       n-word-bytes))))
 		 ;; Restore the old fp from its save location on the stack,
 		 ;; and zot the stack.
 		 (inst pop ebp-tn))
@@ -656,14 +664,14 @@
        ;; Zot all of the stack except for the old-fp and return-pc.
        (inst lea esp-tn
 	     (make-ea :dword :base ebp-tn
-		      :disp (- (* (1+ (tn-offset return-pc)) word-bytes))))
+		      :disp (- (* (1+ (tn-offset return-pc)) n-word-bytes))))
        ;; Restore the old fp. old-fp may be either on the stack in its
        ;; save location or in a register, in either case this restores it.
        (move ebp-tn old-fp)
        ;; The return pops the return address (4 bytes), then we need
        ;; to pop all the slots before the return-pc which includes the
        ;; 4 bytes for the old-fp.
-       (inst ret (* (tn-offset return-pc) word-bytes))))
+       (inst ret (* (tn-offset return-pc) n-word-bytes))))
 
     (trace-table-entry trace-table-normal)))
 
@@ -699,7 +707,7 @@
 ;;; 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
@@ -762,12 +770,12 @@
 	       ;; doing the call. Therefore, we have to tell the
 	       ;; lifetime stuff that we need to use them.
 	       ,@(when variable
-		   (mapcar #'(lambda (name offset)
-			       `(:temporary (:sc descriptor-reg
-						 :offset ,offset
-						 :from (:argument 0)
-						 :to :eval)
-					    ,name))
+		   (mapcar (lambda (name offset)
+			     `(:temporary (:sc descriptor-reg
+					       :offset ,offset
+					       :from (:argument 0)
+					       :to :eval)
+					  ,name))
 			   *register-arg-names* *register-arg-offsets*))
 
 	       ,@(when (eq return :tail)
@@ -874,9 +882,10 @@
 	       (inst ,(if (eq return :tail) 'jmp 'call)
 		     (make-ea :dword :base eax
 			      :disp ,(if named
-					 '(- (* fdefn-raw-addr-slot word-bytes)
+					 '(- (* fdefn-raw-addr-slot
+						n-word-bytes)
 					     other-pointer-lowtag)
-				       '(- (* closure-fun-slot word-bytes)
+				       '(- (* closure-fun-slot n-word-bytes)
 					   fun-pointer-lowtag))))
 	       ,@(ecase return
 		   (:fixed
@@ -945,7 +954,7 @@
   (:temporary (:sc unsigned-reg) ret)
   (:ignore value)
   (:generator 6
-    (trace-table-entry trace-table-function-epilogue)
+    (trace-table-entry trace-table-fun-epilogue)
     (move ret return-pc)
     ;; Clear the control stack
     (move ofp old-fp)
@@ -987,19 +996,19 @@
 		   :from :eval) a2)
 
   (:generator 6
-    (trace-table-entry trace-table-function-epilogue)
+    (trace-table-entry trace-table-fun-epilogue)
     ;; Establish the values pointer and values count.
     (move ebx ebp-tn)
     (if (zerop nvals)
 	(inst xor ecx ecx) ; smaller
       (inst mov ecx (fixnumize nvals)))
-    ;; restore the frame pointer.
+    ;; Restore the frame pointer.
     (move ebp-tn old-fp)
-    ;; clear as much of the stack as possible, but not past the return
+    ;; Clear as much of the stack as possible, but not past the return
     ;; address.
     (inst lea esp-tn (make-ea :dword :base ebx
-			      :disp (- (* (max nvals 2) word-bytes))))
-    ;; pre-default any argument register that need it.
+			      :disp (- (* (max nvals 2) n-word-bytes))))
+    ;; Pre-default any argument register that need it.
     (when (< nvals register-arg-count)
       (let* ((arg-tns (nthcdr nvals (list a0 a1 a2)))
 	     (first (first arg-tns)))
@@ -1011,7 +1020,7 @@
     ;; tell it to index off of EBX instead of EBP.
     (cond ((zerop nvals)
 	   ;; Return popping the return address and the OCFP.
-	   (inst ret word-bytes))
+	   (inst ret n-word-bytes))
 	  ((= nvals 1)
 	   ;; Return popping the return, leaving 1 slot. Can this
 	   ;; happen, or is a single value return handled elsewhere?
@@ -1019,7 +1028,7 @@
 	  (t
 	   (inst jmp (make-ea :dword :base ebx
 			      :disp (- (* (1+ (tn-offset return-pc))
-					  word-bytes))))))
+					  n-word-bytes))))))
 
     (trace-table-entry trace-table-normal)))
 
@@ -1050,7 +1059,7 @@
   (:node-var node)
 
   (:generator 13
-    (trace-table-entry trace-table-function-epilogue)
+    (trace-table-entry trace-table-fun-epilogue)
     ;; Load the return-pc.
     (move eax return-pc)
     (unless (policy node (> space speed))
@@ -1134,7 +1143,7 @@
     (inst lea ebx-tn
 	  (make-ea :dword :base ebp-tn
 		   :disp (- (fixnumize fixed)
-			    (* sb!vm:word-bytes
+			    (* n-word-bytes
 			       (max 3 (sb-allocated-size 'stack))))))
     (inst sub ebx-tn ecx-tn)  ; Got the new stack in ebx
     (inst mov esp-tn ebx-tn)
@@ -1212,7 +1221,7 @@
     JUST-ALLOC-FRAME
     (inst lea esp-tn
 	  (make-ea :dword :base ebp-tn
-		   :disp (- (* sb!vm:word-bytes
+		   :disp (- (* n-word-bytes
 			       (max 3 (sb-allocated-size 'stack))))))
 
     DONE))
@@ -1244,7 +1253,7 @@
   (:result-types *)
   (:generator 4
    (inst mov value
-	 (make-ea :dword :base object :disp (- (* index word-bytes))))))
+	 (make-ea :dword :base object :disp (- (* index n-word-bytes))))))
 
 
 ;;; Turn more arg (context, count) into a list.
@@ -1285,7 +1294,7 @@
        (inst jmp enter)
        (emit-label loop)
        ;; Compute a pointer to the next cons.
-       (inst add dst (* cons-size word-bytes))
+       (inst add dst (* cons-size n-word-bytes))
        ;; Store a pointer to this cons in the CDR of the previous cons.
        (storew dst dst -1 list-pointer-lowtag)
        (emit-label enter)
@@ -1295,7 +1304,7 @@
        ;; Go back for more.
        (inst loop loop)
        ;; NIL out the last cons.
-       (storew nil-value dst 1 sb!vm:list-pointer-lowtag))
+       (storew nil-value dst 1 list-pointer-lowtag))
       (emit-label done))))
 
 ;;; Return the location and size of the &MORE arg glob created by
@@ -1329,9 +1338,9 @@
       (inst sub count (fixnumize fixed)))))
 
 ;;; 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))
   (:info count)
@@ -1339,33 +1348,33 @@
   (: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)))
       (if (zerop count)
 	  (inst test nargs nargs)  ; smaller instruction
 	(inst cmp nargs (fixnumize count)))
       (inst jmp :ne err-lab))))
 
 ;;; Various other error signallers.
-(macrolet ((frob (name error translate &rest args)
+(macrolet ((def (name error translate &rest args)
 	     `(define-vop (,name)
 		,@(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 type-check-error object-not-type-error sb!c::%type-check-error
+  (def arg-count-error invalid-arg-count-error
+    sb!c::%arg-count-error nargs)
+  (def 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
+  (def 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))
+  (def odd-key-args-error odd-key-args-error
+    sb!c::%odd-key-args-error)
+  (def unknown-key-arg-error unknown-key-arg-error
+    sb!c::%unknown-key-arg-error key)
+  (def nil-fun-returned-error nil-fun-returned-error nil fun))