-(in-package "SB!VM")
+;;;; the VM definition of function call for MIPS
+
+;;;; This software is part of the SBCL system. See the README file for
+;;;; more information.
+;;;;
+;;;; This software is derived from the CMU CL system, which was
+;;;; written at Carnegie Mellon University and released into the
+;;;; public domain. The software is in the public domain and is
+;;;; provided with absolutely no warranty. See the COPYING and CREDITS
+;;;; files for more information.
+(in-package "SB!VM")
\f
;;;; Interfaces to IR2 conversion:
-;;; Standard-Argument-Location -- Interface
-;;;
-;;; Return a wired TN describing the N'th full call argument passing
+;;; Return a wired TN describing the N'th full call argument passing
;;; location.
-;;;
(!def-vm-support-routine standard-arg-location (n)
(declare (type unsigned-byte n))
(if (< n register-arg-count)
control-stack-arg-scn n)))
-;;; Make-Return-PC-Passing-Location -- Interface
-;;;
-;;; Make a passing location TN for a local call return PC. If standard is
+;;; Make a passing location TN for a local call return PC. If standard 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)
(if standard
(make-wired-tn *backend-t-primitive-type* register-arg-scn lra-offset)
(make-restricted-tn *backend-t-primitive-type* register-arg-scn)))
-;;; Make-Old-FP-Passing-Location -- Interface
-;;;
-;;; 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.
-;;;
+;;; 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)
(make-normal-tn *fixnum-primitive-type*)))
-;;; Make-Old-FP-Save-Location, Make-Return-PC-Save-Location -- Interface
-;;;
-;;; Make the TNs used to hold Old-FP and Return-PC within the current
-;;; function. We treat these specially so that the debugger can find them at a
-;;; known location.
-;;;
+;;; Make the TNs used to hold OLD-FP and RETURN-PC within the current
+;;; function. We treat these specially so that the debugger can find
+;;; them at a known location.
(!def-vm-support-routine make-old-fp-save-location (env)
(specify-save-tn
(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
(physenv-debug-live-tn (make-normal-tn ptype) env)
(make-wired-tn ptype control-stack-arg-scn lra-save-offset))))
-;;; Make-Argument-Count-Location -- Interface
-;;;
-;;; Make a TN for the standard argument count passing location. We only
+;;; 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-arg-count-location ()
(make-wired-tn *fixnum-primitive-type* immediate-arg-scn nargs-offset))
-;;; MAKE-NFP-TN -- Interface
-;;;
-;;; Make a TN to hold the number-stack frame pointer. This is allocated
+;;; Make a TN to hold the number-stack frame pointer. This is allocated
;;; once per component, and is component-live.
-;;;
(!def-vm-support-routine make-nfp-tn ()
(component-live-tn
(make-wired-tn *fixnum-primitive-type* immediate-arg-scn nfp-offset)))
-;;; MAKE-STACK-POINTER-TN ()
-;;;
(!def-vm-support-routine make-stack-pointer-tn ()
(make-normal-tn *fixnum-primitive-type*))
-;;; MAKE-NUMBER-STACK-POINTER-TN ()
-;;;
(!def-vm-support-routine make-number-stack-pointer-tn ()
(make-normal-tn *fixnum-primitive-type*))
-;;; Make-Unknown-Values-Locations -- Interface
-;;;
-;;; Return a list of TNs that can be used to represent an unknown-values
+;;; Return a list of TNs that can be used to represent an unknown-values
;;; continuation within a function.
-;;;
(!def-vm-support-routine make-unknown-values-locations ()
(list (make-stack-pointer-tn)
(make-normal-tn *fixnum-primitive-type*)))
-;;; Select-Component-Format -- Interface
-;;;
-;;; This function is called by the Entry-Analyze phase, allowing
-;;; VM-dependent initialization of the IR2-Component structure. We push
+;;; 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))
(dotimes (i code-constants-offset)
\f
-;;; Default-Unknown-Values -- Internal
-;;;
-;;; Emit code needed at the return-point from an unknown-values call for a
+;;; 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 list for the
;;; locations that the values are to be received into. Nvals is the number of
;;; values that are to be received (should equal the length of Values).
;;;
-;;; Move-Temp is a Descriptor-Reg TN used as a temporary.
+;;; MOVE-TEMP is a DESCRIPTOR-REG TN used as a temporary.
;;;
;;; This code exploits the fact that in the unknown-values convention, a
;;; single value return returns at the return PC + 8, whereas a return of other
;; gets confused.
(without-scheduling ()
(note-this-location vop :single-value-return)
- (move csp-tn ocfp-tn)
+ (inst move csp-tn ocfp-tn)
(inst nop))
(when lra-label
(inst compute-code-from-lra code-tn code-tn lra-label temp)))
;; If there are no stack results, clear the stack now.
(if (> nvals register-arg-count)
(inst addu temp nargs-tn (fixnumize (- register-arg-count)))
- (move csp-tn ocfp-tn)))
+ (move csp-tn ocfp-tn t)))
;; Do the single value calse.
(do ((i 1 (1+ i))
(move (tn-ref-tn val) null-tn))
(when (> nvals register-arg-count)
(inst b default-stack-vals)
- (move ocfp-tn csp-tn))
+ (move ocfp-tn csp-tn t))
(emit-label regs-defaulted)
(move csp-tn ocfp-tn)
(let ((defaults (defaults)))
- (assert defaults)
+ (aver defaults)
(assemble (*elsewhere*)
(emit-label default-stack-vals)
(do ((remaining defaults (cdr remaining)))
\f
;;;; Unknown values receiving:
-;;; Receive-Unknown-Values -- Internal
-;;;
;;; Emit code needed at the return point for an unknown-values call for an
;;; arbitrary number of values.
;;;
((null arg))
(storew (first arg) args i))
(move start args)
- (move count nargs)
(inst b done)
- (inst nop)))
+ (move count nargs t)))
(values))
(bytes-needed-for-non-descriptor-stack-frame))))
(inst addu lip return-pc-temp (- n-word-bytes other-pointer-lowtag))
(inst j lip)
- (move cfp-tn ocfp-temp)
+ (move cfp-tn ocfp-temp t)
(trace-table-entry trace-table-normal)))
\f
;;; arguments, we don't bother allocating a partial frame, and instead set FP
;;; to SP just before the call.
-;;; Define-Full-Call -- Internal
-;;;
;;; This macro helps in the definition of full call VOPs by avoiding code
;;; replication in defining the cross-product VOPs.
;;;
;;; the current frame.
;;;
(defmacro define-full-call (name named return variable)
- (assert (not (and variable (eq return :tail))))
+ (aver (not (and variable (eq return :tail))))
`(define-vop (,name
,@(when (eq return :unknown)
'(unknown-values-receiver)))
'((:load-ocfp
(sc-case ocfp
(any-reg
- (inst move ocfp-pass ocfp))
+ (move ocfp-pass ocfp t))
(control-stack
(inst lw ocfp-pass cfp-tn
(ash (tn-offset ocfp)
(:load-return-pc
(sc-case return-pc
(descriptor-reg
- (inst move return-pc-pass return-pc))
+ (move return-pc-pass return-pc t))
(control-stack
(inst lw return-pc-pass cfp-tn
(ash (tn-offset return-pc)
(:frob-nfp
(store-stack-tn nfp-save cur-nfp))
(:save-fp
- (inst move ocfp-pass cfp-tn))
+ (move ocfp-pass cfp-tn t))
(:load-fp
,(if variable
'(move cfp-tn new-fp)
(do-next-filler)
(return)))
+ (do-next-filler)
(note-this-location vop :call-site)
(inst j entry-point)
- (do-next-filler))
+ (inst nop))
,@(ecase return
(:fixed
(move ocfp ocfp-arg)
(move lra lra-arg)
- ;; Clear the number stack if anything is there.
+ ;; Clear the number stack if anything is there and jump to the
+ ;; assembly-routine that does the bliting.
+ (inst j (make-fixup 'tail-call-variable :assembly-routine))
(let ((cur-nfp (current-nfp-tn vop)))
- (when cur-nfp
+ (if cur-nfp
(inst addu nsp-tn cur-nfp
- (bytes-needed-for-non-descriptor-stack-frame))))
-
- ;; And jump to the assembly-routine that does the bliting.
- (inst j (make-fixup 'tail-call-variable :assembly-routine))
- (inst nop)))
+ (bytes-needed-for-non-descriptor-stack-frame))
+ (inst nop)))))
\f
;;;; Unknown values return:
(move ocfp ocfp-arg)
(move lra lra-arg)
(move vals vals-arg)
- (move nvals nvals-arg)
+
(inst j (make-fixup 'return-multiple :assembly-routine))
- (inst nop))
+ (move nvals nvals-arg t))
(trace-table-entry trace-table-normal)))
;; Don't bother doing anything.
))
-;;; Get the lexical environment from it's passing location.
+;;; Get the lexical environment from its passing location.
;;;
(define-vop (setup-closure-environment)
(:temporary (:sc descriptor-reg :offset lexenv-offset :target closure
(:temporary (:sc any-reg :offset nl0-offset) result)
(:temporary (:sc any-reg :offset nl1-offset) count)
(:temporary (:sc any-reg :offset nl2-offset) src)
- (:temporary (:sc any-reg :offset nl4-offset) dst)
+ (:temporary (:sc any-reg :offset nl3-offset) dst)
(:temporary (:sc descriptor-reg :offset l0-offset) temp)
(:info fixed)
(:generator 20
;; Everything of interest in registers.
(inst blez count do-regs)
;; Initialize dst to be end of stack.
- (move dst csp-tn)
+ (move dst csp-tn t)
;; Initialize src to be end of args.
(inst addu src cfp-tn nargs-tn)
(move count count-arg)
;; Check to see if there are any arguments.
(inst beq count zero-tn done)
- (move result null-tn)
+ (move result null-tn t)
;; We need to do this atomically.
(pseudo-atomic (pa-flag)
projects / sbcl.git / blobdiff