-;;; **********************************************************************
-;;; This code was written as part of the CMU Common Lisp project at
-;;; Carnegie Mellon University, and has been placed in the public domain.
-;;;
-;;;
-;;; **********************************************************************
-;;;
-(in-package "SB!VM")
+;;;; 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
;;;; Return-multiple with other than one value
-#+sb-assembling ;; we don't want a vop for this one.
+#+sb-assembling ;; We don't want a vop for this one.
(define-assembly-routine
(return-multiple
(:return-style :none))
(:temp a4 descriptor-reg a4-offset)
(:temp a5 descriptor-reg a5-offset))
- ;; Note, because of the way the return-multiple vop is written, we can
- ;; assume that we are never called with nvals == 1 and that a0 has already
- ;; been loaded.
+ ;; Note, because of the way the RETURN-MULTIPLE VOP is written, we
+ ;; can assume that we are never called with NVALS == 1 and that A0
+ ;; has already been loaded.
(inst ble nvals default-a0-and-on)
- (inst ldl a1 (* 1 sb!vm:word-bytes) vals)
+ (inst ldl a1 (* 1 n-word-bytes) vals)
(inst subq nvals (fixnumize 2) count)
(inst ble count default-a2-and-on)
- (inst ldl a2 (* 2 sb!vm:word-bytes) vals)
+ (inst ldl a2 (* 2 n-word-bytes) vals)
(inst subq nvals (fixnumize 3) count)
(inst ble count default-a3-and-on)
- (inst ldl a3 (* 3 sb!vm:word-bytes) vals)
+ (inst ldl a3 (* 3 n-word-bytes) vals)
(inst subq nvals (fixnumize 4) count)
(inst ble count default-a4-and-on)
- (inst ldl a4 (* 4 sb!vm:word-bytes) vals)
+ (inst ldl a4 (* 4 n-word-bytes) vals)
(inst subq nvals (fixnumize 5) count)
(inst ble count default-a5-and-on)
- (inst ldl a5 (* 5 sb!vm:word-bytes) vals)
+ (inst ldl a5 (* 5 n-word-bytes) vals)
(inst subq nvals (fixnumize 6) count)
(inst ble count done)
;; Copy the remaining args to the top of the stack.
- (inst addq vals (* 6 sb!vm:word-bytes) vals)
- (inst addq cfp-tn (* 6 sb!vm:word-bytes) dst)
+ (inst addq vals (* 6 n-word-bytes) vals)
+ (inst addq cfp-tn (* 6 n-word-bytes) dst)
LOOP
(inst ldl temp 0 vals)
- (inst addq vals sb!vm:word-bytes vals)
+ (inst addq vals n-word-bytes vals)
(inst stl temp 0 dst)
(inst subq count (fixnumize 1) count)
- (inst addq dst sb!vm:word-bytes dst)
+ (inst addq dst n-word-bytes dst)
(inst bne count loop)
-
+
(inst br zero-tn done)
DEFAULT-A0-AND-ON
DEFAULT-A5-AND-ON
(inst move null-tn a5)
DONE
-
+
;; Clear the stack.
(move cfp-tn ocfp-tn)
(move ocfp cfp-tn)
(inst addq ocfp-tn nvals csp-tn)
-
+
;; Return.
(lisp-return lra lip))
-
\f
-;;;; tail-call-variable.
+;;;; tail-call-variable
-#+sb-assembling ;; no vop for this one either.
+#+sb-assembling ;; no vop for this one either
(define-assembly-routine
(tail-call-variable
(:return-style :none))
;; Calculate NARGS (as a fixnum)
(inst subq csp-tn args nargs)
-
+
;; Load the argument regs (must do this now, 'cause the blt might
;; trash these locations)
- (inst ldl a0 (* 0 sb!vm:word-bytes) args)
- (inst ldl a1 (* 1 sb!vm:word-bytes) args)
- (inst ldl a2 (* 2 sb!vm:word-bytes) args)
- (inst ldl a3 (* 3 sb!vm:word-bytes) args)
- (inst ldl a4 (* 4 sb!vm:word-bytes) args)
- (inst ldl a5 (* 5 sb!vm:word-bytes) args)
+ (inst ldl a0 (* 0 n-word-bytes) args)
+ (inst ldl a1 (* 1 n-word-bytes) args)
+ (inst ldl a2 (* 2 n-word-bytes) args)
+ (inst ldl a3 (* 3 n-word-bytes) args)
+ (inst ldl a4 (* 4 n-word-bytes) args)
+ (inst ldl a5 (* 5 n-word-bytes) args)
;; Calc SRC, DST, and COUNT
(inst subq nargs (fixnumize register-arg-count) count)
- (inst addq args (* sb!vm:word-bytes register-arg-count) src)
+ (inst addq args (* n-word-bytes register-arg-count) src)
(inst ble count done)
- (inst addq cfp-tn (* sb!vm:word-bytes register-arg-count) dst)
-
+ (inst addq cfp-tn (* n-word-bytes register-arg-count) dst)
+
LOOP
;; Copy one arg.
(inst ldl temp 0 src)
- (inst addq src sb!vm:word-bytes src)
+ (inst addq src n-word-bytes src)
(inst stl temp 0 dst)
(inst subq count (fixnumize 1) count)
- (inst addq dst sb!vm:word-bytes dst)
+ (inst addq dst n-word-bytes dst)
(inst bgt count loop)
-
+
DONE
;; We are done. Do the jump.
(progn
- (loadw temp lexenv sb!vm:closure-function-slot sb!vm:function-pointer-type)
+ (loadw temp lexenv closure-fun-slot fun-pointer-lowtag)
(lisp-jump temp lip)))
\f
-;;;; Non-local exit noise.
+;;;; non-local exit noise
(define-assembly-routine
(unwind
(:temp temp1 non-descriptor-reg nl3-offset))
(declare (ignore start count))
- (load-symbol-value cur-uwp sb!impl::*current-unwind-protect-block*)
+ (load-symbol-value cur-uwp *current-unwind-protect-block*)
(let ((error (generate-error-code nil invalid-unwind-error)))
(inst beq block error))
-
- (loadw target-uwp block sb!vm:unwind-block-current-uwp-slot)
+
+ (loadw target-uwp block unwind-block-current-uwp-slot)
(inst cmpeq cur-uwp target-uwp temp1)
(inst beq temp1 do-uwp)
-
+
(move block cur-uwp)
do-exit
-
- (loadw cfp-tn cur-uwp sb!vm:unwind-block-current-cont-slot)
- (loadw code-tn cur-uwp sb!vm:unwind-block-current-code-slot)
+
+ (loadw cfp-tn cur-uwp unwind-block-current-cont-slot)
+ (loadw code-tn cur-uwp unwind-block-current-code-slot)
(progn
- (loadw lra cur-uwp sb!vm:unwind-block-entry-pc-slot)
+ (loadw lra cur-uwp unwind-block-entry-pc-slot)
(lisp-return lra lip :frob-code nil))
do-uwp
- (loadw next-uwp cur-uwp sb!vm:unwind-block-current-uwp-slot)
- (store-symbol-value next-uwp sb!impl::*current-unwind-protect-block*)
+ (loadw next-uwp cur-uwp unwind-block-current-uwp-slot)
+ (store-symbol-value next-uwp *current-unwind-protect-block*)
(inst br zero-tn do-exit))
-
(define-assembly-routine
throw
((:arg target descriptor-reg a0-offset)
(:temp catch any-reg a1-offset)
(:temp tag descriptor-reg a2-offset)
(:temp temp1 non-descriptor-reg nl0-offset))
-
+
(progn start count) ; We just need them in the registers.
- (load-symbol-value catch sb!impl::*current-catch-block*)
-
+ (load-symbol-value catch *current-catch-block*)
+
loop
-
+
(let ((error (generate-error-code nil unseen-throw-tag-error target)))
(inst beq catch error))
-
- (loadw tag catch sb!vm:catch-block-tag-slot)
+
+ (loadw tag catch catch-block-tag-slot)
(inst cmpeq tag target temp1)
(inst bne temp1 exit)
- (loadw catch catch sb!vm:catch-block-previous-catch-slot)
+ (loadw catch catch catch-block-previous-catch-slot)
(inst br zero-tn loop)
-
+
exit
-
+
(move catch target)
(inst li (make-fixup 'unwind :assembly-routine) temp1)
(inst jmp zero-tn temp1 (make-fixup 'unwind :assembly-routine)))
projects / sbcl.git / blobdiff