├── .gitignore ├── CODEGEN_NOTES.md ├── Makefile ├── README.md ├── asmentry.s ├── codegen2.cpp ├── codegen2.hpp ├── dict.hpp ├── gc.cpp ├── gc.hpp ├── main.cpp ├── object.cpp ├── object.hpp ├── parser.cpp ├── parser.hpp ├── runtime.cpp ├── runtime.hpp ├── scheme-src ├── alloc-perf.ss ├── begin.ss ├── bug │ └── 1.ss ├── define.ss ├── fibo-call-proc.ss ├── fibo.ss ├── funcall.ss ├── if.ss ├── lib │ ├── bug.ss │ ├── integer.ss │ └── lists.ss ├── loopsum.ss ├── myif.ss ├── neg-prim-sub.ss ├── prim-add.ss ├── prim-car.ss ├── prim-cons.ss ├── prim-display.ss ├── prim-error-inner.ss ├── prim-error.ss ├── prim-intp.ss ├── prim-lt.ss ├── prim-nullp.ss ├── prim-pairp.ss ├── prim-sub.ss ├── prim-trace.ss ├── quote.ss ├── recur-bug.ss ├── return-one.ss ├── sete.ss ├── test-framedescr.ss ├── test-gc-loop.ss ├── test-gc.ss └── test-parse.ss ├── test-gc.cpp ├── util.cpp └── util.hpp /.gitignore: -------------------------------------------------------------------------------- 1 | *.o 2 | main 3 | .*.swp 4 | test-gc 5 | -------------------------------------------------------------------------------- /CODEGEN_NOTES.md: -------------------------------------------------------------------------------- 1 | S2S (Scheme to scheme) calling convention 2 | ----------------------------------------- 3 | 4 | ### Stack after call instr 5 | [...] 6 | retAddr <- %rsp 7 | r10 = frameDescr 8 | rdi = thisClosure 9 | rsi = arg0 10 | rdx = arg1 11 | rcx = arg2 12 | 13 | ### prologue 14 | push r10 15 | push rdi 16 | push rsi 17 | push rdx 18 | push rcx 19 | 20 | ### (define a val) 21 | [code for val] 22 | 23 | ### (func a1 a2 a3) 24 | [code for func] 25 | pop %rdi 26 | [code for a1] 27 | pop %rsi 28 | [code for a2] 29 | pop %rdx 30 | [code for a3] 31 | pop %rcx 32 | mov frameDescr, %r10 33 | [test and extract codeptr to %rax] 34 | call %rax 35 | push %rax 36 | 37 | ### return x (frameSize = args + locals + thisClosure + frameDescr) 38 | [code for x] 39 | pop %rax 40 | add $8 * frameSize, %rsp 41 | ret 42 | 43 | ### tailcall (func a1 a2 a3) 44 | [code for func] 45 | pop %rdi 46 | [code for a1] 47 | pop %rsi 48 | [code for a2] 49 | pop %rdx 50 | [code for a3] 51 | pop %rcx 52 | add $8, frameSize 53 | [test and extract codeptr to %rax] 54 | jmp %rax 55 | 56 | ### Runtime GC call 57 | mov allocSize, %rdi 58 | mov %rsp, %rsi 59 | mov frameDescr, %rdx 60 | mov threadState, %rcx 61 | call collectAndAlloc 62 | 63 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | CXXFLAGS += $(INCLUDE) -std=c++0x -Wno-pmf-conversions -O0 -g -Wall 2 | #CXXFLAGS += -D kSanyaGCDebug 3 | 4 | LDFLAGS += -lasmjit -L/usr/local/lib -g 5 | 6 | INCLUDE += -I "/home/overmind/ref/binutil/asmjit-read-only/asmjit/src" 7 | 8 | OBJECTS = main.o parser.o object.o runtime.o gc.o util.o codegen2.o asmentry.o 9 | 10 | HEADERS = object.hpp parser.hpp runtime.hpp util.hpp gc.hpp codegen2.hpp 11 | 12 | main : $(OBJECTS) 13 | $(CXX) $^ -o $@ $(LDFLAGS) 14 | 15 | test-gc : test-gc.o gc.o object.o util.o codegen2.o 16 | $(CXX) $^ -o $@ $(LDFLAGS) 17 | 18 | %.o : %.cpp $(HEADERS) 19 | $(CXX) -c $< -o $@ $(CXXFLAGS) 20 | 21 | clean : 22 | rm -f main $(OBJECTS) 23 | 24 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | ### What's this 2 | 3 | Yet another scheme compiler, written in C++. 4 | 5 | ### Dependency 6 | 7 | Requires a modified version of libasmjit. 8 | 9 | -------------------------------------------------------------------------------- /asmentry.s: -------------------------------------------------------------------------------- 1 | 2 | .globl Scheme_asmEntry 3 | # rdi: thisClosure, rsi: function ptr, rdx: heapPtr, rcx: heapLimit, 4 | # r8: threadstate 5 | Scheme_asmEntry: 6 | push %r12 7 | push %r13 8 | push %r14 9 | 10 | mov %rdx, %r12 # set Hp 11 | mov %rcx, %r13 # set HpLim 12 | mov %r8, %r14 # set ThreadState 13 | mov %rsp, 8(%r14) # set SpBase 14 | 15 | call *%rsi 16 | 17 | pop %r14 18 | pop %r13 19 | pop %r12 20 | ret 21 | -------------------------------------------------------------------------------- /codegen2.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | #include "codegen2.hpp" 4 | #include "runtime.hpp" 5 | 6 | #define KB 1024 7 | #define MB (KB * KB) 8 | 9 | using namespace AsmJit; 10 | 11 | static const int kPtrSize = sizeof(void *); 12 | static const GpReg kArgRegs[5] = { rsi, rdx, rcx, r8, r9 }; 13 | static const GpReg kArgRegsWithClosure[6] = { rdi, rsi, rdx, rcx, r8, r9 }; 14 | static const auto kClosureReg = rdi, 15 | kFrameDescrReg = r10, 16 | kHeapPtr = r12, 17 | kHeapLimit = r13, 18 | kThreadState = r14; 19 | 20 | Module::Module() { 21 | root = Object::newVector(2, Object::newNil()); 22 | Handle hAssoc = Util::newAssocList(); 23 | assoc() = hAssoc; 24 | 25 | Handle hArr = Util::newGrowableArray(); 26 | array() = hArr; 27 | } 28 | 29 | Object *&Module::assoc() { 30 | return root->raw()->vectorAt(0); 31 | } 32 | 33 | Object *&Module::array() { 34 | return root->raw()->vectorAt(1); 35 | } 36 | 37 | intptr_t Module::addName(const Handle &name, const Handle &val) { 38 | Handle hAssoc = assoc(); 39 | bool ok; 40 | Handle maybeIndex = Util::assocLookup(hAssoc, name, Util::kPtrEq, &ok); 41 | if (ok) { 42 | intptr_t ix = maybeIndex->fromFixnum(); 43 | Util::arrayAt(array(), ix) = val; 44 | return ix; 45 | } 46 | else { 47 | intptr_t ix = Util::arrayLength(array()); 48 | Util::arrayAppend(array(), val); 49 | Handle newAssoc = Util::assocInsert( 50 | hAssoc, name, Object::newFixnum(ix), Util::kPtrEq); 51 | assoc() = newAssoc; 52 | return ix; 53 | } 54 | } 55 | 56 | intptr_t Module::lookupName(const Handle &name) { 57 | bool ok; 58 | Handle maybeIndex = Util::assocLookup(assoc(), name, Util::kPtrEq, &ok); 59 | if (ok) { 60 | return maybeIndex->fromFixnum(); 61 | } 62 | else { 63 | return -1; 64 | } 65 | } 66 | 67 | Object *Module::getRoot() { 68 | Handle trimmedVec = Util::arrayToVector(array()); 69 | Handle tmpRoot = Object::newVector(2, Object::newNil()); 70 | tmpRoot->raw()->vectorAt(0) = assoc(); 71 | tmpRoot->raw()->vectorAt(1) = trimmedVec; 72 | return tmpRoot; 73 | } 74 | 75 | template 76 | static void forEachListItem(const Handle &kxs, F f) { 77 | intptr_t i = 0; 78 | Handle xs = kxs; 79 | 80 | while (xs->isPair()) { 81 | if (f(xs->raw()->car(), i++, xs->raw()->cdr())) { 82 | xs = xs->raw()->cdr(); 83 | } 84 | else { 85 | break; 86 | } 87 | } 88 | } 89 | 90 | static Object *listToArray(const Handle &xs, Handle *out) { 91 | Handle restOut; 92 | forEachListItem(xs, 93 | [&](const Handle &x, intptr_t _, const Handle &rest) -> bool { 94 | 95 | Util::arrayAppend(*out, x); 96 | restOut = rest; 97 | return true; 98 | }); 99 | return restOut; 100 | } 101 | 102 | CGModule::CGModule() { 103 | symDefine = Object::internSymbol("define"); 104 | symSete = Object::internSymbol("set!"); 105 | symLambda = Object::internSymbol("lambda"); 106 | symQuote = Object::internSymbol("quote"); 107 | symBegin = Object::internSymbol("begin"); 108 | symIf = Object::internSymbol("if"); 109 | symPrimAdd = Object::internSymbol("+#"); 110 | symPrimSub = Object::internSymbol("-#"); 111 | symPrimLt = Object::internSymbol("<#"); 112 | symPrimCons = Object::internSymbol("cons#"); 113 | symPrimTrace = Object::internSymbol("trace#"); 114 | symPrimDisplay = Object::internSymbol("display#"); 115 | symPrimNewLine = Object::internSymbol("newline#"); 116 | symPrimError = Object::internSymbol("error#"); 117 | symMain = Object::internSymbol("main"); 118 | 119 | #define DEF_SYM(scmName, cxxName) \ 120 | symPrim ## cxxName ## p = Object::internSymbol(#scmName "#"); 121 | PRIM_TAG_PREDICATES(DEF_SYM) 122 | PRIM_SINGLETON_PREDICATES(DEF_SYM) 123 | #undef DEF_SYM 124 | 125 | #define DEF_SYM(scmName, _unused, attrName) \ 126 | symPrim ## attrName = Object::internSymbol(#scmName "#"); 127 | PRIM_ATTR_ACCESSORS(DEF_SYM) 128 | #undef DEF_SYM 129 | } 130 | 131 | CGModule::~CGModule() { 132 | for (auto f : cgfuncs) { 133 | delete f; 134 | } 135 | } 136 | 137 | Object *CGModule::genModule(const Handle &top) { 138 | Handle mainClo; 139 | 140 | assert(top->isPair()); 141 | forEachListItem( 142 | top, [&](const Handle &defn, intptr_t _u, Object *_u2) -> bool { 143 | 144 | Handle items = Util::newGrowableArray(); 145 | Handle rest = listToArray(defn, &items); 146 | assert(Util::arrayLength(items) == 3); 147 | assert(rest->isNil()); 148 | 149 | assert(Util::arrayAt(items, 0) == symDefine); 150 | assert(Util::arrayAt(items, 1)->isSymbol()); 151 | assert(Util::arrayAt(items, 2)->isPair()); 152 | 153 | Handle name = Util::arrayAt(items, 1); 154 | Handle lamExpr = Util::newGrowableArray(); 155 | rest = listToArray(Util::arrayAt(items, 2), &lamExpr); 156 | assert(Util::arrayLength(lamExpr) >= 3); 157 | assert(Util::arrayAt(lamExpr, 0) == symLambda); 158 | assert(Util::arrayAt(lamExpr, 1)->isList()); 159 | 160 | CGFunction *cgf = new CGFunction(name, lamExpr, this); 161 | // Provides an indirection for other code to refer 162 | module.addName(name, cgf->makeClosure()); 163 | if (name == symMain) { 164 | mainClo = cgf->closure; 165 | } 166 | cgfuncs.push_back(cgf); 167 | 168 | return true; 169 | }); 170 | 171 | assert(mainClo.getPtr() && "main not defined"); 172 | 173 | moduleRoot = module.getRoot(); 174 | moduleGlobalVector = moduleRoot->raw()->vectorAt(1); 175 | 176 | for (auto cgf : cgfuncs) { 177 | // Do the actual compilation 178 | cgf->compileFunction(); 179 | } 180 | 181 | return mainClo; 182 | } 183 | 184 | intptr_t CGModule::lookupGlobal(const Handle &name) { 185 | assert(moduleRoot); 186 | return module.lookupName(name); 187 | } 188 | 189 | // Short-hand 190 | #define __ xasm. 191 | 192 | CGFunction::CGFunction(const Handle &name, const Handle &lamBody, 193 | CGModule *parent) 194 | : frameSize(0) 195 | , name(name) 196 | , lamBody(lamBody) 197 | , parent(parent) 198 | , locals(Util::newAssocList()) 199 | , stackItemList(Object::newNil()) 200 | , ptrOffsets(Util::newGrowableArray()) 201 | , relocArray(Util::newGrowableArray()) 202 | { } 203 | 204 | const Handle &CGFunction::makeClosure() { 205 | assert(!closure.getPtr()); 206 | closure = Object::newClosure(NULL); 207 | //dprintf(2, "[mkClosure] %s => %p\n", name->rawSymbol(), closure); 208 | return closure; 209 | } 210 | 211 | void CGFunction::emitFuncHeader() { 212 | // Keep in sync with object.hpp's function definition. 213 | __ emitQWord(0); 214 | __ emitQWord(0); 215 | __ emitQWord(0); 216 | __ emitQWord(0); 217 | } 218 | 219 | void CGFunction::compileFunction() { 220 | 221 | if (Option::global().kLogInfo) { 222 | Util::logObj("CompileFunction Start", name); 223 | } 224 | 225 | emitFuncHeader(); 226 | 227 | // push frameDescr 228 | pushReg(kFrameDescrReg, kIsNotPtr); 229 | 230 | // push thisClosure 231 | pushReg(kClosureReg, kIsPtr); 232 | 233 | Handle argArray = Util::newGrowableArray(); 234 | Handle restArgs = listToArray(Util::arrayAt(lamBody, 1), &argArray); 235 | intptr_t arity = Util::arrayLength(argArray); 236 | // To be able to pass by reg 237 | assert(arity <= 5); 238 | 239 | // Move args to stack 240 | for (intptr_t i = 0; i < arity; ++i) { 241 | Handle arg = Util::arrayAt(argArray, i); 242 | assert(arg->isSymbol()); 243 | assert(lookupLocal(arg) == -1); 244 | 245 | // +1 for closure reg 246 | pushReg(kArgRegs[i], kIsPtr); 247 | addNewLocal(arg); 248 | } 249 | 250 | // Check stack overflow 251 | auto labelStackOvf = __ newLabel(); 252 | FrameDescr fdAtPrologue = FrameDescr::unpack(makeFrameDescr()); 253 | if (Option::global().kInsertStackCheck) { 254 | // diff = ts.firstSp - currSp; 255 | // if (diff > 1MB) { 256 | // handleStackOvf(); 257 | // } 258 | __ lea(rax, qword_ptr(rsp, 1 * MB)); 259 | __ cmp(rax, qword_ptr(kThreadState, 260 | kPtrSize * ThreadState::kFirstStackPtrOffset)); 261 | __ jl(labelStackOvf); 262 | } 263 | 264 | // TCO can be runtime-specified 265 | compileBody(lamBody, 2, Option::global().kTailCallOpt); 266 | 267 | // Return last value on the stack 268 | popReg(rax); 269 | popFrame(); 270 | __ ret(); 271 | 272 | // Handles stack overflow 273 | if (Option::global().kInsertStackCheck) { 274 | __ bind(labelStackOvf); 275 | syncThreadState(&fdAtPrologue); 276 | __ mov(rdi, kThreadState); 277 | __ jmp((void *) Runtime::handleStackOvf); 278 | } 279 | 280 | // Used for debugging 281 | intptr_t codeSize = __ getCodeSize(); 282 | // Create function and patch closure. 283 | void *rawPtr = __ make(); 284 | 285 | Handle trimmedConstOffsets = Util::arrayToVector(ptrOffsets); 286 | 287 | rawFunc = Object::newFunction(rawPtr, arity, name, 288 | /* const ptr offset array */ trimmedConstOffsets, 289 | /* num payload */ 0); 290 | rawFunc->funcSize() = codeSize; 291 | closure->raw()->cloInfo() = rawFunc; 292 | 293 | // Patch relocs 294 | for (intptr_t i = 0, len = Util::arrayLength(relocArray); 295 | i < len; ++i) { 296 | intptr_t base = rawFunc->funcCodeAs(); 297 | Handle ptrVal = Util::arrayAt(relocArray, i); 298 | intptr_t offset = Util::arrayAt(ptrOffsets, i)->fromFixnum(); 299 | Object **addr = reinterpret_cast(base + offset); 300 | *addr = ptrVal; 301 | 302 | //dprintf(2, "[PatchCodeReloc] %s[%ld] ", name->rawSymbol(), offset); 303 | //ptrVal->displayDetail(2); 304 | //dprintf(2, "\n"); 305 | } 306 | 307 | if (Option::global().kLogInfo) { 308 | Util::logPtr("CompileFunction Done", rawFunc->funcCodeAs()); 309 | } 310 | } 311 | 312 | void CGFunction::compileBody(const Handle &body, intptr_t start, 313 | bool isTail) { 314 | intptr_t len = Util::arrayLength(body); 315 | for (intptr_t i = start; i < len; ++i) { 316 | Handle x = Util::arrayAt(body, i); 317 | if (i == len - 1) { 318 | compileExpr(x, isTail); 319 | } 320 | else { 321 | compileExpr(x, false); 322 | popSome(1); 323 | } 324 | } 325 | } 326 | 327 | void CGFunction::compileExpr(const Handle &expr, bool isTail) { 328 | intptr_t ix; 329 | 330 | switch (expr->getTag()) { 331 | case RawObject::kFixnumTag: 332 | pushObject(expr); 333 | break; 334 | 335 | case RawObject::kSymbolTag: 336 | { 337 | LookupResult varLoc; 338 | // Lookup first 339 | ix = lookupName(expr, &varLoc); 340 | if (varLoc == kIsLocal) { 341 | __ mov(rax, qword_ptr(rsp, ix * kPtrSize)); 342 | pushReg(rax, kIsPtr); 343 | } 344 | else if (varLoc == kIsGlobal) { 345 | __ mov(rax, 0L); 346 | // We add this pointer into our code later, 347 | // since copying gc cannot track into unfinished code. 348 | recordLastPtrOffset(); 349 | recordReloc(parent->moduleGlobalVector); 350 | 351 | __ mov(rax, qword_ptr(rax, 352 | RawObject::kVectorElemOffset - RawObject::kVectorTag + 353 | kPtrSize * ix)); 354 | pushReg(rax, kIsPtr); 355 | } 356 | else { 357 | dprintf(2, "lookupGlobal: %s not found\n", expr->rawSymbol()); 358 | exit(1); 359 | } 360 | break; 361 | } 362 | 363 | case RawObject::kPairTag: 364 | { 365 | Handle xs = Util::newGrowableArray(); 366 | assert(listToArray(expr, &xs)->isNil()); 367 | 368 | // Check for define 369 | if (tryIf(xs, isTail)) { 370 | } 371 | else if (tryDefine(xs)) { 372 | } 373 | else if (trySete(xs)) { 374 | } 375 | else if (tryBegin(xs, isTail)) { 376 | } 377 | else if (tryQuote(xs)) { 378 | } 379 | else if (tryPrimOp(xs, isTail)) { 380 | } 381 | else { 382 | // Should be funcall 383 | compileCall(xs, isTail); 384 | } 385 | break; 386 | } 387 | 388 | case RawObject::kSingletonTag: 389 | if (expr->isTrue() || expr->isFalse()) { 390 | pushObject(expr); 391 | } 392 | else if (expr->isNil()) { 393 | assert(0 && "Unexpected nil in code"); 394 | } 395 | else { 396 | assert(0 && "Unexpected singleton in code"); 397 | } 398 | break; 399 | 400 | default: 401 | assert(false); 402 | } 403 | } 404 | 405 | void CGFunction::compileCall(const Handle &xs, bool isTail) { 406 | intptr_t argc = Util::arrayLength(xs) - 1; 407 | assert(argc < 6); 408 | 409 | for (intptr_t i = 0; i < argc + 1; ++i) { 410 | // Evaluate func and args 411 | compileExpr(Util::arrayAt(xs, i), false); 412 | } 413 | 414 | for (intptr_t i = argc; i >= 0; --i) { 415 | // Reverse pop values to argument pos 416 | popReg(kArgRegsWithClosure[i]); 417 | } 418 | 419 | FrameDescr savedFd = FrameDescr::unpack(makeFrameDescr()); 420 | 421 | // Check closure type 422 | __ mov(rax, rdi); 423 | __ and_(eax, RawObject::kTagMask); 424 | __ cmp(eax, RawObject::kClosureTag); 425 | auto labelNotAClosure = __ newLabel(); 426 | __ jne(labelNotAClosure); 427 | 428 | // Check arg count 429 | __ mov(rax, qword_ptr(rdi, -RawObject::kClosureTag)); 430 | __ mov(rax, qword_ptr(rax, RawObject::kFuncArityOffset)); 431 | __ cmp(rax, argc); 432 | auto labelArgCountMismatch = __ newLabel(); 433 | __ jne(labelArgCountMismatch); 434 | 435 | // Extract and call the code pointer 436 | // XXX: how about stack overflow checking? 437 | __ mov(rax, qword_ptr(rdi, -RawObject::kClosureTag)); 438 | __ lea(rax, qword_ptr(rax, RawObject::kFuncCodeOffset)); 439 | 440 | auto labelOk = __ newLabel(); 441 | if (!isTail) { 442 | __ mov(kFrameDescrReg, makeFrameDescr()); 443 | 444 | // If doing normal call: 445 | __ call(rax); 446 | 447 | // After call 448 | pushReg(rax, kIsPtr); 449 | __ jmp(labelOk); 450 | } 451 | else { 452 | // Get caller's FD 453 | __ mov(kFrameDescrReg, qword_ptr(rsp, getFrameDescr())); 454 | 455 | popPhysicalFrame(); 456 | // Tail call 457 | __ jmp(rax); 458 | 459 | // To compensate for stack depth 460 | pushVirtual(kIsPtr); 461 | } 462 | 463 | // Not a closure(%rdi = func, rsi = threadstate) 464 | __ bind(labelNotAClosure); 465 | syncThreadState(&savedFd); 466 | __ mov(rsi, kThreadState); 467 | __ jmp(reinterpret_cast(&Runtime::handleNotAClosure)); 468 | 469 | // Wrong arg count(%rdi = func, %rsi = actual argc, rdx = threadstate) 470 | __ bind(labelArgCountMismatch); 471 | syncThreadState(&savedFd); 472 | __ mov(rsi, argc); 473 | __ mov(rdx, kThreadState); 474 | __ jmp(reinterpret_cast(&Runtime::handleArgCountMismatch)); 475 | 476 | if (!isTail) { 477 | __ bind(labelOk); 478 | } 479 | } 480 | 481 | intptr_t CGFunction::lookupName(const Handle &name, LookupResult *out) { 482 | intptr_t ix = lookupLocal(name); 483 | if (ix != -1) { 484 | *out = kIsLocal; 485 | return ix; 486 | } 487 | 488 | ix = parent->lookupGlobal(name); 489 | if (ix != -1) { 490 | *out = kIsGlobal; 491 | return ix; 492 | } 493 | 494 | *out = kNotFound; 495 | return -1; 496 | } 497 | 498 | bool CGFunction::tryDefine(const Handle &xs) { 499 | intptr_t len = Util::arrayLength(xs); 500 | if (len != 3 || Util::arrayAt(xs, 0) != parent->symDefine) { 501 | return false; 502 | } 503 | 504 | assert(Util::arrayAt(xs, 1)->isSymbol()); 505 | compileExpr(Util::arrayAt(xs, 2)); 506 | // XXX: handle duplicate define? 507 | addNewLocal(Util::arrayAt(xs, 1)); 508 | pushObject(Object::newVoid()); 509 | return true; 510 | } 511 | 512 | bool CGFunction::trySete(const Handle &xs) { 513 | intptr_t len = Util::arrayLength(xs); 514 | if (len != 3 || Util::arrayAt(xs, 0) != parent->symSete) { 515 | return false; 516 | } 517 | Handle varName = Util::arrayAt(xs, 1); 518 | assert(varName->isSymbol()); 519 | 520 | // Eval and pop to rax 521 | compileExpr(Util::arrayAt(xs, 2)); 522 | popReg(rax); 523 | 524 | LookupResult loc; 525 | intptr_t ix = lookupName(varName, &loc); 526 | 527 | if (loc == kIsLocal) { 528 | __ mov(qword_ptr(rsp, ix * kPtrSize), rax); 529 | } 530 | else if (loc == kIsGlobal) { 531 | __ mov(rcx, 0L); 532 | // We add this pointer into our code later, 533 | // since copying gc cannot track into unfinished code. 534 | recordLastPtrOffset(); 535 | recordReloc(parent->moduleGlobalVector); 536 | 537 | // Write back. XXX: write barrier when using generational GC? 538 | __ mov(qword_ptr(rcx, RawObject::kVectorElemOffset - 539 | RawObject::kVectorTag + kPtrSize * ix), 540 | rax); 541 | } 542 | else { 543 | dprintf(2, "set!: variable not defined: "); 544 | varName->displayDetail(2); 545 | dprintf(2, "\n"); 546 | exit(1); 547 | } 548 | pushObject(Object::newVoid()); 549 | return true; 550 | } 551 | 552 | 553 | bool CGFunction::tryIf(const Handle &xs, bool isTail) { 554 | intptr_t len = Util::arrayLength(xs); 555 | if (len != 4 || Util::arrayAt(xs, 0) != parent->symIf) { 556 | return false; 557 | } 558 | 559 | Label labelFalse = __ newLabel(), 560 | labelDone = __ newLabel(); 561 | 562 | // Pred 563 | compileExpr(Util::arrayAt(xs, 1)); 564 | popReg(rax); 565 | 566 | __ cmp(rax, Object::newFalse()->as()); 567 | __ je(labelFalse); 568 | 569 | compileExpr(Util::arrayAt(xs, 2), isTail); 570 | __ jmp(labelDone); 571 | // Since we need to balance out those two branches 572 | popVirtual(1); 573 | 574 | __ bind(labelFalse); 575 | compileExpr(Util::arrayAt(xs, 3), isTail); 576 | 577 | __ bind(labelDone); 578 | 579 | return true; 580 | } 581 | 582 | bool CGFunction::tryQuote(const Handle &expr) { 583 | if (Util::arrayLength(expr) != 2 || 584 | Util::arrayAt(expr, 0) != parent->symQuote) { 585 | return false; 586 | } 587 | pushObject(Util::arrayAt(expr, 1)); 588 | return true; 589 | } 590 | 591 | bool CGFunction::tryBegin(const Handle &expr, bool isTail) { 592 | if (Util::arrayAt(expr, 0) != parent->symBegin) { 593 | return false; 594 | } 595 | compileBody(expr, 1, isTail); 596 | return true; 597 | } 598 | 599 | bool CGFunction::tryPrimOp(const Handle &xs, bool isTail) { 600 | intptr_t len = Util::arrayLength(xs); 601 | if (len < 1) { 602 | return false; 603 | } 604 | 605 | const Handle opName = Util::arrayAt(xs, 0); 606 | 607 | //dprintf(2, "opName = %s, size = %ld\n", opName.c_str(), xs.size()); 608 | 609 | if (opName == parent->symPrimAdd && len == 3) { 610 | compileExpr(Util::arrayAt(xs, 1)); 611 | compileExpr(Util::arrayAt(xs, 2)); 612 | popReg(rax); 613 | __ add(rax, qword_ptr(rsp)); 614 | __ sub(rax, RawObject::kFixnumTag); 615 | __ mov(qword_ptr(rsp), rax); 616 | } 617 | else if (opName == parent->symPrimSub && len == 3) { 618 | compileExpr(Util::arrayAt(xs, 1)); 619 | compileExpr(Util::arrayAt(xs, 2)); 620 | __ mov(rax, qword_ptr(rsp, kPtrSize)); 621 | __ sub(rax, qword_ptr(rsp)); 622 | __ add(rax, RawObject::kFixnumTag); 623 | popSome(1); 624 | __ mov(qword_ptr(rsp), rax); 625 | } 626 | else if (opName == parent->symPrimLt && len == 3) { 627 | compileExpr(Util::arrayAt(xs, 1)); 628 | compileExpr(Util::arrayAt(xs, 2)); 629 | popReg(rax); 630 | __ cmp(rax, qword_ptr(rsp)); 631 | __ mov(ecx, Object::newTrue()->as()); 632 | __ mov(eax, Object::newFalse()->as()); 633 | __ cmovg(rax, rcx); 634 | __ mov(qword_ptr(rsp), rax); 635 | } 636 | else if (opName == parent->symPrimCons && len == 3) { 637 | // (cons# 1 2) 638 | compileExpr(Util::arrayAt(xs, 1)); 639 | compileExpr(Util::arrayAt(xs, 2)); 640 | 641 | allocPair(); 642 | } 643 | 644 | #define MK_IMPL(_unused, klsName, attrName) \ 645 | else if (opName == parent->symPrim ## attrName && len == 2) { \ 646 | compileExpr(Util::arrayAt(xs, 1)); \ 647 | popReg(rax); \ 648 | __ mov(rax, qword_ptr(rax, \ 649 | RawObject::k ## attrName ## Offset - \ 650 | RawObject::k ## klsName ## Tag)); \ 651 | pushReg(rax, kIsPtr); \ 652 | } 653 | PRIM_ATTR_ACCESSORS(MK_IMPL) 654 | #undef MK_IMPL 655 | 656 | #define MK_IMPL(_unused, typeName) \ 657 | else if (opName == parent->symPrim ## typeName ## p && len == 2) { \ 658 | compileExpr(Util::arrayAt(xs, 1)); \ 659 | popReg(rax); \ 660 | __ and_(eax, RawObject::kTagMask); \ 661 | __ cmp(eax, RawObject::k ## typeName ## Tag); \ 662 | __ mov(ecx, Object::newTrue()->as()); \ 663 | __ mov(eax, Object::newFalse()->as()); \ 664 | __ cmove(eax, ecx); \ 665 | pushReg(rax, kIsPtr); \ 666 | } 667 | PRIM_TAG_PREDICATES(MK_IMPL) 668 | #undef MK_IMPL 669 | 670 | #define MK_IMPL(_unused, objName) \ 671 | else if (opName == parent->symPrim ## objName ## p && len == 2) { \ 672 | compileExpr(Util::arrayAt(xs, 1)); \ 673 | popReg(rax); \ 674 | __ mov(ecx, reinterpret_cast(Object::new ## objName())); \ 675 | __ cmp(rax, rcx); \ 676 | __ mov(ecx, Object::newTrue()->as()); \ 677 | __ mov(eax, Object::newFalse()->as()); \ 678 | __ cmove(eax, ecx); \ 679 | pushReg(rax, kIsPtr); \ 680 | } 681 | PRIM_SINGLETON_PREDICATES(MK_IMPL) 682 | #undef MK_IMPL 683 | 684 | else if (opName == parent->symPrimTrace && len == 3) { 685 | compileExpr(Util::arrayAt(xs, 1)); 686 | popReg(rdi); 687 | __ call(reinterpret_cast(&Runtime::traceObject)); 688 | compileExpr(Util::arrayAt(xs, 2), isTail); 689 | } 690 | else if (opName == parent->symPrimDisplay && len == 2) { 691 | compileExpr(Util::arrayAt(xs, 1)); 692 | // Stdout 693 | popReg(rdi); 694 | __ mov(esi, 1); 695 | __ call(reinterpret_cast((void *) &Object::displayDetail)); 696 | pushObject(Object::newVoid()); 697 | } 698 | else if (opName == parent->symPrimNewLine && len == 1) { 699 | __ mov(edi, 1); 700 | __ call(reinterpret_cast((void *) &Runtime::printNewLine)); 701 | pushObject(Object::newVoid()); 702 | } 703 | else if (opName == parent->symPrimError && len == 2) { 704 | // (error# anything) 705 | compileExpr(Util::arrayAt(xs, 1)); 706 | 707 | popReg(rdi); 708 | syncThreadState(); 709 | __ mov(rsi, kThreadState); 710 | __ jmp((intptr_t) &Runtime::handleUserError); 711 | 712 | // To keep stack balence 713 | pushVirtual(kIsPtr); 714 | } 715 | else { 716 | return false; 717 | } 718 | 719 | return true; 720 | } 721 | 722 | void CGFunction::allocPair() { 723 | size_t hSize = sizeof(GcHeader); 724 | size_t rawAllocSize = RawObject::kSizeOfPair + hSize; 725 | assert(Util::isAligned<4>(rawAllocSize)); 726 | assert(hSize == 0x10); 727 | 728 | auto labelAllocOk = __ newLabel(); 729 | 730 | #ifndef kSanyaGCDebug 731 | // Try alloc 732 | __ lea(rcx, qword_ptr(kHeapPtr, rawAllocSize)); 733 | __ cmp(rcx, kHeapLimit); 734 | __ jle(labelAllocOk); 735 | #endif 736 | 737 | // Alloc failed: Do GC 738 | syncThreadState(); 739 | __ mov(rax, rawAllocSize); 740 | __ mov(qword_ptr(kThreadState, 741 | kPtrSize * ThreadState::kLastAllocReqOffset), 742 | rax); 743 | 744 | __ mov(rdi, kThreadState); 745 | __ call(reinterpret_cast(&Runtime::collectAndAlloc)); 746 | // Extract new heapPtr and limitPtr 747 | __ mov(kHeapPtr, 748 | qword_ptr(kThreadState, kPtrSize * ThreadState::kHeapPtrOffset)); 749 | __ mov(kHeapLimit, 750 | qword_ptr(kThreadState, kPtrSize * ThreadState::kHeapLimitOffset)); 751 | // And retry 752 | __ lea(rcx, qword_ptr(kHeapPtr, rawAllocSize)); 753 | 754 | // Alloc ok: fill content 755 | __ bind(labelAllocOk); 756 | // Init gc header 757 | // Mark: 0 758 | __ mov(dword_ptr(kHeapPtr, 0), 0); 759 | // size: (precalculated) 760 | __ mov(dword_ptr(kHeapPtr, 4), rawAllocSize); 761 | 762 | // Put cdr 763 | popReg(rax); 764 | __ mov(qword_ptr(kHeapPtr, hSize + RawObject::kCdrOffset), rax); 765 | 766 | // Put car 767 | popReg(rax); 768 | __ mov(qword_ptr(kHeapPtr, hSize + RawObject::kCarOffset), rax); 769 | 770 | // GcHeader padding and tag 771 | __ add(kHeapPtr, hSize + RawObject::kPairTag); 772 | pushReg(kHeapPtr, kIsPtr); 773 | 774 | // Write new heapPtr back 775 | __ mov(kHeapPtr, rcx); 776 | } 777 | 778 | void CGFunction::shiftLocal(intptr_t n) { 779 | // XXX: loss of encapsulation 780 | forEachListItem(locals, 781 | [=](const Handle &x, intptr_t _u, Object *_u2) -> bool { 782 | x->raw()->cdr() = Object::newFixnum(x->raw()->cdr()->fromFixnum() + n); 783 | return true; 784 | }); 785 | } 786 | 787 | intptr_t CGFunction::getThisClosure() { 788 | return (frameSize - 2) * kPtrSize; 789 | } 790 | 791 | intptr_t CGFunction::getFrameDescr() { 792 | return (frameSize - 1) * kPtrSize; 793 | } 794 | 795 | void CGFunction::recordReloc(const Handle &e) { 796 | Util::arrayAppend(relocArray, e); 797 | } 798 | 799 | void CGFunction::recordLastPtrOffset() { 800 | intptr_t size = __ lastImmOffset().size, 801 | offset = __ lastImmOffset().offset; 802 | assert(size == 8); 803 | Util::arrayAppend(ptrOffsets, 804 | Object::newFixnum(offset - RawObject::kFuncCodeOffset)); 805 | } 806 | 807 | void CGFunction::pushObject(const Handle &x) { 808 | if (x->isHeapAllocated()) { 809 | // To be patched later. See @Invariant 810 | __ mov(rax, 0L); 811 | recordReloc(x); 812 | recordLastPtrOffset(); 813 | } 814 | else { 815 | __ mov(rax, x->as()); 816 | } 817 | __ push(rax); 818 | pushVirtual(kIsPtr); 819 | } 820 | 821 | void CGFunction::pushInt(intptr_t i) { 822 | __ mov(rax, i); 823 | __ push(rax); 824 | pushVirtual(kIsNotPtr); 825 | } 826 | 827 | void CGFunction::pushReg(const GpReg &r, IsPtr isPtr) { 828 | __ push(r); 829 | pushVirtual(isPtr); 830 | } 831 | 832 | void CGFunction::pushVirtual(IsPtr isPtr) { 833 | shiftLocal(1); 834 | stackItemList = Object::newPair(Object::newBool(isPtr == kIsPtr), 835 | stackItemList); 836 | ++frameSize; 837 | //dprintf(2, "[pushV] += 1, frameSize = %ld\n", frameSize); 838 | } 839 | 840 | void CGFunction::popSome(intptr_t n) { 841 | __ add(rsp, kPtrSize * n); 842 | popVirtual(n); 843 | } 844 | 845 | void CGFunction::popFrame() { 846 | popSome(frameSize); 847 | } 848 | 849 | void CGFunction::popPhysicalFrame() { 850 | __ add(rsp, kPtrSize * frameSize); 851 | } 852 | 853 | void CGFunction::popReg(const GpReg &r) { 854 | __ pop(r); 855 | popVirtual(1); 856 | } 857 | 858 | void CGFunction::popVirtual(intptr_t n) { 859 | shiftLocal(-n); 860 | for (intptr_t i = 0; i < n; ++i) { 861 | stackItemList = stackItemList->raw()->cdr(); 862 | } 863 | frameSize -= n; 864 | //dprintf(2, "[popV] -= %ld, frameSize = %ld\n", n, frameSize); 865 | } 866 | 867 | intptr_t CGFunction::makeFrameDescr() { 868 | FrameDescr fd; 869 | // Current max fd size. 870 | assert(frameSize <= 48); 871 | fd.frameSize = frameSize; 872 | Handle stackIter = stackItemList; 873 | for (intptr_t i = 0; i < frameSize; ++i) { 874 | assert(stackIter->isPair()); 875 | if (stackIter->raw()->car()->isTrue()) { 876 | //dprintf(2, "[mkFd %s] %ld is ptr\n", name->rawSymbol(), i); 877 | fd.setIsPtr(i); 878 | } 879 | else { 880 | //dprintf(2, "[mkFd %s] %ld is not ptr\n", name->rawSymbol(), i); 881 | assert(!fd.isPtr(i)); 882 | } 883 | stackIter = stackIter->raw()->cdr(); 884 | } 885 | //dprintf(2, "[mkFd %s] fd = %ld\n", name->rawSymbol(), fd.pack()); 886 | return fd.pack(); 887 | } 888 | 889 | void CGFunction::syncThreadState(FrameDescr *fdToUse) { 890 | // Store gc info 891 | __ mov( 892 | qword_ptr(kThreadState, kPtrSize * ThreadState::kHeapPtrOffset), 893 | kHeapPtr); 894 | __ mov( 895 | qword_ptr(kThreadState, kPtrSize * ThreadState::kHeapLimitOffset), 896 | kHeapLimit); 897 | 898 | // Store frame descr 899 | __ mov(rax, fdToUse ? fdToUse->pack() : makeFrameDescr()); 900 | __ mov( 901 | qword_ptr(kThreadState, 902 | kPtrSize * ThreadState::kLastFrameDescrOffset), 903 | rax); 904 | 905 | // And stack ptr 906 | __ mov( 907 | qword_ptr(kThreadState, 908 | kPtrSize * ThreadState::kLastStackPtrOffset), 909 | rsp); 910 | } 911 | 912 | -------------------------------------------------------------------------------- /codegen2.hpp: -------------------------------------------------------------------------------- 1 | #ifndef CODEGEN2_HPP 2 | #define CODEGEN2_HPP 3 | 4 | #include 5 | 6 | #include 7 | #include 8 | 9 | #include "gc.hpp" 10 | #include "object.hpp" 11 | #include "util.hpp" 12 | 13 | // Runtime representation of module, referenced by generated functions 14 | class Module { 15 | public: 16 | Module(); 17 | ~Module() { } 18 | 19 | intptr_t addName(const Handle &name, const Handle &val); 20 | intptr_t lookupName(const Handle &name); 21 | 22 | // Trim the array to a vector 23 | // (# ) 24 | Object *getRoot(); 25 | 26 | private: 27 | Object *&assoc(); 28 | Object *&array(); 29 | // (# index> 30 | // val>) 31 | Handle root; 32 | }; 33 | 34 | class CGFunction; 35 | 36 | #define PRIM_TAG_PREDICATES(V) \ 37 | V(pair?, Pair) \ 38 | V(symbol?, Symbol) \ 39 | V(integer?, Fixnum) \ 40 | V(procedure?, Closure) \ 41 | V(vector?, Vector) 42 | 43 | #define PRIM_SINGLETON_PREDICATES(V) \ 44 | V(true?, True) \ 45 | V(false?, False) \ 46 | V(null?, Nil) 47 | 48 | #define PRIM_ATTR_ACCESSORS(V) \ 49 | V(car, Pair, Car) \ 50 | V(cdr, Pair, Cdr) 51 | 52 | class CGModule { 53 | public: 54 | CGModule(); 55 | ~CGModule(); 56 | Object *genModule(const Handle &); 57 | 58 | protected: 59 | // Returns -1 when not found 60 | intptr_t lookupGlobal(const Handle &name); 61 | 62 | private: 63 | Module module; 64 | Handle moduleRoot, moduleGlobalVector; 65 | 66 | Handle symDefine, 67 | symSete, 68 | symLambda, 69 | symQuote, 70 | symBegin, 71 | symIf, 72 | 73 | symPrimAdd, 74 | symPrimSub, 75 | symPrimLt, 76 | 77 | symPrimCons, 78 | 79 | symPrimTrace, 80 | symPrimDisplay, 81 | symPrimNewLine, 82 | symPrimError, 83 | symMain; 84 | 85 | #define MK_SYM(_unused, typeName) \ 86 | Handle symPrim ## typeName ## p; 87 | PRIM_TAG_PREDICATES(MK_SYM) 88 | PRIM_SINGLETON_PREDICATES(MK_SYM) 89 | #undef MK_SYM 90 | 91 | #define MK_SYM(_unused, _unused2, attrName) \ 92 | Handle symPrim ## attrName; 93 | PRIM_ATTR_ACCESSORS(MK_SYM) 94 | #undef MK_SYM 95 | 96 | std::vector cgfuncs; 97 | 98 | friend class CGFunction; 99 | }; 100 | 101 | class CGFunction { 102 | protected: 103 | CGFunction(const Handle &name, const Handle &lamBody, CGModule *parent); 104 | 105 | const Handle &makeClosure(); 106 | 107 | // Put placeholders there 108 | void emitFuncHeader(); 109 | 110 | // Invariant: cannot GC during single function compilation, since some of 111 | // the generated pointers are inside the AsmJit's assembler buffer. 112 | // XXX: Fix it by utilizing reloc is fine, but it's kind of... 113 | void compileFunction(); 114 | void compileBody(const Handle &exprs, intptr_t start, bool isTail); 115 | void compileExpr(const Handle &expr, bool isTail = false); 116 | void compileCall(const Handle &xs, bool isTail); 117 | 118 | enum LookupResult { 119 | kIsLocal, 120 | kIsGlobal, 121 | kNotFound 122 | }; 123 | 124 | // Special case operators 125 | bool tryDefine(const Handle &expr); 126 | bool trySete(const Handle &expr); 127 | bool tryIf(const Handle &expr, bool isTail); 128 | bool tryQuote(const Handle &expr); 129 | bool tryBegin(const Handle &expr, bool isTail); 130 | bool tryPrimOp(const Handle &expr, bool isTail); 131 | 132 | // Stores regs back to ThreadState. Uses %rax only. 133 | void syncThreadState(FrameDescr *fdToUse = NULL); 134 | 135 | intptr_t getThisClosure(); 136 | intptr_t getFrameDescr(); 137 | 138 | void recordReloc(const Handle &e); 139 | void recordLastPtrOffset(); 140 | intptr_t makeFrameDescr(); 141 | 142 | // Alloc related 143 | 144 | // Assume car and cdr are pushed 145 | void allocPair(); 146 | 147 | // Also records virtual frame 148 | void pushObject(const Handle &); 149 | void pushInt(intptr_t); 150 | enum IsPtr { kIsNotPtr = 0, kIsPtr = 1 }; 151 | void pushReg(const AsmJit::GpReg &r, IsPtr isPtr); 152 | void pushVirtual(IsPtr isPtr); 153 | void popSome(intptr_t n = 1); 154 | void popVirtual(intptr_t); 155 | void popFrame(); 156 | // But don't pop virtual. Used by tailcall. 157 | void popPhysicalFrame(); 158 | void popReg(const AsmJit::GpReg &r); 159 | 160 | intptr_t lookupName(const Handle &name, LookupResult *); 161 | intptr_t lookupLocal(const Handle &name) { 162 | bool ok; 163 | Handle result = Util::assocLookup(locals, name, Util::kPtrEq, &ok); 164 | if (ok) { 165 | return result->fromFixnum(); 166 | } 167 | else { 168 | return -1; 169 | } 170 | } 171 | 172 | void addNewLocal(const Handle &name) { 173 | locals = Util::assocInsert( 174 | locals, name, Object::newFixnum(0), Util::kPtrEq); 175 | } 176 | 177 | void shiftLocal(intptr_t n); 178 | 179 | private: 180 | AsmJit::X86Assembler xasm; 181 | 182 | // Offset between current rsp and the stack slot for return address, 183 | // in ptrSize (8). 184 | intptr_t frameSize; 185 | 186 | Handle name, lamBody; 187 | CGModule *parent; 188 | 189 | RawObject *rawFunc; 190 | Handle closure; 191 | // Maps symbol to index 192 | Handle locals; 193 | 194 | // (# #t #f #t ...) vector of stack items. 195 | // True if is pointer 196 | Handle stackItemList; 197 | 198 | // Growable array of # 199 | Handle ptrOffsets; 200 | 201 | // Growable array of objects. Will be used to patch the generated 202 | // code. 203 | Handle relocArray; 204 | 205 | friend class CGModule; 206 | }; 207 | 208 | #endif 209 | -------------------------------------------------------------------------------- /dict.hpp: -------------------------------------------------------------------------------- 1 | // In order to utilize our allocator 2 | 3 | template 5 | class Dict { 6 | public: 7 | void insert(Key key, Val val) { 8 | bool found; 9 | intptr_t hash = HashFunc(key); 10 | Entry *entry = lookupEntry(key, hash, &found); 11 | if (!found) { 12 | // Rehash when 1/4 full 13 | if ((occupied << 2) > buckets) { 14 | static_cast(this)->rehash(occupied << 2); 15 | insert(key, val); 16 | return; 17 | } 18 | 19 | ++occupied; 20 | entry->status = filled; 21 | entry->hash = hash; 22 | } 23 | entry->val = val; 24 | } 25 | 26 | Val lookup(Key key, bool *found) { 27 | intptr_t hash = HashFunc(key); 28 | Entry *entry = lookupEntry(key, hash, found); 29 | return entry->val; 30 | } 31 | 32 | Key lookupKey(Key key, bool *found) { 33 | intptr_t hash = HashFunc(key); 34 | Entry *entry = lookupEntry(key, hash, found); 35 | return entry->key; 36 | } 37 | 38 | void remove(Key key, bool *found) { 39 | intptr_t hash = HashFunc(key); 40 | Entry *entry = lookupEntry(key, hash, found); 41 | if (*found) { 42 | } 43 | return entry->val; 44 | } 45 | 46 | private: 47 | 48 | // Copied from `c++/4.5/backward/hashtable' 49 | enum { kNumBuckets = 29 }; 50 | 51 | static const uintptr_t bucketList[kNumBuckets] = { 52 | 5ul, 53ul, 97ul, 193ul, 389ul, 53 | 769ul, 1543ul, 3079ul, 6151ul, 12289ul, 54 | 24593ul, 49157ul, 98317ul, 196613ul, 393241ul, 55 | 786433ul, 1572869ul, 3145739ul, 6291469ul, 12582917ul, 56 | 25165843ul, 50331653ul, 100663319ul, 201326611ul, 402653189ul, 57 | 805306457ul, 1610612741ul, 3221225473ul, 4294967291ul 58 | }; 59 | 60 | enum EntryStatus { 61 | Empty, 62 | Filled, 63 | TombStone 64 | }; 65 | 66 | struct Entry { 67 | Key key; 68 | intptr_t hash; 69 | Val val; 70 | EntryStatus status; 71 | }; 72 | 73 | Entry *lookupEntry(Key key, intptr_t hash, bool *found) { 74 | Entry *lastTomb = NULL; 75 | for (intptr_t i = 0; i < buckets; ++i) { 76 | intptr_t ix = (hash + i * i) % buckets; 77 | Entry *got = items + ix; 78 | if (got->status == Empty) { 79 | if (found) { 80 | *found = false; 81 | } 82 | return got; 83 | } 84 | else if (got->status == TombStone) { 85 | lastTomb = lastTomb ? lastTomb : got; 86 | } 87 | else if (got->status == Filled && got->hash == hash && 88 | EqFunc(got->key, key)) { 89 | if (found) { 90 | *found = true; 91 | } 92 | return got; 93 | } 94 | } 95 | if (found) { 96 | *found = false; 97 | } 98 | return lastTomb; 99 | } 100 | 101 | intptr_t buckets; 102 | intptr_t occupied; 103 | Entry *items; 104 | }; 105 | 106 | -------------------------------------------------------------------------------- /gc.cpp: -------------------------------------------------------------------------------- 1 | #include "gc.hpp" 2 | #include "object.hpp" 3 | #include "util.hpp" 4 | #include "runtime.hpp" 5 | 6 | #define KB 1024 7 | #define MB (KB * KB) 8 | 9 | ThreadState *ThreadState::global_ = NULL; 10 | 11 | ThreadState *ThreadState::create() { 12 | void *raw = malloc(kLastOffset * sizeof(void *)); 13 | ThreadState *ts = reinterpret_cast(raw); 14 | 15 | // Mocking compiled code info 16 | ts->lastFrameDescr() = FrameDescr(); 17 | ts->firstStackPtr() = 0; 18 | ts->lastStackPtr() = 0; 19 | 20 | // Init gc 21 | ts->heapSize() = 256 * KB; 22 | #ifndef kSanyaGCDebug 23 | ts->heapBase() = (intptr_t) malloc(ts->heapSize() * 2); 24 | ts->heapPtr() = ts->heapBase(); 25 | ts->heapLimit() = ts->heapBase() + ts->heapSize(); 26 | ts->heapFromSpace() = ts->heapBase(); 27 | ts->heapToSpace() = ts->heapBase() + ts->heapSize(); 28 | #else 29 | ts->heapBase() = (intptr_t) malloc(ts->heapSize()); 30 | ts->heapPtr() = ts->heapBase(); 31 | ts->heapLimit() = ts->heapBase() + ts->heapSize(); 32 | ts->heapFromSpace() = ts->heapBase(); 33 | #endif 34 | 35 | // Create linkedlist head 36 | ts->handleHead() = reinterpret_cast(malloc(sizeof(Handle))); 37 | ts->handleHead()->initFromThreadState(ts); 38 | 39 | // There's only one intern table 40 | ts->symbolInternTable() = NULL; 41 | 42 | return ts; 43 | } 44 | 45 | void ThreadState::initGlobalState() { 46 | global_ = ThreadState::create(); 47 | 48 | // Create global symbol intern table 49 | global_->symbolInternTable() = Util::newAssocList(); 50 | } 51 | 52 | void *ThreadState::initGcHeader(intptr_t raw, size_t size) { 53 | GcHeader *h = reinterpret_cast(raw); 54 | h->mark = 0; 55 | h->setMarkAt(); 56 | h->size = size; 57 | h->copiedTo = NULL; 58 | return reinterpret_cast(h->toRawObject()); 59 | } 60 | 61 | void ThreadState::destroy() { 62 | free(handleHead()); 63 | free(reinterpret_cast(heapBase())); 64 | free(this); 65 | } 66 | 67 | void ThreadState::display(int fd) { 68 | dprintf(fd, "[ThreadState] Hp = %ld, HpLim = %ld\n", 69 | heapPtr(), heapLimit()); 70 | } 71 | 72 | void *ThreadState::gcAllocSlow(size_t size) { 73 | heapPtr() -= size; 74 | lastAllocReq() = size; 75 | gcCollect(); 76 | 77 | intptr_t raw = heapPtr(); 78 | heapPtr() += size; 79 | return initGcHeader(raw, size); 80 | } 81 | 82 | // XXX: tags 83 | void ThreadState::gcScavenge(Object **loc) { 84 | Object *ptr = *loc; 85 | 86 | if (!ptr || !ptr->isHeapAllocated()) { 87 | return; 88 | } 89 | //dprintf(2, "[GcScav] [%p] %ld (%p)\n", loc, (intptr_t) ptr, ptr); 90 | RawObject::Tag ptrTag = ptr->getTag(); 91 | GcHeader *h = GcHeader::fromRawObject(ptr->raw()); 92 | 93 | if (h->markAt()) { 94 | // If is in from space and already copied: do redirection 95 | *loc = h->copiedTo->toRawObject()->tagWith(ptrTag); 96 | return; 97 | } 98 | else if (isInToSpace(h)) { 99 | // If is in to space: do nothing 100 | return; 101 | } 102 | 103 | //dprintf(2, "[GC] Scavenge %p: ", ptr->raw()); 104 | //ptr->displayDetail(2); 105 | //dprintf(2, "\n"); 106 | 107 | h->setMarkAt(); 108 | 109 | // Do copy 110 | GcHeader *newH = reinterpret_cast(heapCopyPtr()); 111 | memcpy(newH, h, h->size); 112 | heapCopyPtr() += h->size; 113 | 114 | // Redirect loc and interior ptrs. 115 | newH->setMarkAt(); 116 | h->copiedTo = newH; 117 | Object *newPtr = newH->toRawObject()->tagWith(ptrTag); 118 | *loc = newPtr; 119 | newPtr->gcScavenge(this); 120 | } 121 | 122 | void ThreadState::gcCollect() { 123 | //dprintf(2, "[GC] Collect\n"); 124 | 125 | // Invariant: we are using simple semispace gc 126 | #ifndef kSanyaGCDebug 127 | heapCopyPtr() = heapToSpace(); 128 | #else 129 | heapToSpace() = (intptr_t) malloc(heapSize()); 130 | heapCopyPtr() = heapToSpace(); 131 | #endif 132 | 133 | // Scavenge C++ roots 134 | for (Handle *iter = handleHead()->next; 135 | iter != handleHead(); iter = iter->next) { 136 | gcScavenge(&iter->ptr); 137 | } 138 | 139 | gcScavengeSchemeStack(); 140 | 141 | // Scavenge symbol intern table 142 | gcScavenge(&symbolInternTable()); 143 | 144 | #ifndef kSanyaGCDebug 145 | intptr_t tmpSpace = heapFromSpace(); 146 | heapFromSpace() = heapToSpace(); 147 | heapToSpace() = tmpSpace; 148 | #else 149 | free((void *) heapBase()); 150 | heapBase() = heapFromSpace() = heapToSpace(); 151 | #endif 152 | heapPtr() = heapCopyPtr(); 153 | heapLimit() = heapFromSpace() + heapSize(); 154 | 155 | if (Option::global().kLogInfo) { 156 | dprintf(2, "[gcCollect] (%ld/%ld)\n", 157 | heapSize() - (heapLimit() - heapPtr()), 158 | heapSize()); 159 | } 160 | 161 | if (heapLimit() - heapPtr() < (intptr_t) lastAllocReq()) { 162 | dprintf(2, "gcCollect: heap exhausted by req %ld\n", lastAllocReq()); 163 | exit(1); 164 | } 165 | } 166 | 167 | // @See Runtime::collectAndAlloc 168 | void ThreadState::gcScavengeSchemeStack() { 169 | FrameDescr fd = lastFrameDescr(); 170 | intptr_t stackPtr = lastStackPtr(); 171 | intptr_t stackTop = firstStackPtr(); 172 | 173 | if (stackPtr == stackTop) { 174 | return; 175 | } 176 | 177 | //dprintf(2, "[ScavScm] lastScmSp = %p, retaddr = %p\n", 178 | // (void **) stackPtr, 179 | // ((void **) stackPtr)[-1]); 180 | 181 | while (true) { 182 | for (intptr_t i = 0; i < fd.frameSize; ++i) { 183 | if (fd.isPtr(i)) { 184 | Object **loc = reinterpret_cast(stackPtr + i * 8); 185 | //Util::logObj("ScavengeScm Before", *loc); 186 | 187 | //if ((*loc)->isHeapAllocated()) { 188 | // GcHeader *h = GcHeader::fromRawObject((*loc)->raw()); 189 | // dprintf(2, "[GcHeader] size = %d, copied = %d\n", 190 | // h->size, h->markAt()); 191 | //} 192 | 193 | gcScavenge(loc); 194 | //Util::logObj("ScavengeScm After", *loc); 195 | } 196 | } 197 | 198 | stackPtr += (1 + fd.frameSize) * 8; 199 | if (stackPtr == stackTop) { 200 | break; 201 | } 202 | assert(stackPtr < stackTop); 203 | fd = *reinterpret_cast(stackPtr - 16); 204 | } 205 | } 206 | 207 | 208 | -------------------------------------------------------------------------------- /gc.hpp: -------------------------------------------------------------------------------- 1 | #ifndef GC_HPP 2 | #define GC_HPP 3 | 4 | #include 5 | #include 6 | #include 7 | #include 8 | 9 | #include "util.hpp" 10 | 11 | class Handle; 12 | class RawObject; 13 | class Object; 14 | class FrameDescr; 15 | class ThreadState; 16 | 17 | // Pads object, stores gc-related info 18 | class GcHeader { 19 | public: 20 | enum { 21 | kCopied 22 | }; 23 | 24 | static GcHeader *fromRawObject(RawObject *wat) { 25 | return reinterpret_cast( 26 | reinterpret_cast(wat) - sizeof(GcHeader)); 27 | } 28 | 29 | RawObject *toRawObject() const { 30 | return reinterpret_cast( 31 | reinterpret_cast(this) + sizeof(*this)); 32 | } 33 | 34 | template 35 | bool markAt() { 36 | return (1UL << n) & mark; 37 | } 38 | 39 | template 40 | void setMarkAt() { 41 | if (p) { 42 | mark |= (1UL << n); 43 | } 44 | else { 45 | mark &= ~(1UL << n); 46 | } 47 | } 48 | 49 | uint32_t mark; 50 | 51 | // Including gcheader 52 | uint32_t size; 53 | 54 | GcHeader *copiedTo; 55 | 56 | friend class ThreadState; 57 | }; 58 | 59 | // Stores all the of runtime information 60 | // Like capability in Haskell, ikpcb in Ikarus, etc etc.. 61 | class ThreadState { 62 | public: 63 | enum { 64 | kLastFrameDescrOffset, 65 | kFirstStackPtrOffset, 66 | kLastStackPtrOffset, 67 | kHeapPtrOffset, 68 | kHeapLimitOffset, 69 | kHeapBaseOffset, 70 | kHeapSizeOffset, 71 | kHeapFromSpaceOffset, 72 | kHeapToSpaceOffset, 73 | kHeapCopyPtrOffset, 74 | kLastAllocReqOffset, 75 | kHandleHeadOffset, 76 | kSymbolInternTableOffset, 77 | kLastOffset 78 | }; 79 | 80 | static ThreadState &global() { 81 | if (!global_) { 82 | initGlobalState(); 83 | } 84 | return *global_; 85 | } 86 | 87 | static void initGlobalState(); 88 | 89 | static ThreadState *create(); 90 | void destroy(); 91 | void display(int fd); 92 | 93 | template 94 | T as() { 95 | return reinterpret_cast(this); 96 | } 97 | 98 | template 99 | T &at() { 100 | return *reinterpret_cast(as() + offset); 101 | } 102 | 103 | 104 | void *initGcHeader(intptr_t raw, size_t size); 105 | 106 | // Only used by compiler code. 107 | void *gcAlloc(size_t size) { 108 | assert(Util::isAligned<4>(size)); 109 | intptr_t res = heapPtr(); 110 | size += sizeof(GcHeader); 111 | heapPtr() += size; 112 | if ( 113 | #ifdef kSanyaGCDebug 114 | // 0 && 115 | #endif 116 | heapPtr() <= heapLimit()) { 117 | return initGcHeader(res, size); 118 | } 119 | else { 120 | return gcAllocSlow(size); 121 | } 122 | } 123 | 124 | void *gcAllocSlow(size_t); 125 | void gcCollect(); 126 | void gcScavenge(Object **); 127 | void gcScavengeSchemeStack(); 128 | 129 | bool isInToSpace(GcHeader *h) { 130 | auto raw = reinterpret_cast(h); 131 | return heapToSpace() <= raw && raw < heapToSpace() + heapSize(); 132 | } 133 | 134 | #define MK_ATTR(name, offset, type) \ 135 | type &name() { return at(); } 136 | 137 | #define ATTR_LIST(V) \ 138 | V(lastFrameDescr, kLastFrameDescr, FrameDescr) \ 139 | V(firstStackPtr, kFirstStackPtr, intptr_t) \ 140 | V(lastStackPtr, kLastStackPtr, intptr_t) \ 141 | V(heapPtr, kHeapPtr, intptr_t) \ 142 | V(heapLimit, kHeapLimit, intptr_t) \ 143 | V(heapBase, kHeapBase, intptr_t) \ 144 | V(heapSize, kHeapSize, intptr_t) \ 145 | V(heapFromSpace, kHeapFromSpace, intptr_t) \ 146 | V(heapToSpace, kHeapToSpace, intptr_t) \ 147 | V(heapCopyPtr, kHeapCopyPtr, intptr_t) \ 148 | V(lastAllocReq, kLastAllocReq, size_t) \ 149 | V(handleHead, kHandleHead, Handle *) \ 150 | V(symbolInternTable, kSymbolInternTable, Object *) \ 151 | // Append 152 | 153 | ATTR_LIST(MK_ATTR); 154 | 155 | #undef ATTR_LIST 156 | #undef MK_ATTR 157 | 158 | private: 159 | static ThreadState *global_; 160 | }; 161 | 162 | // Generated by codegen for each callsite. 163 | // Currently only contains the size of the frame and the place 164 | // of the pointers 165 | struct FrameDescr { 166 | uint16_t frameSize; 167 | char ptrBitMap[6]; 168 | 169 | FrameDescr() { 170 | *this = unpack(0); 171 | } 172 | 173 | bool isPtr(intptr_t ix) { 174 | int nthByte = ix >> 3; 175 | int nthBit = ix & 7; 176 | return (ptrBitMap[nthByte] >> nthBit) & 1L; 177 | } 178 | 179 | void setIsPtr(intptr_t ix) { 180 | int nthByte = ix >> 3; 181 | int nthBit = ix & 7; 182 | ptrBitMap[nthByte] |= (1L << nthBit); 183 | } 184 | 185 | intptr_t pack() { 186 | return *reinterpret_cast(this); 187 | } 188 | 189 | static FrameDescr unpack(intptr_t val) { 190 | return *reinterpret_cast(&val); 191 | } 192 | }; 193 | 194 | // Used by C++-compiled code (but not by native code) to handle gc. 195 | class Handle { 196 | public: 197 | Handle() { 198 | initPtr(NULL); 199 | } 200 | 201 | Handle(Object *ptr) { 202 | initPtr(ptr); 203 | } 204 | 205 | Handle(const Handle &other) { 206 | initPtr(other.ptr); 207 | } 208 | 209 | Handle &operator=(const Handle &other) { 210 | ptr = other.ptr; 211 | return *this; 212 | } 213 | 214 | bool operator==(const Handle &other) const { 215 | return ptr == other.ptr; 216 | } 217 | 218 | bool operator==(const Object *other) const { 219 | return ptr == other; 220 | } 221 | 222 | ~Handle() { 223 | prev->next = next; 224 | next->prev = prev; 225 | } 226 | 227 | // This 228 | Object *operator->() const { 229 | return ptr; 230 | } 231 | 232 | Object *getPtr() const { 233 | return ptr; 234 | } 235 | 236 | operator bool() const { 237 | return ptr != NULL; 238 | } 239 | 240 | operator Object *() const { 241 | return ptr; 242 | } 243 | 244 | void initPtr(Object *ptr) { 245 | Handle *&head = ThreadState::global().handleHead(); 246 | this->ptr = ptr; 247 | 248 | // insert before head 249 | prev = head->prev; 250 | next = head; 251 | 252 | head->prev->next = this; 253 | head->prev = this; 254 | } 255 | 256 | private: 257 | 258 | void initFromThreadState(ThreadState *ts) { 259 | ptr = NULL; 260 | next = prev = this; 261 | } 262 | 263 | Handle *prev, *next; 264 | Object *ptr; 265 | 266 | friend class ThreadState; 267 | }; 268 | 269 | #endif 270 | -------------------------------------------------------------------------------- /main.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | 5 | #include 6 | 7 | #include "util.hpp" 8 | #include "object.hpp" 9 | #include "parser.hpp" 10 | #include "codegen2.hpp" 11 | #include "runtime.hpp" 12 | 13 | // Global flags 14 | struct Flags { 15 | bool kTailCallOpt; 16 | }; 17 | 18 | Flags flag; 19 | 20 | extern "C" { 21 | extern Object *Scheme_asmEntry( 22 | Object *, void *, intptr_t, intptr_t, ThreadState *); 23 | } 24 | 25 | Object *callScheme_0(Object *clo) { 26 | assert(clo->isClosure()); 27 | auto info = clo->raw()->cloInfo(); 28 | assert(info->funcArity() == 0); 29 | auto entry = info->funcCodeAs(); 30 | ThreadState *ts = &ThreadState::global(); 31 | 32 | if (Option::global().kLogInfo) { 33 | Util::logObj("CallScheme", clo); 34 | } 35 | 36 | return Scheme_asmEntry(clo, entry, ts->heapPtr(), ts->heapLimit(), ts); 37 | } 38 | 39 | void readAll(FILE *f, std::string *xs) { 40 | int c; 41 | while ((c = fgetc(f)) != EOF) { 42 | char realC = c; 43 | (*xs) += realC; 44 | } 45 | } 46 | 47 | Object *getMainClo(int argc, char **argv) { 48 | FILE *fin; 49 | CGModule cg; 50 | Handle ast; 51 | 52 | { 53 | std::string input; 54 | 55 | if (argc == 2) { 56 | fin = fopen(argv[1], "r"); 57 | if (!fin) { 58 | perror(argv[1]); 59 | exit(1); 60 | } 61 | } 62 | else { 63 | fin = stdin; 64 | } 65 | readAll(fin, &input); 66 | if (fin != stdin) { 67 | fclose(fin); 68 | } 69 | 70 | Parser parser(input); 71 | 72 | bool parseOk; 73 | ast = parser.parseProg(&parseOk); 74 | assert(parseOk); 75 | } 76 | 77 | //ast->displayDetail(2); 78 | 79 | Object *mainClo = cg.genModule(ast); 80 | return mainClo; 81 | //ThreadState::global().display(2); 82 | 83 | //callScheme_0(mainClo)->displayDetail(1); 84 | //Runtime::printNewLine(1); 85 | } 86 | 87 | int main(int argc, char **argv) { 88 | //VALGRIND_MAKE_MEM_NOACCESS(0x7fefff700UL, 8); 89 | 90 | //ThreadState::global().display(2); 91 | Option::init(); 92 | 93 | callScheme_0(getMainClo(argc, argv)); 94 | ThreadState::global().destroy(); 95 | return 0; 96 | } 97 | 98 | -------------------------------------------------------------------------------- /object.cpp: -------------------------------------------------------------------------------- 1 | #include "object.hpp" 2 | #include "gc.hpp" 3 | #include 4 | 5 | void Object::printToFd(int fd) { 6 | RawObject *raw = unTag(); 7 | switch (getTag()) { 8 | case RawObject::kPairTag: 9 | dprintf(fd, "", raw); 10 | break; 11 | 12 | case RawObject::kSymbolTag: 13 | dprintf(fd, "", raw->as()); 14 | break; 15 | 16 | case RawObject::kSingletonTag: 17 | if (this == newNil()) { 18 | dprintf(fd, ""); 19 | } 20 | else { 21 | dprintf(fd, "", this); 22 | } 23 | break; 24 | 25 | case RawObject::kFixnumTag: 26 | dprintf(fd, "", fromFixnum()); 27 | break; 28 | 29 | case RawObject::kClosureTag: 30 | dprintf(fd, "cloInfo()->funcName()->printToFd(fd); 32 | dprintf(fd, " @%p>", raw); 33 | break; 34 | 35 | case RawObject::kVectorTag: 36 | dprintf(fd, "", raw); 37 | break; 38 | 39 | default: 40 | dprintf(fd, "", this); 41 | break; 42 | } 43 | } 44 | 45 | void Object::displayDetail(int fd) { 46 | RawObject *raw = unTag(); 47 | switch (getTag()) { 48 | case RawObject::kPairTag: 49 | dprintf(fd, "("); 50 | displayListDetail(fd); 51 | dprintf(fd, ")"); 52 | break; 53 | 54 | case RawObject::kSymbolTag: 55 | dprintf(fd, "%s", raw->as()); 56 | break; 57 | 58 | case RawObject::kSingletonTag: 59 | if (this == newNil()) { 60 | dprintf(fd, "()"); 61 | } 62 | else if (this == newTrue()) { 63 | dprintf(fd, "#t"); 64 | } 65 | else if (this == newFalse()) { 66 | dprintf(fd, "#f"); 67 | } 68 | else if (this == newVoid()) { 69 | dprintf(fd, ""); 70 | } 71 | else { 72 | dprintf(fd, "", this); 73 | } 74 | break; 75 | 76 | case RawObject::kFixnumTag: 77 | dprintf(fd, "%ld", fromFixnum()); 78 | break; 79 | 80 | case RawObject::kClosureTag: 81 | if (raw->cloInfo()) { 82 | dprintf(fd, "cloInfo()->funcName()->displayDetail(fd); 84 | dprintf(fd, ">"); 85 | } 86 | else { 87 | // info table is null during compilation 88 | dprintf(fd, "", raw); 89 | } 90 | break; 91 | 92 | case RawObject::kVectorTag: 93 | { 94 | dprintf(fd, "(#"); 95 | for (intptr_t i = 0, len = raw->vectorSize(); i < len; ++i) { 96 | dprintf(fd, " "); 97 | raw->vectorAt(i)->displayDetail(fd); 98 | } 99 | dprintf(fd, ")"); 100 | break; 101 | } 102 | 103 | default: 104 | dprintf(fd, "", this); 105 | break; 106 | } 107 | } 108 | 109 | void Object::displayListDetail(int fd) { 110 | raw()->car()->displayDetail(fd); 111 | Object *curr = raw()->cdr(); 112 | 113 | while (curr->isPair()) { 114 | dprintf(fd, " "); 115 | curr->raw()->car()->displayDetail(fd); 116 | curr = curr->raw()->cdr(); 117 | } 118 | 119 | if (curr != newNil()) { 120 | dprintf(fd, " . "); 121 | curr->displayDetail(fd); 122 | } 123 | } 124 | 125 | void Object::gcScavenge(ThreadState *ts) { 126 | switch (getTag()) { 127 | case RawObject::kPairTag: 128 | ts->gcScavenge(&raw()->car()); 129 | ts->gcScavenge(&raw()->cdr()); 130 | break; 131 | 132 | case RawObject::kSymbolTag: 133 | break; 134 | 135 | case RawObject::kSingletonTag: 136 | case RawObject::kFixnumTag: 137 | assert(0 && "Object::gcScavenge: not heap allocated"); 138 | 139 | case RawObject::kClosureTag: 140 | { 141 | RawObject *info = raw()->cloInfo(); 142 | if (!info) { 143 | // info is NULL? happens when a supercombinator 144 | // is just being compiled in the codegen. 145 | break; 146 | } 147 | Object **payload = raw()->cloPayload(); 148 | for (intptr_t i = 0; i < info->funcNumPayload(); ++i) { 149 | ts->gcScavenge(payload + i); 150 | } 151 | ts->gcScavenge(&info->funcName()); 152 | ts->gcScavenge(&info->funcConstOffset()); 153 | 154 | // Scavenge const ptrs in code 155 | // @See codegen2.cpp 156 | //Util::logObj("scavenge code", info->funcConstOffset()); 157 | intptr_t len = info->funcConstOffset()->raw()->vectorSize(); 158 | for (intptr_t i = 0; i < len; ++i) { 159 | intptr_t offset = info->funcConstOffset()-> 160 | raw()->vectorAt(i)->fromFixnum(); 161 | intptr_t ptrLoc = info->funcCodeAs() + offset; 162 | 163 | //Object *oldPtrVal = *(Object **) ptrLoc; 164 | 165 | ts->gcScavenge(reinterpret_cast(ptrLoc)); 166 | 167 | //dprintf(2, "[ScavCodeReloc] %s[%ld] (which is %p) %p => %p ", 168 | // info->funcName()->rawSymbol(), 169 | // offset, 170 | // (void *) ptrLoc, 171 | // *(Object **) ptrLoc, 172 | // oldPtrVal); 173 | 174 | //(*(Object **) ptrLoc)->displayDetail(2); 175 | //dprintf(2, "\n"); 176 | } 177 | 178 | // And instructs valgrind to discard out-of-date jitted codes 179 | // Must do this since we have changed our code 180 | VALGRIND_DISCARD_TRANSLATIONS( 181 | info->funcCodeAs(), 182 | info->funcCodeAs() + info->funcSize() - 183 | RawObject::kFuncCodeOffset); 184 | break; 185 | } 186 | case RawObject::kVectorTag: 187 | { 188 | Object **elems = &raw()->vectorElem(); 189 | for (intptr_t i = 0; i < raw()->vectorSize(); ++i) { 190 | ts->gcScavenge(elems + i); 191 | } 192 | break; 193 | } 194 | default: 195 | assert(0 && "Object::gcScavenge: not a tagged object"); 196 | } 197 | } 198 | 199 | -------------------------------------------------------------------------------- /object.hpp: -------------------------------------------------------------------------------- 1 | #ifndef OBJECT_HPP 2 | #define OBJECT_HPP 3 | 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | 10 | #include "util.hpp" 11 | #include "gc.hpp" 12 | 13 | class Object; 14 | class ThreadState; 15 | 16 | template 17 | class Base { 18 | public: 19 | template 20 | constexpr T as() { return reinterpret_cast(this); } 21 | 22 | template 23 | static constexpr This *from(T wat) { 24 | return reinterpret_cast(wat); 25 | } 26 | }; 27 | 28 | // Untagged 29 | class RawObject : public Base { 30 | public: 31 | enum Tag { 32 | kPairTag = 0x1, 33 | kSymbolTag = 0x2, 34 | kSingletonTag = 0x3, 35 | kFixnumTag = 0x4, 36 | kClosureTag = 0x5, 37 | kVectorTag = 0x6, 38 | kForeignPtrTag = 0x7 39 | }; 40 | 41 | enum { 42 | kTagShift = 0x4, 43 | kTagMask = 0xf, 44 | 45 | kSizeOfPair = 0x10, 46 | kCarOffset = 0x0, 47 | kCdrOffset = 0x8, 48 | 49 | kNilUpper = 0x0, 50 | kTrueUpper = 0x1, 51 | kFalseUpper = 0x2, 52 | kVoidUpper = 0x3, 53 | 54 | kFuncArityOffset = 0x0, 55 | kFuncNameOffset = 0x8, 56 | kFuncConstOffsetOffset = 0x10, 57 | kFuncNumPayloadOffset = 0x18, 58 | kFuncSizeOffset = 0x1c, // including meta data 59 | kFuncCodeOffset = 0x20, // variable-sized 60 | 61 | kCloInfoOffset = 0x0, 62 | kCloPayloadOffset = 0x8, // variable-sized 63 | 64 | kVectorSizeOffset = 0x0, 65 | kVectorElemOffset = 0x8 // variable-sized 66 | }; 67 | 68 | template 69 | constexpr T &at() { 70 | return *reinterpret_cast(as() + offset); 71 | } 72 | 73 | template 74 | constexpr T &at(intptr_t offset) { 75 | return *reinterpret_cast(as() + offset); 76 | } 77 | 78 | template 79 | constexpr Object *tag() { 80 | return reinterpret_cast(as() + tagVal); 81 | } 82 | 83 | Object *tagWith(Tag wat) { 84 | return reinterpret_cast(as() + wat); 85 | } 86 | 87 | #define MK_TAG_AS(name) \ 88 | Object *tagAs ## name() { return tag(); } 89 | 90 | #define TAG_LIST(V) \ 91 | V(Pair) V(Symbol) V(Fixnum) V(Singleton) \ 92 | V(Closure) V(Vector) V(ForeignPtr) 93 | TAG_LIST(MK_TAG_AS) 94 | #undef MK_TAG_AS 95 | 96 | #define MK_ATTR(name, offset, type) \ 97 | type &name() { return at(); } 98 | 99 | #define ATTR_LIST(V) \ 100 | V(car, kCar, Object *) \ 101 | V(cdr, kCdr, Object *) \ 102 | V(funcArity, kFuncArity, intptr_t) \ 103 | V(funcName, kFuncName, Object *) \ 104 | V(funcConstOffset, kFuncConstOffset, Object *) \ 105 | V(funcCode, kFuncCode, char) \ 106 | V(funcNumPayload, kFuncNumPayload, int32_t) \ 107 | V(funcSize, kFuncSize, int32_t) \ 108 | V(vectorSize, kVectorSize, intptr_t) \ 109 | V(vectorElem, kVectorElem, Object *) \ 110 | V(cloInfo, kCloInfo, RawObject *) \ 111 | V(cloPayload_, kCloPayload, Object *) \ 112 | // Append 113 | 114 | ATTR_LIST(MK_ATTR); 115 | 116 | Object *&vectorAt(intptr_t i) { 117 | return (&vectorElem())[i]; 118 | } 119 | 120 | template 121 | T funcCodeAs() { 122 | return reinterpret_cast(&funcCode()); 123 | } 124 | 125 | Object **cloPayload() { 126 | return &cloPayload_(); 127 | } 128 | 129 | #undef ATTR_LIST 130 | #undef MK_ATTR 131 | 132 | typedef void (*NullaryFn) (); 133 | }; 134 | 135 | 136 | // Tagged 137 | class Object : public Base { 138 | public: 139 | static Object *newPair(const Handle &car, const Handle &cdr) { 140 | RawObject *pair = alloc(RawObject::kSizeOfPair); 141 | pair->car() = car.getPtr(); 142 | pair->cdr() = cdr.getPtr(); 143 | //dprintf(2, "[Object::newPair] %p\n", pair); 144 | return pair->tagAsPair(); 145 | } 146 | 147 | static Object *newFixnum(intptr_t val) { 148 | RawObject *raw = RawObject::from(val << RawObject::kTagShift); 149 | return raw->tagAsFixnum(); 150 | } 151 | 152 | static Object *internSymbol(const char *src) { 153 | Handle tmp = newSymbolFromC(src); 154 | bool ok; 155 | Object *got = Util::assocLookupKey( 156 | ThreadState::global().symbolInternTable(), 157 | tmp, Util::kSymbolEq, &ok); 158 | if (ok) { 159 | return got; 160 | } 161 | else { 162 | //ThreadState::global().symbolInternTable() = 163 | 164 | Object *newInternTable = 165 | Util::assocInsert(ThreadState::global().symbolInternTable(), 166 | tmp, Object::newNil(), Util::kPtrEq); 167 | ThreadState::global().symbolInternTable() = newInternTable; 168 | return tmp.getPtr(); 169 | } 170 | } 171 | 172 | static Object *newSymbolFromC(const char *src) { 173 | RawObject *raw; 174 | size_t len = strlen(src); 175 | raw = alloc(Util::align(len + 1)); 176 | memcpy(raw, src, len + 1); 177 | return raw->tagAsSymbol(); 178 | } 179 | 180 | #define SINGLETONS(V) \ 181 | V(Nil) V(True) V(False) V(Void) 182 | #define MK_SINGLETON(name) \ 183 | static Object *new ## name() { \ 184 | return RawObject::from(RawObject::k ## name ## Upper << \ 185 | RawObject::kTagShift)->tagAsSingleton(); \ 186 | } 187 | SINGLETONS(MK_SINGLETON) 188 | #undef MK_SINGLETON 189 | 190 | #define CHECK_SINGLETON(name) \ 191 | bool is ## name() { return this == new ## name(); } 192 | SINGLETONS(CHECK_SINGLETON) 193 | #undef SINGLETONS 194 | 195 | static Object *newBool(bool wat) { 196 | return wat ? newTrue() : newFalse(); 197 | } 198 | 199 | static RawObject *newFunction(void *raw, intptr_t arity, 200 | Object *name, Object *constOffsets, 201 | intptr_t numPayload) { 202 | // keep in sync with the codegen. 203 | RawObject *func = RawObject::from(raw); 204 | func->funcArity() = arity; 205 | func->funcName() = name; 206 | func->funcConstOffset() = constOffsets; 207 | func->funcNumPayload() = numPayload; 208 | return func; 209 | } 210 | 211 | static Object *newClosure(RawObject *info) { 212 | size_t size; 213 | 214 | if (info) { 215 | size = sizeof(Object *) * (1 + info->funcNumPayload()); 216 | } 217 | else { 218 | // No info, should be a supercombinator 219 | size = sizeof(Object *); 220 | } 221 | 222 | size = Util::align<4>(size); 223 | 224 | RawObject *clo = alloc(size); 225 | clo->cloInfo() = info; 226 | return clo->tagAsClosure(); 227 | } 228 | 229 | static Object *newVector(intptr_t size, Object *fill) { 230 | size_t actualSize = Util::align<4>(sizeof(Object *) * (1 + size)); 231 | RawObject *vector = alloc(actualSize); 232 | vector->vectorSize() = size; 233 | for (intptr_t i = 0; i < size; ++i) { 234 | vector->vectorAt(i) = fill; 235 | } 236 | return vector->tagAsVector(); 237 | } 238 | 239 | // Not allocated from the scheme heap 240 | template 241 | static Object *newForeignPtr(T *wat) { 242 | return RawObject::from(wat)->tagAsForeignPtr(); 243 | } 244 | 245 | #define CHECK_TAG(name) \ 246 | bool is ## name() { return getTag() == RawObject::k ## name ## Tag; } 247 | TAG_LIST(CHECK_TAG) 248 | #undef CHECK_TAG 249 | 250 | // Does not check for proper list. 251 | bool isList() { 252 | return isPair() || isNil(); 253 | } 254 | 255 | template 256 | static T *alloc(size_t size) { 257 | return reinterpret_cast(allocRaw(size)); 258 | } 259 | 260 | bool isHeapAllocated() { 261 | switch (getTag()) { 262 | case RawObject::kPairTag: 263 | case RawObject::kSymbolTag: 264 | return true; 265 | 266 | case RawObject::kSingletonTag: 267 | case RawObject::kFixnumTag: 268 | return false; 269 | 270 | case RawObject::kClosureTag: 271 | case RawObject::kVectorTag: 272 | return true; 273 | 274 | default: 275 | Util::logPtr("Object::isHeapAllocated: not a tagged object", this); 276 | assert(0); 277 | } 278 | } 279 | 280 | RawObject::Tag getTag() { 281 | return (RawObject::Tag) (as() & 0xf); 282 | } 283 | 284 | template 285 | T *unTag() { 286 | return reinterpret_cast(as() & ~0xfUL); 287 | } 288 | 289 | RawObject *raw() { 290 | return unTag(); 291 | } 292 | 293 | const char *rawSymbol() { 294 | return unTag(); 295 | } 296 | 297 | intptr_t fromFixnum() { 298 | return as() >> RawObject::kTagShift; 299 | } 300 | 301 | static void *allocRaw(size_t size) { 302 | // XXX gc here 303 | return ThreadState::global().gcAlloc(size); 304 | } 305 | 306 | // Library functions 307 | void printToFd(int fd); 308 | static void printNewLine(int fd); 309 | void displayDetail(int fd); 310 | void displayListDetail(int fd); 311 | 312 | // Gc support 313 | void gcScavenge(ThreadState *); 314 | }; 315 | 316 | #endif 317 | -------------------------------------------------------------------------------- /parser.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include "object.hpp" 3 | #include "parser.hpp" 4 | 5 | Parser::Parser(const std::string &input) 6 | : input(input) 7 | , ix(0) { 8 | 9 | symQuote = Object::internSymbol("quote"); 10 | symQuasiQuote = Object::internSymbol("quasiquote"); 11 | symUnquote = Object::internSymbol("unquote"); 12 | symUnquoteSplicing = Object::internSymbol("unquote-splicing"); 13 | } 14 | 15 | Object *Parser::parseProg(bool *outOk) { 16 | bool ok; 17 | Handle head = Object::newNil(), 18 | tail = Object::newNil(); 19 | 20 | while (true) { 21 | Handle x = parse(&ok); 22 | if (!ok) { 23 | break; 24 | } 25 | 26 | if (head->isNil()) { 27 | head = tail = Object::newPair(x, Object::newNil()); 28 | } 29 | else { 30 | // XXX: need to separate lhs with rhs to avoid memory corruption 31 | // since lhs (raw()->cdr()) will be evaluated before rhs (t). 32 | Handle t = Object::newPair(x, Object::newNil()); 33 | tail->raw()->cdr() = t.getPtr(); 34 | tail = tail->raw()->cdr(); 35 | } 36 | } 37 | ok = *outOk = !hasNext(); 38 | return ok ? head.getPtr() : NULL; 39 | } 40 | 41 | Object *Parser::parse(bool *ok) { 42 | assert(hasNext()); 43 | char c; 44 | 45 | while (true) { 46 | switch ((c = getNextSkipWS(ok))) { 47 | case '(': case '[': 48 | return parseList(c); 49 | 50 | case '0': case '1': case '2': case '3': case '4': 51 | case '5': case '6': case '7': case '8': case '9': 52 | return parseFixnum(c); 53 | 54 | case '\'': case '`': case ',': 55 | return parseQuote(c); 56 | 57 | default: 58 | if (!*ok) { 59 | return NULL; 60 | } 61 | return parseAtom(c); 62 | } 63 | } 64 | } 65 | 66 | Object *Parser::parseList(char open) { 67 | char c; 68 | char close = open == '(' ? ')' : ']'; 69 | bool ok; 70 | 71 | Handle head = Object::newNil(), 72 | tail = Object::newNil(); 73 | 74 | while (hasNext()) { 75 | switch ((c = getNextSkipWS())) { 76 | case ']': case ')': 77 | assert(close == c); 78 | return head.getPtr(); 79 | 80 | default: 81 | putBack(); 82 | { 83 | Handle curr = parse(&ok); 84 | assert(ok); 85 | 86 | if (head->isNil()) { 87 | head = tail = Object::newPair(curr.getPtr(), Object::newNil()); 88 | } 89 | else { 90 | Handle t = Object::newPair(curr.getPtr(), Object::newNil()); 91 | tail->raw()->cdr() = t.getPtr(); 92 | tail = tail->raw()->cdr(); 93 | } 94 | } 95 | } 96 | } 97 | assert(0); 98 | } 99 | 100 | Object *Parser::parseFixnum(char open) { 101 | intptr_t val; 102 | std::stringstream xs; 103 | xs << open; 104 | 105 | while (hasNext()) { 106 | char c = getNext(); 107 | switch (c) { 108 | case '0': case '1': case '2': case '3': case '4': 109 | case '5': case '6': case '7': case '8': case '9': 110 | xs << c; 111 | continue; 112 | 113 | default: 114 | putBack(); 115 | xs >> val; 116 | goto done; 117 | } 118 | } 119 | done: 120 | return Object::newFixnum(val); 121 | } 122 | 123 | Object *Parser::parseAtom(char open) { 124 | char c; 125 | std::stringstream xs; 126 | switch (open) { 127 | case '#': 128 | c = getNext(); 129 | assert(!isspace(c)); 130 | if (c == 't') { 131 | return Object::newTrue(); 132 | } 133 | else if (c == 'f') { 134 | return Object::newFalse(); 135 | } 136 | putBack(); 137 | } 138 | 139 | xs << open; 140 | 141 | while (hasNext()) { 142 | c = getNext(); 143 | if (isspace(c) || c == '[' || c == '(' || 144 | c == ']' || c == ')') { 145 | putBack(); 146 | break; 147 | } 148 | xs << c; 149 | } 150 | return Object::internSymbol(xs.str().c_str()); 151 | } 152 | 153 | Object *Parser::parseQuote(char fst) { 154 | Handle tag; 155 | if (fst == '\'') { 156 | tag = symQuote; 157 | } 158 | else if (fst == ',') { 159 | if (getNext() == '@') { 160 | tag = symUnquoteSplicing; 161 | } 162 | else { 163 | putBack(); 164 | tag = symUnquote; 165 | } 166 | } 167 | else { 168 | assert(fst == '`'); 169 | tag = symQuasiQuote; 170 | } 171 | 172 | bool ok; 173 | Handle body = parse(&ok); 174 | assert(ok); 175 | Handle wrapped = Object::newPair(body, Object::newNil()); 176 | return Object::newPair(tag, wrapped); 177 | } 178 | 179 | -------------------------------------------------------------------------------- /parser.hpp: -------------------------------------------------------------------------------- 1 | #ifndef PARSER_HPP 2 | #define PARSER_HPP 3 | 4 | #include 5 | #include 6 | #include 7 | #include 8 | 9 | class Object; 10 | 11 | class Parser { 12 | public: 13 | Parser(const std::string &input); 14 | 15 | Object *parseProg(bool *); 16 | Object *parse(bool *); 17 | Object *parseList(char); 18 | Object *parseFixnum(char); 19 | Object *parseAtom(char); 20 | Object *parseQuote(char); 21 | 22 | void putBack() { 23 | --ix; 24 | } 25 | 26 | bool hasNext() { 27 | return ix < (intptr_t) input.length(); 28 | } 29 | 30 | char getNext() { 31 | assert(hasNext()); 32 | return input[ix++]; 33 | } 34 | 35 | char getNextSkipWS(bool *ok = NULL) { 36 | while (hasNext()) { 37 | char c = input[ix++]; 38 | if (isspace(c)) { 39 | continue; 40 | } 41 | 42 | if (ok) *ok = true; 43 | return c; 44 | } 45 | if (ok) *ok = false; 46 | return 0; 47 | } 48 | 49 | private: 50 | Handle symQuote, 51 | symQuasiQuote, 52 | symUnquote, 53 | symUnquoteSplicing; 54 | 55 | const std::string &input; 56 | intptr_t ix; 57 | }; 58 | 59 | #endif 60 | -------------------------------------------------------------------------------- /runtime.cpp: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | #include "runtime.hpp" 5 | #include "gc.hpp" 6 | #include "object.hpp" 7 | 8 | static void printSchemeStackTrace(ThreadState *ts, 9 | intptr_t maxLevel = -1) { 10 | dprintf(2, "### Stack trace:\n"); 11 | 12 | FrameDescr fd = ts->lastFrameDescr(); 13 | intptr_t stackPtr = ts->lastStackPtr(); 14 | intptr_t stackTop = ts->firstStackPtr(); 15 | 16 | // Do a stack walk. 17 | // XXX: duplicate code since gcScavScheme does almost the same. 18 | intptr_t level = 0; 19 | while (maxLevel == -1 || level < maxLevel) { 20 | Object *thisClosure = NULL; 21 | for (intptr_t i = 0; i < fd.frameSize; ++i) { 22 | if (fd.isPtr(i)) { 23 | Object **loc = reinterpret_cast(stackPtr + i * 8); 24 | if (i == fd.frameSize - 2) { 25 | // fd, thisClo. 26 | thisClosure = *loc; 27 | } 28 | else { 29 | dprintf(2, "#%3ld Frame[%ld] ", level, i); 30 | (*loc)->displayDetail(2); 31 | dprintf(2, "\n"); 32 | } 33 | } 34 | } 35 | assert(thisClosure); 36 | dprintf(2, "#%3ld ^ Inside ", level); 37 | thisClosure->displayDetail(2); 38 | dprintf(2, "\n"); 39 | ++level; 40 | 41 | // Find prev stack 42 | stackPtr += (1 + fd.frameSize) * 8; 43 | if (stackPtr == stackTop) { 44 | break; 45 | } 46 | dprintf(2, "-------------------------------\n"); 47 | assert(stackPtr < stackTop); 48 | fd = *reinterpret_cast(stackPtr - 16); 49 | } 50 | } 51 | 52 | void Runtime::handleNotAClosure(Object *wat, ThreadState *ts) { 53 | dprintf(2, "Not a closure: "); 54 | wat->displayDetail(2); 55 | dprintf(2, "\n"); 56 | 57 | printSchemeStackTrace(ts); 58 | ts->destroy(); 59 | exit(1); 60 | } 61 | 62 | void Runtime::handleArgCountMismatch(Object *wat, intptr_t argc, 63 | ThreadState *ts) { 64 | dprintf(2, "Argument count mismatch: "); 65 | wat->displayDetail(2); 66 | dprintf(2, " need %ld, but got %ld\n", 67 | wat->raw()->cloInfo()->funcArity(), argc); 68 | 69 | printSchemeStackTrace(ts); 70 | ts->destroy(); 71 | exit(1); 72 | } 73 | 74 | void Runtime::handleUserError(Object *wat, ThreadState *ts) { 75 | Util::logObj("UserError", wat); 76 | 77 | printSchemeStackTrace(ts); 78 | ts->destroy(); 79 | exit(1); 80 | } 81 | 82 | void Runtime::handleStackOvf(ThreadState *ts) { 83 | dprintf(2, "Runtime stack overflow.\n"); 84 | dprintf(2, "Stack starts at %p, but has grow to %p. Total size = %ld\n", 85 | (void *) ts->firstStackPtr(), (void *) ts->lastStackPtr(), 86 | ts->firstStackPtr() - ts->lastStackPtr()); 87 | dprintf(2, "We display 5 most recent call stack here.\n"); 88 | 89 | printSchemeStackTrace(ts, 5); 90 | 91 | ts->destroy(); 92 | exit(1); 93 | } 94 | 95 | void Runtime::collectAndAlloc(ThreadState *ts) { 96 | if (Option::global().kLogInfo) { 97 | dprintf(2, "[Runtime::collect]\n"); 98 | } 99 | 100 | ts->gcCollect(); 101 | 102 | /* 103 | FrameDescr fd = ts->lastFrameDescr(); 104 | while (true) { 105 | dprintf(2, "[Stack Walk] stackPtr = %p, fd = %ld, size = %d\n", 106 | (void *) stackPtr, fd.pack(), fd.frameSize); 107 | for (intptr_t i = 0; i < fd.frameSize; ++i) { 108 | if (fd.isPtr(i)) { 109 | dprintf(2, "[Stack Walk] %ld isPtr\n", i); 110 | Util::logObj("E.g.", *(Object **) (stackPtr + i * 8)); 111 | } 112 | } 113 | // Get next stackPtr 114 | stackPtr += (1 + fd.frameSize) * 8; 115 | 116 | if (stackPtr == ts->firstStackPtr()) { 117 | dprintf(2, "[Stack Walk] done\n"); 118 | break; 119 | } 120 | assert(stackPtr < ts->firstStackPtr()); 121 | // Get next framedescr. -2 slot for (fd + retAddr) 122 | fd = *reinterpret_cast(stackPtr - 16); 123 | } 124 | 125 | exit(1); 126 | */ 127 | } 128 | 129 | void Runtime::traceObject(Object *wat) { 130 | dprintf(2, "[Runtime::Trace] "); 131 | wat->displayDetail(2); 132 | dprintf(2, "\n"); 133 | } 134 | 135 | intptr_t Runtime::endOfCode(intptr_t entry) { 136 | auto info = RawObject::from(entry - RawObject::kFuncCodeOffset); 137 | return entry + info->funcSize() - RawObject::kFuncCodeOffset; 138 | } 139 | 140 | void Runtime::printNewLine(int fd) { 141 | dprintf(fd, "\n"); 142 | } 143 | 144 | static Option option; 145 | 146 | static bool envIs(const char *name, const char *val) { 147 | char *maybeVal = getenv(name); 148 | if (maybeVal && strcmp(maybeVal, val) == 0) { 149 | return true; 150 | } 151 | return false; 152 | } 153 | 154 | void Option::init() { 155 | if (option.kInitialized) { 156 | return; 157 | } 158 | 159 | option.kInitialized = true; 160 | option.kTailCallOpt = !envIs("SANYA_TCO", "NO"); 161 | option.kInsertStackCheck = !envIs("SANYA_STACKCHECK", "NO"); 162 | option.kLogInfo = envIs("SANYA_LOGINFO", "YES"); 163 | } 164 | 165 | Option &Option::global() { 166 | return option; 167 | } 168 | 169 | 170 | -------------------------------------------------------------------------------- /runtime.hpp: -------------------------------------------------------------------------------- 1 | #ifndef RUNTIME_HPP 2 | #define RUNTIME_HPP 3 | 4 | #include 5 | 6 | class Object; 7 | class ThreadState; 8 | 9 | class Runtime { 10 | public: 11 | // Error handlers 12 | static void handleNotAClosure(Object *, ThreadState *); 13 | static void handleArgCountMismatch(Object *, intptr_t, ThreadState *); 14 | static void handleUserError(Object *, ThreadState *); 15 | static void handleStackOvf(ThreadState *); 16 | 17 | // GC 18 | static void collectAndAlloc(ThreadState *ts); 19 | 20 | // Debug 21 | static void traceObject(Object *); 22 | static intptr_t endOfCode(intptr_t); 23 | 24 | // Library 25 | static void printNewLine(int fd); 26 | }; 27 | 28 | struct Option { 29 | static Option &global(); 30 | static void init(); 31 | 32 | bool kTailCallOpt; 33 | bool kInitialized; 34 | bool kInsertStackCheck; 35 | bool kLogInfo; 36 | }; 37 | 38 | #endif 39 | -------------------------------------------------------------------------------- /scheme-src/alloc-perf.ss: -------------------------------------------------------------------------------- 1 | 2 | (define main 3 | (lambda () 4 | (alloc-loop 10000000))) 5 | 6 | (define alloc-loop 7 | (lambda (n) 8 | (cons# 1 2) 9 | (if (<# n 0) 0 10 | (alloc-loop (-# n 1))))) 11 | 12 | -------------------------------------------------------------------------------- /scheme-src/begin.ss: -------------------------------------------------------------------------------- 1 | 2 | (define main 3 | (lambda () 4 | (begin 5 | (trace# 1 1) 6 | 2))) 7 | 8 | -------------------------------------------------------------------------------- /scheme-src/bug/1.ss: -------------------------------------------------------------------------------- 1 | (define prn 2 | (lambda (x) 3 | (display# x) 4 | (newline#))) 5 | 6 | (define main 7 | (lambda () 8 | (prn 'in-main) 9 | (append '() '(4 5 6)))) 10 | 11 | (define append 12 | (lambda (xs ys) 13 | (prn 'in-append) 14 | (prn xs) 15 | (prn ys) 16 | (prn (null?# xs)) 17 | (prn (null?# ys)) 18 | (if (null?# xs) 19 | (trace# 'ys ys) 20 | (trace# 'cons# (cons# (trace# 'car# (car# (trace# 'get-xs xs))) 21 | (append (cdr# xs) ys)))))) 22 | 23 | -------------------------------------------------------------------------------- /scheme-src/define.ss: -------------------------------------------------------------------------------- 1 | 2 | (define main 3 | (lambda () 4 | (define a 1) 5 | (define b 2) 6 | (trace# b a))) 7 | 8 | -------------------------------------------------------------------------------- /scheme-src/fibo-call-proc.ss: -------------------------------------------------------------------------------- 1 | (define main 2 | (lambda () 3 | (display# (fibo 40)) 4 | (newline#))) 5 | 6 | (define + 7 | (lambda (x y) 8 | (if (integer?# x) 9 | (if (integer?# y) 10 | (+# x y) 11 | (error# '+-rhs-is-not-integer)) 12 | (error# '+-lhs-is-not-integer)))) 13 | 14 | (define - 15 | (lambda (x y) 16 | (if (integer?# x) 17 | (if (integer?# y) 18 | (-# x y) 19 | (error# '--rhs-is-not-integer)) 20 | (error# '--lhs-is-not-integer)))) 21 | 22 | (define < 23 | (lambda (x y) 24 | (if (integer?# x) 25 | (if (integer?# y) 26 | (<# x y) 27 | (error# '<-rhs-is-not-integer)) 28 | (error# '<-lhs-is-not-integer)))) 29 | 30 | (define fibo 31 | (lambda (n) 32 | (if (< n 2) 33 | n 34 | (+ (fibo (- n 1)) 35 | (fibo (- n 2)))))) 36 | 37 | -------------------------------------------------------------------------------- /scheme-src/fibo.ss: -------------------------------------------------------------------------------- 1 | (define main 2 | (lambda () 3 | (display# (fibo 40)) 4 | (newline#))) 5 | 6 | (define fibo 7 | (lambda (n) 8 | (if (<# n 2) 9 | n 10 | (+# (fibo (-# n 1)) 11 | (fibo (-# n 2)))))) 12 | 13 | -------------------------------------------------------------------------------- /scheme-src/funcall.ss: -------------------------------------------------------------------------------- 1 | (define main 2 | (lambda () 3 | (add 1 2))) 4 | 5 | (define add 6 | (lambda (x y) 7 | (+# x y))) 8 | 9 | -------------------------------------------------------------------------------- /scheme-src/if.ss: -------------------------------------------------------------------------------- 1 | (define main 2 | (lambda () 3 | (if #t (trace# 1 1) (trace# 2 2)))) 4 | -------------------------------------------------------------------------------- /scheme-src/lib/bug.ss: -------------------------------------------------------------------------------- 1 | 2 | (define getSomeList 3 | (lambda () 4 | '(1 2 3 4 5))) 5 | 6 | (define main 7 | (lambda () 8 | (display# (loop (getSomeList))))) 9 | 10 | (define loop 11 | (lambda (x) 12 | (loop (cons# (car# '(1 2)) '(3 4))))) 13 | 14 | -------------------------------------------------------------------------------- /scheme-src/lib/integer.ss: -------------------------------------------------------------------------------- 1 | (define main 2 | (lambda () 3 | (display# (< 5 'a)) 4 | (newline#))) 5 | 6 | (define + 7 | (lambda (x y) 8 | (if (integer?# x) 9 | (if (integer?# y) 10 | (+# x y) 11 | (error# '+-rhs-is-not-integer)) 12 | (error# '+-lhs-is-not-integer)))) 13 | 14 | (define - 15 | (lambda (x y) 16 | (if (integer?# x) 17 | (if (integer?# y) 18 | (-# x y) 19 | (error# '--rhs-is-not-integer)) 20 | (error# '--lhs-is-not-integer)))) 21 | 22 | (define < 23 | (lambda (x y) 24 | (if (integer?# x) 25 | (if (integer?# y) 26 | (<# x y) 27 | (error# (tag 'not-an-integer y))) 28 | (error# (tag 'not-an-integer x))))) 29 | 30 | (define car 31 | (lambda (xs) 32 | (if (pair?# xs) 33 | (car# xs) 34 | (error# (tag 'not-a-pair xs))))) 35 | 36 | (define tag 37 | (lambda (x y) 38 | (cons# x (cons# y '())))) 39 | 40 | -------------------------------------------------------------------------------- /scheme-src/lib/lists.ss: -------------------------------------------------------------------------------- 1 | (define getSomeList 2 | (lambda () 3 | '(1 2 3 4 5))) 4 | 5 | (define reverse 6 | (lambda (xs) 7 | (reverse' xs '()))) 8 | 9 | (define reverse' 10 | (lambda (in out) 11 | (if (null?# in) 12 | out 13 | (reverse' (cdr in) (cons# (car# in) out))))) 14 | 15 | (define cdr 16 | (lambda (xs) 17 | (if (pair?# xs) 18 | (cdr# xs) 19 | (error# 'cdr-not-a-pair)))) 20 | 21 | (define main 22 | (lambda () 23 | (display# (reverse (getSomeList))))) 24 | 25 | -------------------------------------------------------------------------------- /scheme-src/loopsum.ss: -------------------------------------------------------------------------------- 1 | (define main 2 | (lambda () 3 | (trace# (loopsum 0 100000 0) 4 | 0))) 5 | 6 | (define loopsum 7 | (lambda (start end s) 8 | (if (<# start end) 9 | (loopsum (+# start 1) end (+# start s)) 10 | s))) 11 | 12 | -------------------------------------------------------------------------------- /scheme-src/myif.ss: -------------------------------------------------------------------------------- 1 | (define main 2 | (lambda () 3 | (myif 1 2 3))) 4 | 5 | (define myif 6 | (lambda (x y z) 7 | (if (<# x y) (+# z y) z))) 8 | 9 | -------------------------------------------------------------------------------- /scheme-src/neg-prim-sub.ss: -------------------------------------------------------------------------------- 1 | 2 | (define main 3 | (lambda () 4 | (-# (-# 1 2) 3))) 5 | -------------------------------------------------------------------------------- /scheme-src/prim-add.ss: -------------------------------------------------------------------------------- 1 | (define main 2 | (lambda () 3 | (<# 0 (+# 1 2)))) 4 | -------------------------------------------------------------------------------- /scheme-src/prim-car.ss: -------------------------------------------------------------------------------- 1 | (define main 2 | (lambda () 3 | (trace# (car# (cons# 1 2)) 0))) 4 | 5 | -------------------------------------------------------------------------------- /scheme-src/prim-cons.ss: -------------------------------------------------------------------------------- 1 | (define main 2 | (lambda () 3 | (trace# (cons# 2 (cons# 1 (quote ()))) 4 | 0))) 5 | 6 | -------------------------------------------------------------------------------- /scheme-src/prim-display.ss: -------------------------------------------------------------------------------- 1 | 2 | (define main 3 | (lambda () 4 | (display# 123) 5 | (newline#))) 6 | 7 | -------------------------------------------------------------------------------- /scheme-src/prim-error-inner.ss: -------------------------------------------------------------------------------- 1 | (define main 2 | (lambda () 3 | (inner-error 0))) 4 | 5 | (define id 6 | (lambda (x) 7 | x)) 8 | 9 | (define inner-error 10 | (lambda (n) 11 | (if (<# n 10) 12 | (inner-error (+# n 1)) 13 | (error# (quote oops))))) 14 | 15 | -------------------------------------------------------------------------------- /scheme-src/prim-error.ss: -------------------------------------------------------------------------------- 1 | 2 | (define main 3 | (lambda () 4 | (error# (quote hello-world)))) 5 | 6 | -------------------------------------------------------------------------------- /scheme-src/prim-intp.ss: -------------------------------------------------------------------------------- 1 | (define main 2 | (lambda () 3 | (trace# (integer?# 1) 4 | (trace# (integer?# main) 5 | 0)))) 6 | 7 | -------------------------------------------------------------------------------- /scheme-src/prim-lt.ss: -------------------------------------------------------------------------------- 1 | (define main 2 | (lambda () 3 | (<# 1 2))) 4 | 5 | -------------------------------------------------------------------------------- /scheme-src/prim-nullp.ss: -------------------------------------------------------------------------------- 1 | (define main 2 | (lambda () 3 | (trace# (null?# (cons# 1 2)) 4 | (trace# (null?# (quote ())) 0)))) 5 | 6 | -------------------------------------------------------------------------------- /scheme-src/prim-pairp.ss: -------------------------------------------------------------------------------- 1 | (define main 2 | (lambda () 3 | (trace# (pair?# (cons# 1 2)) 4 | (trace# (pair?# 1) 0)))) 5 | -------------------------------------------------------------------------------- /scheme-src/prim-sub.ss: -------------------------------------------------------------------------------- 1 | (define main 2 | (lambda () 3 | (-# 3 2))) 4 | 5 | -------------------------------------------------------------------------------- /scheme-src/prim-trace.ss: -------------------------------------------------------------------------------- 1 | 2 | (define foo 3 | (lambda () 0)) 4 | 5 | (define main 6 | (lambda () 7 | (trace# 1 8 | (trace# 2 9 | (trace# 3 4))))) 10 | 11 | -------------------------------------------------------------------------------- /scheme-src/quote.ss: -------------------------------------------------------------------------------- 1 | (define main 2 | (lambda () 3 | (trace# '(1 2 3) 0))) 4 | 5 | (define bar 6 | (lambda () 7 | (quote 4))) 8 | 9 | -------------------------------------------------------------------------------- /scheme-src/recur-bug.ss: -------------------------------------------------------------------------------- 1 | (define main 2 | (lambda () 3 | (loopPrint 0 10 1))) 4 | 5 | (define loopPrint 6 | (lambda (start end x) 7 | (if (<# start end) 8 | (trace# x (loopPrint (+# start 1) end x)) 9 | 0))) 10 | 11 | -------------------------------------------------------------------------------- /scheme-src/return-one.ss: -------------------------------------------------------------------------------- 1 | (define main 2 | (lambda () 1)) 3 | 4 | -------------------------------------------------------------------------------- /scheme-src/sete.ss: -------------------------------------------------------------------------------- 1 | (define display 2 | (lambda (x) 3 | (trace# x 0))) 4 | 5 | (define main 6 | (lambda () 7 | (define a 1) 8 | (display a) 9 | (set! a 2) 10 | (display a) 11 | (set! main 5) 12 | (display main) 13 | (main))) 14 | 15 | -------------------------------------------------------------------------------- /scheme-src/test-framedescr.ss: -------------------------------------------------------------------------------- 1 | 2 | (define main 3 | (lambda () (main))) 4 | 5 | -------------------------------------------------------------------------------- /scheme-src/test-gc-loop.ss: -------------------------------------------------------------------------------- 1 | (define main 2 | (lambda () 3 | (loopAlloc 0))) 4 | 5 | (define loopAlloc 6 | (lambda (n) 7 | (cons# 1 2) 8 | (if (<# 1000 n) 9 | (begin 10 | (trace# n (loopAlloc 0))) 11 | (loopAlloc (+# n 1))))) 12 | 13 | -------------------------------------------------------------------------------- /scheme-src/test-gc.ss: -------------------------------------------------------------------------------- 1 | (define main 2 | (lambda () 3 | (consumeSomeStack 10))) 4 | 5 | (define consumeSomeStack 6 | (lambda (n) 7 | (if (<# n 0) 8 | (plainLoop) 9 | (begin 10 | (consumeSomeStack (-# n 1)) 11 | 0)))) 12 | 13 | (define plainLoop 14 | (lambda () 15 | (cons# 1 2) 16 | (plainLoop))) 17 | 18 | -------------------------------------------------------------------------------- /scheme-src/test-parse.ss: -------------------------------------------------------------------------------- 1 | 1 2 | 2 3 | 3 4 | -------------------------------------------------------------------------------- /test-gc.cpp: -------------------------------------------------------------------------------- 1 | #include "gc.hpp" 2 | #include "object.hpp" 3 | #include "util.hpp" 4 | #include "codegen2.hpp" 5 | 6 | int main() { 7 | Handle a = Object::internSymbol("a"); 8 | Handle a2 = Object::internSymbol("a"); 9 | Handle b = Object::internSymbol("b"); 10 | Handle c = Object::internSymbol("c"); 11 | 12 | Module mod; 13 | 14 | intptr_t a_i, b_i, c_i; 15 | a_i = mod.addName(a, a); 16 | b_i = mod.addName(b, b); 17 | c_i = mod.addName(c, c); 18 | 19 | printf("%ld %ld %ld\n", a_i, b_i, c_i); 20 | 21 | mod.getRoot()->displayDetail(2); 22 | 23 | return 0; 24 | } 25 | 26 | -------------------------------------------------------------------------------- /util.cpp: -------------------------------------------------------------------------------- 1 | #include "util.hpp" 2 | #include "object.hpp" 3 | 4 | namespace Util { 5 | 6 | void logPtr(const char *wat, void *x, int fd) { 7 | dprintf(fd, "[%s] %p\n", wat, x); 8 | } 9 | 10 | void logObj(const char *wat, Object *x, int fd) { 11 | dprintf(fd, "[%s] ", wat); 12 | x->displayDetail(fd); 13 | dprintf(fd, "\n"); 14 | } 15 | 16 | Object *newAssocList() { 17 | // ((key . val) (key2 . val2)) 18 | return Object::newNil(); 19 | } 20 | 21 | intptr_t assocLength(const Handle &assoc) { 22 | Handle iter = assoc; 23 | intptr_t i = 0; 24 | while (!iter->isNil()) { 25 | iter = iter->raw()->cdr(); 26 | ++i; 27 | } 28 | return i; 29 | } 30 | 31 | static Object *assocLookupEntry(const Handle &assoc, const Handle &key, 32 | EqFunc eqf) { 33 | for (Handle iter = assoc; !iter->isNil(); iter = iter->raw()->cdr()) { 34 | Handle entry = iter->raw()->car(); 35 | if (eqf == kSymbolEq) { 36 | if (strcmp(key->rawSymbol(), entry->raw()->car()->rawSymbol()) == 0) { 37 | return entry.getPtr(); 38 | } 39 | } 40 | else if (eqf == kPtrEq) { 41 | if (key.getPtr() == entry->raw()->car()) { 42 | return entry.getPtr(); 43 | } 44 | } 45 | } 46 | return NULL; 47 | } 48 | 49 | Object *assocLookup(const Handle &assoc, const Handle &key, 50 | EqFunc eqf, bool *ok) { 51 | Handle entry = assocLookupEntry(assoc, key, eqf); 52 | if (entry.getPtr() == NULL) { 53 | if (ok) *ok = false; 54 | return NULL; 55 | } 56 | else { 57 | if (ok) *ok = true; 58 | return entry->raw()->cdr(); 59 | } 60 | } 61 | 62 | Object *assocLookupKey(const Handle &assoc, const Handle &key, 63 | EqFunc eqf, bool *ok) { 64 | Handle entry = assocLookupEntry(assoc, key, eqf); 65 | if (entry.getPtr() == NULL) { 66 | if (ok) *ok = false; 67 | return NULL; 68 | } 69 | else { 70 | if (ok) *ok = true; 71 | return entry->raw()->car(); 72 | } 73 | } 74 | 75 | Object *assocInsert(const Handle &assoc, const Handle &key, 76 | const Handle &val, EqFunc eqf) { 77 | Handle entry = assocLookupEntry(assoc, key, eqf); 78 | if (entry.getPtr() == NULL) { 79 | Handle newEntry = Object::newPair(key, val); 80 | return Object::newPair(newEntry, assoc); 81 | } 82 | else { 83 | entry->raw()->cdr() = val.getPtr(); 84 | return assoc.getPtr(); 85 | } 86 | } 87 | 88 | Object *newGrowableArray() { 89 | // ((# 1 2 3 () ()) . 3) 90 | Handle vec = Object::newVector(0, NULL); 91 | return Object::newPair(vec, Object::newFixnum(0)); 92 | } 93 | 94 | void arrayAppend(const Handle &arr, const Handle &item) { 95 | Handle vec = arr->raw()->car(); 96 | intptr_t size = vec->raw()->vectorSize(); 97 | intptr_t nextIx = arr->raw()->cdr()->fromFixnum(); 98 | if (nextIx < size) { 99 | vec->raw()->vectorAt(nextIx) = item.getPtr(); 100 | arr->raw()->cdr() = Object::newFixnum(nextIx + 1); 101 | } 102 | else { 103 | // Resize 104 | intptr_t newSize = size * 2 + 1; 105 | Handle newVec = Object::newVector(newSize, Object::newNil()); 106 | for (intptr_t i = 0; i < size; ++i) { 107 | newVec->raw()->vectorAt(i) = vec->raw()->vectorAt(i); 108 | } 109 | arr->raw()->car() = newVec.getPtr(); 110 | 111 | // Try again 112 | arrayAppend(arr, item); 113 | } 114 | } 115 | 116 | Object *&arrayAt(const Handle &arr, intptr_t ix) { 117 | intptr_t len = arr->raw()->cdr()->fromFixnum(); 118 | if (ix < 0) { 119 | ix += len; 120 | if (ix < 0) { 121 | ix = 0; 122 | } 123 | } 124 | 125 | return arr->raw()->car()->raw()->vectorAt(ix); 126 | } 127 | 128 | intptr_t arrayLength(const Handle &arr) { 129 | return arr->raw()->cdr()->fromFixnum(); 130 | } 131 | 132 | Object *arrayToVector(const Handle &arr) { 133 | intptr_t len = Util::arrayLength(arr); 134 | Handle vec = Object::newVector(len, Object::newNil()); 135 | for (intptr_t i = 0; i < len; ++i) { 136 | vec->raw()->vectorAt(i) = Util::arrayAt(arr, i); 137 | } 138 | return vec; 139 | } 140 | 141 | } 142 | -------------------------------------------------------------------------------- /util.hpp: -------------------------------------------------------------------------------- 1 | #ifndef UTIL_HPP 2 | #define UTIL_HPP 3 | 4 | #include 5 | #include 6 | 7 | class Object; 8 | class Handle; 9 | 10 | namespace Util { 11 | 12 | template 13 | intptr_t align(intptr_t orig) { 14 | uintptr_t mask = -1, 15 | unmasked; 16 | mask <<= Bits; 17 | mask = ~mask; 18 | if ((unmasked = orig & mask)) { 19 | orig += (1 << Bits) - unmasked; 20 | } 21 | return orig; 22 | } 23 | 24 | void logObj(const char *wat, Object *x, int fd = 2); 25 | void logPtr(const char *wat, void *x, int fd = 2); 26 | 27 | template 28 | bool isAligned(intptr_t orig) { 29 | return align(orig) == orig; 30 | } 31 | 32 | // AssocList and growable array 33 | 34 | enum EqFunc { 35 | kSymbolEq, 36 | kPtrEq 37 | }; 38 | 39 | Object *newAssocList(); 40 | Object *assocLookup(const Handle &assoc, const Handle &key, 41 | EqFunc eqf, bool *ok = NULL); 42 | Object *assocLookupKey(const Handle &assoc, const Handle &key, 43 | EqFunc eqf, bool *ok = NULL); 44 | Object *assocInsert(const Handle &assoc, const Handle &key, 45 | const Handle &val, EqFunc eqf); 46 | intptr_t assocLength(const Handle &assoc); 47 | 48 | Object *newGrowableArray(); 49 | void arrayAppend(const Handle &arr, const Handle &item); 50 | 51 | // Can use negative index 52 | Object *&arrayAt(const Handle &arr, intptr_t ix); 53 | 54 | intptr_t arrayLength(const Handle &arr); 55 | 56 | // Trim unused parts 57 | Object *arrayToVector(const Handle &arr); 58 | 59 | } 60 | 61 | #endif 62 | --------------------------------------------------------------------------------