Implement procedure pointers

This commit is contained in:
2025-02-24 00:24:36 +01:00
parent 18857e1a88
commit 85b6843ecf
9 changed files with 217 additions and 181 deletions

View File

@ -44,10 +44,12 @@ namespace gcc
}
void generic_visitor::build_procedure_call(location_t call_location,
tree symbol, const std::vector<boot::expression *>& arguments)
tree procedure_address, const std::vector<boot::expression *>& arguments)
{
vec<tree, va_gc> *argument_trees = nullptr;
tree current_parameter = TYPE_ARG_TYPES(TREE_TYPE(symbol));
tree symbol_type = TREE_TYPE(TREE_TYPE(procedure_address));
tree current_parameter = TYPE_ARG_TYPES(symbol_type);
vec_alloc(argument_trees, arguments.size());
for (boot::expression *const argument : arguments)
@ -56,11 +58,12 @@ namespace gcc
if (is_void_type(TREE_VALUE(current_parameter)))
{
error_at(argument_location, "too many arguments, expected %i, got %lu",
list_length(TYPE_ARG_TYPES(TREE_TYPE(symbol))) - 1, arguments.size());
list_length(TYPE_ARG_TYPES(symbol_type)) - 1, arguments.size());
this->current_expression = error_mark_node;
break;
}
argument->accept(this);
this->current_expression = prepare_rvalue(this->current_expression);
if (!is_assignable_from(TREE_VALUE(current_parameter), this->current_expression))
{
error_at(argument_location,
@ -72,15 +75,16 @@ namespace gcc
current_parameter = TREE_CHAIN(current_parameter);
argument_trees->quick_push(this->current_expression);
}
tree stmt = build_call_expr_loc_vec(call_location, symbol, argument_trees);
tree stmt = fold_build_call_array_loc(call_location, TREE_TYPE(symbol_type),
procedure_address, vec_safe_length(argument_trees), vec_safe_address(argument_trees));
if (!is_void_type(TREE_VALUE(current_parameter)))
{
error_at(call_location, "too few arguments, expected %i, got %lu",
list_length(TYPE_ARG_TYPES(TREE_TYPE(symbol))) - 1, arguments.size());
list_length(TYPE_ARG_TYPES(symbol_type)) - 1, arguments.size());
this->current_expression = error_mark_node;
}
else if (TREE_TYPE(TREE_TYPE(symbol)) == void_type_node)
else if (TREE_TYPE(symbol_type) == void_type_node)
{
append_statement(stmt);
this->current_expression = NULL_TREE;
@ -134,27 +138,31 @@ namespace gcc
void generic_visitor::visit(boot::call_expression *expression)
{
tree symbol = this->lookup(expression->name());
location_t call_location = get_location(&expression->position());
expression->callable().accept(this);
if (symbol == NULL_TREE)
tree expression_type = TYPE_P(this->current_expression)
? this->current_expression
: TREE_TYPE(this->current_expression);
if (TYPE_P(this->current_expression) && TREE_CODE(expression_type) == RECORD_TYPE)
{
error_at(call_location, "procedure '%s' not declared",
expression->name().c_str());
this->current_expression = error_mark_node;
build_record_call(call_location, this->current_expression, expression->arguments);
}
else if (DECL_P(symbol) && is_procedure_type(TREE_TYPE(symbol)))
else if (TREE_CODE(expression_type) == FUNCTION_TYPE)
{
build_procedure_call(call_location, symbol, expression->arguments());
this->current_expression = build1(ADDR_EXPR,
build_pointer_type_for_mode(expression_type, VOIDmode, true), this->current_expression);
build_procedure_call(call_location, this->current_expression, expression->arguments);
}
else if (TYPE_P(symbol) && TREE_CODE(symbol) == RECORD_TYPE)
else if (is_pointer_type(expression_type) && TREE_CODE(TREE_TYPE(expression_type)) == FUNCTION_TYPE)
{
build_record_call(call_location, symbol, expression->arguments());
build_procedure_call(call_location, this->current_expression, expression->arguments);
}
else
{
error_at(call_location, "'%s' cannot be called, it is neither a procedure nor record",
print_type(TYPE_P(symbol) ? symbol : TREE_TYPE(symbol)).c_str());
print_type(expression_type).c_str());
this->current_expression = error_mark_node;
}
}
@ -242,7 +250,7 @@ namespace gcc
void generic_visitor::visit(boot::procedure_definition *definition)
{
tree declaration_type = build_type(definition->heading());
tree declaration_type = build_procedure_type(definition->heading());
tree fndecl = build_fn_decl(definition->identifier.c_str(), declaration_type);
this->symbol_map->enter(definition->identifier, fndecl);
@ -281,6 +289,7 @@ namespace gcc
}
DECL_ARGUMENTS(fndecl) = argument_chain;
TREE_PUBLIC(fndecl) = definition->exported;
TREE_ADDRESSABLE(fndecl) = 1;
if (definition->body != nullptr)
{
@ -647,6 +656,7 @@ namespace gcc
switch (expression->operation())
{
case boot::unary_operator::reference:
this->current_expression = prepare_rvalue(this->current_expression);
TREE_ADDRESSABLE(this->current_expression) = 1;
this->current_expression = build_fold_addr_expr_with_type_loc(location,
this->current_expression,
@ -739,6 +749,21 @@ namespace gcc
}
}
tree generic_visitor::build_procedure_type(boot::procedure_type& type)
{
std::vector<tree> parameter_types(type.parameters.size());
for (std::size_t i = 0; i < type.parameters.size(); ++i)
{
parameter_types[i] = build_type(type.parameters.at(i)->variable_type());
}
tree return_type = type.return_type == nullptr
? void_type_node
: build_type(*type.return_type);
return build_function_type_array(return_type, type.parameters.size(), parameter_types.data());
}
tree generic_visitor::build_type(boot::top_type& type)
{
if (std::shared_ptr<boot::basic_type> basic_type = type.is_basic())
@ -834,18 +859,8 @@ namespace gcc
}
else if (std::shared_ptr<boot::procedure_type> procedure_type = type.is_procedure())
{
std::vector<tree> parameter_types(procedure_type->parameters.size());
for (std::size_t i = 0; i < procedure_type->parameters.size(); ++i)
{
parameter_types[i] = build_type(procedure_type->parameters.at(i)->variable_type());
}
tree return_type = procedure_type->return_type == nullptr
? void_type_node
: build_type(*procedure_type->return_type);
return build_function_type_array(return_type,
procedure_type->parameters.size(), parameter_types.data());
tree procedure_type_node = build_procedure_type(*procedure_type);
return build_pointer_type_for_mode(procedure_type_node, VOIDmode, true);
}
return NULL_TREE;
}
@ -893,14 +908,10 @@ namespace gcc
if (symbol == NULL_TREE)
{
error_at(get_location(&expression->position()),
"variable '%s' not declared in the current scope",
"symbol '%s' not declared in the current scope",
expression->name().c_str());
this->current_expression = error_mark_node;
}
else if (TREE_CODE(symbol) == FUNCTION_DECL)
{
this->current_expression = build1(ADDR_EXPR, build_pointer_type(TREE_TYPE(symbol)), symbol);
}
else
{
this->current_expression = symbol;
@ -1029,10 +1040,11 @@ namespace gcc
{
statement->lvalue().accept(this);
auto lvalue = this->current_expression;
auto statement_location = get_location(&statement->position());
tree lvalue = this->current_expression;
location_t statement_location = get_location(&statement->position());
statement->rvalue().accept(this);
tree rvalue = prepare_rvalue(this->current_expression);
if (TREE_CODE(lvalue) == CONST_DECL)
{
@ -1040,10 +1052,9 @@ namespace gcc
statement->lvalue().is_variable()->name().c_str());
this->current_expression = error_mark_node;
}
else if (is_assignable_from(TREE_TYPE(lvalue), this->current_expression))
else if (is_assignable_from(TREE_TYPE(lvalue), rvalue))
{
tree assignment = build2_loc(statement_location, MODIFY_EXPR,
void_type_node, lvalue, this->current_expression);
tree assignment = build2_loc(statement_location, MODIFY_EXPR, void_type_node, lvalue, rvalue);
append_statement(assignment);
this->current_expression = NULL_TREE;
@ -1052,7 +1063,7 @@ namespace gcc
{
error_at(statement_location,
"cannot assign value of type '%s' to variable of type '%s'",
print_type(TREE_TYPE(this->current_expression)).c_str(),
print_type(TREE_TYPE(rvalue)).c_str(),
print_type(TREE_TYPE(lvalue)).c_str());
this->current_expression = error_mark_node;
}