;;; debugger can find them at a known location.
(!def-vm-support-routine make-old-fp-save-location (env)
(specify-save-tn
- (environment-debug-live-tn (make-normal-tn *fixnum-primitive-type*) env)
+ (physenv-debug-live-tn (make-normal-tn *fixnum-primitive-type*) env)
(make-wired-tn *fixnum-primitive-type*
control-stack-arg-scn
ocfp-save-offset)))
(!def-vm-support-routine make-return-pc-save-location (env)
(let ((ptype *backend-t-primitive-type*))
(specify-save-tn
- (environment-debug-live-tn (make-normal-tn ptype) env)
+ (physenv-debug-live-tn (make-normal-tn ptype) env)
(make-wired-tn ptype control-stack-arg-scn lra-save-offset))))
;;; Make a TN for the standard argument count passing location. We
(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)
+ (align n-lowtag-bits)
(trace-table-entry trace-table-function-prologue)
(emit-label start-lab)
;; Allocate function header.
- (inst function-header-word)
- (dotimes (i (1- function-code-offset))
+ (inst simple-fun-header-word)
+ (dotimes (i (1- simple-fun-code-offset))
(inst lword 0))
;; The start of the actual code.
;; Compute CODE from the address of this entry point.
;; 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)
(:generator 2
(trace-table-entry trace-table-function-prologue)
(move csp-tn res)
- (inst lda csp-tn (* word-bytes (sb-allocated-size 'control-stack)) csp-tn)
- (when (ir2-environment-number-stack-p callee)
+ (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)
(move nsp-tn nfp))
(: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
(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)))
(:temporary (:sc control-stack :offset nfp-save-offset) nfp-save)
(:temporary (:scs (non-descriptor-reg)) temp)
(:generator 5
- (let (#!-gengc (label (gen-label))
+ (let ((label (gen-label))
(cur-nfp (current-nfp-tn vop)))
(when cur-nfp
(store-stack-tn nfp-save cur-nfp))
(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)
(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)))
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)))
,@(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)
(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))
(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-function-slot word-shift)
- function-pointer-type) lexenv)
+ (- (ash closure-fun-slot word-shift)
+ fun-pointer-lowtag) lexenv)
#!-gengc
(do-next-filler)
#!-gengc
(inst addq function
- (- (ash function-code-offset word-shift)
- function-pointer-type) entry-point)
+ (- (ash simple-fun-code-offset word-shift)
+ fun-pointer-lowtag) entry-point)
#!+gengc
(inst ldl entry-point
(- (ash closure-entry-point-slot word-shift)
- function-pointer-type) lexenv)
+ fun-pointer-lowtag) lexenv)
#!+gengc
(do-next-filler)))
(loop
#!-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))
;; 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))
(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)
;; 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)
;; 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
,@(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)
projects / sbcl.git / blobdiff