From: David L. <dav...@li...> - 2005-05-18 21:01:22
|
Hi, as discussed on #lisp, structure objects currently store "raw" slots in an extra vector, wasting between two and four words for each such instance. To reduce this memory overhead, I have reworked raw slots to be stored directly in the main instance, referenced from the end of the instance. LAYOUTs for structure classes record the number of raw slots, so that garbage collection can determine how many slots to skip. The current version of the patch is at http://www.lichteblau.com/raw.diff Unfortunately, the patch is not complete. For raw slots to be usable on a given architecture, new VOPs need to be written. Since I neither have access to Linux/MIPS nor Linux/HPPA, these two are missing. (An attempt at the MIPS port is at http://www.lichteblau.com/mips.lisp, but it is completely untested.) However, working x86, x86-64, ppc, sparc, and alpha VOPs are included in the patch, and writing mips/hppa ones should be nearly a matter of copy&paste starting with the versions from a similar RISC architecture already covered. Note that SBCL makes nearly no use of raw slots itself, so these changes will only affect user code, not SBCL's own performance. On the way, the patch attempts to solve a number of KLUDGEs: - The raw slots for SB-VM:WORD were labelled UNSIGNED-BYTE (with an old comment suggesting them to be 32 bit, but they are really 64 bit). With this fixed, there is no need for a reduntant CASE form selecting the right raw data kind manually anymore. - The old code required raw data to be aligned on a multiple of its size, aligning (complex double-float) on a 16 byte boundary instead of 4 bytes (or 8 bytes if the hardware needs that). - Since HASH-TABLE is one of the few structures with a raw slot in SBCL, its layout changes. Unfortunately GC knows about HASH-TABLES's layout, so the patch changes genesis to emit C `struct' definitions for structure classes as needed to avoid having to renumber the hash table slot manually. Alignment is still on multiples of words with this patch, so that two SINGLE-FLOATs still cannot be packed into one word on 64 bit architectures. As explained in the patch, I would be more interested in such packing if it also helped with (UNSIGNED-BYTE 32) in addition to SINGLE-FLOAT, but (UNSIGNED-BYTE 32) is a subtype of FIXNUM on 64 bit architectures, and is therefore stored unraw. So that is not possible anyway. Finally, some ASCII art: Old instance for n tagged user slots (not counting layout and raw data) and m words for raw slots: +-------------------------------+ | n+2 | INSTANCE_HEADER_WIDETAG | +-------------------------------+ | o---->[layout] +-------------------------------+ | o----> +-------------------------------+ +-------------------------------+ | vector header | | descriptor slot 2 | +-------------------------------+ +-------------------------------+ | length | | ... | +-------------------------------+ +-------------------------------+ | raw slot 0 | | descriptor slot (n+1) | +-------------------------------+ +-------------------------------+ | ... | [ if needed: one word padding ] +-------------------------------+ +-------------------------------+ | raw slot (m-1) | +-------------------------------+ [ if needed: one word padding ] +-------------------------------+ New instance: +-------------------------------+ |n+m+1| INSTANCE_HEADER_WIDETAG | +-------------------------------+ | o---->[layout] +-------------------------------+ | descriptor slot 1 | +-------------------------------+ | ... | +-------------------------------+ | descriptor slot n | +-------------------------------+ [ if needed: one word padding ] +-------------------------------+ | raw slot (m-1) | +-------------------------------+ | ... | +-------------------------------+ | raw slot 0 | +-------------------------------+ Theoretical note: One could go even further and store raw slots not at the end of the instance, but in front of header, so that the header (or more precisely, the location pointed to by references to the object) is not actually at the beginning of the object. Aside from making the raw slot VOPs a little simpler, this would make the explicit length field in the header unnecessary, saving an additional 24 bits for some other purpose. However, I am not going to try this experiment... ;) d. |
From: Thiemo S. <th...@ne...> - 2005-05-31 20:57:15
|
David Lichteblau wrote: [snip] > The current version of the patch is at http://www.lichteblau.com/raw.diff > > Unfortunately, the patch is not complete. For raw slots to be usable on > a given architecture, new VOPs need to be written. Since I neither have > access to Linux/MIPS nor Linux/HPPA, these two are missing. (An attempt > at the MIPS port is at http://www.lichteblau.com/mips.lisp, but it is > completely untested.) I derived a mips version from it which at least succeeds for the included test cases as well as for a sbcl rebuild. The patch for compiler/mips/cell.lisp is available from http://people.debian.org/~ths/sbcl/patches/raw-slots-mips-vops.diff The full interdiff of my changes is appended for reference. Thiemo diff -u src/code/defstruct.lisp src/code/defstruct.lisp --- src/code/defstruct.lisp 17 May 2005 18:35:36 -0000 +++ src/code/defstruct.lisp 31 May 2005 20:24:45 -0000 @@ -235,13 +235,13 @@ (alignment 1 :type (integer 1 2) :read-only t)) (defvar *raw-slot-data-list* - #!+(or hppa mips) + #!+hppa nil - #!-(or hppa mips) + #!-hppa (let ((double-float-alignment ;; white list of architectures that can load unaligned doubles: #!+(or x86 x86-64 ppc) 1 - ;; at least sparc and alpha can't: + ;; at least alpha, mips, and sparc can't: #!-(or x86 x86-64 ppc) 2)) (list (make-raw-slot-data :raw-type 'sb!vm:word diff -u src/code/target-defstruct.lisp src/code/target-defstruct.lisp --- src/code/target-defstruct.lisp 17 May 2005 18:35:36 -0000 +++ src/code/target-defstruct.lisp 31 May 2005 20:24:45 -0000 @@ -31,7 +31,7 @@ (defun %instance-set (instance index new-value) (setf (%instance-ref instance index) new-value)) -#!-(or hppa mips) +#!-hppa (progn (defun %raw-instance-ref/word (instance index) (declare (type index index)) unchanged: --- src/compiler/mips/cell.lisp 21 May 2004 12:17:49 -0000 1.2 +++ src/compiler/mips/cell.lisp 31 May 2005 20:24:47 -0000 @@ -292,4 +292,266 @@ (descriptor-reg any-reg null zero) * code-header-set) + +;;;; raw instance slot accessors +(define-vop (raw-instance-ref/word) + (:translate %raw-instance-ref/word) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg))) + (:arg-types * positive-fixnum) + (:results (value :scs (unsigned-reg))) + (:temporary (:scs (non-descriptor-reg)) tmp) + (:result-types unsigned-num) + (:generator 5 + (loadw tmp object 0 instance-pointer-lowtag) + (inst srl tmp n-widetag-bits) + (inst sll tmp 2) + (inst subu tmp index) + (inst addu tmp (- (* (1- instance-slots-offset) n-word-bytes) + instance-pointer-lowtag)) + (inst addu tmp object) + (inst lw value tmp))) + +(define-vop (raw-instance-set/word) + (:translate %raw-instance-set/word) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg)) + (value :scs (unsigned-reg) :target result)) + (:arg-types * positive-fixnum unsigned-num) + (:results (result :scs (unsigned-reg))) + (:temporary (:scs (non-descriptor-reg)) tmp) + (:result-types unsigned-num) + (:generator 5 + (loadw tmp object 0 instance-pointer-lowtag) + (inst srl tmp n-widetag-bits) + (inst sll tmp 2) + (inst subu tmp index) + (inst addu tmp (- (* (1- instance-slots-offset) n-word-bytes) + instance-pointer-lowtag)) + (inst addu tmp object) + (inst sw value tmp) + (unless (location= result value) + (move result value)))) + +(define-vop (raw-instance-ref/single) + (:translate %raw-instance-ref/single) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg))) + (:arg-types * positive-fixnum) + (:results (value :scs (single-reg))) + (:temporary (:scs (non-descriptor-reg)) tmp) + (:result-types single-float) + (:generator 5 + (loadw tmp object 0 instance-pointer-lowtag) + (inst srl tmp n-widetag-bits) + (inst sll tmp 2) + (inst subu tmp index) + (inst addu tmp (- (* (1- instance-slots-offset) n-word-bytes) + instance-pointer-lowtag)) + (inst addu tmp object) + (inst lwc1 value tmp))) + +(define-vop (raw-instance-set/single) + (:translate %raw-instance-set/single) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg)) + (value :scs (single-reg) :target result)) + (:arg-types * positive-fixnum single-float) + (:results (result :scs (single-reg))) + (:temporary (:scs (non-descriptor-reg)) tmp) + (:result-types single-float) + (:generator 5 + (loadw tmp object 0 instance-pointer-lowtag) + (inst srl tmp n-widetag-bits) + (inst sll tmp 2) + (inst subu tmp index) + (inst addu tmp (- (* (1- instance-slots-offset) n-word-bytes) + instance-pointer-lowtag)) + (inst addu tmp object) + (inst swc1 value tmp) + (unless (location= result value) + (inst fmove :single result value)))) + +(define-vop (raw-instance-ref/double) + (:translate %raw-instance-ref/double) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg))) + (:arg-types * positive-fixnum) + (:results (value :scs (double-reg))) + (:temporary (:scs (non-descriptor-reg)) tmp) + (:result-types double-float) + (:generator 5 + (loadw tmp object 0 instance-pointer-lowtag) + (inst srl tmp n-widetag-bits) + (inst sll tmp 2) + (inst subu tmp index) + (inst addu tmp (- (* (- instance-slots-offset 2) n-word-bytes) + instance-pointer-lowtag)) + (inst addu tmp object) + (ecase *backend-byte-order* + (:big-endian (inst lwc1 value tmp)) + (:little-endian (inst lwc1-odd value tmp))) + (inst addu tmp n-word-bytes) + (ecase *backend-byte-order* + (:big-endian (inst lwc1-odd value tmp)) + (:little-endian (inst lwc1 value tmp))))) + +(define-vop (raw-instance-set/double) + (:translate %raw-instance-set/double) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg)) + (value :scs (double-reg) :target result)) + (:arg-types * positive-fixnum double-float) + (:results (result :scs (double-reg))) + (:temporary (:scs (non-descriptor-reg)) tmp) + (:result-types double-float) + (:generator 5 + (loadw tmp object 0 instance-pointer-lowtag) + (inst srl tmp n-widetag-bits) + (inst sll tmp 2) + (inst subu tmp index) + (inst addu tmp (- (* (- instance-slots-offset 2) n-word-bytes) + instance-pointer-lowtag)) + (inst addu tmp object) + (ecase *backend-byte-order* + (:big-endian (inst swc1 value tmp)) + (:little-endian (inst swc1-odd value tmp))) + (inst addu tmp n-word-bytes) + (ecase *backend-byte-order* + (:big-endian (inst swc1-odd value tmp)) + (:little-endian (inst swc1 value tmp))) + (unless (location= result value) + (inst fmove :double result value)))) + +(define-vop (raw-instance-ref/complex-single) + (:translate %raw-instance-ref/complex-single) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg))) + (:arg-types * positive-fixnum) + (:results (value :scs (complex-single-reg))) + (:temporary (:scs (non-descriptor-reg)) tmp) + (:result-types complex-single-float) + (:generator 5 + (loadw tmp object 0 instance-pointer-lowtag) + (inst srl tmp n-widetag-bits) + (inst sll tmp 2) + (inst subu tmp index) + (inst addu tmp (- (* (- instance-slots-offset 2) n-word-bytes) + instance-pointer-lowtag)) + (inst addu tmp object) + (inst lwc1 (complex-single-reg-real-tn value) tmp) + (inst addu tmp n-word-bytes) + (inst lwc1 (complex-single-reg-imag-tn value) tmp))) + +(define-vop (raw-instance-set/complex-single) + (:translate %raw-instance-set/complex-single) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg)) + (value :scs (complex-single-reg) :target result)) + (:arg-types * positive-fixnum complex-single-float) + (:results (result :scs (complex-single-reg))) + (:temporary (:scs (non-descriptor-reg)) tmp) + (:result-types complex-single-float) + (:generator 5 + (loadw tmp object 0 instance-pointer-lowtag) + (inst srl tmp n-widetag-bits) + (inst sll tmp 2) + (inst subu tmp index) + (inst addu tmp (- (* (- instance-slots-offset 2) n-word-bytes) + instance-pointer-lowtag)) + (inst addu tmp object) + (let ((value-real (complex-single-reg-real-tn value)) + (result-real (complex-single-reg-real-tn result))) + (inst swc1 value-real tmp) + (unless (location= result-real value-real) + (inst fmove :single result-real value-real))) + (inst addu tmp n-word-bytes) + (let ((value-imag (complex-single-reg-imag-tn value)) + (result-imag (complex-single-reg-imag-tn result))) + (inst swc1 value-imag tmp) + (unless (location= result-imag value-imag) + (inst fmove :single result-imag value-imag))))) + +(define-vop (raw-instance-ref/complex-double) + (:translate %raw-instance-ref/complex-double) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg))) + (:arg-types * positive-fixnum) + (:results (value :scs (complex-double-reg))) + (:temporary (:scs (non-descriptor-reg)) tmp) + (:result-types complex-double-float) + (:generator 5 + (loadw tmp object 0 instance-pointer-lowtag) + (inst srl tmp n-widetag-bits) + (inst sll tmp 2) + (inst subu tmp index) + (inst addu tmp (- (* (- instance-slots-offset 4) n-word-bytes) + instance-pointer-lowtag)) + (inst addu tmp object) + (ecase *backend-byte-order* + (:big-endian (inst lwc1 (complex-double-reg-real-tn value) tmp)) + (:little-endian (inst lwc1-odd (complex-double-reg-real-tn value) tmp))) + (inst addu tmp n-word-bytes) + (ecase *backend-byte-order* + (:big-endian (inst lwc1-odd (complex-double-reg-real-tn value) tmp)) + (:little-endian (inst lwc1 (complex-double-reg-real-tn value) tmp))) + (inst addu tmp n-word-bytes) + (ecase *backend-byte-order* + (:big-endian (inst lwc1 (complex-double-reg-imag-tn value) tmp)) + (:little-endian (inst lwc1-odd (complex-double-reg-imag-tn value) tmp))) + (inst addu tmp n-word-bytes) + (ecase *backend-byte-order* + (:big-endian (inst lwc1-odd (complex-double-reg-imag-tn value) tmp)) + (:little-endian (inst lwc1 (complex-double-reg-imag-tn value) tmp))))) + +(define-vop (raw-instance-set/complex-double) + (:translate %raw-instance-set/complex-double) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg)) + (value :scs (complex-double-reg) :target result)) + (:arg-types * positive-fixnum complex-double-float) + (:results (result :scs (complex-double-reg))) + (:temporary (:scs (non-descriptor-reg)) tmp) + (:result-types complex-double-float) + (:generator 5 + (loadw tmp object 0 instance-pointer-lowtag) + (inst srl tmp n-widetag-bits) + (inst sll tmp 2) + (inst subu tmp index) + (inst addu tmp (- (* (- instance-slots-offset 4) n-word-bytes) + instance-pointer-lowtag)) + (inst addu tmp object) + (let ((value-real (complex-double-reg-real-tn value)) + (result-real (complex-double-reg-real-tn result))) + (ecase *backend-byte-order* + (:big-endian (inst swc1 value-real tmp)) + (:little-endian (inst swc1-odd value-real tmp))) + (inst addu tmp n-word-bytes) + (ecase *backend-byte-order* + (:big-endian (inst swc1-odd value-real tmp)) + (:little-endian (inst swc1 value-real tmp))) + (unless (location= result-real value-real) + (inst fmove :double result-real value-real))) + (let ((value-imag (complex-double-reg-imag-tn value)) + (result-imag (complex-double-reg-imag-tn result))) + (inst addu tmp n-word-bytes) + (ecase *backend-byte-order* + (:big-endian (inst swc1 value-imag tmp)) + (:little-endian (inst swc1-odd value-imag tmp))) + (inst addu tmp n-word-bytes) + (ecase *backend-byte-order* + (:big-endian (inst swc1-odd value-imag tmp)) + (:little-endian (inst swc1 value-imag tmp))) + (unless (location= result-imag value-imag) + (inst fmove :double result-imag value-imag))))) |
From: Thiemo S. <th...@ne...> - 2005-06-01 01:27:10
|
Thiemo Seufer wrote: > David Lichteblau wrote: > [snip] > > The current version of the patch is at http://www.lichteblau.com/raw.diff > > > > Unfortunately, the patch is not complete. For raw slots to be usable on > > a given architecture, new VOPs need to be written. Since I neither have > > access to Linux/MIPS nor Linux/HPPA, these two are missing. (An attempt > > at the MIPS port is at http://www.lichteblau.com/mips.lisp, but it is > > completely untested.) > > I derived a mips version from it which at least succeeds for the included > test cases as well as for a sbcl rebuild. The patch for > compiler/mips/cell.lisp is available from > http://people.debian.org/~ths/sbcl/patches/raw-slots-mips-vops.diff > > The full interdiff of my changes is appended for reference. Which turned out to introduce some bugs in connection with GC. Appended is the updated (backdated?) version. Besides some trivial formatting differences, it differs in a few things from David's original: - It generally tries to reuse the setter's value as result register, even for words. - double layout follows the C ABI conventions, being endian dependent and naturally aligned. - There was a lwc1/lwc1-odd typo in the complex number support. - The code is much uglier now, with all the endianness tests. :-) Thiemo Index: src/compiler/mips/cell.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/compiler/mips/cell.lisp,v retrieving revision 1.2 diff -u -p -r1.2 cell.lisp --- src/compiler/mips/cell.lisp 21 May 2004 12:17:49 -0000 1.2 +++ src/compiler/mips/cell.lisp 1 Jun 2005 00:47:27 -0000 @@ -292,4 +292,348 @@ (descriptor-reg any-reg null zero) * code-header-set) + +;;;; raw instance slot accessors +(define-vop (raw-instance-ref/word) + (:translate %raw-instance-ref/word) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg))) + (:arg-types * positive-fixnum) + (:results (value :scs (unsigned-reg))) + (:temporary (:scs (non-descriptor-reg)) offset) + (:temporary (:scs (interior-reg)) lip) + (:result-types unsigned-num) + (:generator 5 + (loadw offset object 0 instance-pointer-lowtag) + (inst srl offset n-widetag-bits) + (inst sll offset 2) + (inst subu offset index) + (inst subu offset n-word-bytes) + (inst addu lip offset object) + (inst lw value lip (- (* instance-slots-offset n-word-bytes) + instance-pointer-lowtag)))) + +(define-vop (raw-instance-set/word) + (:translate %raw-instance-set/word) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg)) + (value :scs (unsigned-reg) :target result)) + (:arg-types * positive-fixnum unsigned-num) + (:results (result :scs (unsigned-reg))) + (:temporary (:scs (non-descriptor-reg)) offset) + (:temporary (:scs (interior-reg)) lip) + (:result-types unsigned-num) + (:generator 5 + (loadw offset object 0 instance-pointer-lowtag) + (inst srl offset n-widetag-bits) + (inst sll offset 2) + (inst subu offset index) + (inst subu offset n-word-bytes) + (inst addu lip offset object) + (inst sw value lip (- (* instance-slots-offset n-word-bytes) + instance-pointer-lowtag)) + (unless (location= result value) + (move result value)))) + +(define-vop (raw-instance-ref/single) + (:translate %raw-instance-ref/single) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg))) + (:arg-types * positive-fixnum) + (:results (value :scs (single-reg))) + (:temporary (:scs (non-descriptor-reg)) offset) + (:temporary (:scs (interior-reg)) lip) + (:result-types single-float) + (:generator 5 + (loadw offset object 0 instance-pointer-lowtag) + (inst srl offset n-widetag-bits) + (inst sll offset 2) + (inst subu offset index) + (inst subu offset n-word-bytes) + (inst addu lip offset object) + (inst lwc1 value lip (- (* instance-slots-offset n-word-bytes) + instance-pointer-lowtag)))) + +(define-vop (raw-instance-set/single) + (:translate %raw-instance-set/single) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg)) + (value :scs (single-reg) :target result)) + (:arg-types * positive-fixnum single-float) + (:results (result :scs (single-reg))) + (:temporary (:scs (non-descriptor-reg)) offset) + (:temporary (:scs (interior-reg)) lip) + (:result-types single-float) + (:generator 5 + (loadw offset object 0 instance-pointer-lowtag) + (inst srl offset n-widetag-bits) + (inst sll offset 2) + (inst subu offset index) + (inst subu offset n-word-bytes) + (inst addu lip offset object) + (inst swc1 value lip (- (* instance-slots-offset n-word-bytes) + instance-pointer-lowtag)) + (unless (location= result value) + (inst fmove :single result value)))) + +(define-vop (raw-instance-ref/double) + (:translate %raw-instance-ref/double) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg))) + (:arg-types * positive-fixnum) + (:results (value :scs (double-reg))) + (:temporary (:scs (non-descriptor-reg)) offset) + (:temporary (:scs (interior-reg)) lip) + (:result-types double-float) + (:generator 5 + (loadw offset object 0 instance-pointer-lowtag) + (inst srl offset n-widetag-bits) + (inst sll offset 2) + (inst subu offset index) + (inst subu offset (* 2 n-word-bytes)) + (inst addu lip offset object) + (let ((immediate-offset (- (* instance-slots-offset n-word-bytes) + instance-pointer-lowtag))) + (ecase *backend-byte-order* + (:big-endian (inst lwc1 value lip immediate-offset)) + (:little-endian (inst lwc1-odd value lip immediate-offset)))) + (let ((immediate-offset (- (* (1+ instance-slots-offset) n-word-bytes) + instance-pointer-lowtag))) + (ecase *backend-byte-order* + (:big-endian (inst lwc1-odd value lip immediate-offset)) + (:little-endian (inst lwc1 value lip immediate-offset)))))) + +(define-vop (raw-instance-set/double) + (:translate %raw-instance-set/double) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg)) + (value :scs (double-reg) :target result)) + (:arg-types * positive-fixnum double-float) + (:results (result :scs (double-reg))) + (:temporary (:scs (non-descriptor-reg)) offset) + (:temporary (:scs (interior-reg)) lip) + (:result-types double-float) + (:generator 5 + (loadw offset object 0 instance-pointer-lowtag) + (inst srl offset n-widetag-bits) + (inst sll offset 2) + (inst subu offset index) + (inst subu offset (* 2 n-word-bytes)) + (inst addu lip offset object) + (let ((immediate-offset (- (* instance-slots-offset n-word-bytes) + instance-pointer-lowtag))) + (ecase *backend-byte-order* + (:big-endian (inst swc1 value lip immediate-offset)) + (:little-endian (inst swc1-odd value lip immediate-offset)))) + (let ((immediate-offset (- (* (1+ instance-slots-offset) n-word-bytes) + instance-pointer-lowtag))) + (ecase *backend-byte-order* + (:big-endian (inst swc1-odd value lip immediate-offset)) + (:little-endian (inst swc1 value lip immediate-offset)))) + (unless (location= result value) + (inst fmove :double result value)))) + +(define-vop (raw-instance-ref/complex-single) + (:translate %raw-instance-ref/complex-single) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg))) + (:arg-types * positive-fixnum) + (:results (value :scs (complex-single-reg))) + (:temporary (:scs (non-descriptor-reg)) offset) + (:temporary (:scs (interior-reg)) lip) + (:result-types complex-single-float) + (:generator 5 + (loadw offset object 0 instance-pointer-lowtag) + (inst srl offset n-widetag-bits) + (inst sll offset 2) + (inst subu offset index) + (inst subu offset (* 2 n-word-bytes)) + (inst addu lip offset object) + (inst lwc1 + (complex-single-reg-real-tn value) + lip + (- (* instance-slots-offset n-word-bytes) + instance-pointer-lowtag)) + (inst lwc1 + (complex-single-reg-imag-tn value) + lip + (- (* (1+ instance-slots-offset) n-word-bytes) + instance-pointer-lowtag)))) + +(define-vop (raw-instance-set/complex-single) + (:translate %raw-instance-set/complex-single) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg)) + (value :scs (complex-single-reg) :target result)) + (:arg-types * positive-fixnum complex-single-float) + (:results (result :scs (complex-single-reg))) + (:temporary (:scs (non-descriptor-reg)) offset) + (:temporary (:scs (interior-reg)) lip) + (:result-types complex-single-float) + (:generator 5 + (loadw offset object 0 instance-pointer-lowtag) + (inst srl offset n-widetag-bits) + (inst sll offset 2) + (inst subu offset index) + (inst subu offset (* 2 n-word-bytes)) + (inst addu lip offset object) + (let ((value-real (complex-single-reg-real-tn value)) + (result-real (complex-single-reg-real-tn result))) + (inst swc1 + value-real + lip + (- (* instance-slots-offset n-word-bytes) + instance-pointer-lowtag)) + (unless (location= result-real value-real) + (inst fmove :single result-real value-real))) + (let ((value-imag (complex-single-reg-imag-tn value)) + (result-imag (complex-single-reg-imag-tn result))) + (inst swc1 + value-imag + lip + (- (* (1+ instance-slots-offset) n-word-bytes) + instance-pointer-lowtag)) + (unless (location= result-imag value-imag) + (inst fmove :single result-imag value-imag))))) + +(define-vop (raw-instance-ref/complex-double) + (:translate %raw-instance-ref/complex-double) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg))) + (:arg-types * positive-fixnum) + (:results (value :scs (complex-double-reg))) + (:temporary (:scs (non-descriptor-reg)) offset) + (:temporary (:scs (interior-reg)) lip) + (:result-types complex-double-float) + (:generator 5 + (loadw offset object 0 instance-pointer-lowtag) + (inst srl offset n-widetag-bits) + (inst sll offset 2) + (inst subu offset index) + (inst subu offset (* 4 n-word-bytes)) + (inst addu lip offset object) + (let ((immediate-offset (- (* instance-slots-offset n-word-bytes) + instance-pointer-lowtag))) + (ecase *backend-byte-order* + (:big-endian (inst lwc1 + (complex-double-reg-real-tn value) + lip + immediate-offset)) + (:little-endian (inst lwc1-odd + (complex-double-reg-real-tn value) + lip + immediate-offset)))) + (let ((immediate-offset (- (* (1+ instance-slots-offset) n-word-bytes) + instance-pointer-lowtag))) + (ecase *backend-byte-order* + (:big-endian (inst lwc1-odd + (complex-double-reg-real-tn value) + lip + immediate-offset)) + (:little-endian (inst lwc1 + (complex-double-reg-real-tn value) + lip + immediate-offset)))) + (let ((immediate-offset (- (* (+ instance-slots-offset 2) n-word-bytes) + instance-pointer-lowtag))) + (ecase *backend-byte-order* + (:big-endian (inst lwc1 + (complex-double-reg-imag-tn value) + lip + immediate-offset)) + (:little-endian (inst lwc1-odd + (complex-double-reg-imag-tn value) + lip + immediate-offset)))) + (let ((immediate-offset (- (* (+ instance-slots-offset 3) n-word-bytes) + instance-pointer-lowtag))) + (ecase *backend-byte-order* + (:big-endian (inst lwc1-odd + (complex-double-reg-imag-tn value) + lip + immediate-offset)) + (:little-endian (inst lwc1 + (complex-double-reg-imag-tn value) + lip + immediate-offset)))))) + +(define-vop (raw-instance-set/complex-double) + (:translate %raw-instance-set/complex-double) + (:policy :fast-safe) + (:args (object :scs (descriptor-reg)) + (index :scs (any-reg)) + (value :scs (complex-double-reg) :target result)) + (:arg-types * positive-fixnum complex-double-float) + (:results (result :scs (complex-double-reg))) + (:temporary (:scs (non-descriptor-reg)) offset) + (:temporary (:scs (interior-reg)) lip) + (:result-types complex-double-float) + (:generator 5 + (loadw offset object 0 instance-pointer-lowtag) + (inst srl offset n-widetag-bits) + (inst sll offset 2) + (inst subu offset index) + (inst subu offset (* 4 n-word-bytes)) + (inst addu lip offset object) + (let ((value-real (complex-double-reg-real-tn value)) + (result-real (complex-double-reg-real-tn result))) + (let ((immediate-offset (- (* instance-slots-offset n-word-bytes) + instance-pointer-lowtag))) + (ecase *backend-byte-order* + (:big-endian (inst swc1 + value-real + lip + immediate-offset)) + (:little-endian (inst swc1-odd + value-real + lip + immediate-offset)))) + (let ((immediate-offset (- (* (1+ instance-slots-offset) n-word-bytes) + instance-pointer-lowtag))) + (ecase *backend-byte-order* + (:big-endian (inst swc1-odd + value-real + lip + immediate-offset)) + (:little-endian (inst swc1 + value-real + lip + immediate-offset)))) + (unless (location= result-real value-real) + (inst fmove :double result-real value-real))) + (let ((value-imag (complex-double-reg-imag-tn value)) + (result-imag (complex-double-reg-imag-tn result))) + (let ((immediate-offset (- (* (+ instance-slots-offset 2) n-word-bytes) + instance-pointer-lowtag))) + (ecase *backend-byte-order* + (:big-endian (inst swc1 + value-imag + lip + immediate-offset)) + (:little-endian (inst swc1-odd + value-imag + lip + immediate-offset)))) + (let ((immediate-offset (- (* (+ instance-slots-offset 3) n-word-bytes) + instance-pointer-lowtag))) + (ecase *backend-byte-order* + (:big-endian (inst swc1-odd + value-imag + lip + immediate-offset)) + (:little-endian (inst swc1 + value-imag + lip + immediate-offset)))) + (unless (location= result-imag value-imag) + (inst fmove :double result-imag value-imag))))) |
From: Christophe R. <cs...@ca...> - 2005-06-12 14:05:46
|
David Lichteblau <dav...@li...> writes: > as discussed on #lisp, structure objects currently store "raw" slots in > an extra vector, wasting between two and four words for each such > instance. Thank you. I think I have merged this, combined with Thiemo's implementation of the mips part, into sbcl-0.9.1.38. Testing by anyone who uses structures with interesting type declarations, is strongly advised. > Theoretical note: One could go even further and store raw slots not at > the end of the instance, but in front of header, so that the header (or > more precisely, the location pointed to by references to the object) is > not actually at the beginning of the object. Aside from making the raw > slot VOPs a little simpler, this would make the explicit length field in > the header unnecessary, saving an additional 24 bits for some other > purpose. However, I am not going to try this experiment... ;) I've noted this in the OPTIMIZATIONS file. Cheers, Christophe |