Changeset 11377


Ignore:
Timestamp:
11/02/08 22:06:34 (13 years ago)
Author:
ehuelsmann
Message:

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.

Location:
trunk/j/src/org/armedbear/lisp
Files:
2 deleted
3 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/Autoload.java

    r11299 r11377  
    426426        autoload("probe-file", "probe_file");
    427427        autoload("rational", "FloatFunctions");
    428         autoload("read-char-no-hang", "read_char_no_hang");
    429         autoload("read-delimited-list", "read_delimited_list");
    430428        autoload("rem", "rem");
    431429        autoload("remhash", "HashTableFunctions");
  • trunk/j/src/org/armedbear/lisp/Primitives.java

    r11341 r11377  
    40004000    };
    40014001
    4002   // ### %stream-write-char character output-stream => character
    4003   // OUTPUT-STREAM must be a real stream, not an output stream designator!
    4004   private static final Primitive _WRITE_CHAR =
    4005     new Primitive("%stream-write-char", PACKAGE_SYS, true,
    4006                   "character output-stream")
    4007     {
    4008       public LispObject execute(LispObject first, LispObject second)
    4009         throws ConditionThrowable
    4010       {
    4011         try
    4012           {
    4013             ((Stream)second)._writeChar(((LispCharacter)first).value);
    4014           }
    4015         catch (ClassCastException e)
    4016           {
    4017             if (second instanceof Stream)
    4018               return type_error(first, Symbol.CHARACTER);
    4019             else
    4020               return type_error(second, Symbol.STREAM);
    4021           }
    4022         return first;
    4023       }
    4024     };
    4025 
    4026   // ### %write-char character output-stream => character
    4027   private static final Primitive _STREAM_WRITE_CHAR =
    4028     new Primitive("%write-char", PACKAGE_SYS, false,
    4029                   "character output-stream")
    4030     {
    4031       public LispObject execute(LispObject first, LispObject second)
    4032         throws ConditionThrowable
    4033       {
    4034         final char c;
    4035         try
    4036           {
    4037             c = ((LispCharacter)first).value;
    4038           }
    4039         catch (ClassCastException e)
    4040           {
    4041             return type_error(first, Symbol.CHARACTER);
    4042           }
    4043         if (second == T)
    4044           second = Symbol.TERMINAL_IO.symbolValue();
    4045         else if (second == NIL)
    4046           second = Symbol.STANDARD_OUTPUT.symbolValue();
    4047         final Stream stream;
    4048         try
    4049           {
    4050             stream = (Stream) second;
    4051           }
    4052         catch (ClassCastException e)
    4053           {
    4054             return type_error(second, Symbol.STREAM);
    4055           }
    4056         stream._writeChar(c);
    4057         return first;
    4058       }
    4059     };
    4060 
    4061   // ### %write-string string output-stream start end => string
    4062   private static final Primitive _WRITE_STRING =
    4063     new Primitive("%write-string", PACKAGE_SYS, false,
    4064                   "string output-stream start end")
    4065     {
    4066       public LispObject execute(LispObject first, LispObject second,
    4067                                 LispObject third, LispObject fourth)
    4068         throws ConditionThrowable
    4069       {
    4070         final AbstractString s;
    4071         try
    4072           {
    4073             s = (AbstractString) first;
    4074           }
    4075         catch (ClassCastException e)
    4076           {
    4077             return type_error(first, Symbol.STRING);
    4078           }
    4079         char[] chars = s.chars();
    4080         final Stream out;
    4081         try
    4082           {
    4083             if (second == T)
    4084               out = (Stream) Symbol.TERMINAL_IO.symbolValue();
    4085             else if (second == NIL)
    4086               out = (Stream) Symbol.STANDARD_OUTPUT.symbolValue();
    4087             else
    4088               out = (Stream) second;
    4089           }
    4090         catch (ClassCastException e)
    4091           {
    4092             return type_error(second, Symbol.STREAM);
    4093           }
    4094         final int start;
    4095         try
    4096           {
    4097             start = ((Fixnum)third).value;
    4098           }
    4099         catch (ClassCastException e)
    4100           {
    4101             return type_error(third, Symbol.FIXNUM);
    4102           }
    4103         final int end;
    4104         if (fourth == NIL)
    4105           end = chars.length;
    4106         else
    4107           {
    4108             try
    4109               {
    4110                 end = ((Fixnum)fourth).value;
    4111               }
    4112             catch (ClassCastException e)
    4113               {
    4114                 return type_error(fourth, Symbol.FIXNUM);
    4115               }
    4116           }
    4117         checkBounds(start, end, chars.length);
    4118         out._writeChars(chars, start, end);
    4119         return first;
    4120       }
    4121     };
    4122 
    4123   // ### %finish-output output-stream => nil
    4124   private static final Primitive _FINISH_OUTPUT =
    4125     new Primitive("%finish-output", PACKAGE_SYS, false, "output-stream")
    4126     {
    4127       public LispObject execute(LispObject arg) throws ConditionThrowable
    4128       {
    4129         return finishOutput(arg);
    4130       }
    4131     };
    4132 
    4133   // ### %force-output output-stream => nil
    4134   private static final Primitive _FORCE_OUTPUT =
    4135     new Primitive("%force-output", PACKAGE_SYS, false, "output-stream")
    4136     {
    4137       public LispObject execute(LispObject arg) throws ConditionThrowable
    4138       {
    4139         return finishOutput(arg);
    4140       }
    4141     };
    4142 
    4143   private static final LispObject finishOutput(LispObject arg)
    4144     throws ConditionThrowable
    4145   {
    4146     final Stream out;
    4147     try
    4148       {
    4149         if (arg == T)
    4150           out = (Stream) Symbol.TERMINAL_IO.symbolValue();
    4151         else if (arg == NIL)
    4152           out = (Stream) Symbol.STANDARD_OUTPUT.symbolValue();
    4153         else
    4154           out = (Stream) arg;
    4155       }
    4156     catch (ClassCastException e)
    4157       {
    4158         return type_error(arg, Symbol.STREAM);
    4159       }
    4160     return out.finishOutput();
    4161   }
    4162 
    4163   // ### clear-input &optional input-stream => nil
    4164   private static final Primitive CLEAR_INPUT =
    4165     new Primitive(Symbol.CLEAR_INPUT, "&optional input-stream")
    4166     {
    4167       public LispObject execute(LispObject[] args) throws ConditionThrowable
    4168       {
    4169         if (args.length > 1)
    4170           return error(new WrongNumberOfArgumentsException(this));
    4171         final Stream in;
    4172         if (args.length == 0)
    4173           in = checkCharacterInputStream(Symbol.STANDARD_INPUT.symbolValue());
    4174         else
    4175           in = inSynonymOf(args[0]);
    4176         in.clearInput();
    4177         return NIL;
    4178       }
    4179     };
    4180 
    4181   // ### %clear-output output-stream => nil
    4182   // "If any of these operations does not make sense for output-stream, then
    4183   // it does nothing."
    4184   private static final Primitive _CLEAR_OUTPUT =
    4185     new Primitive("%clear-output", PACKAGE_SYS, false, "output-stream")
    4186     {
    4187       public LispObject execute(LispObject arg) throws ConditionThrowable
    4188       {
    4189         if (arg == T) // *TERMINAL-IO*
    4190           return NIL;
    4191         if (arg == NIL) // *STANDARD-OUTPUT*
    4192           return NIL;
    4193         if (arg instanceof Stream)
    4194           return NIL;
    4195         return type_error(arg, Symbol.STREAM);
    4196       }
    4197     };
    4198 
    4199   // ### close stream &key abort => result
    4200   private static final Primitive CLOSE =
    4201     new Primitive(Symbol.CLOSE, "stream &key abort")
    4202     {
    4203       public LispObject execute(LispObject arg) throws ConditionThrowable
    4204       {
    4205         try
    4206           {
    4207             return ((Stream)arg).close(NIL);
    4208           }
    4209         catch (ClassCastException e)
    4210           {
    4211             return type_error(arg, Symbol.STREAM);
    4212           }
    4213       }
    4214       public LispObject execute(LispObject first, LispObject second,
    4215                                 LispObject third)
    4216         throws ConditionThrowable
    4217       {
    4218         final Stream stream;
    4219         try
    4220           {
    4221             stream = (Stream) first;
    4222           }
    4223         catch (ClassCastException e)
    4224           {
    4225             return type_error(first, Symbol.STREAM);
    4226           }
    4227         if (second == Keyword.ABORT)
    4228           return stream.close(third);
    4229         return error(new ProgramError("Unrecognized keyword argument " +
    4230                                        second.writeToString() + "."));
    4231       }
    4232     };
    4233 
    42344002  // ### multiple-value-list form => list
    42354003  // Evaluates form and creates a list of the multiple values it returns.
     
    42864054    };
    42874055
    4288   // ### out-synonym-of stream-designator => stream
    4289   private static final Primitive OUT_SYNONYM_OF =
    4290     new Primitive("out-synonym-of", PACKAGE_SYS, true, "stream-designator")
    4291     {
    4292       public LispObject execute (LispObject arg) throws ConditionThrowable
    4293       {
    4294         if (arg instanceof Stream)
    4295           return arg;
    4296         if (arg == T)
    4297           return Symbol.TERMINAL_IO.symbolValue();
    4298         if (arg == NIL)
    4299           return Symbol.STANDARD_OUTPUT.symbolValue();
    4300         return arg;
    4301       }
    4302     };
    4303 
    4304   // ### write-8-bits
    4305   // write-8-bits byte stream => nil
    4306   private static final Primitive WRITE_8_BITS =
    4307     new Primitive("write-8-bits", PACKAGE_SYS, true, "byte stream")
    4308     {
    4309       public LispObject execute (LispObject first, LispObject second)
    4310         throws ConditionThrowable
    4311       {
    4312         int n;
    4313         try
    4314           {
    4315             n = ((Fixnum)first).value;
    4316           }
    4317         catch (ClassCastException e)
    4318           {
    4319             return type_error(first, Symbol.FIXNUM);
    4320           }
    4321         if (n < 0 || n > 255)
    4322           return type_error(first, UNSIGNED_BYTE_8);
    4323         try
    4324           {
    4325             ((Stream)second)._writeByte(n);
    4326             return NIL;
    4327           }
    4328         catch (ClassCastException e)
    4329           {
    4330             return type_error(second, Symbol.STREAM);
    4331           }
    4332       }
    4333     };
    4334 
    4335   // ### read-8-bits
    4336   // read-8-bits stream &optional eof-error-p eof-value => byte
    4337   private static final Primitive READ_8_BITS =
    4338     new Primitive("read-8-bits", PACKAGE_SYS, true,
    4339                   "stream &optional eof-error-p eof-value")
    4340     {
    4341       public LispObject execute (LispObject first, LispObject second,
    4342                                  LispObject third)
    4343         throws ConditionThrowable
    4344       {
    4345         return checkBinaryInputStream(first).readByte((second != NIL),
    4346                                                       third);
    4347       }
    4348       public LispObject execute (LispObject[] args) throws ConditionThrowable
    4349       {
    4350         int length = args.length;
    4351         if (length < 1 || length > 3)
    4352           return error(new WrongNumberOfArgumentsException(this));
    4353         final Stream in = checkBinaryInputStream(args[0]);
    4354         boolean eofError = length > 1 ? (args[1] != NIL) : true;
    4355         LispObject eofValue = length > 2 ? args[2] : NIL;
    4356         return in.readByte(eofError, eofValue);
    4357       }
    4358     };
    4359 
    4360   // ### read-line &optional input-stream eof-error-p eof-value recursive-p
    4361   // => line, missing-newline-p
    4362   private static final Primitive READ_LINE =
    4363     new Primitive(Symbol.READ_LINE,
    4364                   "&optional input-stream eof-error-p eof-value recursive-p")
    4365     {
    4366       public LispObject execute() throws ConditionThrowable
    4367       {
    4368         final LispObject obj = Symbol.STANDARD_INPUT.symbolValue();
    4369         final Stream stream;
    4370         try
    4371           {
    4372             stream = (Stream) obj;
    4373           }
    4374         catch (ClassCastException e)
    4375           {
    4376             return type_error(obj, Symbol.STREAM);
    4377           }
    4378         return stream.readLine(true, NIL);
    4379       }
    4380       public LispObject execute(LispObject arg) throws ConditionThrowable
    4381       {
    4382         if (arg == T)
    4383           arg = Symbol.TERMINAL_IO.symbolValue();
    4384         else if (arg == NIL)
    4385           arg = Symbol.STANDARD_INPUT.symbolValue();
    4386         final Stream stream;
    4387         try
    4388           {
    4389             stream = (Stream) arg;
    4390           }
    4391         catch (ClassCastException e)
    4392           {
    4393             return type_error(arg, Symbol.STREAM);
    4394           }
    4395         return stream.readLine(true, NIL);
    4396       }
    4397       public LispObject execute(LispObject first, LispObject second)
    4398         throws ConditionThrowable
    4399       {
    4400         if (first == T)
    4401           first = Symbol.TERMINAL_IO.symbolValue();
    4402         else if (first == NIL)
    4403           first = Symbol.STANDARD_INPUT.symbolValue();
    4404         final Stream stream;
    4405         try
    4406           {
    4407             stream = (Stream) first;
    4408           }
    4409         catch (ClassCastException e)
    4410           {
    4411             return type_error(first, Symbol.STREAM);
    4412           }
    4413         return stream.readLine(second != NIL, NIL);
    4414       }
    4415       public LispObject execute(LispObject first, LispObject second,
    4416                                 LispObject third)
    4417         throws ConditionThrowable
    4418       {
    4419         if (first == T)
    4420           first = Symbol.TERMINAL_IO.symbolValue();
    4421         else if (first == NIL)
    4422           first = Symbol.STANDARD_INPUT.symbolValue();
    4423         final Stream stream;
    4424         try
    4425           {
    4426             stream = (Stream) first;
    4427           }
    4428         catch (ClassCastException e)
    4429           {
    4430             return type_error(first, Symbol.STREAM);
    4431           }
    4432         return stream.readLine(second != NIL, third);
    4433       }
    4434       public LispObject execute(LispObject first, LispObject second,
    4435                                 LispObject third, LispObject fourth)
    4436         throws ConditionThrowable
    4437       {
    4438         // recursive-p is ignored
    4439         if (first == T)
    4440           first = Symbol.TERMINAL_IO.symbolValue();
    4441         else if (first == NIL)
    4442           first = Symbol.STANDARD_INPUT.symbolValue();
    4443         final Stream stream;
    4444         try
    4445           {
    4446             stream = (Stream) first;
    4447           }
    4448         catch (ClassCastException e)
    4449           {
    4450             return type_error(first, Symbol.STREAM);
    4451           }
    4452         return stream.readLine(second != NIL, third);
    4453       }
    4454     };
    4455 
    4456   // ### %read-from-string string eof-error-p eof-value start end preserve-whitespace
    4457   // => object, position
    4458   private static final Primitive _READ_FROM_STRING =
    4459     new Primitive("%read-from-string", PACKAGE_SYS, false)
    4460     {
    4461       public LispObject execute(LispObject first, LispObject second,
    4462                                 LispObject third, LispObject fourth,
    4463                                 LispObject fifth, LispObject sixth)
    4464         throws ConditionThrowable
    4465       {
    4466         String s = first.getStringValue();
    4467         boolean eofError = (second != NIL);
    4468         boolean preserveWhitespace = (sixth != NIL);
    4469         final int startIndex;
    4470         if (fourth != NIL)
    4471           startIndex = Fixnum.getValue(fourth);
    4472         else
    4473           startIndex = 0;
    4474         final int endIndex;
    4475         if (fifth != NIL)
    4476           endIndex = Fixnum.getValue(fifth);
    4477         else
    4478           endIndex = s.length();
    4479         StringInputStream in =
    4480           new StringInputStream(s, startIndex, endIndex);
    4481         final LispThread thread = LispThread.currentThread();
    4482         LispObject result;
    4483         if (preserveWhitespace)
    4484           result = in.readPreservingWhitespace(eofError, third, false,
    4485                                                thread);
    4486         else
    4487           result = in.read(eofError, third, false, thread);
    4488         return thread.setValues(result, new Fixnum(in.getOffset()));
    4489       }
    4490     };
    4491 
    44924056  // ### call-count
    44934057  private static final Primitive CALL_COUNT =
     
    45094073        first.setCallCount(Fixnum.getValue(second));
    45104074        return second;
    4511       }
    4512     };
    4513 
    4514   // ### read &optional input-stream eof-error-p eof-value recursive-p => object
    4515   private static final Primitive READ =
    4516     new Primitive(Symbol.READ,
    4517                   "&optional input-stream eof-error-p eof-value recursive-p")
    4518     {
    4519       public LispObject execute() throws ConditionThrowable
    4520       {
    4521         final LispThread thread = LispThread.currentThread();
    4522         final LispObject obj = Symbol.STANDARD_INPUT.symbolValue(thread);
    4523         final Stream stream;
    4524         try
    4525           {
    4526             stream = (Stream) obj;
    4527           }
    4528         catch (ClassCastException e)
    4529           {
    4530             return type_error(obj, Symbol.STREAM);
    4531           }
    4532         return stream.read(true, NIL, false, thread);
    4533       }
    4534       public LispObject execute(LispObject arg) throws ConditionThrowable
    4535       {
    4536         final LispThread thread = LispThread.currentThread();
    4537         if (arg == T)
    4538           arg = Symbol.TERMINAL_IO.symbolValue(thread);
    4539         else if (arg == NIL)
    4540           arg = Symbol.STANDARD_INPUT.symbolValue(thread);
    4541         final Stream stream;
    4542         try
    4543           {
    4544             stream = (Stream) arg;
    4545           }
    4546         catch (ClassCastException e)
    4547           {
    4548             return type_error(arg, Symbol.STREAM);
    4549           }
    4550         return stream.read(true, NIL, false, thread);
    4551       }
    4552       public LispObject execute(LispObject first, LispObject second)
    4553         throws ConditionThrowable
    4554       {
    4555         final LispThread thread = LispThread.currentThread();
    4556         if (first == T)
    4557           first = Symbol.TERMINAL_IO.symbolValue(thread);
    4558         else if (first == NIL)
    4559           first = Symbol.STANDARD_INPUT.symbolValue(thread);
    4560         final Stream stream;
    4561         try
    4562           {
    4563             stream = (Stream) first;
    4564           }
    4565         catch (ClassCastException e)
    4566           {
    4567             return type_error(first, Symbol.STREAM);
    4568           }
    4569         return stream.read(second != NIL, NIL, false, thread);
    4570       }
    4571       public LispObject execute(LispObject first, LispObject second,
    4572                                 LispObject third)
    4573         throws ConditionThrowable
    4574       {
    4575         final LispThread thread = LispThread.currentThread();
    4576         if (first == T)
    4577           first = Symbol.TERMINAL_IO.symbolValue(thread);
    4578         else if (first == NIL)
    4579           first = Symbol.STANDARD_INPUT.symbolValue(thread);
    4580         final Stream stream;
    4581         try
    4582           {
    4583             stream = (Stream) first;
    4584           }
    4585         catch (ClassCastException e)
    4586           {
    4587             return type_error(first, Symbol.STREAM);
    4588           }
    4589         return stream.read(second != NIL, third, false, thread);
    4590       }
    4591       public LispObject execute(LispObject first, LispObject second,
    4592                                 LispObject third, LispObject fourth)
    4593         throws ConditionThrowable
    4594       {
    4595         final LispThread thread = LispThread.currentThread();
    4596         if (first == T)
    4597           first = Symbol.TERMINAL_IO.symbolValue(thread);
    4598         else if (first == NIL)
    4599           first = Symbol.STANDARD_INPUT.symbolValue(thread);
    4600         final Stream stream;
    4601         try
    4602           {
    4603             stream = (Stream) first;
    4604           }
    4605         catch (ClassCastException e)
    4606           {
    4607             return type_error(first, Symbol.STREAM);
    4608           }
    4609         return stream.read(second != NIL, third, fourth != NIL, thread);
    4610       }
    4611     };
    4612 
    4613   // ### read-preserving-whitespace
    4614   // &optional input-stream eof-error-p eof-value recursive-p => object
    4615   private static final Primitive READ_PRESERVING_WHITESPACE =
    4616     new Primitive(Symbol.READ_PRESERVING_WHITESPACE,
    4617                   "&optional input-stream eof-error-p eof-value recursive-p")
    4618     {
    4619       public LispObject execute(LispObject[] args) throws ConditionThrowable
    4620       {
    4621         int length = args.length;
    4622         if (length > 4)
    4623           return error(new WrongNumberOfArgumentsException(this));
    4624         Stream stream =
    4625           length > 0 ? inSynonymOf(args[0]) : getStandardInput();
    4626         boolean eofError = length > 1 ? (args[1] != NIL) : true;
    4627         LispObject eofValue = length > 2 ? args[2] : NIL;
    4628         boolean recursive = length > 3 ? (args[3] != NIL) : false;
    4629         return stream.readPreservingWhitespace(eofError, eofValue,
    4630                                                recursive,
    4631                                                LispThread.currentThread());
    4632       }
    4633     };
    4634 
    4635   // ### read-char &optional input-stream eof-error-p eof-value recursive-p
    4636   // => char
    4637   private static final Primitive READ_CHAR =
    4638     new Primitive(Symbol.READ_CHAR,
    4639                   "&optional input-stream eof-error-p eof-value recursive-p")
    4640     {
    4641       public LispObject execute() throws ConditionThrowable
    4642       {
    4643         return checkCharacterInputStream(Symbol.STANDARD_INPUT.symbolValue()).readChar();
    4644       }
    4645       public LispObject execute(LispObject arg) throws ConditionThrowable
    4646       {
    4647         return inSynonymOf(arg).readChar();
    4648       }
    4649       public LispObject execute(LispObject first, LispObject second)
    4650         throws ConditionThrowable
    4651       {
    4652         return inSynonymOf(first).readChar(second != NIL, NIL);
    4653       }
    4654       public LispObject execute(LispObject first, LispObject second,
    4655                                 LispObject third)
    4656         throws ConditionThrowable
    4657       {
    4658         return inSynonymOf(first).readChar(second != NIL, third);
    4659       }
    4660       public LispObject execute(LispObject first, LispObject second,
    4661                                 LispObject third, LispObject fourth)
    4662         throws ConditionThrowable
    4663       {
    4664         return inSynonymOf(first).readChar(second != NIL, third);
    4665       }
    4666     };
    4667 
    4668   // ### unread-char character &optional input-stream => nil
    4669   private static final Primitive UNREAD_CHAR =
    4670     new Primitive(Symbol.UNREAD_CHAR, "character &optional input-stream")
    4671     {
    4672       public LispObject execute(LispObject arg) throws ConditionThrowable
    4673       {
    4674         return getStandardInput().unreadChar(checkCharacter(arg));
    4675       }
    4676       public LispObject execute(LispObject first, LispObject second)
    4677         throws ConditionThrowable
    4678       {
    4679         Stream stream = inSynonymOf(second);
    4680         return stream.unreadChar(checkCharacter(first));
    46814075      }
    46824076    };
     
    61285522    };
    61295523
    6130   // ### write-vector-unsigned-byte-8
    6131   private static final Primitive WRITE_VECTOR_UNSIGNED_BYTE_8 =
    6132     new Primitive("write-vector-unsigned-byte-8", PACKAGE_SYS, true,
    6133                   "vector stream start end")
    6134     {
    6135       public LispObject execute(LispObject first, LispObject second,
    6136                                 LispObject third, LispObject fourth)
    6137         throws ConditionThrowable
    6138       {
    6139         final AbstractVector v = checkVector(first);
    6140         final Stream stream;
    6141         try
    6142           {
    6143             stream = (Stream) second;
    6144           }
    6145         catch (ClassCastException e)
    6146           {
    6147             return type_error(second, Symbol.STREAM);
    6148           }
    6149         int start = Fixnum.getValue(third);
    6150         int end = Fixnum.getValue(fourth);
    6151         for (int i = start; i < end; i++)
    6152           stream._writeByte(v.aref(i));
    6153         return v;
    6154       }
    6155     };
    6156 
    6157   // ### read-vector-unsigned-byte-8 vector stream start end => position
    6158   private static final Primitive READ_VECTOR_UNSIGNED_BYTE_8 =
    6159     new Primitive("read-vector-unsigned-byte-8", PACKAGE_SYS, true,
    6160                   "vector stream start end")
    6161     {
    6162       public LispObject execute(LispObject first, LispObject second,
    6163                                 LispObject third, LispObject fourth)
    6164         throws ConditionThrowable
    6165       {
    6166         AbstractVector v = checkVector(first);
    6167         Stream stream = checkBinaryInputStream(second);
    6168         int start = Fixnum.getValue(third);
    6169         int end = Fixnum.getValue(fourth);
    6170         if (!v.getElementType().equal(UNSIGNED_BYTE_8))
    6171           return type_error(first, list2(Symbol.VECTOR,
    6172                                               UNSIGNED_BYTE_8));
    6173         for (int i = start; i < end; i++)
    6174           {
    6175             int n = stream._readByte();
    6176             if (n < 0)
    6177               {
    6178                 // End of file.
    6179                 return new Fixnum(i);
    6180               }
    6181             v.aset(i, n);
    6182           }
    6183         return fourth;
    6184       }
    6185     };
    6186 
    61875524  // ### %documentation
    61885525  private static final Primitive _DOCUMENTATION =
  • trunk/j/src/org/armedbear/lisp/Stream.java

    r11297 r11377  
    14791479  }
    14801480
     1481
    14811482  // unread-char character &optional input-stream => nil
    14821483  public LispObject unreadChar(LispCharacter c) throws ConditionThrowable
     
    19381939  }
    19391940
     1941  // ### %stream-write-char character output-stream => character
     1942  // OUTPUT-STREAM must be a real stream, not an output stream designator!
     1943  private static final Primitive _WRITE_CHAR =
     1944    new Primitive("%stream-write-char", PACKAGE_SYS, true,
     1945                  "character output-stream")
     1946    {
     1947      public LispObject execute(LispObject first, LispObject second)
     1948        throws ConditionThrowable
     1949      {
     1950        try
     1951          {
     1952            ((Stream)second)._writeChar(((LispCharacter)first).value);
     1953          }
     1954        catch (ClassCastException e)
     1955          {
     1956            if (second instanceof Stream)
     1957              return type_error(first, Symbol.CHARACTER);
     1958            else
     1959              return type_error(second, Symbol.STREAM);
     1960          }
     1961        return first;
     1962      }
     1963    };
     1964
     1965  // ### %write-char character output-stream => character
     1966  private static final Primitive _STREAM_WRITE_CHAR =
     1967    new Primitive("%write-char", PACKAGE_SYS, false,
     1968                  "character output-stream")
     1969    {
     1970      public LispObject execute(LispObject first, LispObject second)
     1971        throws ConditionThrowable
     1972      {
     1973        final char c;
     1974        try
     1975          {
     1976            c = ((LispCharacter)first).value;
     1977          }
     1978        catch (ClassCastException e)
     1979          {
     1980            return type_error(first, Symbol.CHARACTER);
     1981          }
     1982        if (second == T)
     1983          second = Symbol.TERMINAL_IO.symbolValue();
     1984        else if (second == NIL)
     1985          second = Symbol.STANDARD_OUTPUT.symbolValue();
     1986        final Stream stream;
     1987        try
     1988          {
     1989            stream = (Stream) second;
     1990          }
     1991        catch (ClassCastException e)
     1992          {
     1993            return type_error(second, Symbol.STREAM);
     1994          }
     1995        stream._writeChar(c);
     1996        return first;
     1997      }
     1998    };
     1999
     2000  // ### %write-string string output-stream start end => string
     2001  private static final Primitive _WRITE_STRING =
     2002    new Primitive("%write-string", PACKAGE_SYS, false,
     2003                  "string output-stream start end")
     2004    {
     2005      public LispObject execute(LispObject first, LispObject second,
     2006                                LispObject third, LispObject fourth)
     2007        throws ConditionThrowable
     2008      {
     2009        final AbstractString s;
     2010        try
     2011          {
     2012            s = (AbstractString) first;
     2013          }
     2014        catch (ClassCastException e)
     2015          {
     2016            return type_error(first, Symbol.STRING);
     2017          }
     2018        char[] chars = s.chars();
     2019        final Stream out;
     2020        try
     2021          {
     2022            if (second == T)
     2023              out = (Stream) Symbol.TERMINAL_IO.symbolValue();
     2024            else if (second == NIL)
     2025              out = (Stream) Symbol.STANDARD_OUTPUT.symbolValue();
     2026            else
     2027              out = (Stream) second;
     2028          }
     2029        catch (ClassCastException e)
     2030          {
     2031            return type_error(second, Symbol.STREAM);
     2032          }
     2033        final int start;
     2034        try
     2035          {
     2036            start = ((Fixnum)third).value;
     2037          }
     2038        catch (ClassCastException e)
     2039          {
     2040            return type_error(third, Symbol.FIXNUM);
     2041          }
     2042        final int end;
     2043        if (fourth == NIL)
     2044          end = chars.length;
     2045        else
     2046          {
     2047            try
     2048              {
     2049                end = ((Fixnum)fourth).value;
     2050              }
     2051            catch (ClassCastException e)
     2052              {
     2053                return type_error(fourth, Symbol.FIXNUM);
     2054              }
     2055          }
     2056        checkBounds(start, end, chars.length);
     2057        out._writeChars(chars, start, end);
     2058        return first;
     2059      }
     2060    };
     2061
     2062  // ### %finish-output output-stream => nil
     2063  private static final Primitive _FINISH_OUTPUT =
     2064    new Primitive("%finish-output", PACKAGE_SYS, false, "output-stream")
     2065    {
     2066      public LispObject execute(LispObject arg) throws ConditionThrowable
     2067      {
     2068        return finishOutput(arg);
     2069      }
     2070    };
     2071
     2072  // ### %force-output output-stream => nil
     2073  private static final Primitive _FORCE_OUTPUT =
     2074    new Primitive("%force-output", PACKAGE_SYS, false, "output-stream")
     2075    {
     2076      public LispObject execute(LispObject arg) throws ConditionThrowable
     2077      {
     2078        return finishOutput(arg);
     2079      }
     2080    };
     2081
     2082  private static final LispObject finishOutput(LispObject arg)
     2083    throws ConditionThrowable
     2084  {
     2085    final Stream out;
     2086    try
     2087      {
     2088        if (arg == T)
     2089          out = (Stream) Symbol.TERMINAL_IO.symbolValue();
     2090        else if (arg == NIL)
     2091          out = (Stream) Symbol.STANDARD_OUTPUT.symbolValue();
     2092        else
     2093          out = (Stream) arg;
     2094      }
     2095    catch (ClassCastException e)
     2096      {
     2097        return type_error(arg, Symbol.STREAM);
     2098      }
     2099    return out.finishOutput();
     2100  }
     2101
     2102  // ### clear-input &optional input-stream => nil
     2103  private static final Primitive CLEAR_INPUT =
     2104    new Primitive(Symbol.CLEAR_INPUT, "&optional input-stream")
     2105    {
     2106      public LispObject execute(LispObject[] args) throws ConditionThrowable
     2107      {
     2108        if (args.length > 1)
     2109          return error(new WrongNumberOfArgumentsException(this));
     2110        final Stream in;
     2111        if (args.length == 0)
     2112          in = checkCharacterInputStream(Symbol.STANDARD_INPUT.symbolValue());
     2113        else
     2114          in = inSynonymOf(args[0]);
     2115        in.clearInput();
     2116        return NIL;
     2117      }
     2118    };
     2119
     2120  // ### %clear-output output-stream => nil
     2121  // "If any of these operations does not make sense for output-stream, then
     2122  // it does nothing."
     2123  private static final Primitive _CLEAR_OUTPUT =
     2124    new Primitive("%clear-output", PACKAGE_SYS, false, "output-stream")
     2125    {
     2126      public LispObject execute(LispObject arg) throws ConditionThrowable
     2127      {
     2128        if (arg == T) // *TERMINAL-IO*
     2129          return NIL;
     2130        if (arg == NIL) // *STANDARD-OUTPUT*
     2131          return NIL;
     2132        if (arg instanceof Stream)
     2133          return NIL;
     2134        return type_error(arg, Symbol.STREAM);
     2135      }
     2136    };
     2137
     2138  // ### close stream &key abort => result
     2139  private static final Primitive CLOSE =
     2140    new Primitive(Symbol.CLOSE, "stream &key abort")
     2141    {
     2142      public LispObject execute(LispObject arg) throws ConditionThrowable
     2143      {
     2144        try
     2145          {
     2146            return ((Stream)arg).close(NIL);
     2147          }
     2148        catch (ClassCastException e)
     2149          {
     2150            return type_error(arg, Symbol.STREAM);
     2151          }
     2152      }
     2153      public LispObject execute(LispObject first, LispObject second,
     2154                                LispObject third)
     2155        throws ConditionThrowable
     2156      {
     2157        final Stream stream;
     2158        try
     2159          {
     2160            stream = (Stream) first;
     2161          }
     2162        catch (ClassCastException e)
     2163          {
     2164            return type_error(first, Symbol.STREAM);
     2165          }
     2166        if (second == Keyword.ABORT)
     2167          return stream.close(third);
     2168        return error(new ProgramError("Unrecognized keyword argument " +
     2169                                       second.writeToString() + "."));
     2170      }
     2171    };
     2172
     2173  // ### out-synonym-of stream-designator => stream
     2174  private static final Primitive OUT_SYNONYM_OF =
     2175    new Primitive("out-synonym-of", PACKAGE_SYS, true, "stream-designator")
     2176    {
     2177      public LispObject execute (LispObject arg) throws ConditionThrowable
     2178      {
     2179        if (arg instanceof Stream)
     2180          return arg;
     2181        if (arg == T)
     2182          return Symbol.TERMINAL_IO.symbolValue();
     2183        if (arg == NIL)
     2184          return Symbol.STANDARD_OUTPUT.symbolValue();
     2185        return arg;
     2186      }
     2187    };
     2188
     2189  // ### write-8-bits
     2190  // write-8-bits byte stream => nil
     2191  private static final Primitive WRITE_8_BITS =
     2192    new Primitive("write-8-bits", PACKAGE_SYS, true, "byte stream")
     2193    {
     2194      public LispObject execute (LispObject first, LispObject second)
     2195        throws ConditionThrowable
     2196      {
     2197        int n;
     2198        try
     2199          {
     2200            n = ((Fixnum)first).value;
     2201          }
     2202        catch (ClassCastException e)
     2203          {
     2204            return type_error(first, Symbol.FIXNUM);
     2205          }
     2206        if (n < 0 || n > 255)
     2207          return type_error(first, UNSIGNED_BYTE_8);
     2208        try
     2209          {
     2210            ((Stream)second)._writeByte(n);
     2211            return NIL;
     2212          }
     2213        catch (ClassCastException e)
     2214          {
     2215            return type_error(second, Symbol.STREAM);
     2216          }
     2217      }
     2218    };
     2219
     2220  // ### read-8-bits
     2221  // read-8-bits stream &optional eof-error-p eof-value => byte
     2222  private static final Primitive READ_8_BITS =
     2223    new Primitive("read-8-bits", PACKAGE_SYS, true,
     2224                  "stream &optional eof-error-p eof-value")
     2225    {
     2226      public LispObject execute (LispObject first, LispObject second,
     2227                                 LispObject third)
     2228        throws ConditionThrowable
     2229      {
     2230        return checkBinaryInputStream(first).readByte((second != NIL),
     2231                                                      third);
     2232      }
     2233      public LispObject execute (LispObject[] args) throws ConditionThrowable
     2234      {
     2235        int length = args.length;
     2236        if (length < 1 || length > 3)
     2237          return error(new WrongNumberOfArgumentsException(this));
     2238        final Stream in = checkBinaryInputStream(args[0]);
     2239        boolean eofError = length > 1 ? (args[1] != NIL) : true;
     2240        LispObject eofValue = length > 2 ? args[2] : NIL;
     2241        return in.readByte(eofError, eofValue);
     2242      }
     2243    };
     2244
     2245  // ### read-line &optional input-stream eof-error-p eof-value recursive-p
     2246  // => line, missing-newline-p
     2247  private static final Primitive READ_LINE =
     2248    new Primitive(Symbol.READ_LINE,
     2249                  "&optional input-stream eof-error-p eof-value recursive-p")
     2250    {
     2251      public LispObject execute() throws ConditionThrowable
     2252      {
     2253        final LispObject obj = Symbol.STANDARD_INPUT.symbolValue();
     2254        final Stream stream;
     2255        try
     2256          {
     2257            stream = (Stream) obj;
     2258          }
     2259        catch (ClassCastException e)
     2260          {
     2261            return type_error(obj, Symbol.STREAM);
     2262          }
     2263        return stream.readLine(true, NIL);
     2264      }
     2265      public LispObject execute(LispObject arg) throws ConditionThrowable
     2266      {
     2267        if (arg == T)
     2268          arg = Symbol.TERMINAL_IO.symbolValue();
     2269        else if (arg == NIL)
     2270          arg = Symbol.STANDARD_INPUT.symbolValue();
     2271        final Stream stream;
     2272        try
     2273          {
     2274            stream = (Stream) arg;
     2275          }
     2276        catch (ClassCastException e)
     2277          {
     2278            return type_error(arg, Symbol.STREAM);
     2279          }
     2280        return stream.readLine(true, NIL);
     2281      }
     2282      public LispObject execute(LispObject first, LispObject second)
     2283        throws ConditionThrowable
     2284      {
     2285        if (first == T)
     2286          first = Symbol.TERMINAL_IO.symbolValue();
     2287        else if (first == NIL)
     2288          first = Symbol.STANDARD_INPUT.symbolValue();
     2289        final Stream stream;
     2290        try
     2291          {
     2292            stream = (Stream) first;
     2293          }
     2294        catch (ClassCastException e)
     2295          {
     2296            return type_error(first, Symbol.STREAM);
     2297          }
     2298        return stream.readLine(second != NIL, NIL);
     2299      }
     2300      public LispObject execute(LispObject first, LispObject second,
     2301                                LispObject third)
     2302        throws ConditionThrowable
     2303      {
     2304        if (first == T)
     2305          first = Symbol.TERMINAL_IO.symbolValue();
     2306        else if (first == NIL)
     2307          first = Symbol.STANDARD_INPUT.symbolValue();
     2308        final Stream stream;
     2309        try
     2310          {
     2311            stream = (Stream) first;
     2312          }
     2313        catch (ClassCastException e)
     2314          {
     2315            return type_error(first, Symbol.STREAM);
     2316          }
     2317        return stream.readLine(second != NIL, third);
     2318      }
     2319      public LispObject execute(LispObject first, LispObject second,
     2320                                LispObject third, LispObject fourth)
     2321        throws ConditionThrowable
     2322      {
     2323        // recursive-p is ignored
     2324        if (first == T)
     2325          first = Symbol.TERMINAL_IO.symbolValue();
     2326        else if (first == NIL)
     2327          first = Symbol.STANDARD_INPUT.symbolValue();
     2328        final Stream stream;
     2329        try
     2330          {
     2331            stream = (Stream) first;
     2332          }
     2333        catch (ClassCastException e)
     2334          {
     2335            return type_error(first, Symbol.STREAM);
     2336          }
     2337        return stream.readLine(second != NIL, third);
     2338      }
     2339    };
     2340
     2341  // ### %read-from-string string eof-error-p eof-value start end preserve-whitespace
     2342  // => object, position
     2343  private static final Primitive _READ_FROM_STRING =
     2344    new Primitive("%read-from-string", PACKAGE_SYS, false)
     2345    {
     2346      public LispObject execute(LispObject first, LispObject second,
     2347                                LispObject third, LispObject fourth,
     2348                                LispObject fifth, LispObject sixth)
     2349        throws ConditionThrowable
     2350      {
     2351        String s = first.getStringValue();
     2352        boolean eofError = (second != NIL);
     2353        boolean preserveWhitespace = (sixth != NIL);
     2354        final int startIndex;
     2355        if (fourth != NIL)
     2356          startIndex = Fixnum.getValue(fourth);
     2357        else
     2358          startIndex = 0;
     2359        final int endIndex;
     2360        if (fifth != NIL)
     2361          endIndex = Fixnum.getValue(fifth);
     2362        else
     2363          endIndex = s.length();
     2364        StringInputStream in =
     2365          new StringInputStream(s, startIndex, endIndex);
     2366        final LispThread thread = LispThread.currentThread();
     2367        LispObject result;
     2368        if (preserveWhitespace)
     2369          result = in.readPreservingWhitespace(eofError, third, false,
     2370                                               thread);
     2371        else
     2372          result = in.read(eofError, third, false, thread);
     2373        return thread.setValues(result, new Fixnum(in.getOffset()));
     2374      }
     2375    };
     2376
     2377  // ### read &optional input-stream eof-error-p eof-value recursive-p => object
     2378  private static final Primitive READ =
     2379    new Primitive(Symbol.READ,
     2380                  "&optional input-stream eof-error-p eof-value recursive-p")
     2381    {
     2382      public LispObject execute() throws ConditionThrowable
     2383      {
     2384        final LispThread thread = LispThread.currentThread();
     2385        final LispObject obj = Symbol.STANDARD_INPUT.symbolValue(thread);
     2386        final Stream stream;
     2387        try
     2388          {
     2389            stream = (Stream) obj;
     2390          }
     2391        catch (ClassCastException e)
     2392          {
     2393            return type_error(obj, Symbol.STREAM);
     2394          }
     2395        return stream.read(true, NIL, false, thread);
     2396      }
     2397      public LispObject execute(LispObject arg) throws ConditionThrowable
     2398      {
     2399        final LispThread thread = LispThread.currentThread();
     2400        if (arg == T)
     2401          arg = Symbol.TERMINAL_IO.symbolValue(thread);
     2402        else if (arg == NIL)
     2403          arg = Symbol.STANDARD_INPUT.symbolValue(thread);
     2404        final Stream stream;
     2405        try
     2406          {
     2407            stream = (Stream) arg;
     2408          }
     2409        catch (ClassCastException e)
     2410          {
     2411            return type_error(arg, Symbol.STREAM);
     2412          }
     2413        return stream.read(true, NIL, false, thread);
     2414      }
     2415      public LispObject execute(LispObject first, LispObject second)
     2416        throws ConditionThrowable
     2417      {
     2418        final LispThread thread = LispThread.currentThread();
     2419        if (first == T)
     2420          first = Symbol.TERMINAL_IO.symbolValue(thread);
     2421        else if (first == NIL)
     2422          first = Symbol.STANDARD_INPUT.symbolValue(thread);
     2423        final Stream stream;
     2424        try
     2425          {
     2426            stream = (Stream) first;
     2427          }
     2428        catch (ClassCastException e)
     2429          {
     2430            return type_error(first, Symbol.STREAM);
     2431          }
     2432        return stream.read(second != NIL, NIL, false, thread);
     2433      }
     2434      public LispObject execute(LispObject first, LispObject second,
     2435                                LispObject third)
     2436        throws ConditionThrowable
     2437      {
     2438        final LispThread thread = LispThread.currentThread();
     2439        if (first == T)
     2440          first = Symbol.TERMINAL_IO.symbolValue(thread);
     2441        else if (first == NIL)
     2442          first = Symbol.STANDARD_INPUT.symbolValue(thread);
     2443        final Stream stream;
     2444        try
     2445          {
     2446            stream = (Stream) first;
     2447          }
     2448        catch (ClassCastException e)
     2449          {
     2450            return type_error(first, Symbol.STREAM);
     2451          }
     2452        return stream.read(second != NIL, third, false, thread);
     2453      }
     2454      public LispObject execute(LispObject first, LispObject second,
     2455                                LispObject third, LispObject fourth)
     2456        throws ConditionThrowable
     2457      {
     2458        final LispThread thread = LispThread.currentThread();
     2459        if (first == T)
     2460          first = Symbol.TERMINAL_IO.symbolValue(thread);
     2461        else if (first == NIL)
     2462          first = Symbol.STANDARD_INPUT.symbolValue(thread);
     2463        final Stream stream;
     2464        try
     2465          {
     2466            stream = (Stream) first;
     2467          }
     2468        catch (ClassCastException e)
     2469          {
     2470            return type_error(first, Symbol.STREAM);
     2471          }
     2472        return stream.read(second != NIL, third, fourth != NIL, thread);
     2473      }
     2474    };
     2475
     2476  // ### read-preserving-whitespace
     2477  // &optional input-stream eof-error-p eof-value recursive-p => object
     2478  private static final Primitive READ_PRESERVING_WHITESPACE =
     2479    new Primitive(Symbol.READ_PRESERVING_WHITESPACE,
     2480                  "&optional input-stream eof-error-p eof-value recursive-p")
     2481    {
     2482      public LispObject execute(LispObject[] args) throws ConditionThrowable
     2483      {
     2484        int length = args.length;
     2485        if (length > 4)
     2486          return error(new WrongNumberOfArgumentsException(this));
     2487        Stream stream =
     2488          length > 0 ? inSynonymOf(args[0]) : getStandardInput();
     2489        boolean eofError = length > 1 ? (args[1] != NIL) : true;
     2490        LispObject eofValue = length > 2 ? args[2] : NIL;
     2491        boolean recursive = length > 3 ? (args[3] != NIL) : false;
     2492        return stream.readPreservingWhitespace(eofError, eofValue,
     2493                                               recursive,
     2494                                               LispThread.currentThread());
     2495      }
     2496    };
     2497
     2498  // ### read-char &optional input-stream eof-error-p eof-value recursive-p
     2499  // => char
     2500  private static final Primitive READ_CHAR =
     2501    new Primitive(Symbol.READ_CHAR,
     2502                  "&optional input-stream eof-error-p eof-value recursive-p")
     2503    {
     2504      public LispObject execute() throws ConditionThrowable
     2505      {
     2506        return checkCharacterInputStream(Symbol.STANDARD_INPUT.symbolValue()).readChar();
     2507      }
     2508      public LispObject execute(LispObject arg) throws ConditionThrowable
     2509      {
     2510        return inSynonymOf(arg).readChar();
     2511      }
     2512      public LispObject execute(LispObject first, LispObject second)
     2513        throws ConditionThrowable
     2514      {
     2515        return inSynonymOf(first).readChar(second != NIL, NIL);
     2516      }
     2517      public LispObject execute(LispObject first, LispObject second,
     2518                                LispObject third)
     2519        throws ConditionThrowable
     2520      {
     2521        return inSynonymOf(first).readChar(second != NIL, third);
     2522      }
     2523      public LispObject execute(LispObject first, LispObject second,
     2524                                LispObject third, LispObject fourth)
     2525        throws ConditionThrowable
     2526      {
     2527        return inSynonymOf(first).readChar(second != NIL, third);
     2528      }
     2529    };
     2530
     2531  // ### read-char-no-hang &optional input-stream eof-error-p eof-value
     2532  // recursive-p => char
     2533  private static final Primitive READ_CHAR_NO_HANG =
     2534    new Primitive("read-char-no-hang", "&optional input-stream eof-error-p eof-value recursive-p") {
     2535
     2536      public LispObject execute(LispObject[] args) throws ConditionThrowable
     2537      {
     2538        int length = args.length;
     2539        if (length > 4)
     2540            error(new WrongNumberOfArgumentsException(this));
     2541        Stream stream =
     2542            length > 0 ? inSynonymOf(args[0]) : getStandardInput();
     2543        boolean eofError = length > 1 ? (args[1] != NIL) : true;
     2544        LispObject eofValue = length > 2 ? args[2] : NIL;
     2545        // recursive-p is ignored
     2546        // boolean recursive = length > 3 ? (args[3] != NIL) : false;
     2547        return stream.readCharNoHang(eofError, eofValue);
     2548      }
     2549  };
     2550
     2551  // ### read-delimited-list char &optional input-stream recursive-p => list
     2552  private static final Primitive READ_DELIMITED_LIST =
     2553    new Primitive("read-delimited-list", "char &optional input-stream recursive-p") {
     2554
     2555      public LispObject execute(LispObject[] args) throws ConditionThrowable
     2556      {
     2557        int length = args.length;
     2558        if (length < 1 || length > 3)
     2559            error(new WrongNumberOfArgumentsException(this));
     2560        char c = LispCharacter.getValue(args[0]);
     2561        Stream stream =
     2562            length > 1 ? inSynonymOf(args[1]) : getStandardInput();
     2563        return stream.readDelimitedList(c);
     2564      }
     2565  };
     2566
     2567
     2568  // ### unread-char character &optional input-stream => nil
     2569  private static final Primitive UNREAD_CHAR =
     2570    new Primitive(Symbol.UNREAD_CHAR, "character &optional input-stream")
     2571    {
     2572      public LispObject execute(LispObject arg) throws ConditionThrowable
     2573      {
     2574        return getStandardInput().unreadChar(checkCharacter(arg));
     2575      }
     2576      public LispObject execute(LispObject first, LispObject second)
     2577        throws ConditionThrowable
     2578      {
     2579        Stream stream = inSynonymOf(second);
     2580        return stream.unreadChar(checkCharacter(first));
     2581      }
     2582    };
     2583
     2584  // ### write-vector-unsigned-byte-8
     2585  private static final Primitive WRITE_VECTOR_UNSIGNED_BYTE_8 =
     2586    new Primitive("write-vector-unsigned-byte-8", PACKAGE_SYS, true,
     2587                  "vector stream start end")
     2588    {
     2589      public LispObject execute(LispObject first, LispObject second,
     2590                                LispObject third, LispObject fourth)
     2591        throws ConditionThrowable
     2592      {
     2593        final AbstractVector v = checkVector(first);
     2594        final Stream stream;
     2595        try
     2596          {
     2597            stream = (Stream) second;
     2598          }
     2599        catch (ClassCastException e)
     2600          {
     2601            return type_error(second, Symbol.STREAM);
     2602          }
     2603        int start = Fixnum.getValue(third);
     2604        int end = Fixnum.getValue(fourth);
     2605        for (int i = start; i < end; i++)
     2606          stream._writeByte(v.aref(i));
     2607        return v;
     2608      }
     2609    };
     2610
     2611  // ### read-vector-unsigned-byte-8 vector stream start end => position
     2612  private static final Primitive READ_VECTOR_UNSIGNED_BYTE_8 =
     2613    new Primitive("read-vector-unsigned-byte-8", PACKAGE_SYS, true,
     2614                  "vector stream start end")
     2615    {
     2616      public LispObject execute(LispObject first, LispObject second,
     2617                                LispObject third, LispObject fourth)
     2618        throws ConditionThrowable
     2619      {
     2620        AbstractVector v = checkVector(first);
     2621        Stream stream = checkBinaryInputStream(second);
     2622        int start = Fixnum.getValue(third);
     2623        int end = Fixnum.getValue(fourth);
     2624        if (!v.getElementType().equal(UNSIGNED_BYTE_8))
     2625          return type_error(first, list2(Symbol.VECTOR,
     2626                                              UNSIGNED_BYTE_8));
     2627        for (int i = start; i < end; i++)
     2628          {
     2629            int n = stream._readByte();
     2630            if (n < 0)
     2631              {
     2632                // End of file.
     2633                return new Fixnum(i);
     2634              }
     2635            v.aset(i, n);
     2636          }
     2637        return fourth;
     2638      }
     2639    };
     2640
    19402641  // ### file-position
    19412642  private static final Primitive FILE_POSITION =
Note: See TracChangeset for help on using the changeset viewer.