static bool link_lib(compile_t* c, const char* file_o)
{
#if defined(PLATFORM_IS_POSIX_BASED)
const char* file_lib = suffix_filename(c->opt->output, "lib", c->filename,
".a");
printf("Archiving %s\n", file_lib);
size_t len = 32 + strlen(file_lib) + strlen(file_o);
char* cmd = (char*)pool_alloc_size(len);
snprintf(cmd, len, "ar -rcs %s %s", file_lib, file_o);
if(system(cmd) != 0)
{
errorf(NULL, "unable to link");
pool_free_size(len, cmd);
return false;
}
pool_free_size(len, cmd);
#elif defined(PLATFORM_IS_WINDOWS)
const char* file_lib = suffix_filename(c->opt->output, "", c->filename,
".lib");
printf("Archiving %s\n", file_lib);
vcvars_t vcvars;
if(!vcvars_get(&vcvars))
{
errorf(NULL, "unable to link");
return false;
}
size_t len = 128 + strlen(file_lib) + strlen(file_o);
char* cmd = (char*)pool_alloc_size(len);
snprintf(cmd, len, "cmd /C \"\"%s\" /NOLOGO /OUT:%s %s\"", vcvars.ar,
file_lib, file_o);
if(system(cmd) == -1)
{
errorf(NULL, "unable to link");
pool_free_size(len, cmd);
return false;
}
pool_free_size(len, cmd);
#endif
return true;
}
const char* token_print(token_t* token)
{
assert(token != NULL);
switch(token->id)
{
case TK_EOF:
return "EOF";
case TK_ID:
case TK_STRING:
return token->string;
case TK_INT:
if (token->printed == NULL)
token->printed = (char*)pool_alloc_size(64);
snprintf(token->printed, 64, __zu, (size_t)token->integer);
return token->printed;
case TK_FLOAT:
{
if(token->printed == NULL)
token->printed = (char*)pool_alloc_size(64);
int r = snprintf(token->printed, 64, "%g", token->real);
if(strcspn(token->printed, ".e") == (size_t)r)
snprintf(token->printed + r, 64 - r, ".0");
return token->printed;
}
case TK_LEX_ERROR:
return "LEX_ERROR";
default:
break;
}
const char* p = lexer_print(token->id);
if(p != NULL)
return p;
if(token->printed == NULL)
token->printed = (char*)pool_alloc_size(64);
snprintf(token->printed, 64, "Unknown_token_%d", token->id);
return token->printed;
}
static LLVMValueRef make_unbox_function(compile_t* c, gentype_t* g,
const char* name)
{
LLVMValueRef fun = LLVMGetNamedFunction(c->module, name);
if(fun == NULL)
return LLVMConstNull(c->void_ptr);
// Create a new unboxing function that forwards to the real function.
LLVMTypeRef f_type = LLVMGetElementType(LLVMTypeOf(fun));
int count = LLVMCountParamTypes(f_type);
// If it takes no arguments, it's a special number constructor. Don't put it
// in the vtable.
if(count == 0)
return LLVMConstNull(c->void_ptr);
size_t buf_size = count *sizeof(LLVMTypeRef);
LLVMTypeRef* params = (LLVMTypeRef*)pool_alloc_size(buf_size);
LLVMGetParamTypes(f_type, params);
LLVMTypeRef ret_type = LLVMGetReturnType(f_type);
// It's the same type, but it takes the boxed type instead of the primitive
// type as the receiver.
params[0] = g->structure_ptr;
const char* unbox_name = genname_unbox(name);
LLVMTypeRef unbox_type = LLVMFunctionType(ret_type, params, count, false);
LLVMValueRef unbox_fun = codegen_addfun(c, unbox_name, unbox_type);
codegen_startfun(c, unbox_fun, false);
// Extract the primitive type from element 1 and call the real function.
LLVMValueRef this_ptr = LLVMGetParam(unbox_fun, 0);
LLVMValueRef primitive_ptr = LLVMBuildStructGEP(c->builder, this_ptr, 1, "");
LLVMValueRef primitive = LLVMBuildLoad(c->builder, primitive_ptr, "");
LLVMValueRef* args = (LLVMValueRef*)pool_alloc_size(buf_size);
args[0] = primitive;
for(int i = 1; i < count; i++)
args[i] = LLVMGetParam(unbox_fun, i);
LLVMValueRef result = codegen_call(c, fun, args, count);
LLVMBuildRet(c->builder, result);
codegen_finishfun(c);
pool_free_size(buf_size, params);
pool_free_size(buf_size, args);
return LLVMConstBitCast(unbox_fun, c->void_ptr);
}
static LLVMValueRef make_trait_list(compile_t* c, gentype_t* g)
{
// The list is an array of integers.
uint32_t count = trait_count(c, g);
// If we have no traits, return a null pointer to a list.
if(count == 0)
return LLVMConstNull(LLVMPointerType(LLVMArrayType(c->i32, 0), 0));
// Sort the trait identifiers.
size_t tid_size = count * sizeof(uint32_t);
uint32_t* tid = (uint32_t*)pool_alloc_size(tid_size);
reachable_type_t* t = reach_type(c->reachable, g->type_name);
assert(t != NULL);
size_t i = HASHMAP_BEGIN;
size_t index = 0;
reachable_type_t* provide;
while((provide = reachable_type_cache_next(&t->subtypes, &i)) != NULL)
tid[index++] = provide->type_id;
qsort(tid, index, sizeof(uint32_t), cmp_uint32);
index = unique_uint32(tid, index);
// Create a constant array of trait identifiers.
size_t list_size = index * sizeof(LLVMValueRef);
LLVMValueRef* list = (LLVMValueRef*)pool_alloc_size(list_size);
for(i = 0; i < index; i++)
list[i] = LLVMConstInt(c->i32, tid[i], false);
count = (uint32_t)index;
LLVMValueRef trait_array = LLVMConstArray(c->i32, list, count);
// Create a global to hold the array.
const char* name = genname_traitlist(g->type_name);
LLVMTypeRef type = LLVMArrayType(c->i32, count);
LLVMValueRef global = LLVMAddGlobal(c->module, type, name);
LLVMSetGlobalConstant(global, true);
LLVMSetLinkage(global, LLVMInternalLinkage);
LLVMSetInitializer(global, trait_array);
pool_free_size(tid_size, tid);
pool_free_size(list_size, list);
return global;
}
static const char* build_name(const char* a, const char* b, ast_t* typeargs,
bool function)
{
size_t len = typeargs_len(typeargs);
if(a != NULL)
len += strlen(a) + 1;
if(b != NULL)
len += strlen(b) + 1;
char* name = (char*)pool_alloc_size(len);
if(a != NULL)
strcpy(name, a);
if(b != NULL)
{
if(a != NULL)
name_append(name, b);
else
strcpy(name, b);
}
typeargs_append(name, typeargs, function);
return stringtab_consume(name, len);
}
static LLVMValueRef get_prototype(compile_t* c, gentype_t* g, const char *name,
ast_t* typeargs, ast_t* fun)
{
// Behaviours and actor constructors also have sender functions.
bool sender = false;
switch(ast_id(fun))
{
case TK_NEW:
sender = g->underlying == TK_ACTOR;
break;
case TK_BE:
sender = true;
break;
default: {}
}
// Get a fully qualified name: starts with the type name, followed by the
// type arguments, followed by the function name, followed by the function
// level type arguments.
const char* funname = genname_fun(g->type_name, name, typeargs);
// If the function already exists, just return it.
LLVMValueRef func = LLVMGetNamedFunction(c->module, funname);
if(func != NULL)
return func;
LLVMTypeRef ftype = get_signature(c, g, fun);
if(ftype == NULL)
return NULL;
// If the function exists now, just return it.
func = LLVMGetNamedFunction(c->module, funname);
if(func != NULL)
return func;
if(sender)
{
// Generate the sender prototype.
const char* be_name = genname_be(funname);
func = codegen_addfun(c, be_name, ftype);
// Change the return type to void for the handler.
size_t count = LLVMCountParamTypes(ftype);
size_t buf_size = count *sizeof(LLVMTypeRef);
LLVMTypeRef* tparams = (LLVMTypeRef*)pool_alloc_size(buf_size);
LLVMGetParamTypes(ftype, tparams);
ftype = LLVMFunctionType(c->void_type, tparams, (int)count, false);
pool_free_size(buf_size, tparams);
}
// Generate the function prototype.
return codegen_addfun(c, funname, ftype);
}
// Cat together the given strings into a newly allocated buffer.
// Any unneeded strings should be passed as "", not NULL.
// The returned buffer must be freed with pool_free_size() when no longer
// needed.
// The out_buf_size parameter returns the size of the buffer (which is needed
// for freeing), not the length of the string.
static char* doc_cat(const char* a, const char* b, const char* c,
const char* d, const char* e, size_t* out_buf_size)
{
assert(a != NULL);
assert(b != NULL);
assert(c != NULL);
assert(d != NULL);
assert(e != NULL);
assert(out_buf_size != NULL);
size_t a_len = strlen(a);
size_t b_len = strlen(b);
size_t c_len = strlen(c);
size_t d_len = strlen(d);
size_t e_len = strlen(e);
size_t buf_len = a_len + b_len + c_len + d_len + e_len + 1;
char* buffer = (char*)pool_alloc_size(buf_len);
char *p = buffer;
if(a_len > 0) { memcpy(p, a, a_len); p += a_len; }
if(b_len > 0) { memcpy(p, b, b_len); p += b_len; }
if(c_len > 0) { memcpy(p, c, c_len); p += c_len; }
if(d_len > 0) { memcpy(p, d, d_len); p += d_len; }
if(e_len > 0) { memcpy(p, e, e_len); p += e_len; }
*(p++) = '\0';
assert(p == (buffer + buf_len));
*out_buf_size = buf_len;
return buffer;
}
static ast_result_t sugar_ffi(ast_t* ast)
{
AST_GET_CHILDREN(ast, id, typeargs, args, named_args);
const char* name = ast_name(id);
size_t len = ast_name_len(id);
// Check for \0 in ffi name (it may be a string literal)
if(memchr(name, '\0', len) != NULL)
{
ast_error(ast, "FFI function names cannot include nul characters");
return AST_ERROR;
}
// Prefix '@' to the name
char* new_name = (char*)pool_alloc_size(len + 2);
new_name[0] = '@';
memcpy(new_name + 1, name, len);
new_name[len + 1] = '\0';
ast_t* new_id = ast_from_string(id, stringtab_consume(new_name, len + 2));
ast_replace(&id, new_id);
if(ast_id(ast) == TK_FFIDECL)
return check_params(args);
return AST_OK;
}
static LLVMValueRef make_trait_list(compile_t* c, gentype_t* g,
uint32_t* final_count)
{
// The list is an array of integers.
uint32_t* tid;
size_t tid_size;
uint32_t count = trait_count(c, g, &tid, &tid_size);
// If we have no traits, return a null pointer to a list.
if(count == 0)
return LLVMConstNull(LLVMPointerType(LLVMArrayType(c->i32, 0), 0));
// Create a constant array of trait identifiers.
size_t list_size = count * sizeof(LLVMValueRef);
LLVMValueRef* list = (LLVMValueRef*)pool_alloc_size(list_size);
for(uint32_t i = 0; i < count; i++)
list[i] = LLVMConstInt(c->i32, tid[i], false);
LLVMValueRef trait_array = LLVMConstArray(c->i32, list, count);
// Create a global to hold the array.
const char* name = genname_traitlist(g->type_name);
LLVMTypeRef type = LLVMArrayType(c->i32, count);
LLVMValueRef global = LLVMAddGlobal(c->module, type, name);
LLVMSetGlobalConstant(global, true);
LLVMSetLinkage(global, LLVMInternalLinkage);
LLVMSetInitializer(global, trait_array);
pool_free_size(tid_size, tid);
pool_free_size(list_size, list);
*final_count = count;
return global;
}
static LLVMValueRef make_vtable(compile_t* c, gentype_t* g)
{
uint32_t vtable_size = genfun_vtable_size(c, g);
if(vtable_size == 0)
return LLVMConstArray(c->void_ptr, NULL, 0);
size_t buf_size = vtable_size * sizeof(LLVMValueRef);
LLVMValueRef* vtable = (LLVMValueRef*)pool_alloc_size(buf_size);
memset(vtable, 0, buf_size);
reachable_type_t* t = reach_type(c->reachable, g->type_name);
size_t i = HASHMAP_BEGIN;
reachable_method_name_t* n;
while((n = reachable_method_names_next(&t->methods, &i)) != NULL)
{
size_t j = HASHMAP_BEGIN;
reachable_method_t* m;
while((m = reachable_methods_next(&n->r_methods, &j)) != NULL)
{
const char* fullname = genname_fun(t->name, n->name, m->typeargs);
token_id t = ast_id(m->r_fun);
switch(t)
{
case TK_NEW:
case TK_BE:
if(g->underlying == TK_ACTOR)
fullname = genname_be(fullname);
break;
default: {}
}
uint32_t index = m->vtable_index;
assert(index != (uint32_t)-1);
assert(vtable[index] == NULL);
if(g->primitive != NULL)
vtable[index] = make_unbox_function(c, g, fullname, t);
else
vtable[index] = make_function_ptr(c, fullname, c->void_ptr);
}
}
for(uint32_t i = 0; i < vtable_size; i++)
{
if(vtable[i] == NULL)
vtable[i] = LLVMConstNull(c->void_ptr);
}
LLVMValueRef r = LLVMConstArray(c->void_ptr, vtable, vtable_size);
pool_free_size(buf_size, vtable);
return r;
}
static const char* symbol_suffix(const char* symbol, size_t suffix)
{
size_t len = strlen(symbol);
size_t buf_size = len + 32;
char* buf = (char*)pool_alloc_size(buf_size);
snprintf(buf, buf_size, "%s" __zu, symbol, suffix);
return stringtab_consume(buf, buf_size);
}
static void genfun_dwarf(compile_t* c, gentype_t* g, const char *name,
ast_t* typeargs, ast_t* fun)
{
if(!codegen_hassource(c))
return;
// Get the function.
const char* funname = genname_fun(g->type_name, name, typeargs);
LLVMValueRef func = LLVMGetNamedFunction(c->module, funname);
assert(func != NULL);
// Count the parameters, including the receiver.
ast_t* params = ast_childidx(fun, 3);
size_t count = ast_childcount(params) + 1;
size_t buf_size = (count + 1) * sizeof(const char*);
const char** pnames = (const char**)pool_alloc_size(buf_size);
count = 0;
// Return value type name and receiver type name.
pnames[count++] = genname_type(ast_childidx(fun, 4));
pnames[count++] = g->type_name;
// Get a type name for each parameter.
ast_t* param = ast_child(params);
while(param != NULL)
{
ast_t* ptype = ast_childidx(param, 1);
pnames[count++] = genname_type(ptype);
param = ast_sibling(param);
}
// Dwarf the method type
dwarf_method(&c->dwarf, fun, name, funname, pnames, count, func);
// Dwarf the receiver pointer.
LLVMBasicBlockRef entry = LLVMGetEntryBasicBlock(codegen_fun(c));
LLVMValueRef argument = codegen_getlocal(c, stringtab("this"));
dwarf_this(&c->dwarf, fun, g->type_name, entry, argument);
// Dwarf locals for parameters
param = ast_child(params);
size_t index = 1;
while(param != NULL)
{
argument = codegen_getlocal(c, ast_name(ast_child(param)));
dwarf_parameter(&c->dwarf, param, pnames[index + 1], entry, argument,
index);
param = ast_sibling(param);
index++;
}
pool_free_size(buf_size, pnames);
}
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;
}
source_t* source_open_string(const char* source_code)
{
source_t* source = POOL_ALLOC(source_t);
source->file = NULL;
source->len = strlen(source_code);
source->m = (char*)pool_alloc_size(source->len);
memcpy(source->m, source_code, source->len);
return source;
}
// Convert the given ID to a hygenic string. The resulting string should not be
// deleted and is valid indefinitely.
static const char* id_to_string(const char* prefix, size_t id)
{
if(prefix == NULL)
prefix = "";
size_t len = strlen(prefix);
size_t buf_size = len + 32;
char* buffer = (char*)pool_alloc_size(buf_size);
snprintf(buffer, buf_size, "%s$" __zu, prefix, id);
return stringtab_consume(buffer, buf_size);
}
static bool make_struct(compile_t* c, gentype_t* g)
{
LLVMTypeRef type;
int extra = 0;
if(g->underlying != TK_TUPLETYPE)
{
type = g->structure;
extra++;
} else {
type = g->primitive;
}
if(g->underlying == TK_ACTOR)
extra++;
size_t buf_size = (g->field_count + extra) * sizeof(LLVMTypeRef);
LLVMTypeRef* elements = (LLVMTypeRef*)pool_alloc_size(buf_size);
// Create the type descriptor as element 0.
if(g->underlying != TK_TUPLETYPE)
elements[0] = LLVMPointerType(g->desc_type, 0);
// Create the actor pad as element 1.
if(g->underlying == TK_ACTOR)
elements[1] = c->actor_pad;
// Get a preliminary type for each field and set the struct body. This is
// needed in case a struct for the type being generated here is required when
// generating a field.
for(int i = 0; i < g->field_count; i++)
{
gentype_t field_g;
if(!gentype_prelim(c, g->fields[i], &field_g))
{
pool_free_size(buf_size, elements);
return false;
}
elements[i + extra] = field_g.use_type;
}
LLVMStructSetBody(type, elements, g->field_count + extra, false);
// Create a box type for tuples.
if(g->underlying == TK_TUPLETYPE)
make_box_type(c, g);
pool_free_size(buf_size, elements);
return true;
}
static LLVMTypeRef get_signature(compile_t* c, gentype_t* g, ast_t* fun)
{
// Get a type for the result.
ast_t* rtype = ast_childidx(fun, 4);
gentype_t rtype_g;
if(!gentype(c, rtype, &rtype_g))
{
ast_error(rtype, "couldn't generate result type");
return NULL;
}
// Count the parameters, including the receiver.
ast_t* params = ast_childidx(fun, 3);
size_t count = ast_childcount(params) + 1;
size_t buf_size = count *sizeof(LLVMTypeRef);
LLVMTypeRef* tparams = (LLVMTypeRef*)pool_alloc_size(buf_size);
count = 0;
// Get a type for the receiver.
tparams[count++] = g->use_type;
// Get a type for each parameter.
ast_t* param = ast_child(params);
while(param != NULL)
{
ast_t* ptype = ast_childidx(param, 1);
gentype_t ptype_g;
if(!gentype(c, ptype, &ptype_g))
{
ast_error(ptype, "couldn't generate parameter type");
pool_free_size(buf_size, tparams);
return NULL;
}
tparams[count++] = ptype_g.use_type;
param = ast_sibling(param);
}
LLVMTypeRef result = rtype_g.use_type;
// Generate the function type.
LLVMTypeRef r = LLVMFunctionType(result, tparams, (int)count, false);
pool_free_size(buf_size, tparams);
return r;
}
static void add_dispatch_case(compile_t* c, gentype_t* g, ast_t* fun,
uint32_t index, LLVMValueRef handler, LLVMTypeRef type)
{
// Add a case to the dispatch function to handle this message.
codegen_startfun(c, g->dispatch_fn, false);
LLVMBasicBlockRef block = codegen_block(c, "handler");
LLVMValueRef id = LLVMConstInt(c->i32, index, false);
LLVMAddCase(g->dispatch_switch, id, block);
// Destructure the message.
LLVMPositionBuilderAtEnd(c->builder, block);
LLVMValueRef ctx = LLVMGetParam(g->dispatch_fn, 0);
LLVMValueRef this_ptr = LLVMGetParam(g->dispatch_fn, 1);
LLVMValueRef msg = LLVMBuildBitCast(c->builder,
LLVMGetParam(g->dispatch_fn, 2), type, "");
int count = LLVMCountParams(handler);
size_t buf_size = count * sizeof(LLVMValueRef);
LLVMValueRef* args = (LLVMValueRef*)pool_alloc_size(buf_size);
args[0] = LLVMBuildBitCast(c->builder, this_ptr, g->use_type, "");
// Trace the message.
LLVMValueRef start_trace = gencall_runtime(c, "pony_gc_recv", &ctx, 1, "");
ast_t* params = ast_childidx(fun, 3);
ast_t* param = ast_child(params);
bool need_trace = false;
for(int i = 1; i < count; i++)
{
LLVMValueRef field = LLVMBuildStructGEP(c->builder, msg, i + 2, "");
args[i] = LLVMBuildLoad(c->builder, field, "");
need_trace |= gentrace(c, ctx, args[i], ast_type(param));
param = ast_sibling(param);
}
if(need_trace)
{
gencall_runtime(c, "pony_recv_done", &ctx, 1, "");
} else {
LLVMInstructionEraseFromParent(start_trace);
}
// Call the handler.
codegen_call(c, handler, args, count);
LLVMBuildRetVoid(c->builder);
codegen_finishfun(c);
pool_free_size(buf_size, args);
}
static const char* name_without_case(const char* name)
{
size_t len = strlen(name) + 1;
char* buf = (char*)pool_alloc_size(len);
if(is_type_name(name))
{
for(size_t i = 0; i < len; i++)
buf[i] = (char)toupper(name[i]);
} else {
for(size_t i = 0; i < len; i++)
buf[i] = (char)tolower(name[i]);
}
return stringtab_consume(buf, len);
}
// Add a colour record
static colour_record_t* add_colour(painter_t* painter)
{
assert(painter != NULL);
size_t map_byte_count = painter->typemap_size * sizeof(uint64_t);
colour_record_t* n = POOL_ALLOC(colour_record_t);
n->colour = painter->colour_count;
n->type_map = (uint64_t*)pool_alloc_size(map_byte_count);
n->next = NULL;
memset(n->type_map, 0, map_byte_count);
*painter->colour_next = n;
painter->colour_next = &n->next;
painter->colour_count++;
return n;
}
// Add a method name record
static name_record_t* add_name(painter_t* painter, const char* name)
{
assert(painter != NULL);
assert(name != NULL);
size_t map_byte_count = painter->typemap_size * sizeof(uint64_t);
name_record_t* n = POOL_ALLOC(name_record_t);
n->name = name;
n->colour = UNASSIGNED_COLOUR;
n->typemap_size = painter->typemap_size;
n->type_map = (uint64_t*)pool_alloc_size(map_byte_count);
memset(n->type_map, 0, map_byte_count);
name_records_put(&painter->names, n);
return n;
}
static uint32_t trait_count(compile_t* c, gentype_t* g,
uint32_t** list, size_t* list_size)
{
switch(g->underlying)
{
case TK_PRIMITIVE:
case TK_CLASS:
case TK_ACTOR:
{
reachable_type_t* t = reach_type(c->reachable, g->type_name);
assert(t != NULL);
uint32_t count = (uint32_t)reachable_type_cache_size(&t->subtypes);
if(count == 0)
return 0;
// Sort the trait identifiers.
size_t tid_size = count * sizeof(uint32_t);
uint32_t* tid = (uint32_t*)pool_alloc_size(tid_size);
size_t i = HASHMAP_BEGIN;
size_t index = 0;
reachable_type_t* provide;
while((provide = reachable_type_cache_next(&t->subtypes, &i)) != NULL)
tid[index++] = provide->type_id;
qsort(tid, index, sizeof(uint32_t), cmp_uint32);
count = (uint32_t)unique_uint32(tid, index);
if(list != NULL)
{
*list = tid;
*list_size = tid_size;
} else {
pool_free_size(tid_size, tid);
}
return count;
}
default: {}
}
return 0;
}
// Append the given character to the current token text
static void append_to_token(lexer_t* lexer, char c)
{
if(lexer->buflen >= lexer->alloc)
{
size_t new_len = (lexer->alloc > 0) ? lexer->alloc << 1 : 64;
char* new_buf = (char*)pool_alloc_size(new_len);
memcpy(new_buf, lexer->buffer, lexer->alloc);
if(lexer->alloc > 0)
pool_free_size(lexer->alloc, lexer->buffer);
lexer->buffer = new_buf;
lexer->alloc = new_len;
}
lexer->buffer[lexer->buflen] = c;
lexer->buflen++;
}
const char* suffix_filename(const char* dir, const char* prefix,
const char* file, const char* extension)
{
// Copy to a string with space for a suffix.
size_t len = strlen(dir) + strlen(prefix) + strlen(file) + strlen(extension)
+ 4;
char* filename = (char*)pool_alloc_size(len);
// Start with no suffix.
#ifdef PLATFORM_IS_WINDOWS
snprintf(filename, len, "%s\\%s%s%s", dir, prefix, file, extension);
#else
snprintf(filename, len, "%s/%s%s%s", dir, prefix, file, extension);
#endif
int suffix = 0;
while(suffix < 100)
{
// Overwrite files but not directories.
struct stat s;
int err = stat(filename, &s);
if((err == -1) || !S_ISDIR(s.st_mode))
break;
#ifdef PLATFORM_IS_WINDOWS
snprintf(filename, len, "%s\\%s%s%d%s", dir, prefix, file, ++suffix,
extension);
#else
snprintf(filename, len, "%s/%s%s%d%s", dir, prefix, file, ++suffix,
extension);
#endif
}
if(suffix >= 100)
{
errorf(NULL, "couldn't pick an unused file name");
pool_free_size(len, filename);
return NULL;
}
return stringtab_consume(filename, len);
}
const char* buildflagset_print(buildflagset_t* set)
{
assert(set != NULL);
assert(set->flags != NULL);
char* p = set->text_buffer;
// First the mutually exclusive flags.
if(set->have_os_flags)
print_flag(_os_flags[set->enum_os_flags], true, set, &p);
if(set->have_size_flags)
print_flag(_size_flags[set->enum_size_flags], true, set, &p);
// Next the normal flags, in any order.
size_t i = HASHMAP_BEGIN;
flag_t* flag;
while((flag = flagtab_next(set->flags, &i)) != NULL)
print_flag(flag->name, flag->value, set, &p);
if(p == set->text_buffer) // No flags, all configs match.
print_str("all configs", set, &p);
// Check buffer was big enough for it all.
size_t size_needed = (p - set->text_buffer) + 1; // +1 for terminator.
if(size_needed > set->buffer_size)
{
// Buffer we have isn't big enough, make it bigger then go round again.
if(set->buffer_size > 0)
pool_free_size(set->buffer_size, set->text_buffer);
set->text_buffer = (char*)pool_alloc_size(size_needed);
set->buffer_size = size_needed;
set->text_buffer[0] = '\0';
buildflagset_print(set);
}
// Add terminator.
assert(set->text_buffer != NULL);
set->text_buffer[size_needed - 1] = '\0';
return set->text_buffer;
}
void* heap_alloc_large(pony_actor_t* actor, heap_t* heap, size_t size)
{
size = pool_adjust_size(size);
chunk_t* chunk = (chunk_t*) POOL_ALLOC(chunk_t);
chunk->actor = actor;
chunk->size = size;
chunk->m = (char*) pool_alloc_size(size);
chunk->slots = 0;
chunk->shallow = 0;
large_pagemap(chunk->m, size, chunk);
chunk->next = heap->large;
heap->large = chunk;
heap->used += chunk->size;
return chunk->m;
}
static const char* suggest_alt_name(ast_t* ast, const char* name)
{
assert(ast != NULL);
assert(name != NULL);
size_t name_len = strlen(name);
if(name[0] == '_')
{
// Try without leading underscore
const char* try_name = stringtab(name + 1);
if(ast_get(ast, try_name, NULL) != NULL)
return try_name;
}
else
{
// Try with a leading underscore
char* buf = (char*)pool_alloc_size(name_len + 2);
buf[0] = '_';
strncpy(buf + 1, name, name_len + 1);
const char* try_name = stringtab_consume(buf, name_len + 2);
if(ast_get(ast, try_name, NULL) != NULL)
return try_name;
}
// Try with a different case (without crossing type/value boundary)
ast_t* case_ast = ast_get_case(ast, name, NULL);
if(case_ast != NULL)
{
assert(ast_child(case_ast) != NULL);
const char* try_name = ast_name(ast_child(case_ast));
if(ast_get(ast, try_name, NULL) != NULL)
return try_name;
}
// Give up
return NULL;
}
source_t* source_open(const char* file)
{
FILE* fp = fopen(file, "rb");
if(fp == NULL)
{
errorf(file, "can't open file");
return NULL;
}
fseek(fp, 0, SEEK_END);
ssize_t size = ftell(fp);
if(size < 0)
{
errorf(file, "can't determine length of file");
fclose(fp);
return NULL;
}
fseek(fp, 0, SEEK_SET);
source_t* source = POOL_ALLOC(source_t);
source->file = stringtab(file);
source->m = (char*)pool_alloc_size(size);
source->len = size;
ssize_t read = fread(source->m, sizeof(char), size, fp);
if(read < size)
{
errorf(file, "failed to read entire file");
pool_free_size(source->len, source->m);
POOL_FREE(source_t, source);
fclose(fp);
return NULL;
}
fclose(fp);
return source;
}
static const char* quoted_locator(ast_t* use, const char* locator)
{
assert(locator != NULL);
if(strpbrk(locator, "\t\r\n\"'`;$|&<>%*?\\[]{}()") != NULL)
{
if(use != NULL)
ast_error(use, "use URI contains invalid characters");
return NULL;
}
size_t len = strlen(locator);
char* quoted = (char*)pool_alloc_size(len + 3);
quoted[0] = '"';
memcpy(quoted + 1, locator, len);
quoted[len + 1] = '"';
quoted[len + 2] = '\0';
return stringtab_consume(quoted, len + 3);
}
static const char* string_to_symbol(const char* string)
{
bool prefix = false;
if(!((string[0] >= 'a') && (string[0] <= 'z')) &&
!((string[0] >= 'A') && (string[0] <= 'Z')))
{
// If it doesn't start with a letter, prefix an underscore.
prefix = true;
}
size_t len = strlen(string);
size_t buf_size = len + prefix + 1;
char* buf = (char*)pool_alloc_size(buf_size);
memcpy(buf + prefix, string, len + 1);
if(prefix)
buf[0] = '_';
for(size_t i = prefix; i < len; i++)
{
if(
(buf[i] == '_') ||
((buf[i] >= 'a') && (buf[i] <= 'z')) ||
((buf[i] >= '0') && (buf[i] <= '9'))
)
{
// Do nothing.
} else if((buf[i] >= 'A') && (buf[i] <= 'Z')) {
// Force lower case.
buf[i] |= 0x20;
} else {
// Smash a non-symbol character to an underscore.
buf[i] = '_';
}
}
return stringtab_consume(buf, buf_size);
}