--- /dev/null
+;;;; $Id: ecl-fast-array.lisp,v 1.1 2015/09/10 00:16:53 mmondor Exp $
+;;
+;; Copyright (c) 2011, Matthew Mondor.
+;; 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.
+;;
+;; THIS SOFTWARE IS PROVIDED BY MATTHEW MONDOR ``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 MATTHEW MONDOR 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.
+;;
+;;;;
+;;;; Implementation of C-backed efficient arrays for ECL.
+;;;; Note that these cannot be used in interpreted code directly,
+;;;; although slower user accessors are also provided for interpreted code.
+;;;; Internally a C array is used to hold the structure data,
+;;;; and CL accessors are converted to inline C.
+;;;; The specialized WITH-FAST-ARRAY system has a small block-setup
+;;;; overhead and provides high-performance C-inlined read and write access
+;;;; to every slot of a fast array within the block.
+;;;;
+
+#| XXX TODO XXX
+|#
+
+(declaim (optimize (speed 3) (safety 1) (debug 3))) ;XXX
+
+(defpackage :fast-array
+ (:use :cl)
+ (:export #:fast-array-instance
+ #:make-fast-array
+ #:fast-array-dimension
+ #:copy-fast-array
+ #:slow-aref
+ #:slow-fill-pointer
+ #:slow-push
+ #:slow-pop
+ #:fast-array--adjust
+ #:fast-array-element-type
+ #:fast-array-element-type-p
+ #:with-fast-array
+ #:do-fast-array))
+(in-package :fast-array)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+
+ ;; XXX Add print-object
+ (defstruct (fast-array-instance
+ (:constructor #make-fast-array-instance))
+ "Every FAST-ARRAY instance is an object of type FAST-ARRAY-INSTANCE.
+Its slots are reserved for internal use."
+ (element-type
+ pointer
+ size 0 :type fixnum
+ fill-pointer 0 :type fixnum))
+
+ ;;; Maps CL/FFI type to C type.
+ (defun c-type<-ecl-type (type)
+ (case type
+ (:t "cl_object")
+ (:fixnum "cl_fixnum")
+ (:int "int")
+ (:unsigned-int "unsigned int")
+ (:long "long")
+ (:unsigned-long "unsigned long")
+ (:int8-t "int8_t")
+ (:uint8-t "uint8_t")
+ (:int16-t "int16_t")
+ (:uint16-t "uint16_t")
+ (:int32-t "int32_t")
+ (:uint32-t "uint32_t")
+ (:int64-t "int64_t")
+ (:uint64-t "uint64_t")))
+
+ ;;; Maps C type to CL/FFI type.
+ (defun ecl-type<-type (type)
+ (case type
+ (:t 't)
+ (:fixnum 'fixnum)
+ (:short 'fixnum)
+ (:unsigned-short 'fixnum)
+ (:int 'integer)
+ (:unsigned-int 'integer)
+ (:long 'integer)
+ (:unsigned-long 'integer)
+ (:int8-t 'fixnum)
+ (:uint8-t 'fixnum)
+ (:int16-t 'fixnum)
+ (:uint16-t 'fixnum)
+ (:int32-t 'integer)
+ (:uint32-t 'integer)
+ (:int64-t 'integer)
+ (:uint64-t 'integer)
+ (otherwise nil)))
+
+ ;;; C function needed to convert a value to the wanted CL/FFI type.
+ (defun c-function<-type (type field)
+ (format nil
+ (case type
+ (:t "ecl_make_object(~A)") ; XXX Right?
+ (:fixnum "ecl_make_fixnum(~A)") ; XXX Right?
+ (:int8-t "ecl_make_int8_t(~A)")
+ (:uint8-t "ecl_make_uint8_t(~A)")
+ (:int16-t "ecl_make_int16_t(~A)")
+ (:uint16-t "ecl_make_uint16_t(~A)")
+ (:int32-t "ecl_make_int32_t(~A)")
+ (:uint32-t "ecl_make_uint32_t(~A)")
+ (:int64-t "ecl_make_int64_t(~A)")
+ (:uint64-t "ecl_make_uint64_t(~A)")
+ (:int "ecl_make_int(~A)")
+ (:unsigned-int "ecl_make_unsigned_integer(~A)")
+ (:long "ecl_make_long(~A)")
+ (otherwise
+ (error "c-function<-type: unknown type ~A"
+ type)))
+ field))
+
+ ;;; Maps C-FFI or CL types to the C function to access them.
+ (defun to-c-function<-type (type)
+ (case type
+ (:t "ecl_to_object_t") ; XXX Right?
+ (:fixnum "ecl_to_fixnum_t") ; XXX Right?
+ (:int8-t "ecl_to_int8_t")
+ (:uint8-t "ecl_to_uint8_t")
+ (:int16-t "ecl_to_int16_t")
+ (:uint16-t "ecl_to_uint16_t")
+ (:int32-t "ecl_to_int32_t")
+ (:uint32-t "ecl_to_uint32_t")
+ (:int64-t "ecl_to_int64_t")
+ (:uint64-t "ecl_to_uint64_t")
+ (:int "ecl_to_int")
+ (:unsigned-int "ecl_to_unsigned_integer")
+ (:long "ecl_to_long")
+ (otherwise
+ (error "to-c-function<-type: unknown type ~A"
+ type))))
+
+ (defun make-fast-array (element-type initial-size
+ &optional (finalizer nil)))
+
+ (defun fast-array-dimension (array))
+
+ (defun copy-fast-array (array &key (copy-finalizer t)))
+
+ (defun slow-aref (array index))
+ (defun (setf slow-aref) (value array index))
+
+ (defun slow-fill-pointer (array))
+ (defun (setf slow-fill-pointer (value array)))
+
+ (defun slow-push (value array))
+ (defun slow-pop (array))
+
+ (defun fast-array-adjust (array new-size))
+
+ (defun fast-array-element-type (array))
+
+ (defun fast-array-element-type-p (array type)))
+
+;;; Define AREF/ASET macros, possibly also FILL-POINTER manipulation and
+;;; PUSH/POP ones.
+(defmacro with-fast-array ((prefix array) &body body))
+
+(defmacro do-fast-array ((var array
+ &key (start 0) (end nil) (index nil))
+ &body body))
\ No newline at end of file
Repositories / mmondor.git / commitdiff