;;; Return a wired TN describing the N'th full call argument passing
;;; location.
-;;;
(!def-vm-support-routine standard-argument-location (n)
(declare (type unsigned-byte n))
(if (< n register-arg-count)
;;; is true, then use the standard (full call) location, otherwise use
;;; any legal location. Even in the non-standard case, this may be
;;; restricted by a desire to use a subroutine call instruction.
-;;;
(!def-vm-support-routine make-return-pc-passing-location (standard)
- #!+gengc (declare (ignore standard))
- #!-gengc
(if standard
(make-wired-tn *backend-t-primitive-type* register-arg-scn lra-offset)
- (make-restricted-tn *backend-t-primitive-type* register-arg-scn))
- #!+gengc
- (make-wired-tn *fixnum-primitive-type* immediate-arg-scn ra-offset))
+ (make-restricted-tn *backend-t-primitive-type* register-arg-scn)))
-;;; This is similar to Make-Return-PC-Passing-Location, but makes a
-;;; location to pass Old-FP in. This is (obviously) wired in the
+;;; This is similar to MAKE-RETURN-PC-PASSING-LOCATION, but makes a
+;;; location to pass OLD-FP in. This is (obviously) wired in the
;;; standard convention, but is totally unrestricted in non-standard
;;; conventions, since we can always fetch it off of the stack using
;;; the arg pointer.
-;;;
(!def-vm-support-routine make-old-fp-passing-location (standard)
(if standard
(make-wired-tn *fixnum-primitive-type* immediate-arg-scn ocfp-offset)
;;; 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 #!-gengc *backend-t-primitive-type*
- #!+gengc *fixnum-primitive-type*))
+ (let ((ptype *backend-t-primitive-type*))
(specify-save-tn
- (environment-debug-live-tn (make-normal-tn ptype) env)
- (make-wired-tn ptype control-stack-arg-scn
- #!-gengc lra-save-offset #!+gengc ra-save-offset))))
+ (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
;;; only need to make the standard location, since a count is never
(: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.
(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)
+ (when (ir2-physenv-number-stack-p callee)
(inst subq nsp-tn (bytes-needed-for-non-descriptor-stack-frame)
nsp-tn)
(move nsp-tn nfp))
(move ocfp-tn csp-tn)
(inst nop))
(when lra-label
- #!-gengc (inst compute-code-from-lra code-tn code-tn lra-label temp)
- #!+gengc (inst compute-code-from-ra code-tn ra-tn lra-label temp)))
+ (inst compute-code-from-lra code-tn code-tn lra-label temp)))
(let ((regs-defaulted (gen-label))
(defaulting-done (gen-label))
(default-stack-vals (gen-label)))
(store-stack-tn (cdr def) null-tn)))))))
(when lra-label
- #!-gengc (inst compute-code-from-lra code-tn code-tn lra-label temp)
- #!+gengc (inst compute-code-from-ra code-tn ra-tn lra-label temp))))
+ (inst compute-code-from-lra code-tn code-tn lra-label temp))))
(values))
\f
;;;; unknown values receiving
(inst nop))
(when lra-label
- #!-gengc (inst compute-code-from-lra code-tn code-tn lra-label temp)
- #!+gengc (inst compute-code-from-ra code-tn ra-tn lra-label temp))
+ (inst compute-code-from-lra code-tn code-tn lra-label temp))
(inst addq csp-tn 4 csp-tn)
(storew (first *register-arg-tns*) csp-tn -1)
(inst subq csp-tn 4 start)
(assemble (*elsewhere*)
(emit-label variable-values)
(when lra-label
- #!-gengc (inst compute-code-from-lra code-tn code-tn lra-label temp)
- #!+gengc (inst compute-code-from-ra code-tn ra-tn lra-label temp))
+ (inst compute-code-from-lra code-tn code-tn lra-label temp))
(do ((arg *register-arg-tns* (rest arg))
(i 0 (1+ i)))
((null arg))
(: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 #!-gengc descriptor-reg #!+gengc any-reg
- :from (:argument 1))
+ (:temporary (:sc descriptor-reg any-reg :from (:argument 1))
return-pc-temp)
- #!-gengc (:temporary (:scs (interior-reg)) lip)
+ (:temporary (:scs (interior-reg)) lip)
(:move-args :known-return)
(:info val-locs)
(:ignore val-locs vals)
(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 word-bytes) lip)
(move ocfp-temp cfp-tn)
(inst ret zero-tn lip 1)
(trace-table-entry trace-table-normal)))
-
\f
;;;; full call:
;;;;
(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
;; 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)
+ (storew dst dst -1 list-pointer-lowtag)
(emit-label enter)
;; Grab one value.
(inst addq context 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
projects / sbcl.git / blobdiff