static LLVMMetadataRef make_debug_field(compile_t* c, reach_type_t* t,
uint32_t i)
{
const char* name;
char buf[32];
unsigned flags = 0;
uint64_t offset = 0;
ast_t* ast;
if(t->underlying != TK_TUPLETYPE)
{
ast_t* def = (ast_t*)ast_data(t->ast);
ast_t* members = ast_childidx(def, 4);
ast = ast_childidx(members, i);
name = ast_name(ast_child(ast));
if(is_name_private(name))
flags |= DW_FLAG_Private;
uint32_t extra = 0;
if(t->underlying != TK_STRUCT)
extra++;
if(t->underlying == TK_ACTOR)
extra++;
offset = LLVMOffsetOfElement(c->target_data, t->structure, i + extra);
} else {
snprintf(buf, 32, "_%d", i + 1);
name = buf;
ast = t->ast;
offset = LLVMOffsetOfElement(c->target_data, t->primitive, i);
}
LLVMTypeRef type;
LLVMMetadataRef di_type;
if(t->fields[i].embed)
{
type = t->fields[i].type->structure;
di_type = t->fields[i].type->di_type_embed;
} else {
type = t->fields[i].type->use_type;
di_type = t->fields[i].type->di_type;
}
uint64_t size = LLVMABISizeOfType(c->target_data, type);
uint64_t align = LLVMABIAlignmentOfType(c->target_data, type);
return LLVMDIBuilderCreateMemberType(c->di, c->di_unit, name, t->di_file,
(unsigned)ast_line(ast), 8 * size, 8 * align, 8 * offset, flags, di_type);
}
static LLVMValueRef field_loc(compile_t* c, LLVMValueRef offset,
LLVMTypeRef structure, LLVMTypeRef ftype, int index)
{
LLVMValueRef f_offset = LLVMBuildAdd(c->builder, offset,
LLVMConstInt(c->intptr,
LLVMOffsetOfElement(c->target_data, structure, index), false), "");
return LLVMBuildIntToPtr(c->builder, f_offset,
LLVMPointerType(ftype, 0), "");
}
static LLVMValueRef make_field_list(compile_t* c, gentype_t* g)
{
// The list is an array of field descriptors.
int count;
if(g->underlying == TK_TUPLETYPE)
count = g->field_count;
else
count = 0;
LLVMTypeRef type = LLVMArrayType(c->field_descriptor, count);
// If we aren't a tuple, return a null pointer to a list.
if(count == 0)
return LLVMConstNull(LLVMPointerType(type, 0));
// Create a constant array of field descriptors.
size_t buf_size = count *sizeof(LLVMValueRef);
LLVMValueRef* list = (LLVMValueRef*)pool_alloc_size(buf_size);
for(int i = 0; i < count; i++)
{
gentype_t fg;
if(!gentype(c, g->fields[i], &fg))
return NULL;
LLVMValueRef fdesc[2];
fdesc[0] = LLVMConstInt(c->i32,
LLVMOffsetOfElement(c->target_data, g->primitive, i), false);
if(fg.desc != NULL)
{
// We are a concrete type.
fdesc[1] = LLVMConstBitCast(fg.desc, c->descriptor_ptr);
} else {
// We aren't a concrete type.
fdesc[1] = LLVMConstNull(c->descriptor_ptr);
}
list[i] = LLVMConstStructInContext(c->context, fdesc, 2, false);
}
LLVMValueRef field_array = LLVMConstArray(c->field_descriptor, list, count);
// Create a global to hold the array.
const char* name = genname_fieldlist(g->type_name);
LLVMValueRef global = LLVMAddGlobal(c->module, type, name);
LLVMSetGlobalConstant(global, true);
LLVMSetLinkage(global, LLVMInternalLinkage);
LLVMSetInitializer(global, field_array);
pool_free_size(buf_size, list);
return global;
}
static LLVMValueRef make_field_offset(compile_t* c, reach_type_t* t)
{
if(t->field_count == 0)
return LLVMConstInt(c->i32, 0, false);
int index = 1;
if(t->underlying == TK_ACTOR)
index++;
return LLVMConstInt(c->i32,
LLVMOffsetOfElement(c->target_data, t->structure, index), false);
}
void dwarf_field(dwarf_t* dwarf, gentype_t* composite, gentype_t* field,
int index)
{
char buf[32];
memset(buf, 0, sizeof(buf));
dwarf_meta_t meta;
setup_dwarf(dwarf, &meta, field, false, true);
meta.typearg = field->type_name;
if(composite->underlying == TK_TUPLETYPE)
{
meta.flags |= DWARF_CONSTANT;
snprintf(buf, sizeof(buf), "_%d", index + 1);
meta.name = buf;
}
else
{
ast_t* def = (ast_t*)ast_data(composite->ast);
ast_t* members = ast_childidx(def, 4);
ast_t* fld = ast_childidx(members, index);
meta.name = ast_name(ast_child(fld));
if(ast_id(fld) == TK_FLET)
meta.flags |= DWARF_CONSTANT;
}
if(meta.name[0] == '_')
meta.flags |= DWARF_PRIVATE;
LLVMTypeRef structure = composite->primitive;
int offset = 0;
if(composite->underlying != TK_TUPLETYPE)
{
structure = composite->structure;
if(composite->underlying != TK_STRUCT)
offset++;
if(composite->underlying == TK_ACTOR)
offset++;
}
meta.offset = 8 * LLVMOffsetOfElement(dwarf->target_data, structure,
offset + index);
symbols_field(dwarf->symbols, &meta);
}
/* TargetData.t -> Llvm.lltype -> int -> Int64.t */
CAMLprim value llvm_offset_of_element(LLVMTargetDataRef TD, LLVMTypeRef Ty,
value Index) {
return caml_copy_int64(LLVMOffsetOfElement(TD, Ty, Int_val(Index)));
}
/* Llvm.lltype -> int -> DataLayout.t -> Int64.t */
CAMLprim value llvm_datalayout_offset_of_element(LLVMTypeRef Ty, value Index,
value DL) {
return caml_copy_int64(LLVMOffsetOfElement(DataLayout_val(DL), Ty,
Int_val(Index)));
}
static void serialise(compile_t* c, reach_type_t* t, LLVMValueRef ctx,
LLVMValueRef object, LLVMValueRef offset)
{
LLVMTypeRef structure = t->structure;
int extra = 0;
switch(t->underlying)
{
case TK_PRIMITIVE:
{
genserialise_typeid(c, t, offset);
if(t->primitive != NULL)
{
LLVMValueRef field = LLVMBuildStructGEP(c->builder, object, 1, "");
LLVMValueRef f_size = LLVMConstInt(c->intptr,
LLVMOffsetOfElement(c->target_data, structure, 1), false);
LLVMValueRef f_offset = LLVMBuildInBoundsGEP(c->builder, offset,
&f_size, 1, "");
genserialise_element(c, t, false, ctx, field, f_offset);
}
return;
}
case TK_CLASS:
{
genserialise_typeid(c, t, offset);
extra++;
break;
}
case TK_ACTOR:
{
// Skip the actor pad.
genserialise_typeid(c, t, offset);
extra += 2;
break;
}
case TK_TUPLETYPE:
{
// Get the tuple primitive type.
if(LLVMTypeOf(object) == t->structure_ptr)
{
genserialise_typeid(c, t, offset);
object = LLVMBuildStructGEP(c->builder, object, 1, "");
LLVMValueRef size = LLVMConstInt(c->intptr,
LLVMOffsetOfElement(c->target_data, structure, 1), false);
offset = LLVMBuildInBoundsGEP(c->builder, offset, &size, 1, "");
}
structure = t->primitive;
break;
}
default: {}
}
for(uint32_t i = 0; i < t->field_count; i++)
{
LLVMValueRef field = LLVMBuildStructGEP(c->builder, object, i + extra, "");
LLVMValueRef f_size = LLVMConstInt(c->intptr,
LLVMOffsetOfElement(c->target_data, structure, i + extra), false);
LLVMValueRef f_offset = LLVMBuildInBoundsGEP(c->builder, offset, &f_size,
1, "");
genserialise_element(c, t->fields[i].type, t->fields[i].embed,
ctx, field, f_offset);
}
}
