From 768537d6e4b82a19e77b7e44234309ecaf4d65d2 Mon Sep 17 00:00:00 2001 From: Eugen Wissner Date: Sun, 12 Jul 2026 13:23:54 +0200 Subject: Remove unions --- boot/ast.cc | 34 - boot/lexer.ll | 3 - boot/parser.yy | 5 - boot/semantic.cc | 20 - boot/symbol.cc | 24 - cl.elna | 6916 ++++++++++++++++++++++++++++++ gcc/gcc/elna-builtins.cc | 8 - gcc/gcc/elna-diagnostic.cc | 4 - include/elna/boot/ast.h | 16 - include/elna/boot/semantic.h | 1 - include/elna/boot/symbol.h | 9 - source/cstdio.elna | 12 + source/cstdlib.elna | 12 +- source/cstring.elna | 17 +- source/lexer.elna | 1050 +---- source/main.elna | 400 +- testsuite/runnable/record_extension.elna | 19 + 17 files changed, 7296 insertions(+), 1254 deletions(-) create mode 100644 cl.elna create mode 100644 testsuite/runnable/record_extension.elna diff --git a/boot/ast.cc b/boot/ast.cc index d0d19b7..fbecf11 100644 --- a/boot/ast.cc +++ b/boot/ast.cc @@ -39,11 +39,6 @@ namespace elna::boot __builtin_unreachable(); } - void empty_visitor::visit(union_type_expression *) - { - __builtin_unreachable(); - } - void empty_visitor::visit(procedure_type_expression *) { __builtin_unreachable(); @@ -391,14 +386,6 @@ namespace elna::boot } } - void walking_visitor::visit(union_type_expression *expression) - { - for (const field_declaration& field : expression->fields) - { - field.second->accept(this); - } - } - void walking_visitor::visit(procedure_type_expression *expression) { for (const field_declaration& field : expression->parameters) @@ -557,11 +544,6 @@ namespace elna::boot return nullptr; } - union_type_expression *type_expression::is_union() - { - return nullptr; - } - procedure_type_expression *type_expression::is_procedure() { return nullptr; @@ -646,22 +628,6 @@ namespace elna::boot return this; } - union_type_expression::union_type_expression(const struct position position, - std::vector&& fields) - : node(position), fields(std::move(fields)) - { - } - - void union_type_expression::accept(parser_visitor *visitor) - { - visitor->visit(this); - } - - union_type_expression *union_type_expression::is_union() - { - return this; - } - variable_declaration::variable_declaration(const struct position position, std::vector&& identifier, std::shared_ptr variable_type, expression *initializer) diff --git a/boot/lexer.ll b/boot/lexer.ll index f914d75..05015f6 100644 --- a/boot/lexer.ll +++ b/boot/lexer.ll @@ -100,9 +100,6 @@ type { record { return yy::parser::make_RECORD(this->location); } -union { - return yy::parser::make_UNION(this->location); -} true { return yy::parser::make_BOOLEAN(true, this->location); } diff --git a/boot/parser.yy b/boot/parser.yy index 6ada702..aace9a1 100644 --- a/boot/parser.yy +++ b/boot/parser.yy @@ -93,7 +93,6 @@ along with GCC; see the file COPYING3. If not see PROCEDURE "proc" TYPE "type" RECORD "record" - UNION "union" EXTERN "extern" IF "if" WHILE "while" @@ -467,10 +466,6 @@ type_expression: { $$ = new boot::record_type_expression(boot::make_position(@1), std::move($5), std::move($3)); } - | "union" required_fields "end" - { - $$ = new boot::union_type_expression(boot::make_position(@1), std::move($2)); - } | "proc" procedure_heading { $$ = $2; diff --git a/boot/semantic.cc b/boot/semantic.cc index df6e70e..29925c2 100644 --- a/boot/semantic.cc +++ b/boot/semantic.cc @@ -459,16 +459,6 @@ namespace elna::boot return type(std::make_shared(lookup_primitive_type("Char"))); } } - else if (auto composite = resolved_type.get()) - { - for (auto& field : composite->fields) - { - if (field.first == field_name) - { - return field.second; - } - } - } return type(); } @@ -581,16 +571,6 @@ namespace elna::boot this->current_type = type(result_type); } - void name_analysis_visitor::visit(union_type_expression *expression) - { - auto result_type = std::make_shared(); - - std::set field_names; - result_type->fields = build_composite_type(expression->fields, field_names); - - this->current_type = type(result_type); - } - void name_analysis_visitor::visit(procedure_type_expression *expression) { std::shared_ptr result_type = diff --git a/boot/symbol.cc b/boot/symbol.cc index b75cdc1..9052b23 100644 --- a/boot/symbol.cc +++ b/boot/symbol.cc @@ -38,11 +38,6 @@ namespace elna::boot { } - type::type(std::shared_ptr _union) - : tag(type_tag::_union), _union(_union) - { - } - type::type(std::shared_ptr pointer) : tag(type_tag::pointer), pointer(pointer) { @@ -78,9 +73,6 @@ namespace elna::boot case type_tag::record: new (&record) std::shared_ptr(other.record); break; - case type_tag::_union: - new (&_union) std::shared_ptr(other._union); - break; case type_tag::pointer: new (&pointer) std::shared_ptr(other.pointer); break; @@ -117,9 +109,6 @@ namespace elna::boot case type_tag::record: new (&record) std::shared_ptr(std::move(other.record)); break; - case type_tag::_union: - new (&_union) std::shared_ptr(std::move(other._union)); - break; case type_tag::pointer: new (&pointer) std::shared_ptr(std::move(other.pointer)); break; @@ -172,9 +161,6 @@ namespace elna::boot case type_tag::record: this->record.~shared_ptr(); break; - case type_tag::_union: - this->_union.~shared_ptr(); - break; case type_tag::pointer: this->pointer.~shared_ptr(); break; @@ -208,12 +194,6 @@ namespace elna::boot return tag == type_tag::record ? this->record : nullptr; } - template<> - std::shared_ptr type::get() const - { - return tag == type_tag::_union ? this->_union : nullptr; - } - template<> std::shared_ptr type::get() const { @@ -258,10 +238,6 @@ namespace elna::boot return right_primitive != nullptr && left_primitive->identifier == right_primitive->identifier; } - if (auto left_union = resolved_this.get()) - { - return left_union == resolved_that.get(); - } if (auto left_enumeration = resolved_this.get()) { return left_enumeration == resolved_that.get(); diff --git a/cl.elna b/cl.elna new file mode 100644 index 0000000..b27c49d --- /dev/null +++ b/cl.elna @@ -0,0 +1,6916 @@ +(* + * This Source Code Form is subject to the terms of the Mozilla Public License, + * v. 2.0. If a copy of the MPL was not distributed with this file, You can + * obtain one at https://mozilla.org/MPL/2.0/. + *) + +(* Stage 24 compiler. *) + +type + ElnaListNode = record + next: ^ElnaListNode + end + ElnaList = record + first: ^ElnaListNode; + last: ^ElnaListNode + end + ElnaLocation = record + line: Word; + column: Word + end + ElnaPosition = record + start_location: ElnaLocation; + end_location: ElnaLocation + end + + (** + * List of intermediate representation items. + *) + ElnaInstructionModule = record + data: Word; + code: Word + end + + (* Type representation. *) + ElnaTypeKind = (primitive, enumeration, _record, pointer, array, alias, procedure) + ElnaType = record + kind: ElnaTypeKind; + size: Word; + alignment: Word + end + ElnaTypeAlias = record + kind: ElnaTypeKind; + size: Word; + alignment: Word; + base: ^ElnaType + end + ElnaTypeEnumeration = record + kind: ElnaTypeKind; + size: Word; + alignment: Word; + members: ^String; + length: Word + end + ElnaTypeField = record + name: String; + field_type: ^ElnaType + end + ElnaTypeRecord = record + kind: ElnaTypeKind; + size: Word; + alignment: Word; + members: ^ElnaTypeField; + length: Word + end + ElnaTypePointer = record + kind: ElnaTypeKind; + size: Word; + alignment: Word; + base: ^ElnaType + end + ElnaTypeArray = record + kind: ElnaTypeKind; + size: Word; + alignment: Word; + base: ^ElnaType; + length: Word + end + ElnaTypeProcedure = record + kind: ElnaTypeKind; + size: Word; + alignment: Word; + return_type: ^ElnaType + end + + (* Abstract syntax tree nodes. *) + ElnaTreeKind = ( + integer_literal, + string_literal, + character_literal, + boolean_literal, + variable_expression, + field_access_expression, + dereference_expression, + unary_expression, + binary_expression, + call, + call_statement, + goto_statement, + label_declaration, + return_statement, + assign_statement, + if_statement, + procedure_declaration, + variable_declaration, + enumeration_type_expression, + named_type_expression, + type_declaration, + module_declaration, + record_type_expression, + pointer_type_expression, + array_type_expression, + null, + trait_expression, + array_access_expression, + _cast + ) + ElnaTreeNode = record + kind: ElnaTreeKind; + position: ElnaPosition + end + ElnaTreeTypeExpression = record + kind: ElnaTreeKind; + position: ElnaPosition + end + ElnaTreeExpression = record + kind: ElnaTreeKind; + position: ElnaPosition; + type_decoration: ^ElnaType + end + ElnaTreeIntegerLiteral = record + kind: ElnaTreeKind; + position: ElnaPosition; + type_decoration: ^ElnaType; + value: Word + end + ElnaTreeCharacterLiteral = record + kind: ElnaTreeKind; + position: ElnaPosition; + type_decoration: ^ElnaType; + value: Char + end + ElnaTreeNilLiteral = record + kind: ElnaTreeKind; + position: ElnaPosition; + type_decoration: ^ElnaType + end + ElnaTreeBooleanLiteral = record + kind: ElnaTreeKind; + position: ElnaPosition; + type_decoration: ^ElnaType; + value: Bool + end + ElnaTreeStringLiteral = record + kind: ElnaTreeKind; + position: ElnaPosition; + type_decoration: ^ElnaType; + value: String + end + ElnaTreeVariableExpression = record + kind: ElnaTreeKind; + position: ElnaPosition; + type_decoration: ^ElnaType; + name: String + end + ElnaTreeCastExpression = record + kind: ElnaTreeKind; + position: ElnaPosition; + type_decoration: ^ElnaType; + expression: ^ElnaTreeExpression; + type_expression: ^ElnaTreeTypeExpression + end + ElnaTreeDereferenceExpression = record + kind: ElnaTreeKind; + position: ElnaPosition; + type_decoration: ^ElnaType; + pointer: Word + end + ElnaTreeBinaryExpression = record + kind: ElnaTreeKind; + position: ElnaPosition; + type_decoration: ^ElnaType; + lhs: ^ElnaTreeExpression; + rhs: ^ElnaTreeExpression; + operator: Word + end + ElnaTreeUnaryExpression = record + kind: ElnaTreeKind; + position: ElnaPosition; + type_decoration: ^ElnaType; + operand: ^ElnaTreeExpression; + operator: Word + end + + (** + * All statements are chained into a list. Next contains a pointer to the next + * statement in the statement list. + *) + ElnaTreeStatement = record + kind: ElnaTreeKind; + position: ElnaPosition; + next: ^ElnaTreeStatement + end + (** + * Conditional statements is a list of pairs: condition and statements. + * Used for example to represent if and elsif blocks with beloning statements. + *) + ElnaTreeConditionalStatements = record + condition: ^ElnaTreeExpression; + statements: ^ElnaTreeStatement; + next: ^ElnaTreeConditionalStatements + end + ElnaTreeIfStatement = record + kind: ElnaTreeKind; + position: ElnaPosition; + next: ^ElnaTreeStatement; + conditionals: ^ElnaTreeConditionalStatements; + _else: ^ElnaTreeStatement + end + ElnaTreeGotoStatement = record + kind: ElnaTreeKind; + position: ElnaPosition; + next: ^ElnaTreeStatement; + label: String + end + ElnaTreeAssignStatement = record + kind: ElnaTreeKind; + position: ElnaPosition; + next: ^ElnaTreeStatement; + assignee: Word; + assignment: ^ElnaTreeExpression + end + ElnaTreeReturnStatement = record + kind: ElnaTreeKind; + position: ElnaPosition; + next: ^ElnaTreeStatement; + returned: ^ElnaTreeExpression + end + ElnaTreeLabelDeclaration = record + kind: ElnaTreeKind; + position: ElnaPosition; + next: ^ElnaTreeStatement; + label: String + end + ElnaTreeFieldAccessExpression = record + kind: ElnaTreeKind; + position: ElnaPosition; + type_decoration: ^ElnaType; + aggregate: ^ElnaTreeNode; + field: String + end + ElnaTreeArrayAccessExpression = record + kind: ElnaTreeKind; + position: ElnaPosition; + type_decoration: ^ElnaType; + array: Word; + index: ^ElnaTreeExpression + end + ElnaTreeEnumeration = record + name: String; + next: ^ElnaTreeEnumeration + end + ElnaTreeEnumerationTypeExpression = record + kind: ElnaTreeKind; + position: ElnaPosition; + members: ^ElnaTreeEnumeration; + length: Word + end + ElnaTreeField = record + name: String; + type_expression: ^ElnaTreeTypeExpression; + next: ^ElnaTreeField + end + ElnaTreeRecordTypeExpression = record + kind: ElnaTreeKind; + position: ElnaPosition; + members: ^ElnaTreeField; + length: Word; + parent: String + end + ElnaTreeNamedTypeExpression = record + kind: ElnaTreeKind; + position: ElnaPosition; + name: String + end + ElnaTreePointerTypeExpression = record + kind: ElnaTreeKind; + position: ElnaPosition; + base: ^ElnaTreeTypeExpression + end + ElnaTreeArrayTypeExpression = record + kind: ElnaTreeKind; + position: ElnaPosition; + base: ^ElnaTreeTypeExpression; + length: ^ElnaTreeExpression + end + ElnaTreeTraitExpression = record + kind: ElnaTreeKind; + position: ElnaPosition; + name: String; + argument: ^ElnaTreeTypeExpression + end + ElnaTreeDeclaration = record + kind: ElnaTreeKind; + position: ElnaPosition; + next: ^ElnaTreeDeclaration; + name: String + end + ElnaTreeVariableDeclaration = record + kind: ElnaTreeKind; + position: ElnaPosition; + next: ^ElnaTreeDeclaration; + name: String; + type_expression: ^ElnaTreeTypeExpression + end + ElnaTreeProcedureDeclaration = record + kind: ElnaTreeKind; + position: ElnaPosition; + next: ^ElnaTreeDeclaration; + name: String; + body: ^ElnaTreeStatement; + temporaries: ^ElnaTreeVariableDeclaration; + parameters: ^ElnaTreeVariableDeclaration; + return_type: ^ElnaTreeTypeExpression; + is_extern: Bool + end + ElnaTreeModuleDeclaration = record + kind: ElnaTreeKind; + position: ElnaPosition; + types: ^ElnaTreeDeclaration; + globals: ^ElnaTreeVariableDeclaration; + procedures: ^ElnaTreeProcedureDeclaration; + body: ^ElnaTreeStatement + end + ElnaTreeTypeDeclaration = record + kind: ElnaTreeKind; + position: ElnaPosition; + next: ^ElnaTreeDeclaration; + name: String; + type_expression: ^ElnaTreeTypeExpression + end + ElnaTreeExpressionList = record + expression: ^ElnaTreeBinaryExpression; + next: ^ElnaTreeExpressionList + end + ElnaTreeCall = record + kind: ElnaTreeKind; + position: ElnaPosition; + type_decoration: ^ElnaType; + callee: ^ElnaTreeVariableExpression; + arguments: ^ElnaTreeExpressionList; + count: Word + end + ElnaTreeCallStatement = record + kind: ElnaTreeKind; + position: ElnaPosition; + next: ^ElnaTreeStatement; + call: ^ElnaTreeCall + end + + (* Symbol table information. *) + ElnaSymbolEntry = record + name: String; + symbol_info: ^ElnaSymbolInfo + end + ElnaSymbolTable = record + count: Word; + parent: ^ElnaSymbolTable; + symbols: ^ElnaSymbolEntry + end + ElnaSymbolInfoKind = (type_info, temporary_info, procedure_info) + ElnaSymbolInfo = record + kind: ElnaSymbolInfoKind + end + ElnaSymbolTypeInfo = record + kind: ElnaSymbolInfoKind; + _type: ^ElnaType + end + ElnaSymbolTemporaryInfo = record + kind: ElnaSymbolInfoKind; + attr: Word; + variable_type: ^ElnaType + end + ElnaSymbolProcedureInfo = record + kind: ElnaSymbolInfoKind; + symbol_table: ^ElnaSymbolTable; + procedure_type: ^ElnaTypeProcedure; + is_extern: Bool + end + + ElnaLexerAction = (none, accumulate, skip, single, eof, finalize, composite, key_id, integer, delimited) + + ElnaLexerTransition = record + action: ElnaLexerAction; + next_state: ElnaLexerState + end + + ElnaLexerToken = record + kind: ElnaLexerKind; + start: String; + position: ElnaPosition + end + ElnaLexerCursor = record + state: ElnaLexerState; + start: ^Char; + finish: ^Char; + token: ^ElnaLexerToken; + position: ElnaPosition + end + + ElnaTacOperator = ( + get_address, + add, + load, + store, + proc_call, + copy, + copy_to_offset, + copy_from_offset, + subtract, + divide, + remainder, + multiply, + _xor, + _or, + and, + less_than, + greater_than, + less_or_equal, + greater_or_equal, + equal, + not_equal, + negate, + complement, + jump, + jump_if_zero, + jump_if_not_zero, + label, + _return, + add_ptr, + nop + ) + ElnaTacKind = (list, label, constant, variable, ignore) + + (* + - If value is a variable or label, length is its name length. + - If value is a constant, length is its size. + - If value is a list, length is the list length. + *) + ElnaTacOperand = record + kind: ElnaTacKind; + value: Word; + length: Word + end + ElnaTacInstruction = record + next: ^ElnaListNode; + operator: ElnaTacOperator; + operands: [4]ElnaTacOperand + end + ElnaTacProcedure = record + next: ^ElnaTacProcedure; + name: String; + body: ElnaList; + parameters: ^String; + count: Word; + symbol_table: ^ElnaSymbolTable + end + ElnaTacStaticVariable = record + next: ^ElnaTacStaticVariable; + name: String; + body: Word + end + ElnaTacOperandType = (plain_object, dereferenced_pointer, sub_object) + ElnaTacOperandResult = record + kind: ElnaTacOperandType; + offset: Word + end + + ElnaRtlOperator = ( + li, + la, + add, + addi, + lw, + sw, + jal, + mv, + sub, + div, + rem, + mul, + _xor, + _or, + and, + seqz, + snez, + slt, + xori, + neg, + not, + j, + beqz, + bnez, + label, + allocate_stack, + ret, + nop + ) + ElnaRtlKind = (register, immediate, data, pseudo, memory, pseudo_mem) + ElnaRtlOperand = record + kind: ElnaRtlKind; + value: Word; + length: Word; + offset: Word + end + ElnaRtlStaticVariable = record + next: ^ElnaRtlStaticVariable; + name: String; + body: Word + end + ElnaRtlProcedure = record + next: ^ElnaRtlProcedure; + name: String; + body: ElnaList; + variable_map: ^ElnaSymbolTable + end + ElnaRtlTypeKind = (byte, long_word, byte_array) + ElnaRtlType = record + kind: ElnaRtlTypeKind + end + ElnaRtlTypeWord = record + kind: ElnaRtlTypeKind + end + ElnaRtlTypeByteArray = record + kind: ElnaRtlTypeKind; + size: Word; + alignment: Word + end + ElnaRtlInstruction = record + next: ^ElnaListNode; + operator: ElnaRtlOperator; + operands: [3]ElnaRtlOperand; + types: [2]^ElnaRtlType + end + ElnaRtlRegister = ( + zero, + ra, + sp, + gp, + tp, + t0, + t1, + t2, + s0, + s1, + a0, + a1, + a2, + a3, + a4, + a5, + a6, + a7, + s2, + s3, + s4, + s5, + s6, + s7, + s8, + s9, + s10, + s11, + t3, + t4, + t5, + t6 + ) + ElnaRtlInfoKind = (object_info, static_info) + ElnaRtlInfo = record + kind: ElnaRtlInfoKind + end + ElnaRtlStaticInfo = record + kind: ElnaRtlInfoKind; + rtl_type: ^ElnaRtlType + end + ElnaRtlObjectInfo = record + kind: ElnaRtlInfoKind; + rtl_type: ^ElnaRtlType; + counter: Word; + allocated: Bool + end + + ElnaErrorKind = (unexpected_token, undefined_symbol, undefined_member, duplicate_declaration) + ElnaError = record + next: ^ElnaListNode; + kind: ElnaErrorKind; + position: ElnaPosition + end + ElnaErrorUnexpectedToken = record + next: ^ElnaListNode; + kind: ElnaErrorKind; + position: ElnaPosition; + expected: ^ElnaLexerKind; + possibilities: Word; + got: ElnaLexerKind + end + ElnaErrorUndefinedSymbol = record + next: ^ElnaListNode; + kind: ElnaErrorKind; + position: ElnaPosition; + symbol_name: String + end + ElnaErrorUndefinedMember = record + next: ^ElnaListNode; + kind: ElnaErrorKind; + position: ElnaPosition; + aggregate_name: String; + member_name: String + end + ElnaErrorDuplicateDeclaration = record + next: ^ElnaListNode; + kind: ElnaErrorKind; + position: ElnaPosition; + symbol_name: String + end + +var + symbol_table_global: ^ElnaSymbolTable + variable_map_global: ^ElnaSymbolTable + compiler_strings: [4096]Char + + classification: [256]Word + transition_table: [19][23]ElnaLexerTransition + word_type: ^ElnaType + char_type: ^ElnaType + bool_type: ^ElnaType + int_type: ^ElnaType + string_type: ^ElnaTypeRecord + + source_code: Word + compiler_strings_position: ^Char + compiler_strings_length: Word + label_counter: Word + temporary_variable_counter: Word + pseudo_counter: Word + + stdout: Pointer + stderr: Pointer + stdin: Pointer + +proc free_and_nil(pointer: Pointer): Pointer +begin + free(pointer); + return nil +end + +(** + * Adds a string to the global, read-only string storage. + * + * Parameters: + * string - String token. + * string_length - String length. + * + * Returns the offset from the beginning of the storage to the new string. + *) +proc elna_tac_add_string(string: ^Char; string_length: Word): Word +var + result: Word + current_byte: Char + current_target: ^Char +begin + result := compiler_strings_length; + (* Global character pointer is appearently dereferenced wrongly. *) + current_target := compiler_strings_position; + + .add_string_loop; + current_byte := string^; + + if current_byte = 92 then + current_target^ := '\\'; + current_target := current_target + 1; + current_target^ := '\\' + elsif current_byte = 10 then + current_target^ := '\\'; + current_target := current_target + 1; + current_target^ := 'n' + elsif current_byte = 9 then + current_target^ := '\\'; + current_target := current_target + 1; + current_target^ := 't' + elsif current_byte = 12 then + current_target^ := '\\'; + current_target := current_target + 1; + current_target^ := 'f' + elsif current_byte = 13 then + current_target^ := '\\'; + current_target := current_target + 1; + current_target^ := 'r' + elsif current_byte = 11 then + current_target^ := '\\'; + current_target := current_target + 1; + current_target^ := 'v' + elsif current_byte = 34 then + current_target^ := '\\'; + current_target := current_target + 1; + current_target^ := '"' + elsif current_byte = 39 then + current_target^ := '\\'; + current_target := current_target + 1; + current_target^ := '\'' + elsif current_byte = 0 then + current_target^ := '\\'; + current_target := current_target + 1; + current_target^ := '0' + else + current_target^ := current_byte + end; + current_target := current_target + 1; + string := string + 1; + string_length := string_length - 1; + compiler_strings_length := compiler_strings_length + 1; + if string_length > 0 then + goto add_string_loop + end; + compiler_strings_position := current_target; + + return result +end + +(** + * Writes to the standard output. + * + * Parameters: + * buffer - String to write. + *) +proc _write_s(stream: Word; buffer: String) +begin + fwrite(buffer.ptr, 1, buffer.length, stream) +end + +(** + * Writes a number to the standard output. + * + * Parameters: + * number - Whole number. + *) +proc _write_i(stream, number: Word) +begin + fprintf(stream, "%i\0".ptr, number) +end + +(** + * Writes a character from a0 into the standard output. + * + * Parameters: + * character - Character to write. + *) +proc _write_c(stream, character: Word) +begin + fputc(character, stream) +end + +proc _write(stream: Word; buffer: ^Char; size: Word) +begin + fwrite(buffer, 1, size, stream) +end + +proc elna_list_initialize(list: ^ElnaList) +begin + list^.first := nil; + list^.last := nil +end + +(** + * Appends a new element to the end of the list. + *) +proc elna_list_append(list: ^ElnaList; element: ^ElnaListNode): ^ElnaListNode +begin + if element <> nil then + if list^.first = nil then + list^.first := element + else + list^.last^.next := element + end; + list^.last := element + end; + return element +end + +(** + * Prepends a new element to the beginning of the given list. + *) +proc elna_list_prepend(list: ^ElnaList; element: ^ElnaListNode) +begin + element^.next := list^.first; + list^.first := element; + if list^.last = nil then + list^.last := element + end +end + +(** + * Inserts a new element after an existing one into the given list. + *) +proc elna_list_insert(list: ^ElnaList; existing: ^ElnaListNode; new: ^ElnaListNode) +begin + if existing^.next = nil then + list^.last := new + else + new^.next := existing^.next + end; + existing^.next := new +end + +(* Returns whether the given list is empty. *) +proc elna_list_empty(list: ^ElnaList): Bool +begin + return list^.first = nil +end + +proc elna_tac_make_variable(operand: ^ElnaTacOperand; symbol_table: ^ElnaSymbolTable; variable_type: ^ElnaType) +var + buffer: Word + temporary_info: ^ElnaSymbolTemporaryInfo +begin + pseudo_counter := pseudo_counter + 1; + buffer := malloc(7); + + sprintf(buffer, "$a%i\0".ptr, pseudo_counter); + + operand^.kind := ElnaTacKind.variable; + operand^.value := buffer; + operand^.length := strlen(buffer); + + temporary_info := elna_symbol_temporary_info_create(1, variable_type); + elna_symbol_table_enter(symbol_table, buffer, operand^.length, temporary_info) +end + +proc elna_tac_instruction_set_operand(this: ^ElnaTacInstruction; n, operand_type, operand_value, operand_length: Word) +begin + this^.operands[n].kind := operand_type; + this^.operands[n].value := operand_value; + this^.operands[n].length := operand_length +end + +proc elna_tac_instruction_create(kind: Word): ^ElnaTacInstruction +var + result: ^ElnaTacInstruction +begin + result := malloc(#size(ElnaTacInstruction)); + + result^.operator := kind; + result^.next := nil; + + return result +end + +proc elna_rtl_instruction_create(operator: ElnaRtlOperator): ^ElnaRtlInstruction +var + result: ^ElnaRtlInstruction +begin + result := malloc(#size(ElnaRtlInstruction)); + + result^.operator := operator; + result^.next := nil; + result^.types[1] := nil; + result^.types[2] := nil; + + return result +end + +proc elna_rtl_instruction_set_operand(this: ^ElnaRtlInstruction; n: Word; operand_type: ElnaRtlKind; + operand_value, operand_length, operand_offset: Word) +begin + this^.operands[n].kind := operand_type; + this^.operands[n].value := operand_value; + this^.operands[n].length := operand_length; + this^.operands[n].offset := operand_offset +end + +(** + * Loads or moves the value from a TAC operand into the given register. + *) +proc elna_rtl_hardware_value(instructions: ^ElnaList, operand: ^ElnaTacOperand, + into: ElnaRtlRegister, variable_map: ^ElnaSymbolTable): Word +var + instruction: ^ElnaRtlInstruction + pseudo_symbol: ^ElnaRtlObjectInfo + target_operand: ElnaRtlOperand + long_word_type: ^ElnaRtlType + registers_used: Word +begin + registers_used := 1; + + if operand^.kind = ElnaTacKind.constant then + instruction := elna_rtl_instruction_create(ElnaRtlOperator.li); + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.register, into, 0, 0); + elna_rtl_instruction_set_operand(instruction, 2, ElnaRtlKind.immediate, operand^.value, 0, 0); + elna_list_append(instructions, instruction) + elsif operand^.kind = ElnaTacKind.variable then + pseudo_symbol := elna_symbol_table_lookup(variable_map, operand^.value, operand^.length); + long_word_type := elna_rtl_constant_type(4); + + if pseudo_symbol^.rtl_type^.kind = ElnaRtlTypeKind.byte_array then + target_operand.kind := ElnaRtlKind.register; + target_operand.value := ElnaRtlRegister.t0; + target_operand.length := 0; + target_operand.offset := 0; + + instruction := elna_rtl_variable_address(variable_map, pseudo_symbol, operand, @target_operand); + elna_list_append(instructions, instruction); + + instruction := elna_rtl_instruction_create(ElnaRtlOperator.lw); + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.register, into, 0, 0); + elna_rtl_instruction_set_operand(instruction, 2, ElnaRtlKind.memory, target_operand.value, target_operand.length, 0); + instruction^.types[1] := long_word_type; + elna_list_append(instructions, instruction); + + instruction := elna_rtl_instruction_create(ElnaRtlOperator.lw); + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.register, into + 1, 0, 0); + elna_rtl_instruction_set_operand(instruction, 2, ElnaRtlKind.memory, target_operand.value, target_operand.length, 4); + instruction^.types[1] := long_word_type; + elna_list_append(instructions, instruction); + + registers_used := 2 + else + instruction := elna_rtl_instruction_create(ElnaRtlOperator.mv); + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.register, into, 0, 0); + elna_rtl_instruction_set_operand(instruction, 2, ElnaRtlKind.pseudo, operand^.value, operand^.length, 0); + instruction^.types[1] := long_word_type; + + elna_list_append(instructions, instruction) + end + end; + return registers_used +end + +proc elna_rtl_operand_value(instructions: ^ElnaList; tac_operand: ^ElnaTacOperand; variable_map: ^ElnaSymbolTable; + rtl_operand: ^ElnaRtlOperand): ^ElnaRtlInfo +var + instruction: ^ElnaRtlInstruction + pseudo_symbol: ^ElnaRtlObjectInfo + rtl_type: ^ElnaRtlType +begin + pseudo_symbol := nil; + + if tac_operand^.kind = ElnaTacKind.constant then + rtl_type := elna_rtl_constant_type(tac_operand^.length); + pseudo_symbol := elna_rtl_generate_pseudo(rtl_operand, variable_map, rtl_type); + + instruction := elna_rtl_instruction_create(ElnaRtlOperator.li); + elna_rtl_instruction_set_operand(instruction, 1, rtl_operand^.kind, rtl_operand^.value, rtl_operand^.length, 0); + elna_rtl_instruction_set_operand(instruction, 2, ElnaRtlKind.immediate, tac_operand^.value, 0, 0); + instruction^.types[1] := rtl_type; + elna_list_append(instructions, instruction) + elsif tac_operand^.kind = ElnaTacKind.variable then + pseudo_symbol := elna_symbol_table_lookup(variable_map, tac_operand^.value, tac_operand^.length); + if pseudo_symbol^.rtl_type^.kind = ElnaRtlTypeKind.byte_array then + rtl_operand^.kind := ElnaRtlKind.pseudo_mem; + rtl_operand^.value := tac_operand^.value; + rtl_operand^.length := tac_operand^.length; + rtl_operand^.offset := 0 + else + rtl_operand^.kind := ElnaRtlKind.pseudo; + rtl_operand^.value := tac_operand^.value; + rtl_operand^.length := tac_operand^.length; + rtl_operand^.offset := 0 + end + end; + return pseudo_symbol +end + +proc elna_rtl_binary_arithmetic(instructions: ^ElnaList; tac_instruction: ^ElnaTacInstruction; + operation: ElnaRtlOperator; variable_map: ^ElnaSymbolTable): ^ElnaRtlInstruction +var + result: ^ElnaRtlInstruction + rtl_operand: ElnaRtlOperand +begin + result := elna_rtl_instruction_create(operation); + elna_rtl_instruction_set_operand(result, 1, ElnaRtlKind.pseudo, + tac_instruction^.operands[3].value, tac_instruction^.operands[3].length, 0); + + elna_rtl_operand_value(instructions, @tac_instruction^.operands[1], variable_map, @rtl_operand); + elna_rtl_instruction_set_operand(result, 2, rtl_operand.kind, rtl_operand.value, rtl_operand.length, 0); + + elna_rtl_operand_value(instructions, @tac_instruction^.operands[2], variable_map, @rtl_operand); + elna_rtl_instruction_set_operand(result, 3, rtl_operand.kind, rtl_operand.value, rtl_operand.length, 0); + + elna_list_append(instructions, result); + return result +end + +proc elna_rtl_add_ptr(instructions: ^ElnaList; tac_instruction: ^ElnaTacInstruction; variable_map: ^ElnaSymbolTable) +var + result: ^ElnaRtlInstruction + rtl_operand: ElnaRtlOperand + intermediate: ElnaRtlOperand + rtl_type: ^ElnaRtlType +begin + rtl_type := malloc(#size(ElnaRtlTypeWord)); + rtl_type^.kind := ElnaRtlTypeKind.long_word; + elna_rtl_generate_pseudo(@intermediate, variable_map, rtl_type); + + result := elna_rtl_instruction_create(ElnaRtlOperator.li); + elna_rtl_instruction_set_operand(result, 1, intermediate.kind, intermediate.value, intermediate.length, 0); + elna_rtl_instruction_set_operand(result, 2, ElnaRtlKind.immediate, tac_instruction^.operands[3].value, 0, 0); + result^.types[1] := rtl_type; + elna_list_append(instructions, result); + + result := elna_rtl_instruction_create(ElnaRtlOperator.mul); + elna_rtl_instruction_set_operand(result, 1, intermediate.kind, intermediate.value, intermediate.length, 0); + elna_rtl_instruction_set_operand(result, 2, intermediate.kind, intermediate.value, intermediate.length, 0); + elna_rtl_operand_value(instructions, @tac_instruction^.operands[2], variable_map, @rtl_operand); + elna_rtl_instruction_set_operand(result, 3, rtl_operand.kind, rtl_operand.value, rtl_operand.length, 0); + elna_list_append(instructions, result); + + result := elna_rtl_instruction_create(ElnaRtlOperator.add); + elna_rtl_instruction_set_operand(result, 1, ElnaRtlKind.pseudo, + tac_instruction^.operands[4].value, tac_instruction^.operands[4].length, 0); + elna_rtl_operand_value(instructions, @tac_instruction^.operands[1], variable_map, @rtl_operand); + elna_rtl_instruction_set_operand(result, 2, rtl_operand.kind, rtl_operand.value, rtl_operand.length, 0); + elna_rtl_instruction_set_operand(result, 3, intermediate.kind, intermediate.value, intermediate.length, 0); + elna_list_append(instructions, result) +end + +proc elna_rtl_binary_equality(instructions: ^ElnaList; tac_instruction: ^ElnaTacInstruction; + instruction_kind: ElnaRtlOperator; variable_map: ^ElnaSymbolTable) +var + instruction: ^ElnaRtlInstruction + target_operand: ^ElnaRtlOperand +begin + instruction := elna_rtl_binary_arithmetic(instructions, tac_instruction, ElnaRtlOperator._xor, variable_map); + target_operand := @instruction^.operands[1]; + + instruction := elna_rtl_instruction_create(instruction_kind); + elna_rtl_instruction_set_operand(instruction, 1, target_operand^.kind, target_operand^.value, target_operand^.length, 0); + elna_rtl_instruction_set_operand(instruction, 2, target_operand^.kind, target_operand^.value, target_operand^.length, 0); + elna_list_append(instructions, instruction) +end + +proc elna_rtl_set_less_than(instructions: ^ElnaList; tac_instruction: ^ElnaTacInstruction; + lhs, rhs: Word; variable_map: ^ElnaSymbolTable): ^ElnaRtlInstruction +var + slt_instruction: ^ElnaRtlInstruction + rtl_operand: ElnaRtlOperand +begin + slt_instruction := elna_rtl_instruction_create(ElnaRtlOperator.slt); + elna_rtl_instruction_set_operand(slt_instruction, 1, ElnaRtlKind.pseudo, + tac_instruction^.operands[3].value, tac_instruction^.operands[3].length, 0); + + elna_rtl_operand_value(instructions, @tac_instruction^.operands[1], variable_map, @rtl_operand); + elna_rtl_instruction_set_operand(slt_instruction, lhs, rtl_operand.kind, rtl_operand.value, rtl_operand.length, 0); + + elna_rtl_operand_value(instructions, @tac_instruction^.operands[2], variable_map, @rtl_operand); + elna_rtl_instruction_set_operand(slt_instruction, rhs, rtl_operand.kind, rtl_operand.value, rtl_operand.length, 0); + + elna_list_append(instructions, slt_instruction); + return slt_instruction +end + +proc elna_rtl_binary_comparison(instructions: ^ElnaList; tac_instruction: ^ElnaTacInstruction; + lhs, rhs: Word; variable_map: ^ElnaSymbolTable) +var + slt_instruction: ^ElnaRtlInstruction + xor_instruction: ^ElnaRtlInstruction + rtl_operand: ElnaRtlOperand +begin + slt_instruction := elna_rtl_set_less_than(instructions, tac_instruction, lhs, rhs, variable_map); + + xor_instruction := elna_rtl_instruction_create(ElnaRtlOperator.xori); + elna_rtl_instruction_set_operand(xor_instruction, 1, slt_instruction^.operands[1].kind, + slt_instruction^.operands[1].value, slt_instruction^.operands[1].length, 0); + elna_rtl_instruction_set_operand(xor_instruction, 2, slt_instruction^.operands[1].kind, + slt_instruction^.operands[1].value, slt_instruction^.operands[1].length, 0); + elna_rtl_instruction_set_operand(xor_instruction, 3, ElnaRtlKind.immediate, 1, 0, 0); + + elna_list_append(instructions, xor_instruction) +end + +proc elna_rtl_variable_address(variable_map: ^ElnaSymbolTable; pseudo_symbol: ^ElnaRtlObjectInfo; + addressable: ^ElnaTacOperand; target_operand: ^ElnaRtlOperand): ^ElnaRtlInstruction +var + instruction: ^ElnaRtlInstruction +begin + instruction := elna_rtl_instruction_create(ElnaRtlOperator.la); + + elna_rtl_instruction_set_operand(instruction, 1, target_operand^.kind, + target_operand^.value, target_operand^.length, 0); + (* "strings" variable with static strings is in the end object and should be addressable, + but not in the symbol table. *) + if pseudo_symbol = nil then + elna_rtl_instruction_set_operand(instruction, 2, ElnaRtlKind.data, + addressable^.value, addressable^.length, 0) + elsif pseudo_symbol^.kind = ElnaRtlInfoKind.static_info then + elna_rtl_instruction_set_operand(instruction, 2, ElnaRtlKind.data, + addressable^.value, addressable^.length, 0) + elsif pseudo_symbol^.rtl_type^.kind = ElnaRtlTypeKind.byte_array then + elna_rtl_instruction_set_operand(instruction, 2, ElnaRtlKind.pseudo_mem, + addressable^.value, addressable^.length, 0) + else + elna_rtl_instruction_set_operand(instruction, 2, ElnaRtlKind.pseudo, + addressable^.value, addressable^.length, 0) + end; + return instruction +end + +proc elna_rtl_operand_address(variable_map: ^ElnaSymbolTable; + addressable: ^ElnaTacOperand; target_operand: ^ElnaRtlOperand): ^ElnaRtlInstruction +var + pseudo_symbol: ^ElnaRtlObjectInfo + instruction: ^ElnaRtlInstruction +begin + pseudo_symbol := elna_symbol_table_lookup(variable_map, addressable^.value, addressable^.length); + + return elna_rtl_variable_address(variable_map, pseudo_symbol, addressable, target_operand) +end + +proc elna_rtl_get_address(instructions: ^ElnaList; tac_instruction: ^ElnaTacInstruction; variable_map: ^ElnaSymbolTable) +var + instruction: ^ElnaRtlInstruction + rtl_operand: ElnaRtlOperand +begin + rtl_operand.kind := ElnaRtlKind.pseudo; + rtl_operand.value := tac_instruction^.operands[2].value; + rtl_operand.length := tac_instruction^.operands[2].length; + + instruction := elna_rtl_operand_address(variable_map, @tac_instruction^.operands[1], @rtl_operand); + elna_list_append(instructions, instruction) +end + +proc elna_rtl_conditional_jump(instructions: ^ElnaList; tac_instruction: ^ElnaTacInstruction; + condition: ElnaRtlOperator; variable_map: ^ElnaSymbolTable) +var + instruction: ^ElnaRtlInstruction + rtl_operand: ElnaRtlOperand +begin + instruction := elna_rtl_instruction_create(condition); + elna_rtl_operand_value(instructions, @tac_instruction^.operands[1], variable_map, @rtl_operand); + elna_rtl_instruction_set_operand(instruction, 1, rtl_operand.kind, rtl_operand.value, rtl_operand.length, 0); + elna_rtl_instruction_set_operand(instruction, 2, ElnaRtlKind.data, + tac_instruction^.operands[2].value, tac_instruction^.operands[2].length, 0); + + elna_list_append(instructions, instruction) +end + +proc elna_rtl_unary(instructions: ^ElnaList; tac_instruction: ^ElnaTacInstruction; rtl_operator: ElnaRtlOperator; variable_map: ^ElnaSymbolTable) +var + instruction: ^ElnaRtlInstruction + rtl_operand: ElnaRtlOperand +begin + elna_rtl_operand_value(instructions, @tac_instruction^.operands[1], variable_map, @rtl_operand); + + instruction := elna_rtl_instruction_create(rtl_operator); + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.pseudo, + tac_instruction^.operands[2].value, tac_instruction^.operands[2].length, 0); + + elna_rtl_instruction_set_operand(instruction, 2, rtl_operand.kind, rtl_operand.value, rtl_operand.length, 0); + elna_list_append(instructions, instruction) +end + +proc elna_rtl_call(instructions: ^ElnaList; tac_instruction: ^ElnaTacInstruction; variable_map: ^ElnaSymbolTable) +var + argument_count: Word + current_argument: ^ElnaTacOperand + instruction: ^ElnaRtlInstruction + current_register: Word + registers_used: Word + target_operand: ElnaRtlOperand + pseudo_symbol: ^ElnaRtlObjectInfo + long_word_type: ^ElnaRtlType +begin + current_register := 0; + current_argument := tac_instruction^.operands[2].value; + argument_count := tac_instruction^.operands[2].length; + + .elna_rtl_call_loop; + + if argument_count > 0 then + argument_count := argument_count - 1; + + registers_used := elna_rtl_hardware_value(instructions, current_argument, ElnaRtlRegister.a0 + current_register, variable_map); + current_argument := current_argument + 1; + current_register := current_register + registers_used; + + goto elna_rtl_call_loop + end; + instruction := elna_rtl_instruction_create(ElnaRtlOperator.jal); + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.data, + tac_instruction^.operands[1].value, tac_instruction^.operands[1].length, 0); + elna_list_append(instructions, instruction); + + if tac_instruction^.operands[3].kind = ElnaTacKind.variable then + pseudo_symbol := elna_symbol_table_lookup(variable_map, tac_instruction^.operands[3].value, tac_instruction^.operands[3].length); + + if pseudo_symbol^.rtl_type^.kind = ElnaRtlTypeKind.byte_array then + target_operand.kind := ElnaRtlKind.register; + target_operand.value := ElnaRtlRegister.t0; + target_operand.length := 0; + target_operand.offset := 0; + long_word_type := elna_rtl_constant_type(4); + + instruction := elna_rtl_variable_address(variable_map, pseudo_symbol, @tac_instruction^.operands[3], @target_operand); + elna_list_append(instructions, instruction); + + instruction := elna_rtl_instruction_create(ElnaRtlOperator.sw); + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.register, ElnaRtlRegister.a0, 0, 0); + elna_rtl_instruction_set_operand(instruction, 2, ElnaRtlKind.memory, + target_operand.value, target_operand.length, 0); + instruction^.types[1] := long_word_type; + elna_list_append(instructions, instruction); + + instruction := elna_rtl_instruction_create(ElnaRtlOperator.sw); + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.register, ElnaRtlRegister.a1, 0, 0); + elna_rtl_instruction_set_operand(instruction, 2, ElnaRtlKind.memory, + target_operand.value, target_operand.length, 4); + instruction^.types[1] := long_word_type; + elna_list_append(instructions, instruction) + else + instruction := elna_rtl_instruction_create(ElnaRtlOperator.mv); + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.pseudo, + tac_instruction^.operands[3].value, tac_instruction^.operands[3].length, 0); + elna_rtl_instruction_set_operand(instruction, 2, ElnaRtlKind.register, ElnaRtlRegister.a0, 0, 0); + elna_list_append(instructions, instruction) + end + end +end + +proc elna_rtl_store(instructions: ^ElnaList; tac_instruction: ^ElnaTacInstruction; variable_map: ^ElnaSymbolTable) +var + instruction: ^ElnaRtlInstruction + rtl_operand: ElnaRtlOperand + pseudo_symbol: ^ElnaRtlObjectInfo + rtl_type: ^ElnaRtlType +begin + if tac_instruction^.operands[1].kind = ElnaTacKind.variable then + pseudo_symbol := elna_symbol_table_lookup(variable_map, + tac_instruction^.operands[1].value, tac_instruction^.operands[1].length); + rtl_type := pseudo_symbol^.rtl_type + else + rtl_type := elna_rtl_constant_type(tac_instruction^.operands[1].length) + end; + elna_rtl_operand_value(instructions, @tac_instruction^.operands[1], variable_map, @rtl_operand); + + if tac_instruction^.operands[1].kind = ElnaTacKind.variable then + if rtl_type^.kind = ElnaRtlTypeKind.byte_array then + instruction := elna_rtl_instruction_create(ElnaRtlOperator.mv); + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.register, ElnaRtlRegister.a0, 0, 0); + elna_rtl_instruction_set_operand(instruction, 2, ElnaRtlKind.pseudo, + tac_instruction^.operands[2].value, tac_instruction^.operands[2].length, 0); + elna_list_append(instructions, instruction); + + instruction := elna_rtl_instruction_create(ElnaRtlOperator.la); + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.register, ElnaRtlRegister.a1, 0, 0); + elna_rtl_instruction_set_operand(instruction, 2, rtl_operand.kind, rtl_operand.value, rtl_operand.length, 0); + elna_list_append(instructions, instruction); + + elna_rtl_memcpy(instructions, pseudo_symbol^.rtl_type); + + rtl_type := nil + end + end; + if rtl_type <> nil then + instruction := elna_rtl_instruction_create(ElnaRtlOperator.sw); + elna_rtl_instruction_set_operand(instruction, 1, rtl_operand.kind, rtl_operand.value, rtl_operand.length, 0); + elna_rtl_instruction_set_operand(instruction, 2, ElnaRtlKind.pseudo, + tac_instruction^.operands[2].value, tac_instruction^.operands[2].length, 0); + instruction^.types[1] := rtl_type; + elna_list_append(instructions, instruction) + end; +end + +proc elna_rtl_copy_to_offset(instructions: ^ElnaList; tac_instruction: ^ElnaTacInstruction; variable_map: ^ElnaSymbolTable) +var + instruction: ^ElnaRtlInstruction + target_operand: ElnaRtlOperand + source_operand: ElnaRtlOperand + pseudo_symbol: ^ElnaRtlObjectInfo + rtl_type: ^ElnaRtlType + address_type: ^ElnaRtlType +begin + if tac_instruction^.operands[1].kind = ElnaTacKind.variable then + pseudo_symbol := elna_symbol_table_lookup(variable_map, + tac_instruction^.operands[1].value, tac_instruction^.operands[1].length); + rtl_type := pseudo_symbol^.rtl_type + else + rtl_type := elna_rtl_constant_type(tac_instruction^.operands[1].length) + end; + elna_rtl_operand_value(instructions, @tac_instruction^.operands[1], variable_map, @source_operand); + + if tac_instruction^.operands[1].kind = ElnaTacKind.variable then + if rtl_type^.kind = ElnaRtlTypeKind.byte_array then + instruction := elna_rtl_instruction_create(ElnaRtlOperator.la); + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.register, ElnaRtlRegister.a0, 0, 0); + elna_rtl_instruction_set_operand(instruction, 2, ElnaRtlKind.pseudo_mem, + tac_instruction^.operands[2].value, tac_instruction^.operands[2].length, 0); + elna_list_append(instructions, instruction); + + instruction := elna_rtl_instruction_create(ElnaRtlOperator.addi); + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.register, ElnaRtlRegister.a0, 0, 0); + elna_rtl_instruction_set_operand(instruction, 2, ElnaRtlKind.register, ElnaRtlRegister.a0, 0, 0); + elna_rtl_instruction_set_operand(instruction, 3, ElnaRtlKind.immediate, tac_instruction^.operands[3].value, 0, 0); + elna_list_append(instructions, instruction); + + instruction := elna_rtl_instruction_create(ElnaRtlOperator.la); + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.register, ElnaRtlRegister.a1, 0, 0); + elna_rtl_instruction_set_operand(instruction, 2, source_operand.kind, source_operand.value, source_operand.length, 0); + elna_list_append(instructions, instruction); + + elna_rtl_memcpy(instructions, pseudo_symbol^.rtl_type); + rtl_type := nil + end + end; + if rtl_type <> nil then + address_type := elna_rtl_constant_type(4); + elna_rtl_generate_pseudo(@target_operand, variable_map, address_type); + + instruction := elna_rtl_operand_address(variable_map, @tac_instruction^.operands[2], @target_operand); + elna_list_append(instructions, instruction); + + instruction := elna_rtl_instruction_create(ElnaRtlOperator.sw); + elna_rtl_instruction_set_operand(instruction, 1, source_operand.kind, source_operand.value, source_operand.length, 0); + elna_rtl_instruction_set_operand(instruction, 2, target_operand.kind, target_operand.value, + target_operand.length, tac_instruction^.operands[3].value); + instruction^.types[1] := rtl_type; + elna_list_append(instructions, instruction) + end +end + +proc elna_rtl_load(instructions: ^ElnaList; tac_instruction: ^ElnaTacInstruction; variable_map: ^ElnaSymbolTable) +var + instruction: ^ElnaRtlInstruction + rtl_operand: ElnaRtlOperand + pseudo_symbol: ^ElnaRtlObjectInfo +begin + elna_rtl_operand_value(instructions, @tac_instruction^.operands[1], variable_map, @rtl_operand); + pseudo_symbol := elna_symbol_table_lookup(variable_map, + tac_instruction^.operands[2].value, tac_instruction^.operands[2].length); + + if pseudo_symbol^.rtl_type^.kind = ElnaRtlTypeKind.byte_array then + instruction := elna_rtl_instruction_create(ElnaRtlOperator.la); + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.register, ElnaRtlRegister.a0, 0, 0); + elna_rtl_instruction_set_operand(instruction, 2, ElnaRtlKind.pseudo, + tac_instruction^.operands[2].value, tac_instruction^.operands[2].length, 0); + elna_list_append(instructions, instruction); + + instruction := elna_rtl_instruction_create(ElnaRtlOperator.mv); + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.register, ElnaRtlRegister.a1, 0, 0); + elna_rtl_instruction_set_operand(instruction, 2, rtl_operand.kind, rtl_operand.value, rtl_operand.length, 0); + elna_list_append(instructions, instruction); + + elna_rtl_memcpy(instructions, pseudo_symbol^.rtl_type) + else + instruction := elna_rtl_instruction_create(ElnaRtlOperator.lw); + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.pseudo, + tac_instruction^.operands[2].value, tac_instruction^.operands[2].length, 0); + elna_rtl_instruction_set_operand(instruction, 2, rtl_operand.kind, rtl_operand.value, rtl_operand.length, 0); + instruction^.types[1] := pseudo_symbol^.rtl_type; + + elna_list_append(instructions, instruction) + end +end + +proc elna_rtl_copy_from_offset(instructions: ^ElnaList; tac_instruction: ^ElnaTacInstruction; variable_map: ^ElnaSymbolTable) +var + instruction: ^ElnaRtlInstruction + rtl_operand: ElnaRtlOperand + pseudo_symbol: ^ElnaRtlObjectInfo +begin + pseudo_symbol := elna_symbol_table_lookup(variable_map, + tac_instruction^.operands[3].value, tac_instruction^.operands[3].length); + + if pseudo_symbol^.rtl_type^.kind = ElnaRtlTypeKind.byte_array then + instruction := elna_rtl_instruction_create(ElnaRtlOperator.la); + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.register, ElnaRtlRegister.a0, 0, 0); + elna_rtl_instruction_set_operand(instruction, 2, ElnaRtlKind.pseudo_mem, + tac_instruction^.operands[3].value, tac_instruction^.operands[3].length, 0); + elna_list_append(instructions, instruction); + + instruction := elna_rtl_instruction_create(ElnaRtlOperator.la); + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.register, ElnaRtlRegister.a1, 0, 0); + elna_rtl_instruction_set_operand(instruction, 2, ElnaRtlKind.pseudo_mem, + tac_instruction^.operands[1].value, tac_instruction^.operands[1].length, 0); + elna_list_append(instructions, instruction); + + instruction := elna_rtl_instruction_create(ElnaRtlOperator.addi); + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.register, ElnaRtlRegister.a1, 0, 0); + elna_rtl_instruction_set_operand(instruction, 2, ElnaRtlKind.register, ElnaRtlRegister.a1, 0, 0); + elna_rtl_instruction_set_operand(instruction, 3, ElnaRtlKind.immediate, tac_instruction^.operands[2].value, 0, 0); + elna_list_append(instructions, instruction); + + elna_rtl_memcpy(instructions, pseudo_symbol^.rtl_type) + else + rtl_operand.kind := ElnaRtlKind.pseudo; + rtl_operand.value := tac_instruction^.operands[3].value; + rtl_operand.length := tac_instruction^.operands[3].length; + + instruction := elna_rtl_operand_address(variable_map, @tac_instruction^.operands[1], @rtl_operand); + elna_list_append(instructions, instruction); + + instruction := elna_rtl_instruction_create(ElnaRtlOperator.lw); + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.pseudo, + tac_instruction^.operands[3].value, tac_instruction^.operands[3].length, 0); + elna_rtl_instruction_set_operand(instruction, 2, ElnaRtlKind.pseudo, tac_instruction^.operands[3].value, + tac_instruction^.operands[3].length, tac_instruction^.operands[2].value); + elna_list_append(instructions, instruction); + instruction^.types[1] := pseudo_symbol^.rtl_type + end +end + +proc elna_rtl_memcpy(instructions: ^ElnaList; byte_array: ^ElnaRtlTypeByteArray) +var + instruction: ^ElnaRtlInstruction +begin + instruction := elna_rtl_instruction_create(ElnaRtlOperator.li); + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.register, ElnaRtlRegister.a2, 0, 0); + elna_rtl_instruction_set_operand(instruction, 2, ElnaRtlKind.immediate, byte_array^.size, 0, 0); + elna_list_append(instructions, instruction); + + instruction := elna_rtl_instruction_create(ElnaRtlOperator.jal); + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.data, "memcpy".ptr, 6, 0); + elna_list_append(instructions, instruction) +end + +proc elna_rtl_copy(instructions: ^ElnaList; tac_instruction: ^ElnaTacInstruction; variable_map: ^ElnaSymbolTable) +var + instruction: ^ElnaRtlInstruction + source_operand: ElnaRtlOperand + pseudo_symbol: ^ElnaRtlObjectInfo +begin + pseudo_symbol := elna_symbol_table_lookup(variable_map, + tac_instruction^.operands[2].value, tac_instruction^.operands[2].length); + elna_rtl_operand_value(instructions, @tac_instruction^.operands[1], variable_map, @source_operand); + + if source_operand.kind = ElnaRtlKind.pseudo then + instruction := elna_rtl_instruction_create(ElnaRtlOperator.mv); + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.pseudo, + tac_instruction^.operands[2].value, tac_instruction^.operands[2].length, 0); + elna_rtl_instruction_set_operand(instruction, 2, source_operand.kind, source_operand.value, source_operand.length, 0); + instruction^.types[1] := pseudo_symbol^.rtl_type; + elna_list_append(instructions, instruction); + else + instruction := elna_rtl_instruction_create(ElnaRtlOperator.la); + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.register, ElnaRtlRegister.a0, 0, 0); + elna_rtl_instruction_set_operand(instruction, 2, ElnaRtlKind.pseudo_mem, + tac_instruction^.operands[2].value, tac_instruction^.operands[2].length, 0); + elna_list_append(instructions, instruction); + + instruction := elna_rtl_instruction_create(ElnaRtlOperator.la); + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.register, ElnaRtlRegister.a1, 0, 0); + elna_rtl_instruction_set_operand(instruction, 2, source_operand.kind, source_operand.value, source_operand.length, 0); + elna_list_append(instructions, instruction); + + elna_rtl_memcpy(instructions, pseudo_symbol^.rtl_type) + end +end + +proc elna_rtl_instruction(instructions: ^ElnaList; tac_instruction: ^ElnaTacInstruction; variable_map: ^ElnaSymbolTable) +var + instruction: ^ElnaRtlInstruction +begin + if tac_instruction^.operator = ElnaTacOperator.get_address then + elna_rtl_get_address(instructions, tac_instruction, variable_map) + elsif tac_instruction^.operator = ElnaTacOperator.add then + elna_rtl_binary_arithmetic(instructions, tac_instruction, ElnaRtlOperator.add, variable_map) + elsif tac_instruction^.operator = ElnaTacOperator.add_ptr then + elna_rtl_add_ptr(instructions, tac_instruction, variable_map) + elsif tac_instruction^.operator = ElnaTacOperator.load then + elna_rtl_load(instructions, tac_instruction, variable_map) + elsif tac_instruction^.operator = ElnaTacOperator.copy_from_offset then + elna_rtl_copy_from_offset(instructions, tac_instruction, variable_map) + elsif tac_instruction^.operator = ElnaTacOperator.store then + elna_rtl_store(instructions, tac_instruction, variable_map) + elsif tac_instruction^.operator = ElnaTacOperator.copy_to_offset then + elna_rtl_copy_to_offset(instructions, tac_instruction, variable_map) + elsif tac_instruction^.operator = ElnaTacOperator.proc_call then + elna_rtl_call(instructions, tac_instruction, variable_map) + elsif tac_instruction^.operator = ElnaTacOperator.subtract then + elna_rtl_binary_arithmetic(instructions, tac_instruction, ElnaRtlOperator.sub, variable_map) + elsif tac_instruction^.operator = ElnaTacOperator.multiply then + elna_rtl_binary_arithmetic(instructions, tac_instruction, ElnaRtlOperator.mul, variable_map) + elsif tac_instruction^.operator = ElnaTacOperator.divide then + elna_rtl_binary_arithmetic(instructions, tac_instruction, ElnaRtlOperator.div, variable_map) + elsif tac_instruction^.operator = ElnaTacOperator.remainder then + elna_rtl_binary_arithmetic(instructions, tac_instruction, ElnaRtlOperator.rem, variable_map) + elsif tac_instruction^.operator = ElnaTacOperator._xor then + elna_rtl_binary_arithmetic(instructions, tac_instruction, ElnaRtlOperator._xor, variable_map) + elsif tac_instruction^.operator = ElnaTacOperator._or then + elna_rtl_binary_arithmetic(instructions, tac_instruction, ElnaRtlOperator._or, variable_map) + elsif tac_instruction^.operator = ElnaTacOperator.and then + elna_rtl_binary_arithmetic(instructions, tac_instruction, ElnaRtlOperator.and, variable_map) + elsif tac_instruction^.operator = ElnaTacOperator.less_than then + elna_rtl_set_less_than(instructions, tac_instruction, 2, 3, variable_map) + elsif tac_instruction^.operator = ElnaTacOperator.greater_than then + elna_rtl_set_less_than(instructions, tac_instruction, 3, 2, variable_map) + elsif tac_instruction^.operator = ElnaTacOperator.less_or_equal then + elna_rtl_binary_comparison(instructions, tac_instruction, 3, 2, variable_map) + elsif tac_instruction^.operator = ElnaTacOperator.greater_or_equal then + elna_rtl_binary_comparison(instructions, tac_instruction, 2, 3, variable_map) + elsif tac_instruction^.operator = ElnaTacOperator.equal then + elna_rtl_binary_equality(instructions, tac_instruction, ElnaRtlOperator.seqz, variable_map) + elsif tac_instruction^.operator = ElnaTacOperator.not_equal then + elna_rtl_binary_equality(instructions, tac_instruction, ElnaRtlOperator.snez, variable_map) + elsif tac_instruction^.operator = ElnaTacOperator.negate then + elna_rtl_unary(instructions, tac_instruction, ElnaRtlOperator.neg, variable_map) + elsif tac_instruction^.operator = ElnaTacOperator.complement then + elna_rtl_unary(instructions, tac_instruction, ElnaRtlOperator.not, variable_map) + elsif tac_instruction^.operator = ElnaTacOperator.jump then + instruction := elna_rtl_instruction_create(ElnaRtlOperator.j); + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.data, + tac_instruction^.operands[1].value, tac_instruction^.operands[1].length, 0); + elna_list_append(instructions, instruction) + elsif tac_instruction^.operator = ElnaTacOperator.jump_if_zero then + elna_rtl_conditional_jump(instructions, tac_instruction, ElnaRtlOperator.beqz, variable_map) + elsif tac_instruction^.operator = ElnaTacOperator.jump_if_not_zero then + elna_rtl_conditional_jump(instructions, tac_instruction, ElnaRtlOperator.bnez, variable_map) + elsif tac_instruction^.operator = ElnaTacOperator._return then + elna_rtl_hardware_value(instructions, @tac_instruction^.operands[1], ElnaRtlRegister.a0, variable_map) + elsif tac_instruction^.operator = ElnaTacOperator.label then + instruction := elna_rtl_instruction_create(ElnaRtlOperator.label); + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.data, + tac_instruction^.operands[1].value, tac_instruction^.operands[1].length, 0); + elna_list_append(instructions, instruction) + elsif tac_instruction^.operator = ElnaTacOperator.copy then + elna_rtl_copy(instructions, tac_instruction, variable_map) + elsif tac_instruction^.operator = ElnaTacOperator.nop then + instruction := elna_rtl_instruction_create(ElnaRtlOperator.nop); + elna_rtl_instruction_set_operand(instruction, 1, tac_instruction^.operands[1].kind, + tac_instruction^.operands[1].value, tac_instruction^.operands[1].length, 0); + elna_rtl_instruction_set_operand(instruction, 2, tac_instruction^.operands[2].kind, + tac_instruction^.operands[2].value, tac_instruction^.operands[2].length, 0); + elna_rtl_instruction_set_operand(instruction, 3, tac_instruction^.operands[3].kind, + tac_instruction^.operands[3].value, tac_instruction^.operands[3].length, 0); + elna_list_append(instructions, instruction) + end +end + + +(** + * Generates an auto incremented label and returns its name. + *) +proc elna_tac_label(): String +var + buffer: String +begin + buffer.ptr := malloc(7); + + sprintf(buffer.ptr, ".L%i\0".ptr, label_counter); + buffer.length := strlen(buffer); + label_counter := label_counter + 1; + + return buffer +end + +proc elna_riscv_instruction_name(instruction_kind: ElnaRtlOperator; + source_type, destination_type: ^ElnaRtlType): Word +var + argument_count: Word +begin + if instruction_kind = ElnaRtlOperator.li then + argument_count := 2; + _write_s(stdout, "\tli") + elsif instruction_kind = ElnaRtlOperator.la then + argument_count := 2; + _write_s(stdout, "\tla") + elsif instruction_kind = ElnaRtlOperator.add then + argument_count := 3; + _write_s(stdout, "\tadd") + elsif instruction_kind = ElnaRtlOperator.addi then + argument_count := 3; + _write_s(stdout, "\taddi") + elsif instruction_kind = ElnaRtlOperator.lw then + argument_count := 2; + if source_type^.kind = ElnaRtlTypeKind.byte then + _write_s(stdout, "\tlb") + else + _write_s(stdout, "\tlw") + end + elsif instruction_kind = ElnaRtlOperator.sw then + argument_count := 2; + if source_type^.kind = ElnaRtlTypeKind.byte then + _write_s(stdout, "\tsb") + else + _write_s(stdout, "\tsw") + end + elsif instruction_kind = ElnaRtlOperator.jal then + argument_count := 1; + _write_s(stdout, "\tcall") + elsif instruction_kind = ElnaRtlOperator.mv then + argument_count := 2; + _write_s(stdout, "\tmv") + elsif instruction_kind = ElnaRtlOperator.sub then + argument_count := 3; + _write_s(stdout, "\tsub") + elsif instruction_kind = ElnaRtlOperator.mul then + argument_count := 3; + _write_s(stdout, "\tmul") + elsif instruction_kind = ElnaRtlOperator.div then + argument_count := 3; + _write_s(stdout, "\tdiv") + elsif instruction_kind = ElnaRtlOperator.rem then + argument_count := 3; + _write_s(stdout, "\trem") + elsif instruction_kind = ElnaRtlOperator._xor then + argument_count := 3; + _write_s(stdout, "\txor") + elsif instruction_kind = ElnaRtlOperator.xori then + argument_count := 3; + _write_s(stdout, "\txori") + elsif instruction_kind = ElnaRtlOperator._or then + argument_count := 3; + _write_s(stdout, "\tor") + elsif instruction_kind = ElnaRtlOperator.and then + argument_count := 3; + _write_s(stdout, "\tand") + elsif instruction_kind = ElnaRtlOperator.seqz then + argument_count := 2; + _write_s(stdout, "\tseqz") + elsif instruction_kind = ElnaRtlOperator.snez then + argument_count := 2; + _write_s(stdout, "\tsnez") + elsif instruction_kind = ElnaRtlOperator.slt then + argument_count := 3; + _write_s(stdout, "\tslt") + elsif instruction_kind = ElnaRtlOperator.neg then + argument_count := 2; + _write_s(stdout, "\tneg") + elsif instruction_kind = ElnaRtlOperator.not then + argument_count := 2; + _write_s(stdout, "\tnot") + elsif instruction_kind = ElnaRtlOperator.j then + argument_count := 1; + _write_s(stdout, "\tj") + elsif instruction_kind = ElnaRtlOperator.beqz then + argument_count := 2; + _write_s(stdout, "\tbeqz") + elsif instruction_kind = ElnaRtlOperator.bnez then + argument_count := 2; + _write_s(stdout, "\tbnez") + end; + return argument_count +end + +proc elna_riscv_register(register: Word) +begin + fprintf(stdout, "x%i\0".ptr, register - 1); +end + +proc elna_riscv_operand(instruction: ^ElnaRtlInstruction; n: Word) +var + operand_type: Word +begin + operand_type := instruction^.operands[n].kind; + + _write_c(stdout, ' '); + if operand_type = ElnaRtlKind.register then + elna_riscv_register(instruction^.operands[n].value) + elsif operand_type = ElnaRtlKind.memory then + _write_i(stdout, instruction^.operands[n].offset); + _write_c(stdout, '('); + elna_riscv_register(instruction^.operands[n].value); + _write_c(stdout, ')') + elsif operand_type = ElnaRtlKind.data then + _write(stdout, instruction^.operands[n].value, instruction^.operands[n].length) + elsif instruction^.operands[n].length = 0 then (* ElnaRtlKind.immediate *) + _write_i(stdout, instruction^.operands[n].value) + else + _write(stdout, instruction^.operands[n].value, instruction^.operands[n].length) + end +end + +proc elna_alloc_variable(operand_value, operand_length: Word; + variable_map: ^ElnaSymbolTable): ^ElnaRtlObjectInfo +var + pseudo_symbol: ^ElnaRtlObjectInfo + pseudo_type: ^ElnaRtlTypeByteArray + type_size: Word +begin + pseudo_symbol := elna_symbol_table_lookup(variable_map, operand_value, operand_length); + if pseudo_symbol = nil then + goto elna_alloc_variable_end + end; + if pseudo_symbol^.allocated = false then + if pseudo_symbol^.rtl_type^.kind = ElnaRtlTypeKind.byte_array then + pseudo_type := pseudo_symbol^.rtl_type; + + pseudo_symbol^.counter := _align_at(temporary_variable_counter, pseudo_type^.alignment); + type_size := pseudo_type^.size + elsif pseudo_symbol^.rtl_type^.kind = ElnaRtlTypeKind.byte then + pseudo_symbol^.counter := temporary_variable_counter; + type_size := 1 + else + pseudo_symbol^.counter := _align_at(temporary_variable_counter, 4); + type_size := 4 + end; + temporary_variable_counter := pseudo_symbol^.counter + type_size; + pseudo_symbol^.allocated := true + end; + .elna_alloc_variable_end; + return pseudo_symbol +end + +(** + * If the first operand of an instruction is an operation target and expected + * to be a register, but is not a register, then this procedure rewrites it + * to a temporary register and preserves its value in the following instruction. + *) +proc elna_alloc_operation_target(instructions: ^ElnaList; instruction: ^ElnaRtlInstruction; + variable_map: ^ElnaSymbolTable): ^ElnaRtlInstruction +var + pseudo_symbol: ^ElnaRtlObjectInfo + store_instruction: ^ElnaRtlInstruction +begin + if instruction^.operands[1].kind = ElnaRtlKind.pseudo then + store_instruction := elna_rtl_instruction_create(ElnaRtlOperator.sw); + pseudo_symbol := elna_alloc_variable(instruction^.operands[1].value, instruction^.operands[1].length, + variable_map); + + elna_rtl_instruction_set_operand(store_instruction, 1, ElnaRtlKind.register, ElnaRtlRegister.t0, 0, 0); + elna_rtl_instruction_set_operand(store_instruction, 2, ElnaRtlKind.memory, + ElnaRtlRegister.sp, 0, pseudo_symbol^.counter); + store_instruction^.types[1] := pseudo_symbol^.rtl_type; + + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.register, ElnaRtlRegister.t0, 0, 0); + elna_list_insert(instructions, instruction, store_instruction); + instruction := store_instruction + end; + return instruction +end + +proc elna_alloc_load_address(instructions: ^ElnaList; instruction: ^ElnaRtlInstruction; variable_map: ^ElnaSymbolTable) +var + pseudo_symbol: ^ElnaRtlObjectInfo +begin + (* pseudo or pseudo_mem. *) + if instruction^.operands[2].kind <> ElnaRtlKind.data then + pseudo_symbol := elna_symbol_table_lookup(variable_map, instruction^.operands[2].value, instruction^.operands[2].length); + + if pseudo_symbol^.kind = ElnaRtlInfoKind.object_info then + pseudo_symbol := elna_alloc_variable(instruction^.operands[2].value, instruction^.operands[2].length, + variable_map); + instruction^.operator := ElnaRtlOperator.addi; + + elna_rtl_instruction_set_operand(instruction, 2, ElnaRtlKind.register, ElnaRtlRegister.sp, 0, 0); + elna_rtl_instruction_set_operand(instruction, 3, ElnaRtlKind.immediate, pseudo_symbol^.counter, 0, 0) + end + end; + if instruction^.operands[1].kind = ElnaRtlKind.pseudo then + elna_alloc_operation_target(instructions, instruction, variable_map) + end +end + +proc elna_alloc_store(instructions: ^ElnaList; instruction: ^ElnaRtlInstruction; + variable_map: ^ElnaSymbolTable): ^ElnaRtlInstruction +var + store_instruction: ^ElnaRtlInstruction + pseudo_symbol: ^ElnaRtlObjectInfo +begin + instruction := elna_alloc_operand(instructions, instruction, 1, ElnaRtlRegister.t0, variable_map); + + if instruction^.operands[2].kind = ElnaRtlKind.pseudo then + store_instruction := elna_rtl_instruction_create(ElnaRtlOperator.sw); + + elna_rtl_instruction_set_operand(store_instruction, 1, ElnaRtlKind.register, ElnaRtlRegister.t0, 0, 0); + elna_rtl_instruction_set_operand(store_instruction, 2, ElnaRtlKind.memory, ElnaRtlRegister.t1, 0, + instruction^.operands[2].offset); + store_instruction^.types[1] := instruction^.types[1]; + + pseudo_symbol := elna_alloc_variable(instruction^.operands[2].value, instruction^.operands[2].length, + variable_map); + instruction^.operator := ElnaRtlOperator.lw; + (* Because it is an address. *) + instruction^.types[1] := elna_rtl_constant_type(4); + + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.register, ElnaRtlRegister.t1, 0, 0); + elna_rtl_instruction_set_operand(instruction, 2, ElnaRtlKind.memory, + ElnaRtlRegister.sp, 0, pseudo_symbol^.counter); + elna_list_insert(instructions, instruction, store_instruction); + instruction := store_instruction + end; + return instruction +end + +proc elna_alloc_load(instructions: ^ElnaList; instruction: ^ElnaRtlInstruction; + variable_map: ^ElnaSymbolTable): ^ElnaRtlInstruction +var + new_instruction: ^ElnaRtlInstruction + pseudo_symbol: ^ElnaRtlObjectInfo +begin + if instruction^.operands[2].kind = ElnaRtlKind.pseudo then + pseudo_symbol := elna_alloc_variable(instruction^.operands[2].value, + instruction^.operands[2].length, variable_map); + new_instruction := malloc(#size(ElnaRtlInstruction)); + new_instruction^ := instruction^; + new_instruction^.next := nil; + + elna_rtl_instruction_set_operand(new_instruction, 2, ElnaRtlKind.memory, ElnaRtlRegister.t0, 0, + instruction^.operands[2].offset); + + instruction^.operator := ElnaRtlOperator.lw; + (* Because it is an address. *) + instruction^.types[1] := elna_rtl_constant_type(4); + + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.register, ElnaRtlRegister.t0, 0, 0); + elna_rtl_instruction_set_operand(instruction, 2, ElnaRtlKind.memory, + ElnaRtlRegister.sp, 0, pseudo_symbol^.counter); + elna_list_insert(instructions, instruction, new_instruction); + instruction := new_instruction + end; + return elna_alloc_operation_target(instructions, instruction, variable_map) +end + +proc elna_alloc_move(instructions: ^ElnaList; instruction: ^ElnaRtlInstruction; + variable_map: ^ElnaSymbolTable): ^ElnaRtlInstruction +var + load_instruction: ^ElnaRtlInstruction + source_operand: ElnaRtlOperand + target_operand: ElnaRtlOperand + pseudo_symbol: ^ElnaRtlObjectInfo + destination_pseudo: Word + source_pseudo: Word +begin + target_operand := instruction^.operands[1]; + source_operand := instruction^.operands[2]; + destination_pseudo := target_operand.kind = ElnaRtlKind.pseudo; + source_pseudo := source_operand.kind = ElnaRtlKind.pseudo; + + if destination_pseudo & source_pseudo then + pseudo_symbol := elna_symbol_table_lookup(variable_map, target_operand.value, target_operand.length); + instruction := elna_alloc_operand(instructions, instruction, 2, ElnaRtlRegister.t0, variable_map); + + if pseudo_symbol^.kind = ElnaRtlInfoKind.static_info then + load_instruction := malloc(#size(ElnaRtlInstruction)); + load_instruction^ := instruction^; + load_instruction^.next := nil; + + instruction^.operator := ElnaRtlOperator.la; + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.register, ElnaRtlRegister.t1, 0, 0); + elna_rtl_instruction_set_operand(instruction, 2, ElnaRtlKind.data, target_operand.value, target_operand.length, 0); + elna_list_insert(instructions, instruction, load_instruction); + + load_instruction^.operator := ElnaRtlOperator.sw; + elna_rtl_instruction_set_operand(load_instruction, 1, ElnaRtlKind.register, ElnaRtlRegister.t0, 0, 0); + elna_rtl_instruction_set_operand(load_instruction, 2, ElnaRtlKind.memory, ElnaRtlRegister.t1, 0, 0) + else + pseudo_symbol := elna_alloc_variable(target_operand.value, target_operand.length, variable_map); + instruction^.operator := ElnaRtlOperator.sw; + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.register, ElnaRtlRegister.t0, 0, 0); + elna_rtl_instruction_set_operand(instruction, 2, ElnaRtlKind.memory, + ElnaRtlRegister.sp, 0, pseudo_symbol^.counter); + + instruction^.types[1] := pseudo_symbol^.rtl_type + end + elsif destination_pseudo then + pseudo_symbol := elna_symbol_table_lookup(variable_map, target_operand.value, target_operand.length); + + if pseudo_symbol^.kind = ElnaRtlInfoKind.static_info then + load_instruction := malloc(#size(ElnaRtlInstruction)); + load_instruction^ := instruction^; + load_instruction^.next := nil; + + instruction^.operator := ElnaRtlOperator.la; + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.register, ElnaRtlRegister.t1, 0, 0); + elna_list_insert(instructions, instruction, load_instruction); + + load_instruction^.operator := ElnaRtlOperator.sw; + elna_rtl_instruction_set_operand(load_instruction, 2, ElnaRtlKind.memory, ElnaRtlRegister.t1, 0, 0) + else + pseudo_symbol := elna_alloc_variable(target_operand.value, target_operand.length, variable_map); + instruction^.operator := ElnaRtlOperator.sw; + + elna_rtl_instruction_set_operand(instruction, 1, source_operand.kind, + source_operand.value, source_operand.length, 0); + elna_rtl_instruction_set_operand(instruction, 2, ElnaRtlKind.memory, + ElnaRtlRegister.sp, 0, pseudo_symbol^.counter) + end; + instruction^.types[1] := pseudo_symbol^.rtl_type + elsif source_pseudo then + pseudo_symbol := elna_alloc_variable(source_operand.value, source_operand.length, variable_map); + + if pseudo_symbol^.kind = ElnaRtlInfoKind.static_info then + load_instruction := malloc(#size(ElnaRtlInstruction)); + load_instruction^ := instruction^; + load_instruction^.next := nil; + + instruction^.operator := ElnaRtlOperator.la; + elna_list_insert(instructions, instruction, load_instruction); + + load_instruction^.operator := ElnaRtlOperator.lw; + elna_rtl_instruction_set_operand(load_instruction, 2, ElnaRtlKind.memory, + target_operand.value, target_operand.length, 0); + load_instruction^.types[1] := pseudo_symbol^.rtl_type + else + instruction^.operator := ElnaRtlOperator.lw; + elna_rtl_instruction_set_operand(instruction, 2, ElnaRtlKind.memory, + ElnaRtlRegister.sp, 0, pseudo_symbol^.counter) + end; + instruction^.types[1] := pseudo_symbol^.rtl_type + end; + return instruction +end + +(** + * Move the operand value from the pseudo register into a hardware register if needed. + * If copying requires an additional instruction inserts the instruction before the + * current instruction and returns the new current instruction. + *) +proc elna_alloc_operand(instructions: ^ElnaList; instruction: ^ElnaRtlInstruction; + number: Word; target: ElnaRtlRegister; variable_map: ^ElnaSymbolTable): ^ElnaRtlInstruction +var + main_instruction: ^ElnaRtlInstruction + load_instruction: ^ElnaRtlInstruction + pseudo_symbol: ^ElnaRtlObjectInfo +begin + if instruction^.operands[number].kind = ElnaRtlKind.pseudo then + pseudo_symbol := elna_alloc_variable(instruction^.operands[number].value, + instruction^.operands[number].length, variable_map); + main_instruction := malloc(#size(ElnaRtlInstruction)); + + main_instruction^ := instruction^; + main_instruction^.next := nil; + + elna_rtl_instruction_set_operand(main_instruction, number, ElnaRtlKind.register, target, 0, 0); + + if pseudo_symbol^.kind = ElnaRtlInfoKind.static_info then + instruction^.operator := ElnaRtlOperator.la; + + elna_rtl_instruction_set_operand(instruction, 2, ElnaRtlKind.data, + instruction^.operands[number].value, instruction^.operands[number].length, 0); + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.register, target, 0, 0); + elna_list_insert(instructions, instruction, main_instruction); + + load_instruction := elna_rtl_instruction_create(ElnaRtlOperator.lw); + elna_rtl_instruction_set_operand(load_instruction, 1, ElnaRtlKind.register, target, 0, 0); + elna_rtl_instruction_set_operand(load_instruction, 2, ElnaRtlKind.memory, target, 0, 0); + load_instruction^.types[1] := pseudo_symbol^.rtl_type; + + elna_list_insert(instructions, instruction, load_instruction) + else + instruction^.operator := ElnaRtlOperator.lw; + + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.register, target, 0, 0); + elna_rtl_instruction_set_operand(instruction, 2, ElnaRtlKind.memory, + ElnaRtlRegister.sp, 0, pseudo_symbol^.counter); + instruction^.types[1] := pseudo_symbol^.rtl_type; + + elna_list_insert(instructions, instruction, main_instruction); + end; + instruction := main_instruction + end; + return instruction +end + +proc elna_alloc_binary(instructions: ^ElnaList; instruction: ^ElnaRtlInstruction; + variable_map: ^ElnaSymbolTable): ^ElnaRtlInstruction +begin + instruction := elna_alloc_operand(instructions, instruction, 2, ElnaRtlRegister.t0, variable_map); + instruction := elna_alloc_operand(instructions, instruction, 3, ElnaRtlRegister.t1, variable_map); + return elna_alloc_operation_target(instructions, instruction, variable_map) +end + +proc elna_alloc_unary(instructions: ^ElnaList; instruction: ^ElnaRtlInstruction; + variable_map: ^ElnaSymbolTable): ^ElnaRtlInstruction +begin + instruction := elna_alloc_operand(instructions, instruction, 2, ElnaRtlRegister.t0, variable_map); + return elna_alloc_operation_target(instructions, instruction, variable_map) +end + +proc elna_alloc_instruction(instructions: ^ElnaList; instruction: ^ElnaRtlInstruction; + variable_map: ^ElnaSymbolTable): ^ElnaRtlInstruction +var + pseudo_symbol: ^ElnaRtlObjectInfo + new_instruction: ^ElnaRtlInstruction +begin + if instruction^.operator = ElnaRtlOperator.mv then + instruction := elna_alloc_move(instructions, instruction, variable_map) + elsif instruction^.operator = ElnaRtlOperator.la then + elna_alloc_load_address(instructions, instruction, variable_map) + elsif instruction^.operator = ElnaRtlOperator.lw then + instruction := elna_alloc_load(instructions, instruction, variable_map) + elsif instruction^.operator = ElnaRtlOperator.sw then + instruction := elna_alloc_store(instructions, instruction, variable_map) + elsif instruction^.operator = ElnaRtlOperator._or then + instruction := elna_alloc_binary(instructions, instruction, variable_map) + elsif instruction^.operator = ElnaRtlOperator.and then + instruction := elna_alloc_binary(instructions, instruction, variable_map) + elsif instruction^.operator = ElnaRtlOperator.mul then + instruction := elna_alloc_binary(instructions, instruction, variable_map) + elsif instruction^.operator = ElnaRtlOperator.sub then + instruction := elna_alloc_binary(instructions, instruction, variable_map) + elsif instruction^.operator = ElnaRtlOperator.add then + instruction := elna_alloc_binary(instructions, instruction, variable_map) + elsif instruction^.operator = ElnaRtlOperator._xor then + instruction := elna_alloc_binary(instructions, instruction, variable_map) + elsif instruction^.operator = ElnaRtlOperator.div then + instruction := elna_alloc_binary(instructions, instruction, variable_map) + elsif instruction^.operator = ElnaRtlOperator.rem then + instruction := elna_alloc_binary(instructions, instruction, variable_map) + elsif instruction^.operator = ElnaRtlOperator.slt then + instruction := elna_alloc_binary(instructions, instruction, variable_map) + elsif instruction^.operator = ElnaRtlOperator.beqz then + if instruction^.operands[1].kind = ElnaRtlKind.pseudo then + new_instruction := elna_rtl_instruction_create(ElnaRtlOperator.beqz); + elna_rtl_instruction_set_operand(new_instruction, 1, ElnaRtlKind.register, ElnaRtlRegister.t0, 0, 0); + elna_rtl_instruction_set_operand(new_instruction, 2, instruction^.operands[2].kind, + instruction^.operands[2].value, instruction^.operands[2].length, 0); + + pseudo_symbol := elna_alloc_variable(instruction^.operands[1].value, instruction^.operands[1].length, + variable_map); + instruction^.operator := ElnaRtlOperator.lw; + + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.register, ElnaRtlRegister.t0, 0, 0); + elna_rtl_instruction_set_operand(instruction, 2, ElnaRtlKind.memory, + ElnaRtlRegister.sp, 0, pseudo_symbol^.counter); + instruction^.types[1] := pseudo_symbol^.rtl_type; + + elna_list_insert(instructions, instruction, new_instruction) + end + elsif instruction^.operator = ElnaRtlOperator.seqz then + instruction := elna_alloc_unary(instructions, instruction, variable_map) + elsif instruction^.operator = ElnaRtlOperator.snez then + instruction := elna_alloc_unary(instructions, instruction, variable_map) + elsif instruction^.operator = ElnaRtlOperator.xori then + instruction := elna_alloc_binary(instructions, instruction, variable_map) + elsif instruction^.operator = ElnaRtlOperator.addi then + instruction := elna_alloc_binary(instructions, instruction, variable_map) + elsif instruction^.operator = ElnaRtlOperator.li then + elna_alloc_operation_target(instructions, instruction, variable_map) + end; + return instruction^.next +end + +proc elna_riscv_instruction(instruction: ^ElnaRtlInstruction) +var + argument_count: Word + current_argument: Word + operand_value: Word +begin + argument_count := 0; + + if instruction^.operator = ElnaRtlOperator.label then + _write(stdout, instruction^.operands[1].value, instruction^.operands[1].length); + _write_c(stdout, ':') + elsif instruction^.operator = ElnaRtlOperator.allocate_stack then + operand_value := instruction^.operands[1].value; + + (* Write the prologue. *) + _write_s(stdout, "\taddi sp, sp, -"); + _write_i(stdout, operand_value); + _write_s(stdout, "\n\tsw ra, "); + _write_i(stdout, operand_value - 4); + _write_s(stdout, "(sp)\n\tsw s0, "); + _write_i(stdout, operand_value - 8); + _write_s(stdout, "(sp)\n\taddi s0, sp, "); + _write_i(stdout, operand_value); + _write_c(stdout, '\n') + elsif instruction^.operator = ElnaRtlOperator.ret then + operand_value := instruction^.operands[1].value; + + (* Write the epilogue. *) + _write_s(stdout, "\tlw ra, "); + _write_i(stdout, operand_value - 4); + _write_s(stdout, "(sp)\n\tlw s0, "); + _write_i(stdout, operand_value - 8); + _write_s(stdout, "(sp)\n\taddi sp, sp, "); + _write_i(stdout, operand_value); + _write_c(stdout, '\n') + elsif instruction^.operator = ElnaRtlOperator.nop then + else + argument_count := elna_riscv_instruction_name(instruction^.operator, + instruction^.types[1], instruction^.types[2]) + end; + current_argument := 1; + + .elna_riscv_instruction_loop; + if current_argument <= argument_count then + elna_riscv_operand(instruction, current_argument); + current_argument := current_argument + 1 + end; + if current_argument <= argument_count then + _write_c(stdout, ','); + goto elna_riscv_instruction_loop + end; + _write_c(stdout, '\n') +end + +proc elna_rtl_instructions(instructions: ^ElnaList; instruction: ^ElnaTacInstruction; variable_map: ^ElnaSymbolTable) +begin + .elna_rtl_instructions_start; + if instruction <> nil then + elna_rtl_instruction(instructions, instruction, variable_map); + instruction := instruction^.next; + + goto elna_rtl_instructions_start + end +end + +proc elna_alloc_instructions(instructions: ^ElnaList; variable_map: ^ElnaSymbolTable) +var + instruction: ^ElnaRtlInstruction +begin + instruction := instructions^.first; + + .elna_alloc_instructions_start; + + if instruction <> nil then + instruction := elna_alloc_instruction(instructions, instruction, variable_map); + + goto elna_alloc_instructions_start + end +end + +proc elna_riscv_instructions(instruction: ^ElnaRtlInstruction) +begin + .elna_riscv_instructions_start; + if instruction <> nil then + elna_riscv_instruction(instruction); + instruction := instruction^.next; + goto elna_riscv_instructions_start + end +end + +proc elna_alloc_procedure(rtl_declaration: ^ElnaRtlProcedure) +var + stack_instruction: ^ElnaRtlInstruction +begin + .elna_alloc_procedure_loop; + temporary_variable_counter := 0; + + elna_alloc_instructions(@rtl_declaration^.body, rtl_declaration^.variable_map); + + stack_instruction := elna_rtl_instruction_create(ElnaRtlOperator.allocate_stack); + elna_rtl_instruction_set_operand(stack_instruction, 1, ElnaRtlKind.immediate, temporary_variable_counter, 0, 0); + elna_list_prepend(@rtl_declaration^.body, stack_instruction); + + stack_instruction := elna_rtl_instruction_create(ElnaRtlOperator.ret); + elna_rtl_instruction_set_operand(stack_instruction, 1, ElnaRtlKind.immediate, temporary_variable_counter, 0, 0); + + elna_list_append(@rtl_declaration^.body, stack_instruction); + + rtl_declaration := rtl_declaration^.next; + if rtl_declaration <> nil then + goto elna_alloc_procedure_loop + end +end + +proc elna_riscv_procedure(procedure: ^ElnaRtlProcedure) +begin + .elna_riscv_procedure_loop; + + (* Write .type _procedure_name, @function. *) + _write_s(stdout, ".type "); + _write_s(stdout, procedure^.name); + _write_s(stdout, ", @function\n"); + + (* Write procedure label, _procedure_name: *) + _write_s(stdout, procedure^.name); + _write_s(stdout, ":\n"); + + elna_riscv_instructions(procedure^.body.first); + _write_s(stdout, "\tret\n"); + + procedure := procedure^.next; + if procedure <> nil then + goto elna_riscv_procedure_loop + end +end + +proc elna_riscv_variable(variable: ^ElnaRtlStaticVariable) +begin + .elna_riscv_variable_loop; + if variable <> nil then + _write_s(stdout, ".type "); + _write_s(stdout, variable^.name); + _write_s(stdout, ", @object"); + _write_c(stdout, '\n'); + _write_s(stdout, variable^.name); + _write_s(stdout, ": .zero "); + _write_i(stdout, variable^.body); + _write_c(stdout, '\n'); + + variable := variable^.next; + + goto elna_riscv_variable_loop + end +end + +proc elna_rtl_module_declaration(tac_module: ^ElnaInstructionModule): ^ElnaInstructionModule +var + result: ^ElnaInstructionModule + count: Word + current_entry: ^ElnaSymbolEntry + pseudo_symbol: ^ElnaRtlStaticInfo + variable_info: ^ElnaSymbolTemporaryInfo + info: ^ElnaSymbolInfo +begin + result := malloc(#size(ElnaInstructionModule)); + result^.data := elna_rtl_globals(tac_module^.data); + + (* Rewrite global symbol table into global backend symbol table. *) + variable_map_global := elna_symbol_table_create(nil); + count := symbol_table_global^.count; + current_entry := symbol_table_global^.symbols; + + .elna_rtl_module_declaration_loop; + if count = 0 then + goto elna_rtl_module_declaration_end + end; + info := current_entry^.symbol_info; + if info^.kind = ElnaSymbolInfoKind.temporary_info then + variable_info := current_entry^.symbol_info; + + pseudo_symbol := malloc(#size(ElnaRtlStaticInfo)); + pseudo_symbol^.kind := ElnaRtlInfoKind.static_info; + pseudo_symbol^.rtl_type := elna_rtl_symbol_type(variable_info^.variable_type); + + elna_symbol_table_enter(variable_map_global, current_entry^.name.ptr, current_entry^.name.length, pseudo_symbol) + end; + count := count - 1; + current_entry := current_entry + 1; + + goto elna_rtl_module_declaration_loop; + + .elna_rtl_module_declaration_end; + result^.code := elna_rtl_procedures(tac_module^.code); + + return result +end + +proc elna_alloc_module(pair: ^ElnaInstructionModule) +begin + elna_alloc_procedure(pair^.code) +end + +proc _align_at(address, alignment: Word): Word +begin + if address % alignment then + address := address + alignment + end; + address := address / alignment; + address := address * alignment; + + return address +end + +proc elna_fixup_instructions(instructions: ^ElnaList) +var + instruction: ^ElnaRtlInstruction + stack_size: Word +begin + instruction := instructions^.first; + + (* Align the stack. *) + stack_size := _align_at(instruction^.operands[1].value + 8, 16); + + instruction^.operands[1].value := stack_size; + instruction := instructions^.last; + instruction^.operands[1].value := stack_size +end + +proc elna_fixup_procedure(rtl_declaration: ^ElnaRtlProcedure) +begin + .elna_fixup_procedure_loop; + + elna_fixup_instructions(@rtl_declaration^.body); + + rtl_declaration := rtl_declaration^.next; + if rtl_declaration <> nil then + goto elna_fixup_procedure_loop + end +end + +proc elna_fixup_module(pair: ^ElnaInstructionModule) +begin + elna_fixup_procedure(pair^.code) +end + +proc elna_riscv_module(pair: ^ElnaInstructionModule) +var + compiler_strings_copy: ^Char + compiler_strings_end: ^Char + current_byte: Char +begin + _write_s(stdout, ".globl main\n\n.section .data\n"); + elna_riscv_variable(pair^.data); + + _write_s(stdout, ".section .text\n\n"); + elna_riscv_procedure(pair^.code); + + _write_s(stdout, ".section .rodata\n.type strings, @object\nstrings: .ascii \""); + + compiler_strings_copy := @compiler_strings; + compiler_strings_end := compiler_strings_position; + + .elna_riscv_module_loop; + if compiler_strings_copy < compiler_strings_end then + current_byte := compiler_strings_copy^; + compiler_strings_copy := compiler_strings_copy + 1; + _write_c(stdout, current_byte); + + goto elna_riscv_module_loop + end; + _write_s(stdout, "\"\n") +end + +proc elna_parser_integer_literal(cursor: ^ElnaLexerCursor): ^ElnaTreeIntegerLiteral +var + token: ^ElnaLexerToken + result: ^ElnaTreeIntegerLiteral + buffer: Pointer +begin + result := malloc(#size(ElnaTreeIntegerLiteral)); + token := elna_lexer_read(cursor); + + buffer := malloc(token^.start.length + 1); + memset(buffer, 0, token^.start.length + 1); + memcpy(buffer, token^.start.ptr, token^.start.length); + + result^.kind := ElnaTreeKind.integer_literal; + result^.value := atoi(buffer); + result^.type_decoration := nil; + result^.position := token^.position; + + free(buffer); + + return result +end + +proc elna_parser_boolean_literal(cursor: ^ElnaLexerCursor): ^ElnaTreeBooleanLiteral +var + token: ^ElnaLexerToken + result: ^ElnaTreeBooleanLiteral +begin + token := elna_lexer_read(cursor); + result := malloc(#size(ElnaTreeBooleanLiteral)); + + result^.kind := ElnaTreeKind.boolean_literal; + result^.value := string_compare(token^.start.ptr, 4, "true"); + result^.type_decoration := nil; + result^.position := token^.position; + + return result +end + +proc elna_parser_nil_literal(cursor: ^ElnaLexerCursor): ^ElnaTreeNilLiteral +var + token: ^ElnaLexerToken + result: ^ElnaTreeNilLiteral +begin + token := elna_lexer_read(cursor); + + result := malloc(#size(ElnaTreeNilLiteral)); + result^.kind := ElnaTreeKind.null; + result^.type_decoration := nil; + result^.position := token^.position; + + return result +end + +proc elna_tac_integer_literal(integer_literal_node: ^ElnaTreeIntegerLiteral; operand: ^ElnaTacOperand) +begin + operand^.kind := ElnaTacKind.constant; + operand^.value := integer_literal_node^.value; + operand^.length := word_type^.size +end + +proc elna_tac_boolean_literal(boolean_literal_node: ^ElnaTreeBooleanLiteral; operand: ^ElnaTacOperand) +var + current_position: Word +begin + operand^.kind := ElnaTacKind.constant; + current_position := boolean_literal_node^.value; + operand^.value := current_position; + operand^.length := bool_type^.size +end + +proc elna_tac_nil_literal(nil_node: Word; operand: ^ElnaTacOperand) +begin + operand^.kind := ElnaTacKind.constant; + operand^.value := 0; + operand^.length := 4 +end + +(* Escape a single character if needed. *) +proc elna_parser_escape(current_position, result: ^Char): Word +var + parsed_length: Word + next_character: Char +begin + next_character := current_position^; + + if next_character = '\\' then + parsed_length := 2; + current_position := current_position + 1; + next_character := current_position^; + + if next_character = '\\' then + (* \\ Backslash. *) + result^ := 92 + elsif next_character = 'n' then + (* \n Newline. *) + result^ := 10 + elsif next_character = 't' then + (* \t Tab. *) + result^ := 9 + elsif next_character = 'f' then + (* \f Formfeed. *) + result^ := 12 + elsif next_character = 'r' then + (* \r Carriage return. *) + result^ := 13 + elsif next_character = 'v' then + (* \v Vertical tab. *) + result^ := 11 + elsif next_character = '"' then + (* \" Double quote. *) + result^ := 34 + elsif next_character = '\'' then + (* \' Single quote. *) + result^ := 39 + elsif next_character = '0' then + (* \0 Null character. *) + result^ := 0 + end + else + parsed_length := 1; + result^ := next_character + end; + + return parsed_length +end + +proc elna_parser_character_literal(cursor: ^ElnaLexerCursor): ^ElnaTreeCharacterLiteral +var + result: ^ElnaTreeCharacterLiteral + token: ^ElnaLexerToken +begin + result := malloc(#size(ElnaTreeCharacterLiteral)); + token := elna_lexer_read(cursor); + result^.kind := ElnaTreeKind.character_literal; + + elna_parser_escape(token^.start.ptr + 1, @result^.value); + result^.position := token^.position; + result^.type_decoration := nil; + + return result +end + +proc elna_tac_character_literal(character_literal_node: ^ElnaTreeCharacterLiteral; operand: ^ElnaTacOperand) +var + current_position: Word +begin + operand^.kind := ElnaTacKind.constant; + current_position := character_literal_node^.value; + operand^.value := current_position; + operand^.length := char_type^.size +end + +proc elna_parser_variable_expression(cursor: ^ElnaLexerCursor): ^ElnaTreeVariableExpression +var + result: ^ElnaTreeVariableExpression + token: ^ElnaLexerToken +begin + result := malloc(#size(ElnaTreeVariableExpression)); + token := elna_lexer_read(cursor); + + result^.kind := ElnaTreeKind.variable_expression; + result^.name := token^.start; + result^.position := token^.position; + result^.type_decoration := nil; + + return result +end + +proc elna_tac_variable_expression(variable_expression: ^ElnaTreeVariableExpression; operand: ^ElnaTacOperand) +begin + operand^.kind := ElnaTacKind.variable; + operand^.value := variable_expression^.name.ptr; + operand^.length := variable_expression^.name.length +end + +proc elna_parser_string_literal(cursor: ^ElnaLexerCursor): ^ElnaTreeStringLiteral +var + result: ^ElnaTreeStringLiteral + token: ^ElnaLexerToken + current_position: ^Char + parsed_length: Word + parsed_total: Word + target_position: ^Char +begin + result := malloc(#size(ElnaTreeStringLiteral)); + token := elna_lexer_read(cursor); + target_position := malloc(token^.start.length - 2); + current_position := token^.start.ptr + 1; + parsed_total := 2; + + result^.kind := ElnaTreeKind.string_literal; + result^.value.ptr := target_position; + + .elna_parser_escape_loop; + parsed_length := elna_parser_escape(current_position, target_position); + current_position := current_position + parsed_length; + parsed_total := parsed_total + parsed_length; + target_position := target_position + 1; + + if parsed_total < token^.start.length then + goto elna_parser_escape_loop + end; + result^.value.length := target_position - result^.value.ptr; + result^.position := token^.position; + result^.type_decoration := nil; + + return result +end + +proc elna_tac_string_literal(instructions: ^ElnaList; string_literal_node: ^ElnaTreeStringLiteral; + symbol_table: ^ElnaSymbolTable; operand: ^ElnaTacOperand) +var + offset: Word + instruction: ^ElnaTacInstruction + address: ElnaTacOperand +begin + offset := elna_tac_add_string(string_literal_node^.value.ptr, string_literal_node^.value.length); + + elna_tac_make_variable(operand, symbol_table, string_type); + elna_tac_make_variable(@address, symbol_table, word_type); + + instruction := elna_tac_instruction_create(ElnaTacOperator.get_address); + elna_tac_instruction_set_operand(instruction, 1, ElnaTacKind.variable, "strings".ptr, 7); + elna_tac_instruction_set_operand(instruction, 2, address.kind, address.value, address.length); + elna_list_append(instructions, instruction); + + (* Add offset to the string block pointer. *) + instruction := elna_tac_instruction_create(ElnaTacOperator.add); + elna_tac_instruction_set_operand(instruction, 1, address.kind, address.value, address.length); + elna_tac_instruction_set_operand(instruction, 2, ElnaTacKind.constant, offset, 4); + elna_tac_instruction_set_operand(instruction, 3, address.kind, address.value, address.length); + elna_list_append(instructions, instruction); + + instruction := elna_tac_instruction_create(ElnaTacOperator.copy_to_offset); + elna_tac_instruction_set_operand(instruction, 1, address.kind, address.value, address.length); + elna_tac_instruction_set_operand(instruction, 2, operand^.kind, operand^.value, operand^.length); + elna_tac_instruction_set_operand(instruction, 3, ElnaTacKind.constant, 0, 4); + elna_list_append(instructions, instruction); + + instruction := elna_tac_instruction_create(ElnaTacOperator.copy_to_offset); + elna_tac_instruction_set_operand(instruction, 1, ElnaTacKind.constant, string_literal_node^.value.length, 4); + elna_tac_instruction_set_operand(instruction, 2, operand^.kind, operand^.value, operand^.length); + elna_tac_instruction_set_operand(instruction, 3, ElnaTacKind.constant, 4, 4); + elna_list_append(instructions, instruction) +end + +proc elna_parser_trait_expression(cursor: ^ElnaLexerCursor; error_list: ^ElnaList): ^ElnaTreeTraitExpression +var + result: ^ElnaTreeTraitExpression + token: ^ElnaLexerToken +begin + result := malloc(#size(ElnaTreeTraitExpression)); + result^.kind := ElnaTreeKind.trait_expression; + + token := elna_lexer_read(cursor); + result^.name := token^.start; + result^.position := token^.position; + + if elna_parser_expect(cursor, ElnaLexerKind.left_paren, error_list) <> nil then + result^.argument := elna_parser_type_expression(cursor, error_list); + if result^.argument = nil then + result := free_and_nil(result) + else + if elna_parser_expect(cursor, ElnaLexerKind.right_paren, error_list) = nil then + result := free_and_nil(result) + end + end + else + result := free_and_nil(result) + end; + return result +end + +proc elna_parser_cast_expression(cursor: ^ElnaLexerCursor; error_list: ^ElnaList): ^ElnaTreeCastExpression +var + result: ^ElnaTreeCastExpression + token: ^ElnaLexerToken +begin + result := nil; + + (* Skip the cast keyword and opening paren. *) + token := elna_lexer_read(cursor); + if elna_parser_expect(cursor, ElnaLexerKind.left_paren, error_list) = nil then + goto elna_parser_cast_expression_end + end; + result := malloc(#size(ElnaTreeCastExpression)); + result^.kind := ElnaTreeKind._cast; + result^.position.start_location := token^.position.start_location; + result^.type_decoration := nil; + + result^.expression := elna_parser_binary_expression(cursor, error_list); + if result^.expression = nil then + result := free_and_nil(result); + goto elna_parser_cast_expression_end + end; + if elna_parser_expect(cursor, ElnaLexerKind.colon, error_list) = nil then + result := free_and_nil(result); + goto elna_parser_cast_expression_end + end; + result^.type_expression := elna_parser_type_expression(cursor, error_list); + if result^.type_expression = nil then + result := free_and_nil(result); + goto elna_parser_cast_expression_end + end; + token := elna_parser_expect(cursor, ElnaLexerKind.right_paren, error_list); + if token = nil then + result := free_and_nil(result); + goto elna_parser_cast_expression_end + end; + result^.position.end_location := token^.position.end_location; + + .elna_parser_cast_expression_end; + return result +end + +proc elna_parser_simple_expression(cursor: ^ElnaLexerCursor; error_list: ^ElnaList): ^ElnaTreeExpression +var + current_character: Word + parser_node: ^ElnaTreeExpression + token: ^ElnaLexerToken +begin + parser_node := nil; + token := elna_lexer_peek(cursor); + + if token^.kind = ElnaLexerKind.character then + parser_node := elna_parser_character_literal(cursor) + elsif token^.kind = ElnaLexerKind.integer then + parser_node := elna_parser_integer_literal(cursor) + elsif token^.kind = ElnaLexerKind.string then + parser_node := elna_parser_string_literal(cursor) + elsif token^.kind = ElnaLexerKind.boolean then + parser_node := elna_parser_boolean_literal(cursor) + elsif token^.kind = ElnaLexerKind.null then + parser_node := elna_parser_nil_literal(cursor) + elsif token^.kind = ElnaLexerKind._cast then + parser_node := elna_parser_cast_expression(cursor, error_list) + elsif token^.kind = ElnaLexerKind.trait then + parser_node := elna_parser_trait_expression(cursor, error_list) + elsif token^.kind = ElnaLexerKind.identifier then + parser_node := elna_parser_variable_expression(cursor) + end; + return parser_node +end + +proc elna_parser_dereference_expression(cursor: ^ElnaLexerCursor; + simple_expression: ^ElnaTreeExpression): ^ElnaTreeDereferenceExpression +var + result: ^ElnaTreeDereferenceExpression + token: ^ElnaLexerToken +begin + token := elna_lexer_read(cursor); + result := malloc(#size(ElnaTreeDereferenceExpression)); + + result^.kind := ElnaTreeKind.dereference_expression; + result^.pointer := simple_expression; + result^.type_decoration := nil; + result^.position := token^.position; + + return result +end + +proc elna_parser_designator(cursor: ^ElnaLexerCursor; error_list: ^ElnaList): ^ElnaTreeExpression +var + simple_expression: ^ElnaTreeExpression + token: ^ElnaLexerToken +begin + simple_expression := elna_parser_simple_expression(cursor, error_list); + if simple_expression = nil then + simple_expression := free_and_nil(simple_expression); + goto elna_parser_designator_end + end; + + .elna_parser_designator_loop; + token := elna_lexer_peek(cursor); + + if token^.kind = ElnaLexerKind.hat then + simple_expression := elna_parser_dereference_expression(cursor, simple_expression); + goto elna_parser_designator_loop + elsif token^.kind = ElnaLexerKind.dot then + simple_expression := elna_parser_field_access_expression(cursor, simple_expression); + goto elna_parser_designator_loop + elsif token^.kind = ElnaLexerKind.left_square then + simple_expression := elna_parser_array_access_expression(cursor, simple_expression, error_list); + if simple_expression <> nil then + goto elna_parser_designator_loop + end + elsif token^.kind = ElnaLexerKind.left_paren then + simple_expression := elna_parser_call(cursor, simple_expression, error_list); + if simple_expression <> nil then + goto elna_parser_designator_loop + end + end; + .elna_parser_designator_end; + return simple_expression +end + +proc elna_tac_trait_expression(trait_node: ^ElnaTreeTraitExpression; operand: ^ElnaTacOperand) +var + symbol: ^ElnaSymbolTypeInfo + info_type: ^ElnaType + parser_node: ^ElnaTreeNamedTypeExpression +begin + parser_node := trait_node^.argument; + symbol := elna_symbol_table_lookup(symbol_table_global, parser_node^.name.ptr, parser_node^.name.length); + info_type := symbol^._type; + + operand^.kind := ElnaTacKind.constant; + operand^.value := info_type^.size; + operand^.length := 4 +end + +proc elna_tac_cast_expression(instructions: ^ElnaList; parser_node: ^ElnaTreeCastExpression; + symbol_table: ^ElnaSymbolTable; operand: ^ElnaTacOperand) +begin + elna_tac_binary_expression(instructions, parser_node^.expression, symbol_table, operand) +end + +proc elna_tac_simple_expression(instructions: ^ElnaList; parser_node: ^ElnaTreeNode; + symbol_table: ^ElnaSymbolTable; operand: ^ElnaTacOperand) +begin + if parser_node^.kind = ElnaTreeKind.character_literal then + elna_tac_character_literal(parser_node, operand) + elsif parser_node^.kind = ElnaTreeKind.string_literal then + elna_tac_string_literal(instructions, parser_node, symbol_table, operand) + elsif parser_node^.kind = ElnaTreeKind.integer_literal then + elna_tac_integer_literal(parser_node, operand) + elsif parser_node^.kind = ElnaTreeKind.boolean_literal then + elna_tac_boolean_literal(parser_node, operand) + elsif parser_node^.kind = ElnaTreeKind.null then + elna_tac_nil_literal(parser_node, operand) + elsif parser_node^.kind = ElnaTreeKind._cast then + elna_tac_cast_expression(instructions, parser_node, symbol_table, operand) + elsif parser_node^.kind = ElnaTreeKind.trait_expression then + elna_tac_trait_expression(parser_node, operand) + else + elna_tac_variable_expression(parser_node, operand) + end +end + +proc elna_parser_unary_expression(cursor: ^ElnaLexerCursor; error_list: ^ElnaList): ^ElnaTreeExpression +var + result: ^ElnaTreeUnaryExpression + operand: Word + operator: Word + token: ^ElnaLexerToken +begin + token := elna_lexer_peek(cursor); + operator := 0; + + if token^.kind = ElnaLexerKind.at then + operator := '@' + elsif token^.kind = ElnaLexerKind.minus then + operator := '-' + elsif token^.kind = ElnaLexerKind.not then + operator := '~' + end; + if operator <> 0 then + elna_lexer_read(cursor) + end; + result := elna_parser_designator(cursor, error_list); + if result <> nil then + if operator <> 0 then + operand := result; + result := malloc(#size(ElnaTreeUnaryExpression)); + + result^.kind := ElnaTreeKind.unary_expression; + result^.operand := operand; + result^.operator := operator; + result^.position := token^.position; + result^.type_decoration := nil + end + end; + + return result +end + +proc elna_tac_copy_address(instructions: ^ElnaList; operand_result: ^ElnaTacOperandResult; from, to: ^ElnaTacOperand) +var + instruction: ^ElnaTacInstruction +begin + if operand_result^.kind = ElnaTacOperandType.dereferenced_pointer then + to^ := from^ + elsif operand_result^.kind = ElnaTacOperandType.sub_object then + instruction := elna_tac_instruction_create(ElnaTacOperator.get_address); + elna_tac_instruction_set_operand(instruction, 1, from^.kind, from^.value, from^.length); + elna_tac_instruction_set_operand(instruction, 2, to^.kind, to^.value, to^.length); + elna_list_append(instructions, instruction); + + instruction := elna_tac_instruction_create(ElnaTacOperator.add); + elna_tac_instruction_set_operand(instruction, 1, ElnaTacKind.constant, operand_result^.offset, 4); + elna_tac_instruction_set_operand(instruction, 2, to^.kind, to^.value, to^.length); + elna_tac_instruction_set_operand(instruction, 3, to^.kind, to^.value, to^.length); + elna_list_append(instructions, instruction) + else (* ElnaTacOperandType.plain_object *) + instruction := elna_tac_instruction_create(ElnaTacOperator.get_address); + elna_tac_instruction_set_operand(instruction, 1, from^.kind, from^.value, from^.length); + elna_tac_instruction_set_operand(instruction, 2, to^.kind, to^.value, to^.length); + elna_list_append(instructions, instruction) + end +end + +proc elna_tac_unary_expression(instructions: ^ElnaList; parser_node: ^ElnaTreeUnaryExpression; + symbol_table: ^ElnaSymbolTable; operand: ^ElnaTacOperand) +var + token_kind: Word + operator: Word + unary_operand: ^ElnaTreeExpression + operand_result: ElnaTacOperandResult + instruction: ^ElnaTacInstruction + base: ElnaTacOperand + temporary_info: ^ElnaSymbolTemporaryInfo +begin + if parser_node^.kind = ElnaTreeKind.unary_expression then + operator := parser_node^.operator; + unary_operand := parser_node^.operand + else + operator := 0; + unary_operand := parser_node + end; + elna_tac_designator(instructions, unary_operand, symbol_table, @operand_result, @base); + + if operator = '@' then + elna_tac_make_variable(operand, symbol_table, word_type); + elna_tac_copy_address(instructions, @operand_result, @base, operand) + elsif operator = '-' then + elna_tac_make_variable(operand, symbol_table, parser_node^.type_decoration); + + instruction := elna_tac_instruction_create(ElnaTacOperator.negate); + elna_tac_instruction_set_operand(instruction, 1, base.kind, base.value, base.length); + elna_tac_instruction_set_operand(instruction, 2, operand^.kind, operand^.value, operand^.length); + elna_list_append(instructions, instruction) + elsif operator = '~' then + elna_tac_make_variable(operand, symbol_table, parser_node^.type_decoration); + + instruction := elna_tac_instruction_create(ElnaTacOperator.complement); + elna_tac_instruction_set_operand(instruction, 1, base.kind, base.value, base.length); + elna_tac_instruction_set_operand(instruction, 2, operand^.kind, operand^.value, operand^.length); + elna_list_append(instructions, instruction) + elsif operand_result.kind = ElnaTacOperandType.dereferenced_pointer then + elna_tac_make_variable(operand, symbol_table, parser_node^.type_decoration); + + instruction := elna_tac_instruction_create(ElnaTacOperator.load); + elna_tac_instruction_set_operand(instruction, 1, base.kind, base.value, base.length); + elna_tac_instruction_set_operand(instruction, 2, operand^.kind, operand^.value, operand^.length); + elna_list_append(instructions, instruction) + elsif operand_result.kind = ElnaTacOperandType.sub_object then + elna_tac_make_variable(operand, symbol_table, parser_node^.type_decoration); + + instruction := elna_tac_instruction_create(ElnaTacOperator.copy_from_offset); + elna_tac_instruction_set_operand(instruction, 1, base.kind, base.value, base.length); + elna_tac_instruction_set_operand(instruction, 2, ElnaTacKind.constant, operand_result.offset, 4); + elna_tac_instruction_set_operand(instruction, 3, operand^.kind, operand^.value, operand^.length); + elna_list_append(instructions, instruction) + else + operand^.kind := base.kind; + operand^.value := base.value; + operand^.length := base.length + end +end + +proc elna_parser_binary_expression(cursor: ^ElnaLexerCursor; error_list: ^ElnaList): ^ElnaTreeExpression +var + lhs_node: ^ElnaTreeExpression + rhs_node: ^ElnaTreeExpression + result: ^ElnaTreeBinaryExpression + token: ^ElnaLexerToken +begin + lhs_node := elna_parser_unary_expression(cursor, error_list); + rhs_node := nil; + result := nil; + token := elna_lexer_peek(cursor); + + if token^.kind = ElnaLexerKind.plus then + elna_lexer_read(cursor); + rhs_node := elna_parser_unary_expression(cursor, error_list) + elsif token^.kind = ElnaLexerKind.minus then + elna_lexer_read(cursor); + rhs_node := elna_parser_unary_expression(cursor, error_list) + elsif token^.kind = ElnaLexerKind.multiplication then + elna_lexer_read(cursor); + rhs_node := elna_parser_unary_expression(cursor, error_list) + elsif token^.kind = ElnaLexerKind.and then + elna_lexer_read(cursor); + rhs_node := elna_parser_unary_expression(cursor, error_list) + elsif token^.kind = ElnaLexerKind._or then + elna_lexer_read(cursor); + rhs_node := elna_parser_unary_expression(cursor, error_list) + elsif token^.kind = ElnaLexerKind._xor then + elna_lexer_read(cursor); + rhs_node := elna_parser_unary_expression(cursor, error_list) + elsif token^.kind = ElnaLexerKind.equals then + elna_lexer_read(cursor); + rhs_node := elna_parser_unary_expression(cursor, error_list) + elsif token^.kind = ElnaLexerKind.remainder then + elna_lexer_read(cursor); + rhs_node := elna_parser_unary_expression(cursor, error_list) + elsif token^.kind = ElnaLexerKind.division then + elna_lexer_read(cursor); + rhs_node := elna_parser_unary_expression(cursor, error_list) + elsif token^.kind = ElnaLexerKind.less_than then + elna_lexer_read(cursor); + rhs_node := elna_parser_unary_expression(cursor, error_list) + elsif token^.kind = ElnaLexerKind.greater_than then + elna_lexer_read(cursor); + rhs_node := elna_parser_unary_expression(cursor, error_list) + elsif token^.kind = ElnaLexerKind.less_equal then + elna_lexer_read(cursor); + rhs_node := elna_parser_unary_expression(cursor, error_list) + elsif token^.kind = ElnaLexerKind.not_equal then + elna_lexer_read(cursor); + rhs_node := elna_parser_unary_expression(cursor, error_list) + elsif token^.kind = ElnaLexerKind.greater_equal then + elna_lexer_read(cursor); + rhs_node := elna_parser_unary_expression(cursor, error_list) + end; + if rhs_node <> nil then + result := malloc(#size(ElnaTreeBinaryExpression)); + + result^.kind := ElnaTreeKind.binary_expression; + result^.lhs := lhs_node; + result^.rhs := rhs_node; + result^.operator := token^.kind; + result^.position := token^.position; + result^.type_decoration := nil + elsif elna_list_empty(error_list) then + result := lhs_node + end; + return result +end + +proc elna_tac_add_pointer(parser_node: ^ElnaTreeExpression, lhs, rhs: ^ElnaTacOperand, + symbol_table: ^ElnaSymbolTable; operand: ^ElnaTacOperand): ^ElnaTacInstruction +var + instruction: ^ElnaTacInstruction + pointer_type: ^ElnaTypePointer +begin + pointer_type := parser_node^.type_decoration; + instruction := elna_tac_instruction_create(ElnaTacOperator.add_ptr); + + elna_tac_make_variable(operand, symbol_table, word_type); + elna_tac_instruction_set_operand(instruction, 1, lhs^.kind, lhs^.value, lhs^.length); + elna_tac_instruction_set_operand(instruction, 2, rhs^.kind, rhs^.value, rhs^.length); + elna_tac_instruction_set_operand(instruction, 3, ElnaTacKind.constant, pointer_type^.base^.size, 4); + elna_tac_instruction_set_operand(instruction, 4, operand^.kind, operand^.value, operand^.length); + + return instruction +end + +proc elna_tac_subtract_create(instructions: ^ElnaList; parser_node: ^ElnaTreeBinaryExpression; + lhs, rhs: ^ElnaTacOperand; symbol_table: ^ElnaSymbolTable; operand: ^ElnaTacOperand) +var + instruction: ^ElnaTacInstruction + lhs_is_pointer: Word + rhs_is_not_pointer: Word +begin + lhs_is_pointer := parser_node^.lhs^.type_decoration^.kind = ElnaTypeKind.pointer; + rhs_is_not_pointer := parser_node^.rhs^.type_decoration^.kind <> ElnaTypeKind.pointer; + + if lhs_is_pointer & rhs_is_not_pointer then + instruction := elna_tac_instruction_create(ElnaTacOperator.negate); + elna_tac_instruction_set_operand(instruction, 1, rhs^.kind, rhs^.value, rhs^.length); + elna_tac_instruction_set_operand(instruction, 2, operand^.kind, operand^.value, operand^.length); + elna_list_append(instructions, instruction); + + instruction := elna_tac_add_pointer(parser_node^.lhs, lhs, operand, symbol_table, operand); + elna_list_append(instructions, instruction) + else + elna_tac_binary_create(instructions, ElnaTacOperator.subtract, lhs, rhs, symbol_table, operand) + end +end + +proc elna_tac_binary_create(instructions: ^ElnaList; operator: ElnaTacOperator; + lhs, rhs: ^ElnaTacOperand; symbol_table: ^ElnaSymbolTable; operand: ^ElnaTacOperand) +var + instruction: ^ElnaTacInstruction + lhs_symbol: ^ElnaSymbolTemporaryInfo + variable_type: ^ElnaType +begin + if lhs^.kind = ElnaTacKind.variable then + lhs_symbol := elna_symbol_table_lookup(symbol_table, lhs^.value, lhs^.length); + variable_type := lhs_symbol^.variable_type + else + variable_type := word_type + end; + elna_tac_make_variable(operand, symbol_table, variable_type); + + instruction := elna_tac_instruction_create(operator); + elna_tac_instruction_set_operand(instruction, 1, lhs^.kind, lhs^.value, lhs^.length); + elna_tac_instruction_set_operand(instruction, 2, rhs^.kind, rhs^.value, rhs^.length); + elna_tac_instruction_set_operand(instruction, 3, operand^.kind, operand^.value, operand^.length); + elna_list_append(instructions, instruction) +end + +proc elna_tac_binary_expression(instructions: ^ElnaList; parser_node: ^ElnaTreeBinaryExpression; + symbol_table: ^ElnaSymbolTable; operand: ^ElnaTacOperand) +var + instruction: ^ElnaTacInstruction + lhs: ElnaTacOperand + rhs: ElnaTacOperand +begin + if parser_node^.kind <> ElnaTreeKind.binary_expression then + elna_tac_unary_expression(instructions, parser_node, symbol_table, operand) + else + elna_tac_unary_expression(instructions, parser_node^.lhs, symbol_table, @lhs); + elna_tac_unary_expression(instructions, parser_node^.rhs, symbol_table, @rhs); + + if parser_node^.operator = ElnaLexerKind.plus then + if parser_node^.lhs^.type_decoration^.kind = ElnaTypeKind.pointer then + instruction := elna_tac_add_pointer(parser_node^.lhs, @lhs, @rhs, symbol_table, operand); + elna_list_append(instructions, instruction) + elsif parser_node^.rhs^.type_decoration^.kind = ElnaTypeKind.pointer then + instruction := elna_tac_add_pointer(parser_node^.rhs, @rhs, @lhs, symbol_table, operand); + elna_list_append(instructions, instruction) + else + elna_tac_binary_create(instructions, ElnaTacOperator.add, @lhs, @rhs, symbol_table, operand) + end + elsif parser_node^.operator = ElnaLexerKind.minus then + elna_tac_subtract_create(instructions, parser_node, @lhs, @rhs, symbol_table, operand) + elsif parser_node^.operator = ElnaLexerKind.multiplication then + elna_tac_binary_create(instructions, ElnaTacOperator.multiply, @lhs, @rhs, symbol_table, operand) + elsif parser_node^.operator = ElnaLexerKind.and then + elna_tac_binary_create(instructions, ElnaTacOperator.and, @lhs, @rhs, symbol_table, operand) + elsif parser_node^.operator = ElnaLexerKind._or then + elna_tac_binary_create(instructions, ElnaTacOperator._or, @lhs, @rhs, symbol_table, operand) + elsif parser_node^.operator = ElnaLexerKind._xor then + elna_tac_binary_create(instructions, ElnaTacOperator._xor, @lhs, @rhs, symbol_table, operand) + elsif parser_node^.operator = ElnaLexerKind.equals then + elna_tac_binary_create(instructions, ElnaTacOperator.equal, @lhs, @rhs, symbol_table, operand) + elsif parser_node^.operator = ElnaLexerKind.remainder then + elna_tac_binary_create(instructions, ElnaTacOperator.remainder, @lhs, @rhs, symbol_table, operand) + elsif parser_node^.operator = ElnaLexerKind.division then + elna_tac_binary_create(instructions, ElnaTacOperator.divide, @lhs, @rhs, symbol_table, operand) + elsif parser_node^.operator = ElnaLexerKind.less_than then + elna_tac_binary_create(instructions, ElnaTacOperator.less_than, @lhs, @rhs, symbol_table, operand) + elsif parser_node^.operator = ElnaLexerKind.greater_than then + elna_tac_binary_create(instructions, ElnaTacOperator.greater_than, @lhs, @rhs, symbol_table, operand) + elsif parser_node^.operator = ElnaLexerKind.less_equal then + elna_tac_binary_create(instructions, ElnaTacOperator.less_or_equal, @lhs, @rhs, symbol_table, operand) + elsif parser_node^.operator = ElnaLexerKind.greater_equal then + elna_tac_binary_create(instructions, ElnaTacOperator.greater_or_equal, @lhs, @rhs, symbol_table, operand) + elsif parser_node^.operator = ElnaLexerKind.not_equal then + elna_tac_binary_create(instructions, ElnaTacOperator.not_equal, @lhs, @rhs, symbol_table, operand) + end + end +end + +proc elna_parser_call(cursor: ^ElnaLexerCursor; callee: ^ElnaTreeExpression; error_list: ^ElnaList): ^ElnaTreeCall +var + result: ^ElnaTreeCall + argument_entry: ^ElnaTreeExpressionList + token: ^ElnaLexerToken + parser_error: ^ElnaErrorUnexpectedToken +begin + result := malloc(#size(ElnaTreeCall)); + result^.kind := ElnaTreeKind.call; + result^.type_decoration := nil; + result^.arguments := nil; + + result^.count := 0; + result^.callee := callee; + + token := elna_lexer_read(cursor); + result^.position.start_location := token^.position.start_location; + token := elna_lexer_peek(cursor); + + if token^.kind = ElnaLexerKind.right_paren then + token := elna_lexer_read(cursor); + goto elna_parser_call_close + end; + + .elna_parser_call_loop; + if result^.arguments = nil then + result^.arguments := malloc(#size(ElnaTreeExpressionList)); + argument_entry := result^.arguments + else + argument_entry^.next := malloc(#size(ElnaTreeExpressionList)); + argument_entry := argument_entry^.next + end; + argument_entry^.next := nil; + argument_entry^.expression := elna_parser_binary_expression(cursor, error_list); + if argument_entry^.expression = nil then + result := free_and_nil(result) + else + result^.count := result^.count + 1; + token := elna_lexer_peek(cursor); + + if token^.kind = ElnaLexerKind.comma then + elna_lexer_read(cursor); + goto elna_parser_call_loop + elsif token^.kind = ElnaLexerKind.right_paren then + token := elna_lexer_read(cursor) + else + parser_error := elna_error_unexpected_token_create(cursor, 2); + parser_error^.expected[1] := ElnaLexerKind.comma; + parser_error^.expected[2] := ElnaLexerKind.right_paren; + + elna_list_append(error_list, parser_error); + result := free_and_nil(result); + goto elna_parser_call_end + end + end; + .elna_parser_call_close; + result^.position.end_location := token^.position.end_location; + + .elna_parser_call_end; + return result +end + +proc elna_tac_call(instructions: ^ElnaList; parsed_call: ^ElnaTreeCall; symbol_table: ^ElnaSymbolTable; + operand: ^ElnaTacOperand) +var + parsed_expression: ^ElnaTreeVariableExpression + arguments_operand: ^ElnaTacOperand + call_instruction: ^ElnaTacInstruction + argument_entry: ^ElnaTreeExpressionList + procedure_info: ^ElnaSymbolProcedureInfo +begin + parsed_expression := parsed_call^.callee; + arguments_operand := malloc(parsed_call^.count * #size(ElnaTacOperand)); + procedure_info := elna_symbol_table_lookup(symbol_table, parsed_expression^.name.ptr, parsed_expression^.name.length); + + call_instruction := elna_tac_instruction_create(ElnaTacOperator.proc_call); + elna_tac_instruction_set_operand(call_instruction, 1, ElnaTacKind.label, + parsed_expression^.name.ptr, parsed_expression^.name.length); + elna_tac_instruction_set_operand(call_instruction, 2, ElnaTacKind.list, arguments_operand, parsed_call^.count); + + if procedure_info^.procedure_type^.return_type = nil then + elna_tac_instruction_set_operand(call_instruction, 3, ElnaTacKind.ignore, 0, 0) + else + elna_tac_make_variable(operand, symbol_table, procedure_info^.procedure_type^.return_type); + elna_tac_instruction_set_operand(call_instruction, 3, operand^.kind, operand^.value, operand^.length) + end; + + argument_entry := parsed_call^.arguments; + .elna_tac_call_loop; + + if argument_entry <> nil then + elna_tac_binary_expression(instructions, argument_entry^.expression, symbol_table, arguments_operand); + arguments_operand := arguments_operand + 1; + + argument_entry := argument_entry^.next; + goto elna_tac_call_loop + end; + elna_list_append(instructions, call_instruction) +end + +proc elna_parser_goto_statement(cursor: ^ElnaLexerCursor; error_list: ^ElnaList): ^ElnaTreeGotoStatement +var + result: ^ElnaTreeGotoStatement + token: ^ElnaLexerToken +begin + (* Skip the goto. *) + token := elna_lexer_read(cursor); + result := malloc(#size(ElnaTreeGotoStatement)); + result^.kind := ElnaTreeKind.goto_statement; + result^.next := nil; + result^.position.start_location := token^.position.start_location; + + token := elna_parser_expect(cursor, ElnaLexerKind.identifier, error_list); + if token <> nil then + result^.label := token^.start; + result^.position.end_location := token^.position.end_location + else + result := free_and_nil(result) + end; + + return result +end + +proc elna_tac_goto_statement(instructions: ^ElnaList; parser_node: ^ElnaTreeGotoStatement) +var + label_length: Word + label_with_dot: ^Char + instruction: ^ElnaTacInstruction +begin + label_length := parser_node^.label.length + 1; + label_with_dot := malloc(label_length); + + label_with_dot^ := '.'; + memcpy(label_with_dot + 1, parser_node^.label.ptr, parser_node^.label.length); + + instruction := elna_tac_instruction_create(ElnaTacOperator.jump); + elna_tac_instruction_set_operand(instruction, 1, ElnaTacKind.label, label_with_dot, label_length); + elna_list_append(instructions, instruction) +end + +proc elna_parser_label_declaration(cursor: ^ElnaLexerCursor; error_list: ^ElnaList): ^ElnaTreeLabelDeclaration +var + result: ^ElnaTreeLabelDeclaration + token: ^ElnaLexerToken +begin + token := elna_lexer_read(cursor); + result := malloc(#size(ElnaTreeLabelDeclaration)); + result^.kind := ElnaTreeKind.label_declaration; + result^.next := nil; + result^.position.start_location := token^.position.start_location; + + token := elna_parser_expect(cursor, ElnaLexerKind.identifier, error_list); + if token <> nil then + result^.label := token^.start; + result^.position.end_location := token^.position.end_location + else + result := free_and_nil(result) + end; + return result +end + +proc elna_tac_label_declaration(instructions: ^ElnaList; parser_node: ^ElnaTreeLabelDeclaration) +var + result: ^ElnaTacInstruction + buffer: String +begin + buffer.length := parser_node^.label.length + 1; + buffer := malloc(buffer.length); + buffer.ptr^ := '.'; + memcpy(buffer.ptr + 1, parser_node^.label.ptr, parser_node^.label.length); + + result := elna_tac_instruction_create(ElnaTacOperator.label); + elna_tac_instruction_set_operand(result, 1, ElnaTacKind.label, buffer.ptr, buffer.length); + elna_list_append(instructions, result) +end + +proc elna_tac_enumeration_value(field_access_expression: ^ElnaTreeFieldAccessExpression; operand: ^ElnaTacOperand) +var + enumeration_type: ^ElnaTypeEnumeration + members: ^String + members_length: Word + symbol_info: ^ElnaSymbolTypeInfo + counter: Word + aggregate_tree: ^ElnaTreeVariableExpression +begin + aggregate_tree := field_access_expression^.aggregate; + symbol_info := elna_symbol_table_lookup(symbol_table_global, + aggregate_tree^.name.ptr, aggregate_tree^.name.length); + + enumeration_type := symbol_info^._type; + members := enumeration_type^.members; + members_length := enumeration_type^.length; + counter := 1; + + .elna_tac_enumeration_value_members; + if members_length > 0 then + if string_compare(field_access_expression^.field.ptr, field_access_expression^.field.length, members^) = false then + members_length := members_length - 1; + members := members + 1; + counter := counter + 1; + goto elna_tac_enumeration_value_members + end; + (* Found. *) + operand^.kind := ElnaTacKind.constant; + operand^.value := counter; + operand^.length := 4 + end +end + +proc elna_parser_field_access_expression(cursor: ^ElnaLexerCursor; + aggregate: ^ElnaTreeExpression): ^ElnaTreeFieldAccessExpression +var + result: ^ElnaTreeFieldAccessExpression + token: ^ElnaLexerToken +begin + (* Skip dot. Read the enumeration value. *) + token := elna_lexer_read(cursor); + + result := malloc(#size(ElnaTreeFieldAccessExpression)); + result^.kind := ElnaTreeKind.field_access_expression; + result^.type_decoration := nil; + result^.aggregate := aggregate; + result^.position.start_location := token^.position.start_location; + + token := elna_lexer_read(cursor); + + result^.field := token^.start; + result^.position.end_location := token^.position.end_location; + + return result +end + +proc elna_parser_array_access_expression(cursor: ^ElnaLexerCursor; + array: ^ElnaTreeExpression; error_list: ^ElnaList): ^ElnaTreeArrayAccessExpression +var + result: ^ElnaTreeArrayAccessExpression + token: ^ElnaLexerToken +begin + token := elna_lexer_read(cursor); + result := malloc(#size(ElnaTreeArrayAccessExpression)); + + result^.kind := ElnaTreeKind.array_access_expression; + result^.type_decoration := nil; + result^.array := array; + result^.position.start_location := token^.position.start_location; + + result^.index := elna_parser_binary_expression(cursor, error_list); + if result^.index = nil then + result := free_and_nil(result) + else + token := elna_parser_expect(cursor, ElnaLexerKind.right_square, error_list); + if token = nil then + result := free_and_nil(result) + else + result^.position.end_location := token^.position.end_location + end + end; + return result +end + +proc elna_tac_dereference_expression(instructions: ^ElnaList; dereference_expression: ^ElnaTreeDereferenceExpression; + symbol_table: ^ElnaSymbolTable; operand: ^ElnaTacOperand) +var + load_instruction: ^ElnaTacInstruction + operand_result: ElnaTacOperandResult + intermediate: ElnaTacOperand +begin + elna_tac_designator(instructions, dereference_expression^.pointer, symbol_table, @operand_result, operand); + + if operand_result.kind = ElnaTacOperandType.dereferenced_pointer then + intermediate := operand^; + elna_tac_make_variable(operand, symbol_table, word_type); + + load_instruction := elna_tac_instruction_create(ElnaTacOperator.load); + elna_tac_instruction_set_operand(load_instruction, 1, intermediate.kind, intermediate.value, intermediate.length); + elna_tac_instruction_set_operand(load_instruction, 2, operand^.kind, operand^.value, operand^.length); + elna_list_append(instructions, load_instruction) + elsif operand_result.kind = ElnaTacOperandType.sub_object then + intermediate := operand^; + elna_tac_make_variable(operand, symbol_table, word_type); + + load_instruction := elna_tac_instruction_create(ElnaTacOperator.copy_from_offset); + elna_tac_instruction_set_operand(load_instruction, 1, intermediate.kind, intermediate.value, intermediate.length); + elna_tac_instruction_set_operand(load_instruction, 2, ElnaTacKind.constant, operand_result.offset, 4); + elna_tac_instruction_set_operand(load_instruction, 3, operand^.kind, operand^.value, operand^.length); + elna_list_append(instructions, load_instruction) + end +end + +proc elna_tac_designator(instructions: ^ElnaList; parser_node: ^ElnaTreeExpression; symbol_table: ^ElnaSymbolTable; + operand_result: ^ElnaTacOperandResult; operand: ^ElnaTacOperand) +var + field_access_expression: ^ElnaTreeFieldAccessExpression + designator_base: ^ElnaTreeExpression +begin + operand_result^.kind := ElnaTacOperandType.plain_object; + operand_result^.offset := 0; + + if parser_node^.kind = ElnaTreeKind.dereference_expression then + elna_tac_dereference_expression(instructions, parser_node, symbol_table, operand); + operand_result^.kind := ElnaTacOperandType.dereferenced_pointer + elsif parser_node^.kind = ElnaTreeKind.field_access_expression then + field_access_expression := parser_node; + designator_base := field_access_expression^.aggregate; + + if designator_base^.type_decoration = nil then + elna_tac_enumeration_value(field_access_expression, operand) + else + elna_tac_field_access_expression(instructions, + field_access_expression, symbol_table, operand_result, operand) + end + elsif parser_node^.kind = ElnaTreeKind.array_access_expression then + elna_tac_array_access_expression(instructions, parser_node, symbol_table, operand); + operand_result^.kind := ElnaTacOperandType.dereferenced_pointer + elsif parser_node^.kind = ElnaTreeKind.call then + elna_tac_call(instructions, parser_node, symbol_table, operand) + else + elna_tac_simple_expression(instructions, parser_node, symbol_table, operand) + end +end + +proc elna_tac_field_access_expression(instructions: ^ElnaList; field_access_expression: ^ElnaTreeFieldAccessExpression; + symbol_table: ^ElnaSymbolTable; operand_result: ^ElnaTacOperandResult; operand: ^ElnaTacOperand) +var + field_type: ^ElnaType + instruction: ^ElnaTacInstruction + designator_base: ^ElnaTreeExpression + aggregate_type: ^ElnaTypeRecord + field_count: Word + current_field: ^ElnaTypeField + field_offset: Word + base: ElnaTacOperand +begin + designator_base := field_access_expression^.aggregate; + aggregate_type := designator_base^.type_decoration; + + elna_tac_designator(instructions, designator_base, symbol_table, operand_result, @base); + + field_count := aggregate_type^.length; + current_field := aggregate_type^.members; + field_offset := 0; + + .elna_tac_field_access_expression_field; + + if string_compare(field_access_expression^.field.ptr, field_access_expression^.field.length, current_field^.name) = false then + field_type := current_field^.field_type; + field_count := field_count - 1; + current_field := current_field + 1; + field_offset := field_offset + field_type^.size; + goto elna_tac_field_access_expression_field + end; + + if operand_result^.kind = ElnaTacOperandType.dereferenced_pointer then + elna_tac_make_variable(operand, symbol_table, word_type); + + instruction := elna_tac_instruction_create(ElnaTacOperator.add); + elna_tac_instruction_set_operand(instruction, 1, base.kind, base.value, base.length); + elna_tac_instruction_set_operand(instruction, 2, ElnaTacKind.constant, field_offset, 4); + elna_tac_instruction_set_operand(instruction, 3, operand^.kind, operand^.value, operand^.length); + elna_list_append(instructions, instruction) + elsif operand_result^.kind = ElnaTacOperandType.sub_object then + operand^ := base; + operand_result^.offset := operand_result^.offset + field_offset + else (* ElnaTacOperandType.plain_object *) + operand^ := base; + + operand_result^.kind := ElnaTacOperandType.sub_object; + operand_result^.offset := field_offset + end +end + +proc elna_tac_array_access_expression(instructions: ^ElnaList; array_access_expression: ^ElnaTreeArrayAccessExpression; + symbol_table: ^ElnaSymbolTable; operand: ^ElnaTacOperand) +var + instruction: ^ElnaTacInstruction + operand_result: ElnaTacOperandResult + inter_operand: ElnaTacOperand + index_operand: ElnaTacOperand + aggregate_type: ^ElnaTypeArray + designator_base: ^ElnaTreeExpression + element_type: ^ElnaType +begin + designator_base := array_access_expression^.array; + aggregate_type := designator_base^.type_decoration; + element_type := aggregate_type^.base; + + elna_tac_binary_expression(instructions, array_access_expression^.index, symbol_table, @inter_operand); + elna_tac_make_variable(@index_operand, symbol_table, word_type); + + instruction := elna_tac_instruction_create(ElnaTacOperator.subtract); + elna_tac_instruction_set_operand(instruction, 1, inter_operand.kind, inter_operand.value, inter_operand.length); + elna_tac_instruction_set_operand(instruction, 2, ElnaTacKind.constant, 1, 4); + elna_tac_instruction_set_operand(instruction, 3, index_operand.kind, index_operand.value, index_operand.length); + elna_list_append(instructions, instruction); + + elna_tac_designator(instructions, array_access_expression^.array, + symbol_table, @operand_result, @inter_operand); + elna_tac_make_variable(operand, symbol_table, word_type); + elna_tac_copy_address(instructions, @operand_result, @inter_operand, operand); + + instruction := elna_tac_instruction_create(ElnaTacOperator.add_ptr); + elna_tac_instruction_set_operand(instruction, 1, operand^.kind, operand^.value, operand^.length); + elna_tac_instruction_set_operand(instruction, 2, index_operand.kind, index_operand.value, index_operand.length); + elna_tac_instruction_set_operand(instruction, 3, ElnaTacKind.constant, element_type^.size, 4); + elna_tac_instruction_set_operand(instruction, 4, operand^.kind, operand^.value, operand^.length); + elna_list_append(instructions, instruction) +end + +proc elna_parser_assign_statement(cursor: ^ElnaLexerCursor; assignee: ^ElnaTreeNode; error_list: ^ElnaList): ^ElnaTreeAssignStatement +var + token: ^ElnaLexerToken + result: ^ElnaTreeAssignStatement +begin + result := malloc(#size(ElnaTreeAssignStatement)); + + result^.kind := ElnaTreeKind.assign_statement; + result^.next := nil; + result^.assignee := assignee; + result^.assignment := nil; + + (* Skip the assignment sign (:=) with surrounding whitespaces. *) + token := elna_parser_expect(cursor, ElnaLexerKind.assignment, error_list); + if token <> nil then + result^.position := token^.position; + result^.assignment := elna_parser_binary_expression(cursor, error_list) + end; + if result^.assignment = nil then + result := free_and_nil(result) + end; + return result +end + +proc elna_tac_assign_statement(instructions: ^ElnaList; parser_tree: ^ElnaTreeAssignStatement; symbol_table: ^ElnaSymbolTable) +var + operand_result: ElnaTacOperandResult + instruction: ^ElnaTacInstruction + assignment_operand: ElnaTacOperand + assignee: ElnaTacOperand + symbol_info: ^ElnaSymbolInfo +begin + elna_tac_designator(instructions, parser_tree^.assignee, symbol_table, @operand_result, @assignee); + + (* Compile the assignment. *) + elna_tac_binary_expression(instructions, parser_tree^.assignment, symbol_table, @assignment_operand); + + if operand_result.kind = ElnaTacOperandType.dereferenced_pointer then + instruction := elna_tac_instruction_create(ElnaTacOperator.store); + elna_tac_instruction_set_operand(instruction, 1, assignment_operand.kind, + assignment_operand.value, assignment_operand.length); + elna_tac_instruction_set_operand(instruction, 2, assignee.kind, assignee.value, assignee.length) + elsif operand_result.kind = ElnaTacOperandType.sub_object then + instruction := elna_tac_instruction_create(ElnaTacOperator.copy_to_offset); + elna_tac_instruction_set_operand(instruction, 1, assignment_operand.kind, + assignment_operand.value, assignment_operand.length); + elna_tac_instruction_set_operand(instruction, 2, assignee.kind, assignee.value, assignee.length); + elna_tac_instruction_set_operand(instruction, 3, ElnaTacKind.constant, operand_result.offset, 4) + else + instruction := elna_tac_instruction_create(ElnaTacOperator.copy); + elna_tac_instruction_set_operand(instruction, 1, assignment_operand.kind, + assignment_operand.value, assignment_operand.length); + elna_tac_instruction_set_operand(instruction, 2, assignee.kind, assignee.value, assignee.length) + end; + elna_list_append(instructions, instruction) +end + +proc elna_parser_return_statement(cursor: ^ElnaLexerCursor; error_list: ^ElnaList): ^ElnaTreeReturnStatement +var + token: ^ElnaLexerToken + result: ^ElnaTreeReturnStatement +begin + (* Skip "return" keyword. *) + token := elna_lexer_read(cursor); + + result := malloc(#size(ElnaTreeReturnStatement)); + result^.kind := ElnaTreeKind.return_statement; + result^.next := nil; + result^.position := token^.position; + result^.returned := elna_parser_binary_expression(cursor, error_list); + if result^.returned = nil then + result := free_and_nil(result) + end; + + return result +end + +proc elna_tac_return_statement(instructions: ^ElnaList; parser_node: ^ElnaTreeReturnStatement; symbol_table: ^ElnaSymbolTable) +var + instruction: ^ElnaTacInstruction + operand: ElnaTacOperand +begin + elna_tac_binary_expression(instructions, parser_node^.returned, symbol_table, @operand); + + instruction := elna_tac_instruction_create(ElnaTacOperator._return); + elna_tac_instruction_set_operand(instruction, 1, operand.kind, operand.value, operand.length); + elna_list_append(instructions, instruction) +end + +proc elna_parser_conditional_statements(cursor: ^ElnaLexerCursor; error_list: ^ElnaList; + block_keyword: ElnaLexerKind): ^ElnaTreeConditionalStatements +var + result: ^ElnaTreeConditionalStatements +begin + result := malloc(#size(ElnaTreeConditionalStatements)); + + (* Skip "if", "while" or "elsif". *) + elna_lexer_read(cursor); + result^.condition := elna_parser_binary_expression(cursor, error_list); + if result^.condition = nil then + result := free_and_nil(result) + else + (* Skip "then" or "do". *) + if elna_parser_expect(cursor, block_keyword, error_list) <> nil then + result^.statements := elna_parser_statements(cursor, error_list) + end; + if elna_list_empty(error_list) then + result^.next := nil + else + result := free_and_nil(result) + end + end; + return result +end + +proc elna_tac_conditional_statements(instructions: ^ElnaList; parser_node: ^ElnaTreeConditionalStatements; + after_end_label: String; symbol_table: ^ElnaSymbolTable) +var + condition_label: String + instruction: ^ElnaTacInstruction + operand: ElnaTacOperand +begin + (* Compile condition. *) + elna_tac_binary_expression(instructions, parser_node^.condition, symbol_table, @operand); + + (* condition_label is the label in front of the next elsif condition or end. *) + condition_label := elna_tac_label(label_counter); + + instruction := elna_tac_instruction_create(ElnaTacOperator.jump_if_zero); + elna_tac_instruction_set_operand(instruction, 1, operand.kind, operand.value, operand.length); + elna_tac_instruction_set_operand(instruction, 2, ElnaTacKind.label, condition_label.ptr, condition_label.length); + + elna_list_append(instructions, instruction); + elna_tac_statements(instructions, parser_node^.statements, symbol_table); + + instruction := elna_tac_instruction_create(ElnaTacOperator.jump); + elna_tac_instruction_set_operand(instruction, 1, ElnaTacKind.label, after_end_label.ptr, after_end_label.length); + elna_list_append(instructions, instruction); + + instruction := elna_tac_instruction_create(ElnaTacOperator.label); + elna_tac_instruction_set_operand(instruction, 1, ElnaTacKind.label, condition_label.ptr, condition_label.length); + elna_list_append(instructions, instruction) +end + +proc elna_parser_if_statement(cursor: ^ElnaLexerCursor; error_list: ^ElnaList): ^ElnaTreeIfStatement +var + result: ^ElnaTreeIfStatement + previous_conditional: ^ElnaTreeConditionalStatements + next_conditional: ^ElnaTreeConditionalStatements + token: ^ElnaLexerToken +begin + token := elna_lexer_peek(cursor); + result := malloc(#size(ElnaTreeIfStatement)); + + result^.kind := ElnaTreeKind.if_statement; + result^.position := token^.position; + result^.next := nil; + + previous_conditional := elna_parser_conditional_statements(cursor, error_list, ElnaLexerKind._then); + result^.conditionals := previous_conditional; + + .elna_parser_if_statement_loop; + token := elna_lexer_peek(cursor); + + if token^.kind = ElnaLexerKind._elsif then + next_conditional := elna_parser_conditional_statements(cursor, error_list, ElnaLexerKind._then); + previous_conditional^.next := next_conditional; + previous_conditional := next_conditional; + + goto elna_parser_if_statement_loop + elsif token^.kind = ElnaLexerKind._else then + elna_lexer_read(cursor); + result^._else := elna_parser_statements(cursor, error_list) + else + result^._else := nil + end; + elna_lexer_read(cursor); + + return result +end + +proc elna_parser_statement(cursor: ^ElnaLexerCursor; error_list: ^ElnaList): ^ElnaTreeStatement +var + result: ^ElnaTreeStatement + call_result: ^ElnaTreeCallStatement + designator: ^ElnaTreeNode + token: ^ElnaLexerToken +begin + result := nil; + token := elna_lexer_peek(cursor); + + if token^.kind = ElnaLexerKind._goto then + result := elna_parser_goto_statement(cursor, error_list) + elsif token^.kind = ElnaLexerKind._if then + result := elna_parser_if_statement(cursor, error_list) + elsif token^.kind = ElnaLexerKind._return then + result := elna_parser_return_statement(cursor, error_list) + elsif token^.kind = ElnaLexerKind.dot then + result := elna_parser_label_declaration(cursor, error_list) + elsif token^.kind = ElnaLexerKind.identifier then + designator := elna_parser_designator(cursor, error_list); + if designator <> nil then + if designator^.kind <> ElnaTreeKind.call then + result := elna_parser_assign_statement(cursor, designator, error_list) + else + call_result := malloc(#size(ElnaTreeCallStatement)); + call_result^.kind := ElnaTreeKind.call_statement; + call_result^.next := nil; + call_result^.call := designator; + call_result^.position := designator^.position; + result := call_result + end + end + end; + return result +end + +proc elna_parser_statements(cursor: ^ElnaLexerCursor; error_list: ^ElnaList): ^ElnaTreeStatement +var + previous_statement: ^ElnaTreeStatement + next_statement: ^ElnaTreeStatement + first_statement: ^ElnaTreeStatement + token: ^ElnaLexerToken +begin + elna_lexer_skip_empty_lines(cursor); + + first_statement := elna_parser_statement(cursor, error_list); + previous_statement := first_statement; + if previous_statement = nil then + goto elna_parser_statements_end + end; + + .elna_parser_statement_loop; + token := elna_lexer_peek(cursor); + + if token^.kind = ElnaLexerKind.semicolon then + elna_lexer_read(cursor); + elna_lexer_skip_empty_lines(cursor); + next_statement := elna_parser_statement(cursor, error_list); + previous_statement^.next := next_statement; + previous_statement := next_statement; + + if elna_list_empty(error_list) then + goto elna_parser_statement_loop + end + end; + .elna_parser_statements_end; + elna_lexer_skip_empty_lines(cursor); + + return first_statement +end + +proc elna_tac_statements(instructions: ^ElnaList; current_statement: ^ElnaTreeStatement; symbol_table: ^ElnaSymbolTable) +begin + .elna_tac_statements_loop; + if current_statement <> nil then + elna_tac_statement(instructions, current_statement, symbol_table); + current_statement := current_statement^.next; + + goto elna_tac_statements_loop + end +end + +proc elna_tac_if_statement(instructions: ^ElnaList; parser_node: ^ElnaTreeIfStatement; symbol_table: ^ElnaSymbolTable) +var + current_node: ^ElnaTreeConditionalStatements + after_end_label: String + instruction: ^ElnaTacInstruction +begin + after_end_label := elna_tac_label(label_counter); + current_node := parser_node^.conditionals; + + elna_tac_conditional_statements(instructions, current_node, after_end_label, symbol_table); + + .elna_tac_if_statement_loop; + current_node := current_node^.next; + if current_node <> nil then + elna_tac_conditional_statements(instructions, current_node, after_end_label, symbol_table); + + goto elna_tac_if_statement_loop + end; + current_node := parser_node^._else; + + if parser_node^._else <> nil then + elna_tac_statements(instructions, parser_node^._else, symbol_table) + end; + instruction := elna_tac_instruction_create(ElnaTacOperator.label); + elna_tac_instruction_set_operand(instruction, 1, ElnaTacKind.label, after_end_label.ptr, after_end_label.length); + elna_list_append(instructions, instruction) +end + +proc elna_tac_statement(instructions: ^ElnaList; parser_node: ^ElnaTreeNode; symbol_table: ^ElnaSymbolTable) +var + operand: ElnaTacOperand + call_statement: ^ElnaTreeCallStatement +begin + if parser_node^.kind = ElnaTreeKind.goto_statement then + elna_tac_goto_statement(instructions, parser_node) + elsif parser_node^.kind = ElnaTreeKind.if_statement then + elna_tac_if_statement(instructions, parser_node, symbol_table) + elsif parser_node^.kind = ElnaTreeKind.return_statement then + elna_tac_return_statement(instructions, parser_node, symbol_table) + elsif parser_node^.kind = ElnaTreeKind.label_declaration then + elna_tac_label_declaration(instructions, parser_node) + elsif parser_node^.kind = ElnaTreeKind.call_statement then + call_statement := parser_node; + elna_tac_call(instructions, call_statement^.call, symbol_table, @operand) + elsif parser_node^.kind = ElnaTreeKind.assign_statement then + elna_tac_assign_statement(instructions, parser_node, symbol_table) + end +end + +(** + * Writes a regster name to the standard output. + * + * Parameters: + * register_character - Register character. + * register_number - Register number. + *) +proc _write_register(register_character: Word; register_number: Word) +begin + _write_c(stdout, register_character); + _write_c(stdout, register_number + '0') +end + +proc elna_parser_record_type_expression(cursor: ^ElnaLexerCursor; error_list: ^ElnaList): ^ElnaTreeRecordTypeExpression +var + entry: ^ElnaTreeField + result: ^ElnaTreeRecordTypeExpression + previous_entry: ^ElnaTreeField + token: ^ElnaLexerToken + parser_error: ^ElnaErrorUnexpectedToken +begin + token := elna_lexer_read(cursor); + result := malloc(#size(ElnaTreeRecordTypeExpression)); + + result^.kind := ElnaTreeKind.record_type_expression; + result^.members := nil; + result^.length := 0; + result^.position := token^.position; + + token := elna_lexer_peek(cursor); + if token^.kind = ElnaLexerKind.left_paren then + elna_lexer_read(cursor); + + token := elna_parser_expect(cursor, ElnaLexerKind.identifier, error_list); + if token = nil then + result := free_and_nil(result); + goto elna_parser_record_type_expression_end + end; + result^.parent := token^.start; + if elna_parser_expect(cursor, ElnaLexerKind.right_paren, error_list) = nil then + result := free_and_nil(result); + goto elna_parser_record_type_expression_end + end + end; + + .elna_parser_record_type_expression_loop; + token := elna_lexer_read(cursor); + if token^.kind = ElnaLexerKind._end then + goto elna_parser_record_type_expression_end + elsif token^.kind <> ElnaLexerKind.identifier then + parser_error := elna_error_unexpected_token_create(cursor, 2); + parser_error^.expected[1] := ElnaLexerKind._end; + parser_error^.expected[2] := ElnaLexerKind.identifier; + + elna_list_append(error_list, parser_error); + result := free_and_nil(result); + goto elna_parser_record_type_expression_end + end; + entry := malloc(#size(ElnaTreeField)); + result^.length := result^.length + 1; + + entry^.name := token^.start; + + (* Skip the colon. *) + if elna_parser_expect(cursor, ElnaLexerKind.colon, error_list) = nil then + result := free_and_nil(result); + goto elna_parser_record_type_expression_end + end; + + entry^.type_expression := elna_parser_type_expression(cursor, error_list); + if entry^.type_expression = nil then + goto elna_parser_record_type_expression_end + end; + entry^.next := nil; + + if result^.members = nil then + result^.members := entry + else + previous_entry^.next := entry + end; + previous_entry := entry; + + token := elna_lexer_read(cursor); + if token^.kind = ElnaLexerKind.semicolon then + goto elna_parser_record_type_expression_loop + elsif token^.kind <> ElnaLexerKind._end then + parser_error := elna_error_unexpected_token_create(cursor, 2); + parser_error^.expected[1] := ElnaLexerKind._end; + parser_error^.expected[2] := ElnaLexerKind.semicolon; + + elna_list_append(error_list, parser_error) + end; + .elna_parser_record_type_expression_end; + + return result +end + +proc elna_parser_enumeration_type_expression(cursor: ^ElnaLexerCursor; error_list: ^ElnaList): ^ElnaTreeEnumerationTypeExpression +var + result: ^ElnaTreeEnumerationTypeExpression + entry: ^ElnaTreeEnumeration + previous_entry: ^ElnaTreeEnumeration + token: ^ElnaLexerToken + parser_error: ^ElnaErrorUnexpectedToken +begin + token := elna_lexer_read(cursor); + + result := malloc(#size(ElnaTreeEnumerationTypeExpression)); + result^.kind := ElnaTreeKind.enumeration_type_expression; + result^.members := nil; + result^.length := 0; + result^.position.start_location := token^.position.start_location; + + .elna_parser_enumeration_type_expression_loop; + token := elna_parser_expect(cursor, ElnaLexerKind.identifier, error_list); + if token <> nil then + entry := malloc(#size(ElnaTreeEnumeration)); + result^.length := result^.length + 1; + + entry^.name := token^.start; + entry^.next := nil; + + if result^.members = nil then + result^.members := entry + else + previous_entry^.next := entry + end; + previous_entry := entry; + + token := elna_lexer_peek(cursor); + if token^.kind = ElnaLexerKind.comma then + elna_lexer_read(cursor); + goto elna_parser_enumeration_type_expression_loop + elsif token^.kind = ElnaLexerKind.right_paren then + token := elna_lexer_read(cursor); + result^.position.end_location := token^.position.end_location + else + parser_error := elna_error_unexpected_token_create(cursor, 2); + parser_error^.expected[1] := ElnaLexerKind.comma; + parser_error^.expected[2] := ElnaLexerKind.right_paren; + + elna_list_append(error_list, parser_error); + result := free_and_nil(result) + end + else + result := free_and_nil(result) + end; + return result +end + +(** + * Reads and creates enumeration type representation. + * + * record + * type_kind: Word; + * size: Word; + * members: StringArray; + * length: Word + * end; + * + * Returns enumeration type description. + *) +proc elna_name_enumeration_type_expression(parser_node: ^ElnaTreeEnumerationTypeExpression; + error_list: ^ElnaList; result: ^ElnaTypeEnumeration) +var + memory_start: ^ElnaTreeEnumeration + member_count: Word + member_array_current: ^String +begin + memory_start := parser_node^.members; + member_count := parser_node^.length; + + (* Copy the list of enumeration members into an array of strings. *) + result^.members := malloc(member_count * #size(String)); + member_array_current := result^.members; + + .elna_name_type_enumeration_loop; + if member_count > 0 then + member_array_current^ := memory_start^.name; + member_array_current := member_array_current + 1; + + memory_start := memory_start^.next; + member_count := member_count - 1; + goto elna_name_type_enumeration_loop + end; + result^.size := 4; + result^.alignment := 4; + result^.length := parser_node^.length +end + +proc elna_name_pointer_type_expression(parser_node: ^ElnaTreePointerTypeExpression; + error_list: ^ElnaList; result: ^ElnaTypePointer) +begin + result^.size := 4; + result^.alignment := 4; + result^.base := elna_name_type_expression(parser_node^.base, error_list) +end + +proc elna_name_array_type_expression(parser_node: ^ElnaTreeArrayTypeExpression; + error_list: ^ElnaList; result: ^ElnaTypeArray) +var + base: ^ElnaType + length: ^ElnaTreeIntegerLiteral +begin + base := elna_name_type_expression(parser_node^.base, error_list); + if base <> nil then + length := parser_node^.length; + + (* Array size in bytes. *) + result^.size := base^.size * length^.value; + result^.alignment := base^.alignment; + result^.base := base; + result^.length := length^.value + end +end + +proc elna_name_record_type_expression(parser_node: ^ElnaTreeRecordTypeExpression; + error_list: ^ElnaList; result: ^ElnaTypeRecord) +var + tree_field: ^ElnaTreeField + member_array_current: ^ElnaTypeField + field_type: ^ElnaType +begin + result^.size := 0; + result^.alignment := 0; + result^.length := 0; + result^.members := malloc(parser_node^.length * #size(ElnaTypeField)); + + tree_field := parser_node^.members; + member_array_current := result^.members; + + .elna_name_type_record_loop; + if result^.length < parser_node^.length then + member_array_current^.name := tree_field^.name; + + field_type := elna_name_type_expression(tree_field^.type_expression, error_list); + if field_type <> nil then + result^.size := result^.size + field_type^.size; + if field_type^.alignment > result^.alignment then + result^.alignment := field_type^.alignment + end; + member_array_current^.field_type := field_type; + + member_array_current := member_array_current + 1; + + tree_field := tree_field^.next; + result^.length := result^.length + 1; + goto elna_name_type_record_loop + end + end +end + +proc elna_parser_named_type_expression(cursor: ^ElnaLexerCursor): ^ElnaTreeNamedTypeExpression +var + result: ^ElnaTreeNamedTypeExpression + token: ^ElnaLexerToken +begin + result := malloc(#size(ElnaTreeNamedTypeExpression)); + token := elna_lexer_read(cursor); + + result^.kind := ElnaTreeKind.named_type_expression; + result^.name := token^.start; + result^.position := token^.position; + + return result +end + +proc elna_parser_pointer_type_expression(cursor: ^ElnaLexerCursor; error_list: ^ElnaList): ^ElnaTreePointerTypeExpression +var + result: ^ElnaTreePointerTypeExpression + token: ^ElnaLexerToken +begin + token := elna_lexer_read(cursor); + + result := malloc(#size(ElnaTreePointerTypeExpression)); + result^.kind := ElnaTreeKind.pointer_type_expression; + result^.base := elna_parser_type_expression(cursor, error_list); + result^.position := token^.position; + + if result^.base = nil then + result := free_and_nil(result) + end; + + return result +end + +proc elna_parser_array_type_expression(cursor: ^ElnaLexerCursor; error_list: ^ElnaList): ^ElnaTreeArrayTypeExpression +var + result: ^ElnaTreeArrayTypeExpression + token: ^ElnaLexerToken +begin + token := elna_lexer_read(cursor); + + result := malloc(#size(ElnaTreeArrayTypeExpression)); + result^.kind := ElnaTreeKind.array_type_expression; + result^.position.start_location := token^.position.start_location; + + result^.length := elna_parser_binary_expression(cursor, error_list); + if result^.length = nil then + result := free_and_nil(result) + else + token := elna_parser_expect(cursor, ElnaLexerKind.right_square, error_list); + + if token = nil then + result := free_and_nil(result) + else + result^.base := elna_parser_type_expression(cursor, error_list); + if result^.base = nil then + result := free_and_nil(result) + else + result^.position.end_location := token^.position.end_location + end + end + end; + + return result +end + +proc elna_parser_type_expression(cursor: ^ElnaLexerCursor; error_list: ^ElnaList): ^ElnaTreeTypeExpression +var + result: ^ElnaTreeNode + token: ^ElnaLexerToken + parser_error: ^ElnaErrorUnexpectedToken +begin + result := nil; + token := elna_lexer_peek(cursor); + + if token^.kind = ElnaLexerKind.identifier then + result := elna_parser_named_type_expression(cursor) + elsif token^.kind = ElnaLexerKind.left_paren then + result := elna_parser_enumeration_type_expression(cursor, error_list) + elsif token^.kind = ElnaLexerKind._record then + result := elna_parser_record_type_expression(cursor, error_list) + elsif token^.kind = ElnaLexerKind.hat then + result := elna_parser_pointer_type_expression(cursor, error_list) + elsif token^.kind = ElnaLexerKind.left_square then + result := elna_parser_array_type_expression(cursor, error_list) + else + parser_error := elna_error_unexpected_token_create(cursor, 5); + parser_error^.expected[1] := ElnaLexerKind.identifier; + parser_error^.expected[2] := ElnaLexerKind.left_paren; + parser_error^.expected[3] := ElnaLexerKind._record; + parser_error^.expected[4] := ElnaLexerKind.hat; + parser_error^.expected[5] := ElnaLexerKind.left_square; + + elna_list_append(error_list, parser_error) + end; + return result +end + +proc elna_name_alias_type_expression(parser_node: ^ElnaTreeNamedTypeExpression; + error_list: ^ElnaList; result: ^ElnaTypeAlias) +var + type_symbol: ^ElnaSymbolTypeInfo + aliased_type: ^ElnaType +begin + type_symbol := elna_symbol_table_lookup(symbol_table_global, + parser_node^.name.ptr, parser_node^.name.length); + aliased_type := type_symbol^._type; + + result^.size := aliased_type^.size; + result^.alignment := aliased_type^.alignment; + result^.base := aliased_type +end + +proc elna_name_named_type_expression(parser_node: ^ElnaTreeNamedTypeExpression; error_list: ^ElnaList): ^ElnaType +var + type_symbol: ^ElnaSymbolTypeInfo + result: ^ElnaType + undefined_symbol: ^ElnaErrorUndefinedSymbol +begin + type_symbol := elna_symbol_table_lookup(symbol_table_global, + parser_node^.name.ptr, parser_node^.name.length); + if type_symbol = nil then + undefined_symbol := malloc(#size(ElnaErrorUndefinedSymbol)); + undefined_symbol^.next := nil; + undefined_symbol^.kind := ElnaErrorKind.undefined_symbol; + undefined_symbol^.position := parser_node^.position; + undefined_symbol^.symbol_name := parser_node^.name; + + elna_list_append(error_list, undefined_symbol); + result := nil + else + result := type_symbol^._type + end; + return result +end + +proc elna_name_type_expression(parser_node: ^ElnaTreeTypeExpression; error_list: ^ElnaList): ^ElnaType +var + named_type_expression: ^ElnaTreeNamedTypeExpression + type_symbol: ^ElnaSymbolTypeInfo + result: ^ElnaType + undefined_symbol: ^ElnaErrorUndefinedSymbol +begin + if parser_node^.kind = ElnaTreeKind.named_type_expression then + result := elna_name_named_type_expression(parser_node, error_list) + elsif parser_node^.kind = ElnaTreeKind.enumeration_type_expression then + result := malloc(#size(ElnaTypeEnumeration)); + result^.kind := ElnaTypeKind.enumeration; + + elna_name_enumeration_type_expression(parser_node, error_list, result) + elsif parser_node^.kind = ElnaTreeKind.record_type_expression then + result := malloc(#size(ElnaTypeRecord)); + result^.kind := ElnaTypeKind._record; + + elna_name_record_type_expression(parser_node, error_list, result) + elsif parser_node^.kind = ElnaTreeKind.pointer_type_expression then + result := malloc(#size(ElnaTypePointer)); + result^.kind := ElnaTypeKind.pointer; + + elna_name_pointer_type_expression(parser_node, error_list, result) + elsif parser_node^.kind = ElnaTreeKind.array_type_expression then + result := malloc(#size(ElnaTypeArray)); + result^.kind := ElnaTypeKind.array; + + elna_name_array_type_expression(parser_node, error_list, result) + end; + return result +end + +proc elna_symbol_type_info_create(type_representation: ^ElnaType): ^ElnaSymbolTypeInfo +var + result: ^ElnaSymbolTypeInfo +begin + result := malloc(#size(ElnaSymbolTypeInfo)); + result^.kind := ElnaSymbolInfoKind.type_info; + result^._type := type_representation; + + return result +end + +(** + * Parameters: + * attr - Local variable attributes. + * temporary_type - Local variable type. + *) +proc elna_symbol_temporary_info_create(attr: Word; temporary_type: ^ElnaType): ^ElnaSymbolTemporaryInfo +var + result: ^ElnaSymbolTemporaryInfo +begin + result := malloc(#size(ElnaSymbolTemporaryInfo)); + result^.kind := ElnaSymbolInfoKind.temporary_info; + + (* Calculate the stack offset: 4 * variable_counter. *) + result^.variable_type := temporary_type; + result^.attr := attr; + + return result +end + +(** + * Parameters: + * symbol_table - Local symbol table. + *) +proc elna_symbol_procedure_info_create(is_extern: Bool): ^ElnaSymbolProcedureInfo +var + result: ^ElnaSymbolProcedureInfo +begin + result := malloc(#size(ElnaSymbolProcedureInfo)); + result^.kind := ElnaSymbolInfoKind.procedure_info; + result^.procedure_type := nil; + result^.is_extern := is_extern; + + return result +end + +(** + * Parameters: + * variable_index - Variable index. + *) +proc elna_name_procedure_temporary(parser_node: ^ElnaTreeVariableDeclaration; symbol_table: ^ElnaSymbolTable; + error_list: ^ElnaList) +var + info: ^ElnaSymbolTemporaryInfo + variable_type: ^ElnaType + declaration_error: ^ElnaErrorDuplicateDeclaration +begin + info := elna_symbol_table_lookup(symbol_table, parser_node^.name.ptr, parser_node^.name.length); + if info = nil then + variable_type := elna_name_type_expression(parser_node^.type_expression, error_list); + + info := elna_symbol_temporary_info_create(0, variable_type); + elna_symbol_table_enter(symbol_table, parser_node^.name.ptr, parser_node^.name.length, info) + else + declaration_error := elna_error_duplicate_declaration_create(parser_node); + elna_list_append(error_list, declaration_error) + end +end + +proc elna_name_procedure_temporaries(parser_node: ^ElnaTreeVariableDeclaration; symbol_table: ^ElnaSymbolTable, + error_list: ^ElnaList) +begin + .elna_name_procedure_temporaries_loop; + if parser_node <> nil then + elna_name_procedure_temporary(parser_node, symbol_table, error_list); + + parser_node := parser_node^.next; + goto elna_name_procedure_temporaries_loop + end +end + +proc elna_parser_parameters(cursor: ^ElnaLexerCursor; error_list: ^ElnaList): ^ElnaTreeVariableDeclaration +var + parameters: ^ElnaTreeVariableDeclaration + token: ^ElnaLexerToken + current_declaration: ^ElnaTreeVariableDeclaration + next_declaration: ^ElnaTreeVariableDeclaration +begin + parameters := nil; + + .elna_parser_parameters_loop; + token := elna_lexer_peek(cursor); + + if token^.kind <> ElnaLexerKind.right_paren then + next_declaration := elna_parser_variable_declaration(cursor, error_list); + if next_declaration = nil then + parameters := free_and_nil(parameters); + goto elna_parser_parameters_end + end; + if parameters = nil then + parameters := next_declaration + else + current_declaration^.next := next_declaration + end; + current_declaration := next_declaration; + + token := elna_lexer_peek(cursor); + + if token^.kind = ElnaLexerKind.comma then + elna_lexer_read(cursor); + goto elna_parser_parameters_loop + end + end; + .elna_parser_parameters_end; + + return parameters +end + +proc elna_parser_procedure_declaration(cursor: ^ElnaLexerCursor; error_list: ^ElnaList): ^ElnaTreeProcedureDeclaration +var + next_declaration: ^ElnaTreeDeclaration + current_declaration: ^ElnaTreeDeclaration + result: ^ElnaTreeProcedureDeclaration + token: ^ElnaLexerToken +begin + (* Skip "proc ". *) + token := elna_lexer_read(cursor); + result := malloc(#size(ElnaTreeProcedureDeclaration)); + result^.kind := ElnaTreeKind.procedure_declaration; + result^.next := nil; + result^.position := token^.position; + + (* Skip procedure name. *) + token := elna_parser_expect(cursor, ElnaLexerKind.identifier, error_list); + if token = nil then + result := free_and_nil(result); + goto elna_parser_procedure_declaration_end + end; + result^.name := token^.start; + + if elna_parser_expect(cursor, ElnaLexerKind.left_paren, error_list) = nil then + result := free_and_nil(result); + goto elna_parser_procedure_declaration_end + end; + result^.parameters := elna_parser_parameters(cursor, error_list); + if elna_list_empty(error_list) = false then + result := free_and_nil(result); + goto elna_parser_procedure_declaration_end + end; + + (* Skip close paren. *) + if elna_parser_expect(cursor, ElnaLexerKind.right_paren, error_list) = nil then + result := free_and_nil(result); + goto elna_parser_procedure_declaration_end + end; + + (* Skip semicolon or arrow. *) + token := elna_lexer_peek(cursor); + + if token^.kind = ElnaLexerKind.arrow then + elna_lexer_read(cursor); + result^.return_type := elna_parser_type_expression(cursor, error_list); + if result^.return_type = nil then + result := free_and_nil(result); + goto elna_parser_procedure_declaration_end + end + else + result^.return_type := nil + end; + + token := elna_lexer_peek(cursor); + result^.is_extern := token^.kind = ElnaLexerKind._extern; + if result^.is_extern then + elna_lexer_read(cursor); + result^.temporaries := nil; + result^.body := nil + else + result^.temporaries := elna_parser_var_part(cursor, error_list); + if elna_list_empty(error_list) = false then + result := free_and_nil(result); + goto elna_parser_procedure_declaration_end + end; + + (* Parser the procedure body if any. *) + token := elna_lexer_peek(cursor); + if token^.kind = ElnaLexerKind._begin then + elna_lexer_read(cursor); + result^.body := elna_parser_statements(cursor, error_list); + if elna_list_empty(error_list) = false then + result := free_and_nil(result); + goto elna_parser_procedure_declaration_end + end + elsif token^.kind = ElnaLexerKind._return then + result^.body := elna_parser_return_statement(cursor, error_list); + if result^.body = nil then + result := free_and_nil(result); + goto elna_parser_procedure_declaration_end + end + end; + + if elna_parser_expect(cursor, ElnaLexerKind._end, error_list) = false then + result := free_and_nil(result) + end + end; + .elna_parser_procedure_declaration_end; + + return result +end + +proc elna_tac_parameters(ast_list: ^ElnaTreeDeclaration; parameter_count: ^Word): ^String +var + ast_parameter: ^ElnaTreeDeclaration + parameter_index: Word + current_parameter: ^String + parameter_list: ^String +begin + ast_parameter := ast_list; + parameter_count^ := 0; + + .elna_tac_parameters_count; + if ast_parameter <> nil then + ast_parameter := ast_parameter^.next; + parameter_count^ := parameter_count^ + 1; + + goto elna_tac_parameters_count + end; + (* The parameters are saved as an array of name pointer + name length. *) + parameter_list := malloc(parameter_count^ * #size(String)); + current_parameter := parameter_list; + + ast_parameter := ast_list; + parameter_index := 0; + + .elna_tac_parameters_loop; + if parameter_index < parameter_count^ then + current_parameter^ := ast_parameter^.name; + current_parameter := current_parameter + 1; + + parameter_index := parameter_index + 1; + ast_parameter := ast_parameter^.next; + goto elna_tac_parameters_loop + end; + + return parameter_list +end + +proc elna_rtl_global_declaration(tac_declaration: ^ElnaTacStaticVariable): ^ElnaRtlStaticVariable +var + result: ^ElnaRtlStaticVariable +begin + result := malloc(#size(ElnaRtlStaticVariable)); + + result^.next := nil; + result^.name := tac_declaration^.name; + result^.body := tac_declaration^.body; + + return result +end + +proc elna_rtl_parameters(instructions: ^ElnaList; parameters, count: Word; + variable_map: ^ElnaSymbolTable): ^ElnaRtlInstruction +var + result: ^ElnaRtlInstruction + instruction: ^ElnaRtlInstruction + parameter_index: Word + pseudo_symbol: ^ElnaRtlObjectInfo + current_register: Word + target_operand: ElnaRtlOperand + source_operand: ElnaTacOperand + long_word_type: ^ElnaRtlType +begin + result := nil; + parameter_index := 0; + current_register := ElnaRtlRegister.a0; + + .elna_rtl_parameters_loop; + if parameter_index < count then + source_operand.kind := ElnaTacKind.variable; + source_operand.value := parameters^; + parameters := parameters + 4; + source_operand.length := parameters^; + parameters := parameters + 4; + + pseudo_symbol := elna_symbol_table_lookup(variable_map, source_operand.value, source_operand.length); + long_word_type := elna_rtl_constant_type(4); + + if pseudo_symbol^.rtl_type^.kind = ElnaRtlTypeKind.byte_array then + target_operand.kind := ElnaRtlKind.register; + target_operand.value := ElnaRtlRegister.t0; + target_operand.length := 0; + target_operand.offset := 0; + instruction := elna_rtl_variable_address(variable_map, pseudo_symbol, @source_operand, @target_operand); + elna_list_append(instructions, instruction); + + instruction := elna_rtl_instruction_create(ElnaRtlOperator.sw); + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.register, current_register, 0, 0); + elna_rtl_instruction_set_operand(instruction, 2, ElnaRtlKind.memory, target_operand.value, target_operand.length, 0); + instruction^.types[1] := long_word_type; + elna_list_append(instructions, instruction); + + instruction := elna_rtl_instruction_create(ElnaRtlOperator.sw); + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.register, current_register + 1, 0, 0); + elna_rtl_instruction_set_operand(instruction, 2, ElnaRtlKind.memory, target_operand.value, target_operand.length, 4); + instruction^.types[1] := long_word_type; + elna_list_append(instructions, instruction); + + current_register := current_register + 2 + else + instruction := elna_rtl_instruction_create(ElnaRtlOperator.mv); + elna_rtl_instruction_set_operand(instruction, 1, ElnaRtlKind.pseudo, source_operand.value, source_operand.length, 0); + elna_rtl_instruction_set_operand(instruction, 2, ElnaRtlKind.register, current_register, 0, 0); + instruction^.types[1] := long_word_type; + elna_list_append(instructions, instruction); + + current_register := current_register + 1 + end; + + parameter_index := parameter_index + 1; + goto elna_rtl_parameters_loop + end; + + return result +end + +(* Returns whether the provided type is array or record. *) +proc elna_type_is_aggregate(_type: ^ElnaType): Bool +var + lhs: Word + rhs: Word +begin + lhs := _type^.kind = ElnaTypeKind._record; + rhs := _type^.kind = ElnaTypeKind.array; + + return lhs or rhs +end + +proc elna_rtl_generate_pseudo(operand: ^ElnaRtlOperand; variable_map: ^ElnaSymbolTable; + rtl_type: ^ElnaRtlType): ^ElnaRtlObjectInfo +var + pseudo_symbol: ^ElnaRtlObjectInfo + pseudo_type: ^ElnaRtlTypeWord + buffer: Word +begin + operand^.kind := ElnaRtlKind.pseudo; + pseudo_counter := pseudo_counter + 1; + pseudo_symbol := malloc(#size(ElnaRtlObjectInfo)); + pseudo_symbol^.kind := ElnaRtlInfoKind.object_info; + buffer := malloc(7); + + sprintf(buffer, "$b%i\0".ptr, pseudo_counter); + pseudo_symbol^.allocated := false; + + operand^.value := buffer; + operand^.length := strlen(buffer); + + pseudo_symbol^.rtl_type := rtl_type; + elna_symbol_table_enter(variable_map, buffer, operand^.length, pseudo_symbol); + + return pseudo_symbol +end + +proc elna_rtl_constant_type(size: Word): ^ElnaRtlType +var + rtl_type: ^ElnaRtlType +begin + rtl_type := malloc(#size(ElnaRtlTypeWord)); + if size = 1 then + rtl_type^.kind := ElnaRtlTypeKind.byte + else + rtl_type^.kind := ElnaRtlTypeKind.long_word + end; + return rtl_type +end + +proc elna_rtl_symbol_type(variable_type: ^ElnaType): ^ElnaRtlType +var + byte_array: ^ElnaRtlTypeByteArray + rtl_type: ^ElnaRtlType +begin + if elna_type_is_aggregate(variable_type) then + byte_array := malloc(#size(ElnaRtlTypeByteArray)); + byte_array^.kind := ElnaRtlTypeKind.byte_array; + byte_array^.size := variable_type^.size; + byte_array^.alignment := variable_type^.alignment; + + rtl_type := byte_array + else + rtl_type := elna_rtl_constant_type(variable_type^.size) + end; + return rtl_type +end + +proc elna_rtl_procedure_declaration(tac_declaration: ^ElnaTacProcedure): ^ElnaRtlProcedure +var + count: Word + current_entry: ^ElnaSymbolEntry + pseudo_symbol: ^ElnaRtlObjectInfo + variable_info: ^ElnaSymbolTemporaryInfo + info: ^ElnaSymbolInfo + result: ^ElnaRtlProcedure +begin + result := malloc(#size(ElnaRtlProcedure)); + elna_list_initialize(@result^.body); + + result^.next := nil; + result^.name := tac_declaration^.name; + + pseudo_counter := 0; + result^.variable_map := elna_symbol_table_create(variable_map_global); + count := tac_declaration^.symbol_table^.count; + current_entry := tac_declaration^.symbol_table^.symbols; + + .elna_rtl_procedure_declaration_loop; + if count = 0 then + goto elna_rtl_procedure_declaration_end + end; + info := current_entry^.symbol_info; + if info^.kind = ElnaSymbolInfoKind.temporary_info then + variable_info := current_entry^.symbol_info; + + pseudo_symbol := malloc(#size(ElnaRtlObjectInfo)); + pseudo_symbol^.allocated := false; + pseudo_symbol^.kind := ElnaRtlInfoKind.object_info; + pseudo_symbol^.rtl_type := elna_rtl_symbol_type(variable_info^.variable_type); + + elna_symbol_table_enter(result^.variable_map, current_entry^.name.ptr, current_entry^.name.length, pseudo_symbol) + end; + count := count - 1; + current_entry := current_entry + 1; + + goto elna_rtl_procedure_declaration_loop; + + .elna_rtl_procedure_declaration_end; + + elna_rtl_parameters(@result^.body, tac_declaration^.parameters, tac_declaration^.count, result^.variable_map); + elna_rtl_instructions(@result^.body, tac_declaration^.body.first, result^.variable_map); + + return result +end + +proc elna_tac_procedure_declaration(parser_node: ^ElnaTreeProcedureDeclaration): ^ElnaTacProcedure +var + symbol_info: ^ElnaSymbolProcedureInfo + result: ^ElnaTacProcedure + parameter_count: Word + body: ElnaList +begin + result := malloc(#size(ElnaTacProcedure)); + result^.next := nil; + + elna_list_initialize(@result^.body); + + result^.name := parser_node^.name; + symbol_info := elna_symbol_table_lookup(symbol_table_global, parser_node^.name.ptr, parser_node^.name.length); + + result^.symbol_table := symbol_info^.symbol_table; + + result^.parameters := elna_tac_parameters(parser_node^.parameters, @parameter_count); + result^.count := parameter_count; + pseudo_counter := 0; + elna_tac_statements(@result^.body, parser_node^.body, symbol_info^.symbol_table); + + return result +end + +proc elna_parser_procedures(cursor: ^ElnaLexerCursor; error_list: ^ElnaList): ^ElnaTreeDeclaration +var + parser_node: ^ElnaTreeDeclaration + result: ^ElnaTreeDeclaration + current_declaration: ^ElnaTreeDeclaration + token: ^ElnaLexerToken +begin + result := nil; + + .elna_parser_procedures_loop; + elna_lexer_skip_empty_lines(cursor); + token := elna_lexer_peek(cursor); + + if token^.kind = ElnaLexerKind._proc then + parser_node := elna_parser_procedure_declaration(cursor, error_list); + + if parser_node <> nil then + if result = nil then + result := parser_node + else + current_declaration^.next := parser_node + end; + current_declaration := parser_node; + goto elna_parser_procedures_loop + end + end; + return result +end + +proc elna_rtl_globals(tac_procedure: ^ElnaTacStaticVariable): ^ElnaRtlStaticVariable +var + current_copy: ^ElnaRtlStaticVariable + next_copy: ^ElnaRtlStaticVariable + first_copy: ^ElnaRtlStaticVariable +begin + if tac_procedure <> nil then + first_copy := elna_rtl_global_declaration(tac_procedure); + tac_procedure := tac_procedure^.next + else + first_copy := nil + end; + current_copy := first_copy; + + .elna_rtl_globals_start; + + if tac_procedure <> nil then + next_copy := elna_rtl_global_declaration(tac_procedure); + + tac_procedure := tac_procedure^.next; + current_copy^.next := next_copy; + current_copy := next_copy; + goto elna_rtl_globals_start + end; + + return first_copy +end + +proc elna_rtl_procedures(tac_procedure: ^ElnaTacProcedure): ^ElnaRtlProcedure +var + current_copy: ^ElnaRtlProcedure + next_copy: ^ElnaRtlProcedure + first_copy: ^ElnaRtlProcedure +begin + if tac_procedure <> nil then + first_copy := elna_rtl_procedure_declaration(tac_procedure); + tac_procedure := tac_procedure^.next + else + first_copy := nil; + end; + current_copy := first_copy; + + .elna_rtl_procedures_start; + + if tac_procedure <> nil then + next_copy := elna_rtl_procedure_declaration(tac_procedure); + + tac_procedure := tac_procedure^.next; + current_copy^.next := next_copy; + current_copy := next_copy; + goto elna_rtl_procedures_start + end; + + return first_copy +end + +proc elna_tac_procedures(parser_node: ^ElnaTreeProcedureDeclaration): ^ElnaTacProcedure +var + result: ^ElnaTacProcedure + current_procedure: ^ElnaTacProcedure + first_procedure: ^ElnaTacProcedure +begin + first_procedure := nil; + + .elna_tac_procedures_loop; + if parser_node = nil then + goto elna_tac_procedures_end + end; + if parser_node^.is_extern = false then + result := elna_tac_procedure_declaration(parser_node); + if first_procedure = nil then + first_procedure := result + else + current_procedure^.next := result + end; + current_procedure := result + end; + parser_node := parser_node^.next; + goto elna_tac_procedures_loop; + + .elna_tac_procedures_end; + return first_procedure +end + +(** + * Skips comments. + *) +proc elna_lexer_skip_empty_lines(cursor: ^ElnaLexerCursor) +var + token: ^ElnaLexerToken +begin + .skip_empty_lines_rerun; + + token := elna_lexer_peek(cursor); + + if token^.kind = ElnaLexerKind.comment then + elna_lexer_read(cursor); + goto skip_empty_lines_rerun + end +end + +proc elna_parser_type_declaration(cursor: ^ElnaLexerCursor; error_list: ^ElnaList): ^ElnaTreeTypeDeclaration +var + result: ^ElnaTreeTypeDeclaration + token: ^ElnaLexerToken +begin + token := elna_lexer_read(cursor); + result := nil; + + result := malloc(#size(ElnaTreeTypeDeclaration)); + result^.kind := ElnaTreeKind.type_declaration; + result^.next := nil; + result^.name := token^.start; + result^.position := token^.position; + + if elna_parser_expect(cursor, ElnaLexerKind.equals, error_list) <> nil then + result^.type_expression := elna_parser_type_expression(cursor, error_list) + else + result := free_and_nil(result) + end; + return result +end + +proc elna_name_type_declaration(parser_node: ^ElnaTreeTypeDeclaration; error_list: ^ElnaList) +var + type_info: ^ElnaSymbolTypeInfo + type_stub: ^ElnaType + type_expression: ^ElnaTreeTypeExpression +begin + type_info := elna_symbol_table_lookup(symbol_table_global, parser_node^.name.ptr, parser_node^.name.length); + type_stub := type_info^._type; + type_expression := parser_node^.type_expression; + + if type_stub^.kind = ElnaTypeKind.alias then + elna_name_alias_type_expression(type_expression, error_list, type_stub) + elsif type_stub^.kind = ElnaTypeKind.enumeration then + elna_name_enumeration_type_expression(type_expression, error_list, type_stub) + elsif type_stub^.kind = ElnaTypeKind._record then + elna_name_record_type_expression(type_expression, error_list, type_stub) + elsif type_stub^.kind = ElnaTypeKind.pointer then + elna_name_pointer_type_expression(type_expression, error_list, type_stub) + elsif type_stub^.kind = ElnaTypeKind.array then + elna_name_array_type_expression(type_expression, error_list, type_stub) + end +end + +proc elna_parser_type_part(cursor: ^ElnaLexerCursor; error_list: ^ElnaList): ^ElnaTreeDeclaration +var + parser_node: ^ElnaTreeDeclaration + result: ^ElnaTreeDeclaration + current_declaration: ^ElnaTreeDeclaration + token: ^ElnaLexerToken +begin + result := nil; + elna_lexer_skip_empty_lines(cursor); + token := elna_lexer_peek(cursor); + + if token^.kind = ElnaLexerKind._type then + elna_lexer_read(cursor); + + .elna_parser_type_part_loop; + elna_lexer_skip_empty_lines(cursor); + + token := elna_lexer_peek(cursor); + if token^.kind = ElnaLexerKind.identifier then + parser_node := elna_parser_type_declaration(cursor, error_list); + + if parser_node <> nil then + if result = nil then + result := parser_node + else + current_declaration^.next := parser_node + end; + current_declaration := parser_node; + goto elna_parser_type_part_loop + end + end; + end; + + return result +end + +proc elna_parser_variable_declaration(cursor: ^ElnaLexerCursor; error_list: ^ElnaList): ^ElnaTreeVariableDeclaration +var + variable_type: Word + result: ^ElnaTreeVariableDeclaration + token: ^ElnaLexerToken +begin + token := elna_parser_expect(cursor, ElnaLexerKind.identifier, error_list); + if token <> nil then + result := nil; + + if elna_parser_expect(cursor, ElnaLexerKind.colon, error_list) <> nil then + variable_type := elna_parser_type_expression(cursor, error_list); + + if variable_type <> nil then + result := malloc(#size(ElnaTreeVariableDeclaration)); + + result^.kind := ElnaTreeKind.variable_declaration; + result^.next := nil; + result^.name := token^.start; + result^.type_expression := variable_type; + result^.position := token^.position + end + end + end; + return result +end + +proc elna_tac_variable_declaration(parser_tree: ^ElnaTreeVariableDeclaration): ^ElnaTacStaticVariable +var + result: ^ElnaTacStaticVariable + variable_info: ^ElnaSymbolTemporaryInfo +begin + result := malloc(#size(ElnaTacStaticVariable)); + variable_info := elna_symbol_table_lookup(symbol_table_global, parser_tree^.name.ptr, parser_tree^.name.length); + + result^.next := nil; + result^.name := parser_tree^.name; + result^.body := variable_info^.variable_type^.size; + + return result +end + +proc elna_parser_var_part(cursor: ^ElnaLexerCursor; error_list: ^ElnaList): ^ElnaTreeVariableDeclaration +var + result: ^ElnaTreeDeclaration + variable_node: ^ElnaTreeDeclaration + current_declaration: ^ElnaTreeDeclaration + token: ^ElnaLexerToken +begin + result := nil; + token := elna_lexer_peek(cursor); + + if token^.kind <> ElnaLexerKind._var then + goto elna_parser_var_part_end + end; + (* Skip "var". *) + elna_lexer_read(cursor); + + .elna_parser_var_part_loop; + elna_lexer_skip_empty_lines(cursor); + token := elna_lexer_peek(cursor); + + if token^.kind = ElnaLexerKind.identifier then + variable_node := elna_parser_variable_declaration(cursor, error_list); + + if result = nil then + result := variable_node + else + current_declaration^.next := variable_node + end; + current_declaration := variable_node; + goto elna_parser_var_part_loop + end; + + .elna_parser_var_part_end; + return result +end + +proc elna_tac_var_part(parser_node: ^ElnaTreeDeclaration): ^ElnaTacStaticVariable +var + node: ^ElnaTacStaticVariable + current_variable: ^ElnaTacStaticVariable + first_variable: ^ElnaTacStaticVariable +begin + first_variable := nil; + if parser_node = nil then + goto elna_tac_var_part_end + end; + + .elna_tac_var_part_loop; + node := elna_tac_variable_declaration(parser_node); + if first_variable = nil then + first_variable := node + else + current_variable^.next := node + end; + current_variable := node; + + parser_node := parser_node^.next; + if parser_node <> nil then + goto elna_tac_var_part_loop + end; + + .elna_tac_var_part_end; + return first_variable +end + +proc elna_parser_program_body(cursor: ^ElnaLexerCursor; error_list: ^ElnaList): ^ElnaTreeStatement +var + result: ^ElnaTreeStatement + token: ^ElnaLexerToken +begin + result := nil; + token := elna_lexer_peek(cursor); + + if token^.kind = ElnaLexerKind._begin then + elna_lexer_read(cursor); + result := elna_parser_statements(cursor, error_list); + end; + return result +end + +proc elna_error_unexpected_token_create(cursor: ^ElnaLexerCursor; number_of_expected: Word): ^ElnaErrorUnexpectedToken +var + parser_error: ^ElnaErrorUnexpectedToken +begin + parser_error := malloc(#size(ElnaErrorUnexpectedToken)); + parser_error^.next := nil; + parser_error^.kind := ElnaErrorKind.unexpected_token; + parser_error^.position := cursor^.position; + parser_error^.possibilities := number_of_expected; + parser_error^.expected := malloc(#size(ElnaLexerKind) * number_of_expected); + parser_error^.got := cursor^.token^.kind; + + return parser_error +end + +proc elna_error_duplicate_declaration_create(declaration_tree: ^ElnaTreeDeclaration): ^ElnaErrorDuplicateDeclaration +var + declaration_error: ^ElnaErrorDuplicateDeclaration +begin + declaration_error := malloc(#size(ElnaErrorDuplicateDeclaration)); + declaration_error^.kind := ElnaErrorKind.duplicate_declaration; + declaration_error^.position := declaration_tree^.position; + declaration_error^.symbol_name := declaration_tree^.name; + + return declaration_error +end + +(* Check and return whether the next token is of the expected kind. +If so the token is skipped, otherwise an error is added to the error list. *) +proc elna_parser_expect(cursor: ^ElnaLexerCursor; expected: ElnaLexerKind; error_list: ^ElnaList): ^ElnaLexerToken +var + token: ^ElnaLexerToken + parser_error: ^ElnaErrorUnexpectedToken +begin + elna_lexer_skip_empty_lines(cursor); + token := elna_lexer_peek(cursor); + + if token^.kind = expected then + token := elna_lexer_read(cursor) + else + token := nil; + + parser_error := elna_error_unexpected_token_create(cursor, 1); + parser_error^.expected[1] := expected; + + elna_list_append(error_list, parser_error) + end; + return token +end + +proc elna_parser_module_declaration(cursor: ^ElnaLexerCursor; error_list: ^ElnaList): ^ElnaTreeModuleDeclaration +var + result: ^ElnaTreeModuleDeclaration +begin + result := malloc(#size(ElnaTreeModuleDeclaration)); + result^.kind := ElnaTreeKind.module_declaration; + + result^.position.start_location.line := 1; + result^.position.start_location.column := 1; + result^.position.end_location := result^.position.start_location; + + result^.types := elna_parser_type_part(cursor, error_list); + if elna_list_empty(error_list) = false then + result := free_and_nil(result) + end; + if result <> nil then + result^.globals := elna_parser_var_part(cursor, error_list); + end; + if elna_list_empty(error_list) = false then + result := free_and_nil(result) + end; + if result <> nil then + result^.procedures := elna_parser_procedures(cursor, error_list); + end; + if elna_list_empty(error_list) = false then + result := free_and_nil(result) + end; + if result <> nil then + result^.body := elna_parser_program_body(cursor, error_list) + end; + if elna_list_empty(error_list) = false then + result := free_and_nil(result) + end; + return result +end + +proc elna_tac_program_body(parser_node: ^ElnaTreeStatement): ^ElnaTacProcedure +var + result: ^ElnaTacProcedure + symbol_info: ^ElnaSymbolProcedureInfo +begin + result := malloc(#size(ElnaTacProcedure)); + result^.next := nil; + + elna_list_initialize(@result^.body); + + result^.name := "main"; + symbol_info := elna_symbol_table_lookup(symbol_table_global, result^.name.ptr, result^.name.length); + + result^.symbol_table := symbol_info^.symbol_table; + + result^.parameters := nil; + result^.count := 0; + + elna_tac_statements(@result^.body, parser_node, result^.symbol_table); + + return result +end + +proc elna_tac_module_declaration(parser_node: ^ElnaTreeModuleDeclaration): ^ElnaInstructionModule +var + result: ^ElnaInstructionModule + code: ^ElnaTacProcedure +begin + result := malloc(#size(ElnaInstructionModule)); + result^.data := elna_tac_var_part(parser_node^.globals); + result^.code := elna_tac_procedures(parser_node^.procedures); + + if parser_node^.body <> nil then + code := result^.code; + if code = nil then + result^.code := elna_tac_program_body(parser_node^.body); + + goto elna_tac_module_declaration_end + end; + .elna_tac_module_declaration_loop; + + if code^.next = nil then + code^.next := elna_tac_program_body(parser_node^.body) + else + code := code^.next; + goto elna_tac_module_declaration_loop + end + end; + .elna_tac_module_declaration_end; + return result +end + +proc elna_name_dereference_expression(parser_node: ^ElnaTreeDereferenceExpression; symbol_table: ^ElnaSymbolTable, + error_list: ^ElnaList) +begin + elna_name_designator(parser_node^.pointer, symbol_table, error_list) +end + +proc elna_name_field_access_expression(parser_node: ^ElnaTreeFieldAccessExpression; symbol_table: ^ElnaSymbolTable; + error_list: ^ElnaList) +var + variable_expression: ^ElnaTreeVariableExpression + identifier_symbol: ^ElnaSymbolInfo + type_info: ^ElnaSymbolTypeInfo + undefined_member_error: ^ElnaErrorUndefinedMember + enumeration_type: ^ElnaTypeEnumeration + member_count: Word + current_member: ^String +begin + if parser_node^.aggregate^.kind = ElnaTreeKind.variable_expression then + variable_expression := parser_node^.aggregate; + identifier_symbol := elna_symbol_table_lookup(symbol_table, + variable_expression^.name.ptr, variable_expression^.name.length); + if identifier_symbol^.kind = ElnaSymbolInfoKind.type_info then + type_info := identifier_symbol; + + if type_info^._type^.kind = ElnaTypeKind.enumeration then + enumeration_type := type_info^._type; + current_member := enumeration_type^.members; + member_count := enumeration_type^.length; + + .elna_name_field_access_expression_loop; + if member_count > 0 then + if string_compare(current_member^.ptr, current_member^.length, parser_node^.field) then + goto elna_name_field_access_expression_end + end; + + member_count := member_count - 1; + current_member := current_member + 1; + goto elna_name_field_access_expression_loop + end + end; + undefined_member_error := malloc(#size(ElnaErrorUndefinedMember)); + undefined_member_error^.kind := ElnaErrorKind.undefined_member; + undefined_member_error^.position := variable_expression^.position; + undefined_member_error^.aggregate_name := variable_expression^.name; + undefined_member_error^.member_name := parser_node^.field; + + elna_list_append(error_list, undefined_member_error) + else + elna_name_designator(variable_expression, symbol_table, error_list) + end + else + elna_name_designator(parser_node^.aggregate, symbol_table, error_list) + end; + .elna_name_field_access_expression_end +end + +proc elna_name_array_access_expression(parser_node: ^ElnaTreeArrayAccessExpression; symbol_table: ^ElnaSymbolTable; + error_list: ^ElnaList) +begin + elna_name_designator(parser_node^.array, symbol_table, error_list); + elna_name_binary_expression(parser_node^.index, symbol_table, error_list) +end + +proc elna_name_cast_expression(parser_node: ^ElnaTreeCastExpression; symbol_table: ^ElnaSymbolTable; + error_list: ^ElnaList) +begin + elna_name_binary_expression(parser_node^.expression, error_list); + parser_node^.type_decoration := elna_name_type_expression(parser_node^.type_expression, error_list) +end + +proc elna_name_variable_expression(parser_node: ^ElnaTreeVariableExpression; symbol_table: ^ElnaSymbolTable; + error_list: ^ElnaList) +var + variable_symbol: ^ElnaSymbolProcedureInfo + undefined_symbol: ^ElnaErrorUndefinedSymbol +begin + variable_symbol := elna_symbol_table_lookup(symbol_table, + parser_node^.name.ptr, parser_node^.name.length); + + if variable_symbol = nil then + undefined_symbol := malloc(#size(ElnaErrorUndefinedSymbol)); + undefined_symbol^.next := nil; + undefined_symbol^.kind := ElnaErrorKind.undefined_symbol; + undefined_symbol^.position := parser_node^.position; + undefined_symbol^.symbol_name := parser_node^.name; + + elna_list_append(error_list, undefined_symbol) + end +end + +proc elna_name_simple_expression(parser_node: ^ElnaTreeNode; symbol_table: ^ElnaSymbolTable; + error_list: ^ElnaList) +begin + (* Not interested in literals. *) + if parser_node^.kind = ElnaTreeKind._cast then + elna_name_cast_expression(parser_node, symbol_table, error_list) + elsif parser_node^.kind = ElnaTreeKind.variable_expression then + elna_name_variable_expression(parser_node, symbol_table, error_list) + end +end + +proc elna_name_call(parser_node: ^ElnaTreeCall; symbol_table: ^ElnaSymbolTable; error_list: ^ElnaList) +var + argument_tree: ^ElnaTreeExpressionList +begin + elna_name_variable_expression(parser_node^.callee, symbol_table, error_list); + argument_tree := parser_node^.arguments; + + .elna_name_call_argument; + if argument_tree <> nil then + elna_name_binary_expression(argument_tree^.expression, symbol_table, error_list); + argument_tree := argument_tree^.next; + + goto elna_name_call_argument + end +end + +proc elna_name_designator(parser_node: ^ElnaTreeNode; symbol_table: ^ElnaSymbolTable; error_list: ^ElnaList) +begin + if parser_node^.kind = ElnaTreeKind.dereference_expression then + elna_name_dereference_expression(parser_node, symbol_table, error_list) + elsif parser_node^.kind = ElnaTreeKind.field_access_expression then + elna_name_field_access_expression(parser_node, symbol_table, error_list) + elsif parser_node^.kind = ElnaTreeKind.array_access_expression then + elna_name_array_access_expression(parser_node, symbol_table, error_list) + elsif parser_node^.kind = ElnaTreeKind.call then + elna_name_call(parser_node, symbol_table, error_list) + else + elna_name_simple_expression(parser_node, symbol_table, error_list) + end +end + +proc elna_name_unary_expression(parser_node: ^ElnaTreeUnaryExpression; symbol_table: ^ElnaSymbolTable; + error_list: ^ElnaList) +begin + if parser_node^.kind = ElnaTreeKind.unary_expression then + elna_name_designator(parser_node^.operand, symbol_table, error_list) + else + elna_name_designator(parser_node, symbol_table, error_list) + end +end + +proc elna_name_binary_expression(parser_node: ^ElnaTreeBinaryExpression; symbol_table: ^ElnaSymbolTable; + error_list: ^ElnaList) +begin + if parser_node^.kind = ElnaTreeKind.binary_expression then + elna_name_unary_expression(parser_node^.lhs, symbol_table, error_list); + elna_name_unary_expression(parser_node^.rhs, symbol_table, error_list) + else + elna_name_unary_expression(parser_node, symbol_table, error_list) + end +end + +proc elna_name_conditional_statements(parser_node: ^ElnaTreeConditionalStatements; symbol_table: ^ElnaSymbolTable; + error_list: ^ElnaList) +begin + .elna_name_conditional_statements_loop; + elna_name_binary_expression(parser_node^.condition, symbol_table, error_list); + elna_name_statements(parser_node^.statements, symbol_table, error_list); + + parser_node := parser_node^.next; + if parser_node <> nil then + goto elna_name_conditional_statements_loop + end +end + +proc elna_name_if_statement(parser_node: ^ElnaTreeIfStatement; symbol_table: ^ElnaSymbolTable; + error_list: ^ElnaList) +var + block: ^ElnaTreeConditionalStatements +begin + block := parser_node^.conditionals; + + .elna_name_if_statement_conditionals; + elna_name_conditional_statements(block, symbol_table, error_list); + + block := block^.next; + if block <> nil then + goto elna_name_if_statement_conditionals + end; + block := parser_node^._else; + if block <> nil then + elna_name_statements(block, symbol_table, error_list) + end +end + +proc elna_name_return_statement(parser_node: ^ElnaTreeReturnStatement; symbol_table: ^ElnaSymbolTable; + error_list: ^ElnaList) +begin + elna_name_binary_expression(parser_node^.returned, symbol_table, error_list) +end + +proc elna_name_assign_statement(parser_node: ^ElnaTreeAssignStatement; symbol_table: ^ElnaSymbolTable; + error_list: ^ElnaList) +begin + elna_name_designator(parser_node^.assignee, symbol_table, error_list); + elna_name_binary_expression(parser_node^.assignment, symbol_table, error_list) +end + +proc elna_name_statement(parser_node: ^ElnaTreeStatement; symbol_table: ^ElnaSymbolTable; error_list: ^ElnaList) +var + call_statement: ^ElnaTreeCallStatement +begin + (* Skipping goto and label declarations. *) + if parser_node^.kind = ElnaTreeKind.if_statement then + elna_name_if_statement(parser_node, symbol_table, error_list) + elsif parser_node^.kind = ElnaTreeKind.return_statement then + elna_name_return_statement(parser_node, symbol_table, error_list) + elsif parser_node^.kind = ElnaTreeKind.call_statement then + call_statement := parser_node; + elna_name_call(call_statement^.call, symbol_table, error_list) + elsif parser_node^.kind = ElnaTreeKind.assign_statement then + elna_name_assign_statement(parser_node, symbol_table, error_list) + end +end + +proc elna_name_statements(parser_node: ^ElnaTreeStatement; symbol_table: ^ElnaSymbolTable; + error_list: ^ElnaList) +begin + .elna_name_statements_loop; + if parser_node <> nil then + elna_name_statement(parser_node, symbol_table, error_list); + + parser_node := parser_node^.next; + goto elna_name_statements_loop + end +end + +proc elna_name_procedure_declaration(parser_node: ^ElnaTreeProcedureDeclaration; error_list: ^ElnaList) +var + new_symbol_table: ^ElnaSymbolTable + symbol_info: ^ElnaSymbolProcedureInfo + return_type: ^ElnaType + procedure_type: ^ElnaTypeProcedure +begin + symbol_info := elna_symbol_table_lookup(symbol_table_global, parser_node^.name.ptr, parser_node^.name.length); + + procedure_type := malloc(#size(ElnaTypeProcedure)); + procedure_type^.kind := ElnaTypeKind.procedure; + procedure_type^.size := 4; + procedure_type^.alignment := 4; + if parser_node^.return_type = nil then + procedure_type^.return_type := nil + else + procedure_type^.return_type := elna_name_type_expression(parser_node^.return_type, error_list) + end; + symbol_info^.procedure_type := procedure_type; + + if symbol_info^.is_extern = false then + new_symbol_table := elna_symbol_table_create(symbol_table_global); + + symbol_info^.symbol_table := new_symbol_table; + + elna_name_procedure_temporaries(parser_node^.parameters, new_symbol_table, error_list); + elna_name_procedure_temporaries(parser_node^.temporaries, new_symbol_table, error_list); + elna_name_statements(parser_node^.body, new_symbol_table, error_list) + end +end + +proc elna_name_program_body(parser_node: ^ElnaTreeStatement) +var + symbol_info: ^ElnaSymbolProcedureInfo +begin + symbol_info := elna_symbol_procedure_info_create(false); + symbol_info^.symbol_table := elna_symbol_table_create(symbol_table_global); + + elna_symbol_table_enter(symbol_table_global, "main".ptr, 4, symbol_info) +end + +proc elna_type_conditional_statements(parser_node: ^ElnaTreeConditionalStatements; symbol_table: ^ElnaSymbolTable; + error_list: ^ElnaList) +begin + .elna_type_conditional_statements_loop; + elna_type_binary_expression(parser_node^.condition, symbol_table, error_list); + elna_type_statements(parser_node^.statements, symbol_table, error_list); + + parser_node := parser_node^.next; + if parser_node <> nil then + goto elna_type_conditional_statements_loop + end +end + +proc elna_type_if_statement(parser_node: ^ElnaTreeIfStatement; symbol_table: ^ElnaSymbolTable; error_list: ^ElnaList) +var + block: ^ElnaTreeConditionalStatements +begin + block := parser_node^.conditionals; + + .elna_type_if_statement_conditionals; + elna_type_conditional_statements(block, symbol_table, error_list); + + block := block^.next; + if block <> nil then + goto elna_type_if_statement_conditionals + end; + block := parser_node^._else; + if block <> nil then + elna_type_statements(block, symbol_table, error_list) + end +end + +proc elna_type_return_statement(parser_node: ^ElnaTreeReturnStatement; symbol_table: ^ElnaSymbolTable; error_list: ^ElnaList) +begin + elna_type_binary_expression(parser_node^.returned, symbol_table, error_list) +end + +proc elna_type_call(parser_node: ^ElnaTreeCall; symbol_table: ^ElnaSymbolTable; error_list: ^ElnaList) +var + argument_tree: ^ElnaTreeExpressionList + procedure_type: ^ElnaTypeProcedure +begin + argument_tree := parser_node^.arguments; + + elna_type_variable_expression(parser_node^.callee, symbol_table, error_list); + procedure_type := parser_node^.callee^.type_decoration; + parser_node^.type_decoration := procedure_type^.return_type; + + .elna_type_call_argument; + if argument_tree <> nil then + elna_type_binary_expression(argument_tree^.expression, symbol_table, error_list); + argument_tree := argument_tree^.next; + + goto elna_type_call_argument + end +end + +proc elna_type_assign_statement(parser_node: ^ElnaTreeAssignStatement; symbol_table: ^ElnaSymbolTable; + error_list: ^ElnaList) +begin + elna_type_designator(parser_node^.assignee, symbol_table, error_list); + elna_type_binary_expression(parser_node^.assignment, symbol_table, error_list) +end + +proc elna_type_statement(parser_node: ^ElnaTreeStatement; symbol_table: ^ElnaSymbolTable; error_list: ^ElnaList) +var + call_statement: ^ElnaTreeCallStatement +begin + (* Skipping goto and label declarations. *) + if parser_node^.kind = ElnaTreeKind.if_statement then + elna_type_if_statement(parser_node, symbol_table) + elsif parser_node^.kind = ElnaTreeKind.return_statement then + elna_type_return_statement(parser_node, symbol_table, error_list) + elsif parser_node^.kind = ElnaTreeKind.call_statement then + call_statement := parser_node; + elna_type_call(call_statement^.call, symbol_table, error_list) + elsif parser_node^.kind = ElnaTreeKind.assign_statement then + elna_type_assign_statement(parser_node, symbol_table, error_list) + end +end + +proc elna_type_statements(parser_node: ^ElnaTreeStatement; symbol_table: ^ElnaSymbolTable; error_list: ^ElnaList) +begin + .elna_type_statements_loop; + if parser_node <> nil then + elna_type_statement(parser_node, symbol_table, error_list); + + parser_node := parser_node^.next; + goto elna_type_statements_loop + end +end + +proc elna_type_character_literal(parser_node: ^ElnaTreeCharacterLiteral) +begin + parser_node^.type_decoration := char_type +end + +proc elna_type_integer_literal(parser_node: ^ElnaTreeIntegerLiteral) +begin + parser_node^.type_decoration := word_type +end + +proc elna_type_string_literal(parser_node: ^ElnaTreeStringLiteral) +begin + parser_node^.type_decoration := string_type +end + +proc elna_type_boolean_literal(parser_node: ^ElnaTreeBooleanLiteral) +begin + parser_node^.type_decoration := bool_type +end + +proc elna_type_nil_literal(parser_node: ^ElnaTreeNilLiteral) +var + symbol_info: ^ElnaSymbolTypeInfo +begin + symbol_info := elna_symbol_table_lookup(symbol_table_global, "Pointer".ptr, 7); + parser_node^.type_decoration := symbol_info^._type +end + +proc elna_type_variable_expression(parser_node: ^ElnaTreeVariableExpression; symbol_table: ^ElnaSymbolTable) +var + variable_info: ^ElnaSymbolInfo + temporary_info: ^ElnaSymbolTemporaryInfo + procedure_info: ^ElnaSymbolProcedureInfo +begin + variable_info := elna_symbol_table_lookup(symbol_table, parser_node^.name.ptr, parser_node^.name.length); + + if variable_info^.kind = ElnaSymbolInfoKind.temporary_info then + temporary_info := variable_info; + parser_node^.type_decoration := temporary_info^.variable_type + elsif variable_info^.kind = ElnaSymbolInfoKind.procedure_info then + procedure_info := variable_info; + parser_node^.type_decoration := procedure_info^.procedure_type + end +end + +proc elna_type_cast_expression(parser_node: ^ElnaTreeCastExpression; symbol_table: ^ElnaSymbolTable; + error_list: ^ElnaList) +begin + elna_type_binary_expression(parser_node^.expression, symbol_table, error_list) +end + +proc elna_type_simple_expression(parser_node: ^ElnaTreeNode; symbol_table: ^ElnaSymbolTable; error_list: ^ElnaList) +begin + if parser_node^.kind = ElnaTreeKind.integer_literal then + elna_type_integer_literal(parser_node) + elsif parser_node^.kind = ElnaTreeKind.character_literal then + elna_type_character_literal(parser_node) + elsif parser_node^.kind = ElnaTreeKind.string_literal then + elna_type_string_literal(parser_node) + elsif parser_node^.kind = ElnaTreeKind.boolean_literal then + elna_type_boolean_literal(parser_node) + elsif parser_node^.kind = ElnaTreeKind.null then + elna_type_nil_literal(parser_node) + elsif parser_node^.kind = ElnaTreeKind._cast then + elna_type_cast_expression(parser_node, error_list) + elsif parser_node^.kind = ElnaTreeKind.variable_expression then + elna_type_variable_expression(parser_node, symbol_table, error_list) + end +end + +proc elna_type_dereference_expression(parser_node: ^ElnaTreeDereferenceExpression; symbol_table: ^ElnaSymbolTable; + error_list: ^ElnaList) +var + base_type: ^ElnaType + pointer_type: ^ElnaTypePointer + dereferenced_expression: ^ElnaTreeExpression +begin + elna_type_designator(parser_node^.pointer, symbol_table, error_list); + + dereferenced_expression := parser_node^.pointer; + base_type := dereferenced_expression^.type_decoration; + + (* If check for compatibility, should be removed later. *) + if base_type^.kind = ElnaTypeKind.pointer then + pointer_type := base_type; + base_type := pointer_type^.base; + end; + parser_node^.type_decoration := base_type +end + +proc elna_type_field_access_expression(parser_node: ^ElnaTreeFieldAccessExpression; symbol_table: ^ElnaSymbolTable; + error_list: ^ElnaList) +var + variable_expression: ^ElnaTreeVariableExpression + base_type: Word + type_kind: ^ElnaSymbolTypeInfo + symbol_info: ^ElnaSymbolInfo + aggregate_type: ^ElnaTypeRecord + field_count: Word + current_field: ^ElnaTypeField +begin + base_type := nil; + variable_expression := parser_node^.aggregate; + + (* Check whether the field access is an enumeration value. *) + if variable_expression^.kind = ElnaTreeKind.variable_expression then + symbol_info := elna_symbol_table_lookup(symbol_table_global, + variable_expression^.name.ptr, variable_expression^.name.length); + if symbol_info <> nil then + type_kind := symbol_info; + + if symbol_info^.kind = ElnaSymbolInfoKind.type_info then + base_type := type_kind^._type + end + end + end; + (* If the base_type is still nil this is record field access. *) + if base_type = nil then + elna_type_designator(parser_node^.aggregate, symbol_table, error_list); + aggregate_type := variable_expression^.type_decoration; + + field_count := aggregate_type^.length; + current_field := aggregate_type^.members; + + .elna_type_field_access_expression_field; + + if string_compare(parser_node^.field.ptr, parser_node^.field.length, current_field^.name) = false then + field_count := field_count - 1; + current_field := current_field + 1; + goto elna_type_field_access_expression_field + end; + base_type := current_field^.field_type + end; + + parser_node^.type_decoration := base_type +end + +proc elna_type_array_access_expression(parser_node: ^ElnaTreeArrayAccessExpression; symbol_table: ^ElnaSymbolTable; + error_list: ^ElnaList) +var + aggregate_type: ^ElnaTypeArray + base_expression: ^ElnaTreeExpression +begin + base_expression := parser_node^.array; + + elna_type_designator(base_expression, symbol_table, error_list); + elna_type_binary_expression(parser_node^.index, symbol_table, error_list); + + aggregate_type := base_expression^.type_decoration; + parser_node^.type_decoration := aggregate_type^.base +end + +proc elna_type_designator(parser_node: ^ElnaTreeNode; symbol_table: ^ElnaSymbolTable; error_list: ^ElnaList) +begin + if parser_node^.kind = ElnaTreeKind.dereference_expression then + elna_type_dereference_expression(parser_node, symbol_table, error_list) + elsif parser_node^.kind = ElnaTreeKind.field_access_expression then + elna_type_field_access_expression(parser_node, symbol_table, error_list) + elsif parser_node^.kind = ElnaTreeKind.array_access_expression then + elna_type_array_access_expression(parser_node, symbol_table, error_list) + elsif parser_node^.kind = ElnaTreeKind.call then + elna_type_call(parser_node, symbol_table, error_list) + else + elna_type_simple_expression(parser_node, symbol_table) + end +end + +proc elna_type_unary_expression(parser_node: ^ElnaTreeUnaryExpression; symbol_table: ^ElnaSymbolTable; + error_list: ^ElnaList) +begin + if parser_node^.kind = ElnaTreeKind.unary_expression then + elna_type_designator(parser_node^.operand, symbol_table, error_list); + + parser_node^.type_decoration := parser_node^.operand^.type_decoration + else + elna_type_designator(parser_node, symbol_table, error_list) + end +end + +proc elna_type_binary_expression(parser_node: ^ElnaTreeBinaryExpression; symbol_table: ^ElnaSymbolTable; + error_list: ^ElnaList) +var + binary_operand: ^ElnaTreeExpression +begin + if parser_node^.kind = ElnaTreeKind.binary_expression then + elna_type_unary_expression(parser_node^.rhs, symbol_table, error_list); + + binary_operand := parser_node^.lhs; + elna_type_unary_expression(binary_operand, symbol_table, error_list); + + parser_node^.type_decoration := binary_operand^.type_decoration + else + elna_type_unary_expression(parser_node, symbol_table, error_list) + end +end + +proc elna_type_procedure_declaration(parser_node: ^ElnaTreeProcedureDeclaration; error_list: ^ElnaList) +var + procedure_info: ^ElnaSymbolProcedureInfo +begin + procedure_info := elna_symbol_table_lookup(symbol_table_global, parser_node^.name.ptr, parser_node^.name.length); + + elna_type_statements(parser_node^.body, procedure_info^.symbol_table, error_list) +end + +proc elna_name_module_declaration(parser_node: ^ElnaTreeModuleDeclaration; error_list: ^ElnaList) +var + current_part: ^ElnaTreeDeclaration +begin + current_part := parser_node^.types; + .elna_name_module_declaration_type; + if current_part <> nil then + elna_name_type_declaration(current_part, error_list); + current_part := current_part^.next; + + goto elna_name_module_declaration_type + end; + current_part := parser_node^.globals; + .elna_name_module_declaration_global; + if current_part <> nil then + elna_name_procedure_temporary(current_part, symbol_table_global, error_list); + current_part := current_part^.next; + + goto elna_name_module_declaration_global + end; + current_part := parser_node^.procedures; + .elna_name_module_declaration_procedure; + if current_part <> nil then + elna_name_procedure_declaration(current_part, error_list); + current_part := current_part^.next; + + goto elna_name_module_declaration_procedure + end; + if parser_node^.body <> nil then + elna_name_program_body(parser_node^.body) + end +end + +proc elna_type_module_declaration(parser_node: ^ElnaTreeModuleDeclaration; error_list: ^ElnaList) +var + current_part: ^ElnaTreeDeclaration +begin + current_part := parser_node^.procedures; + .elna_type_module_declaration_procedure; + if current_part <> nil then + elna_type_procedure_declaration(current_part, error_list); + current_part := current_part^.next; + + goto elna_type_module_declaration_procedure + end +end + +proc elna_declaration_type_declaration(parser_node: ^ElnaTreeTypeDeclaration; error_list: ^ElnaList) +var + type_info: ^ElnaSymbolTypeInfo + result: ^ElnaType + type_expression: ^ElnaTreeTypeExpression + declaration_error: ^ElnaErrorDuplicateDeclaration +begin + type_info := elna_symbol_table_lookup(symbol_table_global, parser_node^.name.ptr, parser_node^.name.length); + + if type_info = nil then + type_expression := parser_node^.type_expression; + + if type_expression^.kind = ElnaTreeKind.named_type_expression then + result := malloc(#size(ElnaTypeAlias)); + result^.kind := ElnaTypeKind.alias + elsif type_expression^.kind = ElnaTreeKind.enumeration_type_expression then + result := malloc(#size(ElnaTypeEnumeration)); + result^.kind := ElnaTypeKind.enumeration + elsif type_expression^.kind = ElnaTreeKind.record_type_expression then + result := malloc(#size(ElnaTypeRecord)); + result^.kind := ElnaTypeKind._record + elsif type_expression^.kind = ElnaTreeKind.pointer_type_expression then + result := malloc(#size(ElnaTypePointer)); + result^.kind := ElnaTypeKind.pointer + elsif type_expression^.kind = ElnaTreeKind.array_type_expression then + result := malloc(#size(ElnaTypeArray)); + result^.kind := ElnaTypeKind.array + end; + type_info := elna_symbol_type_info_create(result); + + elna_symbol_table_enter(symbol_table_global, parser_node^.name.ptr, parser_node^.name.length, type_info) + else + declaration_error := elna_error_duplicate_declaration_create(parser_node); + elna_list_append(error_list, declaration_error) + end +end + +proc elna_declaration_procedure_declaration(parser_node: ^ElnaTreeProcedureDeclaration; error_list: ^ElnaList) +var + symbol_info: ^ElnaSymbolProcedureInfo + declaration_error: ^ElnaErrorDuplicateDeclaration +begin + symbol_info := elna_symbol_table_lookup(symbol_table_global, parser_node^.name.ptr, parser_node^.name.length); + + if symbol_info = nil then + symbol_info := elna_symbol_procedure_info_create(parser_node^.is_extern); + symbol_info^.symbol_table := elna_symbol_table_create(symbol_table_global); + + elna_symbol_table_enter(symbol_table_global, parser_node^.name.ptr, parser_node^.name.length, symbol_info) + else + declaration_error := elna_error_duplicate_declaration_create(parser_node); + elna_list_append(error_list, declaration_error) + end +end + +proc elna_declaration_module_declaration(parser_node: ^ElnaTreeModuleDeclaration; error_list: ^ElnaList) +var + current_part: ^ElnaTreeDeclaration +begin + current_part := parser_node^.types; + .elna_declaration_module_declaration_type; + if current_part <> nil then + elna_declaration_type_declaration(current_part, error_list); + current_part := current_part^.next; + + goto elna_declaration_module_declaration_type + end; + + current_part := parser_node^.procedures; + .elna_declaration_module_declaration_procedure; + if current_part <> nil then + elna_declaration_procedure_declaration(current_part, error_list); + current_part := current_part^.next; + + goto elna_declaration_module_declaration_procedure + end +end + +proc elna_error_print_token1(kind: ElnaLexerKind) +begin + if kind = ElnaLexerKind.identifier then + _write_s(stderr, "IDENTIFIER") + elsif kind = ElnaLexerKind._const then + _write_s(stderr, "\"const\"") + elsif kind = ElnaLexerKind._var then + _write_s(stderr, "\"var\"") + elsif kind = ElnaLexerKind._proc then + _write_s(stderr, "\"proc\"") + elsif kind = ElnaLexerKind._type then + _write_s(stderr, "\"type\"") + elsif kind = ElnaLexerKind._begin then + _write_s(stderr, "\"begin\"") + elsif kind = ElnaLexerKind._end then + _write_s(stderr, "\"end\"") + elsif kind = ElnaLexerKind._if then + _write_s(stderr, "\"if\"") + elsif kind = ElnaLexerKind._then then + _write_s(stderr, "\"then\"") + elsif kind = ElnaLexerKind._else then + _write_s(stderr, "\"else\"") + elsif kind = ElnaLexerKind._elsif then + _write_s(stderr, "\"elsif\"") + elsif kind = ElnaLexerKind._extern then + _write_s(stderr, "\"extern\"") + elsif kind = ElnaLexerKind._record then + _write_s(stderr, "\"record\"") + elsif kind = ElnaLexerKind.boolean then + _write_s(stderr, "BOOLEAN") + elsif kind = ElnaLexerKind.null then + _write_s(stderr, "NIL") + elsif kind = ElnaLexerKind.and then + _write_s(stderr, "\"&\"") + elsif kind = ElnaLexerKind._or then + _write_s(stderr, "\"or\"") + elsif kind = ElnaLexerKind._xor then + _write_s(stderr, "\"xor\"") + elsif kind = ElnaLexerKind.not then + _write_s(stderr, "\"~\"") + elsif kind = ElnaLexerKind._return then + _write_s(stderr, "\"return\"") + elsif kind = ElnaLexerKind._cast then + _write_s(stderr, "\"cast\"") + elsif kind = ElnaLexerKind.trait then + _write_s(stderr, "TRAIT") + elsif kind = ElnaLexerKind.left_paren then + _write_s(stderr, "\"(\"") + elsif kind = ElnaLexerKind.right_paren then + _write_s(stderr, "\")\"") + elsif kind = ElnaLexerKind.left_square then + _write_s(stderr, "\"[\"") + elsif kind = ElnaLexerKind.right_square then + _write_s(stderr, "\"]\"") + elsif kind = ElnaLexerKind.greater_equal then + _write_s(stderr, "\">=\"") + elsif kind = ElnaLexerKind.less_equal then + _write_s(stderr, "\"<=\"") + elsif kind = ElnaLexerKind.greater_than then + _write_s(stderr, "\">\"") + elsif kind = ElnaLexerKind.less_than then + _write_s(stderr, "\"<\"") + elsif kind = ElnaLexerKind.not_equal then + _write_s(stderr, "\"<>\"") + elsif kind = ElnaLexerKind.equals then + _write_s(stderr, "\"=\"") + elsif kind = ElnaLexerKind.semicolon then + _write_s(stderr, "\";\"") + elsif kind = ElnaLexerKind.dot then + _write_s(stderr, "\".\"") + elsif kind = ElnaLexerKind.comma then + _write_s(stderr, "\",\"") + elsif kind = ElnaLexerKind.plus then + _write_s(stderr, "\"+\"") + elsif kind = ElnaLexerKind.arrow then + _write_s(stderr, "\"->\"") + elsif kind = ElnaLexerKind.minus then + _write_s(stderr, "\"-\"") + elsif kind = ElnaLexerKind.multiplication then + _write_s(stderr, "\"*\"") + elsif kind = ElnaLexerKind.division then + _write_s(stderr, "\"/\"") + elsif kind = ElnaLexerKind.remainder then + _write_s(stderr, "\"%\"") + elsif kind = ElnaLexerKind.assignment then + _write_s(stderr, "\":=\"") + elsif kind = ElnaLexerKind.colon then + _write_s(stderr, "\":\"") + elsif kind = ElnaLexerKind.hat then + _write_s(stderr, "\"^\"") + elsif kind = ElnaLexerKind.at then + _write_s(stderr, "\"@\"") + elsif kind = ElnaLexerKind.comment then + _write_s(stderr, "COMMENT") + elsif kind = ElnaLexerKind.string then + _write_s(stderr, "STRING") + elsif kind = ElnaLexerKind.character then + _write_s(stderr, "CHARACTER") + elsif kind = ElnaLexerKind.integer then + _write_s(stderr, "INTEGER") + elsif kind = ElnaLexerKind.word then + _write_s(stderr, "WORD") + else + elna_error_print_token2(kind) + end +end + +proc elna_error_print_token2(kind: ElnaLexerKind) +begin + if kind = ElnaLexerKind._goto then + _write_s(stderr, "\"goto\"") + elsif kind = ElnaLexerKind.eof then + _write_s(stderr, "EOF") + else + _write_s(stderr, "UNKNOWN") + end +end + +proc elna_error_print_unexpected_token(current_error: ^ElnaErrorUnexpectedToken) +begin + _write_s(stderr, "Parse error: Expecting token "); + elna_error_print_token1(current_error^.expected[1]); + _write_s(stderr, "; got "); + elna_error_print_token1(current_error^.got); + _write_s(stderr, ". ") +end + +proc elna_error_print_undefined_member(current_error: ^ElnaErrorUndefinedMember) +begin + _write_s(stderr, "Semantic error: Member \""); + _write_s(stderr, current_error^.member_name); + _write_s(stderr, "\" is not accessible on \""); + _write_s(stderr, current_error^.aggregate_name); + _write_s(stderr, "\". ") +end + +proc elna_error_print_undefined_symbol(current_error: ^ElnaErrorUndefinedSymbol) +begin + _write_s(stderr, "Semantic error: Undefined symbol \""); + _write_s(stderr, current_error^.symbol_name); + _write_s(stderr, "\". ") +end + +proc elna_error_print_duplicate_declaration(current_error: ^ElnaErrorDuplicateDeclaration) +begin + _write_s(stderr, "Semantic error: Duplicate declaration \""); + _write_s(stderr, current_error^.symbol_name); + _write_s(stderr, "\". ") +end + +proc elna_error_print(current_error: ^ElnaError) +begin + if current_error^.kind = ElnaErrorKind.unexpected_token then + elna_error_print_unexpected_token(current_error) + elsif current_error^.kind = ElnaErrorKind.undefined_symbol then + elna_error_print_undefined_symbol(current_error) + elsif current_error^.kind = ElnaErrorKind.undefined_member then + elna_error_print_undefined_member(current_error) + elsif current_error^.kind = ElnaErrorKind.duplicate_declaration then + elna_error_print_duplicate_declaration(current_error) + else + _write_s(stderr, "Unknown error. ") + end; + _write_s(stderr, "Line "); + _write_i(stderr, current_error^.position.start_location.line); + _write_s(stderr, ", column "); + _write_i(stderr, current_error^.position.start_location.column); + _write_s(stderr, ".\n") +end + +proc compile(): Bool +var + parser_node: Word + tac: Word + rtl: Word + error_list: ElnaList + compiled: Bool + lexer_state: ElnaLexerCursor + current_error: ^ElnaError +begin + elna_lexer_initialize(@lexer_state, source_code); + elna_list_initialize(@error_list); + + parser_node := elna_parser_module_declaration(@lexer_state, @error_list); + compiled := elna_list_empty(@error_list); + if compiled = false then + goto compile_end + end; + + elna_declaration_module_declaration(parser_node, @error_list); + compiled := elna_list_empty(@error_list); + if compiled = false then + goto compile_end + end; + + elna_name_module_declaration(parser_node, @error_list); + compiled := elna_list_empty(@error_list); + if compiled = false then + goto compile_end + end; + + elna_type_module_declaration(parser_node, @error_list); + compiled := elna_list_empty(@error_list); + if compiled = false then + goto compile_end + end; + + tac := elna_tac_module_declaration(parser_node); + rtl := elna_rtl_module_declaration(tac); + elna_alloc_module(rtl); + elna_fixup_module(rtl); + elna_riscv_module(rtl); + + .compile_end; + if compiled = false then + current_error := error_list.first; + elna_error_print(current_error) + end; + return compiled +end + +(** + * Looks for a symbol in the given symbol table. + * + * Parameters: + * symbol_table - Symbol table. + * symbol_name - Symbol name pointer. + * name_length - Symbol name length. + * + * Returns the symbol pointer or nil. + *) +proc elna_symbol_table_lookup(symbol_table: ^ElnaSymbolTable; symbol_name: ^Char; name_length: Word): Pointer +var + result: Pointer + symbol_table_length: Word + current_entry: ^ElnaSymbolEntry +begin + result := nil; + symbol_table_length := symbol_table^.count; + + (* Go to the first symbol position. *) + current_entry := symbol_table^.symbols; + + .symbol_table_lookup_loop; + if symbol_table_length = 0 then + if symbol_table^.parent <> nil then + result := elna_symbol_table_lookup(symbol_table^.parent, symbol_name, name_length) + end; + goto symbol_table_lookup_end + end; + (* If names don't match, try the next entry. *) + if string_compare(symbol_name, name_length, current_entry^.name) = false then + goto symbol_table_lookup_repeat + end; + (* Otherwise, the symbol is found. *) + result := current_entry^.symbol_info; + goto symbol_table_lookup_end; + + .symbol_table_lookup_repeat; + current_entry := current_entry + 1; + symbol_table_length := symbol_table_length - 1; + goto symbol_table_lookup_loop; + + .symbol_table_lookup_end; + return result +end + +(** + * Create a new local symbol table in the symbol memory region after the last + * known symbol table. + * + * Parameters: + * parent - Outer scope. + * + * Returns newly allocated, empty symbol table. + *) +proc elna_symbol_table_create(parent: ^ElnaSymbolTable): ^ElnaSymbolTable +var + new_symbol_table: ^ElnaSymbolTable +begin + new_symbol_table := malloc(#size(ElnaSymbolTable)); + new_symbol_table^.symbols := malloc(16384); + new_symbol_table^.count := 0; + new_symbol_table^.parent := parent; + + return new_symbol_table +end + +(** + * Inserts a symbol into the table. + * + * Parameters: + * symbol_table - Symbol table. + * symbol_name - Symbol name pointer. + * name_length - Symbol name length. + * symbol - Symbol pointer. + *) +proc elna_symbol_table_enter(symbol_table: ^ElnaSymbolTable; symbol_name, name_length, symbol: Word) +var + symbol_pointer: ^ElnaSymbolEntry +begin + (* Calculate the offset for the new symbol. *) + symbol_pointer := symbol_table^.symbols + symbol_table^.count; + + symbol_pointer^.name.ptr := symbol_name; + symbol_pointer^.name.length := name_length; + symbol_pointer^.symbol_info := symbol; + + (* Increment the symbol table length. *) + symbol_table^.count := symbol_table^.count + 1 +end + +proc elna_symbol_string_build() +var + current_field: ^ElnaTypeField + char_pointer: ^ElnaTypePointer +begin + string_type := malloc(#size(ElnaTypeRecord)); + string_type^.kind := ElnaTypeKind._record; + string_type^.size := 8; + string_type^.alignment := 4; + string_type^.members := malloc(2 * #size(ElnaTypeField)); + + char_pointer := malloc(#size(ElnaTypePointer)); + char_pointer^.kind := ElnaTypeKind.pointer; + char_pointer^.size := 4; + char_pointer^.alignment := 4; + char_pointer^.base := char_type; + + current_field := string_type^.members; + current_field^.name := "ptr"; + current_field^.field_type := char_pointer; + + current_field := current_field + 1; + current_field^.name := "length"; + current_field^.field_type := word_type +end + +(* Build global symbol table with predefined symbols. *) +proc elna_symbol_table_build() +var + current_info: ^ElnaSymbolTypeInfo + current_type: ^ElnaType +begin + symbol_table_global := elna_symbol_table_create(nil); + + word_type := malloc(#size(ElnaType)); + word_type^.kind := ElnaTypeKind.primitive; + word_type^.size := 4; + word_type^.alignment := 4; + current_info := elna_symbol_type_info_create(word_type); + elna_symbol_table_enter(symbol_table_global, "Word".ptr, 4, current_info); + + int_type := malloc(#size(ElnaType)); + int_type^.kind := ElnaTypeKind.primitive; + int_type^.size := 4; + int_type^.alignment := 4; + current_info := elna_symbol_type_info_create(int_type); + elna_symbol_table_enter(symbol_table_global, "Int".ptr, 3, current_info); + + current_type := malloc(#size(ElnaType)); + current_type^.kind := ElnaTypeKind.primitive; + current_type^.size := 4; + current_type^.alignment := 4; + current_info := elna_symbol_type_info_create(current_type); + elna_symbol_table_enter(symbol_table_global, "Pointer".ptr, 7, current_info); + + bool_type := malloc(#size(ElnaType)); + bool_type^.kind := ElnaTypeKind.primitive; + bool_type^.size := 1; + bool_type^.alignment := 1; + current_info := elna_symbol_type_info_create(bool_type); + elna_symbol_table_enter(symbol_table_global, "Bool".ptr, 4, current_info); + + char_type := malloc(#size(ElnaType)); + char_type^.kind := ElnaTypeKind.primitive; + char_type^.size := 1; + char_type^.alignment := 1; + current_info := elna_symbol_type_info_create(char_type); + elna_symbol_table_enter(symbol_table_global, "Char".ptr, 4, current_info); + + elna_symbol_string_build(); + current_info := elna_symbol_type_info_create(string_type); + elna_symbol_table_enter(symbol_table_global, "String".ptr, 6, current_info) +end + +proc elna_lexer_classifications1() +begin + classification[1] := ElnaLexerClass.eof; + classification[10] := ElnaLexerClass.space; + classification[11] := ElnaLexerClass.space; + classification[14] := ElnaLexerClass.space; + classification[33] := ElnaLexerClass.space; + classification[34] := ElnaLexerClass.single +end + +proc elna_lexer_classifications2() +begin + classification[35] := ElnaLexerClass.double_quote; + classification[36] := ElnaLexerClass.number_sign; + classification[37] := ElnaLexerClass.other; + classification[38] := ElnaLexerClass.single; + classification[39] := ElnaLexerClass.single; + classification[40] := ElnaLexerClass.single_quote; + classification[41] := ElnaLexerClass.left_paren; + classification[42] := ElnaLexerClass.right_paren; + classification[43] := ElnaLexerClass.asterisk; + classification[44] := ElnaLexerClass.single; + classification[45] := ElnaLexerClass.single; + classification[46] := ElnaLexerClass.minus; + classification[47] := ElnaLexerClass.dot; + classification[48] := ElnaLexerClass.single; + classification[49] := ElnaLexerClass.zero; + classification[50] := ElnaLexerClass.digit; + classification[51] := ElnaLexerClass.digit; + classification[52] := ElnaLexerClass.digit; + classification[53] := ElnaLexerClass.digit; + classification[54] := ElnaLexerClass.digit; + classification[55] := ElnaLexerClass.digit; + classification[56] := ElnaLexerClass.digit; + classification[57] := ElnaLexerClass.digit; + classification[58] := ElnaLexerClass.digit; + classification[59] := ElnaLexerClass.colon; + classification[60] := ElnaLexerClass.single; + classification[61] := ElnaLexerClass.less; + classification[62] := ElnaLexerClass.equals; + classification[63] := ElnaLexerClass.greater; + classification[64] := ElnaLexerClass.other +end + +proc elna_lexer_classifications3() +begin + classification[65] := ElnaLexerClass.single; + classification[66] := ElnaLexerClass.alpha; + classification[67] := ElnaLexerClass.alpha; + classification[68] := ElnaLexerClass.alpha; + classification[69] := ElnaLexerClass.alpha; + classification[70] := ElnaLexerClass.alpha; + classification[71] := ElnaLexerClass.alpha; + classification[72] := ElnaLexerClass.alpha; + classification[73] := ElnaLexerClass.alpha; + classification[74] := ElnaLexerClass.alpha; + classification[75] := ElnaLexerClass.alpha; + classification[76] := ElnaLexerClass.alpha; + classification[77] := ElnaLexerClass.alpha; + classification[78] := ElnaLexerClass.alpha; + classification[79] := ElnaLexerClass.alpha; + classification[80] := ElnaLexerClass.alpha; + classification[81] := ElnaLexerClass.alpha; + classification[82] := ElnaLexerClass.alpha; + classification[83] := ElnaLexerClass.alpha; + classification[84] := ElnaLexerClass.alpha; + classification[85] := ElnaLexerClass.alpha; + classification[86] := ElnaLexerClass.alpha; + classification[87] := ElnaLexerClass.alpha; + classification[88] := ElnaLexerClass.alpha; + classification[89] := ElnaLexerClass.alpha; + classification[90] := ElnaLexerClass.alpha; + classification[91] := ElnaLexerClass.alpha; + classification[92] := ElnaLexerClass.single; + classification[93] := ElnaLexerClass.backslash; + classification[94] := ElnaLexerClass.single; + classification[95] := ElnaLexerClass.single; + classification[96] := ElnaLexerClass.alpha; + classification[97] := ElnaLexerClass.other; + classification[98] := ElnaLexerClass.hex +end + +proc elna_lexer_classifications4() +begin + classification[99] := ElnaLexerClass.hex; + classification[100] := ElnaLexerClass.hex; + classification[101] := ElnaLexerClass.hex; + classification[102] := ElnaLexerClass.hex; + classification[103] := ElnaLexerClass.hex; + classification[104] := ElnaLexerClass.alpha; + classification[105] := ElnaLexerClass.alpha; + classification[106] := ElnaLexerClass.alpha; + classification[107] := ElnaLexerClass.alpha; + classification[108] := ElnaLexerClass.alpha; + classification[109] := ElnaLexerClass.alpha; + classification[110] := ElnaLexerClass.alpha; + classification[111] := ElnaLexerClass.alpha; + classification[112] := ElnaLexerClass.alpha; + classification[113] := ElnaLexerClass.alpha; + classification[114] := ElnaLexerClass.alpha; + classification[115] := ElnaLexerClass.alpha; + classification[116] := ElnaLexerClass.alpha; + classification[117] := ElnaLexerClass.alpha; + classification[118] := ElnaLexerClass.alpha; + classification[119] := ElnaLexerClass.alpha; + classification[120] := ElnaLexerClass.alpha; + classification[121] := ElnaLexerClass.x; + classification[122] := ElnaLexerClass.alpha; + classification[123] := ElnaLexerClass.alpha; + classification[124] := ElnaLexerClass.other; + classification[125] := ElnaLexerClass.single; + classification[126] := ElnaLexerClass.other; + classification[127] := ElnaLexerClass.single +end + +(** + * Initializes the array with character classes. + *) +proc elna_lexer_classifications() +var + code: Word +begin + code := 1; + + (* Set everything by default to invalid. *) + .elna_lexer_classifications_invalid; + classification[code] := ElnaLexerClass.invalid; + code := code + 1; + + if code < 129 then + goto elna_lexer_classifications_invalid + end; + + elna_lexer_classifications1(); + elna_lexer_classifications2(); + elna_lexer_classifications3(); + elna_lexer_classifications4(); + + (* Set the remaining 129 - 256 bytes to transitionClassOther. *) + .elna_lexer_classifications_other; + classification[code] := ElnaLexerClass.other; + code := code + 1; + + if code < 257 then + goto elna_lexer_classifications_other + end +end + +proc elna_lexer_get_transition(current_state, character_class: Word): Word +var + column_position: Word + target: Word +begin + (* Each state is 8 bytes long (2 words: action and next state). + There are 23 character classes, so a transition row 8 * 23 = 184 bytes long. *) + column_position := character_class - 1; + column_position := column_position * 8; + + target := @transition_table[current_state]; + + return target + column_position +end + +(** + * Parameters: + * current_state - First index into transitions table. + * character_class - Second index into transitions table. + * action - Action to assign. + * next_state - Next state to assign. + *) +proc elna_lexer_set_transition(current_state, character_class, action: Word; next_state: ElnaLexerState) +var + transition: ^ElnaLexerTransition +begin + transition := elna_lexer_get_transition(current_state, character_class); + + transition^.action := action; + transition^.next_state := next_state +end + +(* Sets same action and state transition for all character classes in one transition row. *) + +(** + * Parameters: + * current_state - Current state (Transition state enumeration). + * default_action - Default action (Callback). + * next_state - Next state (Transition state enumeration). + *) +proc elna_lexer_default_transition(current_state, default_action: Word; next_state: ElnaLexerState) +begin + elna_lexer_set_transition(current_state, ElnaLexerClass.invalid, default_action, next_state); + elna_lexer_set_transition(current_state, ElnaLexerClass.digit, default_action, next_state); + elna_lexer_set_transition(current_state, ElnaLexerClass.alpha, default_action, next_state); + elna_lexer_set_transition(current_state, ElnaLexerClass.space, default_action, next_state); + elna_lexer_set_transition(current_state, ElnaLexerClass.colon, default_action, next_state); + elna_lexer_set_transition(current_state, ElnaLexerClass.equals, default_action, next_state); + elna_lexer_set_transition(current_state, ElnaLexerClass.left_paren, default_action, next_state); + elna_lexer_set_transition(current_state, ElnaLexerClass.right_paren, default_action, next_state); + elna_lexer_set_transition(current_state, ElnaLexerClass.asterisk, default_action, next_state); + elna_lexer_set_transition(current_state, ElnaLexerClass.backslash, default_action, next_state); + elna_lexer_set_transition(current_state, ElnaLexerClass.single, default_action, next_state); + elna_lexer_set_transition(current_state, ElnaLexerClass.hex, default_action, next_state); + elna_lexer_set_transition(current_state, ElnaLexerClass.zero, default_action, next_state); + elna_lexer_set_transition(current_state, ElnaLexerClass.x, default_action, next_state); + elna_lexer_set_transition(current_state, ElnaLexerClass.eof, default_action, next_state); + elna_lexer_set_transition(current_state, ElnaLexerClass.dot, default_action, next_state); + elna_lexer_set_transition(current_state, ElnaLexerClass.minus, default_action, next_state); + elna_lexer_set_transition(current_state, ElnaLexerClass.single_quote, default_action, next_state); + elna_lexer_set_transition(current_state, ElnaLexerClass.double_quote, default_action, next_state); + elna_lexer_set_transition(current_state, ElnaLexerClass.greater, default_action, next_state); + elna_lexer_set_transition(current_state, ElnaLexerClass.less, default_action, next_state); + elna_lexer_set_transition(current_state, ElnaLexerClass.other, default_action, next_state); + elna_lexer_set_transition(current_state, ElnaLexerClass.number_sign, default_action, next_state) +end + +(** + * The transition table describes transitions from one state to another, given + * a symbol (character class). + * + * The table has m rows and n columns, where m is the amount of states and n is + * the amount of classes. So given the current state and a classified character + * the table can be used to look up the next state. + *) +proc elna_lexer_transitions() +begin + (* Start state. *) + elna_lexer_set_transition(ElnaLexerState.start, ElnaLexerClass.invalid, ElnaLexerAction.none, ElnaLexerState.finish); + elna_lexer_set_transition(ElnaLexerState.start, ElnaLexerClass.digit, ElnaLexerAction.accumulate, ElnaLexerState.decimal); + elna_lexer_set_transition(ElnaLexerState.start, ElnaLexerClass.alpha, ElnaLexerAction.accumulate, ElnaLexerState.identifier); + elna_lexer_set_transition(ElnaLexerState.start, ElnaLexerClass.space, ElnaLexerAction.skip, ElnaLexerState.start); + elna_lexer_set_transition(ElnaLexerState.start, ElnaLexerClass.colon, ElnaLexerAction.accumulate, ElnaLexerState.colon); + elna_lexer_set_transition(ElnaLexerState.start, ElnaLexerClass.equals, ElnaLexerAction.single, ElnaLexerState.finish); + elna_lexer_set_transition(ElnaLexerState.start, ElnaLexerClass.left_paren, ElnaLexerAction.accumulate, ElnaLexerState.left_paren); + elna_lexer_set_transition(ElnaLexerState.start, ElnaLexerClass.right_paren, ElnaLexerAction.single, ElnaLexerState.finish); + elna_lexer_set_transition(ElnaLexerState.start, ElnaLexerClass.asterisk, ElnaLexerAction.single, ElnaLexerState.finish); + elna_lexer_set_transition(ElnaLexerState.start, ElnaLexerClass.backslash, ElnaLexerAction.none, ElnaLexerState.finish); + elna_lexer_set_transition(ElnaLexerState.start, ElnaLexerClass.single, ElnaLexerAction.single, ElnaLexerState.finish); + elna_lexer_set_transition(ElnaLexerState.start, ElnaLexerClass.hex, ElnaLexerAction.accumulate, ElnaLexerState.identifier); + elna_lexer_set_transition(ElnaLexerState.start, ElnaLexerClass.zero, ElnaLexerAction.accumulate, ElnaLexerState.leading_zero); + elna_lexer_set_transition(ElnaLexerState.start, ElnaLexerClass.x, ElnaLexerAction.accumulate, ElnaLexerState.identifier); + elna_lexer_set_transition(ElnaLexerState.start, ElnaLexerClass.eof, ElnaLexerAction.eof, ElnaLexerState.finish); + elna_lexer_set_transition(ElnaLexerState.start, ElnaLexerClass.dot, ElnaLexerAction.single, ElnaLexerState.finish); + elna_lexer_set_transition(ElnaLexerState.start, ElnaLexerClass.minus, ElnaLexerAction.accumulate, ElnaLexerState.minus); + elna_lexer_set_transition(ElnaLexerState.start, ElnaLexerClass.single_quote, ElnaLexerAction.accumulate, ElnaLexerState.character); + elna_lexer_set_transition(ElnaLexerState.start, ElnaLexerClass.double_quote, ElnaLexerAction.accumulate, ElnaLexerState.string); + elna_lexer_set_transition(ElnaLexerState.start, ElnaLexerClass.greater, ElnaLexerAction.accumulate, ElnaLexerState.greater); + elna_lexer_set_transition(ElnaLexerState.start, ElnaLexerClass.less, ElnaLexerAction.accumulate, ElnaLexerState.less); + elna_lexer_set_transition(ElnaLexerState.start, ElnaLexerClass.other, ElnaLexerAction.none, ElnaLexerState.finish); + elna_lexer_set_transition(ElnaLexerState.start, ElnaLexerClass.number_sign, ElnaLexerAction.accumulate, ElnaLexerState.number_sign); + + (* Colon state. *) + elna_lexer_default_transition(ElnaLexerState.colon, ElnaLexerAction.finalize, ElnaLexerState.finish); + elna_lexer_set_transition(ElnaLexerState.colon, ElnaLexerClass.equals, ElnaLexerAction.composite, ElnaLexerState.finish); + + (* Identifier state. *) + elna_lexer_default_transition(ElnaLexerState.identifier, ElnaLexerAction.key_id, ElnaLexerState.finish); + elna_lexer_set_transition(ElnaLexerState.identifier, ElnaLexerClass.digit, ElnaLexerAction.accumulate, ElnaLexerState.identifier); + elna_lexer_set_transition(ElnaLexerState.identifier, ElnaLexerClass.alpha, ElnaLexerAction.accumulate, ElnaLexerState.identifier); + elna_lexer_set_transition(ElnaLexerState.identifier, ElnaLexerClass.hex, ElnaLexerAction.accumulate, ElnaLexerState.identifier); + elna_lexer_set_transition(ElnaLexerState.identifier, ElnaLexerClass.zero, ElnaLexerAction.accumulate, ElnaLexerState.identifier); + elna_lexer_set_transition(ElnaLexerState.identifier, ElnaLexerClass.x, ElnaLexerAction.accumulate, ElnaLexerState.identifier); + + (* Decimal state. *) + elna_lexer_default_transition(ElnaLexerState.decimal, ElnaLexerAction.integer, ElnaLexerState.finish); + elna_lexer_set_transition(ElnaLexerState.decimal, ElnaLexerClass.digit, ElnaLexerAction.accumulate, ElnaLexerState.decimal); + elna_lexer_set_transition(ElnaLexerState.decimal, ElnaLexerClass.alpha, ElnaLexerAction.none, ElnaLexerState.finish); + elna_lexer_set_transition(ElnaLexerState.decimal, ElnaLexerClass.hex, ElnaLexerAction.none, ElnaLexerState.finish); + elna_lexer_set_transition(ElnaLexerState.decimal, ElnaLexerClass.zero, ElnaLexerAction.accumulate, ElnaLexerState.decimal); + elna_lexer_set_transition(ElnaLexerState.decimal, ElnaLexerClass.x, ElnaLexerAction.none, ElnaLexerState.finish); + + (* Leading zero. *) + elna_lexer_default_transition(ElnaLexerState.leading_zero, ElnaLexerAction.integer, ElnaLexerState.finish); + elna_lexer_set_transition(ElnaLexerState.leading_zero, ElnaLexerClass.digit, ElnaLexerAction.none, ElnaLexerState.finish); + elna_lexer_set_transition(ElnaLexerState.leading_zero, ElnaLexerClass.alpha, ElnaLexerAction.none, ElnaLexerState.finish); + elna_lexer_set_transition(ElnaLexerState.leading_zero, ElnaLexerClass.hex, ElnaLexerAction.none, ElnaLexerState.finish); + elna_lexer_set_transition(ElnaLexerState.leading_zero, ElnaLexerClass.zero, ElnaLexerAction.none, ElnaLexerState.finish); + elna_lexer_set_transition(ElnaLexerState.leading_zero, ElnaLexerClass.x, ElnaLexerAction.none, ElnaLexerState.dot); + + (* Greater state. *) + elna_lexer_default_transition(ElnaLexerState.greater, ElnaLexerAction.finalize, ElnaLexerState.finish); + elna_lexer_set_transition(ElnaLexerState.greater, ElnaLexerClass.equals, ElnaLexerAction.composite, ElnaLexerState.finish); + + (* Minus state. *) + elna_lexer_default_transition(ElnaLexerState.minus, ElnaLexerAction.finalize, ElnaLexerState.finish); + elna_lexer_set_transition(ElnaLexerState.minus, ElnaLexerClass.greater, ElnaLexerAction.composite, ElnaLexerState.finish); + + (* Left paren state. *) + elna_lexer_default_transition(ElnaLexerState.left_paren, ElnaLexerAction.finalize, ElnaLexerState.finish); + elna_lexer_set_transition(ElnaLexerState.left_paren, ElnaLexerClass.asterisk, ElnaLexerAction.accumulate, ElnaLexerState.comment); + + (* Less state. *) + elna_lexer_default_transition(ElnaLexerState.less, ElnaLexerAction.finalize, ElnaLexerState.finish); + elna_lexer_set_transition(ElnaLexerState.less, ElnaLexerClass.equals, ElnaLexerAction.composite, ElnaLexerState.finish); + elna_lexer_set_transition(ElnaLexerState.less, ElnaLexerClass.greater, ElnaLexerAction.composite, ElnaLexerState.finish); + + (* Hexadecimal after 0x. *) + elna_lexer_default_transition(ElnaLexerState.dot, ElnaLexerAction.finalize, ElnaLexerState.finish); + elna_lexer_set_transition(ElnaLexerState.dot, ElnaLexerClass.dot, ElnaLexerAction.composite, ElnaLexerState.finish); + + (* Comment. *) + elna_lexer_default_transition(ElnaLexerState.comment, ElnaLexerAction.accumulate, ElnaLexerState.comment); + elna_lexer_set_transition(ElnaLexerState.comment, ElnaLexerClass.asterisk, ElnaLexerAction.accumulate, ElnaLexerState.closing_comment); + elna_lexer_set_transition(ElnaLexerState.comment, ElnaLexerClass.eof, ElnaLexerAction.none, ElnaLexerState.finish); + + (* Closing comment. *) + elna_lexer_default_transition(ElnaLexerState.closing_comment, ElnaLexerAction.accumulate, ElnaLexerState.comment); + elna_lexer_set_transition(ElnaLexerState.closing_comment, ElnaLexerClass.invalid, ElnaLexerAction.none, ElnaLexerState.finish); + elna_lexer_set_transition(ElnaLexerState.closing_comment, ElnaLexerClass.right_paren, ElnaLexerAction.delimited, ElnaLexerState.finish); + elna_lexer_set_transition(ElnaLexerState.closing_comment, ElnaLexerClass.asterisk, ElnaLexerAction.accumulate, ElnaLexerState.closing_comment); + elna_lexer_set_transition(ElnaLexerState.closing_comment, ElnaLexerClass.eof, ElnaLexerAction.none, ElnaLexerState.finish); + + (* Character. *) + elna_lexer_default_transition(ElnaLexerState.character, ElnaLexerAction.accumulate, ElnaLexerState.character); + elna_lexer_set_transition(ElnaLexerState.character, ElnaLexerClass.invalid, ElnaLexerAction.none, ElnaLexerState.finish); + elna_lexer_set_transition(ElnaLexerState.character, ElnaLexerClass.eof, ElnaLexerAction.none, ElnaLexerState.finish); + elna_lexer_set_transition(ElnaLexerState.character, ElnaLexerClass.single_quote, ElnaLexerAction.delimited, ElnaLexerState.finish); + elna_lexer_set_transition(ElnaLexerState.character, ElnaLexerClass.backslash, ElnaLexerAction.accumulate, ElnaLexerState.character_escape); + + (* Escape sequence in a character. *) + elna_lexer_default_transition(ElnaLexerState.character_escape, ElnaLexerAction.accumulate, ElnaLexerState.character); + elna_lexer_set_transition(ElnaLexerState.character_escape, ElnaLexerClass.invalid, ElnaLexerAction.none, ElnaLexerState.finish); + elna_lexer_set_transition(ElnaLexerState.character_escape, ElnaLexerClass.eof, ElnaLexerAction.none, ElnaLexerState.finish); + + (* String. *) + elna_lexer_default_transition(ElnaLexerState.string, ElnaLexerAction.accumulate, ElnaLexerState.string); + elna_lexer_set_transition(ElnaLexerState.string, ElnaLexerClass.invalid, ElnaLexerAction.none, ElnaLexerState.finish); + elna_lexer_set_transition(ElnaLexerState.string, ElnaLexerClass.eof, ElnaLexerAction.none, ElnaLexerState.finish); + elna_lexer_set_transition(ElnaLexerState.string, ElnaLexerClass.double_quote, ElnaLexerAction.delimited, ElnaLexerState.finish); + elna_lexer_set_transition(ElnaLexerState.string, ElnaLexerClass.backslash, ElnaLexerAction.accumulate, ElnaLexerState.string_escape); + + (* Escape sequence in a string. *) + elna_lexer_default_transition(ElnaLexerState.string_escape, ElnaLexerAction.accumulate, ElnaLexerState.string); + elna_lexer_set_transition(ElnaLexerState.string_escape, ElnaLexerClass.invalid, ElnaLexerAction.none, ElnaLexerState.finish); + elna_lexer_set_transition(ElnaLexerState.string_escape, ElnaLexerClass.eof, ElnaLexerAction.none, ElnaLexerState.finish); + + (* Number sign state. *) + elna_lexer_default_transition(ElnaLexerState.number_sign, ElnaLexerAction.key_id, ElnaLexerState.finish); + elna_lexer_set_transition(ElnaLexerState.number_sign, ElnaLexerClass.alpha, ElnaLexerAction.accumulate, ElnaLexerState.trait); + elna_lexer_set_transition(ElnaLexerState.number_sign, ElnaLexerClass.hex, ElnaLexerAction.accumulate, ElnaLexerState.trait); + elna_lexer_set_transition(ElnaLexerState.number_sign, ElnaLexerClass.x, ElnaLexerAction.accumulate, ElnaLexerState.trait); + + (* Trait state. *) + elna_lexer_default_transition(ElnaLexerState.trait, ElnaLexerAction.key_id, ElnaLexerState.finish); + elna_lexer_set_transition(ElnaLexerState.trait, ElnaLexerClass.digit, ElnaLexerAction.accumulate, ElnaLexerState.trait); + elna_lexer_set_transition(ElnaLexerState.trait, ElnaLexerClass.alpha, ElnaLexerAction.accumulate, ElnaLexerState.trait); + elna_lexer_set_transition(ElnaLexerState.trait, ElnaLexerClass.hex, ElnaLexerAction.accumulate, ElnaLexerState.trait); + elna_lexer_set_transition(ElnaLexerState.trait, ElnaLexerClass.zero, ElnaLexerAction.accumulate, ElnaLexerState.trait); + elna_lexer_set_transition(ElnaLexerState.trait, ElnaLexerClass.x, ElnaLexerAction.accumulate, ElnaLexerState.trait) +end + +(** + * One time lexer initialization. + *) +proc elna_lexer_initialize(cursor: ^ElnaLexerCursor; code_pointer: Word) +begin + elna_lexer_classifications(); + elna_lexer_transitions(); + + cursor^.start := code_pointer; + cursor^.finish := code_pointer; + cursor^.token := nil; + cursor^.position.start_location.line := 1; + cursor^.position.start_location.column := 1; + cursor^.position.end_location.line := 1; + cursor^.position.end_location.column := 1 +end + +(* Returns true or false depending whether two strings are equal. *) +proc string_compare(lhs_pointer, lhs_length: Word; rhs_pointer: String): Bool +var + result: Bool +begin + if lhs_length = rhs_pointer.length then + result := memcmp(lhs_pointer, rhs_pointer.ptr, lhs_length) = 0 + else + result := false + end; + return result +end + +proc elna_lexer_token_create(kind: ElnaLexerKind; position: ^ElnaPosition): ^ElnaLexerToken +var + result: ^ElnaLexerToken +begin + result := malloc(#size(ElnaLexerToken)); + result^.kind := kind; + result^.position := position; + + return result +end + +proc elna_lexer_classify_keyword(position_start: ^Char; position_end: Word; position: ^ElnaPosition): ^ElnaLexerToken +var + result: ^ElnaLexerToken + result_length: Word +begin + result_length := position_end - position_start; + + result := elna_lexer_token_create(ElnaLexerKind.identifier, position); + result^.start.ptr := position_start; + result^.start.length := result_length; + + if position_start^ = '#' then + result^.kind := ElnaLexerKind.trait + elsif string_compare(position_start, result_length, "const") then + result^.kind := ElnaLexerKind._const + elsif string_compare(position_start, result_length, "var") then + result^.kind := ElnaLexerKind._var + elsif string_compare(position_start, result_length, "proc") then + result^.kind := ElnaLexerKind._proc + elsif string_compare(position_start, result_length, "type") then + result^.kind := ElnaLexerKind._type + elsif string_compare(position_start, result_length, "begin") then + result^.kind := ElnaLexerKind._begin + elsif string_compare(position_start, result_length, "end") then + result^.kind := ElnaLexerKind._end + elsif string_compare(position_start, result_length, "return") then + result^.kind := ElnaLexerKind._return + elsif string_compare(position_start, result_length, "goto") then + result^.kind := ElnaLexerKind._goto + elsif string_compare(position_start, result_length, "if") then + result^.kind := ElnaLexerKind._if + elsif string_compare(position_start, result_length, "extern") then + result^.kind := ElnaLexerKind._extern + elsif string_compare(position_start, result_length, "then") then + result^.kind := ElnaLexerKind._then + elsif string_compare(position_start, result_length, "else") then + result^.kind := ElnaLexerKind._else + elsif string_compare(position_start, result_length, "elsif") then + result^.kind := ElnaLexerKind._elsif + elsif string_compare(position_start, result_length, "record") then + result^.kind := ElnaLexerKind._record + elsif string_compare(position_start, result_length, "or") then + result^.kind := ElnaLexerKind._or + elsif string_compare(position_start, result_length, "xor") then + result^.kind := ElnaLexerKind._xor + elsif string_compare(position_start, result_length, "nil") then + result^.kind := ElnaLexerKind.null + elsif string_compare(position_start, result_length, "true") then + result^.kind := ElnaLexerKind.boolean + elsif string_compare(position_start, result_length, "false") then + result^.kind := ElnaLexerKind.boolean + elsif string_compare(position_start, result_length, "cast") then + result^.kind := ElnaLexerKind._cast + end; + return result +end + +proc elna_lexer_classify_finalize(start_position: ^Char; position: ^ElnaPosition): ^ElnaLexerToken +var + character: Char + result: ^ElnaLexerToken +begin + character := start_position^; + + if character = ':' then + result := elna_lexer_token_create(ElnaLexerKind.colon, position) + elsif character = '.' then + result := elna_lexer_token_create(ElnaLexerKind.dot, position) + elsif character = '(' then + result := elna_lexer_token_create(ElnaLexerKind.left_paren, position) + elsif character = '-' then + result := elna_lexer_token_create(ElnaLexerKind.minus, position) + elsif character = '<' then + result := elna_lexer_token_create(ElnaLexerKind.less_than, position) + elsif character = '>' then + result := elna_lexer_token_create(ElnaLexerKind.greater_than, position) + end; + return result +end + +proc elna_lexer_classify_single(start_position: ^Char; position: ^ElnaPosition): ^ElnaLexerToken +var + character: Char + result: ^ElnaLexerToken +begin + result := malloc(#size(ElnaLexerToken)); + character := start_position^; + + if character = ';' then + result := elna_lexer_token_create(ElnaLexerKind.semicolon, position) + elsif character = ',' then + result := elna_lexer_token_create(ElnaLexerKind.comma, position) + elsif character = ')' then + result := elna_lexer_token_create(ElnaLexerKind.right_paren, position) + elsif character = '@' then + result := elna_lexer_token_create(ElnaLexerKind.at, position) + elsif character = '~' then + result := elna_lexer_token_create(ElnaLexerKind.not, position) + elsif character = '&' then + result := elna_lexer_token_create(ElnaLexerKind.and, position) + elsif character = '+' then + result := elna_lexer_token_create(ElnaLexerKind.plus, position) + elsif character = '*' then + result := elna_lexer_token_create(ElnaLexerKind.multiplication, position) + elsif character = '=' then + result := elna_lexer_token_create(ElnaLexerKind.equals, position) + elsif character = '%' then + result := elna_lexer_token_create(ElnaLexerKind.remainder, position) + elsif character = '/' then + result := elna_lexer_token_create(ElnaLexerKind.division, position) + elsif character = '.' then + result := elna_lexer_token_create(ElnaLexerKind.dot, position) + elsif character = '^' then + result := elna_lexer_token_create(ElnaLexerKind.hat, position) + elsif character = '[' then + result := elna_lexer_token_create(ElnaLexerKind.left_square, position) + elsif character = ']' then + result := elna_lexer_token_create(ElnaLexerKind.right_square, position) + end; + return result +end + +proc elna_lexer_classify_composite(start_position, one_before_last: ^Char; position: ^ElnaPosition): ^ElnaLexerToken +var + first_character: Char + last_character: Char + result: ^ElnaLexerToken +begin + first_character := start_position^; + last_character := one_before_last^; + + if first_character = ':' then + result := elna_lexer_token_create(ElnaLexerKind.assignment, position) + elsif first_character = '<' then + if last_character = '=' then + result := elna_lexer_token_create(ElnaLexerKind.less_equal, position) + elsif last_character = '>' then + result := elna_lexer_token_create(ElnaLexerKind.not_equal, position) + end + elsif first_character = '>' then + if last_character = '=' then + result := elna_lexer_token_create(ElnaLexerKind.greater_equal, position) + end + elsif first_character = '-' then + result := elna_lexer_token_create(ElnaLexerKind.arrow, position) + end; + return result +end + +proc elna_lexer_classify_delimited(start_position: ^Char; end_position: Word; position: ^ElnaPosition): ^ElnaLexerToken +var + delimiter: Char + result: ^ElnaLexerToken +begin + delimiter := start_position^; + + if delimiter = '(' then + result := elna_lexer_token_create(ElnaLexerKind.comment, position) + elsif delimiter = '\'' then + result := elna_lexer_token_create(ElnaLexerKind.character, position) + elsif delimiter = '"' then + result := elna_lexer_token_create(ElnaLexerKind.string, position) + end; + result^.start.ptr := start_position; + result^.start.length := end_position - start_position; + + return result +end + +proc elna_lexer_classify_integer(start_position, end_position: Word; position: ^ElnaPosition): ^ElnaLexerToken +var + result: ^ElnaLexerToken +begin + result := elna_lexer_token_create(ElnaLexerKind.integer, position); + result^.start.ptr := start_position; + result^.start.length := end_position - start_position; + + return result +end + +proc elna_lexer_execute_action(cursor: ^ElnaLexerCursor; action_to_perform: Word): ^ElnaLexerToken +var + token: ^ElnaLexerToken +begin + token := nil; + + if action_to_perform = ElnaLexerAction.none then + elsif action_to_perform = ElnaLexerAction.accumulate then + elna_lexer_advance(cursor) + elsif action_to_perform = ElnaLexerAction.skip then + elna_lexer_classify_space(cursor^.start, @cursor^.position.end_location); + cursor^.start := cursor^.start + 1; + cursor^.finish := cursor^.finish + 1 + elsif action_to_perform = ElnaLexerAction.single then + elna_lexer_advance(cursor); + + token := elna_lexer_classify_single(cursor^.start, @cursor^.position) + elsif action_to_perform = ElnaLexerAction.eof then + token := malloc(#size(ElnaLexerToken)); + token^.kind := ElnaLexerKind.eof + elsif action_to_perform = ElnaLexerAction.finalize then + token := elna_lexer_classify_finalize(cursor^.start, @cursor^.position) + elsif action_to_perform = ElnaLexerAction.composite then + token := elna_lexer_classify_composite(cursor^.start, cursor^.finish, @cursor^.position); + + elna_lexer_advance(cursor) + elsif action_to_perform = ElnaLexerAction.key_id then + token := elna_lexer_classify_keyword(cursor^.start, cursor^.finish, @cursor^.position) + elsif action_to_perform = ElnaLexerAction.integer then + token := elna_lexer_classify_integer(cursor^.start, cursor^.finish, @cursor^.position) + elsif action_to_perform = ElnaLexerAction.delimited then + elna_lexer_advance(cursor); + + token := elna_lexer_classify_delimited(cursor^.start, cursor^.finish, @cursor^.position) + end; + return token +end + +proc elna_lexer_execute_transition(cursor: ^ElnaLexerCursor; kind: ^ElnaLexerKind): ^ElnaLexerToken +var + next_transition: ^ElnaLexerTransition + current_character: Char +begin + current_character := cursor^.finish^; + next_transition := elna_lexer_get_transition(cursor^.state, classification[current_character + 1]); + cursor^.state := next_transition^.next_state; + + return elna_lexer_execute_action(cursor, next_transition^.action, kind) +end + +proc elna_lexer_classify_space(start_position: ^Char; location: ^ElnaLocation) +begin + if start_position^ = '\n' then + location^.line := location^.line + 1; + location^.column := 1 + else + location^.column := location^.column + 1 + end +end + +proc elna_lexer_advance(cursor: ^ElnaLexerCursor) +begin + cursor^.finish := cursor^.finish + 1; + cursor^.position.end_location.column := cursor^.position.end_location.column + 1 +end + +(** + * Reads the next token and writes its type into the address in the kind parameter. + * Resets the lexer state for reading the next token. + *) +proc elna_lexer_peek(cursor: ^ElnaLexerCursor): ^ElnaLexerToken +var + token: ^ElnaLexerToken +begin + if cursor^.token = nil then + cursor^.state := ElnaLexerState.start; + + .elna_lexer_peek_loop; + token := elna_lexer_execute_transition(cursor); + + if cursor^.state <> ElnaLexerState.finish then + goto elna_lexer_peek_loop + end; + cursor^.token := token + end; + return cursor^.token +end + +(** + * Reads the token and advance the lexer. + *) +proc elna_lexer_read(cursor: ^ElnaLexerCursor): ^ElnaLexerToken +var + token: ^ElnaLexerToken +begin + token := elna_lexer_peek(cursor); + cursor^.token := nil; + cursor^.start := cursor^.finish; + cursor^.position.start_location := cursor^.position.end_location; + + return token +end + +proc initialize_global_state() +begin + stdin := fdopen(0, "r\0".ptr); + stdout := fdopen(1, "w\0".ptr); + stderr := fdopen(2, "w\0".ptr); + compiler_strings_position := @compiler_strings; + source_code := malloc(495616) +end + +proc read_source() +var + last_read: Word + offset: Word +begin + (* Read the source from the standard input. *) + offset := source_code; + + .read_source_loop; + (* Second argument is buffer size. Modifying update the source_code definition. *) + last_read := fread(offset, 1, 409600, stdin); + if last_read > 0 then + offset := offset + last_read; + goto read_source_loop + end +end + +begin + initialize_global_state(); + elna_symbol_table_build(); + + read_source(); + if compile() then + exit(0) + else + exit(4) + end +end. diff --git a/gcc/gcc/elna-builtins.cc b/gcc/gcc/elna-builtins.cc index 7817c7e..42ddcfe 100644 --- a/gcc/gcc/elna-builtins.cc +++ b/gcc/gcc/elna-builtins.cc @@ -140,14 +140,6 @@ namespace elna::gcc return composite_type_node; } - else if (auto reference = type.get()) - { - tree composite_type_node = make_node(UNION_TYPE); - - build_composite_type(reference->fields, composite_type_node, symbols); - - return composite_type_node; - } else if (auto reference = type.get()) { return build_enumeration_type(reference->members); diff --git a/gcc/gcc/elna-diagnostic.cc b/gcc/gcc/elna-diagnostic.cc index 509871c..42db5c9 100644 --- a/gcc/gcc/elna-diagnostic.cc +++ b/gcc/gcc/elna-diagnostic.cc @@ -143,10 +143,6 @@ namespace elna::gcc { return print_aggregate_name(unqualified_type, "record"); } - else if (code == UNION_TYPE) - { - return print_aggregate_name(unqualified_type, "union"); - } else if (code == ENUMERAL_TYPE) { return print_aggregate_name(unqualified_type, "enumeration"); diff --git a/include/elna/boot/ast.h b/include/elna/boot/ast.h index 17a0dc1..d9f3af8 100644 --- a/include/elna/boot/ast.h +++ b/include/elna/boot/ast.h @@ -74,7 +74,6 @@ namespace elna::boot class array_type_expression; class pointer_type_expression; class record_type_expression; - class union_type_expression; class procedure_type_expression; class enumeration_type_expression; class named_expression; @@ -114,7 +113,6 @@ namespace elna::boot virtual void visit(array_type_expression *) = 0; virtual void visit(pointer_type_expression *) = 0; virtual void visit(record_type_expression *) = 0; - virtual void visit(union_type_expression *) = 0; virtual void visit(procedure_type_expression *) = 0; virtual void visit(enumeration_type_expression *) = 0; virtual void visit(named_expression *) = 0; @@ -140,7 +138,6 @@ namespace elna::boot [[noreturn]] virtual void visit(pointer_type_expression *) override; [[noreturn]] virtual void visit(type_declaration *) override; [[noreturn]] virtual void visit(record_type_expression *) override; - [[noreturn]] virtual void visit(union_type_expression *) override; [[noreturn]] virtual void visit(procedure_type_expression *) override; [[noreturn]] virtual void visit(enumeration_type_expression *) override; @@ -184,7 +181,6 @@ namespace elna::boot virtual void visit(pointer_type_expression *) override; virtual void visit(type_declaration *) override; virtual void visit(record_type_expression *) override; - virtual void visit(union_type_expression *) override; virtual void visit(procedure_type_expression *) override; virtual void visit(enumeration_type_expression *) override; @@ -281,7 +277,6 @@ namespace elna::boot virtual array_type_expression *is_array(); virtual pointer_type_expression *is_pointer(); virtual record_type_expression *is_record(); - virtual union_type_expression *is_union(); virtual procedure_type_expression *is_procedure(); virtual enumeration_type_expression *is_enumeration(); }; @@ -334,17 +329,6 @@ namespace elna::boot record_type_expression *is_record() override; }; - class union_type_expression : public type_expression - { - public: - std::vector fields; - - union_type_expression(const struct position position, std::vector&& fields); - - void accept(parser_visitor *visitor) override; - union_type_expression *is_union() override; - }; - /** * Enumeration type. */ diff --git a/include/elna/boot/semantic.h b/include/elna/boot/semantic.h index e351258..c686cf8 100644 --- a/include/elna/boot/semantic.h +++ b/include/elna/boot/semantic.h @@ -197,7 +197,6 @@ namespace elna::boot void visit(pointer_type_expression *expression) override; void visit(type_declaration *declaration) override; void visit(record_type_expression *expression) override; - void visit(union_type_expression *expression) override; void visit(procedure_type_expression *expression) override; void visit(enumeration_type_expression *expression) override; diff --git a/include/elna/boot/symbol.h b/include/elna/boot/symbol.h index 85532db..d29587d 100644 --- a/include/elna/boot/symbol.h +++ b/include/elna/boot/symbol.h @@ -31,7 +31,6 @@ namespace elna::boot class alias_type; class primitive_type; class record_type; - class union_type; class pointer_type; class array_type; class procedure_type; @@ -45,7 +44,6 @@ namespace elna::boot alias, primitive, record, - _union, pointer, array, procedure, @@ -57,7 +55,6 @@ namespace elna::boot std::weak_ptr alias; std::shared_ptr primitive; std::shared_ptr record; - std::shared_ptr _union; std::shared_ptr pointer; std::shared_ptr array; std::shared_ptr procedure; @@ -72,7 +69,6 @@ namespace elna::boot explicit type(std::shared_ptr alias); explicit type(std::shared_ptr primitive); explicit type(std::shared_ptr record); - explicit type(std::shared_ptr _union); explicit type(std::shared_ptr pointer); explicit type(std::shared_ptr array); explicit type(std::shared_ptr procedure); @@ -135,11 +131,6 @@ namespace elna::boot explicit record_type(type base = type()); }; - struct union_type - { - std::vector fields; - }; - struct procedure_type { using return_t = return_declaration; diff --git a/source/cstdio.elna b/source/cstdio.elna index 95283a1..346d931 100644 --- a/source/cstdio.elna +++ b/source/cstdio.elna @@ -34,6 +34,9 @@ extern proc fwrite*(ptr: Pointer; size: Word; nitems: Word; stream: ^FILE): Word extern +proc fputc(c: Int; stream: ^FILE): Word +extern + proc perror(s: ^Char) extern @@ -43,4 +46,13 @@ extern proc putchar(c: Int): Int extern +proc sprintf(str: Pointer; format: ^Char; number: Word): Int +extern + +proc fprintf(stream: Pointer; format: ^Char; number: Word): Int +extern + +proc fdopen(fildes: Int; mode: ^Char): Pointer +extern + end. diff --git a/source/cstdlib.elna b/source/cstdlib.elna index 696e5dd..32669c1 100644 --- a/source/cstdlib.elna +++ b/source/cstdlib.elna @@ -2,22 +2,22 @@ v. 2.0. If a copy of the MPL was not distributed with this file, You can obtain one at https://mozilla.org/MPL/2.0/. *) -proc malloc(size: Word): Pointer +proc malloc*(size: Word): Pointer extern -proc free(ptr: Pointer) +proc free*(ptr: Pointer) extern -proc calloc(nmemb: Word; size: Word): Pointer +proc calloc*(nmemb: Word; size: Word): Pointer extern -proc realloc(ptr: Pointer; size: Word): Pointer +proc realloc*(ptr: Pointer; size: Word): Pointer extern -proc atoi(str: ^Char): Int +proc atoi*(str: ^Char): Int extern -proc exit(code: Int): ! +proc exit*(code: Int): ! extern end. diff --git a/source/cstring.elna b/source/cstring.elna index ec5cd7b..e21056a 100644 --- a/source/cstring.elna +++ b/source/cstring.elna @@ -2,25 +2,28 @@ v. 2.0. If a copy of the MPL was not distributed with this file, You can obtain one at https://mozilla.org/MPL/2.0/. *) -proc memset(ptr: Pointer; c: Int; n: Word): ^Char +proc memset*(ptr: Pointer; c: Int; n: Word): ^Char extern -proc memcpy(dst: Pointer; src: Pointer; n: Word) +proc memcpy*(dst, src: Pointer; n: Word) extern -proc strcmp(s1: ^Char; s2: ^Char): Int +proc memcmp*(s1, s2: Pointer; n: Word): Int extern -proc strncmp(s1: ^Char; s2: ^Char; n: Word): Int +proc strcmp*(s1: ^Char; s2: ^Char): Int extern -proc strncpy(dst: ^Char; src: ^Char; dsize: Word): ^Char +proc strncmp*(s1: ^Char; s2: ^Char; n: Word): Int extern -proc strcpy(dst: ^Char; src: ^Char): ^Char +proc strncpy*(dst: ^Char; src: ^Char; dsize: Word): ^Char extern -proc strlen(ptr: ^Char): Word +proc strcpy*(dst: ^Char; src: ^Char): ^Char +extern + +proc strlen*(ptr: ^Char): Word extern end. diff --git a/source/lexer.elna b/source/lexer.elna index bb8c8ef..3b015ad 100644 --- a/source/lexer.elna +++ b/source/lexer.elna @@ -2,77 +2,53 @@ v. 2.0. If a copy of the MPL was not distributed with this file, You can obtain one at https://mozilla.org/MPL/2.0/. *) -import cstdio, cstring, cctype, cstdlib, common +import cstdio, common const CHUNK_SIZE := 85536u type - (* - * Classification table assigns each possible character to a group (class). All - * characters of the same group are handled equivalently. - * - * Classification: - *) - TransitionClass = ( - invalid, - digit, - alpha, - space, - colon, - equals, - left_paren, - right_paren, - asterisk, - underscore, - single, - hex, - zero, - x, - eof, - dot, - minus, - single_quote, - double_quote, - greater, - less, - other - ) - TransitionState = ( - start, - colon, - identifier, - decimal, - greater, - minus, - left_paren, - less, - dot, - comment, - closing_comment, - character, - string, - leading_zero, - decimal_suffix, - finish - ) - LexerToken = record - kind: LexerKind; - value: union - booleanKind: Bool; - identifierKind: Identifier; - integerKind: Int; - stringKind: String - end; - start_location: TextLocation; - end_location: TextLocation + ElnaLexerState = ( + start, + colon, + identifier, + decimal, + leading_zero, + greater, + minus, + left_paren, + less, + dot, + comment, + closing_comment, + character, + character_escape, + string, + string_escape, + number_sign, + trait, + finish + ) + ElnaLexerToken* = record + kind: ElnaLexerKind end - TransitionAction = proc(lexer: ^Lexer; token: ^LexerToken) - Transition = record + ElnaLexerBooleanToken* = record(ElnaLexerToken) + value: Bool + end + ElnaLexerCharacterToken* = record(ElnaLexerToken) + value: Char + end + ElnaLexerStringToken* = record(ElnaLexerToken) + value: String + end + ElnaLexerIntegerToken* = record(ElnaLexerToken) + value: Int + end + TransitionAction = proc(lexer: ^Lexer; token: ^ElnaLexerToken) + ElnaLexerTransition = record action: TransitionAction; - next_state: TransitionState + next_state: ElnaLexerState end - TransitionClasses = [22]Transition BufferPosition* = record iterator: ^Char; @@ -86,866 +62,96 @@ type start: BufferPosition; current: BufferPosition end - LexerKind* = ( - unknown, - identifier, - _if, - _then, - _else, - _elsif, - _while, - _do, - _proc, - _begin, - _end, - _extern, - _const, - _var, - _case, - _of, - _type, - _record, - _union, - pipe, - to, - boolean, - null, - and, - _or, - _xor, - not, - _return, - _cast, - shift_left, - shift_right, - left_paren, - right_paren, - left_square, - right_square, - greater_equal, - less_equal, - greater_than, - less_than, - not_equal, - equal, - semicolon, - dot, - comma, - plus, - minus, - multiplication, - division, - remainder, - assignment, - colon, - hat, - at, - comment, - integer, - word, - character, - string, + ElnaLexerKind* = ( + identifier, + _const, + _var, + _proc, + _type, + _begin, + _end, + _if, + _then, + _else, + _elsif, + _extern, + _record, + boolean, + null, + and, + _or, + _xor, + not, + _return, + _cast, + trait, + left_paren, + right_paren, + left_square, + right_square, + greater_equal, + less_equal, + greater_than, + less_than, + not_equal, + equals, + semicolon, + dot, + comma, + plus, + _import, + minus, + multiplication, + division, + remainder, + assignment, + colon, + hat, + at, + comment, + string, + character, + integer, + word, + _while, _defer, exclamation, - arrow, - trait, - _program, - _module, - _import - ) - -var - classification: [128]TransitionClass - transitions: [16]TransitionClasses - -proc initialize_classification() -var - i: Word -begin - classification[1] := TransitionClass.eof; (* NUL *) - classification[2] := TransitionClass.invalid; (* SOH *) - classification[3] := TransitionClass.invalid; (* STX *) - classification[4] := TransitionClass.invalid; (* ETX *) - classification[5] := TransitionClass.invalid; (* EOT *) - classification[6] := TransitionClass.invalid; (* EMQ *) - classification[7] := TransitionClass.invalid; (* ACK *) - classification[8] := TransitionClass.invalid; (* BEL *) - classification[9] := TransitionClass.invalid; (* BS *) - classification[10] := TransitionClass.space; (* HT *) - classification[11] := TransitionClass.space; (* LF *) - classification[12] := TransitionClass.invalid; (* VT *) - classification[13] := TransitionClass.invalid; (* FF *) - classification[14] := TransitionClass.space; (* CR *) - classification[15] := TransitionClass.invalid; (* SO *) - classification[16] := TransitionClass.invalid; (* SI *) - classification[17] := TransitionClass.invalid; (* DLE *) - classification[18] := TransitionClass.invalid; (* DC1 *) - classification[19] := TransitionClass.invalid; (* DC2 *) - classification[20] := TransitionClass.invalid; (* DC3 *) - classification[21] := TransitionClass.invalid; (* DC4 *) - classification[22] := TransitionClass.invalid; (* NAK *) - classification[23] := TransitionClass.invalid; (* SYN *) - classification[24] := TransitionClass.invalid; (* ETB *) - classification[25] := TransitionClass.invalid; (* CAN *) - classification[26] := TransitionClass.invalid; (* EM *) - classification[27] := TransitionClass.invalid; (* SUB *) - classification[28] := TransitionClass.invalid; (* ESC *) - classification[29] := TransitionClass.invalid; (* FS *) - classification[30] := TransitionClass.invalid; (* GS *) - classification[31] := TransitionClass.invalid; (* RS *) - classification[32] := TransitionClass.invalid; (* US *) - classification[33] := TransitionClass.space; (* Space *) - classification[34] := TransitionClass.single; (* ! *) - classification[35] := TransitionClass.double_quote; (* " *) - classification[36] := TransitionClass.other; (* # *) - classification[37] := TransitionClass.other; (* $ *) - classification[38] := TransitionClass.single; (* % *) - classification[39] := TransitionClass.single; (* & *) - classification[40] := TransitionClass.single_quote; (* ' *) - classification[41] := TransitionClass.left_paren; (* ( *) - classification[42] := TransitionClass.right_paren; (* ) *) - classification[43] := TransitionClass.asterisk; (* * *) - classification[44] := TransitionClass.single; (* + *) - classification[45] := TransitionClass.single; (* , *) - classification[46] := TransitionClass.minus; (* - *) - classification[47] := TransitionClass.dot; (* . *) - classification[48] := TransitionClass.single; (* / *) - classification[49] := TransitionClass.zero; (* 0 *) - classification[50] := TransitionClass.digit; (* 1 *) - classification[51] := TransitionClass.digit; (* 2 *) - classification[52] := TransitionClass.digit; (* 3 *) - classification[53] := TransitionClass.digit; (* 4 *) - classification[54] := TransitionClass.digit; (* 5 *) - classification[55] := TransitionClass.digit; (* 6 *) - classification[56] := TransitionClass.digit; (* 7 *) - classification[57] := TransitionClass.digit; (* 8 *) - classification[58] := TransitionClass.digit; (* 9 *) - classification[59] := TransitionClass.colon; (* : *) - classification[60] := TransitionClass.single; (* ; *) - classification[61] := TransitionClass.less; (* < *) - classification[62] := TransitionClass.equals; (* = *) - classification[63] := TransitionClass.greater; (* > *) - classification[64] := TransitionClass.other; (* ? *) - classification[65] := TransitionClass.single; (* @ *) - classification[66] := TransitionClass.alpha; (* A *) - classification[67] := TransitionClass.alpha; (* B *) - classification[68] := TransitionClass.alpha; (* C *) - classification[69] := TransitionClass.alpha; (* D *) - classification[70] := TransitionClass.alpha; (* E *) - classification[71] := TransitionClass.alpha; (* F *) - classification[72] := TransitionClass.alpha; (* G *) - classification[73] := TransitionClass.alpha; (* H *) - classification[74] := TransitionClass.alpha; (* I *) - classification[75] := TransitionClass.alpha; (* J *) - classification[76] := TransitionClass.alpha; (* K *) - classification[77] := TransitionClass.alpha; (* L *) - classification[78] := TransitionClass.alpha; (* M *) - classification[79] := TransitionClass.alpha; (* N *) - classification[80] := TransitionClass.alpha; (* O *) - classification[81] := TransitionClass.alpha; (* P *) - classification[82] := TransitionClass.alpha; (* Q *) - classification[83] := TransitionClass.alpha; (* R *) - classification[84] := TransitionClass.alpha; (* S *) - classification[85] := TransitionClass.alpha; (* T *) - classification[86] := TransitionClass.alpha; (* U *) - classification[87] := TransitionClass.alpha; (* V *) - classification[88] := TransitionClass.alpha; (* W *) - classification[89] := TransitionClass.alpha; (* X *) - classification[90] := TransitionClass.alpha; (* Y *) - classification[91] := TransitionClass.alpha; (* Z *) - classification[92] := TransitionClass.single; (* [ *) - classification[93] := TransitionClass.other; (* \ *) - classification[94] := TransitionClass.single; (* ] *) - classification[95] := TransitionClass.single; (* ^ *) - classification[96] := TransitionClass.underscore; (* _ *) - classification[97] := TransitionClass.other; (* ` *) - classification[98] := TransitionClass.hex; (* a *) - classification[99] := TransitionClass.hex; (* b *) - classification[100] := TransitionClass.hex; (* c *) - classification[101] := TransitionClass.hex; (* d *) - classification[102] := TransitionClass.hex; (* e *) - classification[103] := TransitionClass.hex; (* f *) - classification[104] := TransitionClass.alpha; (* g *) - classification[105] := TransitionClass.alpha; (* h *) - classification[106] := TransitionClass.alpha; (* i *) - classification[107] := TransitionClass.alpha; (* j *) - classification[108] := TransitionClass.alpha; (* k *) - classification[109] := TransitionClass.alpha; (* l *) - classification[110] := TransitionClass.alpha; (* m *) - classification[111] := TransitionClass.alpha; (* n *) - classification[112] := TransitionClass.alpha; (* o *) - classification[113] := TransitionClass.alpha; (* p *) - classification[114] := TransitionClass.alpha; (* q *) - classification[115] := TransitionClass.alpha; (* r *) - classification[116] := TransitionClass.alpha; (* s *) - classification[117] := TransitionClass.alpha; (* t *) - classification[118] := TransitionClass.alpha; (* u *) - classification[119] := TransitionClass.alpha; (* v *) - classification[120] := TransitionClass.alpha; (* w *) - classification[121] := TransitionClass.x; (* x *) - classification[122] := TransitionClass.alpha; (* y *) - classification[123] := TransitionClass.alpha; (* z *) - classification[124] := TransitionClass.other; (* { *) - classification[125] := TransitionClass.single; (* | *) - classification[126] := TransitionClass.other; (* } *) - classification[127] := TransitionClass.single; (* ~ *) - classification[128] := TransitionClass.invalid; (* DEL *) - - i := 129u; - while i <= 256u do - classification[i] := TransitionClass.other; - i := i + 1u - end -end - -proc compare_keyword(keyword: String; token_start: BufferPosition; token_end: ^Char): Bool -var - result: Bool - index: Word - continue: Bool -begin - index := 0u; - result := true; - continue := (index < keyword.length) & (token_start.iterator <> token_end); - - while continue & result do - result := keyword[index] = token_start.iterator^ - or cast(tolower(cast(keyword[index]: Int)): Char) = token_start.iterator^; - token_start.iterator := token_start.iterator + 1; - index := index + 1u; - continue := (index < keyword.length) & (token_start.iterator <> token_end) - end; - result := result & index = keyword.length; - - return result & (token_start.iterator = token_end) -end - -(* Reached the end of file. *) -proc transition_action_eof(lexer: ^Lexer; token: ^LexerToken) -begin - token^.kind := LexerKind.unknown -end - -proc increment(position: ^BufferPosition) -begin - position^.iterator := position^.iterator + 1 -end - -(* Add the character to the token currently read and advance to the next character. *) -proc transition_action_accumulate(lexer: ^Lexer; token: ^LexerToken) -begin - increment(@lexer^.current) -end - -(* The current character is not a part of the token. Finish the token already - * read. Don't advance to the next character. *) -proc transition_action_finalize(lexer: ^Lexer; token: ^LexerToken) -begin - if lexer^.start.iterator^ = ':' then - token^.kind := LexerKind.colon - end; - if lexer^.start.iterator^ = '>' then - token^.kind := LexerKind.greater_than - end; - if lexer^.start.iterator^ = '<' then - token^.kind := LexerKind.less_than - end; - if lexer^.start.iterator^ = '(' then - token^.kind := LexerKind.left_paren - end; - if lexer^.start.iterator^ = '-' then - token^.kind := LexerKind.minus - end; - if lexer^.start.iterator^ = '.' then - token^.kind := LexerKind.dot - end -end - -(* An action for tokens containing multiple characters. *) -proc transition_action_composite(lexer: ^Lexer; token: ^LexerToken) -begin - if lexer^.start.iterator^ = '<' then - if lexer^.current.iterator^ = '>' then - token^.kind := LexerKind.not_equal - end; - if lexer^.current.iterator^ = '=' then - token^.kind := LexerKind.less_equal - end - end; - if (lexer^.start.iterator^ = '>') & (lexer^.current.iterator^ = '=') then - token^.kind := LexerKind.greater_equal - end; - if (lexer^.start.iterator^ = ':') & (lexer^.current.iterator^ = '=') then - token^.kind := LexerKind.assignment - end; - if (lexer^.start.iterator^ = '-') & (lexer^.current.iterator^ = '>') then - token^.kind := LexerKind.arrow - end; - increment(@lexer^.current) -end - -(* Skip a space. *) -proc transition_action_skip(lexer: ^Lexer; token: ^LexerToken) -begin - increment(@lexer^.start); - - if lexer^.start.iterator^ = '\n' then - lexer^.start.location.line := lexer^.start.location.line + 1u; - lexer^.start.location.column := 1u - end; - lexer^.current := lexer^.start -end - -(* Delimited string action. *) -proc transition_action_delimited(lexer: ^Lexer; token: ^LexerToken) -var - text_length: Word -begin - if lexer^.start.iterator^ = '(' then - token^.kind := LexerKind.comment - end; - if lexer^.start.iterator^ = '"' then - text_length := cast(lexer^.current.iterator - lexer^.start.iterator + 1: Word); - - token^.value.stringKind := String(cast(malloc(text_length): ^Char), text_length); - memcpy(token^.value.stringKind.ptr, lexer^.start.iterator, text_length); - - token^.kind := LexerKind.character - end; - if lexer^.start.iterator^ = '\'' then - text_length := cast(lexer^.current.iterator - lexer^.start.iterator + 1: Word); - - token^.value.stringKind := String(cast(malloc(text_length): ^Char), text_length); - memcpy(token^.value.stringKind.ptr, lexer^.start.iterator, text_length); - - token^.kind := LexerKind.string - end; - increment(@lexer^.current) -end - -(* Finalize keyword or identifier. *) -proc transition_action_key_id(lexer: ^Lexer; token: ^LexerToken) -begin - token^.kind := LexerKind.identifier; - - token^.value.identifierKind[1] := cast(lexer^.current.iterator - lexer^.start.iterator: Char); - memcpy(@token^.value.identifierKind[2], lexer^.start.iterator, cast(token^.value.identifierKind[1]: Word)); - - if compare_keyword("program", lexer^.start, lexer^.current.iterator) then - token^.kind := LexerKind._program - end; - if compare_keyword("import", lexer^.start, lexer^.current.iterator) then - token^.kind := LexerKind._import - end; - if compare_keyword("const", lexer^.start, lexer^.current.iterator) then - token^.kind := LexerKind._const - end; - if compare_keyword("var", lexer^.start, lexer^.current.iterator) then - token^.kind := LexerKind._var - end; - if compare_keyword("if", lexer^.start, lexer^.current.iterator) then - token^.kind := LexerKind._if - end; - if compare_keyword("then", lexer^.start, lexer^.current.iterator) then - token^.kind := LexerKind._then - end; - if compare_keyword("elsif", lexer^.start, lexer^.current.iterator) then - token^.kind := LexerKind._elsif - end; - if compare_keyword("else", lexer^.start, lexer^.current.iterator) then - token^.kind := LexerKind._else - end; - if compare_keyword("while", lexer^.start, lexer^.current.iterator) then - token^.kind := LexerKind._while - end; - if compare_keyword("do", lexer^.start, lexer^.current.iterator) then - token^.kind := LexerKind._do - end; - if compare_keyword("proc", lexer^.start, lexer^.current.iterator) then - token^.kind := LexerKind._proc - end; - if compare_keyword("begin", lexer^.start, lexer^.current.iterator) then - token^.kind := LexerKind._begin - end; - if compare_keyword("end", lexer^.start, lexer^.current.iterator) then - token^.kind := LexerKind._end - end; - if compare_keyword("type", lexer^.start, lexer^.current.iterator) then - token^.kind := LexerKind._type - end; - if compare_keyword("record", lexer^.start, lexer^.current.iterator) then - token^.kind := LexerKind._record - end; - if compare_keyword("union", lexer^.start, lexer^.current.iterator) then - token^.kind := LexerKind._union - end; - if compare_keyword("NIL", lexer^.start, lexer^.current.iterator) then - token^.kind := LexerKind.null - end; - if compare_keyword("or", lexer^.start, lexer^.current.iterator) then - token^.kind := LexerKind._or - end; - if compare_keyword("return", lexer^.start, lexer^.current.iterator) then - token^.kind := LexerKind._return - end; - if compare_keyword("defer", lexer^.start, lexer^.current.iterator) then - token^.kind := LexerKind._defer - end; - if compare_keyword("TO", lexer^.start, lexer^.current.iterator) then - token^.kind := LexerKind.to - end; - if compare_keyword("CASE", lexer^.start, lexer^.current.iterator) then - token^.kind := LexerKind._case - end; - if compare_keyword("OF", lexer^.start, lexer^.current.iterator) then - token^.kind := LexerKind._of - end; - if compare_keyword("module", lexer^.start, lexer^.current.iterator) then - token^.kind := LexerKind._module - end; - if compare_keyword("xor", lexer^.start, lexer^.current.iterator) then - token^.kind := LexerKind._xor - end; - if compare_keyword("TRUE", lexer^.start, lexer^.current.iterator) then - token^.kind := LexerKind.boolean; - token^.value.booleanKind := true - end; - if compare_keyword("FALSE", lexer^.start, lexer^.current.iterator) then - token^.kind := LexerKind.boolean; - token^.value.booleanKind := false - end -end - -(* Action for tokens containing only one character. The character cannot be - * followed by other characters forming a composite token. *) -proc transition_action_single(lexer: ^Lexer; token: ^LexerToken) -begin - if lexer^.current.iterator^ = '&' then - token^.kind := LexerKind.and - end; - if lexer^.current.iterator^ = ';' then - token^.kind := LexerKind.semicolon - end; - if lexer^.current.iterator^ = ',' then - token^.kind := LexerKind.comma - end; - if lexer^.current.iterator^ = '~' then - token^.kind := LexerKind.not - end; - if lexer^.current.iterator^ = ')' then - token^.kind := LexerKind.right_paren - end; - if lexer^.current.iterator^ = '[' then - token^.kind := LexerKind.left_square - end; - if lexer^.current.iterator^ = ']' then - token^.kind := LexerKind.right_square - end; - if lexer^.current.iterator^ = '^' then - token^.kind := LexerKind.hat - end; - if lexer^.current.iterator^ = '=' then - token^.kind := LexerKind.equal - end; - if lexer^.current.iterator^ = '+' then - token^.kind := LexerKind.plus - end; - if lexer^.current.iterator^ = '*' then - token^.kind := LexerKind.multiplication - end; - if lexer^.current.iterator^ = '/' then - token^.kind := LexerKind.division - end; - if lexer^.current.iterator^ = '%' then - token^.kind := LexerKind.remainder - end; - if lexer^.current.iterator^ = '@' then - token^.kind := LexerKind.at - end; - if lexer^.current.iterator^ = '|' then - token^.kind := LexerKind.pipe - end; - increment(@lexer^.current) -end - -(* Handle an integer literal. *) -proc transition_action_integer(lexer: ^Lexer; token: ^LexerToken) -var - buffer: String - integer_length: Word - found: Bool -begin - token^.kind := LexerKind.integer; - - integer_length := cast(lexer^.current.iterator - lexer^.start.iterator: Word); - memset(cast(token^.value.identifierKind.ptr: Pointer), 0, #size(Identifier)); - memcpy(@token^.value.identifierKind[1], lexer^.start.iterator, integer_length); - - token^.value.identifierKind[cast(token^.value.identifierKind[1]: Int) + 2] := '\0'; - token^.value.integerKind := atoi(@token^.value.identifierKind[2]) -end - -proc set_default_transition(current_state: TransitionState; default_action: TransitionAction; next_state: TransitionState): Int -var - default_transition: Transition - state_index: Int -begin - default_transition.action := default_action; - default_transition.next_state := next_state; - state_index := cast(current_state: Int) + 1; - - transitions[state_index][cast(TransitionClass.invalid: Int) + 1] := default_transition; - transitions[state_index][cast(TransitionClass.digit: Int) + 1] := default_transition; - transitions[state_index][cast(TransitionClass.alpha: Int) + 1] := default_transition; - transitions[state_index][cast(TransitionClass.space: Int) + 1] := default_transition; - transitions[state_index][cast(TransitionClass.colon: Int) + 1] := default_transition; - transitions[state_index][cast(TransitionClass.equals: Int) + 1] := default_transition; - transitions[state_index][cast(TransitionClass.left_paren: Int) + 1] := default_transition; - transitions[state_index][cast(TransitionClass.right_paren: Int) + 1] := default_transition; - transitions[state_index][cast(TransitionClass.asterisk: Int) + 1] := default_transition; - transitions[state_index][cast(TransitionClass.underscore: Int) + 1] := default_transition; - transitions[state_index][cast(TransitionClass.single: Int) + 1] := default_transition; - transitions[state_index][cast(TransitionClass.hex: Int) + 1] := default_transition; - transitions[state_index][cast(TransitionClass.zero: Int) + 1] := default_transition; - transitions[state_index][cast(TransitionClass.x: Int) + 1] := default_transition; - transitions[state_index][cast(TransitionClass.eof: Int) + 1] := default_transition; - transitions[state_index][cast(TransitionClass.dot: Int) + 1] := default_transition; - transitions[state_index][cast(TransitionClass.minus: Int) + 1] := default_transition; - transitions[state_index][cast(TransitionClass.single_quote: Int) + 1] := default_transition; - transitions[state_index][cast(TransitionClass.double_quote: Int) + 1] := default_transition; - transitions[state_index][cast(TransitionClass.greater: Int) + 1] := default_transition; - transitions[state_index][cast(TransitionClass.less: Int) + 1] := default_transition; - transitions[state_index][cast(TransitionClass.other: Int) + 1] := default_transition; - - return state_index -end - -(* - * The transition table describes transitions from one state to another, given - * a symbol (character class). - * - * The table has m rows and n columns, where m is the amount of states and n is - * the amount of classes. So given the current state and a classified character - * the table can be used to look up the next state. - * - * Each cell is a word long. - * - The least significant byte of the word is a row number (beginning with 0). - * It specifies the target state. "ff" means that this is an end state and no - * transition is possible. - * - The next byte is the action that should be performed when transitioning. - * For the meaning of actions see labels in the lex_next function, which - * handles each action. - *) -proc initialize_transitions() -var - state_index: Int -begin - (* Start state. *) - state_index := cast(TransitionState.start: Int) + 1; - - transitions[state_index][cast(TransitionClass.invalid: Int) + 1].action := nil; - transitions[state_index][cast(TransitionClass.invalid: Int) + 1].next_state := TransitionState.finish; - - transitions[state_index][cast(TransitionClass.digit: Int) + 1].action := transition_action_accumulate; - transitions[state_index][cast(TransitionClass.digit: Int) + 1].next_state := TransitionState.decimal; - - transitions[state_index][cast(TransitionClass.alpha: Int) + 1].action := transition_action_accumulate; - transitions[state_index][cast(TransitionClass.alpha: Int) + 1].next_state := TransitionState.identifier; - - transitions[state_index][cast(TransitionClass.space: Int) + 1].action := transition_action_skip; - transitions[state_index][cast(TransitionClass.space: Int) + 1].next_state := TransitionState.start; - - transitions[state_index][cast(TransitionClass.colon: Int) + 1].action := transition_action_accumulate; - transitions[state_index][cast(TransitionClass.colon: Int) + 1].next_state := TransitionState.colon; - - transitions[state_index][cast(TransitionClass.equals: Int) + 1].action := transition_action_single; - transitions[state_index][cast(TransitionClass.equals: Int) + 1].next_state := TransitionState.finish; - - transitions[state_index][cast(TransitionClass.left_paren: Int) + 1].action := transition_action_accumulate; - transitions[state_index][cast(TransitionClass.left_paren: Int) + 1].next_state := TransitionState.left_paren; - - transitions[state_index][cast(TransitionClass.right_paren: Int) + 1].action := transition_action_single; - transitions[state_index][cast(TransitionClass.right_paren: Int) + 1].next_state := TransitionState.finish; - - transitions[state_index][cast(TransitionClass.asterisk: Int) + 1].action := transition_action_single; - transitions[state_index][cast(TransitionClass.asterisk: Int) + 1].next_state := TransitionState.finish; - - transitions[state_index][cast(TransitionClass.underscore: Int) + 1].action := transition_action_accumulate; - transitions[state_index][cast(TransitionClass.underscore: Int) + 1].next_state := TransitionState.identifier; - - transitions[state_index][cast(TransitionClass.single: Int) + 1].action := transition_action_single; - transitions[state_index][cast(TransitionClass.single: Int) + 1].next_state := TransitionState.finish; - - transitions[state_index][cast(TransitionClass.hex: Int) + 1].action := transition_action_accumulate; - transitions[state_index][cast(TransitionClass.hex: Int) + 1].next_state := TransitionState.identifier; - - transitions[state_index][cast(TransitionClass.zero: Int) + 1].action := transition_action_accumulate; - transitions[state_index][cast(TransitionClass.zero: Int) + 1].next_state := TransitionState.leading_zero; - - transitions[state_index][cast(TransitionClass.x: Int) + 1].action := transition_action_accumulate; - transitions[state_index][cast(TransitionClass.x: Int) + 1].next_state := TransitionState.identifier; - - transitions[state_index][cast(TransitionClass.eof: Int) + 1].action := transition_action_eof; - transitions[state_index][cast(TransitionClass.eof: Int) + 1].next_state := TransitionState.finish; - - transitions[state_index][cast(TransitionClass.dot: Int) + 1].action := transition_action_accumulate; - transitions[state_index][cast(TransitionClass.dot: Int) + 1].next_state := TransitionState.dot; - - transitions[state_index][cast(TransitionClass.minus: Int) + 1].action := transition_action_accumulate; - transitions[state_index][cast(TransitionClass.minus: Int) + 1].next_state := TransitionState.minus; - - transitions[state_index][cast(TransitionClass.single_quote: Int) + 1].action := transition_action_accumulate; - transitions[state_index][cast(TransitionClass.single_quote: Int) + 1].next_state := TransitionState.character; - - transitions[state_index][cast(TransitionClass.double_quote: Int) + 1].action := transition_action_accumulate; - transitions[state_index][cast(TransitionClass.double_quote: Int) + 1].next_state := TransitionState.string; - - transitions[state_index][cast(TransitionClass.greater: Int) + 1].action := transition_action_accumulate; - transitions[state_index][cast(TransitionClass.greater: Int) + 1].next_state := TransitionState.greater; - - transitions[state_index][cast(TransitionClass.less: Int) + 1].action := transition_action_accumulate; - transitions[state_index][cast(TransitionClass.less: Int) + 1].next_state := TransitionState.less; - - transitions[state_index][cast(TransitionClass.other: Int) + 1].action := nil; - transitions[state_index][cast(TransitionClass.other: Int) + 1].next_state := TransitionState.finish; - - (* Colon state. *) - state_index := set_default_transition(TransitionState.colon, transition_action_finalize, TransitionState.finish); - - transitions[state_index][cast(TransitionClass.equals: Int) + 1].action := transition_action_composite; - transitions[state_index][cast(TransitionClass.equals: Int) + 1].next_state := TransitionState.finish; - - (* Identifier state. *) - state_index := set_default_transition(TransitionState.identifier, transition_action_key_id, TransitionState.finish); - - transitions[state_index][cast(TransitionClass.digit: Int) + 1].action := transition_action_accumulate; - transitions[state_index][cast(TransitionClass.digit: Int) + 1].next_state := TransitionState.identifier; - - transitions[state_index][cast(TransitionClass.alpha: Int) + 1].action := transition_action_accumulate; - transitions[state_index][cast(TransitionClass.alpha: Int) + 1].next_state := TransitionState.identifier; - - transitions[state_index][cast(TransitionClass.underscore: Int) + 1].action := transition_action_accumulate; - transitions[state_index][cast(TransitionClass.underscore: Int) + 1].next_state := TransitionState.identifier; - - transitions[state_index][cast(TransitionClass.hex: Int) + 1].action := transition_action_accumulate; - transitions[state_index][cast(TransitionClass.hex: Int) + 1].next_state := TransitionState.identifier; - - transitions[state_index][cast(TransitionClass.zero: Int) + 1].action := transition_action_accumulate; - transitions[state_index][cast(TransitionClass.zero: Int) + 1].next_state := TransitionState.identifier; - - transitions[state_index][cast(TransitionClass.x: Int) + 1].action := transition_action_accumulate; - transitions[state_index][cast(TransitionClass.x: Int) + 1].next_state := TransitionState.identifier; - - (* Decimal state. *) - state_index := set_default_transition(TransitionState.decimal, transition_action_integer, TransitionState.finish); - - transitions[state_index][cast(TransitionClass.digit: Int) + 1].action := transition_action_accumulate; - transitions[state_index][cast(TransitionClass.digit: Int) + 1].next_state := TransitionState.decimal; - - transitions[state_index][cast(TransitionClass.alpha: Int) + 1].action := transition_action_accumulate; - transitions[state_index][cast(TransitionClass.alpha: Int) + 1].next_state := TransitionState.decimal_suffix; - - transitions[state_index][cast(TransitionClass.underscore: Int) + 1].action := nil; - transitions[state_index][cast(TransitionClass.underscore: Int) + 1].next_state := TransitionState.finish; - - transitions[state_index][cast(TransitionClass.hex: Int) + 1].action := transition_action_accumulate; - transitions[state_index][cast(TransitionClass.hex: Int) + 1].next_state := TransitionState.decimal_suffix; - - transitions[state_index][cast(TransitionClass.zero: Int) + 1].action := transition_action_accumulate; - transitions[state_index][cast(TransitionClass.zero: Int) + 1].next_state := TransitionState.decimal; - - transitions[state_index][cast(TransitionClass.x: Int) + 1].action := transition_action_accumulate; - transitions[state_index][cast(TransitionClass.x: Int) + 1].next_state := TransitionState.decimal_suffix; - - (* Greater state. *) - state_index := set_default_transition(TransitionState.greater, transition_action_finalize, TransitionState.finish); - - transitions[state_index][cast(TransitionClass.equals: Int) + 1].action := transition_action_composite; - transitions[state_index][cast(TransitionClass.equals: Int) + 1].next_state := TransitionState.finish; - - (* Minus state. *) - state_index := set_default_transition(TransitionState.minus, transition_action_finalize, TransitionState.finish); - - transitions[state_index][cast(TransitionClass.greater: Int) + 1].action := transition_action_composite; - transitions[state_index][cast(TransitionClass.greater: Int) + 1].next_state := TransitionState.finish; - - (* Left paren state. *) - state_index := set_default_transition(TransitionState.left_paren, transition_action_finalize, TransitionState.finish); - - transitions[state_index][cast(TransitionClass.asterisk: Int) + 1].action := transition_action_accumulate; - transitions[state_index][cast(TransitionClass.asterisk: Int) + 1].next_state := TransitionState.comment; - - (* Less state. *) - state_index := set_default_transition(TransitionState.less, transition_action_finalize, TransitionState.finish); - - transitions[state_index][cast(TransitionClass.equals: Int) + 1].action := transition_action_composite; - transitions[state_index][cast(TransitionClass.equals: Int) + 1].next_state := TransitionState.finish; - - transitions[state_index][cast(TransitionClass.greater: Int) + 1].action := transition_action_composite; - transitions[state_index][cast(TransitionClass.greater: Int) + 1].next_state := TransitionState.finish; - - (* Hexadecimal after 0x. *) - state_index := set_default_transition(TransitionState.dot, transition_action_finalize, TransitionState.finish); - - transitions[state_index][cast(TransitionClass.dot: Int) + 1].action := transition_action_composite; - transitions[state_index][cast(TransitionClass.dot: Int) + 1].next_state := TransitionState.finish; - - (* Comment. *) - state_index := set_default_transition(TransitionState.comment, transition_action_accumulate, TransitionState.comment); - - transitions[state_index][cast(TransitionClass.asterisk: Int) + 1].action := transition_action_accumulate; - transitions[state_index][cast(TransitionClass.asterisk: Int) + 1].next_state := TransitionState.closing_comment; - - transitions[state_index][cast(TransitionClass.eof: Int) + 1].action := nil; - transitions[state_index][cast(TransitionClass.eof: Int) + 1].next_state := TransitionState.finish; - - (* Closing comment. *) - state_index := set_default_transition(TransitionState.closing_comment, transition_action_accumulate, TransitionState.comment); - - transitions[state_index][cast(TransitionClass.invalid: Int) + 1].action := nil; - transitions[state_index][cast(TransitionClass.invalid: Int) + 1].next_state := TransitionState.finish; - - transitions[state_index][cast(TransitionClass.right_paren: Int) + 1].action := transition_action_delimited; - transitions[state_index][cast(TransitionClass.right_paren: Int) + 1].next_state := TransitionState.finish; - - transitions[state_index][cast(TransitionClass.asterisk: Int) + 1].action := transition_action_accumulate; - transitions[state_index][cast(TransitionClass.asterisk: Int) + 1].next_state := TransitionState.closing_comment; - - transitions[state_index][cast(TransitionClass.eof: Int) + 1].action := nil; - transitions[state_index][cast(TransitionClass.eof: Int) + 1].next_state := TransitionState.finish; - - (* Character. *) - state_index := set_default_transition(TransitionState.character, transition_action_accumulate, TransitionState.character); - - transitions[state_index][cast(TransitionClass.invalid: Int) + 1].action := nil; - transitions[state_index][cast(TransitionClass.invalid: Int) + 1].next_state := TransitionState.finish; - - transitions[state_index][cast(TransitionClass.eof: Int) + 1].action := nil; - transitions[state_index][cast(TransitionClass.eof: Int) + 1].next_state := TransitionState.finish; - - transitions[state_index][cast(TransitionClass.single_quote: Int) + 1].action := transition_action_delimited; - transitions[state_index][cast(TransitionClass.single_quote: Int) + 1].next_state := TransitionState.finish; - - (* String. *) - state_index := set_default_transition(TransitionState.string, transition_action_accumulate, TransitionState.string); - - transitions[state_index][cast(TransitionClass.invalid: Int) + 1].action := nil; - transitions[state_index][cast(TransitionClass.invalid: Int) + 1].next_state := TransitionState.finish; - - transitions[state_index][cast(TransitionClass.eof: Int) + 1].action := nil; - transitions[state_index][cast(TransitionClass.eof: Int) + 1].next_state := TransitionState.finish; - - transitions[state_index][cast(TransitionClass.double_quote: Int) + 1].action := transition_action_delimited; - transitions[state_index][cast(TransitionClass.double_quote: Int) + 1].next_state := TransitionState.finish; - - (* Leading zero. *) - state_index := set_default_transition(TransitionState.leading_zero, transition_action_integer, TransitionState.finish); - - transitions[state_index][cast(TransitionClass.digit: Int) + 1].action := nil; - transitions[state_index][cast(TransitionClass.digit: Int) + 1].next_state := TransitionState.finish; - - transitions[state_index][cast(TransitionClass.alpha: Int) + 1].action := nil; - transitions[state_index][cast(TransitionClass.alpha: Int) + 1].next_state := TransitionState.finish; - - transitions[state_index][cast(TransitionClass.underscore: Int) + 1].action := nil; - transitions[state_index][cast(TransitionClass.underscore: Int) + 1].next_state := TransitionState.finish; - - transitions[state_index][cast(TransitionClass.hex: Int) + 1].action := nil; - transitions[state_index][cast(TransitionClass.hex: Int) + 1].next_state := TransitionState.finish; - - transitions[state_index][cast(TransitionClass.zero: Int) + 1].action := nil; - transitions[state_index][cast(TransitionClass.zero: Int) + 1].next_state := TransitionState.finish; - - transitions[state_index][cast(TransitionClass.x: Int) + 1].action := nil; - transitions[state_index][cast(TransitionClass.x: Int) + 1].next_state := TransitionState.finish; - - (* Digit with a character suffix. *) - state_index := set_default_transition(TransitionState.decimal_suffix, transition_action_integer, TransitionState.finish); - - transitions[state_index][cast(TransitionClass.alpha: Int) + 1].action := nil; - transitions[state_index][cast(TransitionClass.alpha: Int) + 1].next_state := TransitionState.finish; - - transitions[state_index][cast(TransitionClass.digit: Int) + 1].action := nil; - transitions[state_index][cast(TransitionClass.digit: Int) + 1].next_state := TransitionState.finish; - - transitions[state_index][cast(TransitionClass.hex: Int) + 1].action := nil; - transitions[state_index][cast(TransitionClass.hex: Int) + 1].next_state := TransitionState.finish; - - transitions[state_index][cast(TransitionClass.zero: Int) + 1].action := nil; - transitions[state_index][cast(TransitionClass.zero: Int) + 1].next_state := TransitionState.finish; - - transitions[state_index][cast(TransitionClass.x: Int) + 1].action := nil; - transitions[state_index][cast(TransitionClass.x: Int) + 1].next_state := TransitionState.finish -end - -proc lexer_make*(lexer: ^Lexer; input: ^FILE) -begin - lexer^.input := input; - lexer^.length := 0u; - - lexer^.buffer := cast(malloc(CHUNK_SIZE): ^Char); - memset(cast(lexer^.buffer: Pointer), 0, CHUNK_SIZE); - lexer^.size := CHUNK_SIZE -end - -(* Returns the last read token. *) -proc lexer_current*(lexer: ^Lexer): LexerToken -var - current_class: TransitionClass - current_state: TransitionState - current_transition: Transition - result: LexerToken - index1: Word - index2: Word -begin - lexer^.current := lexer^.start; - current_state := TransitionState.start; - - while current_state <> TransitionState.finish do - index1 := cast(lexer^.current.iterator^: Word) + 1u; - current_class := classification[index1]; - - index1 := cast(current_state: Word) + 1u; - index2 := cast(current_class: Word) + 1u; - - current_transition := transitions[index1][index2]; - if current_transition.action <> nil then - current_transition.action(lexer, @result) - end; - current_state := current_transition.next_state - end; - result.start_location := lexer^.start.location; - result.end_location := lexer^.current.location; - - return result -end - -(* Read and return the next token. *) -proc lexer_lex*(lexer: ^Lexer): LexerToken -var - result: LexerToken -begin - if lexer^.length = 0u then - lexer^.length := fread(cast(lexer^.buffer: Pointer), CHUNK_SIZE, 1u, lexer^.input); - lexer^.current.location.column := 1u; - lexer^.current.location.line := 1u; - lexer^.current.iterator := lexer^.buffer - end; - lexer^.start := lexer^.current; - - result := lexer_current(lexer); - return result -end - -proc lexer_destroy*(lexer: ^Lexer) -begin - free(cast(lexer^.buffer: Pointer)) -end - -proc lexer_initialize() -begin - initialize_classification(); - initialize_transitions() -end + shift_right, + shift_left, + pipe, + _case, + _do, + _of, + eof + ) + (** + * Classification table assigns each possible character to a group (class). All + * characters of the same group a handled equivalently. + *) + ElnaLexerClass = ( + invalid, + digit, + alpha, + space, + colon, + equals, + left_paren, + right_paren, + asterisk, + backslash, + single, + hex, + zero, + x, + eof, + dot, + minus, + single_quote, + double_quote, + greater, + less, + other, + number_sign + ) end. diff --git a/source/main.elna b/source/main.elna index aeaba2f..781d681 100644 --- a/source/main.elna +++ b/source/main.elna @@ -24,18 +24,9 @@ type advance: proc(stream: Pointer); head: proc(stream: Pointer): Char end - Token* = record - kind: LexerKind; - value: union - int_value: Int; - string: String; - boolean_value: Bool; - char_value: Char - end - end Tokenizer* = record length: Word; - data: ^Token + data: ^^ElnaLexerToken end (* @@ -57,7 +48,7 @@ proc string_dup(origin: String): String var copy: ^Char begin - copy := cast(malloc(origin.length): ^Char); + copy := malloc(origin.length); strncpy(copy, origin.ptr, origin.length); return String(copy, origin.length) @@ -326,92 +317,109 @@ begin end (* Categorize an identifier. *) -proc lexer_categorize(token_content: String): Token +proc lexer_categorize(token_content: String): ^ElnaLexerToken var - current_token: Token + current_token: ^ElnaLexerToken begin if token_content = "if" then - current_token.kind := LexerKind._if + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind._if elsif token_content = "then" then - current_token.kind := LexerKind._then + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind._then elsif token_content = "else" then - current_token.kind := LexerKind._else + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind._else elsif token_content = "elsif" then - current_token.kind := LexerKind._elsif + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind._elsif elsif token_content = "while" then - current_token.kind := LexerKind._while + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind._while elsif token_content = "do" then - current_token.kind := LexerKind._do + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind._do elsif token_content = "proc" then - current_token.kind := LexerKind._proc + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind._proc elsif token_content = "begin" then - current_token.kind := LexerKind._begin + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind._begin elsif token_content = "end" then - current_token.kind := LexerKind._end + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind._end elsif token_content = "extern" then - current_token.kind := LexerKind._extern + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind._extern elsif token_content = "const" then - current_token.kind := LexerKind._const + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind._const elsif token_content = "var" then - current_token.kind := LexerKind._var + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind._var elsif token_content = "case" then - current_token.kind := LexerKind._case + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind._case elsif token_content = "of" then - current_token.kind := LexerKind._of + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind._of elsif token_content = "type" then - current_token.kind := LexerKind._type + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind._type elsif token_content = "record" then - current_token.kind := LexerKind._record - elsif token_content = "union" then - current_token.kind := LexerKind._union + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind._record elsif token_content = "true" then - current_token.kind := LexerKind.boolean; - current_token.value.boolean_value := true + current_token := malloc(#size(ElnaLexerBooleanToken)); + current_token^.kind := ElnaLexerKind.boolean; + cast(current_token: ^ElnaLexerBooleanToken)^.value := true elsif token_content = "false" then - current_token.kind := LexerKind.boolean; - current_token.value.boolean_value := false + current_token := malloc(#size(ElnaLexerBooleanToken)); + current_token^.kind := ElnaLexerKind.boolean; + cast(current_token: ^ElnaLexerBooleanToken)^.value := false elsif token_content = "nil" then - current_token.kind := LexerKind.null + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind.null elsif token_content = "or" then - current_token.kind := LexerKind._or + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind._or elsif token_content = "return" then - current_token.kind := LexerKind._return + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind._return elsif token_content = "cast" then - current_token.kind := LexerKind._cast + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind._cast elsif token_content = "defer" then - current_token.kind := LexerKind._defer - elsif token_content = "program" then - current_token.kind := LexerKind._program - elsif token_content = "module" then - current_token.kind := LexerKind._module + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind._defer elsif token_content = "import" then - current_token.kind := LexerKind._import + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind._import else - current_token.kind := LexerKind.identifier; - current_token.value.string := string_dup(token_content) + current_token := malloc(#size(ElnaLexerStringToken)); + current_token^.kind := ElnaLexerKind.identifier; + cast(current_token: ^ElnaLexerStringToken)^.value := string_dup(token_content) end; return current_token end -proc lexer_add_token(lexer: ^Tokenizer; token: Token) +proc lexer_add_token(lexer: ^Tokenizer; token: ^ElnaLexerToken) var new_length: Word begin new_length := lexer^.length + 1u; - lexer^.data := cast(reallocarray(cast(lexer^.data: Pointer), new_length, #size(Token)): ^Token); + lexer^.data := cast(reallocarray(cast(lexer^.data: Pointer), new_length, #size(Pointer)): ^^ElnaLexerToken); (lexer^.data + lexer^.length)^ := token; lexer^.length := new_length end (* Read the next token from the input. *) -proc lexer_next(source_code: SourceCode; token_buffer: ^StringBuffer): Token +proc lexer_next(source_code: SourceCode; token_buffer: ^StringBuffer): ^ElnaLexerToken var - current_token: Token + current_token: ^ElnaLexerToken := nil first_char: Char begin - current_token.kind := LexerKind.unknown; - first_char := source_code_head(source_code); if isalpha(cast(first_char: Int)) <> 0 or first_char = '_' then @@ -421,158 +429,170 @@ begin source_code_advance(@source_code); lexer_identifier(@source_code, token_buffer); - current_token.kind := LexerKind.trait; - current_token.value.string := string_dup(string_buffer_clear(token_buffer)) + current_token := malloc(#size(ElnaLexerStringToken)); + current_token^.kind := ElnaLexerKind.trait; + cast(current_token: ^ElnaLexerStringToken)^.value := string_dup(string_buffer_clear(token_buffer)) elsif isdigit(cast(first_char: Int)) <> 0 then - lexer_number(@source_code, @current_token.value.int_value); + current_token := malloc(#size(ElnaLexerIntegerToken)); + lexer_number(@source_code, @cast(current_token: ^ElnaLexerIntegerToken)^.value); if source_code_expect(@source_code, 'u') then - current_token.kind := LexerKind.word; - source_code_advance(@source_code) + current_token^.kind := ElnaLexerKind.word; + source_code_advance(@source_code) else - current_token.kind := LexerKind.integer + current_token^.kind := ElnaLexerKind.integer end elsif first_char = '(' then source_code_advance(@source_code); if source_code_empty(@source_code) then - current_token.kind := LexerKind.left_paren + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind.left_paren elsif source_code_head(source_code) = '*' then source_code_advance(@source_code); if lexer_comment(@source_code, token_buffer) then - current_token.value.string := string_dup(string_buffer_clear(token_buffer)); - current_token.kind := LexerKind.comment - else - current_token.kind := LexerKind.unknown + current_token := malloc(#size(ElnaLexerStringToken)); + cast(current_token: ^ElnaLexerStringToken)^.value := string_dup(string_buffer_clear(token_buffer)); + current_token^.kind := ElnaLexerKind.comment end else - current_token.kind := LexerKind.left_paren + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind.left_paren end elsif first_char = ')' then - current_token.kind := LexerKind.right_paren; + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind.right_paren; source_code_advance(@source_code) elsif first_char = '\'' then source_code_advance(@source_code); - if lexer_character(@source_code, @current_token.value.char_value) & source_code_expect(@source_code, '\'') then - current_token.kind := LexerKind.character; + if lexer_character(@source_code, @first_char) & source_code_expect(@source_code, '\'') then + current_token := malloc(#size(ElnaLexerCharacterToken)); + current_token^.kind := ElnaLexerKind.character; + cast(current_token: ^ElnaLexerCharacterToken)^.value := first_char; source_code_advance(@source_code) - else - current_token.kind := LexerKind.unknown end elsif first_char = '"' then source_code_advance(@source_code); if lexer_string(@source_code, token_buffer) then - current_token.kind := LexerKind.string; - current_token.value.string := string_dup(string_buffer_clear(token_buffer)) - else - current_token.kind := LexerKind.unknown + current_token := malloc(#size(ElnaLexerStringToken)); + current_token^.kind := ElnaLexerKind.string; + cast(current_token: ^ElnaLexerStringToken)^.value := string_dup(string_buffer_clear(token_buffer)) end elsif first_char = '[' then - current_token.kind := LexerKind.left_square; + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind.left_square; source_code_advance(@source_code) elsif first_char = ']' then - current_token.kind := LexerKind.right_square; + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind.right_square; source_code_advance(@source_code) elsif first_char = '>' then source_code_advance(@source_code); + current_token := malloc(#size(ElnaLexerToken)); if source_code_empty(@source_code) then - current_token.kind := LexerKind.greater_than + current_token^.kind := ElnaLexerKind.greater_than elsif source_code_head(source_code) = '=' then - current_token.kind := LexerKind.greater_equal; + current_token^.kind := ElnaLexerKind.greater_equal; source_code_advance(@source_code) elsif source_code_head(source_code) = '>' then - current_token.kind := LexerKind.shift_right; + current_token^.kind := ElnaLexerKind.shift_right; source_code_advance(@source_code) else - current_token.kind := LexerKind.greater_than + current_token^.kind := ElnaLexerKind.greater_than end elsif first_char = '<' then source_code_advance(@source_code); + current_token := malloc(#size(ElnaLexerToken)); if source_code_empty(@source_code) then - current_token.kind := LexerKind.less_than + current_token^.kind := ElnaLexerKind.less_than elsif source_code_head(source_code) = '=' then - current_token.kind := LexerKind.less_equal; + current_token^.kind := ElnaLexerKind.less_equal; source_code_advance(@source_code) elsif source_code_head(source_code) = '<' then - current_token.kind := LexerKind.shift_left; + current_token^.kind := ElnaLexerKind.shift_left; source_code_advance(@source_code) elsif source_code_head(source_code) = '>' then - current_token.kind := LexerKind.not_equal; + current_token^.kind := ElnaLexerKind.not_equal; source_code_advance(@source_code) else - current_token.kind := LexerKind.less_than + current_token^.kind := ElnaLexerKind.less_than end elsif first_char = '=' then - current_token.kind := LexerKind.equal; + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind.equals; source_code_advance(@source_code) elsif first_char = ';' then - current_token.kind := LexerKind.semicolon; + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind.semicolon; source_code_advance(@source_code) elsif first_char = '.' then - current_token.kind := LexerKind.dot; + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind.dot; source_code_advance(@source_code) elsif first_char = ',' then - current_token.kind := LexerKind.comma; + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind.comma; source_code_advance(@source_code) elsif first_char = '+' then - current_token.kind := LexerKind.plus; + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind.plus; source_code_advance(@source_code) elsif first_char = '-' then source_code_advance(@source_code); - - if source_code_empty(@source_code) then - current_token.kind := LexerKind.minus - elsif source_code_head(source_code) = '>' then - current_token.kind := LexerKind.arrow; - source_code_advance(@source_code) - else - current_token.kind := LexerKind.minus - end + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind.minus elsif first_char = '*' then - current_token.kind := LexerKind.multiplication; + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind.multiplication; source_code_advance(@source_code) elsif first_char = '/' then - current_token.kind := LexerKind.division; + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind.division; source_code_advance(@source_code) elsif first_char = '%' then - current_token.kind := LexerKind.remainder; + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind.remainder; source_code_advance(@source_code) elsif first_char = ':' then source_code_advance(@source_code); + current_token := malloc(#size(ElnaLexerToken)); if source_code_empty(@source_code) then - current_token.kind := LexerKind.colon + current_token^.kind := ElnaLexerKind.colon elsif source_code_head(source_code) = '=' then - current_token.kind := LexerKind.assignment; + current_token^.kind := ElnaLexerKind.assignment; source_code_advance(@source_code) else - current_token.kind := LexerKind.colon + current_token^.kind := ElnaLexerKind.colon end elsif first_char = '^' then - current_token.kind := LexerKind.hat; + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind.hat; source_code_advance(@source_code) elsif first_char = '@' then - current_token.kind := LexerKind.at; + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind.at; source_code_advance(@source_code) elsif first_char = '!' then - current_token.kind := LexerKind.exclamation; + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind.exclamation; source_code_advance(@source_code) elsif first_char = '&' then - current_token.kind := LexerKind.and; + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind.and; source_code_advance(@source_code) elsif first_char = '~' then - current_token.kind := LexerKind.not; + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind.not; source_code_advance(@source_code) elsif first_char = '|' then - current_token.kind := LexerKind.pipe; - source_code_advance(@source_code) - else - current_token.kind := LexerKind.unknown; + current_token := malloc(#size(ElnaLexerToken)); + current_token^.kind := ElnaLexerKind.pipe; source_code_advance(@source_code) end; @@ -582,7 +602,7 @@ end (* Split the source text into tokens. *) proc lexer_text(source_code: SourceCode): Tokenizer var - current_token: Token + current_token: ^ElnaLexerToken token_buffer: StringBuffer lexer: Tokenizer begin @@ -594,7 +614,7 @@ begin while ~source_code_empty(@source_code) do current_token := lexer_next(source_code, @token_buffer); - if current_token.kind <> LexerKind.unknown then + if current_token <> nil then lexer_add_token(@lexer, current_token); lexer_spaces(@source_code) else @@ -611,151 +631,141 @@ end Parser. *) -proc parse(tokens: ^Token; tokens_size: Word) +proc parse(tokens: ^^ElnaLexerToken; tokens_size: Word) var - current_token: ^Token + current_token: ^ElnaLexerToken i: Word := 0u begin while i < tokens_size do - current_token := tokens + i; + current_token := (tokens + i)^; case current_token^.kind of - LexerKind._if: + ElnaLexerKind._if: write_s("IF") - | LexerKind._then: + | ElnaLexerKind._then: write_s("THEN") - | LexerKind._else: + | ElnaLexerKind._else: write_s("ELSE") - | LexerKind._elsif: + | ElnaLexerKind._elsif: write_s("ELSIF") - | LexerKind._while: + | ElnaLexerKind._while: write_s("WHILE") - | LexerKind._do: + | ElnaLexerKind._do: write_s("DO") - | LexerKind._proc: + | ElnaLexerKind._proc: write_s("PROC") - | LexerKind._begin: + | ElnaLexerKind._begin: write_s("BEGIN") - | LexerKind._end: + | ElnaLexerKind._end: write_s("END") - | LexerKind._extern: + | ElnaLexerKind._extern: write_s("EXTERN") - | LexerKind._const: + | ElnaLexerKind._const: write_s("CONST") - | LexerKind._var: + | ElnaLexerKind._var: write_s("VAR") - | LexerKind._case: + | ElnaLexerKind._case: write_s("CASE") - | LexerKind._of: + | ElnaLexerKind._of: write_s("OF") - | LexerKind._type: + | ElnaLexerKind._type: write_s("TYPE") - | LexerKind._record: + | ElnaLexerKind._record: write_s("RECORD") - | LexerKind._union: - write_s("UNION") - | LexerKind.pipe: + | ElnaLexerKind.pipe: write_s("|") - | LexerKind.to: - write_s("TO") - | LexerKind.boolean: + | ElnaLexerKind.boolean: write_s("BOOLEAN<"); - write_b(current_token^.value.boolean_value); + write_b(cast(current_token: ^ElnaLexerBooleanToken)^.value); write_c('>') - | LexerKind.null: + | ElnaLexerKind.null: write_s("NIL") - | LexerKind.and: + | ElnaLexerKind.and: write_s("&") - | LexerKind._or: + | ElnaLexerKind._or: write_s("OR") - | LexerKind.not: + | ElnaLexerKind.not: write_s("~") - | LexerKind._return: + | ElnaLexerKind._return: write_s("RETURN") - | LexerKind._cast: + | ElnaLexerKind._cast: write_s("CAST") - | LexerKind.shift_left: + | ElnaLexerKind.shift_left: write_s("<<") - | LexerKind.shift_right: + | ElnaLexerKind.shift_right: write_s(">>") - | LexerKind.identifier: + | ElnaLexerKind.identifier: write_c('<'); - write_s(current_token^.value.string); + write_s(cast(current_token: ^ElnaLexerStringToken)^.value); write_c('>') - | LexerKind.trait: + | ElnaLexerKind.trait: write_c('#'); - write_s(current_token^.value.string) - | LexerKind.left_paren: + write_s(cast(current_token: ^ElnaLexerStringToken)^.value) + | ElnaLexerKind.left_paren: write_s("(") - | LexerKind.right_paren: + | ElnaLexerKind.right_paren: write_s(")") - | LexerKind.left_square: + | ElnaLexerKind.left_square: write_s("[") - | LexerKind.right_square: + | ElnaLexerKind.right_square: write_s("]") - | LexerKind.greater_equal: + | ElnaLexerKind.greater_equal: write_s(">=") - | LexerKind.less_equal: + | ElnaLexerKind.less_equal: write_s("<=") - | LexerKind.greater_than: + | ElnaLexerKind.greater_than: write_s(">") - | LexerKind.less_than: + | ElnaLexerKind.less_than: write_s("<") - | LexerKind.equal: + | ElnaLexerKind.equals: write_s("=") - | LexerKind.not_equal: + | ElnaLexerKind.not_equal: write_s("<>") - | LexerKind.semicolon: + | ElnaLexerKind.semicolon: write_c(';') - | LexerKind.dot: + | ElnaLexerKind.dot: write_c('.') - | LexerKind.comma: + | ElnaLexerKind.comma: write_c(',') - | LexerKind.plus: + | ElnaLexerKind.plus: write_c('+') - | LexerKind.minus: + | ElnaLexerKind.minus: write_c('-') - | LexerKind.multiplication: + | ElnaLexerKind.multiplication: write_c('*') - | LexerKind.division: + | ElnaLexerKind.division: write_c('/') - | LexerKind.remainder: + | ElnaLexerKind.remainder: write_c('%') - | LexerKind.assignment: + | ElnaLexerKind.assignment: write_s(":=") - | LexerKind.colon: + | ElnaLexerKind.colon: write_c(':') - | LexerKind.hat: + | ElnaLexerKind.hat: write_c('^') - | LexerKind.at: + | ElnaLexerKind.at: write_c('@') - | LexerKind.comment: + | ElnaLexerKind.comment: write_s("(* COMMENT *)") - | LexerKind.integer: + | ElnaLexerKind.integer: write_c('<'); - write_i(current_token^.value.int_value); + write_i(cast(current_token: ^ElnaLexerIntegerToken)^.value); write_c('>') - | LexerKind.word: + | ElnaLexerKind.word: write_c('<'); - write_i(current_token^.value.int_value); + write_i(cast(current_token: ^ElnaLexerIntegerToken)^.value); write_s("u>") - | LexerKind.character: + | ElnaLexerKind.character: write_c('<'); - write_i(cast(current_token^.value.char_value: Int)); + write_i(cast(cast(current_token: ^ElnaLexerCharacterToken)^.value: Int)); write_s("c>") - | LexerKind.string: + | ElnaLexerKind.string: write_s("\"...\"") - | LexerKind._defer: + | ElnaLexerKind._defer: write_s("DEFER") - | LexerKind.exclamation: + | ElnaLexerKind.exclamation: write_c('!') - | LexerKind.arrow: - write_s("->") - | LexerKind._program: - write_s("PROGRAM") - | LexerKind._module: - write_s("MODULE") - | LexerKind._import: + | ElnaLexerKind._import: write_s("IMPORT") else write_s("UNKNOWN<"); @@ -790,7 +800,7 @@ end proc process(argc: Int; argv: ^^Char): Int var - tokens: ^Token + tokens: ^ElnaLexerToken tokens_size: Word source_code: SourceCode command_line: ^CommandLine @@ -817,7 +827,7 @@ begin end; source_code.position := TextLocation(1u, 1u); - source_code.input := cast(source_file: Pointer); + source_code.input := source_file; source_code.empty := source_file_empty; source_code.head := source_file_head; source_code.advance := source_file_advance; diff --git a/testsuite/runnable/record_extension.elna b/testsuite/runnable/record_extension.elna new file mode 100644 index 0000000..161361b --- /dev/null +++ b/testsuite/runnable/record_extension.elna @@ -0,0 +1,19 @@ +type + ElnaLexerToken = record + kind: Word + end + ElnaLexerStringToken = record(ElnaLexerToken) + value: String + end + +var + token_memory: ElnaLexerStringToken + current_token: ^ElnaLexerToken + +begin + current_token := @token_memory; + cast(current_token: ^ElnaLexerStringToken)^.value := "Some string"; + + assert(token_memory.value = "Some string"); + return 0 +end. -- cgit v1.2.3