(defvar *r*)
(defun test2 ()
(let ((a1 (make-array '(#-(or abcl clisp) 1000 #+clisp 16 #+abcl 64 1000 1000) :element-type '(unsigned-byte 8)
:initial-element 1))
(a2 (make-array '(#-(or abcl clisp) 1000 #+clisp 16 #+abcl 64 1000 1000) :element-type '(unsigned-byte 8)
:initial-element 2)))
(copy-array-2 a1 a2)
(setf *r* a2))
t)
>> real time : 23.863
>>
>> What an optimization!
I used:
ecl -norc
(load (compile-file #P"~/b.lisp"))
(time (test1))
(time (test2))
(time (test3))
(find 1 (make-array 1000000000 :displaced-to *r* :element-type (array-element-type *r*)) :test '/=)
Using compile-file seem to have applied the C compiler.
If I use (load #P"~/b.lisp"), which allows to use diassmble, the timings
are as follow "ecl (bc)":
| implementation | row-major-aref | replace+displaced | aref | best |
|----------------+----------------+-------------------+---------+-------------------|
| abcl (64MB) | 0.912 | 4.54 | 4.665 | row-major-aref |
| ccl | 51.729 | 28.204 | 47.139 | replace+displaced |
| clisp (16MB) | 0.711 | 0.029 | 1.063 | replace+displaced |
| ecl (cmp) | 17.272 | 0.193 | 14.057 | replace+dispalced |
| ecl (bc) | 132.108 | 0.205 | 176.943 | replace+dispalced |
| sbcl | 36.516 | 44.510 | 28.526 | aref |
I would guess that in both cases, it comes down to a builtin memcpy.
This is on a iMac with 4 x 8GB banks of 1867 MHz DDR3, and 4 GHz Intel
Core i7.
So one could expect a minimum copy time for 1e9 bytes to be:
(/ 1000000000.0 8 (/ 1867000000.0 2)) - 0.134 s.
However, a built-in memcpy could do much better, by using the DMA,
duplicating only the page descriptors, marking them COW, and sharing the
storage between the two arrays. Then the actual copy would occur only
as one array or the other is mutated. Since gcc builtin memcpy doesn't
do it, any CL implementation could perform this optimization, for big arrays…
Otherwise, disassemble on ecl is not that informative since it only
works for the bytecode, not for the C code:
[pjb@despina org.macports:0 ~]$ ecl -norc
ECL (Embeddable Common-Lisp) 16.1.3 (git:UNKNOWN)
Copyright (C) 1984 Taiichi Yuasa and Masami Hagiya
Copyright (C) 1993 Giuseppe Attardi
Copyright (C) 2000 Juan J. Garcia-Ripoll
Copyright (C) 2016 Daniel Kochmanski
ECL is free software, and you are welcome to redistribute it
under certain conditions; see file 'Copyright' for details.
Type :h for Help.
Top level in: #<process TOP-LEVEL>.
> (load (compile-file "~/b.lisp"))
;;; Loading #P"/opt/local/lib/ecl-16.1.3/cmp.fas"
;;;
;;; Compiling /Users/pjb/b.lisp.
;;; OPTIMIZE levels: Safety=2, Space=0, Speed=3, Debug=0
;;;
;;; Compiling (DEFUN COPY-ARRAY-1 ...).
;;; Compiling (DEFUN COPY-ARRAY-2 ...).
;;; Compiling (DEFUN COPYDATA ...).
;;; Compiling (DEFUN TEST1 ...).
;;; Compiling (DEFVAR *R*).
;;; Compiling (DEFUN TEST2 ...).
;;; Compiling (DEFUN TEST3 ...).
;;; End of Pass 1.
;;; Emitting code for COPY-ARRAY-1.
;;; Emitting code for COPY-ARRAY-2.
;;; Emitting code for COPYDATA.
;;; Emitting code for TEST1.
;;; Emitting code for TEST2.
;;; Emitting code for TEST3.
;;; Finished compiling /Users/pjb/b.lisp.
;;;
;;; Loading "/Users/pjb/b.fas"
#P"/Users/pjb/b.fas"
> (disassemble 'test2)
;;; Warning: Cannot disassemble the binary function #<compiled-function TEST2> because I do not have its source code.
NIL
> (load #P"~/b.lisp")
;;; Loading "/Users/pjb/b.lisp"
#P"/Users/pjb/b.lisp"
> (disassemble 'test2)
#(TEST2 (1000 1000 1000) :ELEMENT-TYPE (UNSIGNED-BYTE 8) :INITIAL-ELEMENT MAKE-ARRAY (1000 1000 1000) (UNSIGNED-BYTE 8) A2 A1 COPY-ARRAY-2 *R* T #<bytecompiled-function TEST2> SI:FSET)
Name: TEST2
0 NOMORE
1 PUSH '(1000 1000 1000)
3 PUSHVS :ELEMENT-TYPE
5 PUSH '(UNSIGNED-BYTE 8)
7 PUSHVS :INITIAL-ELEMENT
9 PUSH 1
11 CALLG 5,MAKE-ARRAY
14 PUSH VALUES(0)
15 PUSH '(1000 1000 1000)
17 PUSHVS :ELEMENT-TYPE
19 PUSH '(UNSIGNED-BYTE 8)
21 PUSHVS :INITIAL-ELEMENT
23 PUSH 2
25 CALLG 5,MAKE-ARRAY
28 PUSH VALUES(0)
29 PBIND A2
31 PBIND A1
33 PUSHV 0
35 PUSHV 1
37 CALLG 2,COPY-ARRAY-2
40 VAR 1
42 SETQS *R*
44 UNBIND 2
46 VARS T
48 SET VALUES(0),REG0
49 EXIT
NIL
> (disassemble 'copy-array-2)
#(COPY-ARRAY-2 FROM TO (EQUAL (ARRAY-DIMENSIONS FROM) (ARRAY-DIMENSIONS TO)) SI:ASSERT-FAILURE ARRAY-DIMENSIONS EQUAL * REDUCE SIZE :ELEMENT-TYPE ARRAY-ELEMENT-TYPE :DISPLACED-TO MAKE-ARRAY REPLACE #<bytecompiled-function COPY-ARRAY-2> SI:FSET)
Name: COPY-ARRAY-2
0 POP REQ
1 BIND FROM
3 POP REQ
4 BIND TO
6 NOMORE
7 JMP 14
9 PUSH '(EQUAL (ARRAY-DIMENSIONS FROM) (ARRAY-DIMENSIONS TO))
11 CALLG 1,ASSERT-FAILURE
14 VAR 1
16 CALLG1 ARRAY-DIMENSIONS
18 PUSH VALUES(0)
19 VAR 0
21 CALLG1 ARRAY-DIMENSIONS
23 CALLG2 EQUAL
25 NOT
26 JT 9
28 SYMFUNC *
30 PUSH VALUES(0)
31 VAR 1
33 CALLG1 ARRAY-DIMENSIONS
35 PUSH VALUES(0)
36 CALLG 2,REDUCE
39 BIND SIZE
41 PUSHV 0
43 PUSHVS :ELEMENT-TYPE
45 VAR 1
47 CALLG1 ARRAY-ELEMENT-TYPE
49 PUSH VALUES(0)
50 PUSHVS :DISPLACED-TO
52 PUSHV 1
54 CALLG 5,MAKE-ARRAY
57 PUSH VALUES(0)
58 PUSHV 0
60 PUSHVS :ELEMENT-TYPE
62 VAR 2
64 CALLG1 ARRAY-ELEMENT-TYPE
66 PUSH VALUES(0)
67 PUSHVS :DISPLACED-TO
69 PUSHV 2
71 CALLG 5,MAKE-ARRAY
74 PUSH VALUES(0)
75 CALLG 2,REPLACE
78 UNBIND 1
80 VAR 0
82 SET VALUES(0),REG0
83 EXIT
NIL