static LLVMValueRef tuple_is(compile_t* c, ast_t* left_type, ast_t* right_type,
LLVMValueRef l_value, LLVMValueRef r_value)
{
pony_assert(ast_id(left_type) == TK_TUPLETYPE);
pony_assert(ast_id(right_type) == TK_TUPLETYPE);
pony_assert(ast_childcount(left_type) == ast_childcount(right_type));
// Pairwise comparison.
LLVMBasicBlockRef this_block = LLVMGetInsertBlock(c->builder);
LLVMBasicBlockRef post_block = codegen_block(c, "post");
// Set up the phi node.
LLVMPositionBuilderAtEnd(c->builder, post_block);
LLVMValueRef phi = LLVMBuildPhi(c->builder, c->i1, "");
ast_t* left_child = ast_child(left_type);
ast_t* right_child = ast_child(right_type);
int i = 0;
while(left_child != NULL)
{
// Set up the next block.
LLVMBasicBlockRef next_block = codegen_block(c, "next");
LLVMPositionBuilderAtEnd(c->builder, this_block);
// Test the element.
LLVMValueRef l_elem = LLVMBuildExtractValue(c->builder, l_value, i, "");
LLVMValueRef r_elem = LLVMBuildExtractValue(c->builder, r_value, i, "");
LLVMValueRef test = gen_is_value(c, left_child, right_child, l_elem,
r_elem);
// If false, go directly to the post block.
LLVMBuildCondBr(c->builder, test, next_block, post_block);
LLVMBasicBlockRef current_block = LLVMGetInsertBlock(c->builder);
LLVMAddIncoming(phi, &test, ¤t_block, 1);
// Point to the next block.
this_block = next_block;
left_child = ast_sibling(left_child);
right_child = ast_sibling(right_child);
i++;
}
// The last block is reached if every element returns true. Jump directly to
// the post block.
LLVMPositionBuilderAtEnd(c->builder, this_block);
LLVMBuildBr(c->builder, post_block);
LLVMPositionBuilderAtEnd(c->builder, post_block);
LLVMValueRef one = LLVMConstInt(c->i1, 1, false);
LLVMAddIncoming(phi, &one, &this_block, 1);
return phi;
}
LLVMValueRef build_recv_stritem_len(
struct llvm_ctx *ctx,
LLVMValueRef *nullpos_p,
LLVMValueRef tpos)
{
LLVMValueRef args[2] = { ctx->utcb, tpos };
LLVMValueRef agg = LLVMBuildCall(ctx->builder,
get_stritem_len_fn(ctx), args, 2, "stritemlen.rval");
LLVMSetTailCall(agg, 1);
*nullpos_p = LLVMBuildExtractValue(ctx->builder, agg, 0,
"stritemlen.rval.len");
return LLVMBuildExtractValue(ctx->builder, agg, 1,
"stritemlen.rval.new.tpos");
}
LLVMValueRef gendesc_fieldptr(compile_t* c, LLVMValueRef ptr,
LLVMValueRef field_info)
{
LLVMValueRef offset = LLVMBuildExtractValue(c->builder, field_info, 0, "");
offset = LLVMBuildZExt(c->builder, offset, c->intptr, "");
return LLVMBuildInBoundsGEP(c->builder, ptr, &offset, 1, "");
}
LLVMValueRef build_l4_ipc_call(
struct llvm_ctx *ctx,
LLVMValueRef arg_to,
LLVMValueRef arg_timeouts,
LLVMValueRef arg_fromspec,
LLVMValueRef arg_mr0,
LLVMValueRef *from_p,
LLVMValueRef *mr1_p,
LLVMValueRef *mr2_p)
{
LLVMTypeRef params[5];
for(int i=0; i<5; i++) params[i] = ctx->wordt;
LLVMTypeRef ipc_result_type = LLVMStructTypeInContext(ctx->ctx,
params, 4, 0);
LLVMTypeRef ipc_type = LLVMFunctionType(ipc_result_type,
params, 5, 0);
LLVMValueRef fn = LLVMConstInlineAsm(ipc_type,
/* NOTE: this compensates against LLVM 3.3's inability to save %ebp
* over an asm statement. clearly a bug, but w/e.
*
* it's been around since at least LLVM 3.2.
*/
" pushl %ebp\n"
"\tcall __L4_Ipc\n"
"\tmovl %ebp, %ecx\n"
"\tpopl %ebp\n",
"={ax},={si},={bx},={cx},{ax},{cx},{dx},{si},{di},~{dirflag},~{fpsr},~{flags}",
1, 0);
LLVMValueRef args[5] = {
arg_to, arg_timeouts, arg_fromspec, arg_mr0,
LLVMBuildPtrToInt(ctx->builder, ctx->utcb, ctx->wordt,
"l4ipc.utcb"),
};
LLVMValueRef result = LLVMBuildCall(ctx->builder, fn, args, 5, "l4ipc");
LLVMSetTailCall(result, 1);
if(from_p != NULL) {
*from_p = LLVMBuildExtractValue(ctx->builder, result, 0, "from");
}
if(mr1_p != NULL) {
*mr1_p = LLVMBuildExtractValue(ctx->builder, result, 2, "mr1");
}
if(mr2_p != NULL) {
*mr2_p = LLVMBuildExtractValue(ctx->builder, result, 3, "mr2");
}
return LLVMBuildExtractValue(ctx->builder, result, 1, "mr0");
}
static LLVMValueRef make_tupleelemptr(compile_t* c, LLVMValueRef l_value,
ast_t* l_type, ast_t* right)
{
pony_assert(ast_id(l_type) == TK_TUPLETYPE);
int index = (int)ast_int(right)->low;
return LLVMBuildExtractValue(c->builder, l_value, index, "");
}
static LLVMValueRef gen_digestof_value(compile_t* c, LLVMValueRef value)
{
LLVMTypeRef type = LLVMTypeOf(value);
switch(LLVMGetTypeKind(type))
{
case LLVMFloatTypeKind:
value = LLVMBuildBitCast(c->builder, value, c->i32, "");
return LLVMBuildZExt(c->builder, value, c->i64, "");
case LLVMDoubleTypeKind:
return LLVMBuildBitCast(c->builder, value, c->i64, "");
case LLVMIntegerTypeKind:
{
uint32_t width = LLVMGetIntTypeWidth(type);
if(width < 64)
{
value = LLVMBuildZExt(c->builder, value, c->i64, "");
} else if(width == 128) {
LLVMValueRef shift = LLVMConstInt(c->i128, 64, false);
LLVMValueRef high = LLVMBuildLShr(c->builder, value, shift, "");
high = LLVMBuildTrunc(c->builder, high, c->i64, "");
value = LLVMBuildTrunc(c->builder, value, c->i64, "");
value = LLVMBuildXor(c->builder, value, high, "");
}
return value;
}
case LLVMStructTypeKind:
{
uint32_t count = LLVMCountStructElementTypes(type);
LLVMValueRef result = LLVMConstInt(c->i64, 0, false);
for(uint32_t i = 0; i < count; i++)
{
LLVMValueRef elem = LLVMBuildExtractValue(c->builder, value, i, "");
elem = gen_digestof_value(c, elem);
result = LLVMBuildXor(c->builder, result, elem, "");
}
return result;
}
case LLVMPointerTypeKind:
return LLVMBuildPtrToInt(c->builder, value, c->i64, "");
default: {}
}
assert(0);
return NULL;
}
static bool trace_elements(compile_t* c, gentype_t* g, LLVMValueRef tuple)
{
bool need_trace = false;
for(int i = 0; i < g->field_count; i++)
{
LLVMValueRef value = LLVMBuildExtractValue(c->builder, tuple, i, "");
need_trace |= gentrace(c, value, g->fields[i]);
}
return need_trace;
}
static bool assign_tuple(compile_t* c, ast_t* left, ast_t* r_type,
LLVMValueRef r_value)
{
// Handle assignment for each component.
ast_t* child = ast_child(left);
ast_t* rtype_child = ast_child(r_type);
int i = 0;
while(child != NULL)
{
ast_t* expr = NULL;
switch(ast_id(child))
{
case TK_SEQ:
// The actual tuple expression is inside a sequence node.
expr = ast_child(child);
break;
case TK_LET:
case TK_VAR:
case TK_TUPLE:
expr = child;
break;
case TK_DONTCARE:
// Ignore this element.
break;
default:
assert(0);
}
if(expr != NULL)
{
// Extract the tuple value.
LLVMValueRef rvalue_child = LLVMBuildExtractValue(c->builder, r_value, i,
"");
// Recurse, assigning pairwise.
if(assign_rvalue(c, expr, rtype_child, rvalue_child) == NULL)
return false;
}
i++;
child = ast_sibling(child);
rtype_child = ast_sibling(rtype_child);
}
assert(rtype_child == NULL);
return true;
}
static void trace_tuple(compile_t* c, LLVMValueRef ctx, LLVMValueRef src_value,
LLVMValueRef dst_value, ast_t* src_type, ast_t* dst_type)
{
int i = 0;
// We're a tuple, determined statically.
if(ast_id(dst_type) == TK_TUPLETYPE)
{
ast_t* src_child = ast_child(src_type);
ast_t* dst_child = ast_child(dst_type);
while((src_child != NULL) && (dst_child != NULL))
{
// Extract each element and trace it.
LLVMValueRef elem = LLVMBuildExtractValue(c->builder, dst_value, i, "");
gentrace(c, ctx, elem, elem, src_child, dst_child);
i++;
src_child = ast_sibling(src_child);
dst_child = ast_sibling(dst_child);
}
pony_assert(src_child == NULL && dst_child == NULL);
} else {
// This is a boxed tuple. Trace the box, then handle the elements.
trace_unknown(c, ctx, dst_value, PONY_TRACE_OPAQUE);
// Extract the elements from the original unboxed tuple.
pony_assert(LLVMGetTypeKind(LLVMTypeOf(src_value)) == LLVMStructTypeKind);
ast_t* src_child = ast_child(src_type);
while(src_child != NULL)
{
LLVMValueRef elem = LLVMBuildExtractValue(c->builder, src_value, i, "");
gentrace(c, ctx, elem, elem, src_child, src_child);
i++;
src_child = ast_sibling(src_child);
}
}
}
static void trace_tuple(compile_t* c, LLVMValueRef ctx, LLVMValueRef value,
ast_t* type)
{
int i = 0;
// We're a tuple, determined statically.
for(ast_t* child = ast_child(type);
child != NULL;
child = ast_sibling(child))
{
// Extract each element and trace it.
LLVMValueRef elem = LLVMBuildExtractValue(c->builder, value, i, "");
gentrace(c, ctx, elem, child);
i++;
}
}
static bool static_tuple_from_tuple(compile_t* c, LLVMValueRef value,
ast_t* type, ast_t* pattern, LLVMBasicBlockRef next_block)
{
// The match expression is a tuple. The type checker will have made sure
// it's the right cardinality and each element has a useful type relation
// with the pattern.
assert(LLVMGetTypeKind(LLVMTypeOf(value)) == LLVMStructTypeKind);
// We have a static type.
ast_t* type_child = ast_child(type);
ast_t* pattern_child = ast_child(pattern);
// Destructure the tuple and continue pattern matching on each element.
for(int i = 0; pattern_child != NULL; i++)
{
switch(ast_id(pattern_child))
{
case TK_SEQ:
{
// Skip over the SEQ node.
ast_t* pattern_expr = ast_child(pattern_child);
LLVMValueRef elem = LLVMBuildExtractValue(c->builder, value, i, "");
if(!static_match(c, elem, type_child, pattern_expr, next_block))
return false;
break;
}
case TK_DONTCARE:
// Ignore the element.
break;
default: assert(0);
}
type_child = ast_sibling(type_child);
pattern_child = ast_sibling(pattern_child);
}
assert(type_child == NULL);
return true;
}
static LLVMValueRef make_fieldptr(compile_t* c, LLVMValueRef l_value,
ast_t* l_type, ast_t* right)
{
switch(ast_id(l_type))
{
case TK_NOMINAL:
{
assert(ast_id(right) == TK_ID);
ast_t* def = (ast_t*)ast_data(l_type);
ast_t* field = ast_get(def, ast_name(right), NULL);
int index = (int)ast_index(field);
if(ast_id(def) != TK_STRUCT)
index++;
if(ast_id(def) == TK_ACTOR)
index++;
return LLVMBuildStructGEP(c->builder, l_value, index, "");
}
case TK_TUPLETYPE:
{
assert(ast_id(right) == TK_INT);
int index = (int)ast_int(right)->low;
return LLVMBuildExtractValue(c->builder, l_value, index, "");
}
case TK_ARROW:
return make_fieldptr(c, l_value, ast_childidx(l_type, 1), right);
default: {}
}
assert(0);
return NULL;
}
static LLVMValueRef assign_to_tuple(compile_t* c, LLVMTypeRef l_type,
LLVMValueRef r_value, ast_t* type)
{
// Cast each component.
assert(ast_id(type) == TK_TUPLETYPE);
int count = LLVMCountStructElementTypes(l_type);
size_t buf_size = count * sizeof(LLVMTypeRef);
LLVMTypeRef* elements = (LLVMTypeRef*)pool_alloc_size(buf_size);
LLVMGetStructElementTypes(l_type, elements);
LLVMValueRef result = LLVMGetUndef(l_type);
ast_t* type_child = ast_child(type);
int i = 0;
while(type_child != NULL)
{
LLVMValueRef r_child = LLVMBuildExtractValue(c->builder, r_value, i, "");
LLVMValueRef cast_value = gen_assign_cast(c, elements[i], r_child,
type_child);
if(cast_value == NULL)
{
pool_free_size(buf_size, elements);
return NULL;
}
result = LLVMBuildInsertValue(c->builder, result, cast_value, i, "");
type_child = ast_sibling(type_child);
i++;
}
pool_free_size(buf_size, elements);
return result;
}
static LLVMValueRef gen_digestof_value(compile_t* c, ast_t* type,
LLVMValueRef value)
{
LLVMTypeRef impl_type = LLVMTypeOf(value);
switch(LLVMGetTypeKind(impl_type))
{
case LLVMFloatTypeKind:
value = LLVMBuildBitCast(c->builder, value, c->i32, "");
return LLVMBuildZExt(c->builder, value, c->intptr, "");
case LLVMDoubleTypeKind:
value = LLVMBuildBitCast(c->builder, value, c->i64, "");
return gen_digestof_int64(c, value);
case LLVMIntegerTypeKind:
{
uint32_t width = LLVMGetIntTypeWidth(impl_type);
if(width < 64)
{
return LLVMBuildZExt(c->builder, value, c->intptr, "");
} else if(width == 64) {
return gen_digestof_int64(c, value);
} else if(width == 128) {
LLVMValueRef shift = LLVMConstInt(c->i128, 64, false);
LLVMValueRef high = LLVMBuildLShr(c->builder, value, shift, "");
high = LLVMBuildTrunc(c->builder, high, c->i64, "");
value = LLVMBuildTrunc(c->builder, value, c->i64, "");
high = gen_digestof_int64(c, high);
value = gen_digestof_int64(c, value);
return LLVMBuildXor(c->builder, value, high, "");
}
break;
}
case LLVMStructTypeKind:
{
uint32_t count = LLVMCountStructElementTypes(impl_type);
LLVMValueRef result = LLVMConstInt(c->intptr, 0, false);
ast_t* child = ast_child(type);
for(uint32_t i = 0; i < count; i++)
{
LLVMValueRef elem = LLVMBuildExtractValue(c->builder, value, i, "");
elem = gen_digestof_value(c, child, elem);
result = LLVMBuildXor(c->builder, result, elem, "");
child = ast_sibling(child);
}
pony_assert(child == NULL);
return result;
}
case LLVMPointerTypeKind:
if(!is_known(type))
{
reach_type_t* t = reach_type(c->reach, type);
int sub_kind = subtype_kind(t);
if((sub_kind & SUBTYPE_KIND_BOXED) != 0)
return gen_digestof_box(c, t, value, sub_kind);
}
return LLVMBuildPtrToInt(c->builder, value, c->intptr, "");
default: {}
}
pony_assert(0);
return NULL;
}
LLVMValueRef gendesc_fielddesc(compile_t* c, LLVMValueRef field_info)
{
return LLVMBuildExtractValue(c->builder, field_info, 1, "");
}