X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fassembly%2Falpha%2Fassem-rtns.lisp;h=c005c0fa69a90f30f848b470e338a76e3ba47534;hb=18d4de696bc5063aad026ba62be613c7b07f5fc8;hp=aae4d8a7d4ccce924640e48c0b8f72860922b6fe;hpb=dfa55a883f94470267b626dae77ce7e7dfac3df6;p=sbcl.git diff --git a/src/assembly/alpha/assem-rtns.lisp b/src/assembly/alpha/assem-rtns.lisp index aae4d8a..c005c0f 100644 --- a/src/assembly/alpha/assem-rtns.lisp +++ b/src/assembly/alpha/assem-rtns.lisp @@ -1,16 +1,17 @@ -;;; ********************************************************************** -;;; 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") ;;;; 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)) @@ -39,32 +40,32 @@ ;; 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 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 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 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 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 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 word-bytes) vals) + (inst addq cfp-tn (* 6 word-bytes) dst) LOOP (inst ldl temp 0 vals) - (inst addq vals sb!vm:word-bytes vals) + (inst addq vals 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 word-bytes dst) (inst bne count loop) (inst br zero-tn done) @@ -89,11 +90,10 @@ ;; Return. (lisp-return lra lip)) - -;;;; 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)) @@ -128,36 +128,36 @@ ;; 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 word-bytes) args) + (inst ldl a1 (* 1 word-bytes) args) + (inst ldl a2 (* 2 word-bytes) args) + (inst ldl a3 (* 3 word-bytes) args) + (inst ldl a4 (* 4 word-bytes) args) + (inst ldl a5 (* 5 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 (* 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 (* 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 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 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-function-slot function-pointer-type) (lisp-jump temp lip))) -;;;; Non-local exit noise. +;;;; non-local exit noise (define-assembly-routine (unwind @@ -174,11 +174,11 @@ (: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) @@ -186,19 +186,18 @@ 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) @@ -210,17 +209,17 @@ (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