X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fx86%2Fcall.lisp;h=2af370203f10d0b5c06a0471b7343629b300596b;hb=34dd23563d2f5cf05c72b971da0d0b065a09bf2a;hp=58522f40efdcdf0d2700370395af81fe9dd2469d;hpb=50305b602c3953440af716137a56f50cd204375d;p=sbcl.git diff --git a/src/compiler/x86/call.lisp b/src/compiler/x86/call.lisp index 58522f4..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,7 +125,7 @@ (: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) @@ -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)) @@ -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. @@ -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) @@ -946,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) @@ -988,7 +996,7 @@ :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) @@ -1051,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)) @@ -1330,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) @@ -1340,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))