diff --git a/rir/src/compiler/analysis/scope.cpp b/rir/src/compiler/analysis/scope.cpp index 6d8fa0d72..dd05f052f 100644 --- a/rir/src/compiler/analysis/scope.cpp +++ b/rir/src/compiler/analysis/scope.cpp @@ -18,7 +18,7 @@ void ScopeAnalysis::lookup(Value* v, const LoadMaybe& action, if (ld->pos < args.size()) return lookup(args[ld->pos], action, notFound); - // If the this is a call instruction or force we might have some result + // If this is a call instruction or force we might have some result // value from the inter-procedural analysis. // Since the "returnValues" and the "cache" are indexed by SSA variables, // they are always valid, even if "state" does not correspond with the diff --git a/rir/src/compiler/native/lower_function_llvm.cpp b/rir/src/compiler/native/lower_function_llvm.cpp index 2c3bb9019..c315ae1fc 100644 --- a/rir/src/compiler/native/lower_function_llvm.cpp +++ b/rir/src/compiler/native/lower_function_llvm.cpp @@ -2112,6 +2112,7 @@ void LowerFunctionLLVM::compile() { stack({container(paramCode())}); additionalStackSlots++; } + { SmallSet> bindings; Visitor::run(code->entry, [&](Instruction* i) { diff --git a/rir/src/compiler/opt/force_dominance.cpp b/rir/src/compiler/opt/force_dominance.cpp index dcc0d4e9d..6e2154316 100644 --- a/rir/src/compiler/opt/force_dominance.cpp +++ b/rir/src/compiler/opt/force_dominance.cpp @@ -192,6 +192,7 @@ bool ForceDominance::apply(Compiler&, ClosureVersion* cls, Code* code, Value* eager = mkarg->eagerArg(); f->replaceUsesWith(eager); next = bb->remove(ip); + } else if (toInline.count(f)) { anyChange = true; Promise* prom = mkarg->prom(); diff --git a/rir/src/compiler/rir2pir/rir2pir.cpp b/rir/src/compiler/rir2pir/rir2pir.cpp index e157fedc8..8442298f0 100644 --- a/rir/src/compiler/rir2pir/rir2pir.cpp +++ b/rir/src/compiler/rir2pir/rir2pir.cpp @@ -815,7 +815,7 @@ bool Rir2Pir::compileBC(const BC& bc, Opcode* pos, Opcode* nextPos, break; } - // Specialcase for calling usemethod, the first argument is eager. + // Specialcase for calling UseMethod, the first argument is eager. // This helps determine the object type of the caller. { auto dt = DispatchTable::unpack(BODY(ti.monomorphic)); diff --git a/rir/src/interpreter/interp.cpp b/rir/src/interpreter/interp.cpp index 7e25478d7..4992eda40 100644 --- a/rir/src/interpreter/interp.cpp +++ b/rir/src/interpreter/interp.cpp @@ -34,41 +34,40 @@ static SEXP evalRirCode(Code* c, SEXP env, const CallContext* callContext, Opcode* initialPc = nullptr, BindingCache* cache = nullptr); +void printStack(int n) { + int sz = ostack_length(); + std::cout << "ostack (length = " << sz << ")\n"; + if (n > sz) + n = sz; + for (int i = n; i > 0; i--) { + auto cell = ostack_cell_at(i - 1); + auto sexp = cell->u.sxpval; + std::cout << "* ostack[" << (sz - i) << "] = "; + if (cell->tag == 0 && sexp) { + std::cout << Print::dumpSexp(sexp, 100); + } else { + std::cout << "{ tag = " << cell->tag << ", flags = " << cell->flags + << ", u = { ival = " << cell->u.ival + << ", dval = " << cell->u.dval << ", sxpval = " << sexp + << " } }"; + } + std::cout << "\n"; + } + std::cout.flush(); +} + // #define PRINT_INTERP // #define PRINT_STACK_SIZE 10 #ifdef PRINT_INTERP static void printInterp(Opcode* pc, Code* c) { #ifdef PRINT_STACK_SIZE -#define INTSEQSXP 9999 // Prevent printing instructions (and recursing) while printing stack static bool printingStackSize = false; if (printingStackSize) return; - // Print stack printingStackSize = true; - std::cout << "#; Stack:\n"; - for (int i = 0;; i++) { - auto typ = ostack_cell_at(i)->tag; - SEXP sexp = ostack_at(i); - if (sexp == nullptr || ostack_length() - i == 0) - break; - else if (i == PRINT_STACK_SIZE) { - std::cout << " ...\n"; - break; - } - if (typ == 0) { - std::cout << " >>> " << Print::dumpSexp(sexp) << " <<<\n"; - } else if (typ == INTSXP || typ == LGLSXP) { - std::cout << " int/lgl >>> " << ostack_cell_at(i)->u.ival - << " <<<\n"; - } else if (typ == REALSXP) { - std::cout << " real >>> " << ostack_cell_at(i)->u.dval - << " <<<\n"; - } else if (typ == INTSEQSXP) { - std::cout << " intseq >>> " << Print::dumpSexp(sexp) << " <<<\n"; - } - } + printStack(PRINT_STACK_SIZE); printingStackSize = false; #endif // Print source @@ -82,7 +81,6 @@ static void printInterp(Opcode* pc, Code* c) { std::cout << "#"; bc.print(std::cout); } - static void printLastop() { std::cout << "> lastop\n"; } #endif @@ -276,27 +274,27 @@ static void __listAppend(SEXP* front, SEXP* last, SEXP value, SEXP name) { #pragma GCC diagnostic ignored "-Wcast-align" SEXP materialize(SEXP wrapper) { - SEXP res = nullptr; - RCNTXT* cur = (RCNTXT*)R_GlobalContext; + if (auto lazyArgs = LazyArglist::check(wrapper)) { - res = lazyArgs->createArglist(); + auto res = lazyArgs->createArglist(); // Fixup the contexts chain - while (cur) { + for (auto cur = (RCNTXT*)R_GlobalContext; cur; cur = cur->nextcontext) { if (cur->promargs == wrapper) cur->promargs = res; - cur = cur->nextcontext; } - } else if (auto lazyEnv = LazyEnvironment::check(wrapper)) { - assert(!lazyEnv->materialized()); + return res; + } + if (auto lazyEnv = LazyEnvironment::check(wrapper)) { + assert(!lazyEnv->materialized()); PROTECT(wrapper); - SEXP arglist = R_NilValue; + auto arglist = R_NilValue; auto names = lazyEnv->names; for (size_t i = 0; i < lazyEnv->nargs; ++i) { - SEXP val = lazyEnv->getArg(i); + auto val = lazyEnv->getArg(i); if (val == R_UnboundValue) continue; - SEXP name = cp_pool_at(names[i]); + auto name = cp_pool_at(names[i]); if (TYPEOF(name) == LISTSXP) name = CAR(name); // cons protects its args if needed @@ -308,29 +306,29 @@ SEXP materialize(SEXP wrapper) { SET_MISSING(arglist, 2); } auto parent = lazyEnv->getParent(); - res = Rf_NewEnvironment(R_NilValue, arglist, parent); + auto res = Rf_NewEnvironment(R_NilValue, arglist, parent); + PROTECT(res); lazyEnv->materialized(res); // Make sure wrapper is not collected by the gc (we may still use it to // access the materialized env) Rf_setAttrib(res, symbol::delayedEnv, wrapper); lazyEnv->clear(); // Fixup the contexts chain - while (cur) { + for (auto cur = (RCNTXT*)R_GlobalContext; cur; cur = cur->nextcontext) { if (cur->cloenv == wrapper) cur->cloenv = res; if (cur->sysparent == wrapper) cur->sysparent = res; - cur = cur->nextcontext; } if (LazyEnvironment::check(parent)) { parent = materialize(parent); SET_ENCLOS(res, parent); } - - UNPROTECT(1); + UNPROTECT(2); + return res; } - assert(res); - return res; + + assert(false); } SEXP materializeCallerEnv(CallContext& callCtx) { @@ -1590,6 +1588,8 @@ void deoptFramesWithContext(const CallContext* callCtxt, if (auto le = LazyEnvironment::check(deoptEnv)) { assert(!le->materialized()); deoptEnv = materialize(deoptEnv); + // Still need to set the cloenv because materialize only patches the + // context list starting with R_GlobalContext cntxt->cloenv = deoptEnv; } assert(TYPEOF(deoptEnv) == ENVSXP); diff --git a/rir/tests/pir_regression_missing.R b/rir/tests/pir_regression_missing.R index ff5a6c165..e99b5c12a 100644 --- a/rir/tests/pir_regression_missing.R +++ b/rir/tests/pir_regression_missing.R @@ -95,7 +95,7 @@ xx3 <- function() { g() } -for (i in 1:10) +for (i in 1:1000) {xx1(); xx2(); xx3()} @@ -111,3 +111,21 @@ stopifnot(g()==1) pir.compile(g) stopifnot(g()==1) + + +f <- function() forceAndCall(1, function(zzz) missing(zzz), quote(expr=)) +for (i in 1:1000) + stopifnot(f() == FALSE) + +f <- function() forceAndCall(1, function(zzz) zzz, quote(expr=)) +for (i in 1:1000) + stopifnot(identical(f(), quote(expr=))) + +x <- as.list(function(y) 42) +f <- function() forceAndCall(1, function(zzz) missing(zzz), x[[1]]) +for (i in 1:1000) + stopifnot(f() == FALSE) + +f <- function() forceAndCall(1, function(zzz) zzz, x[[1]]) +for (i in 1:1000) + stopifnot(identical(f(), quote(expr=)))