From 4c201bf6817c2de64d38a9e5d61a923a07c32865 Mon Sep 17 00:00:00 2001 From: Christophe Rhodes Date: Mon, 27 Oct 2003 22:16:58 +0000 Subject: [PATCH] 0.8.5.11: Modifications for which I could make a plausible case on the basis of being 64-bit SAP implementations for HPPA and MIPS ... testing? What's that? It compiles, ship it! --- src/compiler/hppa/sap.lisp | 46 +++++++++------------------ src/compiler/mips/sap.lisp | 75 +++++++++++++++++++++++++++++--------------- version.lisp-expr | 2 +- 3 files changed, 65 insertions(+), 58 deletions(-) diff --git a/src/compiler/hppa/sap.lisp b/src/compiler/hppa/sap.lisp index 48da088..09d21f0 100644 --- a/src/compiler/hppa/sap.lisp +++ b/src/compiler/hppa/sap.lisp @@ -1,10 +1,19 @@ -(in-package "SB!VM") +;;;; the MIPS 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: ;;; Move a tagged SAP to an untagged representation. -;;; (define-vop (move-to-sap) (:args (x :scs (descriptor-reg))) (:results (y :scs (sap-reg))) @@ -12,13 +21,11 @@ (:generator 1 (loadw 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) :to (:eval 1))) (:temporary (:scs (non-descriptor-reg)) ndescr) @@ -27,13 +34,11 @@ (:generator 20 (with-fixed-allocation (y ndescr sap-widetag sap-size) (storew x y sap-pointer-slot other-pointer-lowtag)))) -;;; + (define-move-vop move-from-sap :move (sap-reg) (descriptor-reg)) - ;;; Move untagged sap values. -;;; (define-vop (sap-move) (:args (x :target y :scs (sap-reg) @@ -44,13 +49,11 @@ (: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) (:args (x :target y :scs (sap-reg)) @@ -63,21 +66,16 @@ (move x y)) (sap-stack (storew x fp (tn-offset y)))))) -;;; + (define-move-vop move-sap-argument :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-arg (sap-reg) (descriptor-reg)) - - ;;;; SAP-INT and INT-SAP - (define-vop (sap-int) (:args (sap :scs (sap-reg) :target int)) (:arg-types system-area-pointer) @@ -97,11 +95,8 @@ (:policy :fast-safe) (:generator 1 (move int sap))) - - ;;;; POINTER+ and POINTER- - (define-vop (pointer+) (:translate sap+) (:args (ptr :scs (sap-reg) :target res) @@ -134,11 +129,8 @@ (:result-types signed-num) (:generator 1 (inst sub ptr1 ptr2 res))) - - ;;;; mumble-SYSTEM-REF and mumble-SYSTEM-SET - (macrolet ((def-system-ref-and-set (ref-name set-name sc type size &optional signed) (let ((ref-name-c (symbolicate ref-name "-C")) @@ -247,10 +239,8 @@ single-reg single-float :float) (def-system-ref-and-set sap-ref-double %set-sap-ref-double double-reg double-float :float)) - ;;; Noise to convert normal lisp data objects into SAPs. - (define-vop (vector-sap) (:translate vector-sap) (:policy :fast-safe) @@ -262,14 +252,9 @@ (- (* vector-data-offset n-word-bytes) other-pointer-lowtag) vector sap))) - ;;; Transforms for 64-bit SAP accessors. -;;; FIXME: So these are now commented out on the SPARC, PPC and HPPA -;;; backends. Did they ever serve a purpose? Could they in future? -- -;;; CSR, 2002-08-10 -#| (deftransform sap-ref-64 ((sap offset) (* *)) '(logior (ash (sap-ref-32 sap offset) 32) (sap-ref-32 sap (+ offset 4)))) @@ -287,4 +272,3 @@ '(progn (%set-signed-sap-ref-32 sap offset (ash value -32)) (%set-sap-ref-32 sap (+ 4 offset) (logand value #xffffffff)))) -|# diff --git a/src/compiler/mips/sap.lisp b/src/compiler/mips/sap.lisp index c8df069..fcd879a 100644 --- a/src/compiler/mips/sap.lisp +++ b/src/compiler/mips/sap.lisp @@ -1,10 +1,19 @@ -(in-package "SB!VM") +;;;; the MIPS 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: ;;; Move a tagged SAP to an untagged representation. -;;; (define-vop (move-to-sap) (:args (x :scs (descriptor-reg))) (:results (y :scs (sap-reg))) @@ -12,13 +21,10 @@ (:generator 1 (loadw 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) @@ -30,13 +36,11 @@ (move sap x) (with-fixed-allocation (y pa-flag ndescr sap-widetag sap-size) (storew sap y sap-pointer-slot other-pointer-lowtag)))) -;;; + (define-move-vop move-from-sap :move (sap-reg) (descriptor-reg)) - ;;; Move untagged sap values. -;;; (define-vop (sap-move) (:args (x :target y :scs (sap-reg) @@ -47,13 +51,11 @@ (:affected) (:generator 0 (move y x))) -;;; + (define-move-vop sap-move :move (sap-reg) (sap-reg)) - ;;; Move untagged sap arguments/return-values. -;;; (define-vop (move-sap-arg) (:args (x :target y :scs (sap-reg)) @@ -66,21 +68,16 @@ (move y x)) (sap-stack (storew x fp (tn-offset y)))))) -;;; + (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-arg :move-arg (sap-reg) (descriptor-reg)) - - ;;;; SAP-INT and INT-SAP - (define-vop (sap-int) (:args (sap :scs (sap-reg) :target int)) (:arg-types system-area-pointer) @@ -100,11 +97,8 @@ (:policy :fast-safe) (:generator 1 (move sap int))) - - ;;;; POINTER+ and POINTER- - (define-vop (pointer+) (:translate sap+) (:args (ptr :scs (sap-reg)) @@ -130,11 +124,8 @@ (:result-types signed-num) (:generator 1 (inst subu res ptr1 ptr2))) - - ;;;; mumble-SYSTEM-REF and mumble-SYSTEM-SET - (macrolet ((def-system-ref-and-set (ref-name set-name sc type size &optional signed) (let ((ref-name-c (symbolicate ref-name "-C")) @@ -307,10 +298,8 @@ 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. - (define-vop (vector-sap) (:translate vector-sap) (:policy :fast-safe) @@ -320,4 +309,38 @@ (:generator 2 (inst addu sap vector (- (* vector-data-offset n-word-bytes) other-pointer-lowtag)))) + +;;; Transforms for 64-bit SAP accessors. +#!+little-endian +(progn + (deftransform sap-ref-64 ((sap offset) (* *)) + '(logior (sap-ref-32 sap offset) + (ash (sap-ref-32 sap (+ offset 4)) 32))) + (deftransform signed-sap-ref-64 ((sap offset) (* *)) + '(logior (sap-ref-32 sap offset) + (ash (signed-sap-ref-32 sap (+ offset 4)) 32))) + (deftransform %set-sap-ref-64 ((sap offset value) (* * *)) + '(progn + (%set-sap-ref-32 sap offset (logand value #xffffffff)) + (%set-sap-ref-32 sap (+ offset 4) (ash value -32)))) + (deftransform %set-signed-sap-ref-64 ((sap offset value) (* * *)) + '(progn + (%set-sap-ref-32 sap offset (logand value #xffffffff)) + (%set-signed-sap-ref-32 sap (+ offset 4) (ash value -32))))) +#!-little-endian +(progn + (deftransform sap-ref-64 ((sap offset) (* *)) + '(logior (ash (sap-ref-32 sap offset) 32) + (sap-ref-32 sap (+ offset 4)))) + (deftransform signed-sap-ref-64 ((sap offset) (* *)) + '(logior (ash (signed-sap-ref-32 sap offset) 32) + (sap-ref-32 sap (+ 4 offset)))) + (deftransform %set-sap-ref-64 ((sap offset value) (* * *)) + '(progn + (%set-sap-ref-32 sap offset (ash value -32)) + (%set-sap-ref-32 sap (+ offset 4) (logand value #xffffffff)))) + (deftransform %set-signed-sap-ref-64 ((sap offset value) (* * *)) + '(progn + (%set-signed-sap-ref-32 sap offset (ash value -32)) + (%set-sap-ref-32 sap (+ 4 offset) (logand value #xffffffff))))) diff --git a/version.lisp-expr b/version.lisp-expr index 8f58115..a0b0e5d 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"0.8.5.10" +"0.8.5.11" -- 1.7.10.4