(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))))
(: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)
(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))
(: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
(: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.
;; 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)
(: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)
: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)
(: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))
(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
+ (def 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 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
+ (def odd-key-arguments-error odd-key-arguments-error
sb!c::%odd-key-arguments-error)
- (frob unknown-key-argument-error unknown-key-argument-error
+ (def 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 nil-fun-returned-error nil-fun-returned-error nil fun))
projects / sbcl.git / blobdiff