// Checks whether to fire the next barrier on the way to the given destination.
// If there is a barrier to fire, fire it. Returns false iff a barrier was fired,
// true if we've arrived at the destination.
static bool maybe_fire_next_barrier(code_cache_t *cache, frame_t *frame,
runtime_t *runtime, value_t stack, value_t destination) {
CHECK_DOMAIN(vdDerivedObject, destination);
value_t next_barrier = get_stack_top_barrier(stack);
if (is_same_value(next_barrier, destination)) {
// We've arrived.
return true;
}
// Grab the next barrier's handler.
value_t payload = get_barrier_state_payload(next_barrier);
value_t previous = get_barrier_state_previous(next_barrier);
// Unhook the barrier from the barrier stack.
set_stack_top_barrier(stack, previous);
// Fire the exit action for the handler object.
if (in_genus(dgEnsureSection, next_barrier)) {
// Pop any previous state off the stack. If we've executed any
// code shards before the first will be the result from the shard
// the second will be the shard itself.
frame_pop_value(frame);
frame_pop_value(frame);
// Push the shard onto the stack as the subject since we may need it
// to refract access to outer variables.
frame_push_value(frame, next_barrier);
value_t argmap = ROOT(runtime, array_of_zero);
value_t code_block = payload;
push_stack_frame(runtime, stack, frame,
get_code_block_high_water_mark(code_block), argmap);
frame_set_code_block(frame, code_block);
code_cache_refresh(cache, frame);
} else {
on_derived_object_exit(next_barrier);
}
return false;
}
bool value_identity_compare(value_t a, value_t b) {
if (is_same_value(a, b))
return true;
cycle_detector_t detector;
cycle_detector_init_bottom(&detector);
value_t ptected = value_identity_compare_cycle_protect(a, b, &detector);
return in_condition_cause(ccCircular, ptected) ? false : get_boolean_value(ptected);
}
value_t stack_validate(value_t self) {
VALIDATE_FAMILY(ofStack, self);
VALIDATE_FAMILY(ofStackPiece, get_stack_top_piece(self));
value_t current = get_stack_top_piece(self);
while (!is_nothing(current)) {
value_t stack = get_stack_piece_stack(current);
VALIDATE(is_same_value(stack, self));
current = get_stack_piece_previous(current);
}
return success();
}
static value_t heap_object_identity_compare(value_t a, value_t b,
cycle_detector_t *detector) {
CHECK_DOMAIN(vdHeapObject, a);
CHECK_DOMAIN(vdHeapObject, b);
// Fast case when a and b are the same object.
if (is_same_value(a, b))
return yes();
heap_object_family_t a_family = get_heap_object_family(a);
heap_object_family_t b_family = get_heap_object_family(b);
if (a_family != b_family)
return no();
family_behavior_t *behavior = get_heap_object_family_behavior(a);
return (behavior->identity_compare)(a, b, detector);
}
// Restores the previous state of the interpreter from the given derived
// object's escape state.
static void restore_escape_state(frame_t *frame, value_t stack,
value_t destination) {
value_t target_piece = get_derived_object_host(destination);
if (!is_same_value(target_piece, frame->stack_piece)) {
set_stack_top_piece(stack, target_piece);
open_stack_piece(target_piece, frame);
}
value_t *stack_start = frame_get_stack_piece_bottom(frame);
value_t stack_pointer = get_escape_state_stack_pointer(destination);
frame->stack_pointer = stack_start + get_integer_value(stack_pointer);
value_t frame_pointer = get_escape_state_frame_pointer(destination);
frame->frame_pointer = stack_start + get_integer_value(frame_pointer);
value_t limit_pointer = get_escape_state_limit_pointer(destination);
frame->limit_pointer = stack_start + get_integer_value(limit_pointer);
frame->flags = get_escape_state_flags(destination);
value_t pc = get_escape_state_pc(destination);
frame->pc = get_integer_value(pc);
}
value_t value_identity_compare_cycle_protect(value_t a, value_t b,
cycle_detector_t *detector) {
// First check that they even belong to the same domain. Values can be equal
// across domains.
value_domain_t a_domain = get_value_domain(a);
value_domain_t b_domain = get_value_domain(b);
if (a_domain != b_domain)
return no();
// Then dispatch to the domain equals functions.
switch (a_domain) {
case vdInteger:
case vdCustomTagged:
return new_boolean(is_same_value(a, b));
case vdHeapObject:
return heap_object_identity_compare(a, b, detector);
default:
return no();
}
}
void operation_print_open_on(value_t self, value_t transport,
print_on_context_t *context) {
value_t value = get_operation_value(self);
print_on_context_t unquote_context = *context;
unquote_context.flags |= pfUnquote;
bool is_async = is_same_value(transport, transport_async());
switch (get_operation_type(self)) {
case otAssign:
// Since the operator for the assignment is kind of sort of part of the
// operator let's not decrease depth. If you make an assignment whose
// operator is the assignment itself then 1) this will fail and 2) I hate
// you.
value_print_inner_on(value, &unquote_context, 0);
string_buffer_printf(context->buf, ":=(");
break;
case otCall:
string_buffer_printf(context->buf, "(");
break;
case otIndex:
string_buffer_printf(context->buf, "[");
break;
case otInfix:
string_buffer_printf(context->buf, is_async ? "->" : ".");
value_print_inner_on(value, &unquote_context, -1);
string_buffer_printf(context->buf, "(");
break;
case otPrefix:
value_print_inner_on(value, &unquote_context, -1);
string_buffer_printf(context->buf, "(");
break;
case otSuffix:
string_buffer_printf(context->buf, "(");
break;
default:
UNREACHABLE("unexpected operation type");
break;
}
}
static value_t default_heap_heap_object_identity_compare(value_t a, value_t b,
cycle_detector_t *detector) {
return new_boolean(is_same_value(a, b));
}
