From 998fb865e29b6765455a05364205d8c3c42646c6 Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Sun, 3 Sep 2023 11:11:26 +0200 Subject: [PATCH 01/36] Rework SIMPLE-VECTOR implementation using openjdk8 facilities (INCOMPLETE) Start of exploration on simplifying and improving support for sequences, vectors, and arrays by using generics and functions shipped as part of openjdk8. Goals: 1) Simplify class structure with parameterized types 2) Use openjdk8 methods like Arrays.fill(), sort() et. al. 3) Reduce memory use for "oversized" buffers 4) Optimize speed of basic operations TODO need some benchmarks to test before/after --- src/org/armedbear/lisp/SimpleVector.java | 209 +++++++++++------------ 1 file changed, 100 insertions(+), 109 deletions(-) diff --git a/src/org/armedbear/lisp/SimpleVector.java b/src/org/armedbear/lisp/SimpleVector.java index 4850923c5..66dd2767a 100644 --- a/src/org/armedbear/lisp/SimpleVector.java +++ b/src/org/armedbear/lisp/SimpleVector.java @@ -35,43 +35,50 @@ import static org.armedbear.lisp.Lisp.*; +import java.lang.reflect.Array; +import java.util.Arrays; + // "The type of a vector that is not displaced to another array, has no fill // pointer, is not expressly adjustable and is able to hold elements of any // type is a subtype of type SIMPLE-VECTOR." -public final class SimpleVector extends AbstractVector +public final class SimpleVector extends AbstractVector { int capacity; - LispObject[] data; + T[] data; + Class clazz; - public SimpleVector(int capacity) - { - data = new LispObject[capacity]; - for (int i = capacity; i-- > 0;) - data[i] = Fixnum.ZERO; + public SimpleVector(int capacity) { + this(LispObject.class, capacity); + } + + public SimpleVector(Class type, int capacity) { + // data = new LispObject[capacity]; + this.clazz = type; this.capacity = capacity; + data = (T[]) Array.newInstance(type, capacity); + // for (int i = capacity; i-- > 0;) { + //data[i] = Fixnum.ZERO; + //} + Arrays.fill(data, (T) Fixnum.ZERO); // is this necessary? } - public SimpleVector(LispObject obj) - { - if (obj.listp()) - { - data = obj.copyToArray(); - capacity = data.length; - } - else if (obj instanceof AbstractVector) - { - capacity = obj.length(); - data = new LispObject[capacity]; - for (int i = 0; i < capacity; i++) - data[i] = obj.elt(i); + public SimpleVector(LispObject obj) { + if (obj.listp()) { + data = (T[]) obj.copyToArray(); + capacity = data.length; + } else if (obj instanceof AbstractVector) { + capacity = obj.length(); + data = (T[]) new LispObject[capacity]; + for (int i = 0; i < capacity; i++) { + data[i] = (T) obj.elt(i); // faster? Implement AbstractVector.asArray()? } - else + } else { Debug.assertTrue(false); + } } - public SimpleVector(LispObject[] array) - { - data = array; + public SimpleVector(LispObject[] array) { + data = (T[])array; capacity = array.length; } @@ -149,42 +156,33 @@ public int length() @Override public LispObject elt(int index) { - try - { - return data[index]; - } - catch (ArrayIndexOutOfBoundsException e) - { - badIndex(index, capacity); - return NIL; // Not reached. - } + try { + return (T) data[index]; + } catch (ArrayIndexOutOfBoundsException e) { + badIndex(index, capacity); + return NIL; // Not reached. + } } @Override public LispObject AREF(int index) { - try - { - return data[index]; - } - catch (ArrayIndexOutOfBoundsException e) - { - badIndex(index, data.length); - return NIL; // Not reached. - } + try { + return data[index]; + } catch (ArrayIndexOutOfBoundsException e) { + badIndex(index, data.length); + return NIL; // Not reached. + } } @Override public void aset(int index, LispObject newValue) { - try - { - data[index] = newValue; - } - catch (ArrayIndexOutOfBoundsException e) - { - badIndex(index, capacity); - } + try { + data[index] = (T) newValue; + } catch (ArrayIndexOutOfBoundsException e) { + badIndex(index, capacity); + } } @Override @@ -204,20 +202,17 @@ public LispObject SVREF(int index) @Override public void svset(int index, LispObject newValue) { - try - { - data[index] = newValue; - } - catch (ArrayIndexOutOfBoundsException e) - { - badIndex(index, capacity); - } + try { + data[index] = (T) newValue; + } catch (ArrayIndexOutOfBoundsException e) { + badIndex(index, capacity); + } } @Override public LispObject subseq(int start, int end) { - SimpleVector v = new SimpleVector(end - start); + SimpleVector v = new SimpleVector(clazz, end - start); int i = start, j = 0; try { @@ -234,8 +229,7 @@ public LispObject subseq(int start, int end) @Override public void fill(LispObject obj) { - for (int i = capacity; i-- > 0;) - data[i] = obj; + Arrays.fill(data, (T) obj); } @Override @@ -248,7 +242,7 @@ public LispObject deleteEq(LispObject item) { LispObject obj = data[i++]; if (obj != item) - data[j++] = obj; + data[j++] = (T)obj; } if (j < limit) shrink(j); @@ -265,7 +259,7 @@ public LispObject deleteEql(LispObject item) { LispObject obj = data[i++]; if (!obj.eql(item)) - data[j++] = obj; + data[j++] = (T) obj; } if (j < limit) shrink(j); @@ -275,26 +269,27 @@ public LispObject deleteEql(LispObject item) @Override public void shrink(int n) { - if (n < capacity) - { - LispObject[] newData = new LispObject[n]; - System.arraycopy(data, 0, newData, 0, n); - data = newData; - capacity = n; - return; - } - if (n == capacity) + if (n < capacity) { + SimpleVector newArray = new SimpleVector(clazz, n); + System.arraycopy(data, 0, newArray.data, 0, n); + data = (T[])newArray.data; + capacity = n; return; + } + if (n == capacity) { + return; + } error(new LispError()); } @Override public LispObject reverse() { - SimpleVector result = new SimpleVector(capacity); + SimpleVector result = new SimpleVector(clazz, capacity); int i, j; - for (i = 0, j = capacity - 1; i < capacity; i++, j--) + for (i = 0, j = capacity - 1; i < capacity; i++, j--) { result.data[i] = data[j]; + } return result; } @@ -307,7 +302,7 @@ public LispObject nreverse() { LispObject temp = data[i]; data[i] = data[j]; - data[j] = temp; + data[j] = (T) temp; ++i; --j; } @@ -384,23 +379,21 @@ public AbstractVector replace(AbstractVector source, new Primitive("svref", "simple-vector index") { @Override - public LispObject execute(LispObject first, LispObject second) - - { - if (first instanceof SimpleVector) { - final SimpleVector sv = (SimpleVector)first; - int index = Fixnum.getValue(second); - try { - return sv.data[index]; - } catch (ArrayIndexOutOfBoundsException e) { - int capacity = sv.capacity; - sv.badIndex(index, capacity); - // Not reached. - return NIL; - } - } - return type_error(first, Symbol.SIMPLE_VECTOR); - } + public LispObject execute(LispObject first, LispObject second) { + if (first instanceof SimpleVector) { + final SimpleVector sv = (SimpleVector)first; + int index = Fixnum.getValue(second); + try { + return sv.data[index]; + } catch (ArrayIndexOutOfBoundsException e) { + int capacity = sv.capacity; + sv.badIndex(index, capacity); + // Not reached. + return NIL; + } + } + return type_error(first, Symbol.SIMPLE_VECTOR); + } }; // ### svset simple-vector index new-value => new-value @@ -409,23 +402,21 @@ public LispObject execute(LispObject first, LispObject second) { @Override public LispObject execute(LispObject first, LispObject second, - LispObject third) - - { - if (first instanceof SimpleVector) { - final SimpleVector sv = (SimpleVector)first; - int index = Fixnum.getValue(second); - try { - sv.data[index] = third; - return third; - } catch (ArrayIndexOutOfBoundsException e) { - int capacity = sv.capacity; - sv.badIndex(index, capacity); - // Not reached. - return NIL; - } - } - return type_error(first, Symbol.SIMPLE_VECTOR); + LispObject third) { + if (first instanceof SimpleVector) { + final SimpleVector sv = (SimpleVector)first; + int index = Fixnum.getValue(second); + try { + sv.data[index] = third; + return third; + } catch (ArrayIndexOutOfBoundsException e) { + int capacity = sv.capacity; + sv.badIndex(index, capacity); + // Not reached. + return NIL; + } + } + return type_error(first, Symbol.SIMPLE_VECTOR); } }; } From 3a04fba39b8d0ce24865ab411156a5beb50fc3ec Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Sun, 3 Sep 2023 14:09:03 +0200 Subject: [PATCH 02/36] Use SimpleVector(int) constructor for new SIMPLE-VECTOR --- src/org/armedbear/lisp/SimpleVector.java | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/src/org/armedbear/lisp/SimpleVector.java b/src/org/armedbear/lisp/SimpleVector.java index 66dd2767a..f6fda1f29 100644 --- a/src/org/armedbear/lisp/SimpleVector.java +++ b/src/org/armedbear/lisp/SimpleVector.java @@ -212,7 +212,7 @@ public void svset(int index, LispObject newValue) @Override public LispObject subseq(int start, int end) { - SimpleVector v = new SimpleVector(clazz, end - start); + SimpleVector v = new SimpleVector(end - start); int i = start, j = 0; try { @@ -270,7 +270,7 @@ public LispObject deleteEql(LispObject item) public void shrink(int n) { if (n < capacity) { - SimpleVector newArray = new SimpleVector(clazz, n); + SimpleVector newArray = new SimpleVector(n); System.arraycopy(data, 0, newArray.data, 0, n); data = (T[])newArray.data; capacity = n; @@ -283,9 +283,8 @@ public void shrink(int n) } @Override - public LispObject reverse() - { - SimpleVector result = new SimpleVector(clazz, capacity); + public LispObject reverse() { + SimpleVector result = new SimpleVector(capacity); int i, j; for (i = 0, j = capacity - 1; i < capacity; i++, j--) { result.data[i] = data[j]; From ace406975776610120cb8d111fc0c224641f68e0 Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Mon, 4 Sep 2023 07:47:36 +0200 Subject: [PATCH 03/36] Use system array copy SIMPLE-VECTOR for SUBSEQ --- src/org/armedbear/lisp/SimpleVector.java | 25 +++++++++++------------- 1 file changed, 11 insertions(+), 14 deletions(-) diff --git a/src/org/armedbear/lisp/SimpleVector.java b/src/org/armedbear/lisp/SimpleVector.java index f6fda1f29..04efa2425 100644 --- a/src/org/armedbear/lisp/SimpleVector.java +++ b/src/org/armedbear/lisp/SimpleVector.java @@ -36,7 +36,9 @@ import static org.armedbear.lisp.Lisp.*; import java.lang.reflect.Array; +import java.text.MessageFormat; import java.util.Arrays; +import java.text.MessageFormat; // "The type of a vector that is not displaced to another array, has no fill // pointer, is not expressly adjustable and is able to hold elements of any @@ -212,23 +214,18 @@ public void svset(int index, LispObject newValue) @Override public LispObject subseq(int start, int end) { - SimpleVector v = new SimpleVector(end - start); - int i = start, j = 0; - try - { - while (i < end) - v.data[j++] = data[i++]; - return v; - } - catch (ArrayIndexOutOfBoundsException e) - { - return error(new TypeError("Array index out of bounds: " + i + ".")); - } + try { + T[] subseq = Arrays.copyOfRange(data, start, end); + return new SimpleVector(subseq); + } catch (ArrayIndexOutOfBoundsException e) { + String m + = MessageFormat.format("The bounding indices {0} and {1} are bad for a sequence of length {2}.", start, end, length()); + return type_error(m, new JavaObject(e), NIL); // Not really a type_error, as there is not one type + } } @Override - public void fill(LispObject obj) - { + public void fill(LispObject obj) { Arrays.fill(data, (T) obj); } From 3da7bb3074a623f16af21650680fdd033e79be1a Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Mon, 4 Sep 2023 09:55:55 +0200 Subject: [PATCH 04/36] Adjust AbstractVector.badIndex() so it can be return'd --- src/org/armedbear/lisp/AbstractVector.java | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) diff --git a/src/org/armedbear/lisp/AbstractVector.java b/src/org/armedbear/lisp/AbstractVector.java index b2c51d82b..6951bc9d5 100644 --- a/src/org/armedbear/lisp/AbstractVector.java +++ b/src/org/armedbear/lisp/AbstractVector.java @@ -149,7 +149,7 @@ public int checkIndex(int index) return index; } - protected void badIndex(int index, int limit) + protected LispObject badIndex(int index, int limit) { StringBuilder sb = new StringBuilder("Invalid array index "); sb.append(index); @@ -161,12 +161,11 @@ protected void badIndex(int index, int limit) sb.append(limit); sb.append(")."); } - error(new TypeError(sb.toString(), - Fixnum.getInstance(index), - list(Symbol.INTEGER, - Fixnum.ZERO, - Fixnum.getInstance(limit - 1)))); - + return error(new TypeError(sb.toString(), + Fixnum.getInstance(index), + list(Symbol.INTEGER, + Fixnum.ZERO, + Fixnum.getInstance(limit - 1)))); } public void setFillPointer(int n) From 9ed1f9a580afc9882c009c9ef0ea3fbec6a80264 Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Mon, 4 Sep 2023 09:57:31 +0200 Subject: [PATCH 05/36] Remove final from SimpleVector so we can inherit --- src/org/armedbear/lisp/SimpleVector.java | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/src/org/armedbear/lisp/SimpleVector.java b/src/org/armedbear/lisp/SimpleVector.java index 04efa2425..0073a5ec0 100644 --- a/src/org/armedbear/lisp/SimpleVector.java +++ b/src/org/armedbear/lisp/SimpleVector.java @@ -43,7 +43,7 @@ // "The type of a vector that is not displaced to another array, has no fill // pointer, is not expressly adjustable and is able to hold elements of any // type is a subtype of type SIMPLE-VECTOR." -public final class SimpleVector extends AbstractVector +public class SimpleVector extends AbstractVector { int capacity; T[] data; @@ -305,6 +305,9 @@ public LispObject nreverse() return this; } + // + // TODO check logic on whether a SIMPLE-VECTOR should be adjustable + // @Override public AbstractVector adjustArray(int newCapacity, LispObject initialElement, From 7807899cde75a499270a46695669e91a21df8a3f Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Mon, 4 Sep 2023 09:58:22 +0200 Subject: [PATCH 06/36] Most of an implementation of BasicVectorBuffer for bytes INCOMPLETE: after finishing implementation, needs to be wired into MAKE-ARRAY to be useful. --- src/org/armedbear/lisp/BasicVectorBuffer.java | 224 ++++++++++++++++++ 1 file changed, 224 insertions(+) create mode 100644 src/org/armedbear/lisp/BasicVectorBuffer.java diff --git a/src/org/armedbear/lisp/BasicVectorBuffer.java b/src/org/armedbear/lisp/BasicVectorBuffer.java new file mode 100644 index 000000000..bcf1e37fd --- /dev/null +++ b/src/org/armedbear/lisp/BasicVectorBuffer.java @@ -0,0 +1,224 @@ +package org.armedbear.lisp; + +import static org.armedbear.lisp.Lisp.*; + +import java.nio.Buffer; +import java.nio.ByteBuffer; +import java.text.MessageFormat; +import java.util.Arrays; + +// A basic vector is a specialized vector that is not displaced to another +// array, has no fill pointer, and is not expressly adjustable. +public final class BasicVectorBuffer + extends SimpleVector +{ + boolean directAllocation; + T data; + + public BasicVectorBuffer(Class type, int capacity, boolean directAllocation) { + this.clazz = type; + this.capacity = capacity; + this.directAllocation = directAllocation; + data = (T) ByteBuffer.allocate(capacity); + } + + // public BasicVectorBuffer(int capacity) { + // this(ByteBuffer.class, capacity, false); + // } + + @Override + public LispObject classOf() { + if (clazz.equals(ByteBuffer.class)) { + return list(Symbol.SIMPLE_VECTOR, UNSIGNED_BYTE_8, new Cons(Fixnum.getInstance(capacity))); + } + return program_error("Unimplemented classOf()"); + } + + public LispObject getDescription() { + StringBuffer sb = new StringBuffer("A simple vector specialized on UNSIGNED_BYTE_8 with "); + sb.append(capacity); + sb.append(" elements"); + return new SimpleString(sb); + } + + public LispObject typep(LispObject type) + { + if (type == Symbol.SIMPLE_VECTOR) + return T; + if (type == Symbol.SIMPLE_ARRAY) + return T; + if (type == BuiltInClass.SIMPLE_VECTOR) + return T; + if (type == BuiltInClass.SIMPLE_ARRAY) + return T; + // TODO return type based on CLAZZ and capacity + if (type instanceof Cons) { + if (type.car().equals(Symbol.SIMPLE_VECTOR) + && type.cdr().equals(UNSIGNED_BYTE_8)) { + return T; + } + } + return super.typep(type); + } + + @Override + public LispObject getElementType() { + return UNSIGNED_BYTE_8; + // TODO return type based on CLAZZ + } + + @Override + public LispObject elt(int i) { + try { + // TODO switch on clazz + return coerceFromJavaByte(((ByteBuffer)data).get(i)); + } catch (ArrayIndexOutOfBoundsException e) { + return badIndex(i, capacity); + } + } + + @Override + public LispObject AREF(int i) { + return elt(i); + } + + @Override + public void aset(int i, LispObject n) { + aset(i, coerceToJavaByte(n)); + } + + public void aset(int i, byte n) { + try { + ((ByteBuffer)data).put(i, n); + } catch (IndexOutOfBoundsException e) { + badIndex(i, capacity); + } + } + + @Override + public LispObject SVREF(int i) { + return elt(i); + } + + @Override + public void svset(int i, LispObject newValue) { + aset(i, newValue); + } + + @Override + public LispObject subseq(int start, int end) { + try { + // TODO: switch on clazz + int length = start - end; + BasicVectorBuffer result + = new BasicVectorBuffer(ByteBuffer.class, length, this.directAllocation); + ((ByteBuffer)data).get(result.data.array(), start, length); + return result; + } catch (ArrayIndexOutOfBoundsException e) { + String m + = MessageFormat.format("The bounding indices {0} and {1} are bad for a sequence of length {2}.", start, end, length()); + return type_error(m, new JavaObject(e), NIL); // Not really a type_error, as there is not one type + } + } + + @Override + public void fill(LispObject obj) { // TODO switch on CLAZZ + byte b = coerceToJavaByte(obj); + fill(b); + } + + public void fill(byte b) { + Arrays.fill(((ByteBuffer)data).array(), b); + } + + + // TODO AbstractVector.deleteEq() could work, as well but is it faster? + @Override + public LispObject deleteEq(LispObject item) { + byte b = coerceToJavaByte(item); + return deleteEq(b); + } + + public LispObject deleteEq(byte b) { + final int limit = capacity; + int i = 0; + int j = 0; + ByteBuffer buffer = (ByteBuffer) data; + while (i < limit) { + byte value = buffer.get(i++); + if (value != b) { + buffer.put(j++, value); + } + } + if (j < limit) { + shrink(j); + } + return this; + } + + // + // TODO check on use of AbstractVector.deleteEql() + // + + @Override + public void shrink(int n) { + if (n < capacity) { + // thunk on CLAZZ + BasicVectorBuffer result + = new BasicVectorBuffer(ByteBuffer.class, n, this.directAllocation); + ((ByteBuffer)data).get(result.data.array(), 0, n); + capacity = n; + return; + } + if (n == capacity) { + return; + } + error(new LispError()); + } + + @Override + public LispObject reverse() { + // thunk on CLAZZ + BasicVectorBuffer result + = new BasicVectorBuffer(ByteBuffer.class, capacity, this.directAllocation); + + int i, j; + ByteBuffer source = (ByteBuffer)data; + ByteBuffer destination = (ByteBuffer)result.data; + for (i = 0, j = capacity - 1; i < capacity; i++, j--) { + destination.put(i, source.get(j)); + } + return result; + } + + @Override + public LispObject nreverse() { + int i = 0; + int j = capacity() - 1; + ByteBuffer buffer = (ByteBuffer)data; + while (i < j) { + byte temp = buffer.get(i); + buffer.put(i, buffer.get(j)); + buffer.put(j, temp); + ++i; + --j; + } + return this; + } + + public AbstractVector replace(AbstractVector source, + int targetStart, int targetEnd, + int sourceStart, int sourceEnd) + { + if (source instanceof BasicVectorBuffer) { + byte[] sourceBytes = (byte[]) ((BasicVectorBuffer)source).data.array(); + System.arraycopy(sourceBytes, sourceStart, + data.array(), targetStart, + Math.min(targetEnd - targetStart, sourceEnd - sourceStart)); + return this; + } else { + return super.replace(source, targetStart, targetEnd, sourceStart, sourceEnd); + } + } +} + From a90dff74f00a2dffdb21ed74a972585a5ce11000 Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Mon, 4 Sep 2023 10:22:14 +0200 Subject: [PATCH 07/36] Add missing SimpleVector no-arg constructor --- src/org/armedbear/lisp/SimpleVector.java | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/org/armedbear/lisp/SimpleVector.java b/src/org/armedbear/lisp/SimpleVector.java index 0073a5ec0..c06427238 100644 --- a/src/org/armedbear/lisp/SimpleVector.java +++ b/src/org/armedbear/lisp/SimpleVector.java @@ -49,6 +49,10 @@ public class SimpleVector extends AbstractVector T[] data; Class clazz; + public SimpleVector() { + super(); + } + public SimpleVector(int capacity) { this(LispObject.class, capacity); } From b8ff2fbc0e78b3069997baf936b56a922ba71872 Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Mon, 4 Sep 2023 10:26:49 +0200 Subject: [PATCH 08/36] Fix SimpleVector classOf()/typeOf() --- src/org/armedbear/lisp/BasicVectorBuffer.java | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) diff --git a/src/org/armedbear/lisp/BasicVectorBuffer.java b/src/org/armedbear/lisp/BasicVectorBuffer.java index bcf1e37fd..7ba99b817 100644 --- a/src/org/armedbear/lisp/BasicVectorBuffer.java +++ b/src/org/armedbear/lisp/BasicVectorBuffer.java @@ -22,12 +22,8 @@ public BasicVectorBuffer(Class type, int capacity, boolean directAll data = (T) ByteBuffer.allocate(capacity); } - // public BasicVectorBuffer(int capacity) { - // this(ByteBuffer.class, capacity, false); - // } - @Override - public LispObject classOf() { + public LispObject typeOf() { if (clazz.equals(ByteBuffer.class)) { return list(Symbol.SIMPLE_VECTOR, UNSIGNED_BYTE_8, new Cons(Fixnum.getInstance(capacity))); } From 3e2df5ec33c9d64b38098b084a8b32cb1baf08a5 Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Mon, 4 Sep 2023 16:33:13 +0200 Subject: [PATCH 09/36] Add static constant for UNSIGNED_BYTE_64 --- src/org/armedbear/lisp/Lisp.java | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/org/armedbear/lisp/Lisp.java b/src/org/armedbear/lisp/Lisp.java index 3c0dec995..aba75acaa 100644 --- a/src/org/armedbear/lisp/Lisp.java +++ b/src/org/armedbear/lisp/Lisp.java @@ -1673,6 +1673,9 @@ public static final boolean isValidMacroFunctionName(LispObject obj) public static final LispObject UNSIGNED_BYTE_32 = list(Symbol.UNSIGNED_BYTE, Fixnum.constants[32]); + public static final LispObject UNSIGNED_BYTE_64 = + list(Symbol.UNSIGNED_BYTE, Fixnum.constants[64]); + public static final LispObject UNSIGNED_BYTE_32_MAX_VALUE = Bignum.getInstance(4294967295L); From 210d033542a5cf004ec87b650142cb5be24e1cda Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Mon, 4 Sep 2023 16:33:43 +0200 Subject: [PATCH 10/36] Minor BasicVectorBuffer adjustments --- src/org/armedbear/lisp/BasicVectorBuffer.java | 15 +++------------ 1 file changed, 3 insertions(+), 12 deletions(-) diff --git a/src/org/armedbear/lisp/BasicVectorBuffer.java b/src/org/armedbear/lisp/BasicVectorBuffer.java index 7ba99b817..3e7007e94 100644 --- a/src/org/armedbear/lisp/BasicVectorBuffer.java +++ b/src/org/armedbear/lisp/BasicVectorBuffer.java @@ -27,7 +27,7 @@ public LispObject typeOf() { if (clazz.equals(ByteBuffer.class)) { return list(Symbol.SIMPLE_VECTOR, UNSIGNED_BYTE_8, new Cons(Fixnum.getInstance(capacity))); } - return program_error("Unimplemented classOf()"); + return program_error("Unimplemented typeOf()"); } public LispObject getDescription() { @@ -37,17 +37,8 @@ public LispObject getDescription() { return new SimpleString(sb); } - public LispObject typep(LispObject type) - { - if (type == Symbol.SIMPLE_VECTOR) - return T; - if (type == Symbol.SIMPLE_ARRAY) - return T; - if (type == BuiltInClass.SIMPLE_VECTOR) - return T; - if (type == BuiltInClass.SIMPLE_ARRAY) - return T; - // TODO return type based on CLAZZ and capacity + public LispObject typep(LispObject type) { + // FIXME type based on CLAZZ and capacity if (type instanceof Cons) { if (type.car().equals(Symbol.SIMPLE_VECTOR) && type.cdr().equals(UNSIGNED_BYTE_8)) { From 700f430a5ac73d38a75950f1b9225347506ace6b Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Mon, 4 Sep 2023 16:34:06 +0200 Subject: [PATCH 11/36] Minor SimpleVector tweaks --- src/org/armedbear/lisp/SimpleVector.java | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/src/org/armedbear/lisp/SimpleVector.java b/src/org/armedbear/lisp/SimpleVector.java index c06427238..e9dc79e57 100644 --- a/src/org/armedbear/lisp/SimpleVector.java +++ b/src/org/armedbear/lisp/SimpleVector.java @@ -105,7 +105,7 @@ public LispObject getDescription() { StringBuffer sb = new StringBuffer("A simple vector with "); sb.append(capacity); - sb.append(" elements"); + sb.append(" elements."); return new SimpleString(sb); } @@ -390,9 +390,7 @@ public LispObject execute(LispObject first, LispObject second) { return sv.data[index]; } catch (ArrayIndexOutOfBoundsException e) { int capacity = sv.capacity; - sv.badIndex(index, capacity); - // Not reached. - return NIL; + return sv.badIndex(index, capacity); } } return type_error(first, Symbol.SIMPLE_VECTOR); From 918f68723b0003f5e95b3691bf2835e7f3992685 Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Mon, 4 Sep 2023 16:34:18 +0200 Subject: [PATCH 12/36] Implementation for vectors specialized on primitive types --- .../armedbear/lisp/BasicVectorPrimitive.java | 105 ++++++++++++++++++ 1 file changed, 105 insertions(+) create mode 100644 src/org/armedbear/lisp/BasicVectorPrimitive.java diff --git a/src/org/armedbear/lisp/BasicVectorPrimitive.java b/src/org/armedbear/lisp/BasicVectorPrimitive.java new file mode 100644 index 000000000..09f747952 --- /dev/null +++ b/src/org/armedbear/lisp/BasicVectorPrimitive.java @@ -0,0 +1,105 @@ +package org.armedbear.lisp; + +import static org.armedbear.lisp.Lisp.*; + +import java.lang.reflect.Array; +import java.nio.Buffer; + +// A basic vector is a specialized vector that is not displaced to another +// array, has no fill pointer, and is not expressly adjustable. +public final class BasicVectorPrimitive extends SimpleVector { + T[] data; + Class type; + + public BasicVectorPrimitive(Class type, int capacity) { + super(capacity); + this.type = type; + data = (T[]) Array.newInstance(type, capacity); + } + + public LispObject typeOf() { + if (type.equals(Byte.class)) { + return list(Symbol.SIMPLE_VECTOR, UNSIGNED_BYTE_8, new Cons(Fixnum.getInstance(capacity))); + } else if (type.equals(Short.class)) { + return list(Symbol.SIMPLE_VECTOR, UNSIGNED_BYTE_16, new Cons(Fixnum.getInstance(capacity))); + } else if (type.equals(Integer.class)) { + return list(Symbol.SIMPLE_VECTOR, UNSIGNED_BYTE_32, new Cons(Fixnum.getInstance(capacity))); + } else if (type.equals(Long.class)) { + return list(Symbol.SIMPLE_VECTOR, UNSIGNED_BYTE_64, new Cons(Fixnum.getInstance(capacity))); + } + return program_error("BasicVectorPrimitive couldn't determine type."); + } + + //public LispObject classOf() + + // public LispObject getDescription() { + // StringBuffer sb = new StringBuffer(super.getDescription().toString()); + + public LispObject typep(LispObject type) { + if (type instanceof Cons) { + if (type.car().equals(Symbol.SIMPLE_VECTOR) + && (type.cdr().equals(UNSIGNED_BYTE_8) + || (type.cdr().equals(UNSIGNED_BYTE_16)) + || (type.cdr().equals(UNSIGNED_BYTE_32)) + || (type.cdr().equals(UNSIGNED_BYTE_64)))) { + return T; + } + } + return super.typep(type); + } + + @Override + public LispObject getElementType() { + if (type.equals(Byte.class)) { + return UNSIGNED_BYTE_8; + } else if (type.equals(Short.class)) { + return UNSIGNED_BYTE_16; + } else if (type.equals(Integer.class)) { + return UNSIGNED_BYTE_32; + } else if (type.equals(Long.class)) { + return UNSIGNED_BYTE_64; + } + return program_error("Unknown element type: " + type); + } + + // do these work? + // public LispObject elt(int index) + // public LispObject AREF(int index) + // public LispObject SVREF(int index) + // public void svset(int index, LispObject newValue) + // public LispObject subseq(int start, int end) + // public void fill(LispObject obj) { + + + // public LispObject deleteEq(LispObject item) + // public LispObject deleteEql(LispObject item) + + + public void shrink(int n) { + if (n < capacity) { + BasicVectorPrimitive newArray = new BasicVectorPrimitive<>(type, n); + System.arraycopy(data, 0, newArray.data, 0, n); + data = (T[])newArray.data; + capacity = n; + return; + } + if (n == capacity) { + return; + } + error(new LispError()); + } + + public LispObject reverse() { + BasicVectorPrimitive result = new BasicVectorPrimitive<>(type, capacity); + int i, j; + for (i = 0, j = capacity - 1; i < capacity; i++, j--) { + result.data[i] = data[j]; + } + return result; + } + // public LispObject nreverse() + + //public AbstractVector adjustArray + // public AbstractVector adjustArray(int newCapacity, AbstractArray displacedTo, int displacement) + +} From fc78243a21b00ae48242550d84363074114c8b3e Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Mon, 4 Sep 2023 16:56:24 +0200 Subject: [PATCH 13/36] Fix BasicVectorPrimitive.typep() --- src/org/armedbear/lisp/BasicVectorPrimitive.java | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) diff --git a/src/org/armedbear/lisp/BasicVectorPrimitive.java b/src/org/armedbear/lisp/BasicVectorPrimitive.java index 09f747952..891998e42 100644 --- a/src/org/armedbear/lisp/BasicVectorPrimitive.java +++ b/src/org/armedbear/lisp/BasicVectorPrimitive.java @@ -38,10 +38,7 @@ public LispObject typeOf() { public LispObject typep(LispObject type) { if (type instanceof Cons) { if (type.car().equals(Symbol.SIMPLE_VECTOR) - && (type.cdr().equals(UNSIGNED_BYTE_8) - || (type.cdr().equals(UNSIGNED_BYTE_16)) - || (type.cdr().equals(UNSIGNED_BYTE_32)) - || (type.cdr().equals(UNSIGNED_BYTE_64)))) { + && (type.cdr().equals(getElementType()))) { return T; } } From 97981fe53a1c5c220fccab01da180494446a2751 Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Tue, 5 Sep 2023 10:00:24 +0200 Subject: [PATCH 14/36] Implement coerceToJavaUnsignedShort --- src/org/armedbear/lisp/Lisp.java | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/org/armedbear/lisp/Lisp.java b/src/org/armedbear/lisp/Lisp.java index aba75acaa..dee073f1f 100644 --- a/src/org/armedbear/lisp/Lisp.java +++ b/src/org/armedbear/lisp/Lisp.java @@ -1812,6 +1812,10 @@ public static final byte coerceToJavaByte(LispObject obj) { return (byte)Fixnum.getValue(obj); } + public static final short coerceToJavaUnsignedShort(LispObject obj) { + return (short) (obj.longValue() & 0xffffL); + } + public static final int coerceToJavaUnsignedInt(LispObject obj) { return (int) (obj.longValue() & 0xffffffffL); } From d0588f04aaacd728de9027b8acf76bff1accc07f Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Tue, 5 Sep 2023 10:00:55 +0200 Subject: [PATCH 15/36] Implement an inefficient conversion of unsigned 64 bit --- src/org/armedbear/lisp/LispInteger.java | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/src/org/armedbear/lisp/LispInteger.java b/src/org/armedbear/lisp/LispInteger.java index 62e780c1c..e952b1946 100644 --- a/src/org/armedbear/lisp/LispInteger.java +++ b/src/org/armedbear/lisp/LispInteger.java @@ -50,5 +50,10 @@ public static LispInteger getInstance(int i) { return Fixnum.getInstance(i); } - + public static LispInteger getUnsignedInstance(long l) { + if (Long.signum(l) == -1) { + return Bignum.getInstance(Long.toUnsignedString(l), 10); // TOOD faster with bytes arithimetic + } + return getInstance(l); + } } From 49dbbe753b879ada4126d8bf4a762942b48fac98 Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Tue, 5 Sep 2023 10:01:52 +0200 Subject: [PATCH 16/36] Further work on SimpleVector specializations --- src/org/armedbear/lisp/BasicVectorBuffer.java | 210 ++++++++++++++---- .../armedbear/lisp/BasicVectorPrimitive.java | 1 - src/org/armedbear/lisp/SimpleVector.java | 6 +- 3 files changed, 173 insertions(+), 44 deletions(-) diff --git a/src/org/armedbear/lisp/BasicVectorBuffer.java b/src/org/armedbear/lisp/BasicVectorBuffer.java index 3e7007e94..3b65616b4 100644 --- a/src/org/armedbear/lisp/BasicVectorBuffer.java +++ b/src/org/armedbear/lisp/BasicVectorBuffer.java @@ -4,34 +4,99 @@ import java.nio.Buffer; import java.nio.ByteBuffer; +import java.nio.IntBuffer; +import java.nio.LongBuffer; +import java.nio.ShortBuffer; import java.text.MessageFormat; import java.util.Arrays; // A basic vector is a specialized vector that is not displaced to another // array, has no fill pointer, and is not expressly adjustable. -public final class BasicVectorBuffer +public final class BasicVectorBuffer extends SimpleVector { - boolean directAllocation; - T data; + // boolean directAllocation; directly allocate Buffer don't have backing arrays + Buffer data; + BufferType specialization; + + public enum BufferType { + BYTE, SHORT, INT, LONG + } - public BasicVectorBuffer(Class type, int capacity, boolean directAllocation) { - this.clazz = type; + public BasicVectorBuffer(Class type, int capacity) { + this.type = type; this.capacity = capacity; - this.directAllocation = directAllocation; - data = (T) ByteBuffer.allocate(capacity); + if (type.equals(ByteBuffer.class)) { + specialization = BufferType.BYTE; + } else if (type.equals(ShortBuffer.class)) { + specialization = BufferType.SHORT; + } else if (type.equals(IntBuffer.class)) { + specialization = BufferType.INT; + } else if (type.equals(LongBuffer.class)) { + specialization = BufferType.LONG; + } + switch (specialization) { + case BYTE: + data = ByteBuffer.allocate(capacity); + break; + case SHORT: + data = ShortBuffer.allocate(capacity); + break; + case INT: + data = IntBuffer.allocate(capacity); + break; + case LONG: + data = LongBuffer.allocate(capacity); + break; + } + } + + public byte[] asByteArray() { + return (byte[])((ByteBuffer)data).array(); } + public short[] asShortArray() { + return (short[])((ShortBuffer)data).array(); + } + public int[] asIntArray() { + return (int[])((IntBuffer)data).array(); + } + public long[] asLongArray() { + return (long[])((LongBuffer)data).array(); + } + @Override public LispObject typeOf() { - if (clazz.equals(ByteBuffer.class)) { + switch (specialization) { + case BYTE: return list(Symbol.SIMPLE_VECTOR, UNSIGNED_BYTE_8, new Cons(Fixnum.getInstance(capacity))); + case SHORT: + return list(Symbol.SIMPLE_VECTOR, UNSIGNED_BYTE_16, new Cons(Fixnum.getInstance(capacity))); + case INT: + return list(Symbol.SIMPLE_VECTOR, UNSIGNED_BYTE_32, new Cons(Fixnum.getInstance(capacity))); + case LONG: + return list(Symbol.SIMPLE_VECTOR, UNSIGNED_BYTE_64, new Cons(Fixnum.getInstance(capacity))); } - return program_error("Unimplemented typeOf()"); + return program_error("Unreachable"); } public LispObject getDescription() { - StringBuffer sb = new StringBuffer("A simple vector specialized on UNSIGNED_BYTE_8 with "); + StringBuffer sb = new StringBuffer("A simple vector specialized on "); + switch (specialization) { + case BYTE: + sb.append("(UNSIGNED-BYTE 8)"); + break; + case SHORT: + sb.append("(UNSIGNED-BYTE 16)"); + break; + case INT: + sb.append("(UNSIGNED-BYTE 32)"); + break; + case LONG: + sb.append("(UNSIGNED-BYTE 64)"); + break; + } + sb.append(" with "); sb.append(capacity); sb.append(" elements"); return new SimpleString(sb); @@ -40,43 +105,95 @@ public LispObject getDescription() { public LispObject typep(LispObject type) { // FIXME type based on CLAZZ and capacity if (type instanceof Cons) { - if (type.car().equals(Symbol.SIMPLE_VECTOR) - && type.cdr().equals(UNSIGNED_BYTE_8)) { - return T; + if (type.car().equals(Symbol.SIMPLE_VECTOR)) { + LispObject vectorType = type.cdr(); + switch (specialization) { + case BYTE: + if (vectorType.equals(UNSIGNED_BYTE_8)) { + return T; + } + break; + case SHORT: + if (vectorType.equals(UNSIGNED_BYTE_16)) { + return T; + } + break; + case INT: + if (vectorType.equals(UNSIGNED_BYTE_32)) { + return T; + } + break; + case LONG: + if (vectorType.equals(UNSIGNED_BYTE_64)) { + return T; + } + break; + } } } return super.typep(type); } @Override - public LispObject getElementType() { - return UNSIGNED_BYTE_8; - // TODO return type based on CLAZZ + public LispObject getElementType() { + if (type.equals(ByteBuffer.class)) { + return UNSIGNED_BYTE_8; + } else if (type.equals(ShortBuffer.class)) { + return UNSIGNED_BYTE_16; + } else if (type.equals(IntBuffer.class)) { + return UNSIGNED_BYTE_32; + } else if (type.equals(LongBuffer.class)) { + return UNSIGNED_BYTE_64; + } + return super.getElementType(); } @Override public LispObject elt(int i) { - try { - // TODO switch on clazz - return coerceFromJavaByte(((ByteBuffer)data).get(i)); - } catch (ArrayIndexOutOfBoundsException e) { - return badIndex(i, capacity); - } + return AREF(i); } @Override public LispObject AREF(int i) { - return elt(i); + try { + switch (specialization) { + case BYTE: + return coerceFromJavaByte(((ByteBuffer)data).get(i)); + case SHORT: + return Fixnum.getInstance(Short.toUnsignedInt(((ShortBuffer)data).get(i))); + case INT: + return Fixnum.getInstance(Integer.toUnsignedLong(((IntBuffer)data).get(i))); + case LONG: + return LispInteger.getUnsignedInstance(((LongBuffer)data).get(i)); + } + return program_error("Bad ELT in BasicVectorBuffer."); + } catch (ArrayIndexOutOfBoundsException e) { + return badIndex(i, capacity); + } } @Override public void aset(int i, LispObject n) { - aset(i, coerceToJavaByte(n)); - } - - public void aset(int i, byte n) { try { - ((ByteBuffer)data).put(i, n); + switch (specialization) { + case BYTE: + byte b = coerceToJavaByte(n); + ((ByteBuffer)data).put(i, b); + break; + case SHORT: + short s = coerceToJavaUnsignedShort(n); + ((ShortBuffer)data).put(i, s); + break; + case INT: + int v = coerceToJavaUnsignedInt(n); + ((IntBuffer)data).put(i, v); + break; + case LONG: + // long v = ??? + // ((IntBuffer)data).put(i, v); + program_error("Unimplemented aset on long"); + break; + } } catch (IndexOutOfBoundsException e) { badIndex(i, capacity); } @@ -84,7 +201,7 @@ public void aset(int i, byte n) { @Override public LispObject SVREF(int i) { - return elt(i); + return AREF(i); } @Override @@ -94,12 +211,27 @@ public void svset(int i, LispObject newValue) { @Override public LispObject subseq(int start, int end) { + int length = start - end; try { - // TODO: switch on clazz - int length = start - end; - BasicVectorBuffer result - = new BasicVectorBuffer(ByteBuffer.class, length, this.directAllocation); - ((ByteBuffer)data).get(result.data.array(), start, length); + BasicVectorBuffer result = null; + switch (specialization) { + case BYTE: + result = new BasicVectorBuffer(ByteBuffer.class, length); + ((ByteBuffer)data).get(result.asByteArray(), start, length); + break; + case SHORT: + result = new BasicVectorBuffer(ShortBuffer.class, length); + ((ShortBuffer)data).get(result.asShortArray(), start, length); + break; + case INT: + result = new BasicVectorBuffer(IntBuffer.class, length); + ((IntBuffer)data).get(result.asIntArray(), start, length); + break; + case LONG: + result = new BasicVectorBuffer(LongBuffer.class, length); + ((LongBuffer)data).get(result.asLongArray(), start, length); + break; + } return result; } catch (ArrayIndexOutOfBoundsException e) { String m @@ -151,9 +283,9 @@ public LispObject deleteEq(byte b) { public void shrink(int n) { if (n < capacity) { // thunk on CLAZZ - BasicVectorBuffer result - = new BasicVectorBuffer(ByteBuffer.class, n, this.directAllocation); - ((ByteBuffer)data).get(result.data.array(), 0, n); + BasicVectorBuffer result + = new BasicVectorBuffer(ByteBuffer.class, n); + ((ByteBuffer)data).get(result.asByteArray(), 0, n); capacity = n; return; } @@ -166,8 +298,8 @@ public void shrink(int n) { @Override public LispObject reverse() { // thunk on CLAZZ - BasicVectorBuffer result - = new BasicVectorBuffer(ByteBuffer.class, capacity, this.directAllocation); + BasicVectorBuffer result + = new BasicVectorBuffer(ByteBuffer.class, capacity); int i, j; ByteBuffer source = (ByteBuffer)data; diff --git a/src/org/armedbear/lisp/BasicVectorPrimitive.java b/src/org/armedbear/lisp/BasicVectorPrimitive.java index 891998e42..d28c3142e 100644 --- a/src/org/armedbear/lisp/BasicVectorPrimitive.java +++ b/src/org/armedbear/lisp/BasicVectorPrimitive.java @@ -12,7 +12,6 @@ public final class BasicVectorPrimitive extends SimpleVector { Class type; public BasicVectorPrimitive(Class type, int capacity) { - super(capacity); this.type = type; data = (T[]) Array.newInstance(type, capacity); } diff --git a/src/org/armedbear/lisp/SimpleVector.java b/src/org/armedbear/lisp/SimpleVector.java index e9dc79e57..f4098f9da 100644 --- a/src/org/armedbear/lisp/SimpleVector.java +++ b/src/org/armedbear/lisp/SimpleVector.java @@ -47,10 +47,9 @@ public class SimpleVector extends AbstractVector { int capacity; T[] data; - Class clazz; + Class type; public SimpleVector() { - super(); } public SimpleVector(int capacity) { @@ -58,8 +57,7 @@ public SimpleVector(int capacity) { } public SimpleVector(Class type, int capacity) { - // data = new LispObject[capacity]; - this.clazz = type; + this.type = type; this.capacity = capacity; data = (T[]) Array.newInstance(type, capacity); // for (int i = capacity; i-- > 0;) { From 8695308ffc406efdbe56fcfd721563d7693f3c0c Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Tue, 5 Sep 2023 16:25:21 +0200 Subject: [PATCH 17/36] Method to convert a Lisp integer to an "unsigned" Java long --- src/org/armedbear/lisp/LispInteger.java | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/org/armedbear/lisp/LispInteger.java b/src/org/armedbear/lisp/LispInteger.java index e952b1946..df4a178b2 100644 --- a/src/org/armedbear/lisp/LispInteger.java +++ b/src/org/armedbear/lisp/LispInteger.java @@ -56,4 +56,11 @@ public static LispInteger getUnsignedInstance(long l) { } return getInstance(l); } + + public static long asUnsignedLong(LispInteger i) { + if (i instanceof Bignum) { + return ((Bignum)i).value.longValue(); + } + return i.longValue(); + } } From 39d4ba07ae32a7d34602a27fef67057b70c89b84 Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Tue, 5 Sep 2023 16:25:55 +0200 Subject: [PATCH 18/36] BasicVectorPrimitive might be complete enough to be wired in --- src/org/armedbear/lisp/BasicVector.java | 93 +++++ src/org/armedbear/lisp/BasicVectorBuffer.java | 130 ++---- .../armedbear/lisp/BasicVectorPrimitive.java | 369 +++++++++++++++--- src/org/armedbear/lisp/SimpleVector.java | 79 ++-- 4 files changed, 465 insertions(+), 206 deletions(-) create mode 100644 src/org/armedbear/lisp/BasicVector.java diff --git a/src/org/armedbear/lisp/BasicVector.java b/src/org/armedbear/lisp/BasicVector.java new file mode 100644 index 000000000..c37baf6a3 --- /dev/null +++ b/src/org/armedbear/lisp/BasicVector.java @@ -0,0 +1,93 @@ +package org.armedbear.lisp; + +import static org.armedbear.lisp.Lisp.*; + +public class BasicVector + extends SimpleVector +{ + public enum Specialization { + U8, U16, U32, U64 + } + Specialization specializedOn; + + public BasicVector(Class type) { + if (type.equals(Byte.class)) { + specializedOn = Specialization.U8; + } else if (type.equals(Short.class)) { + specializedOn = Specialization.U16; + } else if (type.equals(Integer.class)) { + specializedOn = Specialization.U32; + } else if (type.equals(Long.class)) { + specializedOn = Specialization.U64; + } + } + + public BasicVector(Class type, int capacity) { + this(type); + this.capacity = capacity; + } + + @Override + public LispObject typeOf() { + switch (specializedOn) { + case U8: + return list(Symbol.SIMPLE_VECTOR, UNSIGNED_BYTE_8, new Cons(Fixnum.getInstance(capacity))); + case U16: + return list(Symbol.SIMPLE_VECTOR, UNSIGNED_BYTE_16, new Cons(Fixnum.getInstance(capacity))); + case U32: + return list(Symbol.SIMPLE_VECTOR, UNSIGNED_BYTE_32, new Cons(Fixnum.getInstance(capacity))); + case U64: + return list(Symbol.SIMPLE_VECTOR, UNSIGNED_BYTE_64, new Cons(Fixnum.getInstance(capacity))); + } + return program_error("Unreachable"); + } + + public LispObject typep(LispObject type) { + if (type instanceof Cons) { + if (type.car().equals(Symbol.SIMPLE_VECTOR)) { + LispObject vectorType = type.cdr(); + switch (specializedOn) { + case U8: + if (vectorType.equals(UNSIGNED_BYTE_8)) { + return T; + } + break; + case U16: + if (vectorType.equals(UNSIGNED_BYTE_16)) { + return T; + } + break; + case U32: + if (vectorType.equals(UNSIGNED_BYTE_32)) { + return T; + } + break; + case U64: + if (vectorType.equals(UNSIGNED_BYTE_64)) { + return T; + } + break; + } + } + } + return super.typep(type); + } + + @Override + public LispObject getElementType() { + switch (specializedOn) { + case U8: + return UNSIGNED_BYTE_8; + case U16: + return UNSIGNED_BYTE_16; + case U32: + return UNSIGNED_BYTE_32; + case U64: + return UNSIGNED_BYTE_64; + } + return program_error("Unknown element type: " + type); + } + + + +} diff --git a/src/org/armedbear/lisp/BasicVectorBuffer.java b/src/org/armedbear/lisp/BasicVectorBuffer.java index 3b65616b4..6bdbfa19f 100644 --- a/src/org/armedbear/lisp/BasicVectorBuffer.java +++ b/src/org/armedbear/lisp/BasicVectorBuffer.java @@ -13,39 +13,24 @@ // A basic vector is a specialized vector that is not displaced to another // array, has no fill pointer, and is not expressly adjustable. public final class BasicVectorBuffer - extends SimpleVector + extends BasicVector { // boolean directAllocation; directly allocate Buffer don't have backing arrays Buffer data; - BufferType specialization; - public enum BufferType { - BYTE, SHORT, INT, LONG - } - public BasicVectorBuffer(Class type, int capacity) { - this.type = type; - this.capacity = capacity; - if (type.equals(ByteBuffer.class)) { - specialization = BufferType.BYTE; - } else if (type.equals(ShortBuffer.class)) { - specialization = BufferType.SHORT; - } else if (type.equals(IntBuffer.class)) { - specialization = BufferType.INT; - } else if (type.equals(LongBuffer.class)) { - specialization = BufferType.LONG; - } - switch (specialization) { - case BYTE: + super(type, capacity); + switch (specializedOn) { + case U8: data = ByteBuffer.allocate(capacity); break; - case SHORT: + case U16: data = ShortBuffer.allocate(capacity); break; - case INT: + case U32: data = IntBuffer.allocate(capacity); break; - case LONG: + case U64: data = LongBuffer.allocate(capacity); break; } @@ -63,36 +48,20 @@ public int[] asIntArray() { public long[] asLongArray() { return (long[])((LongBuffer)data).array(); } - - - @Override - public LispObject typeOf() { - switch (specialization) { - case BYTE: - return list(Symbol.SIMPLE_VECTOR, UNSIGNED_BYTE_8, new Cons(Fixnum.getInstance(capacity))); - case SHORT: - return list(Symbol.SIMPLE_VECTOR, UNSIGNED_BYTE_16, new Cons(Fixnum.getInstance(capacity))); - case INT: - return list(Symbol.SIMPLE_VECTOR, UNSIGNED_BYTE_32, new Cons(Fixnum.getInstance(capacity))); - case LONG: - return list(Symbol.SIMPLE_VECTOR, UNSIGNED_BYTE_64, new Cons(Fixnum.getInstance(capacity))); - } - return program_error("Unreachable"); - } public LispObject getDescription() { StringBuffer sb = new StringBuffer("A simple vector specialized on "); - switch (specialization) { - case BYTE: + switch (specializedOn) { + case U8: sb.append("(UNSIGNED-BYTE 8)"); break; - case SHORT: + case U16: sb.append("(UNSIGNED-BYTE 16)"); break; - case INT: + case U32: sb.append("(UNSIGNED-BYTE 32)"); break; - case LONG: + case U64: sb.append("(UNSIGNED-BYTE 64)"); break; } @@ -102,51 +71,6 @@ public LispObject getDescription() { return new SimpleString(sb); } - public LispObject typep(LispObject type) { - // FIXME type based on CLAZZ and capacity - if (type instanceof Cons) { - if (type.car().equals(Symbol.SIMPLE_VECTOR)) { - LispObject vectorType = type.cdr(); - switch (specialization) { - case BYTE: - if (vectorType.equals(UNSIGNED_BYTE_8)) { - return T; - } - break; - case SHORT: - if (vectorType.equals(UNSIGNED_BYTE_16)) { - return T; - } - break; - case INT: - if (vectorType.equals(UNSIGNED_BYTE_32)) { - return T; - } - break; - case LONG: - if (vectorType.equals(UNSIGNED_BYTE_64)) { - return T; - } - break; - } - } - } - return super.typep(type); - } - - @Override - public LispObject getElementType() { - if (type.equals(ByteBuffer.class)) { - return UNSIGNED_BYTE_8; - } else if (type.equals(ShortBuffer.class)) { - return UNSIGNED_BYTE_16; - } else if (type.equals(IntBuffer.class)) { - return UNSIGNED_BYTE_32; - } else if (type.equals(LongBuffer.class)) { - return UNSIGNED_BYTE_64; - } - return super.getElementType(); - } @Override public LispObject elt(int i) { @@ -156,14 +80,14 @@ public LispObject elt(int i) { @Override public LispObject AREF(int i) { try { - switch (specialization) { - case BYTE: + switch (specializedOn) { + case U8: return coerceFromJavaByte(((ByteBuffer)data).get(i)); - case SHORT: + case U16: return Fixnum.getInstance(Short.toUnsignedInt(((ShortBuffer)data).get(i))); - case INT: + case U32: return Fixnum.getInstance(Integer.toUnsignedLong(((IntBuffer)data).get(i))); - case LONG: + case U64: return LispInteger.getUnsignedInstance(((LongBuffer)data).get(i)); } return program_error("Bad ELT in BasicVectorBuffer."); @@ -175,20 +99,20 @@ public LispObject AREF(int i) { @Override public void aset(int i, LispObject n) { try { - switch (specialization) { - case BYTE: + switch (specializedOn) { + case U8: byte b = coerceToJavaByte(n); ((ByteBuffer)data).put(i, b); break; - case SHORT: + case U16: short s = coerceToJavaUnsignedShort(n); ((ShortBuffer)data).put(i, s); break; - case INT: + case U32: int v = coerceToJavaUnsignedInt(n); ((IntBuffer)data).put(i, v); break; - case LONG: + case U64: // long v = ??? // ((IntBuffer)data).put(i, v); program_error("Unimplemented aset on long"); @@ -214,20 +138,20 @@ public LispObject subseq(int start, int end) { int length = start - end; try { BasicVectorBuffer result = null; - switch (specialization) { - case BYTE: + switch (specializedOn) { + case U8: result = new BasicVectorBuffer(ByteBuffer.class, length); ((ByteBuffer)data).get(result.asByteArray(), start, length); break; - case SHORT: + case U16: result = new BasicVectorBuffer(ShortBuffer.class, length); ((ShortBuffer)data).get(result.asShortArray(), start, length); break; - case INT: + case U32: result = new BasicVectorBuffer(IntBuffer.class, length); ((IntBuffer)data).get(result.asIntArray(), start, length); break; - case LONG: + case U64: result = new BasicVectorBuffer(LongBuffer.class, length); ((LongBuffer)data).get(result.asLongArray(), start, length); break; diff --git a/src/org/armedbear/lisp/BasicVectorPrimitive.java b/src/org/armedbear/lisp/BasicVectorPrimitive.java index d28c3142e..29dee2e99 100644 --- a/src/org/armedbear/lisp/BasicVectorPrimitive.java +++ b/src/org/armedbear/lisp/BasicVectorPrimitive.java @@ -4,78 +4,179 @@ import java.lang.reflect.Array; import java.nio.Buffer; +import java.text.MessageFormat; +import java.util.Arrays; // A basic vector is a specialized vector that is not displaced to another // array, has no fill pointer, and is not expressly adjustable. -public final class BasicVectorPrimitive extends SimpleVector { - T[] data; - Class type; +public final class BasicVectorPrimitive + extends BasicVector +{ + byte[] u8; + short[] u16; + int[] u32; + long[] u64; public BasicVectorPrimitive(Class type, int capacity) { - this.type = type; - data = (T[]) Array.newInstance(type, capacity); - } - - public LispObject typeOf() { - if (type.equals(Byte.class)) { - return list(Symbol.SIMPLE_VECTOR, UNSIGNED_BYTE_8, new Cons(Fixnum.getInstance(capacity))); - } else if (type.equals(Short.class)) { - return list(Symbol.SIMPLE_VECTOR, UNSIGNED_BYTE_16, new Cons(Fixnum.getInstance(capacity))); - } else if (type.equals(Integer.class)) { - return list(Symbol.SIMPLE_VECTOR, UNSIGNED_BYTE_32, new Cons(Fixnum.getInstance(capacity))); - } else if (type.equals(Long.class)) { - return list(Symbol.SIMPLE_VECTOR, UNSIGNED_BYTE_64, new Cons(Fixnum.getInstance(capacity))); + super(type, capacity); + switch (specializedOn) { + case U8: + u8 = new byte[capacity]; + case U16: + u16 = new short[capacity]; + case U32: + u32 = new int[capacity]; + case U64: + u64 = new long[capacity]; } - return program_error("BasicVectorPrimitive couldn't determine type."); } - //public LispObject classOf() + public BasicVectorPrimitive(byte[] data) { + super(Byte.class, data.length); + u8 = data; + } + public BasicVectorPrimitive(short[] data) { + super(Short.class, data.length); + u16 = data; + } + public BasicVectorPrimitive(int[] data) { + super(Integer.class, data.length); + u32 = data; + } + public BasicVectorPrimitive(long[] data) { + super(Long.class, data.length); + u64 = data; + } + - // public LispObject getDescription() { - // StringBuffer sb = new StringBuffer(super.getDescription().toString()); - - public LispObject typep(LispObject type) { - if (type instanceof Cons) { - if (type.car().equals(Symbol.SIMPLE_VECTOR) - && (type.cdr().equals(getElementType()))) { - return T; - } - } - return super.typep(type); + @Override + public LispObject elt(int i) { + return AREF(i); + } + + @Override + public LispObject AREF(int i) { + return SVREF(i); } @Override - public LispObject getElementType() { - if (type.equals(Byte.class)) { - return UNSIGNED_BYTE_8; - } else if (type.equals(Short.class)) { - return UNSIGNED_BYTE_16; - } else if (type.equals(Integer.class)) { - return UNSIGNED_BYTE_32; - } else if (type.equals(Long.class)) { - return UNSIGNED_BYTE_64; + public void aset(int i, LispObject n) { + svset(i, n); + } + + public LispObject SVREF(int i) { + try { + switch (specializedOn) { + case U8: + return coerceFromJavaByte(u8[i]); + case U16: + return Fixnum.getInstance(Short.toUnsignedInt(u16[i])); + case U32: + return Fixnum.getInstance(Integer.toUnsignedLong(u32[i])); + case U64: + return LispInteger.getUnsignedInstance(u64[i]); + } + } catch (ArrayIndexOutOfBoundsException e) { + return badIndex(i, capacity); } - return program_error("Unknown element type: " + type); + return program_error("Supposedly unreachable code in BasicVectorPrimitive"); } - // do these work? - // public LispObject elt(int index) - // public LispObject AREF(int index) - // public LispObject SVREF(int index) - // public void svset(int index, LispObject newValue) - // public LispObject subseq(int start, int end) - // public void fill(LispObject obj) { + public void svset(int i, LispObject n) { + try { + switch (specializedOn) { + case U8: + byte b = coerceToJavaByte(n); + u8[i] = b; + break; + case U16: + short s = coerceToJavaUnsignedShort(n); + u16[i] = s; + break; + case U32: + int v = coerceToJavaUnsignedInt(n); + u32[i] = v; + break; + case U64: + // long v = ??? + // ((IntBuffer)data).put(i, v); + program_error("Unimplemented aset on long"); + break; + } + } catch (IndexOutOfBoundsException e) { + badIndex(i, capacity); + } + } + public LispObject subseq(int start, int end) { + try { + switch (specializedOn) { + case U8: + byte[] bytes = Arrays.copyOfRange(u8, start, end); + return new BasicVectorPrimitive(bytes); + case U16: + short[] shorts = Arrays.copyOfRange(u16, start, end); + return new BasicVectorPrimitive(shorts); + case U32: + int[] ints = Arrays.copyOfRange(u32, start, end); + return new BasicVectorPrimitive(ints); + case U64: + long[] longs = Arrays.copyOfRange(u64, start, end); + return new BasicVectorPrimitive(longs); + } + } catch (ArrayIndexOutOfBoundsException e) { + String m + = MessageFormat.format("The bounding indices {0} and {1} are bad for a sequence of length {2}.", start, end, length()); + return type_error(m, new JavaObject(e), NIL); // Not really a type_error, as there is not one type + } + return program_error("Unreachable"); + } - // public LispObject deleteEq(LispObject item) + @Override + public void fill(LispObject obj) { + switch (specializedOn) { + case U8: + byte b = coerceToJavaByte(obj); + Arrays.fill(u8, b); + break; + case U16: + short s = coerceToJavaUnsignedShort(obj); + Arrays.fill(u16, s); + break; + case U32: + int i = coerceToJavaUnsignedInt(obj); + Arrays.fill(u32,i); + break; + case U64: + program_error("Unimplemented fill of U64"); + break; + } + } + + // public LispObject deleteEq(LispObject item) // public LispObject deleteEql(LispObject item) - public void shrink(int n) { if (n < capacity) { - BasicVectorPrimitive newArray = new BasicVectorPrimitive<>(type, n); - System.arraycopy(data, 0, newArray.data, 0, n); - data = (T[])newArray.data; + BasicVectorPrimitive newArray = new BasicVectorPrimitive(type, n); + switch (specializedOn) { + case U8: + System.arraycopy(u8, 0, newArray.u8, 0, n); + u8 = newArray.u8; + break; + case U16: + System.arraycopy(u16, 0, newArray.u16, 0, n); + u16 = newArray.u16; + break; + case U32: + System.arraycopy(u32, 0, newArray.u32, 0, n); + u32 = newArray.u32; + break; + case U64: + System.arraycopy(u64, 0, newArray.u64, 0, n); + u64 = newArray.u64; + break; + } capacity = n; return; } @@ -86,16 +187,172 @@ public void shrink(int n) { } public LispObject reverse() { - BasicVectorPrimitive result = new BasicVectorPrimitive<>(type, capacity); + BasicVectorPrimitive result = new BasicVectorPrimitive(type, capacity); int i, j; - for (i = 0, j = capacity - 1; i < capacity; i++, j--) { - result.data[i] = data[j]; + switch (specializedOn) { + case U8: + for (i = 0, j = capacity - 1; i < capacity; i++, j--) { + result.u8[i] = u8[j]; + } + break; + case U16: + for (i = 0, j = capacity - 1; i < capacity; i++, j--) { + result.u16[i] = u16[j]; + } + break; + case U32: + for (i = 0, j = capacity - 1; i < capacity; i++, j--) { + result.u32[i] = u32[j]; + } + break; + case U64: + for (i = 0, j = capacity - 1; i < capacity; i++, j--) { + result.u64[i] = u64[j]; + } + break; } return result; } - // public LispObject nreverse() + public LispObject nreverse() { + int i = 0; + int j = capacity - 1; + switch (specializedOn) { + case U8: + while (i < j) { + byte temp = u8[i]; + u8[i] = u8[j]; + u8[j] = temp; + ++i; --j; + } + break; + case U16: + while (i < j) { + short temp = u16[i]; + u16[i] = u16[j]; + u16[j] = temp; + ++i; --j; + } + break; + case U32: + while (i < j) { + int temp = u32[i]; + u32[i] = u32[j]; + u32[j] = temp; + ++i; --j; + } + break; + case U64: + while (i < j) { + long temp = u64[i]; + u64[i] = u64[j]; + u64[j] = temp; + ++i; --j; + } + break; + } + return this; + } - //public AbstractVector adjustArray + @Override + public AbstractVector adjustArray(int newCapacity, + LispObject initialElement, + LispObject initialContents) + { + if (initialContents != null) { + if (initialContents.listp()) { + LispObject list = initialContents; + switch (specializedOn) { + case U8: + byte[] bytes = new byte[newCapacity]; + for (int i = 0; i < newCapacity; i++) { + bytes[i] = coerceToJavaByte(list.car()); + list = list.cdr(); + } + return new BasicVectorPrimitive(bytes); + case U16: + short[] shorts = new short[newCapacity]; + for (int i = 0; i < newCapacity; i++) { + shorts[i] = coerceToJavaUnsignedShort(list.car()); + list = list.cdr(); + } + return new BasicVectorPrimitive(shorts); + case U32: + int[] ints = new int[newCapacity]; + for (int i = 0; i < newCapacity; i++) { + ints[i] = coerceToJavaUnsignedInt(list.car()); + list = list.cdr(); + } + return new BasicVectorPrimitive(ints); + case U64: + program_error("Unimplemented adjustment of u64 array"); + } + } else if (initialContents.vectorp()) { + if (initialContents instanceof BasicVectorPrimitive) { + switch(specializedOn) { + case U8: + byte[] bytes = Arrays.copyOfRange(u8, 0, newCapacity); + return new BasicVectorPrimitive(bytes); + case U16: + short[] shorts = Arrays.copyOfRange(u16, 0, newCapacity); + return new BasicVectorPrimitive(shorts); + case U32: + int[] ints = Arrays.copyOfRange(u32, 0, newCapacity); + return new BasicVectorPrimitive(ints); + case U64: + long[] longs = Arrays.copyOfRange(u64, 0, newCapacity); + return new BasicVectorPrimitive(longs); + } + } else { + program_error("Unimplmented adjust array for non BasicVectorPrimitive"); + } + } else { + type_error(initialContents, Symbol.SEQUENCE); + } + } + if (capacity != newCapacity) { + if (initialElement == null) { + switch(specializedOn) { + case U8: + byte[] bytes = new byte[newCapacity]; + bytes = Arrays.copyOfRange(u8, 0, Math.min(capacity, newCapacity)); + return new BasicVectorPrimitive(bytes); + case U16: + short[] shorts = new short[newCapacity]; + shorts = Arrays.copyOfRange(u16, 0, Math.min(capacity, newCapacity)); + return new BasicVectorPrimitive(shorts); + case U32: + int[] ints = new int[newCapacity]; + ints = Arrays.copyOfRange(u32, 0, Math.min(capacity, newCapacity)); + return new BasicVectorPrimitive(ints); + case U64: + long[] longs = new long[newCapacity]; + longs = Arrays.copyOfRange(u64, 0, Math.min(capacity, newCapacity)); + return new BasicVectorPrimitive(longs); + } + } + + BasicVectorPrimitive result = null; + switch(specializedOn) { + case U8: + result = new BasicVectorPrimitive(Byte.class, newCapacity); + break; + case U16: + result = new BasicVectorPrimitive(Short.class, newCapacity); + break; + case U32: + result = new BasicVectorPrimitive(Integer.class, newCapacity); + break; + case U64: + result = new BasicVectorPrimitive(Long.class, newCapacity); + break; + } + result.fill(initialElement); + return result; + } + + // No change. + return this; + } // public AbstractVector adjustArray(int newCapacity, AbstractArray displacedTo, int displacement) } diff --git a/src/org/armedbear/lisp/SimpleVector.java b/src/org/armedbear/lisp/SimpleVector.java index f4098f9da..30a6d4bc4 100644 --- a/src/org/armedbear/lisp/SimpleVector.java +++ b/src/org/armedbear/lisp/SimpleVector.java @@ -160,47 +160,27 @@ public int length() @Override public LispObject elt(int index) { - try { - return (T) data[index]; - } catch (ArrayIndexOutOfBoundsException e) { - badIndex(index, capacity); - return NIL; // Not reached. - } + return SVREF(index); } @Override - public LispObject AREF(int index) - { - try { - return data[index]; - } catch (ArrayIndexOutOfBoundsException e) { - badIndex(index, data.length); - return NIL; // Not reached. - } + public LispObject AREF(int index) { + return SVREF(index); } @Override - public void aset(int index, LispObject newValue) - { - try { - data[index] = (T) newValue; - } catch (ArrayIndexOutOfBoundsException e) { - badIndex(index, capacity); - } + public void aset(int index, LispObject newValue) { + svset(index, newValue); } @Override - public LispObject SVREF(int index) - { - try - { - return data[index]; - } - catch (ArrayIndexOutOfBoundsException e) - { - badIndex(index, data.length); - return NIL; // Not reached. - } + public LispObject SVREF(int index) { + try { + return data[index]; + } catch (ArrayIndexOutOfBoundsException e) { + badIndex(index, data.length); + return NIL; // Not reached. + } } @Override @@ -381,17 +361,20 @@ public AbstractVector replace(AbstractVector source, { @Override public LispObject execute(LispObject first, LispObject second) { - if (first instanceof SimpleVector) { - final SimpleVector sv = (SimpleVector)first; - int index = Fixnum.getValue(second); - try { - return sv.data[index]; - } catch (ArrayIndexOutOfBoundsException e) { - int capacity = sv.capacity; - return sv.badIndex(index, capacity); + int index = Fixnum.getValue(second); + if (first instanceof BasicVectorPrimitive) { + return ((BasicVectorPrimitive)first).SVREF(index); } - } - return type_error(first, Symbol.SIMPLE_VECTOR); + if (first instanceof SimpleVector) { + final SimpleVector sv = (SimpleVector)first; + try { + return sv.data[index]; + } catch (ArrayIndexOutOfBoundsException e) { + int capacity = sv.capacity; + return sv.badIndex(index, capacity); + } + } + return type_error(first, Symbol.SIMPLE_VECTOR); } }; @@ -401,18 +384,20 @@ public LispObject execute(LispObject first, LispObject second) { { @Override public LispObject execute(LispObject first, LispObject second, - LispObject third) { + LispObject third) + { + int index = Fixnum.getValue(second); + if (first instanceof BasicVectorPrimitive) { + ((BasicVectorPrimitive)first).svset(index, third); + } if (first instanceof SimpleVector) { final SimpleVector sv = (SimpleVector)first; - int index = Fixnum.getValue(second); try { sv.data[index] = third; return third; } catch (ArrayIndexOutOfBoundsException e) { int capacity = sv.capacity; - sv.badIndex(index, capacity); - // Not reached. - return NIL; + return sv.badIndex(index, capacity); } } return type_error(first, Symbol.SIMPLE_VECTOR); From fa509a568f297099292f2b2a5a3204a532e1e4b6 Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Sat, 9 Sep 2023 09:12:26 +0200 Subject: [PATCH 19/36] Some basic javadoc for the new types TODO: wire getDescription() for our type menagerie Using the BuiltinClass hierarchy causes problems, so getDescription() is one way to indicate what implementation class is actually handling a specialization of sequence types. --- src/org/armedbear/lisp/BasicVector.java | 29 ++++++++++++++++++- src/org/armedbear/lisp/BasicVectorBuffer.java | 14 ++++++--- .../armedbear/lisp/BasicVectorPrimitive.java | 12 ++++++-- 3 files changed, 48 insertions(+), 7 deletions(-) diff --git a/src/org/armedbear/lisp/BasicVector.java b/src/org/armedbear/lisp/BasicVector.java index c37baf6a3..643f03d06 100644 --- a/src/org/armedbear/lisp/BasicVector.java +++ b/src/org/armedbear/lisp/BasicVector.java @@ -2,6 +2,12 @@ import static org.armedbear.lisp.Lisp.*; +/** + A basic vector is a specialized vector that is not displaced to another + array, has no fill pointer, and is not expressly adjustable. + + All BasicVectors are children of SimpleVector. +*/ public class BasicVector extends SimpleVector { @@ -88,6 +94,27 @@ public LispObject getElementType() { return program_error("Unknown element type: " + type); } - + @Override + public LispObject getDescription() { + StringBuffer sb = new StringBuffer("A simple vector specialized on "); + switch (specializedOn) { + case U8: + sb.append("(UNSIGNED-BYTE 8)"); + break; + case U16: + sb.append("(UNSIGNED-BYTE 16)"); + break; + case U32: + sb.append("(UNSIGNED-BYTE 32)"); + break; + case U64: + sb.append("(UNSIGNED-BYTE 64)"); + break; + } + sb.append(" with "); + sb.append(capacity); + sb.append(" elements"); + return new SimpleString(sb); + } } diff --git a/src/org/armedbear/lisp/BasicVectorBuffer.java b/src/org/armedbear/lisp/BasicVectorBuffer.java index 6bdbfa19f..6bf912244 100644 --- a/src/org/armedbear/lisp/BasicVectorBuffer.java +++ b/src/org/armedbear/lisp/BasicVectorBuffer.java @@ -10,12 +10,16 @@ import java.text.MessageFormat; import java.util.Arrays; -// A basic vector is a specialized vector that is not displaced to another -// array, has no fill pointer, and is not expressly adjustable. +/** + + A SIMPLE-VECTOR specialized on 8, 16, 32, and 64 unsigned byte + types backed by a java.nio.Buffer implmentation. + +*/ public final class BasicVectorBuffer extends BasicVector { - // boolean directAllocation; directly allocate Buffer don't have backing arrays + // boolean directAllocation; directly allocate Buffer don't have backing arrays TODO subclass that behavior Buffer data; public BasicVectorBuffer(Class type, int capacity) { @@ -36,6 +40,8 @@ public BasicVectorBuffer(Class type, int capacity) { } } + // TODO constructor that takes an existing ByteBuffer as its backing store + public byte[] asByteArray() { return (byte[])((ByteBuffer)data).array(); } @@ -69,8 +75,8 @@ public LispObject getDescription() { sb.append(capacity); sb.append(" elements"); return new SimpleString(sb); - } + } @Override public LispObject elt(int i) { diff --git a/src/org/armedbear/lisp/BasicVectorPrimitive.java b/src/org/armedbear/lisp/BasicVectorPrimitive.java index 29dee2e99..c85cdf22b 100644 --- a/src/org/armedbear/lisp/BasicVectorPrimitive.java +++ b/src/org/armedbear/lisp/BasicVectorPrimitive.java @@ -7,11 +7,19 @@ import java.text.MessageFormat; import java.util.Arrays; -// A basic vector is a specialized vector that is not displaced to another -// array, has no fill pointer, and is not expressly adjustable. +/** + + A SIMPLE-VECTOR specialized on types of primitive arrays. + + Currently only the four necessary primitives to implement the + UNSIGNED-BYTE 8, 16, 32, and 64 bit specializations have been + implemented on bytes, shorts, ints, and longs respectively. + +*/ public final class BasicVectorPrimitive extends BasicVector { + // TODO we can theoretically do this as a single u8 array, with views as shorts, ints, and longs byte[] u8; short[] u16; int[] u32; From b78f49f1ec1c7d9e3443aa1a86df128bde6410dd Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Wed, 6 Sep 2023 16:10:32 +0200 Subject: [PATCH 20/36] Try using AbstractVector.deleteEQ() It should work, as it references the upper-case operators, which should thunk down to the AREF, etc. methods in BasicVectorBuffer, but I could be wrong about the inheritance. --- src/org/armedbear/lisp/BasicVectorBuffer.java | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/org/armedbear/lisp/BasicVectorBuffer.java b/src/org/armedbear/lisp/BasicVectorBuffer.java index 6bf912244..a8811f2d1 100644 --- a/src/org/armedbear/lisp/BasicVectorBuffer.java +++ b/src/org/armedbear/lisp/BasicVectorBuffer.java @@ -180,8 +180,8 @@ public void fill(byte b) { Arrays.fill(((ByteBuffer)data).array(), b); } - - // TODO AbstractVector.deleteEq() could work, as well but is it faster? + // Does AbstractVector.deleteEq() could work, as well but is it faster? + /** @Override public LispObject deleteEq(LispObject item) { byte b = coerceToJavaByte(item); @@ -204,6 +204,7 @@ public LispObject deleteEq(byte b) { } return this; } + */ // // TODO check on use of AbstractVector.deleteEql() From 78e139f8df93c8eeb5f9c86a6316b738e019bcd3 Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Wed, 6 Sep 2023 16:19:02 +0200 Subject: [PATCH 21/36] The new nio Buffer *might* work on u8 specializations --- src/org/armedbear/lisp/BasicVectorBuffer.java | 36 ++++++++++++++----- src/org/armedbear/lisp/LispInteger.java | 4 +++ 2 files changed, 31 insertions(+), 9 deletions(-) diff --git a/src/org/armedbear/lisp/BasicVectorBuffer.java b/src/org/armedbear/lisp/BasicVectorBuffer.java index a8811f2d1..e34c53a4f 100644 --- a/src/org/armedbear/lisp/BasicVectorBuffer.java +++ b/src/org/armedbear/lisp/BasicVectorBuffer.java @@ -119,9 +119,9 @@ public void aset(int i, LispObject n) { ((IntBuffer)data).put(i, v); break; case U64: - // long v = ??? - // ((IntBuffer)data).put(i, v); - program_error("Unimplemented aset on long"); + LispInteger lispInteger = LispInteger.coerce(n); + long l = LispInteger.asUnsignedLong(lispInteger); + ((LongBuffer)data).put(i, l); break; } } catch (IndexOutOfBoundsException e) { @@ -228,13 +228,20 @@ public void shrink(int n) { @Override public LispObject reverse() { - // thunk on CLAZZ - BasicVectorBuffer result - = new BasicVectorBuffer(ByteBuffer.class, capacity); - + BasicVectorBuffer result = new BasicVectorBuffer(type, capacity); int i, j; - ByteBuffer source = (ByteBuffer)data; - ByteBuffer destination = (ByteBuffer)result.data; + // switch (onSpecialization) { + // case U8: + ByteBuffer source = (ByteBuffer)data; + ByteBuffer destination = (ByteBuffer)result.data; + // break; + // case U16: + // break; + // case U32: + // break; + // case U64: + // break; + // } for (i = 0, j = capacity - 1; i < capacity; i++, j--) { destination.put(i, source.get(j)); } @@ -245,6 +252,8 @@ public LispObject reverse() { public LispObject nreverse() { int i = 0; int j = capacity() - 1; + // switch (onSpecialization) { + // case U8: ByteBuffer buffer = (ByteBuffer)data; while (i < j) { byte temp = buffer.get(i); @@ -253,6 +262,15 @@ public LispObject nreverse() { ++i; --j; } + // break; + // case U16: + // break; + // case U32: + // break; + // case U64: + // break; + // } + return this; } diff --git a/src/org/armedbear/lisp/LispInteger.java b/src/org/armedbear/lisp/LispInteger.java index df4a178b2..4889b7c1a 100644 --- a/src/org/armedbear/lisp/LispInteger.java +++ b/src/org/armedbear/lisp/LispInteger.java @@ -63,4 +63,8 @@ public static long asUnsignedLong(LispInteger i) { } return i.longValue(); } + + public static LispInteger coerce(LispObject o) { + return (LispInteger)o; + } } From fc11e7c6bef51753567a36af68871f1abd594bf7 Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Sat, 9 Sep 2023 09:39:30 +0200 Subject: [PATCH 22/36] DESCRIBE shows which class implementation of SIMPLE-VECTOR --- src/org/armedbear/lisp/BasicVector.java | 5 ++-- src/org/armedbear/lisp/BasicVectorBuffer.java | 25 +++++-------------- .../armedbear/lisp/BasicVectorPrimitive.java | 11 +++++++- 3 files changed, 18 insertions(+), 23 deletions(-) diff --git a/src/org/armedbear/lisp/BasicVector.java b/src/org/armedbear/lisp/BasicVector.java index 643f03d06..03c77bd26 100644 --- a/src/org/armedbear/lisp/BasicVector.java +++ b/src/org/armedbear/lisp/BasicVector.java @@ -111,9 +111,8 @@ public LispObject getDescription() { sb.append("(UNSIGNED-BYTE 64)"); break; } - sb.append(" with "); - sb.append(capacity); - sb.append(" elements"); + sb.append(" with ").append(capacity).append(" elements").append(".") + .append("\n"); return new SimpleString(sb); } diff --git a/src/org/armedbear/lisp/BasicVectorBuffer.java b/src/org/armedbear/lisp/BasicVectorBuffer.java index e34c53a4f..7d2a8f7df 100644 --- a/src/org/armedbear/lisp/BasicVectorBuffer.java +++ b/src/org/armedbear/lisp/BasicVectorBuffer.java @@ -56,26 +56,13 @@ public long[] asLongArray() { } public LispObject getDescription() { - StringBuffer sb = new StringBuffer("A simple vector specialized on "); - switch (specializedOn) { - case U8: - sb.append("(UNSIGNED-BYTE 8)"); - break; - case U16: - sb.append("(UNSIGNED-BYTE 16)"); - break; - case U32: - sb.append("(UNSIGNED-BYTE 32)"); - break; - case U64: - sb.append("(UNSIGNED-BYTE 64)"); - break; - } - sb.append(" with "); - sb.append(capacity); - sb.append(" elements"); - return new SimpleString(sb); + StringBuffer sb + = new StringBuffer("A simple vector baced with a java.nio.Buffer implementation. ") + .append("\n"); + sb.append("Whose superimplementation is ").append("\n") + .append(super.getDescription()); + return new SimpleString(sb); } @Override diff --git a/src/org/armedbear/lisp/BasicVectorPrimitive.java b/src/org/armedbear/lisp/BasicVectorPrimitive.java index c85cdf22b..c487e8823 100644 --- a/src/org/armedbear/lisp/BasicVectorPrimitive.java +++ b/src/org/armedbear/lisp/BasicVectorPrimitive.java @@ -56,7 +56,16 @@ public BasicVectorPrimitive(long[] data) { u64 = data; } - + public LispObject getDescription() { + StringBuffer sb + = new StringBuffer("A simple vector backed by an array of Java primitive types. ") + .append("\n"); + sb.append("Whose superimplementation is ").append("\n") + .append(super.getDescription()); + + return new SimpleString(sb); + } + @Override public LispObject elt(int i) { return AREF(i); From fb64ec8ca17a2fee62083032b981d8a5cb534f1b Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Sat, 9 Sep 2023 09:40:29 +0200 Subject: [PATCH 23/36] Check type when coerceing to a LispInteger --- src/org/armedbear/lisp/LispInteger.java | 18 +++++++++++++----- 1 file changed, 13 insertions(+), 5 deletions(-) diff --git a/src/org/armedbear/lisp/LispInteger.java b/src/org/armedbear/lisp/LispInteger.java index 4889b7c1a..70993e89e 100644 --- a/src/org/armedbear/lisp/LispInteger.java +++ b/src/org/armedbear/lisp/LispInteger.java @@ -33,12 +33,17 @@ package org.armedbear.lisp; -/** This class merely serves as the super class for - * Fixnum and Bignum +import static org.armedbear.lisp.Lisp.*; + +/** + * An INTEGER is either a FIXNUM or a BIGNUM + * + * See the Fixnum and Bignum classes for the Java implementations. */ -public class LispInteger extends LispObject implements java.io.Serializable +public class LispInteger + extends LispObject + implements java.io.Serializable { - public static LispInteger getInstance(long l) { if (Integer.MIN_VALUE <= l && l <= Integer.MAX_VALUE) return Fixnum.getInstance((int)l); @@ -65,6 +70,9 @@ public static long asUnsignedLong(LispInteger i) { } public static LispInteger coerce(LispObject o) { - return (LispInteger)o; + if (o instanceof LispInteger) { + return (LispInteger)o; + } + return (LispInteger) type_error(o, (LispObject)new JavaObject(LispInteger.class)); } } From a62f71d1d64e601a6dd5ee8eedad733ae284cc0c Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Sat, 9 Sep 2023 09:46:23 +0200 Subject: [PATCH 24/36] BasicVectorPrimitive should be complete --- src/org/armedbear/lisp/BasicVectorPrimitive.java | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/src/org/armedbear/lisp/BasicVectorPrimitive.java b/src/org/armedbear/lisp/BasicVectorPrimitive.java index c487e8823..4de553693 100644 --- a/src/org/armedbear/lisp/BasicVectorPrimitive.java +++ b/src/org/armedbear/lisp/BasicVectorPrimitive.java @@ -115,9 +115,10 @@ public void svset(int i, LispObject n) { u32[i] = v; break; case U64: - // long v = ??? - // ((IntBuffer)data).put(i, v); - program_error("Unimplemented aset on long"); + // TODO: consider asUnsignedLong should be an instance method + LispInteger lispInteger = LispInteger.coerce(n); + long l = LispInteger.asUnsignedLong(lispInteger); + u64[i] = l; break; } } catch (IndexOutOfBoundsException e) { From c67f2ee76e0de3de83d4005591f86382c84df095 Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Sat, 9 Sep 2023 09:47:04 +0200 Subject: [PATCH 25/36] doc: simple vectors specialization on java.nio works only for u8 --- src/org/armedbear/lisp/BasicVectorBuffer.java | 10 +++++++--- src/org/armedbear/lisp/BasicVectorPrimitive.java | 8 +++++--- 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/src/org/armedbear/lisp/BasicVectorBuffer.java b/src/org/armedbear/lisp/BasicVectorBuffer.java index 7d2a8f7df..ae76a5536 100644 --- a/src/org/armedbear/lisp/BasicVectorBuffer.java +++ b/src/org/armedbear/lisp/BasicVectorBuffer.java @@ -15,7 +15,9 @@ A SIMPLE-VECTOR specialized on 8, 16, 32, and 64 unsigned byte types backed by a java.nio.Buffer implmentation. + */ +// Only code paths for (UNSIGNED-BYTE 8) types right now. public final class BasicVectorBuffer extends BasicVector { @@ -83,7 +85,7 @@ public LispObject AREF(int i) { case U64: return LispInteger.getUnsignedInstance(((LongBuffer)data).get(i)); } - return program_error("Bad ELT in BasicVectorBuffer."); + return program_error("Bad array reference in BasicVectorBuffer for " + i); } catch (ArrayIndexOutOfBoundsException e) { return badIndex(i, capacity); } @@ -152,8 +154,10 @@ public LispObject subseq(int start, int end) { return result; } catch (ArrayIndexOutOfBoundsException e) { String m - = MessageFormat.format("The bounding indices {0} and {1} are bad for a sequence of length {2}.", start, end, length()); - return type_error(m, new JavaObject(e), NIL); // Not really a type_error, as there is not one type + = MessageFormat.format("The bounding indices {0} and {1} are bad for a sequence of length {2}.", + start, end, length()); + // Not really a type_error, as there is not one type + return type_error(m, new JavaObject(e), NIL); } } diff --git a/src/org/armedbear/lisp/BasicVectorPrimitive.java b/src/org/armedbear/lisp/BasicVectorPrimitive.java index 4de553693..968fcddca 100644 --- a/src/org/armedbear/lisp/BasicVectorPrimitive.java +++ b/src/org/armedbear/lisp/BasicVectorPrimitive.java @@ -19,7 +19,7 @@ public final class BasicVectorPrimitive extends BasicVector { - // TODO we can theoretically do this as a single u8 array, with views as shorts, ints, and longs + // TODO do this as a single u8 array, with views as shorts, ints, and longs byte[] u8; short[] u16; int[] u32; @@ -144,8 +144,10 @@ public LispObject subseq(int start, int end) { } } catch (ArrayIndexOutOfBoundsException e) { String m - = MessageFormat.format("The bounding indices {0} and {1} are bad for a sequence of length {2}.", start, end, length()); - return type_error(m, new JavaObject(e), NIL); // Not really a type_error, as there is not one type + = MessageFormat.format("The bounding indices {0} and {1} are bad for a sequence of length {2}.", + start, end, length()); + // Not really a type_error, as there is not one type + return type_error(m, new JavaObject(e), NIL); } return program_error("Unreachable"); } From f0580c4915233124fa66aedd9bac1d84f1bb655b Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Sat, 9 Sep 2023 13:49:22 +0200 Subject: [PATCH 26/36] Remove generics for SimpleVector This doesn't seem to help anything. --- src/org/armedbear/lisp/SimpleVector.java | 47 ++++++++++++------------ 1 file changed, 24 insertions(+), 23 deletions(-) diff --git a/src/org/armedbear/lisp/SimpleVector.java b/src/org/armedbear/lisp/SimpleVector.java index 30a6d4bc4..cc4c769b4 100644 --- a/src/org/armedbear/lisp/SimpleVector.java +++ b/src/org/armedbear/lisp/SimpleVector.java @@ -43,11 +43,13 @@ // "The type of a vector that is not displaced to another array, has no fill // pointer, is not expressly adjustable and is able to hold elements of any // type is a subtype of type SIMPLE-VECTOR." -public class SimpleVector extends AbstractVector +public class SimpleVector + extends AbstractVector + implements java.io.Serializable { int capacity; - T[] data; - Class type; + LispObject[] data; + Class type; // "always" LispObject for now public SimpleVector() { } @@ -59,22 +61,19 @@ public SimpleVector(int capacity) { public SimpleVector(Class type, int capacity) { this.type = type; this.capacity = capacity; - data = (T[]) Array.newInstance(type, capacity); - // for (int i = capacity; i-- > 0;) { - //data[i] = Fixnum.ZERO; - //} - Arrays.fill(data, (T) Fixnum.ZERO); // is this necessary? + data = (LispObject[]) Array.newInstance(type, capacity); + Arrays.fill(data, (LispObject) Fixnum.ZERO); // is this necessary? ECL fills with NIL } public SimpleVector(LispObject obj) { if (obj.listp()) { - data = (T[]) obj.copyToArray(); + data = obj.copyToArray(); capacity = data.length; } else if (obj instanceof AbstractVector) { capacity = obj.length(); - data = (T[]) new LispObject[capacity]; + data = new LispObject[capacity]; for (int i = 0; i < capacity; i++) { - data[i] = (T) obj.elt(i); // faster? Implement AbstractVector.asArray()? + data[i] = (LispObject) obj.AREF(i); // faster? Implement AbstractVector.asArray()? } } else { Debug.assertTrue(false); @@ -82,7 +81,7 @@ public SimpleVector(LispObject obj) { } public SimpleVector(LispObject[] array) { - data = (T[])array; + data = array; capacity = array.length; } @@ -187,7 +186,7 @@ public LispObject SVREF(int index) { public void svset(int index, LispObject newValue) { try { - data[index] = (T) newValue; + data[index] = newValue; } catch (ArrayIndexOutOfBoundsException e) { badIndex(index, capacity); } @@ -197,18 +196,20 @@ public void svset(int index, LispObject newValue) public LispObject subseq(int start, int end) { try { - T[] subseq = Arrays.copyOfRange(data, start, end); + LispObject[] subseq = Arrays.copyOfRange(data, start, end); return new SimpleVector(subseq); } catch (ArrayIndexOutOfBoundsException e) { String m - = MessageFormat.format("The bounding indices {0} and {1} are bad for a sequence of length {2}.", start, end, length()); - return type_error(m, new JavaObject(e), NIL); // Not really a type_error, as there is not one type + = MessageFormat.format("The bounding indices {0} and {1} are bad for a sequence of length {2}.", + start, end, length()); + // Not really a type_error, as there is not one type + return type_error(m, new JavaObject(e), NIL); } } @Override public void fill(LispObject obj) { - Arrays.fill(data, (T) obj); + Arrays.fill(data, obj); } @Override @@ -221,7 +222,7 @@ public LispObject deleteEq(LispObject item) { LispObject obj = data[i++]; if (obj != item) - data[j++] = (T)obj; + data[j++] = obj; } if (j < limit) shrink(j); @@ -238,7 +239,7 @@ public LispObject deleteEql(LispObject item) { LispObject obj = data[i++]; if (!obj.eql(item)) - data[j++] = (T) obj; + data[j++] = obj; } if (j < limit) shrink(j); @@ -251,7 +252,7 @@ public void shrink(int n) if (n < capacity) { SimpleVector newArray = new SimpleVector(n); System.arraycopy(data, 0, newArray.data, 0, n); - data = (T[])newArray.data; + data = newArray.data; capacity = n; return; } @@ -280,7 +281,7 @@ public LispObject nreverse() { LispObject temp = data[i]; data[i] = data[j]; - data[j] = (T) temp; + data[j] = temp; ++i; --j; } @@ -345,9 +346,9 @@ public AbstractVector replace(AbstractVector source, int sourceStart, int sourceEnd) { if (source instanceof SimpleVector) { + // data = Array.copyOfRange ... ? System.arraycopy(((SimpleVector)source).data, sourceStart, - data, targetStart, - Math.min(targetEnd - targetStart, sourceEnd - sourceStart)); + data, targetStart, Math.min(targetEnd - targetStart, sourceEnd - sourceStart)); return this; } else { return super.replace(source, targetStart, targetEnd, sourceStart, sourceEnd); From 76b41a0895eb23fc53fe8a65c9eb60c44bdb0fe6 Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Sat, 9 Sep 2023 13:51:00 +0200 Subject: [PATCH 27/36] INCOMPLETE Implement nio Buffer as having views of a u8 vector --- src/org/armedbear/lisp/BasicVector.java | 9 +- src/org/armedbear/lisp/BasicVectorBuffer.java | 123 ++++++++++++++---- 2 files changed, 108 insertions(+), 24 deletions(-) diff --git a/src/org/armedbear/lisp/BasicVector.java b/src/org/armedbear/lisp/BasicVector.java index 03c77bd26..1d5d8080b 100644 --- a/src/org/armedbear/lisp/BasicVector.java +++ b/src/org/armedbear/lisp/BasicVector.java @@ -12,7 +12,14 @@ public class BasicVector extends SimpleVector { public enum Specialization { - U8, U16, U32, U64 + U8(1), U16(2), U32(4), U64(8); + + public final int totalBytes; + + private Specialization(int bytes) { + totalBytes = bytes; + } + } Specialization specializedOn; diff --git a/src/org/armedbear/lisp/BasicVectorBuffer.java b/src/org/armedbear/lisp/BasicVectorBuffer.java index ae76a5536..1166a60b1 100644 --- a/src/org/armedbear/lisp/BasicVectorBuffer.java +++ b/src/org/armedbear/lisp/BasicVectorBuffer.java @@ -15,7 +15,6 @@ A SIMPLE-VECTOR specialized on 8, 16, 32, and 64 unsigned byte types backed by a java.nio.Buffer implmentation. - */ // Only code paths for (UNSIGNED-BYTE 8) types right now. public final class BasicVectorBuffer @@ -23,40 +22,109 @@ public final class BasicVectorBuffer { // boolean directAllocation; directly allocate Buffer don't have backing arrays TODO subclass that behavior Buffer data; + ByteBuffer bytes; public BasicVectorBuffer(Class type, int capacity) { super(type, capacity); + bytes = ByteBuffer.allocate(capacity * specializedOn.totalBytes); + switch (specializedOn) { case U8: - data = ByteBuffer.allocate(capacity); + data = bytes; break; case U16: - data = ShortBuffer.allocate(capacity); + data = bytes.asShortBuffer(); break; case U32: - data = IntBuffer.allocate(capacity); + data = bytes.asIntBuffer(); break; case U64: - data = LongBuffer.allocate(capacity); + data = bytes.asLongBuffer(); break; } } - // TODO constructor that takes an existing ByteBuffer as its backing store + /** + public asPrimitiveArray() { + if (data.hasArray()) { + switch (specializedOn) { + case U8: + return (T[]) ((ByteBuffer)data).array(); + break; + } + // case U8: - public byte[] asByteArray() { - return (byte[])((ByteBuffer)data).array(); + // break; + // case U16: + // data = bytes.asShortBuffer(); + // break; + // case U32: + // data = bytes.asIntBuffer(); + // break; + // case U64: + // data = bytes.asLongBuffer(); + // break; + + // data.array(); + } + program_error("Not able to get underlying bytes for BasicVectorBuffer."); + // not reached + return null; } - public short[] asShortArray() { - return (short[])((ShortBuffer)data).array(); + */ + + byte[] asByteArray() { + if (data.hasArray()) { + data.array(); + } + program_error("Not able to get underlying bytes for BasicVectorBuffer."); + // not reached + return null; + } + + short[] asShortArray() { + if (data.hasArray()) { + data.array(); + } + program_error("Not able to get underlying shorts for BasicVectorBuffer."); + // not reached + return null; } - public int[] asIntArray() { - return (int[])((IntBuffer)data).array(); + + int[] asIntArray() { + if (data.hasArray()) { + data.array(); + } + program_error("Not able to get underlying ints for BasicVectorBuffer."); + // not reached + return null; } - public long[] asLongArray() { - return (long[])((LongBuffer)data).array(); + + long[] asLongArray() { + if (data.hasArray()) { + data.array(); + } + program_error("Not able to get underlying longs for BasicVectorBuffer."); + // not reached + return null; } + + // TODO constructor that takes an existing ByteBuffer as its backing store + + // public byte[] asByteArray() { + // return (byte[])((ByteBuffer)data).array(); + // } + // public short[] asShortArray() { + // return (short[])((ShortBuffer)data).array(); + // } + // public int[] asIntArray() { + // return (int[])((IntBuffer)data).array(); + // } + // public long[] asLongArray() { + // return (long[])((LongBuffer)data).array(); + // } + public LispObject getDescription() { StringBuffer sb = new StringBuffer("A simple vector baced with a java.nio.Buffer implementation. ") @@ -136,21 +204,18 @@ public LispObject subseq(int start, int end) { switch (specializedOn) { case U8: result = new BasicVectorBuffer(ByteBuffer.class, length); - ((ByteBuffer)data).get(result.asByteArray(), start, length); break; case U16: result = new BasicVectorBuffer(ShortBuffer.class, length); - ((ShortBuffer)data).get(result.asShortArray(), start, length); break; case U32: result = new BasicVectorBuffer(IntBuffer.class, length); - ((IntBuffer)data).get(result.asIntArray(), start, length); break; case U64: result = new BasicVectorBuffer(LongBuffer.class, length); - ((LongBuffer)data).get(result.asLongArray(), start, length); break; } + result.bytes.put(asByteArray(), start, length * specializedOn.totalBytes); return result; } catch (ArrayIndexOutOfBoundsException e) { String m @@ -163,13 +228,25 @@ public LispObject subseq(int start, int end) { @Override public void fill(LispObject obj) { // TODO switch on CLAZZ - byte b = coerceToJavaByte(obj); - fill(b); + switch (specializedOn) { + case U8: + byte b = coerceToJavaByte(obj); + Arrays.fill(asByteArray(), b); + break; + case U16: + short s = coerceToJavaUnsignedShort(obj); + Arrays.fill(asShortArray(), s); + break; + case U32: + int i = coerceToJavaUnsignedShort(obj); + Arrays.fill(asIntArray(), i); + break; + case U64: + break; + } } - public void fill(byte b) { - Arrays.fill(((ByteBuffer)data).array(), b); - } + // Does AbstractVector.deleteEq() could work, as well but is it faster? /** From f8157f08cc6c030994ffb9d0758d7050ccfa1ee8 Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Sun, 10 Sep 2023 09:34:37 +0200 Subject: [PATCH 28/36] Simple vectors backed with java.nio.Buffer *might* work --- src/org/armedbear/lisp/BasicVectorBuffer.java | 165 ++++++++++-------- 1 file changed, 95 insertions(+), 70 deletions(-) diff --git a/src/org/armedbear/lisp/BasicVectorBuffer.java b/src/org/armedbear/lisp/BasicVectorBuffer.java index 1166a60b1..bdf06d95f 100644 --- a/src/org/armedbear/lisp/BasicVectorBuffer.java +++ b/src/org/armedbear/lisp/BasicVectorBuffer.java @@ -21,8 +21,13 @@ public final class BasicVectorBuffer extends BasicVector { // boolean directAllocation; directly allocate Buffer don't have backing arrays TODO subclass that behavior + + + /** The u8 bytes for this vector */ + ByteBuffer bytes; + + /** A view of the underlying bytes by specialization */ Buffer data; - ByteBuffer bytes; public BasicVectorBuffer(Class type, int capacity) { super(type, capacity); @@ -44,35 +49,6 @@ public BasicVectorBuffer(Class type, int capacity) { } } - /** - public asPrimitiveArray() { - if (data.hasArray()) { - switch (specializedOn) { - case U8: - return (T[]) ((ByteBuffer)data).array(); - break; - } - // case U8: - - // break; - // case U16: - // data = bytes.asShortBuffer(); - // break; - // case U32: - // data = bytes.asIntBuffer(); - // break; - // case U64: - // data = bytes.asLongBuffer(); - // break; - - // data.array(); - } - program_error("Not able to get underlying bytes for BasicVectorBuffer."); - // not reached - return null; - } - */ - byte[] asByteArray() { if (data.hasArray()) { data.array(); @@ -274,44 +250,74 @@ public LispObject deleteEq(byte b) { } */ - // // TODO check on use of AbstractVector.deleteEql() - // @Override public void shrink(int n) { if (n < capacity) { - // thunk on CLAZZ - BasicVectorBuffer result - = new BasicVectorBuffer(ByteBuffer.class, n); - ((ByteBuffer)data).get(result.asByteArray(), 0, n); + bytes.limit(n * specializedOn.totalBytes); + switch (specializedOn) { + case U8: + break; + case U16: + data = bytes.asShortBuffer(); + data.limit(n); + break; + case U32: + data = bytes.asIntBuffer(); + data.limit(n); + break; + case U64: + data = bytes.asLongBuffer(); + data.limit(n); + break; + } capacity = n; return; } if (n == capacity) { return; } - error(new LispError()); + simple_error("Unable to shrink vector ~a to size ~a.", this, n); } @Override public LispObject reverse() { - BasicVectorBuffer result = new BasicVectorBuffer(type, capacity); + BasicVectorBuffer result = null; int i, j; - // switch (onSpecialization) { - // case U8: - ByteBuffer source = (ByteBuffer)data; - ByteBuffer destination = (ByteBuffer)result.data; - // break; - // case U16: - // break; - // case U32: - // break; - // case U64: - // break; - // } - for (i = 0, j = capacity - 1; i < capacity; i++, j--) { - destination.put(i, source.get(j)); + switch (specializedOn) { + case U8: + result = new BasicVectorBuffer(ByteBuffer.class, capacity); + ByteBuffer byteSource = bytes; + ByteBuffer byteDestination = result.bytes; + for (i = 0, j = capacity - 1; i < capacity; i++, j--) { + byteDestination.put(i, byteSource.get(j)); + } + break; + case U16: + result = new BasicVectorBuffer(ShortBuffer.class, capacity); + ShortBuffer shortSource = (ShortBuffer)data; + ShortBuffer shortDestination = (ShortBuffer)result.data; + for (i = 0, j = capacity - 1; i < capacity; i++, j--) { + shortDestination.put(i, shortSource.get(j)); + } + break; + case U32: + result = new BasicVectorBuffer(IntBuffer.class, capacity); + IntBuffer intSource = (IntBuffer)data; + IntBuffer intDestination = (IntBuffer)result.data; + for (i = 0, j = capacity - 1; i < capacity; i++, j--) { + intDestination.put(i, intSource.get(j)); + } + break; + case U64: + result = new BasicVectorBuffer(LongBuffer.class, capacity); + LongBuffer longSource = (LongBuffer)data; + LongBuffer longDestination = (LongBuffer)result.data; + for (i = 0, j = capacity - 1; i < capacity; i++, j--) { + longDestination.put(i, longSource.get(j)); + } + break; } return result; } @@ -320,25 +326,44 @@ public LispObject reverse() { public LispObject nreverse() { int i = 0; int j = capacity() - 1; - // switch (onSpecialization) { - // case U8: - ByteBuffer buffer = (ByteBuffer)data; - while (i < j) { - byte temp = buffer.get(i); - buffer.put(i, buffer.get(j)); - buffer.put(j, temp); - ++i; - --j; + switch (specializedOn) { + case U8: + ByteBuffer byteBuffer = (ByteBuffer)data; + while (i < j) { + byte temp = byteBuffer.get(i); + byteBuffer.put(i, byteBuffer.get(j)); + byteBuffer.put(j, temp); + ++i; --j; + } + break; + case U16: + ShortBuffer shortBuffer = (ShortBuffer)data; + while (i < j) { + short temp = shortBuffer.get(i); + shortBuffer.put(i, shortBuffer.get(j)); + shortBuffer.put(j, temp); + ++i; --j; + } + break; + case U32: + IntBuffer intBuffer = (IntBuffer)data; + while (i < j) { + int temp = intBuffer.get(i); + intBuffer.put(i, intBuffer.get(j)); + intBuffer.put(j, temp); + ++i; --j; + } + break; + case U64: + LongBuffer longBuffer = (LongBuffer)data; + while (i < j) { + long temp = longBuffer.get(i); + longBuffer.put(i, longBuffer.get(j)); + longBuffer.put(j, temp); + ++i; --j; + } + break; } - // break; - // case U16: - // break; - // case U32: - // break; - // case U64: - // break; - // } - return this; } From 26de4f86442f54aafc1b3e4b8010482793aafbdd Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Mon, 11 Sep 2023 07:23:42 +0200 Subject: [PATCH 29/36] t: fix mistake in test output --- t/byte-vectors.lisp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/t/byte-vectors.lisp b/t/byte-vectors.lisp index 0b5cacad4..5f1b8cca4 100644 --- a/t/byte-vectors.lisp +++ b/t/byte-vectors.lisp @@ -112,7 +112,7 @@ :nio-buffer nio-buffer))) (prove:ok (equalp original result) - (format nil "Creating an (unsigned-byte 8) array from nio-buffer where~%~2t~a EQUALP ~a" result result)))) + (format nil "Creating an (unsigned-byte 32) array from nio-buffer where~%~2t~a EQUALP ~a" result result)))) (prove:finalize) From d428232a60005768e43ee08c2858acdc234e0b78 Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Mon, 11 Sep 2023 07:24:29 +0200 Subject: [PATCH 30/36] whitespace --- src/org/armedbear/lisp/Lisp.java | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/org/armedbear/lisp/Lisp.java b/src/org/armedbear/lisp/Lisp.java index dee073f1f..ea5991ff4 100644 --- a/src/org/armedbear/lisp/Lisp.java +++ b/src/org/armedbear/lisp/Lisp.java @@ -1809,7 +1809,7 @@ public static final char coerceToJavaChar(LispObject obj) { } public static final byte coerceToJavaByte(LispObject obj) { - return (byte)Fixnum.getValue(obj); + return (byte)Fixnum.getValue(obj); } public static final short coerceToJavaUnsignedShort(LispObject obj) { From 86267feb8b3dba921b6f366a27757210b8f6a779 Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Mon, 11 Sep 2023 07:24:56 +0200 Subject: [PATCH 31/36] Java static constant for 2^32 fixnum --- src/org/armedbear/lisp/Bignum.java | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/org/armedbear/lisp/Bignum.java b/src/org/armedbear/lisp/Bignum.java index 2d5b24f16..9f0859b41 100644 --- a/src/org/armedbear/lisp/Bignum.java +++ b/src/org/armedbear/lisp/Bignum.java @@ -46,6 +46,9 @@ public final class Bignum extends LispInteger private static BigInteger MOST_POSITIVE_FIXNUM = BigInteger.valueOf(Integer.MAX_VALUE); + final static LispInteger MAX_UNSIGNED_BYTE_32 + = Bignum.getInstance("4294967296", 10); // 2^32 + public static LispInteger getInstance(long l) { if (Integer.MIN_VALUE <= l && l <= Integer.MAX_VALUE) return Fixnum.getInstance(l); From 2823cbfe3735cc1388a35ab27e3609d8972e2f9b Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Mon, 11 Sep 2023 07:25:34 +0200 Subject: [PATCH 32/36] Check Lisp type for operations on specialized simple vectors Mark BasicVector as abstract. --- src/org/armedbear/lisp/BasicVector.java | 36 ++++++++++-- src/org/armedbear/lisp/BasicVectorBuffer.java | 56 ++++++++++--------- .../armedbear/lisp/BasicVectorPrimitive.java | 25 +++++---- 3 files changed, 73 insertions(+), 44 deletions(-) diff --git a/src/org/armedbear/lisp/BasicVector.java b/src/org/armedbear/lisp/BasicVector.java index 1d5d8080b..75e0f3eab 100644 --- a/src/org/armedbear/lisp/BasicVector.java +++ b/src/org/armedbear/lisp/BasicVector.java @@ -8,7 +8,7 @@ All BasicVectors are children of SimpleVector. */ -public class BasicVector +abstract public class BasicVector extends SimpleVector { public enum Specialization { @@ -24,13 +24,13 @@ private Specialization(int bytes) { Specialization specializedOn; public BasicVector(Class type) { - if (type.equals(Byte.class)) { + if (type.equals(Byte.class) || type.equals(byte.class)) { specializedOn = Specialization.U8; - } else if (type.equals(Short.class)) { + } else if (type.equals(Short.class) || type.equals(short.class)) { specializedOn = Specialization.U16; - } else if (type.equals(Integer.class)) { + } else if (type.equals(Integer.class) || type.equals(int.class)) { specializedOn = Specialization.U32; - } else if (type.equals(Long.class)) { + } else if (type.equals(Long.class)|| type.equals(long.class)) { specializedOn = Specialization.U64; } } @@ -123,4 +123,30 @@ public LispObject getDescription() { return new SimpleString(sb); } + LispInteger coerceToElementType(LispObject o) { + LispInteger result = LispInteger.coerce(o); + switch (specializedOn) { + case U8: + if (result.isLessThan(0) + || result.isGreaterThan(255)) { + return (LispInteger) type_error(result, UNSIGNED_BYTE_8); + } + break; + case U16: + if (result.isLessThan(0) + || result.isGreaterThan(65536)) { + return (LispInteger) type_error(result, UNSIGNED_BYTE_16); + } + break; + case U32: + if (result.isLessThan(0) + || result.isGreaterThan(Bignum.MAX_UNSIGNED_BYTE_32)) { + return (LispInteger) type_error(result, UNSIGNED_BYTE_32); + } + break; + } + return result; + } + + } diff --git a/src/org/armedbear/lisp/BasicVectorBuffer.java b/src/org/armedbear/lisp/BasicVectorBuffer.java index bdf06d95f..e98bd5007 100644 --- a/src/org/armedbear/lisp/BasicVectorBuffer.java +++ b/src/org/armedbear/lisp/BasicVectorBuffer.java @@ -51,36 +51,36 @@ public BasicVectorBuffer(Class type, int capacity) { byte[] asByteArray() { if (data.hasArray()) { - data.array(); + return (byte[])data.array(); } - program_error("Not able to get underlying bytes for BasicVectorBuffer."); + program_error("Unable to get underlying bytes for BasicVectorBuffer."); // not reached return null; } short[] asShortArray() { if (data.hasArray()) { - data.array(); + return (short[])data.array(); } - program_error("Not able to get underlying shorts for BasicVectorBuffer."); + program_error("Unable to get underlying shorts for BasicVectorBuffer."); // not reached return null; } int[] asIntArray() { if (data.hasArray()) { - data.array(); + return (int[])data.array(); } - program_error("Not able to get underlying ints for BasicVectorBuffer."); + program_error("Unable to get underlying ints for BasicVectorBuffer."); // not reached return null; } long[] asLongArray() { if (data.hasArray()) { - data.array(); + return (long[])data.array(); } - program_error("Not able to get underlying longs for BasicVectorBuffer."); + program_error("Unable to get underlying longs for BasicVectorBuffer."); // not reached return null; } @@ -113,11 +113,11 @@ public LispObject getDescription() { @Override public LispObject elt(int i) { - return AREF(i); + return SVREF(i); } @Override - public LispObject AREF(int i) { + public LispObject SVREF(int i) { try { switch (specializedOn) { case U8: @@ -136,24 +136,24 @@ public LispObject AREF(int i) { } @Override - public void aset(int i, LispObject n) { + public void svset(int i, LispObject n) { + LispInteger o = coerceToElementType(n); try { switch (specializedOn) { case U8: - byte b = coerceToJavaByte(n); + byte b = coerceToJavaByte(o); ((ByteBuffer)data).put(i, b); break; case U16: - short s = coerceToJavaUnsignedShort(n); + short s = coerceToJavaUnsignedShort(o); ((ShortBuffer)data).put(i, s); break; case U32: - int v = coerceToJavaUnsignedInt(n); + int v = coerceToJavaUnsignedInt(o); ((IntBuffer)data).put(i, v); break; case U64: - LispInteger lispInteger = LispInteger.coerce(n); - long l = LispInteger.asUnsignedLong(lispInteger); + long l = LispInteger.asUnsignedLong(o); ((LongBuffer)data).put(i, l); break; } @@ -163,13 +163,13 @@ public void aset(int i, LispObject n) { } @Override - public LispObject SVREF(int i) { - return AREF(i); + public LispObject AREF(int i) { + return SVREF(i); } @Override - public void svset(int i, LispObject newValue) { - aset(i, newValue); + public void aset(int i, LispObject newValue) { + svset(i, newValue); } @Override @@ -203,28 +203,29 @@ public LispObject subseq(int start, int end) { } @Override - public void fill(LispObject obj) { // TODO switch on CLAZZ + public void fill(LispObject obj) { + LispInteger o = coerceToElementType(obj); switch (specializedOn) { case U8: - byte b = coerceToJavaByte(obj); + byte b = coerceToJavaByte(o); Arrays.fill(asByteArray(), b); break; case U16: - short s = coerceToJavaUnsignedShort(obj); + short s = coerceToJavaUnsignedShort(o); Arrays.fill(asShortArray(), s); break; case U32: - int i = coerceToJavaUnsignedShort(obj); + int i = coerceToJavaUnsignedShort(o); Arrays.fill(asIntArray(), i); break; case U64: + long l = LispInteger.asUnsignedLong(o); + Arrays.fill(asLongArray(), l); break; } } - - - // Does AbstractVector.deleteEq() could work, as well but is it faster? + // AbstractVector.deleteEq() should work, as well but is it faster? /** @Override public LispObject deleteEq(LispObject item) { @@ -381,5 +382,6 @@ public AbstractVector replace(AbstractVector source, return super.replace(source, targetStart, targetEnd, sourceStart, sourceEnd); } } + } diff --git a/src/org/armedbear/lisp/BasicVectorPrimitive.java b/src/org/armedbear/lisp/BasicVectorPrimitive.java index 968fcddca..0b9950c29 100644 --- a/src/org/armedbear/lisp/BasicVectorPrimitive.java +++ b/src/org/armedbear/lisp/BasicVectorPrimitive.java @@ -19,7 +19,7 @@ public final class BasicVectorPrimitive extends BasicVector { - // TODO do this as a single u8 array, with views as shorts, ints, and longs + // TODO ??? do this as a single u8 array, with views as shorts, ints, and longs byte[] u8; short[] u16; int[] u32; @@ -100,24 +100,23 @@ public LispObject SVREF(int i) { } public void svset(int i, LispObject n) { + LispInteger o = coerceToElementType(n); try { switch (specializedOn) { case U8: - byte b = coerceToJavaByte(n); + byte b = coerceToJavaByte(o); u8[i] = b; break; case U16: - short s = coerceToJavaUnsignedShort(n); + short s = coerceToJavaUnsignedShort(o); u16[i] = s; break; case U32: - int v = coerceToJavaUnsignedInt(n); + int v = coerceToJavaUnsignedInt(o); u32[i] = v; break; case U64: - // TODO: consider asUnsignedLong should be an instance method - LispInteger lispInteger = LispInteger.coerce(n); - long l = LispInteger.asUnsignedLong(lispInteger); + long l = LispInteger.asUnsignedLong(o); u64[i] = l; break; } @@ -154,21 +153,23 @@ public LispObject subseq(int start, int end) { @Override public void fill(LispObject obj) { + LispInteger o = coerceToElementType(obj); switch (specializedOn) { case U8: - byte b = coerceToJavaByte(obj); + byte b = coerceToJavaByte(o); Arrays.fill(u8, b); break; case U16: - short s = coerceToJavaUnsignedShort(obj); + short s = coerceToJavaUnsignedShort(o); Arrays.fill(u16, s); break; case U32: - int i = coerceToJavaUnsignedInt(obj); - Arrays.fill(u32,i); + int i = coerceToJavaUnsignedInt(o); + Arrays.fill(u32, i); break; case U64: - program_error("Unimplemented fill of U64"); + long l = LispInteger.asUnsignedLong(o); + Arrays.fill(u64, l); break; } } From 7cc2638b2fbf3bf01be718c3b724a1c655d15d0a Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Mon, 11 Sep 2023 07:26:45 +0200 Subject: [PATCH 33/36] Move comment for asUnsignedLong() --- src/org/armedbear/lisp/LispInteger.java | 1 + 1 file changed, 1 insertion(+) diff --git a/src/org/armedbear/lisp/LispInteger.java b/src/org/armedbear/lisp/LispInteger.java index 70993e89e..8bfaab1d4 100644 --- a/src/org/armedbear/lisp/LispInteger.java +++ b/src/org/armedbear/lisp/LispInteger.java @@ -62,6 +62,7 @@ public static LispInteger getUnsignedInstance(long l) { return getInstance(l); } + // TODO ??? consider asUnsignedLong should be an instance method public static long asUnsignedLong(LispInteger i) { if (i instanceof Bignum) { return ((Bignum)i).value.longValue(); From c4b381e80a331c9863cc1b89319db0b496a532f8 Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Mon, 11 Sep 2023 10:11:48 +0200 Subject: [PATCH 34/36] Fix SUBSEQ and REVERSE on SIMPLE-VECTORS backed by NIO classes --- src/org/armedbear/lisp/BasicVectorBuffer.java | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/src/org/armedbear/lisp/BasicVectorBuffer.java b/src/org/armedbear/lisp/BasicVectorBuffer.java index e98bd5007..80fdaf576 100644 --- a/src/org/armedbear/lisp/BasicVectorBuffer.java +++ b/src/org/armedbear/lisp/BasicVectorBuffer.java @@ -174,21 +174,21 @@ public void aset(int i, LispObject newValue) { @Override public LispObject subseq(int start, int end) { - int length = start - end; + int length = end - start; try { BasicVectorBuffer result = null; switch (specializedOn) { case U8: - result = new BasicVectorBuffer(ByteBuffer.class, length); + result = new BasicVectorBuffer(Byte.class, length); break; case U16: - result = new BasicVectorBuffer(ShortBuffer.class, length); + result = new BasicVectorBuffer(Short.class, length); break; case U32: - result = new BasicVectorBuffer(IntBuffer.class, length); + result = new BasicVectorBuffer(Integer.class, length); break; case U64: - result = new BasicVectorBuffer(LongBuffer.class, length); + result = new BasicVectorBuffer(Long.class, length); break; } result.bytes.put(asByteArray(), start, length * specializedOn.totalBytes); @@ -288,7 +288,7 @@ public LispObject reverse() { int i, j; switch (specializedOn) { case U8: - result = new BasicVectorBuffer(ByteBuffer.class, capacity); + result = new BasicVectorBuffer(Byte.class, capacity); ByteBuffer byteSource = bytes; ByteBuffer byteDestination = result.bytes; for (i = 0, j = capacity - 1; i < capacity; i++, j--) { @@ -296,7 +296,7 @@ public LispObject reverse() { } break; case U16: - result = new BasicVectorBuffer(ShortBuffer.class, capacity); + result = new BasicVectorBuffer(Short.class, capacity); ShortBuffer shortSource = (ShortBuffer)data; ShortBuffer shortDestination = (ShortBuffer)result.data; for (i = 0, j = capacity - 1; i < capacity; i++, j--) { @@ -304,7 +304,7 @@ public LispObject reverse() { } break; case U32: - result = new BasicVectorBuffer(IntBuffer.class, capacity); + result = new BasicVectorBuffer(Integer.class, capacity); IntBuffer intSource = (IntBuffer)data; IntBuffer intDestination = (IntBuffer)result.data; for (i = 0, j = capacity - 1; i < capacity; i++, j--) { @@ -312,7 +312,7 @@ public LispObject reverse() { } break; case U64: - result = new BasicVectorBuffer(LongBuffer.class, capacity); + result = new BasicVectorBuffer(Long.class, capacity); LongBuffer longSource = (LongBuffer)data; LongBuffer longDestination = (LongBuffer)result.data; for (i = 0, j = capacity - 1; i < capacity; i++, j--) { From 7bf4b401c7bb0d1318fa2d238e7250899efefc82 Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Tue, 21 Nov 2023 23:23:57 +0100 Subject: [PATCH 35/36] NIO backed unsigned types working for IRONCLAD --- src/org/armedbear/lisp/BasicVector.java | 9 +++++- .../armedbear/lisp/BasicVectorPrimitive.java | 30 +++++++++++++++---- src/org/armedbear/lisp/Bignum.java | 2 ++ src/org/armedbear/lisp/LispInteger.java | 24 +++++++++++++-- src/org/armedbear/lisp/SimpleVector.java | 5 ++-- 5 files changed, 60 insertions(+), 10 deletions(-) diff --git a/src/org/armedbear/lisp/BasicVector.java b/src/org/armedbear/lisp/BasicVector.java index 75e0f3eab..e666e3c0f 100644 --- a/src/org/armedbear/lisp/BasicVector.java +++ b/src/org/armedbear/lisp/BasicVector.java @@ -123,8 +123,9 @@ public LispObject getDescription() { return new SimpleString(sb); } + // should be coerceToUnsignedElementType??? LispInteger coerceToElementType(LispObject o) { - LispInteger result = LispInteger.coerce(o); + LispInteger result = LispInteger.coerceAsUnsigned(o); switch (specializedOn) { case U8: if (result.isLessThan(0) @@ -144,6 +145,12 @@ LispInteger coerceToElementType(LispObject o) { return (LispInteger) type_error(result, UNSIGNED_BYTE_32); } break; + case U64: + if (result.isLessThan(0) + || result.isGreaterThan(Bignum.MAX_UNSIGNED_BYTE_64)) { + return (LispInteger) type_error(result, UNSIGNED_BYTE_32); + } + break; } return result; } diff --git a/src/org/armedbear/lisp/BasicVectorPrimitive.java b/src/org/armedbear/lisp/BasicVectorPrimitive.java index 0b9950c29..285c9f16c 100644 --- a/src/org/armedbear/lisp/BasicVectorPrimitive.java +++ b/src/org/armedbear/lisp/BasicVectorPrimitive.java @@ -100,23 +100,43 @@ public LispObject SVREF(int i) { } public void svset(int i, LispObject n) { - LispInteger o = coerceToElementType(n); + // LispInteger o = coerceToElementType(n); try { switch (specializedOn) { case U8: - byte b = coerceToJavaByte(o); + byte b; + if (n instanceof JavaObject) { + b = ((java.lang.Number)((JavaObject)n).getObject()).byteValue(); + } else { + b = coerceToJavaByte((LispInteger)n); + } u8[i] = b; break; case U16: - short s = coerceToJavaUnsignedShort(o); + short s; + if (n instanceof JavaObject) { + s = ((java.lang.Number)((JavaObject)n).getObject()).shortValue(); + } else { + s = coerceToJavaUnsignedShort(n); + } u16[i] = s; break; case U32: - int v = coerceToJavaUnsignedInt(o); + int v; + if (n instanceof JavaObject) { + v = ((java.lang.Number)((JavaObject)n).getObject()).intValue(); + } else { + v = coerceToJavaUnsignedInt(n); + } u32[i] = v; break; case U64: - long l = LispInteger.asUnsignedLong(o); + long l; + if (n instanceof JavaObject) { + l = ((java.lang.Number)((JavaObject)n).getObject()).longValue(); + } else { + l = LispInteger.asUnsignedLong((LispInteger)n); + } u64[i] = l; break; } diff --git a/src/org/armedbear/lisp/Bignum.java b/src/org/armedbear/lisp/Bignum.java index 9f0859b41..ab526e272 100644 --- a/src/org/armedbear/lisp/Bignum.java +++ b/src/org/armedbear/lisp/Bignum.java @@ -48,6 +48,8 @@ public final class Bignum extends LispInteger final static LispInteger MAX_UNSIGNED_BYTE_32 = Bignum.getInstance("4294967296", 10); // 2^32 + final static LispInteger MAX_UNSIGNED_BYTE_64 + = Bignum.getInstance("4611686018427387904", 10); // 2^64 public static LispInteger getInstance(long l) { if (Integer.MIN_VALUE <= l && l <= Integer.MAX_VALUE) diff --git a/src/org/armedbear/lisp/LispInteger.java b/src/org/armedbear/lisp/LispInteger.java index 8bfaab1d4..e827c1595 100644 --- a/src/org/armedbear/lisp/LispInteger.java +++ b/src/org/armedbear/lisp/LispInteger.java @@ -70,10 +70,30 @@ public static long asUnsignedLong(LispInteger i) { return i.longValue(); } - public static LispInteger coerce(LispObject o) { + public static LispInteger coerceAsUnsigned(LispObject o) { + // TODO what should we return if we are already a negative + // LispInteger? currently only used in coercing unsigned byte + // types, for which we should maybe use the expected size to + // interpret negative values? This would help when dealing with + // converting signed Java byte/short/int/long but wouldn't be + // conforming ANSI behavior. if (o instanceof LispInteger) { return (LispInteger)o; } - return (LispInteger) type_error(o, (LispObject)new JavaObject(LispInteger.class)); + if (o instanceof JavaObject) { + Object obj = o.javaInstance(); + if (obj instanceof Byte) { + return getInstance(Byte.toUnsignedInt(((Byte)obj).byteValue())); + } else if (obj instanceof Short) { + return getInstance(Short.toUnsignedInt(((Short)obj).shortValue())); + } else if (obj instanceof Integer) { + return getUnsignedInstance(Integer.toUnsignedLong(((Integer)obj).intValue())); + } else if (obj instanceof Long) { + return getUnsignedInstance(((Long)obj).longValue()); + } + } + + return (LispInteger) type_error("Failed to coerce to unsigned integer", + o, (LispObject)new JavaObject(LispInteger.class)); } } diff --git a/src/org/armedbear/lisp/SimpleVector.java b/src/org/armedbear/lisp/SimpleVector.java index cc4c769b4..68be065b1 100644 --- a/src/org/armedbear/lisp/SimpleVector.java +++ b/src/org/armedbear/lisp/SimpleVector.java @@ -345,8 +345,9 @@ public AbstractVector replace(AbstractVector source, int targetStart, int targetEnd, int sourceStart, int sourceEnd) { - if (source instanceof SimpleVector) { - // data = Array.copyOfRange ... ? + if (source instanceof SimpleVector + // XXX how to determine more elegantly an exact type + && this.getClass().getSimpleName().equals("SimpleVector")) { System.arraycopy(((SimpleVector)source).data, sourceStart, data, targetStart, Math.min(targetEnd - targetStart, sourceEnd - sourceStart)); return this; From b9164faa2d999e77d44039a9babad1720c77ebc1 Mon Sep 17 00:00:00 2001 From: Mark Evenson Date: Tue, 21 Nov 2023 23:24:44 +0100 Subject: [PATCH 36/36] Wire in usage of (UNSIGNED-BYTE 8) types --- src/org/armedbear/lisp/make_array.java | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/src/org/armedbear/lisp/make_array.java b/src/org/armedbear/lisp/make_array.java index 585c8fd67..53312ce05 100644 --- a/src/org/armedbear/lisp/make_array.java +++ b/src/org/armedbear/lisp/make_array.java @@ -182,10 +182,12 @@ public LispObject execute(LispObject[] args) { v = new BasicVector_ByteBuffer((java.nio.ByteBuffer)(((JavaObject)nioBuffer).getObject()), directAllocation); } else { - v = new BasicVector_ByteBuffer(size, directAllocation); + // v = new BasicVector_ByteBuffer(size, directAllocation); + v = new BasicVectorBuffer(Byte.class, size); } } else { //if (Java.Buffers.active.equals(AllocationPolicy.PRIMITIVE_ARRAY)) { - v = new BasicVector_UnsignedByte8(size); + //v = new BasicVector_UnsignedByte8(size); + v = new BasicVectorPrimitive(Byte.class, size); } } defaultInitialElement = Fixnum.ZERO;