Tooling around on rainy pandemic Saturday

Create SIMPLE-VECTOR backed with java.nio.Buffer abstractions

EXT:MAKE-BYTEBUFFER-BYTE-VECTOR, EXT:MAKE-CHARBUFFER-BYTE-VECTOR,
EXT:MAKE-INTBUFFER-BYTE-VECTOR return a simple vector containing
unsigned elements for types (unsigned-byte 8), (unsigned-byte 16),
(unsigned-byte 32).

The EXT:MAKE-NIOBUFFER function provides the means to construct a
SIMPLE-VECTOR which shares the NIO-BUFFER contents.

   (ext:make-niobuffer nio-buffer :element-type '(unsigned-byte 8))

t/static-vector.lisp shows the creation of a bytebuffer for right now.

Add "buffers.lisp" to autoload on function definitions, otherwise the
function definitions for EXT:MAKE-INTBUFFER-BYTE-VECTOR
EXT:MAKE-CHARBUFFER-BYTE-VECTOR aren't loaded when first accessed.

src/org/armedbear/lisp/BasicVector_ByteBuffer.java

@@ -55,6 +55,30 @@ public BasicVector_ByteBuffer(byte[] array) {
     capacity = array.length;
     elements = ByteBuffer.wrap(array);
   }
+
+  // ### ext:make-bytebuffer-byte-vector BYTEBUFFER Construct a simple vector from BYTEBUFFER
+  @DocString(name="make-bytebuffer-byte-vector",
+             args="bytebuffer",
+             doc="Construct a simple vector from a java.nio.ByteBuffer BYTEBUFFER reference")
+
+  public static final Primitive MAKE_BYTEBUFFER_BYTE_VECTOR
+    = new pf_make_bytebuffer_byte_vector();
+  private static final class pf_make_bytebuffer_byte_vector extends Primitive {
+    pf_make_bytebuffer_byte_vector() {
+      super(Symbol.MAKE_BYTEBUFFER_BYTE_VECTOR, "bytebuffer");
+    }
+    @Override
+    public LispObject execute(LispObject arg) {
+      return new BasicVector_ByteBuffer(coerceToByteBuffer(arg));
+    }
+  }
+
+  static public ByteBuffer coerceToByteBuffer(LispObject arg) {
+    JavaObject obj = (JavaObject) arg;
+    return (ByteBuffer)obj.getObject();
+  }
+
+
 
   public BasicVector_ByteBuffer(LispObject[] array) {
     // FIXME: for now we assume that we're being handled an array of

src/org/armedbear/lisp/BasicVector_CharBuffer.java

@@ -66,6 +66,31 @@ public BasicVector_CharBuffer(CharBuffer buffer) {
     capacity = buffer.limit();
   }
 
+  // ### ext:make-charbuffer-byte-vector BYTEBUFFER
+  public static final Primitive MAKE_CHARBUFFER_BYTE_VECTOR
+    = new pf_make_charbuffer_byte_vector();
+  private static final class pf_make_charbuffer_byte_vector extends Primitive {
+    pf_make_charbuffer_byte_vector() {
+      super(Symbol.MAKE_CHARBUFFER_BYTE_VECTOR, "bytebuffer",
+            "Construct a simple vector with element type (unsigned 16) from a java.nio BYTEBUFFER");
+    }
+    @Override
+    public LispObject execute(LispObject arg) {
+      return new BasicVector_CharBuffer(coerceToCharBuffer(arg));
+    }
+  }
+
+  static public CharBuffer coerceToCharBuffer(LispObject arg) {
+    JavaObject javaObject = (JavaObject) arg;
+    Object o = javaObject.getObject();
+    if (o instanceof ByteBuffer) {
+      return ((ByteBuffer)o).asCharBuffer();
+    } else {
+      return (CharBuffer) o;
+    }
+  }
+
+
   @Override
   public LispObject typeOf() {
     return list(Symbol.SIMPLE_ARRAY, UNSIGNED_BYTE_16,

src/org/armedbear/lisp/BasicVector_IntBuffer.java

@@ -59,6 +59,31 @@ public BasicVector_IntBuffer(LispObject[] array) {
     }
   }
 
+  // ### ext:make-intbuffer-byte-vector BYTEBUFFER
+
+  public static final Primitive MAKE_INTBUFFER_BYTE_VECTOR
+    = new pf_make_intbuffer_byte_vector();
+  private static final class pf_make_intbuffer_byte_vector extends Primitive {
+    pf_make_intbuffer_byte_vector() {
+      super(Symbol.MAKE_INTBUFFER_BYTE_VECTOR, "bytebuffer",
+            "Construct a simple vector with element type (unsigned 32) from a nio.java BYTEBUFFER");
+    }
+    @Override
+    public LispObject execute(LispObject arg) {
+      return new BasicVector_IntBuffer(coerceToIntBuffer(arg));
+    }
+  }
+
+  static public IntBuffer coerceToIntBuffer(LispObject arg) {
+    JavaObject javaObject = (JavaObject) arg;
+    Object o = javaObject.getObject();
+    if (o instanceof ByteBuffer) {
+      return ((ByteBuffer)o).asIntBuffer();
+    } else {
+      return (IntBuffer) o;
+    }
+  }
+
   public BasicVector_IntBuffer(ByteBuffer buffer) {
     elements = buffer.asIntBuffer();
     capacity = buffer.limit();

src/org/armedbear/lisp/Symbol.java

@@ -2919,6 +2919,14 @@ public String toString() {
   // End of CL symbols.
 
   // Extensions.
+  public static final Symbol MAKE_NIOBUFFER_VECTOR =
+    PACKAGE_EXT.addExternalSymbol("MAKE-NIOBUFFER-VECTOR");
+  public static final Symbol MAKE_BYTEBUFFER_BYTE_VECTOR =
+    PACKAGE_EXT.addExternalSymbol("MAKE-BYTEBUFFER-BYTE-VECTOR");
+  public static final Symbol MAKE_CHARBUFFER_BYTE_VECTOR =
+    PACKAGE_EXT.addExternalSymbol("MAKE-CHARBUFFER-BYTE-VECTOR");
+  public static final Symbol MAKE_INTBUFFER_BYTE_VECTOR =
+    PACKAGE_EXT.addExternalSymbol("MAKE-INTBUFFER-BYTE-VECTOR");
   public static final Symbol MOST_POSITIVE_JAVA_LONG =
     PACKAGE_EXT.addExternalSymbol("MOST-POSITIVE-JAVA-LONG");
   public static final Symbol MOST_NEGATIVE_JAVA_LONG=

src/org/armedbear/lisp/autoloads.lisp

@@ -52,4 +52,9 @@
 ;; in a debugger. This command replaces the earlier function binding
 ;; where simple-format calls sys::%format
 
-(autoload 'simple-format "format")
+(autoload 'simple-format "format")
+;;; Otherwise the Primitive don't get fbound…
+(autoload '(ext:make-charbuffer-byte-vector
+            ext:make-intbuffer-byte-vector)
+          "buffers")
+

src/org/armedbear/lisp/buffers.lisp

@@ -0,0 +1,49 @@
+(in-package :ext)
+
+(defvar *buffer-allocation* :primitive-array
+  "The current buffer allocation strategy.")
+
+(defun choose-buffer-strategy (&key (new-default :nio new-default-p))
+  "Return current choices for buffer allocation strategy that can then be chosen as a :new-default strategy
+
+Not currently advisable to call during runtime. "
+  (if new-default-p
+      (setf *buffer-allocation*  new-default)
+      '((:nio
+         ((unsigned-byte 8)
+          . BasicVector_ByteBuffer)
+         ((unsigned-byte 16)
+          . BasicVector_CharBuffer)
+         ((unsigned-byte 32)
+          . BasicVector_IntBuffer))
+        (:primitive-array
+         ((unsigned-byte 8)
+          . BasicVector_UnsignedByte8)
+         ((unsigned-byte 16)
+          . BasicVector_UnsignedByte16)
+         ((unsigned-byte 32)
+          . BasicVector_UnsignedByte32)))))
+
+(defun make-niobuffer-vector (nio-buffer &key (element-type '(unsigned-byte 8)))
+  (unless (subtypep element-type '(unsigned-byte *))
+    (signal 'type-error "Need some subtype of (UNSIGNED-BYTE *)")) ;; FIXME: :datum ,
+  (case (second element-type) ;; FIXME: probably wrong for types that aren't 8, 16, or 32
+    (8 
+     (ext:make-bytebuffer-byte-vector nio-buffer))    
+    (16 
+     (ext:make-charbuffer-byte-vector nio-buffer))
+    (32
+     (ext:make-intbuffer-byte-vector nio-buffer))
+    (t
+     (ext:make-bytebuffer-byte-vector nio-buffer))))
+
+
+(eval-when (:load-toplevel :execute)
+  ;;; FIXME: otherwise EXT:MAKE-INTBUFFER-BYTE-VECTOR doesn't get loaded
+  (make-array 1 :element-type '(unsigned-byte 16))
+  (make-array 2 :element-type '(unsigned-byte 32)))
+
+
+
+
+

src/org/armedbear/lisp/compile-system.lisp

@@ -329,6 +329,7 @@
                            "aver.lisp"
                            "bit-array-ops.lisp"
                            "boole.lisp"
+                           "buffers.lisp"
                            "butlast.lisp"
                            "byte-io.lisp"
                            "case.lisp"

t/static-vectors.lisp

@@ -0,0 +1,15 @@
+(in-package :cl-user)
+
+(require :abcl-contrib)
+(require :jss)
+
+(prove:plan 1)
+(prove:ok
+ (let* ((bytebuffer
+          (#"allocate" 'nio.ByteBuffer 21))
+        (vector
+          (ext:make-bytebuffer-byte-vector bytebuffer)))
+   (and
+    vector
+    (typep vector '(SIMPLE-ARRAY (UNSIGNED-BYTE 8) (21))))))
+(prove:finalize)