1 /*
2 * VM.cpp - Virtual stack based machine.
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 "EqHashTable.h"
37 #include "VM.h"
38 #include "Closure.h"
39 #include "EqHashTable.h"
40 #include "Symbol.h"
41 #include "Gloc.h"
42 #include "VM-inl.h"
43 #include "CompilerProcedures.h"
44 #include "HashTableProcedures.h"
45 #include "StringProcedures.h"
46 #include "PortProcedures.h"
47 #include "ErrorProcedures.h"
48 #include "ListProcedures.h"
49 #include "ArithmeticProcedures.h"
50 #include "FlonumProcedures.h"
51 #include "BitwiseProcedures.h"
52 #include "ProcessProcedures.h"
53 #include "ByteVectorProcedures.h"
54 #include "FFIProcedures.h"
55 #include "Codec.h"
56 #include "Ratnum.h"
57 #include "Flonum.h"
58 #include "Equivalent.h"
59 #include "TextualOutputPort.h"
60 #include "TextualInputPort.h"
61 #include "Vector.h"
62 #include "SString.h"
63 #include "CProcedure.h"
64 #include "Box.h"
65 #include "UtilityProcedures.h"
66 #include "RegexpProcedures.h"
67 #include "FixnumProcedures.h"
68 #include "SocketProcedures.h"
69 #include "MultiVMProcedures.h"
70 #include "CompilerProcedures.h"
71 #include "Bignum.h"
72 #include "ByteArrayBinaryInputPort.h"
73 #include "Symbol.h"
74 #include "SimpleStruct.h"
75 #include "FaslReader.h"
76 #include "Gloc.h"
77 #include "OSCompat.h"
78 #include "BinaryOutputPort.h"
79 #include "BinaryInputOutputPort.h"
80 #include "TranscodedTextualInputOutputPort.h"
81 #include "Scanner.h"
82 #include "Reader.h"
83 #include "NumberReader.h"
84 #include "Code.h"
85
86 #define TRY_VM jmp_buf org; \
87 copyJmpBuf(org, returnPoint_); \
88 if (setjmp(returnPoint_) == 0) \
89
90 #define CATCH_VM copyJmpBuf(returnPoint_, org); \
91 } else {
92
93 using namespace scheme;
94
95 #include "cprocedures.cpp"
96
VM(int stackSize,Object outPort,Object errorPort,Object inputPort,bool isProfiler)97 VM::VM(int stackSize, Object outPort, Object errorPort, Object inputPort, bool isProfiler) :
98 ac_(Object::Nil),
99 dc_(Object::Nil),
100 cl_(Object::Nil),
101 pc_(NULL),
102 stackSize_(stackSize),
103 currentOutputPort_(outPort),
104 currentErrorPort_(errorPort),
105 currentInputPort_(inputPort),
106 errorObj_(Object::Nil),
107 #ifdef ENABLE_PROFILER
108 profilerRunning_(false),
109 #endif
110 isProfiler_(isProfiler),
111 maxNumValues_(256),
112 numValues_(0),
113 isR6RSMode_(false),
114 name_(UC("")),
115 thread_(NULL),
116 readerContext_(new ReaderContext),
117 numberReaderContext_(new NumberReaderContext),
118 errno_(0),
119 dynamicWinders_(Object::Nil),
120 callBackTrampolines_(new EqHashTable),
121 callBackTrampolinesUid_(0)
122 {
123 stack_ = Object::makeObjectArrayLocal(stackSize);
124 values_ = Object::makeObjectArrayLocal(maxNumValues_);
125 stackEnd_ = stack_ + stackSize;
126 sp_ = stack_;
127 fp_ = stack_;
128 nameSpace_ = Object::makeEqHashTable();
129 outerSourceInfo_ = L2(Object::False, Symbol::intern(UC("<top-level>")));
130 cProcs_ = Object::makeObjectArrayLocal(cProcNum);
131 for (int i = 0; i < cProcNum; i++) {
132 cProcs_[i] = Object::makeCProcedure(cProcFunctions[i]);
133 }
134
135 // initialize "On the fly" instructions array
136 closureForEvaluate_ = Object::makeClosure(NULL, 0, 0, false, cProcs_, cProcNum, 0, outerSourceInfo_);
137 closureForApply_ = Object::makeClosure(NULL, 0, 0, false, cProcs_, cProcNum, 1, outerSourceInfo_);;
138
139 initializeDynamicCode();
140 }
141
~VM()142 VM::~VM() {}
143
initializeDynamicCode()144 void VM::initializeDynamicCode()
145 {
146 applyCode_ = new Code(9);
147 applyCode_->push(Object::makeRaw(Instruction::FRAME));
148 applyCode_->push(Object::makeFixnum(7));
149 applyCode_->push(Object::makeRaw(Instruction::CONSTANT));
150 applyCode_->push(Object::Undef);
151 applyCode_->push(Object::makeRaw(Instruction::PUSH));
152 applyCode_->push(Object::makeRaw(Instruction::CONSTANT));
153 applyCode_->push(Object::Undef);
154 applyCode_->push(Object::makeRaw(Instruction::APPLY));
155 applyCode_->push(Object::makeRaw(Instruction::HALT));
156
157 callClosure0Code_ = new Code(7);
158 callClosure0Code_->push(Object::makeRaw(Instruction::FRAME));
159 callClosure0Code_->push(Object::makeFixnum(5));
160 callClosure0Code_->push(Object::makeRaw(Instruction::CONSTANT));
161 callClosure0Code_->push(Object::Undef);
162 callClosure0Code_->push(Object::makeRaw(Instruction::CALL));
163 callClosure0Code_->push(Object::makeFixnum(0));
164 callClosure0Code_->push(Object::makeRaw(Instruction::HALT));
165
166 callClosure1Code_ = new Code(10);
167 callClosure1Code_->push(Object::makeRaw(Instruction::FRAME));
168 callClosure1Code_->push(Object::makeFixnum(8));
169 callClosure1Code_->push(Object::makeRaw(Instruction::CONSTANT));
170 callClosure1Code_->push(Object::Undef);
171 callClosure1Code_->push(Object::makeRaw(Instruction::PUSH));
172 callClosure1Code_->push(Object::makeRaw(Instruction::CONSTANT));
173 callClosure1Code_->push(Object::Undef);
174 callClosure1Code_->push(Object::makeRaw(Instruction::CALL));
175 callClosure1Code_->push(Object::makeFixnum(1));
176 callClosure1Code_->push(Object::makeRaw(Instruction::HALT));
177
178 callClosure2Code_ = new Code(13);
179 callClosure2Code_->push(Object::makeRaw(Instruction::FRAME));
180 callClosure2Code_->push(Object::makeFixnum(11));
181 callClosure2Code_->push(Object::makeRaw(Instruction::CONSTANT));
182 callClosure2Code_->push(Object::Undef);
183 callClosure2Code_->push(Object::makeRaw(Instruction::PUSH));
184 callClosure2Code_->push(Object::makeRaw(Instruction::CONSTANT));
185 callClosure2Code_->push(Object::Undef);
186 callClosure2Code_->push(Object::makeRaw(Instruction::PUSH));
187 callClosure2Code_->push(Object::makeRaw(Instruction::CONSTANT));
188 callClosure2Code_->push(Object::Undef);
189 callClosure2Code_->push(Object::makeRaw(Instruction::CALL));
190 callClosure2Code_->push(Object::makeFixnum(2));
191 callClosure2Code_->push(Object::makeRaw(Instruction::HALT));
192
193 callClosure3Code_ = new Code(16);
194 callClosure3Code_->push(Object::makeRaw(Instruction::FRAME));
195 callClosure3Code_->push(Object::makeFixnum(14));
196 callClosure3Code_->push(Object::makeRaw(Instruction::CONSTANT));
197 callClosure3Code_->push(Object::Undef);
198 callClosure3Code_->push(Object::makeRaw(Instruction::PUSH));
199 callClosure3Code_->push(Object::makeRaw(Instruction::CONSTANT));
200 callClosure3Code_->push(Object::Undef);
201 callClosure3Code_->push(Object::makeRaw(Instruction::PUSH));
202 callClosure3Code_->push(Object::makeRaw(Instruction::CONSTANT));
203 callClosure3Code_->push(Object::Undef);
204 callClosure3Code_->push(Object::makeRaw(Instruction::PUSH));
205 callClosure3Code_->push(Object::makeRaw(Instruction::CONSTANT));
206 callClosure3Code_->push(Object::Undef);
207 callClosure3Code_->push(Object::makeRaw(Instruction::CALL));
208 callClosure3Code_->push(Object::makeFixnum(3));
209 callClosure3Code_->push(Object::makeRaw(Instruction::HALT));
210
211 trigger0Code_ = new Code(7);
212 trigger0Code_->push(Object::makeRaw(Instruction::CONSTANT));
213 trigger0Code_->push(Object::Undef);
214 trigger0Code_->push(Object::makeRaw(Instruction::CALL));
215 trigger0Code_->push(Object::makeFixnum(0));
216 trigger0Code_->push(Object::makeRaw(Instruction::RETURN));
217 trigger0Code_->push(Object::makeFixnum(0));
218 trigger0Code_->push(Object::makeRaw(Instruction::HALT));
219
220 trigger1Code_ = new Code(10);
221 trigger1Code_->push(Object::makeRaw(Instruction::CONSTANT));
222 trigger1Code_->push(Object::Undef);
223 trigger1Code_->push(Object::makeRaw(Instruction::PUSH));
224 trigger1Code_->push(Object::makeRaw(Instruction::CONSTANT));
225 trigger1Code_->push(Object::Undef);
226 trigger1Code_->push(Object::makeRaw(Instruction::CALL));
227 trigger1Code_->push(Object::makeFixnum(1));
228 trigger1Code_->push(Object::makeRaw(Instruction::RETURN));
229 trigger1Code_->push(Object::makeFixnum(0));
230 trigger1Code_->push(Object::makeRaw(Instruction::HALT));
231
232 trigger2Code_ = new Code(13);
233 trigger2Code_->push(Object::makeRaw(Instruction::CONSTANT));
234 trigger2Code_->push(Object::Undef);
235 trigger2Code_->push(Object::makeRaw(Instruction::PUSH));
236 trigger2Code_->push(Object::makeRaw(Instruction::CONSTANT));
237 trigger2Code_->push(Object::Undef);
238 trigger2Code_->push(Object::makeRaw(Instruction::PUSH));
239 trigger2Code_->push(Object::makeRaw(Instruction::CONSTANT));
240 trigger2Code_->push(Object::Undef);
241 trigger2Code_->push(Object::makeRaw(Instruction::CALL));
242 trigger2Code_->push(Object::makeFixnum(2));
243 trigger2Code_->push(Object::makeRaw(Instruction::RETURN));
244 trigger2Code_->push(Object::makeFixnum(0));
245 trigger2Code_->push(Object::makeRaw(Instruction::HALT));
246
247 trigger3Code_ = new Code(16);
248 trigger3Code_->push(Object::makeRaw(Instruction::CONSTANT));
249 trigger3Code_->push(Object::Undef);
250 trigger3Code_->push(Object::makeRaw(Instruction::PUSH));
251 trigger3Code_->push(Object::makeRaw(Instruction::CONSTANT));
252 trigger3Code_->push(Object::Undef);
253 trigger3Code_->push(Object::makeRaw(Instruction::PUSH));
254 trigger3Code_->push(Object::makeRaw(Instruction::CONSTANT));
255 trigger3Code_->push(Object::Undef);
256 trigger3Code_->push(Object::makeRaw(Instruction::PUSH));
257 trigger3Code_->push(Object::makeRaw(Instruction::CONSTANT));
258 trigger3Code_->push(Object::Undef);
259 trigger3Code_->push(Object::makeRaw(Instruction::CALL));
260 trigger3Code_->push(Object::makeFixnum(3));
261 trigger3Code_->push(Object::makeRaw(Instruction::RETURN));
262 trigger3Code_->push(Object::makeFixnum(0));
263 trigger3Code_->push(Object::makeRaw(Instruction::HALT));
264
265 trigger4Code_ = new Code(19);
266 trigger4Code_->push(Object::makeRaw(Instruction::CONSTANT));
267 trigger4Code_->push(Object::Undef);
268 trigger4Code_->push(Object::makeRaw(Instruction::PUSH));
269 trigger4Code_->push(Object::makeRaw(Instruction::CONSTANT));
270 trigger4Code_->push(Object::Undef);
271 trigger4Code_->push(Object::makeRaw(Instruction::PUSH));
272 trigger4Code_->push(Object::makeRaw(Instruction::CONSTANT));
273 trigger4Code_->push(Object::Undef);
274 trigger4Code_->push(Object::makeRaw(Instruction::PUSH));
275 trigger4Code_->push(Object::makeRaw(Instruction::CONSTANT));
276 trigger4Code_->push(Object::Undef);
277 trigger4Code_->push(Object::makeRaw(Instruction::PUSH));
278 trigger4Code_->push(Object::makeRaw(Instruction::CONSTANT));
279 trigger4Code_->push(Object::Undef);
280 trigger4Code_->push(Object::makeRaw(Instruction::CALL));
281 trigger4Code_->push(Object::makeFixnum(4));
282 trigger4Code_->push(Object::makeRaw(Instruction::RETURN));
283 trigger4Code_->push(Object::makeFixnum(0));
284 trigger4Code_->push(Object::makeRaw(Instruction::HALT));
285
286 callClosureByNameCode_ = new Code(10);
287 callClosureByNameCode_->push(Object::makeRaw(Instruction::FRAME));
288 callClosureByNameCode_->push(Object::makeFixnum(8));
289 callClosureByNameCode_->push(Object::makeRaw(Instruction::CONSTANT));
290 callClosureByNameCode_->push(Object::Undef);
291 callClosureByNameCode_->push(Object::makeRaw(Instruction::PUSH));
292 callClosureByNameCode_->push(Object::makeRaw(Instruction::REFER_GLOBAL));
293 callClosureByNameCode_->push(Object::Undef);
294 callClosureByNameCode_->push(Object::makeRaw(Instruction::CALL));
295 callClosureByNameCode_->push(Object::makeFixnum(1));
296 callClosureByNameCode_->push(Object::makeRaw(Instruction::HALT));
297
298 callCode_ = new Code(3);
299 }
300
loadCompiler()301 void VM::loadCompiler()
302 {
303 # include "match.h"
304 # include "baselib.h"
305 const Object libCompiler = FASL_GET(baselib_image);
306 #ifdef ENABLE_PROFILER
307 if (isProfiler_) {
308 initProfiler();
309 }
310 #endif
311 TRY_VM {
312 evaluateUnsafe(libCompiler.toVector(), true);
313 const Object libMatch = FASL_GET(match_image);
314 evaluateUnsafe(libMatch.toVector());
315 CATCH_VM
316 // call default error handler
317 defaultExceptionHandler(errorObj_);
318 this->exit(-1);
319 }
320 }
321
322
getGlobalValue(Object id)323 Object VM::getGlobalValue(Object id)
324 {
325 const Object val = nameSpace_.toEqHashTable()->ref(id, notFound_);
326 if (val != notFound_) {
327 return val.toGloc()->value();
328 } else {
329 callAssertionViolationAfter(this, "symbol-value2", "unbound variable", L1(id));
330 return Object::Undef;
331 }
332 }
333
defaultExceptionHandler(Object error)334 void VM::defaultExceptionHandler(Object error)
335 {
336 currentErrorPort_.toTextualOutputPort()->format(this, UC("\n Exception:\n~a\n"), L1(error));
337 }
338
dumpCompiledCode(Object code) const339 void VM::dumpCompiledCode(Object code) const
340 {
341 MOSH_ASSERT(code.isVector());
342 Vector* const v = code.toVector();
343 for (int i = 0; i < v->length(); i++) {
344 const Object c = v->ref(i);
345 if (c.isInstruction()) {
346 VM_LOG1("\n~a ", Instruction::toString(c.val));
347 } else {
348 VM_LOG1("~a ", c);
349 }
350 }
351 }
352
353
354 // N.B. If you call loadFileUnsafe, be sure that this code is inside the TRY_VM/CATCH_VM
loadFileUnsafe(const ucs4string & file)355 void VM::loadFileUnsafe(const ucs4string& file)
356 {
357 Registers r;
358 saveRegisters(&r);
359 const Object loadPort = Object::makeTextualInputFilePort(file.ascii_c_str());
360 TextualInputPort* p = loadPort.toTextualInputPort();
361 bool readErrorOccured = false;
362 for (Object o = p->getDatum(readErrorOccured); !o.isEof(); o = p->getDatum(readErrorOccured)) {
363 if (readErrorOccured) {
364 callLexicalViolationImmidiaImmediately(this, "read", p->error());
365 }
366 evaluateUnsafe(compile(o).toVector());
367 }
368 restoreRegisters(&r);
369 }
370
loadFileWithGuard(const ucs4string & file)371 void VM::loadFileWithGuard(const ucs4string& file)
372 {
373 TRY_VM {
374 ucs4string moshLibPath(UC(MOSH_LIB_PATH));
375 moshLibPath += UC("/") + file;
376 if (File::isExist(file)) {
377 loadFileUnsafe(file);
378 } else if (File::isExist(moshLibPath)) {
379 loadFileUnsafe(moshLibPath);
380 } else {
381 callAssertionViolationImmidiaImmediately(this,
382 "load",
383 "cannot find file in load path",
384 L1(Object::makeString(file)));
385 }
386 CATCH_VM
387 // call default error handler
388 defaultExceptionHandler(errorObj_);
389 this->exit(-1);
390 }
391 }
392
393 // Faster than evaluateUnsafe, used to load compiler, which won't raise error.
evaluateUnsafe(Object * code,int codeSize,bool isCompiler)394 Object VM::evaluateUnsafe(Object* code, int codeSize, bool isCompiler /* = false */)
395 {
396 closureForEvaluate_.toClosure()->pc = code;
397 ac_ = closureForEvaluate_;
398 dc_ = closureForEvaluate_;
399 cl_ = closureForEvaluate_;
400 fp_ = 0;
401 Object* const direct = getDirectThreadedCode(code, codeSize, isCompiler);
402 return runLoop(direct, NULL);
403 }
404
evaluateUnsafe(Vector * code,bool isCompiler)405 Object VM::evaluateUnsafe(Vector* code, bool isCompiler /* = false */)
406 {
407 return evaluateUnsafe(code->data(), code->length(), isCompiler);
408 }
409
evaluateSafe(Object * code,int codeSize,bool isCompiler)410 Object VM::evaluateSafe(Object* code, int codeSize, bool isCompiler /* = false */)
411 {
412 Registers r;
413 saveRegisters(&r);
414 Object ret = Object::Undef;
415 TRY_VM {
416 ret = evaluateUnsafe(code, codeSize, isCompiler);
417 CATCH_VM
418 defaultExceptionHandler(errorObj_);
419 this->exit(-1);
420 }
421 restoreRegisters(&r);
422 return ret;
423 }
424
evaluateSafe(Vector * code)425 Object VM::evaluateSafe(Vector* code)
426 {
427 return evaluateSafe(code->data(), code->length());
428 }
429
evaluateSafe(Code * code)430 Object VM::evaluateSafe(Code* code)
431 {
432 return evaluateSafe(code->code(), code->size());
433 }
434
callClosure0(Object closure)435 Object VM::callClosure0(Object closure)
436 {
437 callClosure0Code_->set(3, closure);
438 return evaluateSafe(callClosure0Code_);
439 }
440
callClosure1(Object closure,Object arg)441 Object VM::callClosure1(Object closure, Object arg)
442 {
443 callClosure1Code_->set(3, arg);
444 callClosure1Code_->set(6, closure);
445 return evaluateSafe(callClosure1Code_);
446 }
447
callClosure2(Object closure,Object arg1,Object arg2)448 Object VM::callClosure2(Object closure, Object arg1, Object arg2)
449 {
450 callClosure2Code_->set(3, arg1);
451 callClosure2Code_->set(6, arg2);
452 callClosure2Code_->set(9, closure);
453 return evaluateSafe(callClosure2Code_);
454 }
455
callClosure3(Object closure,Object arg1,Object arg2,Object arg3)456 Object VM::callClosure3(Object closure, Object arg1, Object arg2, Object arg3)
457 {
458 callClosure3Code_->set(3, arg1);
459 callClosure3Code_->set(6, arg2);
460 callClosure3Code_->set(9, arg3);
461 callClosure3Code_->set(12, closure);
462 return evaluateSafe(callClosure3Code_);
463 }
464
compileWithoutHalt(Object sexp)465 Object VM::compileWithoutHalt(Object sexp)
466 {
467 static Object compiler = Symbol::intern(UC("compile-w/o-halt"));
468 return callClosureByName(compiler, sexp);
469 }
470
evalCompiledAfter(Object code)471 Object VM::evalCompiledAfter(Object code)
472 {
473 VM_ASSERT(code.isVector());
474 Vector* const vcode = code.toVector();
475
476 // We need to append "RETURN 0" to the code.
477 const int codeSize = vcode->length();
478 const int bodySize = codeSize + 2;
479 Object* body = Object::makeObjectArray(bodySize);
480 for (int i = 0; i < codeSize; i++) {
481 body[i] = (vcode->data())[i];
482 }
483 body[codeSize] = Object::makeRaw(Instruction::RETURN);
484 body[codeSize+ 1] = Object::makeFixnum(0);
485
486 // make closure for save/restore current environment
487 Closure* const closure = new Closure(getDirectThreadedCode(body, bodySize), // pc
488 bodySize, // codeSize
489 0, // argLength
490 false, // isOptionalArg
491 cProcs_, // freeVars
492 cProcNum, // freeVariablesNum
493 0, // todo maxStack
494 Object::False); // todo sourceInfo
495 return setAfterTrigger0(Object::makeClosure(closure));
496 }
497
evalAfter(Object sexp)498 Object VM::evalAfter(Object sexp)
499 {
500 const Object code = compileWithoutHalt(sexp);
501 VM_ASSERT(code.isVector());
502 Vector* const vcode = code.toVector();
503
504 // We need to append "RETURN 0" to the code.
505 const int codeSize = vcode->length();
506 const int bodySize = codeSize + 2;
507 Object* body = Object::makeObjectArray(bodySize);
508 for (int i = 0; i < codeSize; i++) {
509 body[i] = (vcode->data())[i];
510 }
511 body[codeSize] = Object::makeRaw(Instruction::RETURN);
512 body[codeSize+ 1] = Object::makeFixnum(0);
513
514 // make closure for save/restore current environment
515 Closure* const closure = new Closure(getDirectThreadedCode(body, bodySize), // pc
516 bodySize, // codeSize
517 0, // argLength
518 false, // isOptionalArg
519 cProcs_, // freeVars
520 cProcNum, // freeVariablesNum
521 0, // todo maxStack
522 Object::False); // todo sourceInfo
523 return setAfterTrigger0(Object::makeClosure(closure));
524 }
525
setAfterTrigger0(Object closure)526 Object VM::setAfterTrigger0(Object closure)
527 {
528 makeCallFrame(pc_);
529 pc_ = getDirectThreadedCode(trigger0Code_->code(), trigger0Code_->size());
530 pc_[1]= closure;
531 return ac_;
532 }
533
534
setAfterTrigger1(Object closure,Object arg1)535 Object VM::setAfterTrigger1(Object closure, Object arg1)
536 {
537 makeCallFrame(pc_);
538 pc_ = getDirectThreadedCode(trigger1Code_->code(), trigger1Code_->size());
539 pc_[4] = closure;
540 pc_[1]= arg1;
541 return ac_;
542 }
543
setAfterTrigger2(Object closure,Object arg1,Object arg2)544 Object VM::setAfterTrigger2(Object closure, Object arg1, Object arg2)
545 {
546 makeCallFrame(pc_);
547 pc_ = getDirectThreadedCode(trigger2Code_->code(), trigger2Code_->size());
548 pc_[7] = closure;
549 pc_[4]= arg2;
550 pc_[1]= arg1;
551 return ac_;
552 }
553
setAfterTrigger3(Object closure,Object arg1,Object arg2,Object arg3)554 Object VM::setAfterTrigger3(Object closure, Object arg1, Object arg2, Object arg3)
555 {
556 makeCallFrame(pc_);
557 pc_ = getDirectThreadedCode(trigger3Code_->code(), trigger3Code_->size());
558 pc_[10] = closure;
559 pc_[7]= arg3;
560 pc_[4]= arg2;
561 pc_[1]= arg1;
562 return ac_;
563 }
564
setAfterTrigger4(Object closure,Object arg1,Object arg2,Object arg3,Object arg4)565 Object VM::setAfterTrigger4(Object closure, Object arg1, Object arg2, Object arg3, Object arg4)
566 {
567 makeCallFrame(pc_);
568 pc_ = getDirectThreadedCode(trigger4Code_->code(), trigger4Code_->size());
569 pc_[13] = closure;
570 pc_[10]= arg4;
571 pc_[7]= arg3;
572 pc_[4]= arg2;
573 pc_[1]= arg1;
574 return ac_;
575 }
576
577 // we need to save registers.
callClosureByName(Object procSymbol,Object arg)578 Object VM::callClosureByName(Object procSymbol, Object arg)
579 {
580 MOSH_ASSERT(procSymbol.isSymbol());
581 callClosureByNameCode_->set(3, arg);
582 callClosureByNameCode_->set(6, procSymbol);
583 return evaluateSafe(callClosureByNameCode_);
584 }
585
apply(Object proc,Object args)586 Object VM::apply(Object proc, Object args)
587 {
588 applyCode_->set(3, args);
589 applyCode_->set(6, proc);
590 return evaluateSafe(applyCode_);
591 }
592
vmapply(Object proc,Object args)593 Object VM::vmapply(Object proc, Object args)
594 {
595 const int procLength = Pair::length(proc);
596 Code* code = new Code(procLength + 7);
597
598 code->push(Object::makeRaw(Instruction::FRAME));
599 code->push(Object::makeFixnum(procLength + 5));
600 code->push(Object::makeRaw(Instruction::CONSTANT));
601 code->push(args);
602 code->push(Object::makeRaw(Instruction::PUSH));
603 for (Object o = proc; !o.isNil(); o = o.cdr()) {
604 code->push(o.car());
605 }
606 code->push(Object::makeRaw(Instruction::APPLY));
607 code->push(Object::makeRaw(Instruction::HALT));
608 return evaluateSafe(code->code(), code->size());
609 }
610
compile(Object code)611 Object VM::compile(Object code)
612 {
613 static Object proc = Symbol::intern(UC("compile"));
614 const Object compiled = callClosureByName(proc, code);
615 return compiled;
616 }
617
getStackTraceObj()618 Object VM::getStackTraceObj()
619 {
620 #ifdef MONA
621 monapi_warn("stack trace is currently disabled, since it causes gc crash.");
622 return Object::Nil;
623 #else
624 //const int MAX_DEPTH = 20;
625 const int FP_OFFSET_IN_FRAME = 1;
626 const int CLOSURE_OFFSET_IN_FRAME = 2;
627
628 Object r = Object::Nil;
629 Object cur = Object::Nil;
630 Object* fp = fp_;
631 Object* cl = &cl_;
632 for (int i = 0;;) {
633 if (cl->isClosure()) {
634 Object src = cl->toClosure()->sourceInfo;
635 if (src.isPair()) {
636 const Object procedure = src.cdr();
637 const Object location = src.car();
638 r = L3(Symbol::intern(UC("*proc*")),procedure,location);
639 }else{
640 r = L1(Symbol::intern(UC("*unknown-proc*")));
641 }
642 i++;
643 } else if (cl->isCProcedure()) {
644 r = L2(Symbol::intern(UC("*cproc*")),getClosureName(*cl));
645 i++;
646 } else if (cl->isRegMatch()) {
647 r = L2(Symbol::intern(UC("*reg-match*")),*cl);
648 i++;
649 } else if (cl->isRegexp()) {
650 r = L2(Symbol::intern(UC("*regexp*")),*cl);
651 i++;
652 } else {
653 MOSH_ASSERT(false);
654 }
655 cur = Object::cons(Object::cons(Object::makeFixnum(i),r),cur);
656 #if 0
657 if (i > MAX_DEPTH) {
658 port->display(this, UC(" ... (more stack dump truncated)\n"));
659 break;
660 }
661 #endif
662
663 VM_ASSERT(!(*cl).isObjectPointer());
664 VM_ASSERT((*cl).isClosure() || (*cl).isCProcedure() );
665 if (fp > stack_) {
666 cl = fp - CLOSURE_OFFSET_IN_FRAME;
667
668 // N.B. We must check whether cl is Object pointer or not.
669 // If so, we can't touch them. (touching may cause crash)
670 if (mayBeStackPointer(cl)) {
671 break;
672 }
673 if (!((*cl).isClosure()) && !((*cl).isCProcedure())) {
674 break;
675 }
676 // next fp is Object pointer, so 4byte aligned.
677 // if it is not Object pointer, may be tail call
678 Object* nextFp = fp - FP_OFFSET_IN_FRAME;
679 if (!(nextFp->isRawPointer())) {
680 break;
681 }
682
683 if (!mayBeStackPointer(nextFp)) {
684 // getOutputPort().toTextualOutputPort()->format(UC("[[[[~a]]]]"), *nextFp);
685 break;
686 }
687
688 VM_ASSERT(nextFp->isObjectPointer());
689 fp = nextFp->toObjectPointer();
690 } else {
691 break;
692 }
693 }
694 return cur;
695 #endif
696 }
697
getStackTrace()698 Object VM::getStackTrace()
699 {
700 #ifdef MONA
701 monapi_warn("stack trace is currently disabled, since it causes gc crash.");
702 return Object::Nil;
703 #else
704 const int MAX_DEPTH = 20;
705 const int FP_OFFSET_IN_FRAME = 1;
706 const int CLOSURE_OFFSET_IN_FRAME = 2;
707
708 const Object sport = Object::makeStringOutputPort();
709 TextualOutputPort* port = sport.toTextualOutputPort();
710 Object* fp = fp_;
711 Object* cl = &cl_;
712 for (int i = 1;;) {
713 if (cl->isClosure()) {
714 Object src = cl->toClosure()->sourceInfo;
715 if (src.isPair()) {
716 port->format(this, UC(" ~d. "), L1(Object::makeFixnum(i)));
717 const Object procedure = src.cdr();
718 const Object location = src.car();
719 if (location.isFalse()) {
720 port->format(this, UC("~a: <unknown location>\n"), L1(unGenSyms(procedure)));
721 } else {
722 const Object lineno = location.cdr().car();
723 const Object file = location.car();
724 const Object procedureName = procedure.car();
725
726 // anonymous procedure
727 if (procedure.car() == Symbol::intern(UC("lambda"))) {
728 // format source information to follwing style
729 // (lambda (arg1 arg2 arg3) ...)
730 Object args = unGenSyms(procedure.cdr());
731 const Object procedureSource = Pair::list3(procedureName, args, Symbol::intern(UC("...")));
732 port->format(this, UC("~a: ~a:~a\n"), L3(procedureSource, file, lineno));
733 } else {
734 port->format(this, UC("~a: ~a:~a\n"), L3(unGenSyms(procedure), file, lineno));
735 }
736 }
737 i++;
738 }
739 } else if (cl->isCProcedure()) {
740 port->format(this, UC(" ~d. "), L1(Object::makeFixnum(i)));
741 port->format(this, UC("~a: <subr>\n"), L1(getClosureName(*cl)));
742 i++;
743 } else if (cl->isRegMatch()) {
744 port->format(this, UC(" ~d. "), L1(Object::makeFixnum(i)));
745 port->format(this, UC("<reg-match>: ~a\n"), L1(*cl));
746 i++;
747 } else if (cl->isRegexp()) {
748 port->format(this, UC(" ~d. "), L1(Object::makeFixnum(i)));
749 port->format(this, UC("<regexp>: ~a\n"), L1(*cl));
750 i++;
751 } else {
752 MOSH_ASSERT(false);
753 }
754 if (i > MAX_DEPTH) {
755 port->display(this, UC(" ... (more stack dump truncated)\n"));
756 break;
757 }
758
759 VM_ASSERT(!(*cl).isObjectPointer());
760 VM_ASSERT((*cl).isClosure() || (*cl).isCProcedure() );
761 if (fp > stack_) {
762 cl = fp - CLOSURE_OFFSET_IN_FRAME;
763
764 // N.B. We must check whether cl is Object pointer or not.
765 // If so, we can't touch them. (touching may cause crash)
766 if (mayBeStackPointer(cl)) {
767 break;
768 }
769 if (!((*cl).isClosure()) && !((*cl).isCProcedure())) {
770 break;
771 }
772 // next fp is Object pointer, so 4byte aligned.
773 // if it is not Object pointer, may be tail call
774 Object* nextFp = fp - FP_OFFSET_IN_FRAME;
775 if (!(nextFp->isRawPointer())) {
776 break;
777 }
778
779 if (!mayBeStackPointer(nextFp)) {
780 // getOutputPort().toTextualOutputPort()->format(UC("[[[[~a]]]]"), *nextFp);
781 break;
782 }
783
784 VM_ASSERT(nextFp->isObjectPointer());
785 fp = nextFp->toObjectPointer();
786 } else {
787 break;
788 }
789 }
790 return getOutputStringEx(this, 1, &sport);
791 #endif
792 }
793
mayBeStackPointer(Object * obj) const794 bool VM::mayBeStackPointer(Object* obj) const
795 {
796 #ifdef DEBUG_VERSION
797 // not heap object
798 if (!obj->isHeapObject()) {
799 return false;
800 }
801 Object* const p = reinterpret_cast<Object*>(reinterpret_cast<HeapObject*>(obj->val)->obj);
802 return p >= stack_ && p <= stackEnd_;
803 #else
804 Object* const p = reinterpret_cast<Object*>(obj->val);
805 return p >= stack_ && p <= stackEnd_;
806 #endif
807 }
808
throwException(Object exception)809 void VM::throwException(Object exception)
810 {
811 #ifdef DEBUG_VERSION
812 VM_LOG1("error~a\n", exception);
813 fflush(stderr);
814 fflush(stdout);
815 #endif
816 const Object stackTrace = getStackTrace();
817 const Object stringOutputPort = Object::makeStringOutputPort();
818 TextualOutputPort* const textualOutputPort = stringOutputPort.toTextualOutputPort();
819 textualOutputPort->format(this, UC("~a\n Stack trace:\n~a\n"), Pair::list2(exception, stackTrace));
820 errorObj_ = getOutputStringEx(this, 1, &stringOutputPort);
821
822 longjmp(returnPoint_, -1);
823 }
824
showStack(int count,const char * file,int line)825 void VM::showStack(int count, const char* file, int line)
826 {
827 printf("** STACK %s:%d\n", file, line);fflush(stdout);
828 #ifdef DEBUG_VERSION
829 for (int i = count - 1; i >= 0; i--) {
830 VM_LOG2("============================================\n~d: ~a\n", Object::makeFixnum(i), index(sp_, i));
831 }
832 #else
833 callAssertionViolationImmidiaImmediately(this, "vm", "don't use showStack");
834 #endif
835 }
836
isR6RSMode() const837 bool VM::isR6RSMode() const
838 {
839 return isR6RSMode_;
840 }
841
activateR6RSMode(const uint8_t * image,unsigned int image_size,bool isDebugExpand)842 Object VM::activateR6RSMode(const uint8_t* image, unsigned int image_size, bool isDebugExpand)
843 {
844 isR6RSMode_ = true;
845 setValueString(UC("debug-expand"), Object::makeBool(isDebugExpand));
846 const Object code = FASL_GET_WITH_SIZE(image, image_size);
847 TRY_VM {
848 Vector* v = code.toVector();
849 return evaluateSafe(v->data(), v->length());
850 CATCH_VM
851 // call default error handler
852 defaultExceptionHandler(errorObj_);
853 this->exit(-1);
854 return Object::Undef;
855 }
856 }
857
getGlobalValueOrFalse(Object id)858 Object VM::getGlobalValueOrFalse(Object id)
859 {
860 const Object val = nameSpace_.toEqHashTable()->ref(id, notFound_);
861 if (val != notFound_) {
862 return val.toGloc()->value();
863 } else {
864 return Object::False;
865 }
866 }
867
getGlobalValueOrFalse(const ucs4char * id)868 Object VM::getGlobalValueOrFalse(const ucs4char* id)
869 {
870 return getGlobalValueOrFalse(Symbol::intern(id));
871 }
872
currentOutputPort() const873 Object VM::currentOutputPort() const
874 {
875 return currentOutputPort_;
876 }
877
currentErrorPort() const878 Object VM::currentErrorPort() const
879 {
880 return currentErrorPort_;
881 }
882
currentInputPort() const883 Object VM::currentInputPort() const
884 {
885 return currentInputPort_;
886 }
887
setCurrentInputPort(Object port)888 void VM::setCurrentInputPort(Object port)
889 {
890 currentInputPort_ = port;
891 }
892
setCurrentOutputPort(Object port)893 void VM::setCurrentOutputPort(Object port)
894 {
895 currentOutputPort_ = port;
896 }
897
expandStack(int plusSize)898 void VM::expandStack(int plusSize)
899 {
900
901 const int nextStackSize = stackSize_ + plusSize;
902 const int WARN_STACK_SIZE_IN_MB = 48;
903 if (nextStackSize * sizeof(intptr_t) > WARN_STACK_SIZE_IN_MB * 1024 * 1024) {
904 fprintf(stderr, "Warning: Stack is growing to %ld MB\n", nextStackSize * sizeof(intptr_t) / 1024 / 1024);
905 }
906
907 Object* nextStack = Object::makeObjectArrayLocal(nextStackSize);
908 if (NULL == nextStack) {
909 // todo
910 // handle stack overflow with guard
911 callAssertionViolationImmidiaImmediately(this, "#<closure>", "stack overflow", L1(Object::makeFixnum(sp_ - stack_)));
912 }
913 memcpy(nextStack, stack_, sizeof(Object) * stackSize_);
914 fp_ = nextStack + (fp_ - stack_);
915 sp_ = nextStack + (sp_ - stack_);
916 stackEnd_ = nextStack + nextStackSize;
917 stack_ = nextStack;
918 stackSize_ = nextStackSize;
919 }
920
printStack() const921 void VM::printStack() const
922 {
923 VM_LOG2("==========dc=~a prev=~a \n", dc_, dc_.toClosure()->prev);
924 for (int i = 1; i>= 0; i--) {
925 if (fp_ + i >= stackEnd_) {
926 break;
927 }
928 const Object obj = referLocal(i);
929
930 if (!obj.isObjectPointer()) {
931 VM_LOG2("~d: ~a\n", Object::makeFixnum(i), obj);
932 }
933 fflush(stderr);
934 }
935 }
936
values(int num,const Object * v)937 Object VM::values(int num, const Object* v)
938 {
939 if (0 == num) {
940 numValues_ = 0;
941 return Object::Undef;
942 }
943 for (int i = 1; i < num; i++) {
944 if (i >= maxNumValues_) {
945 callAssertionViolationAfter(this, "values", "too many values", Pair::list1(Object::makeFixnum(i)));
946 return Object::Undef;
947 }
948 values_[i - 1] = v[i];
949 }
950 numValues_ = num;
951 return v[0]; // set to ac_ later.
952 }
953
values2(Object obj1,Object obj2)954 Object VM::values2(Object obj1, Object obj2)
955 {
956 values_[0] = obj2;
957 numValues_ = 2;
958 return obj1; // set to ac_ later.
959 }
960
values3(Object obj1,Object obj2,Object obj3)961 Object VM::values3(Object obj1, Object obj2, Object obj3)
962 {
963 values_[0] = obj2;
964 values_[1] = obj3;
965 numValues_ = 3;
966 return obj1; // set to ac_ later.
967 }
968
values6(Object obj1,Object obj2,Object obj3,Object obj4,Object obj5,Object obj6)969 Object VM::values6(Object obj1, Object obj2, Object obj3, Object obj4, Object obj5, Object obj6)
970 {
971 values_[0] = obj2;
972 values_[1] = obj3;
973 values_[2] = obj4;
974 values_[3] = obj5;
975 values_[4] = obj6;
976 numValues_ = 6;
977 return obj1; // set to ac_ later.
978 }
979
980
getCProcedureName(Object proc) const981 Object VM::getCProcedureName(Object proc) const
982 {
983 for (int k = 0; k < cProcNum; k++) {
984 if (proc == cProcs_[k]) {
985 return Symbol::intern(cProcNames[k]);
986 }
987 }
988 return Symbol::intern(UC("<unknwon subr>"));
989 }
990
registerPort(Object obj)991 void VM::registerPort(Object obj)
992 {
993 MOSH_ASSERT(obj.isOutputPort());
994 activePorts_.push_back(obj);
995 }
996
unregisterPort(Object obj)997 void VM::unregisterPort(Object obj)
998 {
999 MOSH_ASSERT(obj.isOutputPort());
1000 Ports::iterator it = activePorts_.begin();
1001 while (it != activePorts_.end()) {
1002 if (obj.eq(*it)) {
1003 activePorts_.erase(it);
1004 return;
1005 }
1006 it++;
1007 }
1008 }
1009
flushAllPorts()1010 void VM::flushAllPorts()
1011 {
1012 Ports::iterator it = activePorts_.begin();
1013 while (it != activePorts_.end()) {
1014 const Object outputPort = *it;
1015 if (outputPort.isBinaryOutputPort()) {
1016 outputPort.toBinaryOutputPort()->flush();
1017 } else if (outputPort.isBinaryInputOutputPort()) {
1018 outputPort.toBinaryInputOutputPort()->flush();
1019 } else if (outputPort.isTextualOutputPort()) {
1020 outputPort.toTextualOutputPort()->flush();
1021 } else if (outputPort.isTextualInputOutputPort()) {
1022 outputPort.toTextualInputOutputPort()->flush();
1023 } else {
1024 MOSH_ASSERT(false);
1025 }
1026 it = activePorts_.erase(it);
1027 }
1028 }
1029
setThread(Thread * thread)1030 void VM::setThread(Thread* thread)
1031 {
1032 thread_ = thread;
1033 }
1034
thread()1035 Thread* VM::thread()
1036 {
1037 return thread_;
1038 }
1039
copyOptions(VM * destVM,VM * srcVM)1040 void VM::copyOptions(VM* destVM, VM* srcVM)
1041 {
1042 const ucs4char* options[] = {
1043 // mosh options
1044 UC("%loadpath"), UC("%verbose"), UC("*command-line-args*"),
1045
1046 // nmosh options
1047 UC("%nmosh-portable-mode"), UC("%nmosh-prefixless-mode")
1048 };
1049 for (size_t i = 0; i < sizeof(options) / sizeof(ucs4char*); i ++) {
1050 destVM->setValueString(options[i], srcVM->getGlobalValueOrFalse(options[i]));
1051 }
1052 }
1053