1 /*
2 * Object.cpp -
3 *
4 * Copyright (c) 2008 Higepon(Taro Minowa) <higepon@users.sourceforge.jp>
5 *
6 * Redistribution and use in source and binary forms, with or without
7 * modification, are permitted provided that the following conditions
8 * are met:
9 *
10 * 1. Redistributions of source code must retain the above copyright
11 * notice, this list of conditions and the following disclaimer.
12 *
13 * 2. Redistributions in binary form must reproduce the above copyright
14 * notice, this list of conditions and the following disclaimer in the
15 * documentation and/or other materials provided with the distribution.
16 *
17 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
18 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
19 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
20 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
21 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
22 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
23 * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
24 * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
25 * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
26 * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
27 * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
28 *
29 * $Id$
30 */
31
32 #include "Object.h"
33 #include "Object-inl.h"
34 #include "Pair.h"
35 #include "Pair-inl.h"
36 #include "Ratnum.h"
37 #include "Flonum.h"
38 #include "Equivalent.h"
39 #include "Vector.h"
40 #include "SString.h"
41 #include "Symbol.h"
42 #include "ByteVector.h"
43 #include "Closure.h"
44 #include "Stack.h"
45 #include "EqHashTable.h"
46 #include "GenericHashTable.h"
47 #include "EqvHashTable.h"
48 #include "CProcedure.h"
49 #include "Box.h"
50 #include "Regexp.h"
51 #include "UtilityProcedures.h"
52 #include "Callable.h"
53 #include "OSCompat.h"
54 #include "FileBinaryInputPort.h"
55 #include "FileBinaryOutputPort.h"
56 #include "TextualOutputPort.h"
57 #include "TextualInputPort.h"
58 #include "Latin1Codec.h"
59 #include "Transcoder.h"
60 #include "StringTextualInputPort.h"
61 #include "StringTextualOutputPort.h"
62 #include "ByteArrayBinaryInputPort.h"
63 #include "CustomBinaryInputPort.h"
64 #include "CustomTextualInputPort.h"
65 #include "CustomTextualOutputPort.h"
66 #include "CustomTextualInputOutputPort.h"
67 #include "CustomBinaryOutputPort.h"
68 #include "CustomBinaryInputOutputPort.h"
69 #include "CodeBuilder.h"
70 #include "Ratnum.h"
71 #include "Flonum.h"
72 #include "Bignum.h"
73 #include "ProcedureMacro.h"
74 #include "Compnum.h"
75 #include "Arithmetic.h"
76 #include "BufferedFileBinaryInputPort.h"
77 #include "TranscodedTextualInputPort.h"
78 #include "TranscodedTextualOutputPort.h"
79 #include "TranscodedTextualInputOutputPort.h"
80 #include "OSCompatSocket.h"
81 #include "FFI.h"
82 #include "SimpleStruct.h"
83 #include "Continuation.h"
84 #include "SharedReference.h"
85
86 using namespace scheme;
87
88 const Object Object::Nil = Object::makeConst(CONST_NIL);
89 const Object Object::Eof = Object::makeConst(CONST_EOF);
90 const Object Object::Undef = Object::makeConst(CONST_UNDEF);
91 const Object Object::UnBound = Object::makeConst(CONST_UNBOUND);
92 const Object Object::True = Object::makeConst(CONST_TRUE);
93 const Object Object::False = Object::makeConst(CONST_FALSE);
94 const Object Object::Ignore = Object::makeConst(CONST_IGNORE);
95
isRational() const96 bool Object::isRational() const
97 {
98 return isFixnum() || isBignum() || (isFlonum() && toFlonum()->isRational()) || isRatnum();
99 }
100
101
isReal() const102 bool Object::isReal() const
103 {
104 return isFixnum() || isBignum() || isFlonum() || isRatnum() || (isCompnum() && toCompnum()->isReal());
105 }
106
isInteger() const107 bool Object::isInteger() const
108 {
109 return isFixnum() || isBignum() || (isNumber() && Arithmetic::isInteger(*this));
110 }
111
makeBinaryInputPort(File * file)112 Object Object::makeBinaryInputPort(File* file)
113 {
114 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::BinaryInputPort,
115 reinterpret_cast<intptr_t>(new FileBinaryInputPort(file)))));
116 }
117
makeBinaryOutputPort(File * file)118 Object Object::makeBinaryOutputPort(File* file)
119 {
120 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::BinaryOutputPort,
121 reinterpret_cast<intptr_t>(new FileBinaryOutputPort(file)))));
122 }
123
makeBinaryInputPort(BinaryInputPort * port)124 Object Object::makeBinaryInputPort(BinaryInputPort* port)
125 {
126 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::BinaryInputPort,
127 reinterpret_cast<intptr_t>(port))));
128 }
129
makeBinaryInputOutputPort(BinaryInputOutputPort * port)130 Object Object::makeBinaryInputOutputPort(BinaryInputOutputPort* port)
131 {
132 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::BinaryInputOutputPort,
133 reinterpret_cast<intptr_t>(port))));
134 }
135
136
makeBinaryOutputPort(BinaryOutputPort * port)137 Object Object::makeBinaryOutputPort(BinaryOutputPort* port)
138 {
139 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::BinaryOutputPort,
140 reinterpret_cast<intptr_t>(port))));
141 }
142
makeTextualOutputPort(BinaryOutputPort * port,Transcoder * transcoder)143 Object Object::makeTextualOutputPort(BinaryOutputPort* port, Transcoder* transcoder)
144 {
145 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::TextualOutputPort,
146 reinterpret_cast<intptr_t>(new TranscodedTextualOutputPort(port, transcoder)))));
147 }
148
makeTextualInputOutputPort(BinaryInputOutputPort * port,Transcoder * transcoder)149 Object Object::makeTextualInputOutputPort(BinaryInputOutputPort* port, Transcoder* transcoder)
150 {
151 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::TextualInputOutputPort,
152 reinterpret_cast<intptr_t>(new TranscodedTextualInputOutputPort(port, transcoder)))));
153 }
154
155
156
makeTextualInputFilePort(const ucs4char * file)157 Object Object::makeTextualInputFilePort(const ucs4char* file)
158 {
159 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::TextualInputPort,
160 reinterpret_cast<intptr_t>(new TranscodedTextualInputPort(new BufferedFileBinaryInputPort(file)
161 , createNativeTranscoder())))));
162 }
163
makeTextualInputFilePort(const char * file)164 Object Object::makeTextualInputFilePort(const char* file)
165 {
166 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::TextualInputPort,
167 reinterpret_cast<intptr_t>(new TranscodedTextualInputPort(new BufferedFileBinaryInputPort(file)
168 , createNativeTranscoder())))));
169 }
170
171
makeStringInputPort(const ucs4string & str)172 Object Object::makeStringInputPort(const ucs4string& str)
173 {
174 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::TextualInputPort,
175 reinterpret_cast<intptr_t>(new StringTextualInputPort(str)))));
176 }
177
makeStringOutputPort()178 Object Object::makeStringOutputPort()
179 {
180 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::TextualOutputPort,
181 reinterpret_cast<intptr_t>(new StringTextualOutputPort()))));
182 }
183
makeStringInputPort(const uint8_t * buf,int size)184 Object Object::makeStringInputPort(const uint8_t* buf, int size)
185 {
186 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::TextualInputPort,
187 reinterpret_cast<intptr_t>(new TranscodedTextualInputPort(new ByteArrayBinaryInputPort(buf, size)
188 , createNativeTranscoder())))));
189 }
190
makeCustomTextualInputPort(VM * theVM,const ucs4string & id,Object readProc,Object getPositionProc,Object setPositionProc,Object closeProc)191 Object Object::makeCustomTextualInputPort(VM* theVM,
192 const ucs4string& id,
193 Object readProc,
194 Object getPositionProc,
195 Object setPositionProc,
196 Object closeProc)
197 {
198 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::TextualInputPort,
199 reinterpret_cast<intptr_t>(new CustomTextualInputPort(theVM,
200 id,
201 readProc,
202 getPositionProc,
203 setPositionProc,
204 closeProc)))));
205 }
206
makeCustomTextualOutputPort(VM * theVM,const ucs4string & id,Object writeProc,Object getPositionProc,Object setPositionProc,Object closeProc)207 Object Object::makeCustomTextualOutputPort(VM* theVM,
208 const ucs4string& id,
209 Object writeProc,
210 Object getPositionProc,
211 Object setPositionProc,
212 Object closeProc)
213 {
214 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::TextualOutputPort,
215 reinterpret_cast<intptr_t>(new CustomTextualOutputPort(theVM,
216 id,
217 writeProc,
218 getPositionProc,
219 setPositionProc,
220 closeProc)))));
221 }
222
223
makeCustomTextualInputOutputPort(VM * theVM,const ucs4string & id,Object readProc,Object writeProc,Object getPositionProc,Object setPositionProc,Object closeProc)224 Object Object::makeCustomTextualInputOutputPort(VM* theVM,
225 const ucs4string& id,
226 Object readProc,
227 Object writeProc,
228 Object getPositionProc,
229 Object setPositionProc,
230 Object closeProc)
231 {
232 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::TextualInputOutputPort,
233 reinterpret_cast<intptr_t>(new CustomTextualInputOutputPort(theVM,
234 id,
235 readProc,
236 writeProc,
237 getPositionProc,
238 setPositionProc,
239 closeProc)))));
240 }
241
242
makeCustomBinaryInputPort(VM * theVM,const ucs4string & id,Object readProc,Object getPositionProc,Object setPositionProc,Object closeProc)243 Object Object::makeCustomBinaryInputPort(VM* theVM, const ucs4string& id, Object readProc, Object getPositionProc, Object setPositionProc, Object closeProc)
244 {
245 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::BinaryInputPort,
246 reinterpret_cast<intptr_t>(new CustomBinaryInputPort(theVM, id, readProc, getPositionProc, setPositionProc, closeProc)))));
247 }
248
makeCustomBinaryOutputPort(VM * theVM,const ucs4string & id,Object writeDProc,Object getPositionProc,Object setPositionDProc,Object closeProc)249 Object Object::makeCustomBinaryOutputPort(VM* theVM, const ucs4string& id, Object writeDProc, Object getPositionProc, Object setPositionDProc, Object closeProc)
250 {
251 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::BinaryOutputPort,
252 reinterpret_cast<intptr_t>(new CustomBinaryOutputPort(theVM, id, writeDProc, getPositionProc, setPositionDProc, closeProc)))));
253 }
254
makeCustomBinaryInputOutputPort(VM * theVM,const ucs4string & id,Object readProc,Object writeProc,Object getPositionProc,Object setPositionProc,Object closeProc)255 Object Object::makeCustomBinaryInputOutputPort(VM* theVM, const ucs4string& id, Object readProc, Object writeProc, Object getPositionProc, Object setPositionProc, Object closeProc)
256 {
257 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::BinaryInputOutputPort,
258 reinterpret_cast<intptr_t>(new CustomBinaryInputOutputPort(theVM, id, readProc, writeProc, getPositionProc, setPositionProc, closeProc)))));
259 }
260
261
makeCodec(Codec * codec)262 Object Object::makeCodec(Codec* codec)
263 {
264 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::Codec,
265 reinterpret_cast<intptr_t>(codec))));
266 }
267
makeTranscoder(Transcoder * transcoder)268 Object Object::makeTranscoder(Transcoder* transcoder)
269 {
270 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::Transcoder,
271 reinterpret_cast<intptr_t>(transcoder))));
272 }
273
makeTranscoder(Codec * codec)274 Object Object::makeTranscoder(Codec* codec)
275 {
276 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::Transcoder,
277 reinterpret_cast<intptr_t>(new Transcoder(codec)))));
278 }
279
makeTranscoder(Codec * codec,enum EolStyle eolStyle)280 Object Object::makeTranscoder(Codec* codec, enum EolStyle eolStyle)
281 {
282 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::Transcoder,
283 reinterpret_cast<intptr_t>(new Transcoder(codec, eolStyle)))));
284 }
285
makeTranscoder(Codec * codec,enum EolStyle eolStyle,enum ErrorHandlingMode errorHandlingMode)286 Object Object::makeTranscoder(Codec* codec, enum EolStyle eolStyle, enum ErrorHandlingMode errorHandlingMode)
287 {
288 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::Transcoder,
289 reinterpret_cast<intptr_t>(new Transcoder(codec, eolStyle, errorHandlingMode)))));
290 }
291
makeTextualInputPort(BinaryInputPort * port,Transcoder * transcoder)292 Object Object::makeTextualInputPort(BinaryInputPort* port, Transcoder* transcoder)
293 {
294 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::TextualInputPort,
295 reinterpret_cast<intptr_t>(new TranscodedTextualInputPort(port, transcoder)))));
296 }
297
makeTextualInputPort(TextualInputPort * port)298 Object Object::makeTextualInputPort(TextualInputPort* port)
299 {
300 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::TextualInputPort,
301 reinterpret_cast<intptr_t>(port))));
302 }
303
makeRegexp(const ucs4string & pattern,bool caseFold,bool isSingleLine)304 Object Object::makeRegexp(const ucs4string& pattern, bool caseFold, bool isSingleLine)
305 {
306 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::Regexp,
307 reinterpret_cast<intptr_t>(new Regexp(pattern, caseFold, isSingleLine)))));
308 }
309
makeRegMatch(OnigRegion * region,const ucs4string & text)310 Object Object::makeRegMatch(OnigRegion* region, const ucs4string& text)
311 {
312 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::RegMatch,
313 reinterpret_cast<intptr_t>(new RegMatch(region, text)))));
314 }
makeSymbol(const ucs4char * str)315 Object Object::makeSymbol(const ucs4char* str)
316 {
317 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::Symbol, reinterpret_cast<intptr_t>(new Symbol(str)))));
318 }
319
makeBox(Object o)320 Object Object::makeBox(Object o)
321 {
322 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::Box, reinterpret_cast<intptr_t>(new Box(o)))));
323 }
324
makeByteVector(int n)325 Object Object::makeByteVector(int n)
326 {
327 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::ByteVector, reinterpret_cast<intptr_t>(new ByteVector(n)))));
328 }
329
makeByteVector(int n,int8_t v)330 Object Object::makeByteVector(int n, int8_t v)
331 {
332 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::ByteVector, reinterpret_cast<intptr_t>(new ByteVector(n, v)))));
333 }
334
makeByteVector(const char * src,size_t length)335 Object Object::makeByteVector(const char* src, size_t length)
336 {
337 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::ByteVector, reinterpret_cast<intptr_t>(new ByteVector(src, length)))));
338 }
339
makeStack(Object * src,int size)340 Object Object::makeStack(Object* src, int size)
341 {
342 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::Stack, reinterpret_cast<intptr_t>(new Stack(src, size)))));
343 }
344
345
makeEqHashTable()346 Object Object::makeEqHashTable()
347 {
348 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::EqHashTable, reinterpret_cast<intptr_t>(new EqHashTable()))));
349 }
350
makeEqvHashTable(VM * theVM)351 Object Object::makeEqvHashTable(VM* theVM)
352 {
353 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::EqvHashTable, reinterpret_cast<intptr_t>(new EqvHashTable(theVM)))));
354 }
355
356
makeCProcedure(Object (* proc)(VM * vm,int,const Object *))357 Object Object::makeCProcedure(Object (*proc)(VM* vm, int, const Object*))
358 {
359 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::CProcedure, reinterpret_cast<intptr_t>(new CProcedure(proc)))));
360 }
361
makeCodeBuilder()362 Object Object::makeCodeBuilder()
363 {
364 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::CodeBuilder,
365 reinterpret_cast<intptr_t>(new CodeBuilder()))));
366 }
367
makeGenericHashTable(VM * theVM,Object hashFunction,Object equivalenceFunction)368 Object Object::makeGenericHashTable(VM* theVM, Object hashFunction, Object equivalenceFunction)
369 {
370 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::GenericHashTable,
371 reinterpret_cast<intptr_t>(new GenericHashTable(theVM, hashFunction, equivalenceFunction)))));
372 }
373
makeCallable(Callable * callable)374 Object Object::makeCallable(Callable* callable)
375 {
376 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::Callable,
377 reinterpret_cast<intptr_t>(callable))));
378 }
379
makeRatnum(int numerator,int denominator)380 Object Object::makeRatnum(int numerator, int denominator)
381 {
382 return Object::makeRatnum(new Ratnum(numerator, denominator));
383 }
384
makeRatnum(Ratnum * r)385 Object Object::makeRatnum(Ratnum* r)
386 {
387 Object denominator = r->denominator();
388 if (denominator.isFixnum() && denominator.toFixnum() == 1) {
389 return r->numerator();
390 } else {
391 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::Ratnum,
392 reinterpret_cast<intptr_t>(r))));
393 }
394 }
395
makeCompnum(Object real,Object imag)396 Object Object::makeCompnum(Object real, Object imag)
397 {
398 if (Arithmetic::isExactZero(imag)) {
399 return real;
400 } else {
401 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::Compnum,
402 reinterpret_cast<intptr_t>(new Compnum(real, imag)))));
403 }
404 }
405
makeSocket(const Socket * socket)406 Object Object::makeSocket(const Socket* socket)
407 {
408 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::Socket,
409 reinterpret_cast<intptr_t>(socket))));
410 }
411
makeVM(VM * vm)412 Object Object::makeVM(VM* vm)
413 {
414 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::VM,
415 reinterpret_cast<intptr_t>(vm))));
416 }
417
makeConditionVariable(ConditionVariable * c)418 Object Object::makeConditionVariable(ConditionVariable* c)
419 {
420 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::ConditionVariable,
421 reinterpret_cast<intptr_t>(c))));
422 }
423
makeMutex(Mutex * c)424 Object Object::makeMutex(Mutex* c)
425 {
426 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::Mutex,
427 reinterpret_cast<intptr_t>(c))));
428 }
429
makePointer(void * pointer)430 Object Object::makePointer(void* pointer)
431 {
432 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::Pointer,
433 reinterpret_cast<intptr_t>(new Pointer(pointer)))));
434 }
435
makeSimpleStruct(Object name,int fieldCount)436 Object Object::makeSimpleStruct(Object name, int fieldCount)
437 {
438 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::SimpleStruct,
439 reinterpret_cast<intptr_t>(new SimpleStruct(name, fieldCount)))));
440 }
441
makeContinuation(Object stack,Object shiftSize,Object winders)442 Object Object::makeContinuation(Object stack, Object shiftSize, Object winders)
443 {
444 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::Continuation,
445 reinterpret_cast<intptr_t>(new Continuation(stack, shiftSize, winders)))));
446 }
447
makeSharedReference(int index)448 Object Object::makeSharedReference(int index)
449 {
450 return Object(reinterpret_cast<intptr_t>(new HeapObject(HeapObject::SharedReference,
451 reinterpret_cast<intptr_t>(new SharedReference(index)))));
452 }
453
isIntegerValued() const454 bool Object::isIntegerValued() const
455 {
456 return Arithmetic::isIntegerValued(*this);
457 }
458
isList() const459 bool Object::isList() const
460 {
461 return Pair::isList(*this);
462 }
463
isOctet() const464 bool Object::isOctet() const
465 {
466 return (isFixnum() && ByteVector::isOctet(toFixnum()));
467 }
468