From: rlaakso Date: Mon, 8 Aug 2005 16:23:22 +0000 (+0000) Subject: .. X-Git-Url: https://repo.or.cz/w/sb-simd.git/commitdiff_plain/a91a1570532a48411fa88bbcf1b6d8a868ce1d32 .. --- diff --git a/cpuid-vop.lisp b/cpuid-vop.lisp index 2f79c70..41a20dd 100644 --- a/cpuid-vop.lisp +++ b/cpuid-vop.lisp @@ -1,3 +1,29 @@ +#| +Copyright (c) 2005 Risto Laakso +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +3. The name of the author may not be used to endorse or promote products + derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES +OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. +IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, +INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT +NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF +THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +|# (in-package :sb-c) (ignore-errors (defknown cl-user::%read-cpu (unsigned-byte-32 simple-array-unsigned-byte-16) nil)) diff --git a/cpuid.lisp b/cpuid.lisp index 55c4f9c..708d3c9 100644 --- a/cpuid.lisp +++ b/cpuid.lisp @@ -1,3 +1,29 @@ +#| +Copyright (c) 2005 Risto Laakso +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +3. The name of the author may not be used to endorse or promote products + derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES +OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. +IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, +INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT +NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF +THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +|# (defpackage :cpuid (:use :cl)) (in-package :cpuid) diff --git a/generate-sse-instructions.lisp b/generate-sse-instructions.lisp index 7619416..5de9881 100644 --- a/generate-sse-instructions.lisp +++ b/generate-sse-instructions.lisp @@ -1,4 +1,30 @@ #| +Copyright (c) 2005 Risto Laakso +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +3. The name of the author may not be used to endorse or promote products + derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES +OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. +IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, +INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT +NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF +THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +|# +#| instruction reference: diff --git a/generate-sse-vops.lisp b/generate-sse-vops.lisp index 4823b1b..e091688 100644 --- a/generate-sse-vops.lisp +++ b/generate-sse-vops.lisp @@ -1,3 +1,30 @@ +#| +Copyright (c) 2005 Risto Laakso +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +3. The name of the author may not be used to endorse or promote products + derived from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR +IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES +OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. +IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, +INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT +NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF +THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +|# + (defun vect-ea (vect idx) `(make-ea :dword :base ,vect :index ,idx :disp (- (* vector-data-offset n-word-bytes) other-pointer-lowtag))) diff --git a/scratch/.emacs.desktop b/scratch/.emacs.desktop deleted file mode 100644 index 4fe6149..0000000 --- a/scratch/.emacs.desktop +++ /dev/null @@ -1,82 +0,0 @@ -;; -*- coding: emacs-mule; -*- -;; -------------------------------------------------------------------------- -;; Desktop File for Emacs -;; -------------------------------------------------------------------------- -;; Created Fri Aug 5 15:49:29 2005 -;; Emacs version 21.3.1 - -;; Global section: -(setq desktop-missing-file-warning nil) -(setq tags-file-name nil) -(setq tags-table-list nil) -(setq search-ring nil) -(setq regexp-search-ring nil) -(setq register-alist nil) - -;; Buffer section: -(desktop-create-buffer 205 - "/home/rlaakso/projects/sbcl-sse/sse2.lisp" - "sse2.lisp" - 'lisp-mode - '(slime-mode) - 1 - '(nil nil) - nil - nil - nil) - -(desktop-create-buffer 205 - "/home/rlaakso/projects/sbcl-sse/OPTIMIZATIONS" - "OPTIMIZATIONS" - 'fundamental-mode - nil - 161 - '(nil nil) - nil - nil - nil) - -(desktop-create-buffer 205 - "/home/rlaakso/projects/sbcl-sse/sse.lisp" - "sse.lisp" - 'lisp-mode - '(slime-mode) - 1630 - '(nil nil) - nil - nil - nil) - -(desktop-create-buffer 205 - "/home/rlaakso/projects/sbcl-sse/cpuid.lisp" - "cpuid.lisp" - 'lisp-mode - '(slime-mode) - 68 - '(1 nil) - nil - nil - nil) - -(desktop-create-buffer 205 - "/home/rlaakso/.emacs" - ".emacs" - 'emacs-lisp-mode - nil - 848 - '(nil nil) - nil - nil - nil) - -(desktop-create-buffer 205 - "/home/rlaakso/projects/sb-simd-tmp/sb-simd/scratch/cpuid.lisp" - "cpuid.lisp<2>" - 'lisp-mode - '(slime-mode) - 1442 - '(nil nil) - nil - nil - nil) - diff --git a/scratch/README b/scratch/README deleted file mode 100644 index caad35e..0000000 --- a/scratch/README +++ /dev/null @@ -1,2 +0,0 @@ -scratch space. do not look ;-) - diff --git a/scratch/asm-t1.asm b/scratch/asm-t1.asm deleted file mode 100644 index 599e6a6..0000000 --- a/scratch/asm-t1.asm +++ /dev/null @@ -1,10 +0,0 @@ - -my_func: - xor eax, eax - movups xmm0, [edx+ebx+1] - movups xmm1, [esi+ecx+1] - addps xmm0, xmm4 - addps xmm4, xmm0 - movups [ecx+1], xmm0 - - ret \ No newline at end of file diff --git a/scratch/foo.lisp b/scratch/foo.lisp deleted file mode 100644 index 0f54018..0000000 --- a/scratch/foo.lisp +++ /dev/null @@ -1,159 +0,0 @@ -(in-package :sb-vm) - -(define-vop (my-vop) - (:policy :fast-safe) - - (:args (vector1 :scs (descriptor-reg)) - (vector2 :scs (descriptor-reg))) - (:arg-types simple-array-single-float simple-array-single-float) - - (:temporary (:sc unsigned-reg) index) - -;; (:temporary (:sc unsigned-reg) temp1) -;; (:temporary (:sc unsigned-reg) temp2) - - (:temporary (:sc sse-reg) sse-temp1) - (:temporary (:sc sse-reg) sse-temp2) - - (:generator 10 - - (inst xor index index) - - - (inst movups sse-temp1 - (make-ea :dword :base vector1 :index index - :disp (- (* vector-data-offset n-word-bytes) other-pointer-lowtag))) - (inst movups sse-temp2 - (make-ea :dword :base vector2 :index index - :disp (- (* vector-data-offset n-word-bytes) other-pointer-lowtag))) - - (inst addps sse-temp1 sse-temp2) - -;; (inst add index 4) - - (inst movups - (make-ea :dword :base vector1 :index index - :disp (- (* vector-data-offset n-word-bytes) other-pointer-lowtag)) - sse-temp1) -#| - (inst add index 4) - (inst mov - (make-ea :dword :base vector1 :index index - :disp (- (* vector-data-offset n-word-bytes) other-pointer-lowtag)) - index) - - (inst add index 4) - (inst movups - (make-ea :dword :base vector1 :index index - :disp (- (* vector-data-offset n-word-bytes) other-pointer-lowtag)) - sse-temp2) -|# - )) - -#| -00000000 : - 0: 31 c0 xor %eax,%eax 2: 0f 10 04 c6 movups (%esi,%eax,8),%xmm0 - 6: 0f 10 0c c7 movups (%edi,%eax,8),%xmm1 - a: 0f 58 c1 addps %xmm1,%xmm0 - d: 0f 11 44 c5 00 movups %xmm0,0x0(%ebp,%eax,8) - ---- v2: - 0: 31 c0 xor %eax,%eax - 2: 0f 10 44 03 01 movups 0x1(%ebx,%eax,1),%xmm0 - 7: 0f 10 4c 01 01 movups 0x1(%ecx,%eax,1),%xmm1 - c: 0f 58 c1 addps %xmm1,%xmm0 - f: 0f 11 44 01 01 movups %xmm0,0x1(%ecx,%eax,1) - ---- v3: - 2: 0f 10 43 01 movups 0x1(%ebx),%xmm0 - 6: 0f 10 49 01 movups 0x1(%ecx),%xmm1 - a: 0f 58 c1 addps %xmm1,%xmm0 - d: 0f 11 41 01 movups %xmm0,0x1(%ecx) - ---- v4: - 2: 0f 10 44 1a 01 movups 0x1(%edx,%ebx,1),%xmm0 - 7: 0f 10 4c 0e 01 movups 0x1(%esi,%ecx,1),%xmm1 - c: 0f 58 c1 addps %xmm1,%xmm0 - f: 0f 11 41 01 movups %xmm0,0x1(%ecx) - -10h = MOVUPS Vps, Wps -11h = MOVUPS Wps, Vps - -V = 128bit xmm reg specified by the modrm reg field. -W = 128bit xmm register or mem op specified by the modrm byte. -ps = 128bit single-precision float operand - -movups xmm0, [ebx + 01] -movups md reg r/m sc idx bse disp8 -0f 10 01 000 100 00 000 011 01 - +d8 xm0 sib *0 +0 ebx +01 -|# -#| -; 43E: L4: 31C0 XOR EAX, EAX - - 7 6 5 4 3 2 1 0 - m d r e g r / m - -44h = b 0 1 0 0 0 1 0 0 -4Ch = b 0 1 0 0 1 1 0 0 -64h = b 0 1 1 0 0 1 0 0 -E0h = b 1 1 1 0 0 0 0 0 -C1h = b 1 1 0 0 0 0 0 1 -43h = b 0 1 0 0 0 0 1 1 -49h = b 0 1 0 0 1 0 0 1 - -r/m b100 => has sib byte - -modrm md+r/m field: - r/m= 000, 001, 010, 011, 100, 101, 110 , 111 -md -00 = ax, cx, dx, bx, sib, rip+d32, si, di -01 = --||-- + disp8 , bp+disp8, .. -10 = --||-- + disp32 -11 = al/ax/eax/mmx0/xmm0, 1, 2, 3, 4, 5, 6, 7 - -modrm reg: - 000 001 010 011 100 101 110 111 -reg32 eax ecx edx ebx esp ebp esi edi -xmm xm0 xm1 xm2 xm3 xm4 xm5 xm6 xm7 ;; actually xmm0..xmm7 - - -44h = md 01, r/m 100, reg 000, => xmm0, [sib + disp8] => 44 03 01 : xmm0, [ebx + 01], 44 01 01 : xmm0, [ecx + 01] -64h = md 01, r/m 100, reg 100, => xmm4, [sib + disp8] => xmm4, [ebx + 01] -04 C6 = md 00, r/m 100, reg 000, => xmm0, [sib] => xmm0, [esi*8] -4C 01 01 = md 01, reg 001, r/m 100 => xmm1, [sib + disp8] => [ecx + 01] -43h = md 01, reg 0, r/m 011 => xmm0, [ebx + 01] -49h = md 01, reg 1, r/m 001 => xmm1, [ecx + 01] - - - 7 6 5 4 3 2 1 0 - s c i d x b a s - -03h = b 0 0 0 0 0 0 1 1 = eax + ebx*1 -01h = b 0 0 0 0 0 0 0 1 = eax + ecx*1 -C6h = b 1 1 0 0 0 1 1 0 = eax + esi*8 -1Ah = b 0 0 0 1 1 0 1 0 = ebx + edx*1 -0Eh = b 0 0 0 0 1 1 1 0 = ecx + esi*1 - - -;; movups xmm0, ea 0F 10 44 03 01 -; 440: 0F 10 44 01 01 movups xmm0, [eax + ecx + 01] - -;; movups xmm1, ea 0F 10 4C 01 01 -; 445: 0F 10 64 03 01 movups xmm4, [eax + ebx + 01] - -;; addps xmm0, xmm1 0F 58 C1 -; 44A: 0F 58 E0 addps xmm0, xmm4 - -;; movups ea, xmm0 0f 11 44 01 01 - 0F 11 44 01 01 movups [eax + ecx + 01], xmm0 - -; 452: 83C004 ADD EAX, 4 - - --- - - c: 0f 58 c4 addps %xmm4,%xmm0 - f: 0f 58 e0 addps %xmm0,%xmm4 - -|# diff --git a/scratch/sse.lisp b/scratch/sse.lisp deleted file mode 100644 index db99a8a..0000000 --- a/scratch/sse.lisp +++ /dev/null @@ -1,125 +0,0 @@ -;;; From sb-devel post by Christophe Rhodes -(in-package :cl-user) - -(defun %vector+ (result vector1 vector2) - (loop for x across vector1 - for y across vector2 - for i from 0 - do (setf (aref result i) (+ x y)))) - -(in-package :sb-c) - -;; kludge -(ignore-errors (defknown cl-user::%vector+ (vector vector vector) vector)) - -(in-package :sb-vm) - -(pushnew :sse2 *backend-subfeatures*) - -(define-vop (vector+/simple-array-signed-byte-30) - (:translate cl-user::%vector+) - (:policy :fast) - (:args (result :scs (descriptor-reg)) - (vector1 :scs (descriptor-reg)) - (vector2 :scs (descriptor-reg))) - (:arg-types simple-array-signed-byte-30 simple-array-signed-byte-30 simple-array-signed-byte-30) - (:temporary (:sc any-reg) temp) - (:temporary (:sc unsigned-reg) index) - (:temporary (:sc unsigned-reg) length) - (:generator 30 - (let ((top (gen-label)) - (end (gen-label))) - (loadw length result vector-length-slot other-pointer-lowtag) - ;; check that the result vector doesn't have length 0 - (inst cmp length 0) - (inst jmp :e end) - ;; zero the index - (inst xor index index) - (emit-label top) - ;; this is wasteful if one of the arguments is the same as the - ;; result; we can save a mov - (inst mov temp (make-ea :dword :base vector1 :index index - :disp (- (* vector-data-offset n-word-bytes) other-pointer-lowtag))) - (inst add temp (make-ea :dword :base vector2 :index index - :disp (- (* vector-data-offset n-word-bytes) other-pointer-lowtag))) - (inst mov (make-ea :dword :base result :index index - :disp (- (* vector-data-offset n-word-bytes) other-pointer-lowtag)) temp) - (inst add index (fixnumize 1)) - (inst cmp index length) - (inst jmp :ne top) - (emit-label end)))) - -(define-vop (vector+/simple-array-signed-byte-30-sse) - (:translate cl-user::%vector+) - (:policy :fast) - (:args (result :scs (descriptor-reg)) - (vector1 :scs (descriptor-reg)) - (vector2 :scs (descriptor-reg))) - (:arg-types simple-array-signed-byte-30 simple-array-signed-byte-30 simple-array-signed-byte-30) - (:temporary (:sc any-reg) temp) - (:temporary (:sc sse-reg) sse-temp1) - (:temporary (:sc sse-reg) sse-temp2) - (:temporary (:sc unsigned-reg) index) - (:temporary (:sc unsigned-reg) length) - (:guard (member :sse2 *backend-subfeatures*)) - (:generator 25 - (let ((top (gen-label)) - (two (gen-label)) - (four (gen-label)) - (end (gen-label))) - (loadw length result vector-length-slot other-pointer-lowtag) - ;; check that the result vector doesn't have length 0 - (inst cmp length 0) - (inst jmp :e end) - ;; zero the index - (inst xor index index) - (emit-label top) - (inst test length 1) - (inst jmp :z two) - (inst mov temp (make-ea :dword :base vector1 :index index - :disp (- (* vector-data-offset n-word-bytes) other-pointer-lowtag))) - (inst add temp (make-ea :dword :base vector2 :index index - :disp (- (* vector-data-offset n-word-bytes) other-pointer-lowtag))) - (inst mov (make-ea :dword :base result :index index - :disp (- (* vector-data-offset n-word-bytes) other-pointer-lowtag)) temp) - (inst add index (fixnumize 1)) - (inst cmp index length) - (inst jmp :e end) - (emit-label two) - ;; eventually at this point we put in a quadword add, but that - ;; would be one more instruction to write. - (inst test length 2) - (inst mov temp (make-ea :dword :base vector1 :index index - :disp (- (* vector-data-offset n-word-bytes) other-pointer-lowtag))) - (inst add temp (make-ea :dword :base vector2 :index index - :disp (- (* vector-data-offset n-word-bytes) other-pointer-lowtag))) - (inst mov (make-ea :dword :base result :index index - :disp (- (* vector-data-offset n-word-bytes) other-pointer-lowtag)) temp) - (inst add index (fixnumize 1)) - (inst cmp index length) - (inst jmp :e end) - (inst mov temp (make-ea :dword :base vector1 :index index - :disp (- (* vector-data-offset n-word-bytes) other-pointer-lowtag))) - (inst add temp (make-ea :dword :base vector2 :index index - :disp (- (* vector-data-offset n-word-bytes) other-pointer-lowtag))) - (inst mov (make-ea :dword :base result :index index - :disp (- (* vector-data-offset n-word-bytes) other-pointer-lowtag)) temp) - (inst add index (fixnumize 1)) - (inst cmp index length) - (inst jmp :e end) - (emit-label four) - ;; here, we do double quadword additions until we hit the end of - ;; the computation. No guarantees about alignment, so we have to - ;; use movdqu. - (inst movdqu sse-temp1 (make-ea :dword :base vector1 :index index - :disp (- (* vector-data-offset n-word-bytes) other-pointer-lowtag))) - ;; KLUDGE: We're using :dword EAs here. This is possibly non-optimal. - (inst movdqu sse-temp2 (make-ea :dword :base vector2 :index index - :disp (- (* vector-data-offset n-word-bytes) other-pointer-lowtag))) - (inst paddd sse-temp1 sse-temp2) - (inst movdqu sse-temp1 (make-ea :dword :base result :index index - :disp (- (* vector-data-offset n-word-bytes) other-pointer-lowtag))) - (inst add index (fixnumize 4)) - (inst cmp index length) - (inst jmp :ne four) - (emit-label end)))) diff --git a/scratch/sse2.lisp b/scratch/sse2.lisp deleted file mode 100644 index 78b95ac..0000000 --- a/scratch/sse2.lisp +++ /dev/null @@ -1,33 +0,0 @@ -;;; From sb-devel post by Christophe Rhodes -(in-package :cl-user) - -(declaim (inline fixnum/vector+)) -(defun fixnum/vector+ (vector1 vector2) - (let ((result (make-array (length vector1) :element-type 'fixnum))) - (dotimes (i 1000000) - (declare (fixnum i)) - (%vector+ result vector1 vector2)) - result)) - -(defun foo () - (declare (optimize (speed 3) (safety 0))) - (let ((x (make-array 1000 :element-type 'fixnum - :initial-contents (loop for x fixnum from 0 to 999 collect x))) - (y (make-array 1000 :element-type 'fixnum - :initial-contents (loop for x fixnum from 0 to 999 collect x)))) - (fixnum/vector+ x y))) - -(defun bar () - (declare (optimize (speed 3) (safety 0))) - (let ((x (make-array 1000 :element-type 'fixnum - :initial-contents (loop for x fixnum from 0 to 999 collect x))) - (y (make-array 1000 :element-type 'fixnum - :initial-contents (loop for x fixnum from 0 to 999 collect x)))) - (let ((result (make-array 1000 :element-type 'fixnum))) - (dotimes (j 1000000) - (declare (fixnum j)) - (loop for tx across x - for ty across y - for i fixnum upfrom 0 - do (setf (aref result i) (+ tx ty)))) - result)))