X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmips%2Fcall.lisp;h=639bebd67ea5dfb8d4fe07d53b3192f9d1d4e9fc;hb=3fe0010d2777b41e01ea9b4a0f894cfa40f7df1b;hp=117e3824678af274f5b7eb5d2056fd4dbc5144fc;hpb=581e3d62de8cb37e13ad9db63e5537c0f962be28;p=sbcl.git diff --git a/src/compiler/mips/call.lisp b/src/compiler/mips/call.lisp index 117e382..639bebd 100644 --- a/src/compiler/mips/call.lisp +++ b/src/compiler/mips/call.lisp @@ -1,5 +1,15 @@ -(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") ;;;; Interfaces to IR2 conversion: @@ -257,7 +267,7 @@ default-value-8 ;; 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))) @@ -272,7 +282,7 @@ default-value-8 ;; 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)) @@ -281,7 +291,7 @@ default-value-8 (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) @@ -309,7 +319,7 @@ default-value-8 (move csp-tn ocfp-tn) (let ((defaults (defaults))) - (assert defaults) + (aver defaults) (assemble (*elsewhere*) (emit-label default-stack-vals) (do ((remaining defaults (cdr remaining))) @@ -370,9 +380,8 @@ default-value-8 ((null arg)) (storew (first arg) args i)) (move start args) - (move count nargs) (inst b done) - (inst nop))) + (move count nargs t))) (values)) @@ -563,7 +572,7 @@ default-value-8 (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))) @@ -608,7 +617,7 @@ default-value-8 ;;; 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))) @@ -729,7 +738,7 @@ default-value-8 '((: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) @@ -737,7 +746,7 @@ default-value-8 (: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) @@ -751,7 +760,7 @@ default-value-8 (: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) @@ -801,9 +810,10 @@ default-value-8 (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 @@ -860,15 +870,14 @@ default-value-8 (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))))) ;;;; Unknown values return: @@ -992,9 +1001,9 @@ default-value-8 (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))) @@ -1011,7 +1020,7 @@ default-value-8 ;; 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 @@ -1031,7 +1040,7 @@ default-value-8 (: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 @@ -1058,7 +1067,7 @@ default-value-8 ;; 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) @@ -1115,7 +1124,7 @@ default-value-8 (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)