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) diff --git a/src/org/armedbear/lisp/BasicVector.java b/src/org/armedbear/lisp/BasicVector.java new file mode 100644 index 000000000..e666e3c0f --- /dev/null +++ b/src/org/armedbear/lisp/BasicVector.java @@ -0,0 +1,159 @@ +package org.armedbear.lisp; + +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. +*/ +abstract public class BasicVector + extends SimpleVector +{ + public enum Specialization { + U8(1), U16(2), U32(4), U64(8); + + public final int totalBytes; + + private Specialization(int bytes) { + totalBytes = bytes; + } + + } + Specialization specializedOn; + + public BasicVector(Class type) { + if (type.equals(Byte.class) || type.equals(byte.class)) { + specializedOn = Specialization.U8; + } else if (type.equals(Short.class) || type.equals(short.class)) { + specializedOn = Specialization.U16; + } else if (type.equals(Integer.class) || type.equals(int.class)) { + specializedOn = Specialization.U32; + } else if (type.equals(Long.class)|| 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); + } + + @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 ").append(capacity).append(" elements").append(".") + .append("\n"); + return new SimpleString(sb); + } + + // should be coerceToUnsignedElementType??? + LispInteger coerceToElementType(LispObject o) { + LispInteger result = LispInteger.coerceAsUnsigned(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; + 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/BasicVectorBuffer.java b/src/org/armedbear/lisp/BasicVectorBuffer.java new file mode 100644 index 000000000..80fdaf576 --- /dev/null +++ b/src/org/armedbear/lisp/BasicVectorBuffer.java @@ -0,0 +1,387 @@ +package org.armedbear.lisp; + +import static org.armedbear.lisp.Lisp.*; + +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 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 +{ + // 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; + + public BasicVectorBuffer(Class type, int capacity) { + super(type, capacity); + bytes = ByteBuffer.allocate(capacity * specializedOn.totalBytes); + + switch (specializedOn) { + case U8: + data = bytes; + break; + case U16: + data = bytes.asShortBuffer(); + break; + case U32: + data = bytes.asIntBuffer(); + break; + case U64: + data = bytes.asLongBuffer(); + break; + } + } + + byte[] asByteArray() { + if (data.hasArray()) { + return (byte[])data.array(); + } + program_error("Unable to get underlying bytes for BasicVectorBuffer."); + // not reached + return null; + } + + short[] asShortArray() { + if (data.hasArray()) { + return (short[])data.array(); + } + program_error("Unable to get underlying shorts for BasicVectorBuffer."); + // not reached + return null; + } + + int[] asIntArray() { + if (data.hasArray()) { + return (int[])data.array(); + } + program_error("Unable to get underlying ints for BasicVectorBuffer."); + // not reached + return null; + } + + long[] asLongArray() { + if (data.hasArray()) { + return (long[])data.array(); + } + program_error("Unable 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. ") + .append("\n"); + sb.append("Whose superimplementation is ").append("\n") + .append(super.getDescription()); + + return new SimpleString(sb); + } + + @Override + public LispObject elt(int i) { + return SVREF(i); + } + + @Override + public LispObject SVREF(int i) { + try { + switch (specializedOn) { + case U8: + return coerceFromJavaByte(((ByteBuffer)data).get(i)); + case U16: + return Fixnum.getInstance(Short.toUnsignedInt(((ShortBuffer)data).get(i))); + case U32: + return Fixnum.getInstance(Integer.toUnsignedLong(((IntBuffer)data).get(i))); + case U64: + return LispInteger.getUnsignedInstance(((LongBuffer)data).get(i)); + } + return program_error("Bad array reference in BasicVectorBuffer for " + i); + } catch (ArrayIndexOutOfBoundsException e) { + return badIndex(i, capacity); + } + } + + @Override + public void svset(int i, LispObject n) { + LispInteger o = coerceToElementType(n); + try { + switch (specializedOn) { + case U8: + byte b = coerceToJavaByte(o); + ((ByteBuffer)data).put(i, b); + break; + case U16: + short s = coerceToJavaUnsignedShort(o); + ((ShortBuffer)data).put(i, s); + break; + case U32: + int v = coerceToJavaUnsignedInt(o); + ((IntBuffer)data).put(i, v); + break; + case U64: + long l = LispInteger.asUnsignedLong(o); + ((LongBuffer)data).put(i, l); + break; + } + } catch (IndexOutOfBoundsException e) { + badIndex(i, capacity); + } + } + + @Override + public LispObject AREF(int i) { + return SVREF(i); + } + + @Override + public void aset(int i, LispObject newValue) { + svset(i, newValue); + } + + @Override + public LispObject subseq(int start, int end) { + int length = end - start; + try { + BasicVectorBuffer result = null; + switch (specializedOn) { + case U8: + result = new BasicVectorBuffer(Byte.class, length); + break; + case U16: + result = new BasicVectorBuffer(Short.class, length); + break; + case U32: + result = new BasicVectorBuffer(Integer.class, length); + break; + case U64: + result = new BasicVectorBuffer(Long.class, length); + break; + } + result.bytes.put(asByteArray(), start, length * specializedOn.totalBytes); + 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()); + // 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) { + LispInteger o = coerceToElementType(obj); + switch (specializedOn) { + case U8: + byte b = coerceToJavaByte(o); + Arrays.fill(asByteArray(), b); + break; + case U16: + short s = coerceToJavaUnsignedShort(o); + Arrays.fill(asShortArray(), s); + break; + case U32: + int i = coerceToJavaUnsignedShort(o); + Arrays.fill(asIntArray(), i); + break; + case U64: + long l = LispInteger.asUnsignedLong(o); + Arrays.fill(asLongArray(), l); + break; + } + } + + // AbstractVector.deleteEq() should 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) { + 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; + } + simple_error("Unable to shrink vector ~a to size ~a.", this, n); + } + + @Override + public LispObject reverse() { + BasicVectorBuffer result = null; + int i, j; + switch (specializedOn) { + case U8: + result = new BasicVectorBuffer(Byte.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(Short.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(Integer.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(Long.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; + } + + @Override + public LispObject nreverse() { + int i = 0; + int j = capacity() - 1; + 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; + } + 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); + } + } + +} + diff --git a/src/org/armedbear/lisp/BasicVectorPrimitive.java b/src/org/armedbear/lisp/BasicVectorPrimitive.java new file mode 100644 index 000000000..285c9f16c --- /dev/null +++ b/src/org/armedbear/lisp/BasicVectorPrimitive.java @@ -0,0 +1,399 @@ +package org.armedbear.lisp; + +import static org.armedbear.lisp.Lisp.*; + +import java.lang.reflect.Array; +import java.nio.Buffer; +import java.text.MessageFormat; +import java.util.Arrays; + +/** + + 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 ??? do this as a single u8 array, with views as shorts, ints, and longs + byte[] u8; + short[] u16; + int[] u32; + long[] u64; + + public BasicVectorPrimitive(Class type, int 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]; + } + } + + 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("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); + } + + @Override + public LispObject AREF(int i) { + return SVREF(i); + } + + @Override + 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("Supposedly unreachable code in BasicVectorPrimitive"); + } + + public void svset(int i, LispObject n) { + // LispInteger o = coerceToElementType(n); + try { + switch (specializedOn) { + case U8: + 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; + if (n instanceof JavaObject) { + s = ((java.lang.Number)((JavaObject)n).getObject()).shortValue(); + } else { + s = coerceToJavaUnsignedShort(n); + } + u16[i] = s; + break; + case U32: + 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; + if (n instanceof JavaObject) { + l = ((java.lang.Number)((JavaObject)n).getObject()).longValue(); + } else { + l = LispInteger.asUnsignedLong((LispInteger)n); + } + u64[i] = l; + 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()); + // Not really a type_error, as there is not one type + return type_error(m, new JavaObject(e), NIL); + } + return program_error("Unreachable"); + } + + @Override + public void fill(LispObject obj) { + LispInteger o = coerceToElementType(obj); + switch (specializedOn) { + case U8: + byte b = coerceToJavaByte(o); + Arrays.fill(u8, b); + break; + case U16: + short s = coerceToJavaUnsignedShort(o); + Arrays.fill(u16, s); + break; + case U32: + int i = coerceToJavaUnsignedInt(o); + Arrays.fill(u32, i); + break; + case U64: + long l = LispInteger.asUnsignedLong(o); + Arrays.fill(u64, l); + 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); + 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; + } + if (n == capacity) { + return; + } + error(new LispError()); + } + + public LispObject reverse() { + BasicVectorPrimitive result = new BasicVectorPrimitive(type, capacity); + int i, 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() { + 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; + } + + @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/Bignum.java b/src/org/armedbear/lisp/Bignum.java index 2d5b24f16..ab526e272 100644 --- a/src/org/armedbear/lisp/Bignum.java +++ b/src/org/armedbear/lisp/Bignum.java @@ -46,6 +46,11 @@ 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 + 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) return Fixnum.getInstance(l); diff --git a/src/org/armedbear/lisp/Lisp.java b/src/org/armedbear/lisp/Lisp.java index 3c0dec995..ea5991ff4 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); @@ -1806,7 +1809,11 @@ 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) { + return (short) (obj.longValue() & 0xffffL); } public static final int coerceToJavaUnsignedInt(LispObject obj) { diff --git a/src/org/armedbear/lisp/LispInteger.java b/src/org/armedbear/lisp/LispInteger.java index 62e780c1c..e827c1595 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); @@ -50,5 +55,45 @@ 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); + } + + // TODO ??? consider asUnsignedLong should be an instance method + public static long asUnsignedLong(LispInteger i) { + if (i instanceof Bignum) { + return ((Bignum)i).value.longValue(); + } + return i.longValue(); + } + + 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; + } + 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 4850923c5..68be065b1 100644 --- a/src/org/armedbear/lisp/SimpleVector.java +++ b/src/org/armedbear/lisp/SimpleVector.java @@ -35,42 +35,52 @@ 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 // type is a subtype of type SIMPLE-VECTOR." -public final class SimpleVector extends AbstractVector +public class SimpleVector + extends AbstractVector + implements java.io.Serializable { int capacity; LispObject[] data; + Class type; // "always" LispObject for now - public SimpleVector(int capacity) - { - data = new LispObject[capacity]; - for (int i = capacity; i-- > 0;) - data[i] = Fixnum.ZERO; + public SimpleVector() { + } + + public SimpleVector(int capacity) { + this(LispObject.class, capacity); + } + + public SimpleVector(Class type, int capacity) { + this.type = type; this.capacity = capacity; + 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 = obj.copyToArray(); - capacity = data.length; + 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] = (LispObject) obj.AREF(i); // faster? Implement AbstractVector.asArray()? } - else if (obj instanceof AbstractVector) - { - capacity = obj.length(); - data = new LispObject[capacity]; - for (int i = 0; i < capacity; i++) - data[i] = obj.elt(i); - } - else + } else { Debug.assertTrue(false); + } } - public SimpleVector(LispObject[] array) - { + public SimpleVector(LispObject[] array) { data = array; capacity = array.length; } @@ -92,7 +102,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); } @@ -149,93 +159,57 @@ public int length() @Override public LispObject elt(int index) { - try - { - return 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] = 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 public void svset(int index, LispObject newValue) { - try - { + try { data[index] = newValue; - } - catch (ArrayIndexOutOfBoundsException e) - { - badIndex(index, capacity); - } + } catch (ArrayIndexOutOfBoundsException e) { + badIndex(index, capacity); + } } @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 { + 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()); + // 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) - { - for (int i = capacity; i-- > 0;) - data[i] = obj; + public void fill(LispObject obj) { + Arrays.fill(data, obj); } @Override @@ -275,26 +249,26 @@ 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(n); + System.arraycopy(data, 0, newArray.data, 0, n); + data = newArray.data; + capacity = n; + return; + } + if (n == capacity) { return; + } error(new LispError()); } @Override - public LispObject reverse() - { + public LispObject reverse() { SimpleVector result = new SimpleVector(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; } @@ -314,6 +288,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, @@ -368,10 +345,11 @@ public AbstractVector replace(AbstractVector source, int targetStart, int targetEnd, int sourceStart, int sourceEnd) { - if (source instanceof SimpleVector) { + 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)); + data, targetStart, Math.min(targetEnd - targetStart, sourceEnd - sourceStart)); return this; } else { return super.replace(source, targetStart, targetEnd, sourceStart, sourceEnd); @@ -384,23 +362,22 @@ 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) { + int index = Fixnum.getValue(second); + if (first instanceof BasicVectorPrimitive) { + return ((BasicVectorPrimitive)first).SVREF(index); + } + 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); + } }; // ### svset simple-vector index new-value => new-value @@ -410,22 +387,22 @@ 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); + int index = Fixnum.getValue(second); + if (first instanceof BasicVectorPrimitive) { + ((BasicVectorPrimitive)first).svset(index, third); + } + if (first instanceof SimpleVector) { + final SimpleVector sv = (SimpleVector)first; + try { + sv.data[index] = third; + return third; + } catch (ArrayIndexOutOfBoundsException e) { + int capacity = sv.capacity; + return sv.badIndex(index, capacity); + } + } + return type_error(first, Symbol.SIMPLE_VECTOR); } }; } 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; 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)