bool genexe(compile_t* c, ast_t* program)
{
// The first package is the main package. It has to have a Main actor.
const char* main_actor = stringtab("Main");
const char* env_class = stringtab("Env");
ast_t* package = ast_child(program);
ast_t* main_def = ast_get(package, main_actor, NULL);
if(main_def == NULL)
{
errorf(NULL, "no Main actor found in package '%s'", c->filename);
return false;
}
// Generate the Main actor and the Env class.
ast_t* main_ast = type_builtin(c->opt, main_def, main_actor);
ast_t* env_ast = type_builtin(c->opt, main_def, env_class);
genprim_reachable_init(c, program);
reach(c->reachable, main_ast, stringtab("create"), NULL);
reach(c->reachable, env_ast, stringtab("_create"), NULL);
paint(c->reachable);
gentype_t main_g;
gentype_t env_g;
bool ok = gentype(c, main_ast, &main_g) && gentype(c, env_ast, &env_g);
if(ok)
gen_main(c, &main_g, &env_g);
ast_free_unattached(main_ast);
ast_free_unattached(env_ast);
if(!ok)
return false;
if(!genopt(c))
return false;
const char* file_o = genobj(c);
if(file_o == NULL)
return false;
if(c->opt->limit < PASS_ALL)
return true;
if(!link_exe(c, program, file_o))
return false;
#ifdef PLATFORM_IS_WINDOWS
_unlink(file_o);
#else
unlink(file_o);
#endif
return true;
}
static errormsg_t* make_errorfv(const char* file, const char* fmt, va_list ap)
{
char buf[LINE_LEN];
vsnprintf(buf, LINE_LEN, fmt, ap);
errormsg_t* e = error_alloc();
e->file = stringtab(file);
e->msg = stringtab(buf);
return e;
}
void errorfv(const char* file, const char* fmt, va_list ap)
{
char buf[LINE_LEN];
vsnprintf(buf, LINE_LEN, fmt, ap);
errormsg_t* e = POOL_ALLOC(errormsg_t);
memset(e, 0, sizeof(errormsg_t));
e->file = stringtab(file);
e->msg = stringtab(buf);
add_error(e);
}
// Replace all the strings in the _os_flags and _size_flags arrays with
// stringtab'ed versions the first time this is called.
// This method of initialisatino is obviously not at all concurrency safe, but
// in works with unit tests trivially.
static void stringtab_mutexgroups()
{
if(_stringtabed)
return;
for(size_t i = 0; _os_flags[i] != NULL; i++)
_os_flags[i] = stringtab(_os_flags[i]);
for(size_t i = 0; _size_flags[i] != NULL; i++)
_size_flags[i] = stringtab(_size_flags[i]);
_stringtabed = true;
}
// Find the index of the handler for the given URI
static int find_handler(pass_opt_t* opt, ast_t* uri, const char** out_locator)
{
assert(uri != NULL);
assert(out_locator != NULL);
assert(ast_id(uri) == TK_STRING);
const char* text = ast_name(uri);
const char* colon = strchr(text, ':');
if(colon == NULL)
{
// No scheme specified, use default
*out_locator = stringtab(text);
return 0;
}
size_t scheme_len = colon - text + 1; // +1 for colon
// Search for matching handler
for(int i = 0; handlers[i].scheme != NULL; i++)
{
if(handlers[i].scheme_len == scheme_len &&
strncmp(handlers[i].scheme, text, scheme_len) == 0)
{
if(handlers[i].handler == NULL) // No handler provided (probably test:)
break;
// Matching scheme found
*out_locator = stringtab(colon + 1);
return i;
}
}
// No match found
#ifdef PLATFORM_IS_WINDOWS
if(colon == text + 1)
{
// Special case error message
ast_error(opt->check.errors, uri, "Use scheme %c: not found. "
"If this is an absolute path use prefix \"package:\"", text[0]);
return -1;
}
#endif
ast_error(opt->check.errors, uri, "Use scheme %.*s not found",
(int)scheme_len, text);
return -1;
}
const char* package_alias_from_id(ast_t* module, const char* id)
{
pony_assert(ast_id(module) == TK_MODULE);
const char* strtab_id = stringtab(id);
ast_t* use = ast_child(module);
while(ast_id(use) == TK_USE)
{
ast_t* imported = (ast_t*)ast_data(use);
pony_assert((imported != NULL) && (ast_id(imported) == TK_PACKAGE));
package_t* pkg = (package_t*)ast_data(imported);
pony_assert(pkg != NULL);
if(pkg->id == strtab_id)
{
ast_t* alias = ast_child(use);
if(ast_id(alias) == TK_NONE)
return NULL;
return ast_name(alias);
}
use = ast_sibling(use);
}
pony_assert(false);
return NULL;
}
bool has_member(ast_t* members, const char* name)
{
name = stringtab(name);
ast_t* member = ast_child(members);
while(member != NULL)
{
ast_t* id;
switch(ast_id(member))
{
case TK_FVAR:
case TK_FLET:
case TK_EMBED:
id = ast_child(member);
break;
default:
id = ast_childidx(member, 1);
break;
}
if(ast_name(id) == name)
return true;
member = ast_sibling(member);
}
return false;
}
// Make a token with the specified ID and current token text
static token_t* make_token_with_text(lexer_t* lexer, token_id id)
{
token_t* t = make_token(lexer, id);
append_to_token(lexer, '\0');
token_set_string(t, stringtab(lexer->buffer));
return t;
}
// Check whether the directory specified by catting the given base and path
// exists
// @return The resulting directory path, which should not be deleted and is
// valid indefinitely. NULL is directory cannot be found.
static const char* try_path(const char* base, const char* path,
bool* out_found_notdir)
{
char composite[FILENAME_MAX];
char file[FILENAME_MAX];
path_cat(base, path, composite);
if(pony_realpath(composite, file) != file)
return NULL;
struct stat s;
int err = stat(file, &s);
if(err == -1)
return NULL;
if(!S_ISDIR(s.st_mode))
{
if(out_found_notdir != NULL)
*out_found_notdir = true;
return NULL;
}
return stringtab(file);
}
void token_set_string(token_t* token, const char* value)
{
assert(token != NULL);
assert(token->id == TK_STRING || token->id == TK_ID);
assert(value != NULL);
token->string = stringtab(value);
}
// Check that the given path exists and add it to our package search paths
static bool add_path(const char* path)
{
#ifdef PLATFORM_IS_WINDOWS
// The Windows implementation of stat() cannot cope with trailing a \ on a
// directory name, so we remove it here if present. It is not safe to modify
// the given path since it may come direct from getenv(), so we copy.
char buf[FILENAME_MAX];
strcpy(buf, path);
size_t len = strlen(path);
if(path[len - 1] == '\\')
{
buf[len - 1] = '\0';
path = buf;
}
#endif
struct stat s;
int err = stat(path, &s);
if((err != -1) && S_ISDIR(s.st_mode))
{
path = stringtab(path);
if(strlist_find(search, path) == NULL)
search = strlist_append(search, path);
}
return true;
}
ast_t* builder_find_sub_tree(builder_t* builder, const char* name)
{
if(builder == NULL || name == NULL)
return NULL;
return (ast_t*)symtab_find(builder->defs, stringtab(name), NULL);
}
void gendesc_init(compile_t* c, gentype_t* g)
{
// Initialise the global descriptor.
uint32_t size = (uint32_t)LLVMABISizeOfType(c->target_data, g->structure);
// Generate a separate type ID for every type.
LLVMValueRef args[DESC_LENGTH];
args[DESC_ID] = make_type_id(c, g->type_name);
args[DESC_SIZE] = LLVMConstInt(c->i32, size, false);
args[DESC_TRAIT_COUNT] = make_trait_count(c, g);
args[DESC_FIELD_COUNT] = make_field_count(c, g);
args[DESC_TRACE] = make_function_ptr(c, genname_trace(g->type_name),
c->trace_fn);
args[DESC_SERIALISE] = make_function_ptr(c, genname_serialise(g->type_name),
c->trace_fn);
args[DESC_DESERIALISE] = make_function_ptr(c,
genname_deserialise(g->type_name), c->trace_fn);
args[DESC_DISPATCH] = make_function_ptr(c, genname_dispatch(g->type_name),
c->dispatch_fn);
args[DESC_FINALISE] = make_function_ptr(c, genname_finalise(g->type_name),
c->final_fn);
args[DESC_EVENT_NOTIFY] = LLVMConstInt(c->i32,
genfun_vtable_index(c, g, stringtab("_event_notify"), NULL), false);
args[DESC_TRAITS] = make_trait_list(c, g);
args[DESC_FIELDS] = make_field_list(c, g);
args[DESC_VTABLE] = make_vtable(c, g);
LLVMValueRef desc = LLVMConstNamedStruct(g->desc_type, args, DESC_LENGTH);
LLVMSetInitializer(g->desc, desc);
LLVMSetGlobalConstant(g->desc, true);
}
ast_t* program_load(const char* path, pass_opt_t* options)
{
ast_t* program = ast_blank(TK_PROGRAM);
ast_scope(program);
options->program_pass = PASS_PARSE;
// Always load builtin package first, then the specified one.
if(package_load(program, stringtab("builtin"), options) == NULL ||
package_load(program, path, options) == NULL)
{
ast_free(program);
return NULL;
}
// Reorder packages so specified package is first.
ast_t* builtin = ast_pop(program);
ast_append(program, builtin);
if(!ast_passes_program(program, options))
{
ast_free(program);
return NULL;
}
return program;
}
LLVMValueRef gen_pattern_eq(compile_t* c, ast_t* pattern, LLVMValueRef r_value)
{
// This is used for structural equality in pattern matching.
ast_t* pattern_type = ast_type(pattern);
AST_GET_CHILDREN(pattern_type, package, id);
// Special case equality on primitive types.
if(ast_name(package) == c->str_builtin)
{
const char* name = ast_name(id);
if((name == c->str_Bool) ||
(name == c->str_I8) ||
(name == c->str_I16) ||
(name == c->str_I32) ||
(name == c->str_I64) ||
(name == c->str_I128) ||
(name == c->str_ILong) ||
(name == c->str_ISize) ||
(name == c->str_U8) ||
(name == c->str_U16) ||
(name == c->str_U32) ||
(name == c->str_U64) ||
(name == c->str_U128) ||
(name == c->str_ULong) ||
(name == c->str_USize) ||
(name == c->str_F32) ||
(name == c->str_F64)
)
{
return gen_eq_rvalue(c, pattern, r_value);
}
}
// Generate the receiver.
LLVMValueRef l_value = gen_expr(c, pattern);
gentype_t g;
if(!gentype(c, pattern_type, &g))
return NULL;
// Static or virtual dispatch.
LLVMValueRef func = dispatch_function(c, pattern, &g, l_value,
stringtab("eq"), NULL);
if(func == NULL)
return NULL;
// Call the function. We know it isn't partial.
LLVMValueRef args[2];
args[0] = l_value;
args[1] = r_value;
// Emit debug location for calls to test for structural equality
dwarf_location(&c->dwarf, pattern);
return codegen_call(c, func, args, 2);
}
void package_add_magic(const char* path, const char* src)
{
magic_package_t* n = POOL_ALLOC(magic_package_t);
n->path = stringtab(path);
n->src = src;
n->next = magic_packages;
magic_packages = n;
}
void errorv(source_t* source, size_t line, size_t pos, const char* fmt,
va_list ap)
{
char buf[LINE_LEN];
vsnprintf(buf, LINE_LEN, fmt, ap);
errormsg_t* e = POOL_ALLOC(errormsg_t);
memset(e, 0, sizeof(errormsg_t));
if(source != NULL)
e->file = source->file;
e->line = line;
e->pos = pos;
e->msg = stringtab(buf);
if((source != NULL) && (line != 0))
{
size_t tline = 1;
size_t tpos = 0;
while((tline < e->line) && (tpos < source->len))
{
if(source->m[tpos] == '\n')
tline++;
tpos++;
}
size_t start = tpos;
while((source->m[tpos] != '\n') && (tpos < source->len))
tpos++;
size_t len = tpos - start;
if(len >= sizeof(buf))
len = sizeof(buf) - 1;
memcpy(buf, &source->m[start], len);
buf[len] = '\0';
e->source = stringtab(buf);
}
add_error(e);
}
static const char* symbol_suffix(const char* symbol, size_t suffix)
{
size_t len = strlen(symbol);
VLA(char, buf, len + 32);
snprintf(buf, len + 32, "%s" __zu, symbol, suffix);
return stringtab(buf);
}
bool expr_consume(pass_opt_t* opt, ast_t* ast)
{
AST_GET_CHILDREN(ast, cap, term);
ast_t* type = ast_type(term);
if(is_typecheck_error(type))
return false;
const char* name = NULL;
switch(ast_id(term))
{
case TK_VARREF:
case TK_LETREF:
case TK_PARAMREF:
{
ast_t* id = ast_child(term);
name = ast_name(id);
break;
}
case TK_THIS:
{
name = stringtab("this");
break;
}
default:
ast_error(opt->check.errors, ast,
"consume must take 'this', a local, or a parameter");
return false;
}
// Can't consume from an outer scope while in a loop condition.
if((opt->check.frame->loop_cond != NULL) &&
!ast_within_scope(opt->check.frame->loop_cond, ast, name))
{
ast_error(opt->check.errors, ast,
"can't consume from an outer scope in a loop condition");
return false;
}
ast_setstatus(ast, name, SYM_CONSUMED);
token_id tcap = ast_id(cap);
ast_t* c_type = consume_type(type, tcap);
if(c_type == NULL)
{
ast_error(opt->check.errors, ast, "can't consume to this capability");
ast_error_continue(opt->check.errors, term, "expression type is %s",
ast_print_type(type));
return false;
}
ast_settype(ast, c_type);
return true;
}
void package_add_magic_src(const char* path, const char* src, pass_opt_t* opt)
{
magic_package_t* n = POOL_ALLOC(magic_package_t);
n->path = stringtab(path);
n->src = src;
n->mapped_path = NULL;
n->next = opt->magic_packages;
opt->magic_packages = n;
}
uint32_t reach_vtable_index(reachable_type_t* t, const char* name)
{
reachable_method_t* m = reach_method(t, stringtab(name), NULL);
if(m == NULL)
return (uint32_t)-1;
return m->vtable_index;
}
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);
}
void dwarf_this(dwarf_t* dwarf, ast_t* fun, const char* type,
LLVMBasicBlockRef entry, LLVMValueRef storage)
{
dwarf_meta_t meta;
meta_local(&meta, fun, stringtab("this"), type, entry, storage, 0, true);
meta.flags |= DWARF_ARTIFICIAL;
symbols_local(dwarf->symbols, &meta, true);
}
// Check whether the given entity has illegal parts
static ast_result_t syntax_entity(ast_t* ast, int entity_def_index)
{
assert(ast != NULL);
assert(entity_def_index >= 0 && entity_def_index < DEF_ENTITY_COUNT);
ast_result_t r = AST_OK;
const permission_def_t* def = &_entity_def[entity_def_index];
AST_GET_CHILDREN(ast, id, typeparams, defcap, provides, members, c_api);
// Check if we're called Main
if(def->permissions[ENTITY_MAIN] == 'N' && ast_name(id) == stringtab("Main"))
{
ast_error(ast, "Main must be an actor");
r = AST_ERROR;
}
if(!check_id_type(id, def->desc))
r = AST_ERROR;
if(!check_permission(def, ENTITY_CAP, defcap, "default capability", defcap))
r = AST_ERROR;
if(!check_permission(def, ENTITY_C_API, c_api, "C api", c_api))
r = AST_ERROR;
if(ast_id(c_api) == TK_AT)
{
if(ast_id(typeparams) != TK_NONE)
{
ast_error(typeparams, "generic actor cannot specify C api");
r = AST_ERROR;
}
}
if(entity_def_index != DEF_TYPEALIAS)
{
// Check referenced traits
if(ast_id(provides) != TK_NONE &&
!check_provides_type(provides, "provides"))
r = AST_ERROR;
}
else
{
// Check for a type alias
if(ast_id(provides) == TK_NONE)
{
ast_error(provides, "a type alias must specify a type");
r = AST_ERROR;
}
}
// Check for illegal members
if(!check_members(members, entity_def_index))
r = AST_ERROR;
return r;
}
static bool add_safe(const char* path)
{
path = stringtab(path);
if(strlist_find(safe, path) == NULL)
safe = strlist_append(safe, path);
return true;
}
static bool add_safe(const char* path, pass_opt_t* opt)
{
path = stringtab(path);
strlist_t* safe = opt->safe_packages;
if(strlist_find(safe, path) == NULL)
opt->safe_packages = strlist_append(safe, path);
return true;
}
static ast_t* eq_param_type(ast_t* pattern)
{
ast_t* pattern_type = ast_type(pattern);
ast_t* fun = lookup(NULL, pattern, pattern_type, stringtab("eq"));
AST_GET_CHILDREN(fun, cap, id, typeparams, params, result, partial);
ast_t* param = ast_child(params);
return ast_childidx(param, 1);
}
const char* ast_print_type(ast_t* type)
{
printbuf_t* buffer = printbuf_new();
print_type(buffer, type);
const char* s = stringtab(buffer->m);
printbuf_free(buffer);
return s;
}
void dwarf_init(dwarf_t* dwarf, pass_opt_t* opt, LLVMBuilderRef builder,
LLVMTargetDataRef layout, LLVMModuleRef module)
{
dwarf->opt = opt;
dwarf->target_data = layout;
dwarf->has_source = false;
symbols_init(&dwarf->symbols, builder, module, opt->release);
symbols_unspecified(dwarf->symbols, stringtab("$object"));
}
static const char* make_full_name(reach_type_t* t, reach_method_t* m)
{
// Generate the full mangled name.
// pkg_Type[_Arg1_Arg2]_cap_name[_Arg1_Arg2]_args_result
printbuf_t* buf = printbuf_new();
printbuf(buf, "%s_%s", t->name, m->mangled_name);
const char* name = stringtab(buf->m);
printbuf_free(buf);
return name;
}