X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Falpha%2Fsap.lisp;h=a46db40e790c33a575739736f63cea9202e2403d;hb=74cf7a4d01664fbf72a662ba093ad67ca243b524;hp=5fd43d915c9b685c36dcc7621d08d8023c4a3f18;hpb=dfa55a883f94470267b626dae77ce7e7dfac3df6;p=sbcl.git diff --git a/src/compiler/alpha/sap.lisp b/src/compiler/alpha/sap.lisp index 5fd43d9..a46db40 100644 --- a/src/compiler/alpha/sap.lisp +++ b/src/compiler/alpha/sap.lisp @@ -1,41 +1,29 @@ -;;; -*- Package: VM; Log: C.Log -*- -;;; -;;; ********************************************************************** -;;; This code was written as part of the CMU Common Lisp project at -;;; Carnegie Mellon University, and has been placed in the public domain. -;;; - -;;; -;;; ********************************************************************** -;;; -;;; This file contains the Alpha VM definition of SAP operations. -;;; -;;; Written by William Lott. -;;; Alpha conversion by Sean Hallgren. -;;; -(in-package "SB!VM") +;;;; the Alpha VM definition of SAP operations +;;;; 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") -;;;; Moves and coercions: +;;;; moves and coercions ;;; Move a tagged SAP to an untagged representation. -;;; - (define-vop (move-to-sap) (:args (x :scs (descriptor-reg))) (:results (y :scs (sap-reg))) (:note "system area pointer indirection") (:generator 1 - (loadq y x sap-pointer-slot other-pointer-type))) - -;;; + (loadq y x sap-pointer-slot other-pointer-lowtag))) (define-move-vop move-to-sap :move (descriptor-reg) (sap-reg)) - ;;; Move an untagged SAP to a tagged representation. -;;; (define-vop (move-from-sap) (:args (x :scs (sap-reg) :target sap)) (:temporary (:scs (sap-reg) :from (:argument 0)) sap) @@ -44,37 +32,31 @@ (:note "system area pointer allocation") (:generator 20 (move x sap) - (with-fixed-allocation (y ndescr sap-type sap-size) - (storeq sap y sap-pointer-slot other-pointer-type)))) -;;; + (with-fixed-allocation (y ndescr sap-widetag sap-size) + (storeq sap y sap-pointer-slot other-pointer-lowtag)))) (define-move-vop move-from-sap :move (sap-reg) (descriptor-reg)) - -;;; Move untagged sap values. -;;; +;;; Move untagged SAP values. (define-vop (sap-move) (:args (x :target y - :scs (sap-reg) - :load-if (not (location= x y)))) + :scs (sap-reg) + :load-if (not (location= x y)))) (:results (y :scs (sap-reg) - :load-if (not (location= x y)))) + :load-if (not (location= x y)))) (:effects) (:affected) (:generator 0 (move x y))) -;;; (define-move-vop sap-move :move (sap-reg) (sap-reg)) - -;;; Move untagged sap arguments/return-values. -;;; -(define-vop (move-sap-argument) +;;; Move untagged SAP arguments/return-values. +(define-vop (move-sap-arg) (:args (x :target y - :scs (sap-reg)) - (fp :scs (any-reg) - :load-if (not (sc-is y sap-reg)))) + :scs (sap-reg)) + (fp :scs (any-reg) + :load-if (not (sc-is y sap-reg)))) (:results (y)) (:generator 0 (sc-case y @@ -82,18 +64,13 @@ (move x y)) (sap-stack (storeq x fp (tn-offset y)))))) -;;; -(define-move-vop move-sap-argument :move-argument +(define-move-vop move-sap-arg :move-arg (descriptor-reg sap-reg) (sap-reg)) - -;;; Use standard MOVE-ARGUMENT + coercion to move an untagged sap to a +;;; Use standard MOVE-ARG + coercion to move an untagged sap to a ;;; descriptor passing location. -;;; -(define-move-vop move-argument :move-argument +(define-move-vop move-arg :move-arg (sap-reg) (descriptor-reg)) - - ;;;; SAP-INT and INT-SAP @@ -116,15 +93,13 @@ (:policy :fast-safe) (:generator 1 (move int sap))) - - ;;;; POINTER+ and POINTER- (define-vop (pointer+) (:translate sap+) (:args (ptr :scs (sap-reg)) - (offset :scs (signed-reg immediate))) + (offset :scs (signed-reg immediate))) (:arg-types system-area-pointer signed-num) (:results (res :scs (sap-reg))) (:result-types system-area-pointer) @@ -139,14 +114,13 @@ (define-vop (pointer-) (:translate sap-) (:args (ptr1 :scs (sap-reg)) - (ptr2 :scs (sap-reg))) + (ptr2 :scs (sap-reg))) (:arg-types system-area-pointer system-area-pointer) (:policy :fast-safe) (:results (res :scs (signed-reg))) (:result-types signed-num) (:generator 1 (inst subq ptr1 ptr2 res))) - ;;;; mumble-SYSTEM-REF and mumble-SYSTEM-SET @@ -245,7 +219,10 @@ (:single '((inst lds result offset object))) (:double - '((inst ldt result (+ offset word-bytes) object)))))) + '((inst ldt + result + (+ offset n-word-bytes) + object)))))) (define-vop (,set-name) (:translate ,set-name) (:policy :fast-safe) @@ -362,13 +339,14 @@ signed-reg signed-num :quad t) (def-system-ref-and-set sap-ref-sap %set-sap-ref-sap sap-reg system-area-pointer :quad) + (def-system-ref-and-set sap-ref-lispobj %set-sap-ref-lispobj + descriptor-reg * :long) (def-system-ref-and-set sap-ref-single %set-sap-ref-single single-reg single-float :single) (def-system-ref-and-set sap-ref-double %set-sap-ref-double double-reg double-float :double)) - -;;; Noise to convert normal lisp data objects into SAPs. +;;; noise to convert normal Lisp data objects into SAPs (define-vop (vector-sap) (:translate vector-sap) @@ -378,5 +356,5 @@ (:result-types system-area-pointer) (:generator 2 (inst lda sap - (- (* vector-data-offset word-bytes) other-pointer-type) - vector))) + (- (* vector-data-offset n-word-bytes) other-pointer-lowtag) + vector)))