From 62d93987726825ffdbbf0d01ee1c5c51771aa4bc Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Wed, 12 Feb 2025 20:47:47 +0100 Subject: [PATCH] Index strings --- boot/parser.yy | 2 +- gcc/elna-builtins.cc | 11 ++-- gcc/elna-diagnostic.cc | 37 +++++++++++- gcc/elna-generic.cc | 107 ++++++++++++++++++++++++----------- gcc/elna-spec.cc | 12 ++-- gcc/elna-tree.cc | 19 ++++++- gcc/elna1.cc | 8 +-- include/elna/gcc/elna-tree.h | 3 + include/elna/gcc/elna1.h | 4 ++ source.elna | 39 ++++++------- 10 files changed, 166 insertions(+), 76 deletions(-) diff --git a/boot/parser.yy b/boot/parser.yy index e4824cb..7f324f3 100644 --- a/boot/parser.yy +++ b/boot/parser.yy @@ -366,7 +366,7 @@ expressions: designator_expression: operand LEFT_SQUARE expression RIGHT_SQUARE { - $$ = new elna::boot::array_access_expression(elna::boot::make_position(@1), $1, $3); + $$ = new elna::boot::array_access_expression(elna::boot::make_position(@2), $1, $3); } | operand DOT IDENTIFIER { diff --git a/gcc/elna-builtins.cc b/gcc/elna-builtins.cc index 3c2de3f..22aba2c 100644 --- a/gcc/elna-builtins.cc +++ b/gcc/elna-builtins.cc @@ -41,14 +41,13 @@ namespace gcc elna_string_type_node = make_node(RECORD_TYPE); tree string_ptr_type = build_pointer_type_for_mode(elna_char_type_node, VOIDmode, true); - tree record_chain = NULL_TREE; - record_chain = chainon(record_chain, - build_field(UNKNOWN_LOCATION, elna_string_type_node, "length", elna_word_type_node)); - record_chain = chainon(record_chain, - build_field(UNKNOWN_LOCATION, elna_string_type_node, "ptr", string_ptr_type)); + elna_string_length_field_node = build_field(UNKNOWN_LOCATION, + elna_string_type_node, "length", elna_word_type_node); + elna_string_ptr_field_node = build_field(UNKNOWN_LOCATION, + elna_string_type_node, "ptr", string_ptr_type); - TYPE_FIELDS(elna_string_type_node) = record_chain; + TYPE_FIELDS(elna_string_type_node) = chainon(elna_string_ptr_field_node, elna_string_length_field_node); layout_type(elna_string_type_node); } } diff --git a/gcc/elna-diagnostic.cc b/gcc/elna-diagnostic.cc index 788a333..28c7efb 100644 --- a/gcc/elna-diagnostic.cc +++ b/gcc/elna-diagnostic.cc @@ -58,11 +58,43 @@ namespace gcc { return "Char"; } + else if (type == elna_string_type_node) + { + return "String"; + } + else if (is_void_type(type)) // For procedures without a return type. + { + return "()"; + } else if (is_pointer_type(type)) { - return std::string("\"pointer to " + print_type(TREE_TYPE(type)) + "\""); + return std::string("pointer to " + print_type(TREE_TYPE(type))); } - else if (TREE_CODE(type) == ARRAY_TYPE) + else if (is_procedure_type(type)) + { + std::string output = "proc("; + tree parameter_type = TYPE_ARG_TYPES(type); + while (parameter_type != NULL_TREE) + { + output += print_type(TREE_VALUE(parameter_type)); + parameter_type = TREE_CHAIN(parameter_type); + if (TREE_VALUE(parameter_type) == void_type_node) + { + break; + } + else + { + output += ", "; + } + } + output += ')'; + if (!is_void_type(TREE_TYPE(type))) + { + output += " -> " + print_type(TREE_TYPE(type)); + } + return output; + } + else if (is_array_type(type)) { return "array"; } @@ -78,6 +110,7 @@ namespace gcc { return "<>"; } + gcc_unreachable(); } } } diff --git a/gcc/elna-generic.cc b/gcc/elna-generic.cc index ae29817..d6d2709 100644 --- a/gcc/elna-generic.cc +++ b/gcc/elna-generic.cc @@ -46,36 +46,44 @@ namespace gcc void generic_visitor::visit(boot::call_expression *expression) { tree symbol = this->lookup(expression->name()); + location_t call_location = get_location(&expression->position()); if (symbol == NULL_TREE) { - error_at(get_location(&expression->position()), - "procedure '%s' not declared", + error_at(call_location, "procedure '%s' not declared", expression->name().c_str()); this->current_expression = error_mark_node; - return; } - tree return_type = TREE_TYPE(TREE_TYPE(symbol)); - tree fndecl_type = build_function_type(return_type, TYPE_ARG_TYPES(symbol)); - tree printf_fn = build1(ADDR_EXPR, build_pointer_type(fndecl_type), symbol); - - std::vector arguments(expression->arguments().size()); - for (std::size_t i = 0; i < expression->arguments().size(); ++i) + else if (DECL_P(symbol) && is_procedure_type(TREE_TYPE(symbol))) { - expression->arguments().at(i)->accept(this); - arguments[i] = this->current_expression; - } - tree stmt = build_call_array_loc(get_location(&expression->position()), - return_type, printf_fn, arguments.size(), arguments.data()); + tree return_type = TREE_TYPE(TREE_TYPE(symbol)); + tree fndecl_type = build_function_type(return_type, TYPE_ARG_TYPES(symbol)); + tree printf_fn = build1(ADDR_EXPR, build_pointer_type(fndecl_type), symbol); - if (return_type == void_type_node) - { - append_statement(stmt); - this->current_expression = NULL_TREE; + std::vector arguments(expression->arguments().size()); + for (std::size_t i = 0; i < expression->arguments().size(); ++i) + { + expression->arguments().at(i)->accept(this); + arguments[i] = this->current_expression; + } + tree stmt = build_call_array_loc(get_location(&expression->position()), + return_type, printf_fn, arguments.size(), arguments.data()); + + if (return_type == void_type_node) + { + append_statement(stmt); + this->current_expression = NULL_TREE; + } + else + { + this->current_expression = stmt; + } } else { - this->current_expression = stmt; + 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()); + this->current_expression = error_mark_node; } } @@ -347,14 +355,14 @@ namespace gcc TREE_READONLY(string_literal) = 1; TREE_STATIC(string_literal) = 1; - string_type = TREE_TYPE(TREE_CHAIN(TYPE_FIELDS(elna_string_type_node))); + string_type = TREE_TYPE(elna_string_ptr_field_node); string_literal = build4(ARRAY_REF, elna_char_type_node, string_literal, integer_zero_node, NULL_TREE, NULL_TREE); string_literal = build1(ADDR_EXPR, string_type, string_literal); vec *elms = NULL; - CONSTRUCTOR_APPEND_ELT(elms, TYPE_FIELDS(elna_string_type_node), index_constant); - CONSTRUCTOR_APPEND_ELT(elms, TREE_CHAIN(TYPE_FIELDS(elna_string_type_node)), string_literal); + CONSTRUCTOR_APPEND_ELT(elms, elna_string_ptr_field_node, string_literal); + CONSTRUCTOR_APPEND_ELT(elms, elna_string_length_field_node, index_constant); this->current_expression = build_constructor(elna_string_type_node, elms); } @@ -401,14 +409,15 @@ namespace gcc } if (TREE_TYPE(left) == elna_string_type_node) { - tree length_field = TYPE_FIELDS(elna_string_type_node); - tree ptr_field = TREE_CHAIN(length_field); + tree lhs_length = build3(COMPONENT_REF, TREE_TYPE(elna_string_length_field_node), + left, elna_string_length_field_node, NULL_TREE); + tree lhs_ptr = build3(COMPONENT_REF, TREE_TYPE(elna_string_ptr_field_node), + left, elna_string_ptr_field_node, NULL_TREE); - tree lhs_length = build3(COMPONENT_REF, TREE_TYPE(length_field), left, length_field, NULL_TREE); - tree lhs_ptr = build3(COMPONENT_REF, TREE_TYPE(ptr_field), left, ptr_field, NULL_TREE); - - tree rhs_length = build3(COMPONENT_REF, TREE_TYPE(length_field), right, length_field, NULL_TREE); - tree rhs_ptr = build3(COMPONENT_REF, TREE_TYPE(ptr_field), right, ptr_field, NULL_TREE); + tree rhs_length = build3(COMPONENT_REF, TREE_TYPE(elna_string_length_field_node), + right, elna_string_length_field_node, NULL_TREE); + tree rhs_ptr = build3(COMPONENT_REF, TREE_TYPE(elna_string_ptr_field_node), + right, elna_string_ptr_field_node, NULL_TREE); tree length_equality = build2(equality_code, elna_bool_type_node, lhs_length, rhs_length); tree *memcmp = elna_global_decls->get("__builtin_memcmp"); @@ -732,14 +741,46 @@ namespace gcc { expression->base().accept(this); tree designator = this->current_expression; + location_t location = get_location(&expression->position()); expression->index().accept(this); - tree index = this->current_expression; + if (!is_integral_type(TREE_TYPE(this->current_expression))) + { + error_at(location, "type '%s' cannot be used as index", + print_type(TREE_TYPE(this->current_expression)).c_str()); + this->current_expression = error_mark_node; + return; + } + if (this->current_expression != elna_word_type_node) + { + this->current_expression = fold_convert(elna_word_type_node, this->current_expression); + } + tree offset = build2(MINUS_EXPR, elna_word_type_node, + this->current_expression, size_one_node); - tree element_type = TREE_TYPE(TREE_TYPE(designator)); + if (is_array_type(TREE_TYPE(designator))) + { + tree element_type = TREE_TYPE(TREE_TYPE(designator)); - this->current_expression = build4_loc(get_location(&expression->position()), - ARRAY_REF, element_type, designator, index, NULL_TREE, NULL_TREE); + this->current_expression = build4_loc(location, + ARRAY_REF, element_type, designator, offset, NULL_TREE, NULL_TREE); + } + else if (TREE_TYPE(designator) == elna_string_type_node) + { + tree string_ptr = build3_loc(location, COMPONENT_REF, TREE_TYPE(elna_string_ptr_field_node), + designator, elna_string_ptr_field_node, NULL_TREE); + + tree target_pointer = do_pointer_arithmetic(boot::binary_operator::sum, string_ptr, offset); + + this->current_expression = build1_loc(location, INDIRECT_REF, + elna_char_type_node, target_pointer); + } + else + { + error_at(location, "indexing is not allowed on type '%s'", + print_type(TREE_TYPE(designator)).c_str()); + this->current_expression = error_mark_node; + } } void generic_visitor::visit(boot::field_access_expression *expression) diff --git a/gcc/elna-spec.cc b/gcc/elna-spec.cc index af6bc81..3489958 100644 --- a/gcc/elna-spec.cc +++ b/gcc/elna-spec.cc @@ -15,18 +15,16 @@ You should have received a copy of the GNU General Public License along with GCC; see the file COPYING3. If not see . */ -void -lang_specific_driver (struct cl_decoded_option ** /* in_decoded_options */, - unsigned int * /* in_decoded_options_count */, - int * /*in_added_libraries */) +void lang_specific_driver(struct cl_decoded_option ** /* in_decoded_options */, + unsigned int * /* in_decoded_options_count */, + int * /*in_added_libraries */) { } /* Called before linking. Returns 0 on success and -1 on failure. */ -int -lang_specific_pre_link (void) +int lang_specific_pre_link (void) { - return 0; + return 0; } /* Number of extra output files that lang_specific_pre_link may generate. */ diff --git a/gcc/elna-tree.cc b/gcc/elna-tree.cc index 5613724..17d3db2 100644 --- a/gcc/elna-tree.cc +++ b/gcc/elna-tree.cc @@ -45,6 +45,23 @@ namespace gcc return is_integral_type(type) || type == elna_float_type_node; } + bool is_array_type(tree type) + { + gcc_assert(TYPE_P(type)); + return TREE_CODE(type) == ARRAY_TYPE; + } + + bool is_procedure_type(tree type) + { + gcc_assert(TYPE_P(type)); + return TREE_CODE(type) == FUNCTION_TYPE; + } + + bool is_void_type(tree type) + { + return type == NULL_TREE || type == void_type_node; + } + bool are_compatible_pointers(tree lhs, tree rhs) { tree lhs_type = TREE_TYPE(lhs); @@ -149,7 +166,7 @@ namespace gcc return fold_build2(POINTER_DIFF_EXPR, ssizetype, left, right); } } - return error_mark_node; + gcc_unreachable(); } tree build_binary_operation(bool condition, boot::binary_expression *expression, diff --git a/gcc/elna1.cc b/gcc/elna1.cc index 5ea5ab4..e2361b6 100644 --- a/gcc/elna1.cc +++ b/gcc/elna1.cc @@ -41,10 +41,10 @@ hash_map *elna_global_decls = nullptr; /* The resulting tree type. */ -union GTY ((desc ("TREE_CODE (&%h.generic) == IDENTIFIER_NODE"), - chain_next ("CODE_CONTAINS_STRUCT (TREE_CODE (&%h.generic), " - "TS_COMMON) ? ((union lang_tree_node *) TREE_CHAIN " - "(&%h.generic)) : NULL"))) lang_tree_node +union GTY ((desc("TREE_CODE (&%h.generic) == IDENTIFIER_NODE"), + chain_next("CODE_CONTAINS_STRUCT (TREE_CODE (&%h.generic), " + "TS_COMMON) ? ((union lang_tree_node *) TREE_CHAIN " + "(&%h.generic)) : NULL"))) lang_tree_node { union tree_node GTY ((tag ("0"), desc ("tree_node_structure (&%h)"))) generic; }; diff --git a/include/elna/gcc/elna-tree.h b/include/elna/gcc/elna-tree.h index 8586355..bb10911 100644 --- a/include/elna/gcc/elna-tree.h +++ b/include/elna/gcc/elna-tree.h @@ -36,6 +36,9 @@ namespace gcc bool is_pointer_type(tree type); bool is_integral_type(tree type); bool is_numeric_type(tree type); + bool is_array_type(tree type); + bool is_procedure_type(tree type); + bool is_void_type(tree type); /** * \param lhs Left hand value. diff --git a/include/elna/gcc/elna1.h b/include/elna/gcc/elna1.h index f4f86f5..418c832 100644 --- a/include/elna/gcc/elna1.h +++ b/include/elna/gcc/elna1.h @@ -27,6 +27,8 @@ enum elna_tree_index ELNA_TI_BOOL_TRUE, ELNA_TI_BOOL_FALSE, ELNA_TI_POINTER_NIL, + ELNA_TI_STRING_PTR_FIELD, + ELNA_TI_STRING_LENGTH_FIELD, ELNA_TI_MAX }; @@ -43,6 +45,8 @@ extern GTY(()) hash_map *elna_global_decls; #define elna_bool_true_node elna_global_trees[ELNA_TI_BOOL_TRUE] #define elna_bool_false_node elna_global_trees[ELNA_TI_BOOL_FALSE] #define elna_pointer_nil_node elna_global_trees[ELNA_TI_POINTER_NIL] +#define elna_string_ptr_field_node elna_global_trees[ELNA_TI_STRING_PTR_FIELD] +#define elna_string_length_field_node elna_global_trees[ELNA_TI_STRING_LENGTH_FIELD] /* Language-dependent contents of a type. */ struct GTY (()) lang_type diff --git a/source.elna b/source.elna index 2a08830..6981e38 100644 --- a/source.elna +++ b/source.elna @@ -127,11 +127,10 @@ end proc write_i(value: Int); var - digit: Int, n: Int, + digit: Int, n: Word, buffer: array 10 of Char; begin - n := 9; - buffer[9] := '0'; + n := 10u; if value = 0 then write_c('0') @@ -141,10 +140,10 @@ begin value := value / 10; buffer[n] := cast(cast('0' as Int) + digit as Char); - n := n - 1 + n := n - 1u end; - while n < 9 do - n := n + 1; + while n < 10u do + n := n + 1u; write_c(buffer[n]) end end @@ -184,7 +183,8 @@ end proc substring(string: String, start: Word, count: Word) -> String; begin string.ptr := string.ptr + start; - string.length := count + string.length := count; + return string end proc string_dup(origin: String) -> String; @@ -198,11 +198,6 @@ begin return origin end -proc char_at(string: String, position: Word) -> Char; -begin - return (string.ptr + position)^ -end - (* End of standard procedures. *) @@ -302,8 +297,8 @@ end proc skip_spaces(source_code: SourceCode) -> SourceCode; begin - while source_code.text.length > 0u and is_space(char_at(source_code.text, 0)) do - if char_at(source_code.text, 0) = '\n' then + while source_code.text.length > 0u and is_space(source_code.text[1u]) do + if source_code.text[1u] = '\n' then source_code.position.line := source_code.position.line + 1u; source_code.position.column := 1u else @@ -321,7 +316,7 @@ begin content_length := 0u; token_content^ := source_code^.text; - while is_alnum(char_at(source_code^.text, 0)) or char_at(source_code^.text, 0) = '_' do + while is_alnum(source_code^.text[1u]) or source_code^.text[1u] = '_' do content_length := content_length + 1u; source_code^ := advance_source(source_code^, 1u) end; @@ -336,7 +331,7 @@ begin token_content^ := source_code^.text; while source_code^.text.length > 1u do - if char_at(source_code^.text, 0) = '*' and char_at(source_code^.text, 1) = ')' then + if source_code^.text[1u] = '*' and source_code^.text[2u] = ')' then source_code^ := advance_source(source_code^, 2u); token_content^ := substring(token_content^, 0, content_length); @@ -638,7 +633,7 @@ begin while source_code.text.length <> 0u do tokens := cast(reallocarray(tokens, tokens_size^ + 1u, sizeof(Token)) as pointer to Token); current_token := tokens + tokens_size^; - first_char := char_at(source_code.text, 0); + first_char := source_code.text[1u]; if is_alpha(first_char) or first_char = '_' then lex_identifier(@source_code, @token_content); @@ -660,7 +655,7 @@ begin if source_code.text.length = 0u then current_token^.kind := TOKEN_LEFT_PAREN - elsif char_at(source_code.text, 0u) = '*' then + elsif source_code.text[1u] = '*' then source_code := advance_source(source_code, 1u); if lex_comment(@source_code, @token_content) then @@ -704,7 +699,7 @@ begin if source_code.text.length = 0u then current_token^.kind := TOKEN_GREATER_THAN - elsif char_at(source_code.text, 0) = '=' then + elsif source_code.text[1u] = '=' then current_token^.kind := TOKEN_GREATER_EQUAL; source_code := advance_source(source_code, 1u) else @@ -715,10 +710,10 @@ begin if source_code.text.length = 0u then current_token^.kind := TOKEN_LESS_THAN - elsif char_at(source_code.text, 0) = '=' then + elsif source_code.text[1u] = '=' then current_token^.kind := TOKEN_LESS_EQUAL; source_code := advance_source(source_code, 1u) - elsif char_at(source_code.text, 0) = '>' then + elsif source_code.text[1u] = '>' then current_token^.kind := TOKEN_NOT_EQUAL; source_code := advance_source(source_code, 1u) else @@ -756,7 +751,7 @@ begin if source_code.text.length = 0u then current_token^.kind := TOKEN_COLON - elsif char_at(source_code.text, 0) = '=' then + elsif source_code.text[1u] = '=' then current_token^.kind := TOKEN_ASSIGNMENT; source_code := advance_source(source_code, 1u) else