[armedbear-cvs] r11377 - trunk/j/src/org/armedbear/lisp
Erik Huelsmann
ehuelsmann at common-lisp.net
Sun Nov 2 22:06:34 UTC 2008
Author: ehuelsmann
Date: Sun Nov 2 22:06:34 2008
New Revision: 11377
Log:
Code reorganization: move stream related primitives from Primitives.java to Stream.java
for easier finding. (There were already some primitives in Stream.java.)
Also, merge read_char_no_hang.java and read_delimited_list.java into Stream.java.
Removed:
trunk/j/src/org/armedbear/lisp/read_char_no_hang.java
trunk/j/src/org/armedbear/lisp/read_delimited_list.java
Modified:
trunk/j/src/org/armedbear/lisp/Autoload.java
trunk/j/src/org/armedbear/lisp/Primitives.java
trunk/j/src/org/armedbear/lisp/Stream.java
Modified: trunk/j/src/org/armedbear/lisp/Autoload.java
==============================================================================
--- trunk/j/src/org/armedbear/lisp/Autoload.java (original)
+++ trunk/j/src/org/armedbear/lisp/Autoload.java Sun Nov 2 22:06:34 2008
@@ -425,8 +425,6 @@
autoload("print-not-readable-object", "PrintNotReadable");
autoload("probe-file", "probe_file");
autoload("rational", "FloatFunctions");
- autoload("read-char-no-hang", "read_char_no_hang");
- autoload("read-delimited-list", "read_delimited_list");
autoload("rem", "rem");
autoload("remhash", "HashTableFunctions");
autoload("remhash", "HashTableFunctions");
Modified: trunk/j/src/org/armedbear/lisp/Primitives.java
==============================================================================
--- trunk/j/src/org/armedbear/lisp/Primitives.java (original)
+++ trunk/j/src/org/armedbear/lisp/Primitives.java Sun Nov 2 22:06:34 2008
@@ -3999,238 +3999,6 @@
}
};
- // ### %stream-write-char character output-stream => character
- // OUTPUT-STREAM must be a real stream, not an output stream designator!
- private static final Primitive _WRITE_CHAR =
- new Primitive("%stream-write-char", PACKAGE_SYS, true,
- "character output-stream")
- {
- public LispObject execute(LispObject first, LispObject second)
- throws ConditionThrowable
- {
- try
- {
- ((Stream)second)._writeChar(((LispCharacter)first).value);
- }
- catch (ClassCastException e)
- {
- if (second instanceof Stream)
- return type_error(first, Symbol.CHARACTER);
- else
- return type_error(second, Symbol.STREAM);
- }
- return first;
- }
- };
-
- // ### %write-char character output-stream => character
- private static final Primitive _STREAM_WRITE_CHAR =
- new Primitive("%write-char", PACKAGE_SYS, false,
- "character output-stream")
- {
- public LispObject execute(LispObject first, LispObject second)
- throws ConditionThrowable
- {
- final char c;
- try
- {
- c = ((LispCharacter)first).value;
- }
- catch (ClassCastException e)
- {
- return type_error(first, Symbol.CHARACTER);
- }
- if (second == T)
- second = Symbol.TERMINAL_IO.symbolValue();
- else if (second == NIL)
- second = Symbol.STANDARD_OUTPUT.symbolValue();
- final Stream stream;
- try
- {
- stream = (Stream) second;
- }
- catch (ClassCastException e)
- {
- return type_error(second, Symbol.STREAM);
- }
- stream._writeChar(c);
- return first;
- }
- };
-
- // ### %write-string string output-stream start end => string
- private static final Primitive _WRITE_STRING =
- new Primitive("%write-string", PACKAGE_SYS, false,
- "string output-stream start end")
- {
- public LispObject execute(LispObject first, LispObject second,
- LispObject third, LispObject fourth)
- throws ConditionThrowable
- {
- final AbstractString s;
- try
- {
- s = (AbstractString) first;
- }
- catch (ClassCastException e)
- {
- return type_error(first, Symbol.STRING);
- }
- char[] chars = s.chars();
- final Stream out;
- try
- {
- if (second == T)
- out = (Stream) Symbol.TERMINAL_IO.symbolValue();
- else if (second == NIL)
- out = (Stream) Symbol.STANDARD_OUTPUT.symbolValue();
- else
- out = (Stream) second;
- }
- catch (ClassCastException e)
- {
- return type_error(second, Symbol.STREAM);
- }
- final int start;
- try
- {
- start = ((Fixnum)third).value;
- }
- catch (ClassCastException e)
- {
- return type_error(third, Symbol.FIXNUM);
- }
- final int end;
- if (fourth == NIL)
- end = chars.length;
- else
- {
- try
- {
- end = ((Fixnum)fourth).value;
- }
- catch (ClassCastException e)
- {
- return type_error(fourth, Symbol.FIXNUM);
- }
- }
- checkBounds(start, end, chars.length);
- out._writeChars(chars, start, end);
- return first;
- }
- };
-
- // ### %finish-output output-stream => nil
- private static final Primitive _FINISH_OUTPUT =
- new Primitive("%finish-output", PACKAGE_SYS, false, "output-stream")
- {
- public LispObject execute(LispObject arg) throws ConditionThrowable
- {
- return finishOutput(arg);
- }
- };
-
- // ### %force-output output-stream => nil
- private static final Primitive _FORCE_OUTPUT =
- new Primitive("%force-output", PACKAGE_SYS, false, "output-stream")
- {
- public LispObject execute(LispObject arg) throws ConditionThrowable
- {
- return finishOutput(arg);
- }
- };
-
- private static final LispObject finishOutput(LispObject arg)
- throws ConditionThrowable
- {
- final Stream out;
- try
- {
- if (arg == T)
- out = (Stream) Symbol.TERMINAL_IO.symbolValue();
- else if (arg == NIL)
- out = (Stream) Symbol.STANDARD_OUTPUT.symbolValue();
- else
- out = (Stream) arg;
- }
- catch (ClassCastException e)
- {
- return type_error(arg, Symbol.STREAM);
- }
- return out.finishOutput();
- }
-
- // ### clear-input &optional input-stream => nil
- private static final Primitive CLEAR_INPUT =
- new Primitive(Symbol.CLEAR_INPUT, "&optional input-stream")
- {
- public LispObject execute(LispObject[] args) throws ConditionThrowable
- {
- if (args.length > 1)
- return error(new WrongNumberOfArgumentsException(this));
- final Stream in;
- if (args.length == 0)
- in = checkCharacterInputStream(Symbol.STANDARD_INPUT.symbolValue());
- else
- in = inSynonymOf(args[0]);
- in.clearInput();
- return NIL;
- }
- };
-
- // ### %clear-output output-stream => nil
- // "If any of these operations does not make sense for output-stream, then
- // it does nothing."
- private static final Primitive _CLEAR_OUTPUT =
- new Primitive("%clear-output", PACKAGE_SYS, false, "output-stream")
- {
- public LispObject execute(LispObject arg) throws ConditionThrowable
- {
- if (arg == T) // *TERMINAL-IO*
- return NIL;
- if (arg == NIL) // *STANDARD-OUTPUT*
- return NIL;
- if (arg instanceof Stream)
- return NIL;
- return type_error(arg, Symbol.STREAM);
- }
- };
-
- // ### close stream &key abort => result
- private static final Primitive CLOSE =
- new Primitive(Symbol.CLOSE, "stream &key abort")
- {
- public LispObject execute(LispObject arg) throws ConditionThrowable
- {
- try
- {
- return ((Stream)arg).close(NIL);
- }
- catch (ClassCastException e)
- {
- return type_error(arg, Symbol.STREAM);
- }
- }
- public LispObject execute(LispObject first, LispObject second,
- LispObject third)
- throws ConditionThrowable
- {
- final Stream stream;
- try
- {
- stream = (Stream) first;
- }
- catch (ClassCastException e)
- {
- return type_error(first, Symbol.STREAM);
- }
- if (second == Keyword.ABORT)
- return stream.close(third);
- return error(new ProgramError("Unrecognized keyword argument " +
- second.writeToString() + "."));
- }
- };
-
// ### multiple-value-list form => list
// Evaluates form and creates a list of the multiple values it returns.
// Should be a macro.
@@ -4285,210 +4053,6 @@
}
};
- // ### out-synonym-of stream-designator => stream
- private static final Primitive OUT_SYNONYM_OF =
- new Primitive("out-synonym-of", PACKAGE_SYS, true, "stream-designator")
- {
- public LispObject execute (LispObject arg) throws ConditionThrowable
- {
- if (arg instanceof Stream)
- return arg;
- if (arg == T)
- return Symbol.TERMINAL_IO.symbolValue();
- if (arg == NIL)
- return Symbol.STANDARD_OUTPUT.symbolValue();
- return arg;
- }
- };
-
- // ### write-8-bits
- // write-8-bits byte stream => nil
- private static final Primitive WRITE_8_BITS =
- new Primitive("write-8-bits", PACKAGE_SYS, true, "byte stream")
- {
- public LispObject execute (LispObject first, LispObject second)
- throws ConditionThrowable
- {
- int n;
- try
- {
- n = ((Fixnum)first).value;
- }
- catch (ClassCastException e)
- {
- return type_error(first, Symbol.FIXNUM);
- }
- if (n < 0 || n > 255)
- return type_error(first, UNSIGNED_BYTE_8);
- try
- {
- ((Stream)second)._writeByte(n);
- return NIL;
- }
- catch (ClassCastException e)
- {
- return type_error(second, Symbol.STREAM);
- }
- }
- };
-
- // ### read-8-bits
- // read-8-bits stream &optional eof-error-p eof-value => byte
- private static final Primitive READ_8_BITS =
- new Primitive("read-8-bits", PACKAGE_SYS, true,
- "stream &optional eof-error-p eof-value")
- {
- public LispObject execute (LispObject first, LispObject second,
- LispObject third)
- throws ConditionThrowable
- {
- return checkBinaryInputStream(first).readByte((second != NIL),
- third);
- }
- public LispObject execute (LispObject[] args) throws ConditionThrowable
- {
- int length = args.length;
- if (length < 1 || length > 3)
- return error(new WrongNumberOfArgumentsException(this));
- final Stream in = checkBinaryInputStream(args[0]);
- boolean eofError = length > 1 ? (args[1] != NIL) : true;
- LispObject eofValue = length > 2 ? args[2] : NIL;
- return in.readByte(eofError, eofValue);
- }
- };
-
- // ### read-line &optional input-stream eof-error-p eof-value recursive-p
- // => line, missing-newline-p
- private static final Primitive READ_LINE =
- new Primitive(Symbol.READ_LINE,
- "&optional input-stream eof-error-p eof-value recursive-p")
- {
- public LispObject execute() throws ConditionThrowable
- {
- final LispObject obj = Symbol.STANDARD_INPUT.symbolValue();
- final Stream stream;
- try
- {
- stream = (Stream) obj;
- }
- catch (ClassCastException e)
- {
- return type_error(obj, Symbol.STREAM);
- }
- return stream.readLine(true, NIL);
- }
- public LispObject execute(LispObject arg) throws ConditionThrowable
- {
- if (arg == T)
- arg = Symbol.TERMINAL_IO.symbolValue();
- else if (arg == NIL)
- arg = Symbol.STANDARD_INPUT.symbolValue();
- final Stream stream;
- try
- {
- stream = (Stream) arg;
- }
- catch (ClassCastException e)
- {
- return type_error(arg, Symbol.STREAM);
- }
- return stream.readLine(true, NIL);
- }
- public LispObject execute(LispObject first, LispObject second)
- throws ConditionThrowable
- {
- if (first == T)
- first = Symbol.TERMINAL_IO.symbolValue();
- else if (first == NIL)
- first = Symbol.STANDARD_INPUT.symbolValue();
- final Stream stream;
- try
- {
- stream = (Stream) first;
- }
- catch (ClassCastException e)
- {
- return type_error(first, Symbol.STREAM);
- }
- return stream.readLine(second != NIL, NIL);
- }
- public LispObject execute(LispObject first, LispObject second,
- LispObject third)
- throws ConditionThrowable
- {
- if (first == T)
- first = Symbol.TERMINAL_IO.symbolValue();
- else if (first == NIL)
- first = Symbol.STANDARD_INPUT.symbolValue();
- final Stream stream;
- try
- {
- stream = (Stream) first;
- }
- catch (ClassCastException e)
- {
- return type_error(first, Symbol.STREAM);
- }
- return stream.readLine(second != NIL, third);
- }
- public LispObject execute(LispObject first, LispObject second,
- LispObject third, LispObject fourth)
- throws ConditionThrowable
- {
- // recursive-p is ignored
- if (first == T)
- first = Symbol.TERMINAL_IO.symbolValue();
- else if (first == NIL)
- first = Symbol.STANDARD_INPUT.symbolValue();
- final Stream stream;
- try
- {
- stream = (Stream) first;
- }
- catch (ClassCastException e)
- {
- return type_error(first, Symbol.STREAM);
- }
- return stream.readLine(second != NIL, third);
- }
- };
-
- // ### %read-from-string string eof-error-p eof-value start end preserve-whitespace
- // => object, position
- private static final Primitive _READ_FROM_STRING =
- new Primitive("%read-from-string", PACKAGE_SYS, false)
- {
- public LispObject execute(LispObject first, LispObject second,
- LispObject third, LispObject fourth,
- LispObject fifth, LispObject sixth)
- throws ConditionThrowable
- {
- String s = first.getStringValue();
- boolean eofError = (second != NIL);
- boolean preserveWhitespace = (sixth != NIL);
- final int startIndex;
- if (fourth != NIL)
- startIndex = Fixnum.getValue(fourth);
- else
- startIndex = 0;
- final int endIndex;
- if (fifth != NIL)
- endIndex = Fixnum.getValue(fifth);
- else
- endIndex = s.length();
- StringInputStream in =
- new StringInputStream(s, startIndex, endIndex);
- final LispThread thread = LispThread.currentThread();
- LispObject result;
- if (preserveWhitespace)
- result = in.readPreservingWhitespace(eofError, third, false,
- thread);
- else
- result = in.read(eofError, third, false, thread);
- return thread.setValues(result, new Fixnum(in.getOffset()));
- }
- };
-
// ### call-count
private static final Primitive CALL_COUNT =
new Primitive("call-count", PACKAGE_SYS, true)
@@ -4511,176 +4075,6 @@
}
};
- // ### read &optional input-stream eof-error-p eof-value recursive-p => object
- private static final Primitive READ =
- new Primitive(Symbol.READ,
- "&optional input-stream eof-error-p eof-value recursive-p")
- {
- public LispObject execute() throws ConditionThrowable
- {
- final LispThread thread = LispThread.currentThread();
- final LispObject obj = Symbol.STANDARD_INPUT.symbolValue(thread);
- final Stream stream;
- try
- {
- stream = (Stream) obj;
- }
- catch (ClassCastException e)
- {
- return type_error(obj, Symbol.STREAM);
- }
- return stream.read(true, NIL, false, thread);
- }
- public LispObject execute(LispObject arg) throws ConditionThrowable
- {
- final LispThread thread = LispThread.currentThread();
- if (arg == T)
- arg = Symbol.TERMINAL_IO.symbolValue(thread);
- else if (arg == NIL)
- arg = Symbol.STANDARD_INPUT.symbolValue(thread);
- final Stream stream;
- try
- {
- stream = (Stream) arg;
- }
- catch (ClassCastException e)
- {
- return type_error(arg, Symbol.STREAM);
- }
- return stream.read(true, NIL, false, thread);
- }
- public LispObject execute(LispObject first, LispObject second)
- throws ConditionThrowable
- {
- final LispThread thread = LispThread.currentThread();
- if (first == T)
- first = Symbol.TERMINAL_IO.symbolValue(thread);
- else if (first == NIL)
- first = Symbol.STANDARD_INPUT.symbolValue(thread);
- final Stream stream;
- try
- {
- stream = (Stream) first;
- }
- catch (ClassCastException e)
- {
- return type_error(first, Symbol.STREAM);
- }
- return stream.read(second != NIL, NIL, false, thread);
- }
- public LispObject execute(LispObject first, LispObject second,
- LispObject third)
- throws ConditionThrowable
- {
- final LispThread thread = LispThread.currentThread();
- if (first == T)
- first = Symbol.TERMINAL_IO.symbolValue(thread);
- else if (first == NIL)
- first = Symbol.STANDARD_INPUT.symbolValue(thread);
- final Stream stream;
- try
- {
- stream = (Stream) first;
- }
- catch (ClassCastException e)
- {
- return type_error(first, Symbol.STREAM);
- }
- return stream.read(second != NIL, third, false, thread);
- }
- public LispObject execute(LispObject first, LispObject second,
- LispObject third, LispObject fourth)
- throws ConditionThrowable
- {
- final LispThread thread = LispThread.currentThread();
- if (first == T)
- first = Symbol.TERMINAL_IO.symbolValue(thread);
- else if (first == NIL)
- first = Symbol.STANDARD_INPUT.symbolValue(thread);
- final Stream stream;
- try
- {
- stream = (Stream) first;
- }
- catch (ClassCastException e)
- {
- return type_error(first, Symbol.STREAM);
- }
- return stream.read(second != NIL, third, fourth != NIL, thread);
- }
- };
-
- // ### read-preserving-whitespace
- // &optional input-stream eof-error-p eof-value recursive-p => object
- private static final Primitive READ_PRESERVING_WHITESPACE =
- new Primitive(Symbol.READ_PRESERVING_WHITESPACE,
- "&optional input-stream eof-error-p eof-value recursive-p")
- {
- public LispObject execute(LispObject[] args) throws ConditionThrowable
- {
- int length = args.length;
- if (length > 4)
- return error(new WrongNumberOfArgumentsException(this));
- Stream stream =
- length > 0 ? inSynonymOf(args[0]) : getStandardInput();
- boolean eofError = length > 1 ? (args[1] != NIL) : true;
- LispObject eofValue = length > 2 ? args[2] : NIL;
- boolean recursive = length > 3 ? (args[3] != NIL) : false;
- return stream.readPreservingWhitespace(eofError, eofValue,
- recursive,
- LispThread.currentThread());
- }
- };
-
- // ### read-char &optional input-stream eof-error-p eof-value recursive-p
- // => char
- private static final Primitive READ_CHAR =
- new Primitive(Symbol.READ_CHAR,
- "&optional input-stream eof-error-p eof-value recursive-p")
- {
- public LispObject execute() throws ConditionThrowable
- {
- return checkCharacterInputStream(Symbol.STANDARD_INPUT.symbolValue()).readChar();
- }
- public LispObject execute(LispObject arg) throws ConditionThrowable
- {
- return inSynonymOf(arg).readChar();
- }
- public LispObject execute(LispObject first, LispObject second)
- throws ConditionThrowable
- {
- return inSynonymOf(first).readChar(second != NIL, NIL);
- }
- public LispObject execute(LispObject first, LispObject second,
- LispObject third)
- throws ConditionThrowable
- {
- return inSynonymOf(first).readChar(second != NIL, third);
- }
- public LispObject execute(LispObject first, LispObject second,
- LispObject third, LispObject fourth)
- throws ConditionThrowable
- {
- return inSynonymOf(first).readChar(second != NIL, third);
- }
- };
-
- // ### unread-char character &optional input-stream => nil
- private static final Primitive UNREAD_CHAR =
- new Primitive(Symbol.UNREAD_CHAR, "character &optional input-stream")
- {
- public LispObject execute(LispObject arg) throws ConditionThrowable
- {
- return getStandardInput().unreadChar(checkCharacter(arg));
- }
- public LispObject execute(LispObject first, LispObject second)
- throws ConditionThrowable
- {
- Stream stream = inSynonymOf(second);
- return stream.unreadChar(checkCharacter(first));
- }
- };
-
// ### lambda-name
private static final Primitive LAMBDA_NAME =
new Primitive("lambda-name", PACKAGE_SYS, true)
@@ -6127,63 +5521,6 @@
}
};
- // ### write-vector-unsigned-byte-8
- private static final Primitive WRITE_VECTOR_UNSIGNED_BYTE_8 =
- new Primitive("write-vector-unsigned-byte-8", PACKAGE_SYS, true,
- "vector stream start end")
- {
- public LispObject execute(LispObject first, LispObject second,
- LispObject third, LispObject fourth)
- throws ConditionThrowable
- {
- final AbstractVector v = checkVector(first);
- final Stream stream;
- try
- {
- stream = (Stream) second;
- }
- catch (ClassCastException e)
- {
- return type_error(second, Symbol.STREAM);
- }
- int start = Fixnum.getValue(third);
- int end = Fixnum.getValue(fourth);
- for (int i = start; i < end; i++)
- stream._writeByte(v.aref(i));
- return v;
- }
- };
-
- // ### read-vector-unsigned-byte-8 vector stream start end => position
- private static final Primitive READ_VECTOR_UNSIGNED_BYTE_8 =
- new Primitive("read-vector-unsigned-byte-8", PACKAGE_SYS, true,
- "vector stream start end")
- {
- public LispObject execute(LispObject first, LispObject second,
- LispObject third, LispObject fourth)
- throws ConditionThrowable
- {
- AbstractVector v = checkVector(first);
- Stream stream = checkBinaryInputStream(second);
- int start = Fixnum.getValue(third);
- int end = Fixnum.getValue(fourth);
- if (!v.getElementType().equal(UNSIGNED_BYTE_8))
- return type_error(first, list2(Symbol.VECTOR,
- UNSIGNED_BYTE_8));
- for (int i = start; i < end; i++)
- {
- int n = stream._readByte();
- if (n < 0)
- {
- // End of file.
- return new Fixnum(i);
- }
- v.aset(i, n);
- }
- return fourth;
- }
- };
-
// ### %documentation
private static final Primitive _DOCUMENTATION =
new Primitive("%documentation", PACKAGE_SYS, true,
Modified: trunk/j/src/org/armedbear/lisp/Stream.java
==============================================================================
--- trunk/j/src/org/armedbear/lisp/Stream.java (original)
+++ trunk/j/src/org/armedbear/lisp/Stream.java Sun Nov 2 22:06:34 2008
@@ -1478,6 +1478,7 @@
return _charReady() ? readChar(eofError, eofValue) : NIL;
}
+
// unread-char character &optional input-stream => nil
public LispObject unreadChar(LispCharacter c) throws ConditionThrowable
{
@@ -1937,6 +1938,706 @@
return error(new StreamError(this, writeToString() + " is not a character output stream."));
}
+ // ### %stream-write-char character output-stream => character
+ // OUTPUT-STREAM must be a real stream, not an output stream designator!
+ private static final Primitive _WRITE_CHAR =
+ new Primitive("%stream-write-char", PACKAGE_SYS, true,
+ "character output-stream")
+ {
+ public LispObject execute(LispObject first, LispObject second)
+ throws ConditionThrowable
+ {
+ try
+ {
+ ((Stream)second)._writeChar(((LispCharacter)first).value);
+ }
+ catch (ClassCastException e)
+ {
+ if (second instanceof Stream)
+ return type_error(first, Symbol.CHARACTER);
+ else
+ return type_error(second, Symbol.STREAM);
+ }
+ return first;
+ }
+ };
+
+ // ### %write-char character output-stream => character
+ private static final Primitive _STREAM_WRITE_CHAR =
+ new Primitive("%write-char", PACKAGE_SYS, false,
+ "character output-stream")
+ {
+ public LispObject execute(LispObject first, LispObject second)
+ throws ConditionThrowable
+ {
+ final char c;
+ try
+ {
+ c = ((LispCharacter)first).value;
+ }
+ catch (ClassCastException e)
+ {
+ return type_error(first, Symbol.CHARACTER);
+ }
+ if (second == T)
+ second = Symbol.TERMINAL_IO.symbolValue();
+ else if (second == NIL)
+ second = Symbol.STANDARD_OUTPUT.symbolValue();
+ final Stream stream;
+ try
+ {
+ stream = (Stream) second;
+ }
+ catch (ClassCastException e)
+ {
+ return type_error(second, Symbol.STREAM);
+ }
+ stream._writeChar(c);
+ return first;
+ }
+ };
+
+ // ### %write-string string output-stream start end => string
+ private static final Primitive _WRITE_STRING =
+ new Primitive("%write-string", PACKAGE_SYS, false,
+ "string output-stream start end")
+ {
+ public LispObject execute(LispObject first, LispObject second,
+ LispObject third, LispObject fourth)
+ throws ConditionThrowable
+ {
+ final AbstractString s;
+ try
+ {
+ s = (AbstractString) first;
+ }
+ catch (ClassCastException e)
+ {
+ return type_error(first, Symbol.STRING);
+ }
+ char[] chars = s.chars();
+ final Stream out;
+ try
+ {
+ if (second == T)
+ out = (Stream) Symbol.TERMINAL_IO.symbolValue();
+ else if (second == NIL)
+ out = (Stream) Symbol.STANDARD_OUTPUT.symbolValue();
+ else
+ out = (Stream) second;
+ }
+ catch (ClassCastException e)
+ {
+ return type_error(second, Symbol.STREAM);
+ }
+ final int start;
+ try
+ {
+ start = ((Fixnum)third).value;
+ }
+ catch (ClassCastException e)
+ {
+ return type_error(third, Symbol.FIXNUM);
+ }
+ final int end;
+ if (fourth == NIL)
+ end = chars.length;
+ else
+ {
+ try
+ {
+ end = ((Fixnum)fourth).value;
+ }
+ catch (ClassCastException e)
+ {
+ return type_error(fourth, Symbol.FIXNUM);
+ }
+ }
+ checkBounds(start, end, chars.length);
+ out._writeChars(chars, start, end);
+ return first;
+ }
+ };
+
+ // ### %finish-output output-stream => nil
+ private static final Primitive _FINISH_OUTPUT =
+ new Primitive("%finish-output", PACKAGE_SYS, false, "output-stream")
+ {
+ public LispObject execute(LispObject arg) throws ConditionThrowable
+ {
+ return finishOutput(arg);
+ }
+ };
+
+ // ### %force-output output-stream => nil
+ private static final Primitive _FORCE_OUTPUT =
+ new Primitive("%force-output", PACKAGE_SYS, false, "output-stream")
+ {
+ public LispObject execute(LispObject arg) throws ConditionThrowable
+ {
+ return finishOutput(arg);
+ }
+ };
+
+ private static final LispObject finishOutput(LispObject arg)
+ throws ConditionThrowable
+ {
+ final Stream out;
+ try
+ {
+ if (arg == T)
+ out = (Stream) Symbol.TERMINAL_IO.symbolValue();
+ else if (arg == NIL)
+ out = (Stream) Symbol.STANDARD_OUTPUT.symbolValue();
+ else
+ out = (Stream) arg;
+ }
+ catch (ClassCastException e)
+ {
+ return type_error(arg, Symbol.STREAM);
+ }
+ return out.finishOutput();
+ }
+
+ // ### clear-input &optional input-stream => nil
+ private static final Primitive CLEAR_INPUT =
+ new Primitive(Symbol.CLEAR_INPUT, "&optional input-stream")
+ {
+ public LispObject execute(LispObject[] args) throws ConditionThrowable
+ {
+ if (args.length > 1)
+ return error(new WrongNumberOfArgumentsException(this));
+ final Stream in;
+ if (args.length == 0)
+ in = checkCharacterInputStream(Symbol.STANDARD_INPUT.symbolValue());
+ else
+ in = inSynonymOf(args[0]);
+ in.clearInput();
+ return NIL;
+ }
+ };
+
+ // ### %clear-output output-stream => nil
+ // "If any of these operations does not make sense for output-stream, then
+ // it does nothing."
+ private static final Primitive _CLEAR_OUTPUT =
+ new Primitive("%clear-output", PACKAGE_SYS, false, "output-stream")
+ {
+ public LispObject execute(LispObject arg) throws ConditionThrowable
+ {
+ if (arg == T) // *TERMINAL-IO*
+ return NIL;
+ if (arg == NIL) // *STANDARD-OUTPUT*
+ return NIL;
+ if (arg instanceof Stream)
+ return NIL;
+ return type_error(arg, Symbol.STREAM);
+ }
+ };
+
+ // ### close stream &key abort => result
+ private static final Primitive CLOSE =
+ new Primitive(Symbol.CLOSE, "stream &key abort")
+ {
+ public LispObject execute(LispObject arg) throws ConditionThrowable
+ {
+ try
+ {
+ return ((Stream)arg).close(NIL);
+ }
+ catch (ClassCastException e)
+ {
+ return type_error(arg, Symbol.STREAM);
+ }
+ }
+ public LispObject execute(LispObject first, LispObject second,
+ LispObject third)
+ throws ConditionThrowable
+ {
+ final Stream stream;
+ try
+ {
+ stream = (Stream) first;
+ }
+ catch (ClassCastException e)
+ {
+ return type_error(first, Symbol.STREAM);
+ }
+ if (second == Keyword.ABORT)
+ return stream.close(third);
+ return error(new ProgramError("Unrecognized keyword argument " +
+ second.writeToString() + "."));
+ }
+ };
+
+ // ### out-synonym-of stream-designator => stream
+ private static final Primitive OUT_SYNONYM_OF =
+ new Primitive("out-synonym-of", PACKAGE_SYS, true, "stream-designator")
+ {
+ public LispObject execute (LispObject arg) throws ConditionThrowable
+ {
+ if (arg instanceof Stream)
+ return arg;
+ if (arg == T)
+ return Symbol.TERMINAL_IO.symbolValue();
+ if (arg == NIL)
+ return Symbol.STANDARD_OUTPUT.symbolValue();
+ return arg;
+ }
+ };
+
+ // ### write-8-bits
+ // write-8-bits byte stream => nil
+ private static final Primitive WRITE_8_BITS =
+ new Primitive("write-8-bits", PACKAGE_SYS, true, "byte stream")
+ {
+ public LispObject execute (LispObject first, LispObject second)
+ throws ConditionThrowable
+ {
+ int n;
+ try
+ {
+ n = ((Fixnum)first).value;
+ }
+ catch (ClassCastException e)
+ {
+ return type_error(first, Symbol.FIXNUM);
+ }
+ if (n < 0 || n > 255)
+ return type_error(first, UNSIGNED_BYTE_8);
+ try
+ {
+ ((Stream)second)._writeByte(n);
+ return NIL;
+ }
+ catch (ClassCastException e)
+ {
+ return type_error(second, Symbol.STREAM);
+ }
+ }
+ };
+
+ // ### read-8-bits
+ // read-8-bits stream &optional eof-error-p eof-value => byte
+ private static final Primitive READ_8_BITS =
+ new Primitive("read-8-bits", PACKAGE_SYS, true,
+ "stream &optional eof-error-p eof-value")
+ {
+ public LispObject execute (LispObject first, LispObject second,
+ LispObject third)
+ throws ConditionThrowable
+ {
+ return checkBinaryInputStream(first).readByte((second != NIL),
+ third);
+ }
+ public LispObject execute (LispObject[] args) throws ConditionThrowable
+ {
+ int length = args.length;
+ if (length < 1 || length > 3)
+ return error(new WrongNumberOfArgumentsException(this));
+ final Stream in = checkBinaryInputStream(args[0]);
+ boolean eofError = length > 1 ? (args[1] != NIL) : true;
+ LispObject eofValue = length > 2 ? args[2] : NIL;
+ return in.readByte(eofError, eofValue);
+ }
+ };
+
+ // ### read-line &optional input-stream eof-error-p eof-value recursive-p
+ // => line, missing-newline-p
+ private static final Primitive READ_LINE =
+ new Primitive(Symbol.READ_LINE,
+ "&optional input-stream eof-error-p eof-value recursive-p")
+ {
+ public LispObject execute() throws ConditionThrowable
+ {
+ final LispObject obj = Symbol.STANDARD_INPUT.symbolValue();
+ final Stream stream;
+ try
+ {
+ stream = (Stream) obj;
+ }
+ catch (ClassCastException e)
+ {
+ return type_error(obj, Symbol.STREAM);
+ }
+ return stream.readLine(true, NIL);
+ }
+ public LispObject execute(LispObject arg) throws ConditionThrowable
+ {
+ if (arg == T)
+ arg = Symbol.TERMINAL_IO.symbolValue();
+ else if (arg == NIL)
+ arg = Symbol.STANDARD_INPUT.symbolValue();
+ final Stream stream;
+ try
+ {
+ stream = (Stream) arg;
+ }
+ catch (ClassCastException e)
+ {
+ return type_error(arg, Symbol.STREAM);
+ }
+ return stream.readLine(true, NIL);
+ }
+ public LispObject execute(LispObject first, LispObject second)
+ throws ConditionThrowable
+ {
+ if (first == T)
+ first = Symbol.TERMINAL_IO.symbolValue();
+ else if (first == NIL)
+ first = Symbol.STANDARD_INPUT.symbolValue();
+ final Stream stream;
+ try
+ {
+ stream = (Stream) first;
+ }
+ catch (ClassCastException e)
+ {
+ return type_error(first, Symbol.STREAM);
+ }
+ return stream.readLine(second != NIL, NIL);
+ }
+ public LispObject execute(LispObject first, LispObject second,
+ LispObject third)
+ throws ConditionThrowable
+ {
+ if (first == T)
+ first = Symbol.TERMINAL_IO.symbolValue();
+ else if (first == NIL)
+ first = Symbol.STANDARD_INPUT.symbolValue();
+ final Stream stream;
+ try
+ {
+ stream = (Stream) first;
+ }
+ catch (ClassCastException e)
+ {
+ return type_error(first, Symbol.STREAM);
+ }
+ return stream.readLine(second != NIL, third);
+ }
+ public LispObject execute(LispObject first, LispObject second,
+ LispObject third, LispObject fourth)
+ throws ConditionThrowable
+ {
+ // recursive-p is ignored
+ if (first == T)
+ first = Symbol.TERMINAL_IO.symbolValue();
+ else if (first == NIL)
+ first = Symbol.STANDARD_INPUT.symbolValue();
+ final Stream stream;
+ try
+ {
+ stream = (Stream) first;
+ }
+ catch (ClassCastException e)
+ {
+ return type_error(first, Symbol.STREAM);
+ }
+ return stream.readLine(second != NIL, third);
+ }
+ };
+
+ // ### %read-from-string string eof-error-p eof-value start end preserve-whitespace
+ // => object, position
+ private static final Primitive _READ_FROM_STRING =
+ new Primitive("%read-from-string", PACKAGE_SYS, false)
+ {
+ public LispObject execute(LispObject first, LispObject second,
+ LispObject third, LispObject fourth,
+ LispObject fifth, LispObject sixth)
+ throws ConditionThrowable
+ {
+ String s = first.getStringValue();
+ boolean eofError = (second != NIL);
+ boolean preserveWhitespace = (sixth != NIL);
+ final int startIndex;
+ if (fourth != NIL)
+ startIndex = Fixnum.getValue(fourth);
+ else
+ startIndex = 0;
+ final int endIndex;
+ if (fifth != NIL)
+ endIndex = Fixnum.getValue(fifth);
+ else
+ endIndex = s.length();
+ StringInputStream in =
+ new StringInputStream(s, startIndex, endIndex);
+ final LispThread thread = LispThread.currentThread();
+ LispObject result;
+ if (preserveWhitespace)
+ result = in.readPreservingWhitespace(eofError, third, false,
+ thread);
+ else
+ result = in.read(eofError, third, false, thread);
+ return thread.setValues(result, new Fixnum(in.getOffset()));
+ }
+ };
+
+ // ### read &optional input-stream eof-error-p eof-value recursive-p => object
+ private static final Primitive READ =
+ new Primitive(Symbol.READ,
+ "&optional input-stream eof-error-p eof-value recursive-p")
+ {
+ public LispObject execute() throws ConditionThrowable
+ {
+ final LispThread thread = LispThread.currentThread();
+ final LispObject obj = Symbol.STANDARD_INPUT.symbolValue(thread);
+ final Stream stream;
+ try
+ {
+ stream = (Stream) obj;
+ }
+ catch (ClassCastException e)
+ {
+ return type_error(obj, Symbol.STREAM);
+ }
+ return stream.read(true, NIL, false, thread);
+ }
+ public LispObject execute(LispObject arg) throws ConditionThrowable
+ {
+ final LispThread thread = LispThread.currentThread();
+ if (arg == T)
+ arg = Symbol.TERMINAL_IO.symbolValue(thread);
+ else if (arg == NIL)
+ arg = Symbol.STANDARD_INPUT.symbolValue(thread);
+ final Stream stream;
+ try
+ {
+ stream = (Stream) arg;
+ }
+ catch (ClassCastException e)
+ {
+ return type_error(arg, Symbol.STREAM);
+ }
+ return stream.read(true, NIL, false, thread);
+ }
+ public LispObject execute(LispObject first, LispObject second)
+ throws ConditionThrowable
+ {
+ final LispThread thread = LispThread.currentThread();
+ if (first == T)
+ first = Symbol.TERMINAL_IO.symbolValue(thread);
+ else if (first == NIL)
+ first = Symbol.STANDARD_INPUT.symbolValue(thread);
+ final Stream stream;
+ try
+ {
+ stream = (Stream) first;
+ }
+ catch (ClassCastException e)
+ {
+ return type_error(first, Symbol.STREAM);
+ }
+ return stream.read(second != NIL, NIL, false, thread);
+ }
+ public LispObject execute(LispObject first, LispObject second,
+ LispObject third)
+ throws ConditionThrowable
+ {
+ final LispThread thread = LispThread.currentThread();
+ if (first == T)
+ first = Symbol.TERMINAL_IO.symbolValue(thread);
+ else if (first == NIL)
+ first = Symbol.STANDARD_INPUT.symbolValue(thread);
+ final Stream stream;
+ try
+ {
+ stream = (Stream) first;
+ }
+ catch (ClassCastException e)
+ {
+ return type_error(first, Symbol.STREAM);
+ }
+ return stream.read(second != NIL, third, false, thread);
+ }
+ public LispObject execute(LispObject first, LispObject second,
+ LispObject third, LispObject fourth)
+ throws ConditionThrowable
+ {
+ final LispThread thread = LispThread.currentThread();
+ if (first == T)
+ first = Symbol.TERMINAL_IO.symbolValue(thread);
+ else if (first == NIL)
+ first = Symbol.STANDARD_INPUT.symbolValue(thread);
+ final Stream stream;
+ try
+ {
+ stream = (Stream) first;
+ }
+ catch (ClassCastException e)
+ {
+ return type_error(first, Symbol.STREAM);
+ }
+ return stream.read(second != NIL, third, fourth != NIL, thread);
+ }
+ };
+
+ // ### read-preserving-whitespace
+ // &optional input-stream eof-error-p eof-value recursive-p => object
+ private static final Primitive READ_PRESERVING_WHITESPACE =
+ new Primitive(Symbol.READ_PRESERVING_WHITESPACE,
+ "&optional input-stream eof-error-p eof-value recursive-p")
+ {
+ public LispObject execute(LispObject[] args) throws ConditionThrowable
+ {
+ int length = args.length;
+ if (length > 4)
+ return error(new WrongNumberOfArgumentsException(this));
+ Stream stream =
+ length > 0 ? inSynonymOf(args[0]) : getStandardInput();
+ boolean eofError = length > 1 ? (args[1] != NIL) : true;
+ LispObject eofValue = length > 2 ? args[2] : NIL;
+ boolean recursive = length > 3 ? (args[3] != NIL) : false;
+ return stream.readPreservingWhitespace(eofError, eofValue,
+ recursive,
+ LispThread.currentThread());
+ }
+ };
+
+ // ### read-char &optional input-stream eof-error-p eof-value recursive-p
+ // => char
+ private static final Primitive READ_CHAR =
+ new Primitive(Symbol.READ_CHAR,
+ "&optional input-stream eof-error-p eof-value recursive-p")
+ {
+ public LispObject execute() throws ConditionThrowable
+ {
+ return checkCharacterInputStream(Symbol.STANDARD_INPUT.symbolValue()).readChar();
+ }
+ public LispObject execute(LispObject arg) throws ConditionThrowable
+ {
+ return inSynonymOf(arg).readChar();
+ }
+ public LispObject execute(LispObject first, LispObject second)
+ throws ConditionThrowable
+ {
+ return inSynonymOf(first).readChar(second != NIL, NIL);
+ }
+ public LispObject execute(LispObject first, LispObject second,
+ LispObject third)
+ throws ConditionThrowable
+ {
+ return inSynonymOf(first).readChar(second != NIL, third);
+ }
+ public LispObject execute(LispObject first, LispObject second,
+ LispObject third, LispObject fourth)
+ throws ConditionThrowable
+ {
+ return inSynonymOf(first).readChar(second != NIL, third);
+ }
+ };
+
+ // ### read-char-no-hang &optional input-stream eof-error-p eof-value
+ // recursive-p => char
+ private static final Primitive READ_CHAR_NO_HANG =
+ new Primitive("read-char-no-hang", "&optional input-stream eof-error-p eof-value recursive-p") {
+
+ public LispObject execute(LispObject[] args) throws ConditionThrowable
+ {
+ int length = args.length;
+ if (length > 4)
+ error(new WrongNumberOfArgumentsException(this));
+ Stream stream =
+ length > 0 ? inSynonymOf(args[0]) : getStandardInput();
+ boolean eofError = length > 1 ? (args[1] != NIL) : true;
+ LispObject eofValue = length > 2 ? args[2] : NIL;
+ // recursive-p is ignored
+ // boolean recursive = length > 3 ? (args[3] != NIL) : false;
+ return stream.readCharNoHang(eofError, eofValue);
+ }
+ };
+
+ // ### read-delimited-list char &optional input-stream recursive-p => list
+ private static final Primitive READ_DELIMITED_LIST =
+ new Primitive("read-delimited-list", "char &optional input-stream recursive-p") {
+
+ public LispObject execute(LispObject[] args) throws ConditionThrowable
+ {
+ int length = args.length;
+ if (length < 1 || length > 3)
+ error(new WrongNumberOfArgumentsException(this));
+ char c = LispCharacter.getValue(args[0]);
+ Stream stream =
+ length > 1 ? inSynonymOf(args[1]) : getStandardInput();
+ return stream.readDelimitedList(c);
+ }
+ };
+
+
+ // ### unread-char character &optional input-stream => nil
+ private static final Primitive UNREAD_CHAR =
+ new Primitive(Symbol.UNREAD_CHAR, "character &optional input-stream")
+ {
+ public LispObject execute(LispObject arg) throws ConditionThrowable
+ {
+ return getStandardInput().unreadChar(checkCharacter(arg));
+ }
+ public LispObject execute(LispObject first, LispObject second)
+ throws ConditionThrowable
+ {
+ Stream stream = inSynonymOf(second);
+ return stream.unreadChar(checkCharacter(first));
+ }
+ };
+
+ // ### write-vector-unsigned-byte-8
+ private static final Primitive WRITE_VECTOR_UNSIGNED_BYTE_8 =
+ new Primitive("write-vector-unsigned-byte-8", PACKAGE_SYS, true,
+ "vector stream start end")
+ {
+ public LispObject execute(LispObject first, LispObject second,
+ LispObject third, LispObject fourth)
+ throws ConditionThrowable
+ {
+ final AbstractVector v = checkVector(first);
+ final Stream stream;
+ try
+ {
+ stream = (Stream) second;
+ }
+ catch (ClassCastException e)
+ {
+ return type_error(second, Symbol.STREAM);
+ }
+ int start = Fixnum.getValue(third);
+ int end = Fixnum.getValue(fourth);
+ for (int i = start; i < end; i++)
+ stream._writeByte(v.aref(i));
+ return v;
+ }
+ };
+
+ // ### read-vector-unsigned-byte-8 vector stream start end => position
+ private static final Primitive READ_VECTOR_UNSIGNED_BYTE_8 =
+ new Primitive("read-vector-unsigned-byte-8", PACKAGE_SYS, true,
+ "vector stream start end")
+ {
+ public LispObject execute(LispObject first, LispObject second,
+ LispObject third, LispObject fourth)
+ throws ConditionThrowable
+ {
+ AbstractVector v = checkVector(first);
+ Stream stream = checkBinaryInputStream(second);
+ int start = Fixnum.getValue(third);
+ int end = Fixnum.getValue(fourth);
+ if (!v.getElementType().equal(UNSIGNED_BYTE_8))
+ return type_error(first, list2(Symbol.VECTOR,
+ UNSIGNED_BYTE_8));
+ for (int i = start; i < end; i++)
+ {
+ int n = stream._readByte();
+ if (n < 0)
+ {
+ // End of file.
+ return new Fixnum(i);
+ }
+ v.aset(i, n);
+ }
+ return fourth;
+ }
+ };
+
// ### file-position
private static final Primitive FILE_POSITION =
new Primitive("file-position", "stream &optional position-spec")
More information about the armedbear-cvs
mailing list