From: Alastair Bridgewater Date: Tue, 22 Nov 2011 18:40:21 +0000 (-0500) Subject: Add SB-SYS:SAP-REF-LISPOBJ. X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=179812c3ad5dad69239c625ec929a7d486cf568f;p=sbcl.git Add SB-SYS:SAP-REF-LISPOBJ. * This is for those cases where you know that you are trying to read valid boxed data, the address of the data you want to read is in some sense "stable" (meaning, won't be moved by the GC), and you don't want to deal with the requirements for calling SB-KERNEL:MAKE-LISP-OBJ. * Implemented across the board, but only tested on PPC. What could possibly go wrong? --- diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 54430d7..be9c9ff 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -1383,7 +1383,7 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "%SET-VECTOR-RAW-BITS" "%SET-SAP-REF-16" "%SET-SAP-REF-32" "%SET-SAP-REF-64" "%SET-SAP-REF-WORD" "%SET-SAP-REF-8" "%SET-SAP-REF-DOUBLE" - "%SET-SAP-REF-LONG" "%SET-SAP-REF-SAP" + "%SET-SAP-REF-LISPOBJ" "%SET-SAP-REF-LONG" "%SET-SAP-REF-SAP" "%SET-SAP-REF-SINGLE" "%SET-SIGNED-SAP-REF-16" "%SET-SIGNED-SAP-REF-32" "%SET-SIGNED-SAP-REF-64" "%SET-SIGNED-SAP-REF-WORD" @@ -2367,7 +2367,7 @@ SB-KERNEL) have been undone, but probably more remain." "SAP-INT" "SAP-REF-16" "SAP-REF-32" "SAP-REF-64" "SAP-REF-WORD" "SAP-REF-8" - "SAP-REF-DOUBLE" "SAP-REF-LONG" + "SAP-REF-DOUBLE" "SAP-REF-LISPOBJ" "SAP-REF-LONG" "SAP-REF-SAP" "SAP-REF-SINGLE" "SAP<" "SAP<=" "SAP=" "SAP>" "SAP>=" "SCRUB-CONTROL-STACK" "SERVE-ALL-EVENTS" diff --git a/src/code/defsetfs.lisp b/src/code/defsetfs.lisp index 9ec31bc..26ed7f2 100644 --- a/src/code/defsetfs.lisp +++ b/src/code/defsetfs.lisp @@ -122,6 +122,7 @@ (defsetf sap-ref-word %set-sap-ref-word) (defsetf signed-sap-ref-word %set-signed-sap-ref-word) (defsetf sap-ref-sap %set-sap-ref-sap) +(defsetf sap-ref-lispobj %set-sap-ref-lispobj) (defsetf sap-ref-single %set-sap-ref-single) (defsetf sap-ref-double %set-sap-ref-double) #!+long-float (defsetf sap-ref-long %set-sap-ref-long) diff --git a/src/code/target-sap.lisp b/src/code/target-sap.lisp index ae48346..edb3a16 100644 --- a/src/code/target-sap.lisp +++ b/src/code/target-sap.lisp @@ -95,6 +95,12 @@ (fixnum offset)) (sap-ref-sap sap offset)) +;; Return the LISPOBJ at OFFSET bytes from SAP. +(defun sap-ref-lispobj (sap offset) + (declare (type system-area-pointer sap) + (fixnum offset)) + (sap-ref-lispobj sap offset)) + ;;; Return the 32-bit SINGLE-FLOAT at OFFSET bytes from SAP. (defun sap-ref-single (sap offset) (declare (type system-area-pointer sap) @@ -209,6 +215,12 @@ (fixnum offset)) (setf (sap-ref-sap sap offset) new-value)) +(defun %set-sap-ref-lispobj (sap offset new-value) + (declare (type system-area-pointer sap) + (fixnum offset) + (t new-value)) + (setf (sap-ref-lispobj sap offset) new-value)) + (defun %set-sap-ref-single (sap offset new-value) (declare (type system-area-pointer sap) (fixnum offset) diff --git a/src/compiler/alpha/sap.lisp b/src/compiler/alpha/sap.lisp index 6fa3a7d..a46db40 100644 --- a/src/compiler/alpha/sap.lisp +++ b/src/compiler/alpha/sap.lisp @@ -339,6 +339,8 @@ 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 diff --git a/src/compiler/hppa/sap.lisp b/src/compiler/hppa/sap.lisp index a99dac4..b234b39 100644 --- a/src/compiler/hppa/sap.lisp +++ b/src/compiler/hppa/sap.lisp @@ -235,6 +235,8 @@ signed-reg signed-num :long t) (def-system-ref-and-set sap-ref-sap %set-sap-ref-sap sap-reg system-area-pointer :long) + (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 :float) (def-system-ref-and-set sap-ref-double %set-sap-ref-double diff --git a/src/compiler/mips/sap.lisp b/src/compiler/mips/sap.lisp index cdc5453..c6f37a2 100644 --- a/src/compiler/mips/sap.lisp +++ b/src/compiler/mips/sap.lisp @@ -301,6 +301,8 @@ signed-reg signed-num :long t) (def-system-ref-and-set sap-ref-sap %set-sap-ref-sap sap-reg system-area-pointer :long) + (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 diff --git a/src/compiler/ppc/sap.lisp b/src/compiler/ppc/sap.lisp index 3118559..f9e6504 100644 --- a/src/compiler/ppc/sap.lisp +++ b/src/compiler/ppc/sap.lisp @@ -241,6 +241,8 @@ signed-reg signed-num :long t) (def-system-ref-and-set sap-ref-sap %set-sap-ref-sap sap-reg system-area-pointer :long) + (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 diff --git a/src/compiler/saptran.lisp b/src/compiler/saptran.lisp index 19945d2..2e6b508 100644 --- a/src/compiler/saptran.lisp +++ b/src/compiler/saptran.lisp @@ -80,6 +80,7 @@ (defsapref signed-sap-ref-64 (signed-byte 64)) (defsapref signed-sap-ref-word (signed-byte #.sb!vm:n-word-bits)) (defsapref sap-ref-sap system-area-pointer) + (defsapref sap-ref-lispobj t) (defsapref sap-ref-single single-float) (defsapref sap-ref-double double-float) (defsapref sap-ref-long long-float) @@ -158,6 +159,8 @@ (def %set-signed-sap-ref-64 t (signed-byte 64)) (def sap-ref-sap) (def %set-sap-ref-sap t system-area-pointer) + (def sap-ref-lispobj) + (def %set-sap-ref-lispobj t t) (def sap-ref-single) (def %set-sap-ref-single t single-float) (def sap-ref-double) diff --git a/src/compiler/sparc/sap.lisp b/src/compiler/sparc/sap.lisp index b57ff7a..4b1df19 100644 --- a/src/compiler/sparc/sap.lisp +++ b/src/compiler/sparc/sap.lisp @@ -252,6 +252,8 @@ signed-reg signed-num :long t) (def-system-ref-and-set sap-ref-sap %set-sap-ref-sap sap-reg system-area-pointer :long) + (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 diff --git a/src/compiler/x86-64/sap.lisp b/src/compiler/x86-64/sap.lisp index b255b07..e086659 100644 --- a/src/compiler/x86-64/sap.lisp +++ b/src/compiler/x86-64/sap.lisp @@ -233,7 +233,9 @@ (def-system-ref-and-set signed-sap-ref-64 %set-signed-sap-ref-64 mov signed-reg signed-num :qword) (def-system-ref-and-set sap-ref-sap %set-sap-ref-sap mov - sap-reg system-area-pointer :qword)) + sap-reg system-area-pointer :qword) + (def-system-ref-and-set sap-ref-lispobj %set-sap-ref-lispobj mov + descriptor-reg * :qword)) ;;;; SAP-REF-DOUBLE diff --git a/src/compiler/x86/sap.lisp b/src/compiler/x86/sap.lisp index 50daa83..4ff8c12 100644 --- a/src/compiler/x86/sap.lisp +++ b/src/compiler/x86/sap.lisp @@ -225,7 +225,9 @@ (def-system-ref-and-set sb!c::signed-sap-ref-32-with-offset sb!c::%set-signed-sap-ref-32-with-offset signed-reg signed-num :dword t) (def-system-ref-and-set sb!c::sap-ref-sap-with-offset sb!c::%set-sap-ref-sap-with-offset - sap-reg system-area-pointer :dword)) + sap-reg system-area-pointer :dword) + (def-system-ref-and-set sb!c::sap-ref-lispobj-with-offset sb!c::%set-sap-ref-lispobj-with-offset + descriptor-reg * :dword)) ;;;; SAP-REF-DOUBLE