diff options
| -rw-r--r-- | cl.elna | 6185 | ||||
| -rw-r--r-- | source/ast.elna | 270 | ||||
| -rw-r--r-- | source/common.elna | 8 | ||||
| -rw-r--r-- | source/diagnostic.elna | 241 | ||||
| -rw-r--r-- | source/lexer.elna | 15 | ||||
| -rw-r--r-- | source/main.elna | 912 | ||||
| -rw-r--r-- | source/name_analysis.elna | 539 | ||||
| -rw-r--r-- | source/parser.elna | 1162 | ||||
| -rw-r--r-- | source/qbe.elna | 635 | ||||
| -rw-r--r-- | source/symbol.elna | 200 | ||||
| -rw-r--r-- | source/tac.elna | 1074 | ||||
| -rw-r--r-- | source/type_check.elna | 315 |
12 files changed, 4570 insertions, 6986 deletions
diff --git a/cl.elna b/cl.elna deleted file mode 100644 index 2219a37..0000000 --- a/cl.elna +++ /dev/null @@ -1,6185 +0,0 @@ -(* - * 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 - - (** - * 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 - - 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 - - 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 - -(** - * 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 - -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 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/source/ast.elna b/source/ast.elna new file mode 100644 index 0000000..ddae997 --- /dev/null +++ b/source/ast.elna @@ -0,0 +1,270 @@ +(* 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/. *) +module +import common, lexer + +type + ElnaListNode* = record + next: ^ElnaListNode + end + ElnaList* = record + first: ^ElnaListNode; + last: ^ElnaListNode + end + + (* Type representation. *) + ElnaTypeKind* = (primitive, enumeration, _record, pointer, array, alias, procedure) + ElnaType* = record + kind: ElnaTypeKind; + size: Word; + alignment: Word + end + ElnaTypeAlias* = record(ElnaType) + base: ^ElnaType + end + ElnaTypeEnumeration* = record(ElnaType) + members: ^[]const Word8; + length: Word + end + ElnaTypeField* = record + name: []const Word8; + field_type: ^ElnaType + end + ElnaTypeRecord* = record(ElnaType) + members: ^ElnaTypeField; + length: Word + end + ElnaTypePointer* = record(ElnaType) + base: ^ElnaType + end + ElnaTypeArray* = record(ElnaType) + base: ^ElnaType; + length: Word + end + ElnaTypeProcedure* = record(ElnaType) + 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(ElnaTreeNode) + end + ElnaTreeExpression* = record(ElnaTreeNode) + type_decoration: ^ElnaType + end + ElnaTreeIntegerLiteral* = record(ElnaTreeExpression) + value: Word + end + ElnaTreeCharacterLiteral* = record(ElnaTreeExpression) + value: Word8 + end + ElnaTreeNilLiteral* = record(ElnaTreeExpression) + end + ElnaTreeBooleanLiteral* = record(ElnaTreeExpression) + value: Bool + end + ElnaTreeStringLiteral* = record(ElnaTreeExpression) + value: []const Word8 + end + ElnaTreeVariableExpression* = record(ElnaTreeExpression) + name: []const Word8 + end + ElnaTreeCastExpression* = record(ElnaTreeExpression) + expression: ^ElnaTreeExpression; + type_expression: ^ElnaTreeTypeExpression + end + ElnaTreeDereferenceExpression* = record(ElnaTreeExpression) + pointer: ^ElnaTreeExpression + end + ElnaTreeBinaryExpression* = record(ElnaTreeExpression) + lhs: ^ElnaTreeExpression; + rhs: ^ElnaTreeExpression; + operator: ElnaLexerKind + end + ElnaTreeUnaryExpression* = record(ElnaTreeExpression) + operand: ^ElnaTreeExpression; + operator: ElnaLexerKind + end + ElnaTreeFieldAccessExpression* = record(ElnaTreeExpression) + aggregate: ^ElnaTreeExpression; + field: []const Word8 + end + ElnaTreeArrayAccessExpression* = record(ElnaTreeExpression) + array: ^ElnaTreeExpression; + index: ^ElnaTreeExpression + end + ElnaTreeTraitExpression* = record(ElnaTreeExpression) + name: []const Word8; + argument: ^ElnaTreeTypeExpression + end + ElnaTreeExpressionList* = record + expression: ^ElnaTreeExpression; + next: ^ElnaTreeExpressionList + end + ElnaTreeCall* = record(ElnaTreeExpression) + callee: ^ElnaTreeVariableExpression; + arguments: ^ElnaTreeExpressionList; + count: Word + end + + (* Statements. *) + ElnaTreeStatement* = record(ElnaTreeNode) + next: ^ElnaTreeStatement + end + ElnaTreeConditionalStatements* = record + condition: ^ElnaTreeExpression; + statements: ^ElnaTreeStatement; + next: ^ElnaTreeConditionalStatements + end + ElnaTreeIfStatement* = record(ElnaTreeStatement) + conditionals: ^ElnaTreeConditionalStatements; + _else: ^ElnaTreeStatement + end + ElnaTreeGotoStatement* = record(ElnaTreeStatement) + label: []const Word8 + end + ElnaTreeAssignStatement* = record(ElnaTreeStatement) + assignee: ^ElnaTreeExpression; + assignment: ^ElnaTreeExpression + end + ElnaTreeReturnStatement* = record(ElnaTreeStatement) + returned: ^ElnaTreeExpression + end + ElnaTreeLabelDeclaration* = record(ElnaTreeStatement) + label: []const Word8 + end + ElnaTreeCallStatement* = record(ElnaTreeStatement) + call: ^ElnaTreeCall + end + + (* Type expressions. *) + ElnaTreeEnumeration* = record + name: []const Word8; + next: ^ElnaTreeEnumeration + end + ElnaTreeEnumerationTypeExpression* = record(ElnaTreeTypeExpression) + members: ^ElnaTreeEnumeration; + length: Word + end + ElnaTreeField* = record + name: []const Word8; + type_expression: ^ElnaTreeTypeExpression; + next: ^ElnaTreeField + end + ElnaTreeRecordTypeExpression* = record(ElnaTreeTypeExpression) + members: ^ElnaTreeField; + length: Word; + parent: []const Word8 + end + ElnaTreeNamedTypeExpression* = record(ElnaTreeTypeExpression) + name: []const Word8 + end + ElnaTreePointerTypeExpression* = record(ElnaTreeTypeExpression) + base: ^ElnaTreeTypeExpression + end + ElnaTreeArrayTypeExpression* = record(ElnaTreeTypeExpression) + base: ^ElnaTreeTypeExpression; + length: ^ElnaTreeExpression + end + + (* Declarations. *) + ElnaTreeDeclaration* = record(ElnaTreeNode) + next: ^ElnaTreeDeclaration; + name: []const Word8 + end + ElnaTreeVariableDeclaration* = record(ElnaTreeDeclaration) + type_expression: ^ElnaTreeTypeExpression + end + ElnaTreeProcedureDeclaration* = record(ElnaTreeDeclaration) + body: ^ElnaTreeStatement; + temporaries: ^ElnaTreeVariableDeclaration; + parameters: ^ElnaTreeVariableDeclaration; + return_type: ^ElnaTreeTypeExpression; + is_extern: Bool + end + ElnaTreeTypeDeclaration* = record(ElnaTreeDeclaration) + type_expression: ^ElnaTreeTypeExpression + end + ElnaTreeModuleDeclaration* = record(ElnaTreeNode) + types: ^ElnaTreeDeclaration; + globals: ^ElnaTreeVariableDeclaration; + procedures: ^ElnaTreeProcedureDeclaration; + body: ^ElnaTreeStatement + end + +proc elna_list_initialize*(list: ^ElnaList) +begin + list^.first := nil; + list^.last := nil +return + +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 + +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 +return + +proc elna_list_insert*(list: ^ElnaList; existing, new: ^ElnaListNode) +begin + if existing^.next = nil then + list^.last := new + else + new^.next := existing^.next + end; + existing^.next := new +return + +proc elna_list_empty*(list: ^ElnaList) -> Bool +return list^.first = nil + +end. diff --git a/source/common.elna b/source/common.elna index 428c4ec..65b0a65 100644 --- a/source/common.elna +++ b/source/common.elna @@ -78,4 +78,12 @@ begin end return result +proc free_and_nil*#[T](ptr: ^T) -> ^T +begin + if ptr <> nil then + free(ptr) + end +return nil + end. + diff --git a/source/diagnostic.elna b/source/diagnostic.elna new file mode 100644 index 0000000..771ce38 --- /dev/null +++ b/source/diagnostic.elna @@ -0,0 +1,241 @@ +(* 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/. *) +module +import common, cstdio, cstdlib, lexer, ast + +type + ElnaErrorKind* = ( + unexpected_token, + undefined_symbol, + undefined_member, + duplicate_declaration + ) + ElnaError* = record(ElnaListNode) + kind: ElnaErrorKind; + position: ElnaPosition + end + ElnaErrorUnexpectedToken* = record(ElnaError) + expected: [16]ElnaLexerKind; + possibilities: Word; + got: ElnaLexerKind + end + ElnaErrorUndefinedSymbol* = record(ElnaError) + symbol_name: []const Word8 + end + ElnaErrorUndefinedMember* = record(ElnaError) + aggregate_name: []const Word8; + member_name: []const Word8 + end + ElnaErrorDuplicateDeclaration* = record(ElnaError) + symbol_name: []const Word8 + end + +proc elna_error_unexpected_token_create*(cursor: ^ElnaLexerCursor; number_of_expected: Word) -> ^ElnaErrorUnexpectedToken +var + parser_error: ^ElnaErrorUnexpectedToken +begin + parser_error := malloc#[ElnaErrorUnexpectedToken](#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^.got := cursor^.token^.kind +return parser_error + +proc elna_error_duplicate_declaration_create*(position: ElnaPosition; symbol_name: []const Word8) -> ^ElnaErrorDuplicateDeclaration +var + declaration_error: ^ElnaErrorDuplicateDeclaration +begin + declaration_error := malloc#[ElnaErrorDuplicateDeclaration](#size(ElnaErrorDuplicateDeclaration)); + declaration_error^.next := nil; + declaration_error^.kind := ElnaErrorKind.duplicate_declaration; + declaration_error^.position := position; + declaration_error^.symbol_name := symbol_name +return declaration_error + +proc elna_error_undefined_symbol_create*(position: ElnaPosition; symbol_name: []const Word8) -> ^ElnaErrorUndefinedSymbol +var + result: ^ElnaErrorUndefinedSymbol +begin + result := malloc#[ElnaErrorUndefinedSymbol](#size(ElnaErrorUndefinedSymbol)); + result^.next := nil; + result^.kind := ElnaErrorKind.undefined_symbol; + result^.position := position; + result^.symbol_name := symbol_name +return result + +proc elna_error_undefined_member_create*(position: ElnaPosition; aggregate, member: []const Word8) -> ^ElnaErrorUndefinedMember +var + result: ^ElnaErrorUndefinedMember +begin + result := malloc#[ElnaErrorUndefinedMember](#size(ElnaErrorUndefinedMember)); + result^.next := nil; + result^.kind := ElnaErrorKind.undefined_member; + result^.position := position; + result^.aggregate_name := aggregate; + result^.member_name := member +return result + +proc elna_error_print_token*(kind: ElnaLexerKind) +begin + case kind of + ElnaLexerKind._const: + write_s("\"const\"") + | ElnaLexerKind._var: + write_s("\"var\"") + | ElnaLexerKind._proc: + write_s("\"proc\"") + | ElnaLexerKind._type: + write_s("\"type\"") + | ElnaLexerKind._begin: + write_s("\"begin\"") + | ElnaLexerKind._end: + write_s("\"end\"") + | ElnaLexerKind._if: + write_s("\"if\"") + | ElnaLexerKind._then: + write_s("\"then\"") + | ElnaLexerKind._else: + write_s("\"else\"") + | ElnaLexerKind._elsif: + write_s("\"elsif\"") + | ElnaLexerKind._extern: + write_s("\"extern\"") + | ElnaLexerKind._record: + write_s("\"record\"") + | ElnaLexerKind.boolean: + write_s("BOOLEAN") + | ElnaLexerKind.null: + write_s("NIL") + | ElnaLexerKind.and: + write_s("\"&\"") + | ElnaLexerKind._or: + write_s("\"or\"") + | ElnaLexerKind._xor: + write_s("\"xor\"") + | ElnaLexerKind.not: + write_s("\"~\"") + | ElnaLexerKind._return: + write_s("\"return\"") + | ElnaLexerKind._cast: + write_s("\"cast\"") + | ElnaLexerKind.trait: + write_s("TRAIT") + | ElnaLexerKind.left_paren: + write_s("\"(\"") + | ElnaLexerKind.right_paren: + write_s("\")\"") + | ElnaLexerKind.left_square: + write_s("\"[\"") + | ElnaLexerKind.right_square: + write_s("\"]\"") + | ElnaLexerKind.greater_equal: + write_s("\">=\"") + | ElnaLexerKind.less_equal: + write_s("\"<=\"") + | ElnaLexerKind.greater_than: + write_s("\">\"") + | ElnaLexerKind.less_than: + write_s("\"<\"") + | ElnaLexerKind.not_equal: + write_s("\"<>\"") + | ElnaLexerKind.equals: + write_s("\"=\"") + | ElnaLexerKind.semicolon: + write_s("\";\"") + | ElnaLexerKind.dot: + write_s("\".\"") + | ElnaLexerKind.comma: + write_s("\",\"") + | ElnaLexerKind.plus: + write_s("\"+\"") + | ElnaLexerKind.arrow: + write_s("\"->\"") + | ElnaLexerKind.minus: + write_s("\"-\"") + | ElnaLexerKind.multiplication: + write_s("\"*\"") + | ElnaLexerKind.division: + write_s("\"/\"") + | ElnaLexerKind.remainder: + write_s("\"%\"") + | ElnaLexerKind.assignment: + write_s("\":=\"") + | ElnaLexerKind.colon: + write_s("\":\"") + | ElnaLexerKind.hat: + write_s("\"^\"") + | ElnaLexerKind.at: + write_s("\"@\"") + | ElnaLexerKind.comment: + write_s("COMMENT") + | ElnaLexerKind.string: + write_s("STRING") + | ElnaLexerKind.character: + write_s("CHARACTER") + | ElnaLexerKind.integer: + write_s("INTEGER") + | ElnaLexerKind.word: + write_s("WORD") + | ElnaLexerKind.eof: + write_s("EOF") + else + write_s("UNKNOWN") + end +return + +proc elna_error_print_unexpected_token*(current_error: ^ElnaErrorUnexpectedToken) +begin + write_s("Parse error: Expecting token "); + elna_error_print_token(current_error^.expected[1]); + write_s("; got "); + elna_error_print_token(current_error^.got); + write_s(". ") +return + +proc elna_error_print_undefined_member*(current_error: ^ElnaErrorUndefinedMember) +begin + write_s("Semantic error: Member \""); + write_s(current_error^.member_name); + write_s("\" is not accessible on \""); + write_s(current_error^.aggregate_name); + write_s("\". ") +return + +proc elna_error_print_undefined_symbol*(current_error: ^ElnaErrorUndefinedSymbol) +begin + write_s("Semantic error: Undefined symbol \""); + write_s(current_error^.symbol_name); + write_s("\". ") +return + +proc elna_error_print_duplicate_declaration*(current_error: ^ElnaErrorDuplicateDeclaration) +begin + write_s("Semantic error: Duplicate declaration \""); + write_s(current_error^.symbol_name); + write_s("\". ") +return + +proc elna_error_print*(current_error: ^ElnaError) +begin + case current_error^.kind of + ElnaErrorKind.unexpected_token: + elna_error_print_unexpected_token(cast(current_error: ^ElnaErrorUnexpectedToken)) + | ElnaErrorKind.undefined_symbol: + elna_error_print_undefined_symbol(cast(current_error: ^ElnaErrorUndefinedSymbol)) + | ElnaErrorKind.undefined_member: + elna_error_print_undefined_member(cast(current_error: ^ElnaErrorUndefinedMember)) + | ElnaErrorKind.duplicate_declaration: + elna_error_print_duplicate_declaration(cast(current_error: ^ElnaErrorDuplicateDeclaration)) + else + write_s("Unknown error. ") + end; + write_s("Line "); + write_u(current_error^.position.start_location.line); + write_s(", column "); + write_u(current_error^.position.start_location.column); + write_s(".\n") +return + +end. diff --git a/source/lexer.elna b/source/lexer.elna index 370c24d..9ba593f 100644 --- a/source/lexer.elna +++ b/source/lexer.elna @@ -5,7 +5,7 @@ module import cstdio, common, cstdlib type - ElnaLexerState = ( + ElnaLexerState* = ( start, colon, identifier, @@ -28,7 +28,7 @@ type ) ElnaLexerToken* = record kind: ElnaLexerKind; - start: []const Word8; (* DEPRECATED *) + start: []const Word8; position: ElnaPosition end ElnaLexerBooleanToken* = record(ElnaLexerToken) @@ -45,7 +45,6 @@ type end TransitionAction = proc(lexer: ^Lexer; token: ^ElnaLexerToken) - (* DEPRECATED should be replaced with TransitionAction (but keeping the type name). *) ElnaLexerAction = (none, accumulate, skip, single, eof, finalize, composite, key_id, integer, delimited) ElnaLexerTransition = record @@ -53,7 +52,7 @@ type next_state: ElnaLexerState end - ElnaLexerCursor = record + ElnaLexerCursor* = record state: ElnaLexerState; start: ^Word8; finish: ^Word8; @@ -755,7 +754,7 @@ return elna_lexer_execute_action(cursor, next_transition^.action) (** * One time lexer initialization. *) -proc elna_lexer_initialize(cursor: ^ElnaLexerCursor; code_pointer: ^Word8) +proc elna_lexer_initialize*(cursor: ^ElnaLexerCursor; code_pointer: ^Word8) begin elna_lexer_classifications(); elna_lexer_transitions(); @@ -771,7 +770,7 @@ return * 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 +proc elna_lexer_peek*(cursor: ^ElnaLexerCursor) -> ^ElnaLexerToken var token: ^ElnaLexerToken begin @@ -788,7 +787,7 @@ return cursor^.token (** * Reads the token and advance the lexer. *) -proc elna_lexer_read(cursor: ^ElnaLexerCursor) -> ^ElnaLexerToken +proc elna_lexer_read*(cursor: ^ElnaLexerCursor) -> ^ElnaLexerToken var token: ^ElnaLexerToken begin @@ -801,7 +800,7 @@ return token (** * Skips comments. *) -proc elna_lexer_skip_empty_lines(cursor: ^ElnaLexerCursor) +proc elna_lexer_skip_empty_lines*(cursor: ^ElnaLexerCursor) var token: ^ElnaLexerToken begin diff --git a/source/main.elna b/source/main.elna index 26853c3..6049362 100644 --- a/source/main.elna +++ b/source/main.elna @@ -4,813 +4,139 @@ program(parameters) import - cstdio, cstdlib, cstring, cctype, common, command_line_interface, lexer - -type - SourceFile* = record - buffer: [1024]Word8; - handle: ^FILE; - size: Word; - index: Word - end - StringBuffer* = record - data: ^Word8; - size: Word; - capacity: Word - end - SourceCode#[T] = record - position: ElnaLocation; - - input: ^T; - empty: proc(stream: ^T) -> Bool; - advance: proc(stream: ^T); - head: proc(stream: ^T) -> Word8 - end - Tokenizer* = record - length: Word; - data: ^^ElnaLexerToken - end - -(* - Standard procedures. -*) -proc string_dup(origin: []const Word8) -> []const Word8 -var - copy: ^Word8 -begin - copy := malloc#[Word8](origin.length); - strncpy(copy, origin.ptr, origin.length) -return copy[1 to origin.length] - -proc string_buffer_new() -> StringBuffer -var - result: StringBuffer -begin - result.capacity := 64u; - result.data := malloc#[Word8](result.capacity); - result.size := 0u -return result - -proc string_buffer_push(buffer: ^StringBuffer; char: Word8) -begin - if buffer^.size >= buffer^.capacity then - buffer^.capacity := buffer^.capacity + 1024u; - buffer^.data := realloc(buffer^.data, buffer^.capacity) - end; - cast(buffer^.data + buffer^.size: ^Word8)^ := cast(char: Word8); - buffer^.size := buffer^.size + 1u -return - -proc string_buffer_pop(buffer: ^StringBuffer; count: Word) -begin - buffer^.size := buffer^.size - count -return - -proc string_buffer_clear(buffer: ^StringBuffer) -> []const Word8 -var - result: []const Word8 -begin - result := cast(buffer^.data: ^Word8)[1 to buffer^.size]; - buffer^.size := 0u + cstdio, cstdlib, cstring, common, command_line_interface, + lexer, ast, diagnostic, symbol, parser, name_analysis, type_check, tac, qbe + +proc read_file_to_buffer(filename: ^Word8) -> []const Word8 +var + file_handle: ^FILE + file_size: Int + buffer: ^Word8 + bytes_read: Word + result: []const Word8 +begin + file_handle := fopen(filename, "rb\0".ptr); + if file_handle = nil then + perror(filename); + exit(3) + end; + fseek(file_handle, 0, 2); + file_size := ftell(file_handle); + rewind(file_handle); + + buffer := malloc#[Word8](cast(file_size: Word) + 1u); + bytes_read := fread#[Word8](buffer, 1u, cast(file_size: Word), file_handle); + (buffer + bytes_read)^ := cast(0: Word8); + fclose(file_handle); + + result := buffer[1u to bytes_read] return result -(* - Source code stream procedures. -*) - -proc read_source(filename: ^Word8) -> ^SourceFile -var - result: ^SourceFile - file_handle: ^FILE -begin - file_handle := fopen(filename, "rb\0".ptr); - - if file_handle <> nil then - result := malloc#[SourceFile](#size(SourceFile)); - result^.handle := file_handle; - result^.size := 0u; - result^.index := 1u - end -return result - -proc source_file_empty(source_input: ^SourceFile) -> Bool - if source_input^.index > source_input^.size then - source_input^.size := fread(source_input^.buffer.ptr, 1u, 1024u, source_input^.handle); - source_input^.index := 1u - end -return source_input^.size = 0u - -proc source_file_head(source_input: ^SourceFile) -> Word8 -return source_input^.buffer[source_input^.index] - -proc source_file_advance(source_input: ^SourceFile) - source_input^.index := source_input^.index + 1u -return - -proc source_code_empty#[T](source_code: ^SourceCode#[T]) -> Bool -return source_code^.empty(source_code^.input) - -proc source_code_head#[T](source_code: SourceCode#[T]) -> Word8 -return source_code.head(source_code.input) - -proc source_code_advance#[T](source_code: ^SourceCode#[T]) -begin - source_code^.advance(source_code^.input); - source_code^.position.column := source_code^.position.column -return - -proc source_code_break#[T](source_code: ^SourceCode#[T]) -begin - source_code^.position.line := source_code^.position.line + 1u; - source_code^.position.column := 0u -return - -proc source_code_expect#[T](source_code: ^SourceCode#[T]; expected: Word8) -> Bool -return ~source_code_empty(source_code) & source_code_head(source_code^) = expected - -(* - Token procedures. -*) - -proc lexer_escape(escape: Word8; result: ^Word8) -> Bool -var - successful: Bool -begin - case escape of - 'n': - result^ := '\n'; - successful := true - | 't': - result^ := '\t'; - successful := true - | 'f': - result^ := '\f'; - successful := true - | 'r': - result^ := '\r'; - successful := true - | 'v': - result^ := '\v'; - successful := true - | '\\': - result^ := '\\'; - successful := true - | '\'': - result^ := '\''; - successful := true - | '"': - result^ := '"'; - successful := true - | '0': - result^ := '\0'; - successful := true - else - successful := false - end -return successful - -(* Skip spaces. *) -proc lexer_spaces#[T](source_code: ^SourceCode#[T]) -var - current: Word8 -begin - while ~source_code_empty(source_code) & isspace(cast(source_code_head(source_code^): Int)) <> 0 do - current := source_code_head(source_code^); - - if current = '\n' then - source_code_break(source_code) - end; - source_code_advance(source_code) - end -return - -(* Checker whether the character is allowed in an identificator. *) -proc lexer_is_ident(char: Word8) -> Bool -return isalnum(cast(char: Int)) <> 0 or char = '_' - -proc lexer_identifier#[T](source_code: ^SourceCode#[T]; token_content: ^StringBuffer) -var - content_length: Word -begin - while ~source_code_empty(source_code) & lexer_is_ident(source_code_head(source_code^)) do - string_buffer_push(token_content, source_code_head(source_code^)); - source_code_advance(source_code) - end -return - -proc lexer_comment#[T](source_code: ^SourceCode#[T]; token_content: ^StringBuffer) -> Bool -var - trailing: Word -begin - trailing := 0u; - - while ~source_code_empty(source_code) & trailing < 2u do - if source_code_head(source_code^) = '*' then - string_buffer_push(token_content, '*'); - trailing := 1u - elsif source_code_head(source_code^) = ')' & trailing = 1u then - string_buffer_pop(token_content, 1u); - trailing := 2u - else - string_buffer_push(token_content, source_code_head(source_code^)); - trailing := 0u - end; - source_code_advance(source_code) - end -return trailing = 2u - -proc lexer_character#[T](source_code: ^SourceCode#[T]; token_content: ^Word8) -> Bool -var - successful: Bool -begin - successful := ~source_code_empty(source_code); - - if successful then - if source_code_head(source_code^) = '\\' then - source_code_advance(source_code); - - successful := ~source_code_empty(source_code) & lexer_escape(source_code_head(source_code^), token_content) - else - token_content^ := source_code_head(source_code^); - successful := true - end - end; - if successful then - source_code_advance(source_code) - end -return successful - -proc lexer_string#[T](source_code: ^SourceCode#[T]; token_content: ^StringBuffer) -> Bool +proc print_errors(error_list: ^ElnaList) var - token_end, constructed_string: ^Word8 - token_length: Word - is_valid: Bool := true - next_char: Word8 -begin - while is_valid & ~source_code_empty(source_code) & source_code_head(source_code^) <> '"' do - is_valid := lexer_character(source_code, @next_char); - - if is_valid then - string_buffer_push(token_content, next_char) - end - end; - - if is_valid & source_code_expect(source_code, '"') then - source_code_advance(source_code) - else - is_valid := false - end -return is_valid - -proc lexer_number#[T](source_code: ^SourceCode#[T]; token_content: ^Int) + node: ^ElnaListNode begin - token_content^ := 0; - - while ~source_code_empty(source_code) & isdigit(cast(source_code_head(source_code^): Int)) <> 0 do - token_content^ := token_content^ * 10 + (cast(source_code_head(source_code^): Int) - cast('0': Int)); - - source_code_advance(source_code) - end + node := error_list^.first; + while node <> nil do + elna_error_print(cast(node: ^ElnaError)); + node := node^.next + end return -(* Categorize an identifier. *) -proc lexer_categorize(token_content: []const Word8) -> ^ElnaLexerToken -var - current_token: ^ElnaLexerToken -begin - if token_content = "if" then - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind._if - elsif token_content = "then" then - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind._then - elsif token_content = "else" then - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind._else - elsif token_content = "elsif" then - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind._elsif - elsif token_content = "while" then - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind._while - elsif token_content = "do" then - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind._do - elsif token_content = "proc" then - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind._proc - elsif token_content = "begin" then - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind._begin - elsif token_content = "end" then - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind._end - elsif token_content = "extern" then - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind._extern - elsif token_content = "const" then - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind._const - elsif token_content = "var" then - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind._var - elsif token_content = "case" then - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind._case - elsif token_content = "of" then - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind._of - elsif token_content = "type" then - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind._type - elsif token_content = "record" then - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind._record - elsif token_content = "true" then - current_token := malloc#[ElnaLexerBooleanToken](#size(ElnaLexerBooleanToken)); - current_token^.kind := ElnaLexerKind.boolean; - cast(current_token: ^ElnaLexerBooleanToken)^.value := true - elsif token_content = "false" then - current_token := malloc#[ElnaLexerBooleanToken](#size(ElnaLexerBooleanToken)); - current_token^.kind := ElnaLexerKind.boolean; - cast(current_token: ^ElnaLexerBooleanToken)^.value := false - elsif token_content = "nil" then - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind.null - elsif token_content = "or" then - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind._or - elsif token_content = "return" then - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind._return - elsif token_content = "cast" then - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind._cast - elsif token_content = "defer" then - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind._defer - elsif token_content = "import" then - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind._import - else - current_token := malloc#[ElnaLexerStringToken](#size(ElnaLexerStringToken)); - current_token^.kind := ElnaLexerKind.identifier; - cast(current_token: ^ElnaLexerStringToken)^.value := string_dup(token_content) - end -return current_token - -proc lexer_add_token(lexer: ^Tokenizer; token: ^ElnaLexerToken) -var - new_length: Word -begin - new_length := lexer^.length + 1u; - lexer^.data := realloc#[^ElnaLexerToken](lexer^.data, new_length * #size(^ElnaLexerToken)); - (lexer^.data + lexer^.length)^ := token; - lexer^.length := new_length -return - -(* Read the next token from the input. *) -proc lexer_next#[T](source_code: SourceCode#[T]; token_buffer: ^StringBuffer) -> ^ElnaLexerToken -var - current_token: ^ElnaLexerToken := nil - first_char: Word8 -begin - first_char := source_code_head(source_code); - - if isalpha(cast(first_char: Int)) <> 0 or first_char = '_' then - lexer_identifier(@source_code, token_buffer); - current_token := lexer_categorize(string_buffer_clear(token_buffer)) - elsif first_char = '#' then - source_code_advance(@source_code); - lexer_identifier(@source_code, token_buffer); - - current_token := malloc#[ElnaLexerStringToken](#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 - current_token := malloc#[ElnaLexerIntegerToken](#size(ElnaLexerIntegerToken)); - lexer_number(@source_code, @cast(current_token: ^ElnaLexerIntegerToken)^.value); - - if source_code_expect(@source_code, 'u') then - current_token^.kind := ElnaLexerKind.word; - source_code_advance(@source_code) - else - current_token^.kind := ElnaLexerKind.integer - end - elsif first_char = '(' then - source_code_advance(@source_code); - - if source_code_empty(@source_code) then - current_token := malloc#[ElnaLexerToken](#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 := malloc#[ElnaLexerStringToken](#size(ElnaLexerStringToken)); - cast(current_token: ^ElnaLexerStringToken)^.value := string_dup(string_buffer_clear(token_buffer)); - current_token^.kind := ElnaLexerKind.comment - end - else - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind.left_paren - end - elsif first_char = ')' then - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind.right_paren; - source_code_advance(@source_code) - elsif first_char = '{' then - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind.left_brace; - source_code_advance(@source_code) - elsif first_char = '}' then - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind.right_brace; - source_code_advance(@source_code) - elsif first_char = '\'' then - source_code_advance(@source_code); - - if lexer_character(@source_code, @first_char) & source_code_expect(@source_code, '\'') then - current_token := malloc#[ElnaLexerCharacterToken](#size(ElnaLexerCharacterToken)); - current_token^.kind := ElnaLexerKind.character; - cast(current_token: ^ElnaLexerCharacterToken)^.value := first_char; - source_code_advance(@source_code) - end - elsif first_char = '"' then - source_code_advance(@source_code); - - if lexer_string(@source_code, token_buffer) then - current_token := malloc#[ElnaLexerStringToken](#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 := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind.left_square; - source_code_advance(@source_code) - elsif first_char = ']' then - current_token := malloc#[ElnaLexerToken](#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#[ElnaLexerToken](#size(ElnaLexerToken)); - - if source_code_empty(@source_code) then - current_token^.kind := ElnaLexerKind.greater_than - elsif source_code_head(source_code) = '=' then - current_token^.kind := ElnaLexerKind.greater_equal; - source_code_advance(@source_code) - elsif source_code_head(source_code) = '>' then - current_token^.kind := ElnaLexerKind.shift_right; - source_code_advance(@source_code) - else - current_token^.kind := ElnaLexerKind.greater_than - end - elsif first_char = '<' then - source_code_advance(@source_code); - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - - if source_code_empty(@source_code) then - current_token^.kind := ElnaLexerKind.less_than - elsif source_code_head(source_code) = '=' then - current_token^.kind := ElnaLexerKind.less_equal; - source_code_advance(@source_code) - elsif source_code_head(source_code) = '<' then - current_token^.kind := ElnaLexerKind.shift_left; - source_code_advance(@source_code) - elsif source_code_head(source_code) = '>' then - current_token^.kind := ElnaLexerKind.not_equal; - source_code_advance(@source_code) - else - current_token^.kind := ElnaLexerKind.less_than - end - elsif first_char = '=' then - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind.equals; - source_code_advance(@source_code) - elsif first_char = ';' then - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind.semicolon; - source_code_advance(@source_code) - elsif first_char = '.' then - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind.dot; - source_code_advance(@source_code) - elsif first_char = ',' then - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind.comma; - source_code_advance(@source_code) - elsif first_char = '+' then - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind.plus; - source_code_advance(@source_code) - elsif first_char = '-' then - source_code_advance(@source_code); - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - - if source_code_empty(@source_code) then - current_token^.kind := ElnaLexerKind.minus - elsif source_code_head(source_code) = '>' then - current_token^.kind := ElnaLexerKind.arrow; - source_code_advance(@source_code) - else - current_token^.kind := ElnaLexerKind.minus - end - elsif first_char = '*' then - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind.multiplication; - source_code_advance(@source_code) - elsif first_char = '/' then - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind.division; - source_code_advance(@source_code) - elsif first_char = '%' then - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind.remainder; - source_code_advance(@source_code) - elsif first_char = ':' then - source_code_advance(@source_code); - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - - if source_code_empty(@source_code) then - current_token^.kind := ElnaLexerKind.colon - elsif source_code_head(source_code) = '=' then - current_token^.kind := ElnaLexerKind.assignment; - source_code_advance(@source_code) - else - current_token^.kind := ElnaLexerKind.colon - end - elsif first_char = '^' then - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind.hat; - source_code_advance(@source_code) - elsif first_char = '@' then - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind.at; - source_code_advance(@source_code) - elsif first_char = '!' then - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind.exclamation; - source_code_advance(@source_code) - elsif first_char = '&' then - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind.and; - source_code_advance(@source_code) - elsif first_char = '~' then - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind.not; - source_code_advance(@source_code) - elsif first_char = '|' then - current_token := malloc#[ElnaLexerToken](#size(ElnaLexerToken)); - current_token^.kind := ElnaLexerKind.pipe; - source_code_advance(@source_code) - end -return current_token - -(* Split the source text into tokens. *) -proc lexer_text#[T](source_code: SourceCode#[T]) -> Tokenizer -var - current_token: ^ElnaLexerToken - token_buffer: StringBuffer - lexer: Tokenizer -begin - lexer := Tokenizer{ length: 0u, data: nil }; - token_buffer := string_buffer_new(); - - lexer_spaces(@source_code); - - while ~source_code_empty(@source_code) do - current_token := lexer_next(source_code, @token_buffer); - - if current_token <> nil then - lexer_add_token(@lexer, current_token); - lexer_spaces(@source_code) - else - write_s("Lexical analysis error on \""); - write_c(source_code_head(source_code)); - write_s("\".\n") - end - end -return lexer - -(* - Parser. -*) - -proc parse(tokens: ^^ElnaLexerToken; tokens_size: Word) -var - current_token: ^ElnaLexerToken - i: Word := 0u -begin - while i < tokens_size do - current_token := (tokens + i)^; - - case current_token^.kind of - ElnaLexerKind._if: - write_s("IF") - | ElnaLexerKind._then: - write_s("THEN") - | ElnaLexerKind._else: - write_s("ELSE") - | ElnaLexerKind._elsif: - write_s("ELSIF") - | ElnaLexerKind._while: - write_s("WHILE") - | ElnaLexerKind._do: - write_s("DO") - | ElnaLexerKind._proc: - write_s("PROC") - | ElnaLexerKind._begin: - write_s("BEGIN") - | ElnaLexerKind._end: - write_s("END") - | ElnaLexerKind._extern: - write_s("EXTERN") - | ElnaLexerKind._const: - write_s("CONST") - | ElnaLexerKind._var: - write_s("VAR") - | ElnaLexerKind._case: - write_s("CASE") - | ElnaLexerKind._of: - write_s("OF") - | ElnaLexerKind._type: - write_s("TYPE") - | ElnaLexerKind._record: - write_s("RECORD") - | ElnaLexerKind.pipe: - write_s("|") - | ElnaLexerKind.boolean: - write_s("BOOLEAN<"); - write_b(cast(current_token: ^ElnaLexerBooleanToken)^.value); - write_c('>') - | ElnaLexerKind.null: - write_s("NIL") - | ElnaLexerKind.and: - write_s("&") - | ElnaLexerKind._or: - write_s("OR") - | ElnaLexerKind.not: - write_s("~") - | ElnaLexerKind._return: - write_s("RETURN") - | ElnaLexerKind._cast: - write_s("CAST") - | ElnaLexerKind.shift_left: - write_s("<<") - | ElnaLexerKind.shift_right: - write_s(">>") - | ElnaLexerKind.identifier: - write_c('<'); - write_s(cast(current_token: ^ElnaLexerStringToken)^.value); - write_c('>') - | ElnaLexerKind.trait: - write_c('#'); - write_s(cast(current_token: ^ElnaLexerStringToken)^.value) - | ElnaLexerKind.left_paren: - write_s("(") - | ElnaLexerKind.right_paren: - write_s(")") - | ElnaLexerKind.left_square: - write_s("[") - | ElnaLexerKind.right_square: - write_s("]") - | ElnaLexerKind.greater_equal: - write_s(">=") - | ElnaLexerKind.less_equal: - write_s("<=") - | ElnaLexerKind.greater_than: - write_s(">") - | ElnaLexerKind.less_than: - write_s("<") - | ElnaLexerKind.equals: - write_s("=") - | ElnaLexerKind.not_equal: - write_s("<>") - | ElnaLexerKind.semicolon: - write_c(';') - | ElnaLexerKind.dot: - write_c('.') - | ElnaLexerKind.comma: - write_c(',') - | ElnaLexerKind.plus: - write_c('+') - | ElnaLexerKind.minus: - write_c('-') - | ElnaLexerKind.multiplication: - write_c('*') - | ElnaLexerKind.division: - write_c('/') - | ElnaLexerKind.remainder: - write_c('%') - | ElnaLexerKind.assignment: - write_s(":=") - | ElnaLexerKind.colon: - write_c(':') - | ElnaLexerKind.hat: - write_c('^') - | ElnaLexerKind.at: - write_c('@') - | ElnaLexerKind.comment: - write_s("(* COMMENT *)") - | ElnaLexerKind.integer: - write_c('<'); - write_i(cast(current_token: ^ElnaLexerIntegerToken)^.value); - write_c('>') - | ElnaLexerKind.word: - write_c('<'); - write_i(cast(current_token: ^ElnaLexerIntegerToken)^.value); - write_s("u>") - | ElnaLexerKind.character: - write_c('<'); - write_i(cast(cast(current_token: ^ElnaLexerCharacterToken)^.value: Int)); - write_s("c>") - | ElnaLexerKind.string: - write_s("\"...\"") - | ElnaLexerKind._defer: - write_s("DEFER") - | ElnaLexerKind.exclamation: - write_c('!') - | ElnaLexerKind.arrow: - write_s("->") - | ElnaLexerKind._import: - write_s("IMPORT") - else - write_s("UNKNOWN<"); - write_i(cast(current_token^.kind: Int)); - write_c('>') - end; - write_c(' '); - - i := i + 1u - end; - write_c('\n') -return - -(* - Compilation entry. -*) - -proc compile_in_stages#[T](command_line: ^CommandLine; source_code: SourceCode#[T]) -> Int -var - return_code: Int := 0 - lexer: Tokenizer -begin - if command_line^.lex or command_line^.parse then - lexer := lexer_text(source_code) - end; - if command_line^.parse then - parse(lexer.data, lexer.length) - end -return return_code - -proc process(argc: Int; argv: ^^Word8) -> Int -var - tokens: ^ElnaLexerToken - tokens_size: Word - source_code: SourceCode#[SourceFile] - command_line: ^CommandLine - return_code: Int := 0 - source_file: ^SourceFile -begin - command_line := parse_command_line(argc, argv); - if command_line = nil then - return_code := 2 - end; - - if return_code = 0 then - source_file := read_source(command_line^.input); - - if source_file = nil then - perror(command_line^.input); - return_code := 3 - end - end; - - if return_code = 0 then - defer - fclose(source_file^.handle) - end; - - source_code.position := ElnaLocation{line: 1u, column: 1u}; - source_code.input := source_file; - source_code.empty := source_file_empty; - source_code.head := source_file_head; - source_code.advance := source_file_advance; - - return_code := compile_in_stages(command_line, source_code) - end +proc compile_file(command_line: ^CommandLine) -> Int +var + source_text: []const Word8 + lexer_cursor: ElnaLexerCursor + error_list: ElnaList + parser_node: ^ElnaTreeModuleDeclaration + tac_module: ^ElnaInstructionModule + out_file: ^FILE := stdout + token: ^ElnaLexerToken + return_code: Int := 0 +begin + source_text := read_file_to_buffer(command_line^.input); + + if command_line^.lex then + elna_lexer_initialize(@lexer_cursor, cast(source_text.ptr: ^Word8)); + token := elna_lexer_read(@lexer_cursor); + while token^.kind <> ElnaLexerKind.eof do + token := elna_lexer_read(@lexer_cursor) + end + else + elna_list_initialize(@error_list); + elna_symbol_table_build(); + + elna_lexer_initialize(@lexer_cursor, cast(source_text.ptr: ^Word8)); + parser_node := elna_parser_module_declaration(@lexer_cursor, @error_list); + + if ~elna_list_empty(@error_list) then + print_errors(@error_list); + return_code := 1 + elsif ~command_line^.parse then + elna_declaration_module_declaration(parser_node, @error_list); + if ~elna_list_empty(@error_list) then + print_errors(@error_list); + return_code := 1 + else + elna_name_module_declaration(parser_node, @error_list); + if ~elna_list_empty(@error_list) then + print_errors(@error_list); + return_code := 1 + else + elna_type_module_declaration(parser_node, @error_list); + if ~elna_list_empty(@error_list) then + print_errors(@error_list); + return_code := 1 + else + tac_module := elna_tac_module_declaration(parser_node); + + if command_line^.output <> nil then + out_file := fopen(command_line^.output, "wb\0".ptr); + if out_file = nil then + perror(command_line^.output); + return_code := 3 + end + end; + + if return_code = 0 then + elna_qbe_emit(tac_module, out_file); + + if command_line^.output <> nil & out_file <> stdout then + fclose(out_file) + end + end + end + end + end + end + end return return_code proc initialize_global_state() +begin stdin := fdopen(0, "r\0".ptr); stdout := fdopen(1, "w\0".ptr); stderr := fdopen(2, "w\0".ptr) return +proc process(argc: Int; argv: ^^Word8) -> Int +var + command_line: ^CommandLine + return_code: Int := 0 +begin + command_line := parse_command_line(argc, argv); + if command_line = nil then + return_code := 2 + elsif command_line^.input = nil then + write_s("Fatal error: no input file provided.\n"); + return_code := 2 + else + return_code := compile_file(command_line) + end +return return_code + begin - initialize_global_state(); + initialize_global_state(); - exit(process(cast(parameters.length: Int), parameters.ptr)) + exit(process(cast(parameters.length: Int), parameters.ptr)) end. diff --git a/source/name_analysis.elna b/source/name_analysis.elna new file mode 100644 index 0000000..75d6dbd --- /dev/null +++ b/source/name_analysis.elna @@ -0,0 +1,539 @@ +(* 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/. *) +module +import common, cstdlib, lexer, ast, symbol, diagnostic + +proc elna_name_type_expression*(parser_node: ^ElnaTreeTypeExpression; error_list: ^ElnaList) -> ^ElnaType +var + result: ^ElnaType := nil +begin + if parser_node <> nil then + case parser_node^.kind of + ElnaTreeKind.named_type_expression: + result := elna_name_named_type_expression(cast(parser_node: ^ElnaTreeNamedTypeExpression), error_list) + | ElnaTreeKind.enumeration_type_expression: + result := malloc#[ElnaType](#size(ElnaTypeEnumeration)); + result^.kind := ElnaTypeKind.enumeration; + elna_name_enumeration_type_expression(cast(parser_node: ^ElnaTreeEnumerationTypeExpression), error_list, cast(result: ^ElnaTypeEnumeration)) + | ElnaTreeKind.record_type_expression: + result := malloc#[ElnaType](#size(ElnaTypeRecord)); + result^.kind := ElnaTypeKind._record; + elna_name_record_type_expression(cast(parser_node: ^ElnaTreeRecordTypeExpression), error_list, cast(result: ^ElnaTypeRecord)) + | ElnaTreeKind.pointer_type_expression: + result := malloc#[ElnaType](#size(ElnaTypePointer)); + result^.kind := ElnaTypeKind.pointer; + elna_name_pointer_type_expression(cast(parser_node: ^ElnaTreePointerTypeExpression), error_list, cast(result: ^ElnaTypePointer)) + | ElnaTreeKind.array_type_expression: + result := malloc#[ElnaType](#size(ElnaTypeArray)); + result^.kind := ElnaTypeKind.array; + elna_name_array_type_expression(cast(parser_node: ^ElnaTreeArrayTypeExpression), error_list, cast(result: ^ElnaTypeArray)) + else + end + end +return result + +proc elna_name_named_type_expression*(parser_node: ^ElnaTreeNamedTypeExpression; error_list: ^ElnaList) -> ^ElnaType +var + symbol_info: ^ElnaSymbolInfo + type_info: ^ElnaSymbolTypeInfo + undefined_symbol: ^ElnaErrorUndefinedSymbol + result: ^ElnaType := nil +begin + symbol_info := elna_symbol_table_lookup(symbol_table_global, parser_node^.name); + if symbol_info <> nil then + type_info := cast(symbol_info: ^ElnaSymbolTypeInfo); + result := type_info^._type + else + undefined_symbol := elna_error_undefined_symbol_create(parser_node^.position, parser_node^.name); + elna_list_append(error_list, cast(undefined_symbol: ^ElnaListNode)) + end +return result + +proc elna_name_alias_type_expression*(parser_node: ^ElnaTreeNamedTypeExpression; + error_list: ^ElnaList; result: ^ElnaTypeAlias) +var + base: ^ElnaType +begin + base := elna_name_named_type_expression(parser_node, error_list); + if base <> nil then + result^.size := base^.size; + result^.alignment := base^.alignment; + result^.base := base + end +return + +proc elna_name_enumeration_type_expression*(parser_node: ^ElnaTreeEnumerationTypeExpression; + error_list: ^ElnaList; result: ^ElnaTypeEnumeration) +var + tree_member: ^ElnaTreeEnumeration + i: Word := 0u +begin + result^.size := 8u; + result^.alignment := 8u; + result^.length := parser_node^.length; + result^.members := malloc#[[]const Word8](parser_node^.length * #size([]const Word8)); + + tree_member := parser_node^.members; + while i < parser_node^.length & tree_member <> nil do + (result^.members + i)^ := tree_member^.name; + tree_member := tree_member^.next; + i := i + 1u + end +return + +proc elna_name_pointer_type_expression*(parser_node: ^ElnaTreePointerTypeExpression; + error_list: ^ElnaList; result: ^ElnaTypePointer) +begin + result^.size := 8u; + result^.alignment := 8u; + result^.base := elna_name_type_expression(parser_node^.base, error_list) +return + +proc elna_name_array_type_expression*(parser_node: ^ElnaTreeArrayTypeExpression; + error_list: ^ElnaList; result: ^ElnaTypeArray) +var + base: ^ElnaType + len_lit: ^ElnaTreeIntegerLiteral +begin + base := elna_name_type_expression(parser_node^.base, error_list); + len_lit := cast(parser_node^.length: ^ElnaTreeIntegerLiteral); + if base <> nil & len_lit <> nil then + result^.size := base^.size * len_lit^.value; + result^.alignment := base^.alignment; + result^.base := base; + result^.length := len_lit^.value + end +return + +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 := 0u; + result^.alignment := 0u; + result^.length := 0u; + result^.members := malloc#[ElnaTypeField](parser_node^.length * #size(ElnaTypeField)); + + tree_field := parser_node^.members; + member_array_current := result^.members; + + while result^.length < parser_node^.length & tree_field <> nil do + 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 + 1u; + tree_field := tree_field^.next; + result^.length := result^.length + 1u + else + tree_field := nil + end + end +return + +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 := cast(elna_symbol_table_lookup(symbol_table, parser_node^.name): ^ElnaSymbolTemporaryInfo); + if info = nil then + variable_type := elna_name_type_expression(parser_node^.type_expression, error_list); + info := elna_symbol_temporary_info_create(0u, variable_type); + elna_symbol_table_enter(symbol_table, parser_node^.name, cast(info: ^ElnaSymbolInfo)) + else + declaration_error := elna_error_duplicate_declaration_create(parser_node^.position, parser_node^.name); + elna_list_append(error_list, cast(declaration_error: ^ElnaListNode)) + end +return + +proc elna_name_procedure_temporaries*(parser_node: ^ElnaTreeVariableDeclaration; symbol_table: ^ElnaSymbolTable; + error_list: ^ElnaList) +var + current: ^ElnaTreeVariableDeclaration +begin + current := parser_node; + while current <> nil do + elna_name_procedure_temporary(current, symbol_table, error_list); + current := cast(current^.next: ^ElnaTreeVariableDeclaration) + end +return + +proc elna_name_type_declaration*(parser_node: ^ElnaTreeTypeDeclaration; error_list: ^ElnaList) +var + type_info: ^ElnaSymbolTypeInfo + type_stub: ^ElnaType + type_expression: ^ElnaTreeTypeExpression +begin + type_info := cast(elna_symbol_table_lookup(symbol_table_global, parser_node^.name): ^ElnaSymbolTypeInfo); + if type_info <> nil then + type_stub := type_info^._type; + type_expression := parser_node^.type_expression; + + if type_stub^.kind = ElnaTypeKind.alias then + elna_name_alias_type_expression(cast(type_expression: ^ElnaTreeNamedTypeExpression), error_list, cast(type_stub: ^ElnaTypeAlias)) + elsif type_stub^.kind = ElnaTypeKind.enumeration then + elna_name_enumeration_type_expression(cast(type_expression: ^ElnaTreeEnumerationTypeExpression), error_list, cast(type_stub: ^ElnaTypeEnumeration)) + elsif type_stub^.kind = ElnaTypeKind._record then + elna_name_record_type_expression(cast(type_expression: ^ElnaTreeRecordTypeExpression), error_list, cast(type_stub: ^ElnaTypeRecord)) + elsif type_stub^.kind = ElnaTypeKind.pointer then + elna_name_pointer_type_expression(cast(type_expression: ^ElnaTreePointerTypeExpression), error_list, cast(type_stub: ^ElnaTypePointer)) + elsif type_stub^.kind = ElnaTypeKind.array then + elna_name_array_type_expression(cast(type_expression: ^ElnaTreeArrayTypeExpression), error_list, cast(type_stub: ^ElnaTypeArray)) + end + end +return + +proc elna_name_variable_expression*(parser_node: ^ElnaTreeVariableExpression; symbol_table: ^ElnaSymbolTable; + error_list: ^ElnaList) +var + symbol_info: ^ElnaSymbolInfo + undefined_symbol: ^ElnaErrorUndefinedSymbol +begin + symbol_info := elna_symbol_table_lookup(symbol_table, parser_node^.name); + if symbol_info = nil then + undefined_symbol := elna_error_undefined_symbol_create(parser_node^.position, parser_node^.name); + elna_list_append(error_list, cast(undefined_symbol: ^ElnaListNode)) + end +return + +proc elna_name_cast_expression*(parser_node: ^ElnaTreeCastExpression; symbol_table: ^ElnaSymbolTable; + error_list: ^ElnaList) +begin + elna_name_binary_expression(parser_node^.expression, symbol_table, error_list); + parser_node^.type_decoration := elna_name_type_expression(parser_node^.type_expression, error_list) +return + +proc elna_name_simple_expression*(parser_node: ^ElnaTreeExpression; symbol_table: ^ElnaSymbolTable; + error_list: ^ElnaList) +begin + if parser_node^.kind = ElnaTreeKind._cast then + elna_name_cast_expression(cast(parser_node: ^ElnaTreeCastExpression), symbol_table, error_list) + elsif parser_node^.kind = ElnaTreeKind.variable_expression then + elna_name_variable_expression(cast(parser_node: ^ElnaTreeVariableExpression), symbol_table, error_list) + end +return + +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; + while argument_tree <> nil do + elna_name_binary_expression(argument_tree^.expression, symbol_table, error_list); + argument_tree := argument_tree^.next + end +return + +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) +return + +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: ^[]const Word8 + found: Bool := false +begin + if parser_node^.aggregate^.kind = ElnaTreeKind.variable_expression then + variable_expression := cast(parser_node^.aggregate: ^ElnaTreeVariableExpression); + identifier_symbol := elna_symbol_table_lookup(symbol_table, variable_expression^.name); + + if identifier_symbol <> nil & identifier_symbol^.kind = ElnaSymbolInfoKind.type_info then + type_info := cast(identifier_symbol: ^ElnaSymbolTypeInfo); + if type_info^._type^.kind = ElnaTypeKind.enumeration then + enumeration_type := cast(type_info^._type: ^ElnaTypeEnumeration); + current_member := enumeration_type^.members; + member_count := enumeration_type^.length; + + while member_count > 0u & ~found do + if current_member^ = parser_node^.field then + found := true + end; + member_count := member_count - 1u; + current_member := current_member + 1u + end + end; + if ~found then + undefined_member_error := elna_error_undefined_member_create(variable_expression^.position, + variable_expression^.name, parser_node^.field); + elna_list_append(error_list, cast(undefined_member_error: ^ElnaListNode)) + end + else + elna_name_designator(cast(variable_expression: ^ElnaTreeExpression), symbol_table, error_list) + end + else + elna_name_designator(parser_node^.aggregate, symbol_table, error_list) + end +return + +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) +return + +proc elna_name_designator*(parser_node: ^ElnaTreeExpression; symbol_table: ^ElnaSymbolTable; error_list: ^ElnaList) +begin + if parser_node^.kind = ElnaTreeKind.dereference_expression then + elna_name_dereference_expression(cast(parser_node: ^ElnaTreeDereferenceExpression), symbol_table, error_list) + elsif parser_node^.kind = ElnaTreeKind.field_access_expression then + elna_name_field_access_expression(cast(parser_node: ^ElnaTreeFieldAccessExpression), symbol_table, error_list) + elsif parser_node^.kind = ElnaTreeKind.array_access_expression then + elna_name_array_access_expression(cast(parser_node: ^ElnaTreeArrayAccessExpression), symbol_table, error_list) + elsif parser_node^.kind = ElnaTreeKind.call then + elna_name_call(cast(parser_node: ^ElnaTreeCall), symbol_table, error_list) + else + elna_name_simple_expression(parser_node, symbol_table, error_list) + end +return + +proc elna_name_unary_expression*(parser_node: ^ElnaTreeExpression; symbol_table: ^ElnaSymbolTable; + error_list: ^ElnaList) +var + unary_node: ^ElnaTreeUnaryExpression +begin + if parser_node^.kind = ElnaTreeKind.unary_expression then + unary_node := cast(parser_node: ^ElnaTreeUnaryExpression); + elna_name_designator(unary_node^.operand, symbol_table, error_list) + else + elna_name_designator(parser_node, symbol_table, error_list) + end +return + +proc elna_name_binary_expression*(parser_node: ^ElnaTreeExpression; symbol_table: ^ElnaSymbolTable; + error_list: ^ElnaList) +var + bin_node: ^ElnaTreeBinaryExpression +begin + if parser_node^.kind = ElnaTreeKind.binary_expression then + bin_node := cast(parser_node: ^ElnaTreeBinaryExpression); + elna_name_unary_expression(bin_node^.lhs, symbol_table, error_list); + elna_name_unary_expression(bin_node^.rhs, symbol_table, error_list) + else + elna_name_unary_expression(parser_node, symbol_table, error_list) + end +return + +proc elna_name_conditional_statements*(parser_node: ^ElnaTreeConditionalStatements; symbol_table: ^ElnaSymbolTable; + error_list: ^ElnaList) +var + current: ^ElnaTreeConditionalStatements +begin + current := parser_node; + while current <> nil do + elna_name_binary_expression(current^.condition, symbol_table, error_list); + elna_name_statements(current^.statements, symbol_table, error_list); + current := current^.next + end +return + +proc elna_name_if_statement*(parser_node: ^ElnaTreeIfStatement; symbol_table: ^ElnaSymbolTable; + error_list: ^ElnaList) +begin + elna_name_conditional_statements(parser_node^.conditionals, symbol_table, error_list); + if parser_node^._else <> nil then + elna_name_statements(parser_node^._else, symbol_table, error_list) + end +return + +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) +return + +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) +return + +proc elna_name_statement*(parser_node: ^ElnaTreeStatement; symbol_table: ^ElnaSymbolTable; error_list: ^ElnaList) +var + call_statement: ^ElnaTreeCallStatement +begin + if parser_node^.kind = ElnaTreeKind.if_statement then + elna_name_if_statement(cast(parser_node: ^ElnaTreeIfStatement), symbol_table, error_list) + elsif parser_node^.kind = ElnaTreeKind.return_statement then + elna_name_return_statement(cast(parser_node: ^ElnaTreeReturnStatement), symbol_table, error_list) + elsif parser_node^.kind = ElnaTreeKind.call_statement then + call_statement := cast(parser_node: ^ElnaTreeCallStatement); + elna_name_call(call_statement^.call, symbol_table, error_list) + elsif parser_node^.kind = ElnaTreeKind.assign_statement then + elna_name_assign_statement(cast(parser_node: ^ElnaTreeAssignStatement), symbol_table, error_list) + end +return + +proc elna_name_statements*(parser_node: ^ElnaTreeStatement; symbol_table: ^ElnaSymbolTable; + error_list: ^ElnaList) +var + current: ^ElnaTreeStatement +begin + current := parser_node; + while current <> nil do + elna_name_statement(current, symbol_table, error_list); + current := current^.next + end +return + +proc elna_name_procedure_declaration*(parser_node: ^ElnaTreeProcedureDeclaration; error_list: ^ElnaList) +var + new_symbol_table: ^ElnaSymbolTable + symbol_info: ^ElnaSymbolProcedureInfo + proc_type: ^ElnaTypeProcedure +begin + symbol_info := cast(elna_symbol_table_lookup(symbol_table_global, parser_node^.name): ^ElnaSymbolProcedureInfo); + + proc_type := malloc#[ElnaTypeProcedure](#size(ElnaTypeProcedure)); + proc_type^.kind := ElnaTypeKind.procedure; + proc_type^.size := 8u; + proc_type^.alignment := 8u; + if parser_node^.return_type = nil then + proc_type^.return_type := nil + else + proc_type^.return_type := elna_name_type_expression(parser_node^.return_type, error_list) + end; + symbol_info^.procedure_type := proc_type; + + if ~symbol_info^.is_extern 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 +return + +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", cast(symbol_info: ^ElnaSymbolInfo)) +return + +proc elna_declaration_type_declaration*(parser_node: ^ElnaTreeTypeDeclaration; error_list: ^ElnaList) +var + type_info: ^ElnaSymbolTypeInfo + result: ^ElnaType := nil + type_expression: ^ElnaTreeTypeExpression + declaration_error: ^ElnaErrorDuplicateDeclaration +begin + type_info := cast(elna_symbol_table_lookup(symbol_table_global, parser_node^.name): ^ElnaSymbolTypeInfo); + + if type_info = nil then + type_expression := parser_node^.type_expression; + + if type_expression^.kind = ElnaTreeKind.named_type_expression then + result := malloc#[ElnaType](#size(ElnaTypeAlias)); + result^.kind := ElnaTypeKind.alias + elsif type_expression^.kind = ElnaTreeKind.enumeration_type_expression then + result := malloc#[ElnaType](#size(ElnaTypeEnumeration)); + result^.kind := ElnaTypeKind.enumeration + elsif type_expression^.kind = ElnaTreeKind.record_type_expression then + result := malloc#[ElnaType](#size(ElnaTypeRecord)); + result^.kind := ElnaTypeKind._record + elsif type_expression^.kind = ElnaTreeKind.pointer_type_expression then + result := malloc#[ElnaType](#size(ElnaTypePointer)); + result^.kind := ElnaTypeKind.pointer + elsif type_expression^.kind = ElnaTreeKind.array_type_expression then + result := malloc#[ElnaType](#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, cast(type_info: ^ElnaSymbolInfo)) + else + declaration_error := elna_error_duplicate_declaration_create(parser_node^.position, parser_node^.name); + elna_list_append(error_list, cast(declaration_error: ^ElnaListNode)) + end +return + +proc elna_declaration_procedure_declaration*(parser_node: ^ElnaTreeProcedureDeclaration; error_list: ^ElnaList) +var + symbol_info: ^ElnaSymbolProcedureInfo + declaration_error: ^ElnaErrorDuplicateDeclaration +begin + symbol_info := cast(elna_symbol_table_lookup(symbol_table_global, parser_node^.name): ^ElnaSymbolProcedureInfo); + + 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, cast(symbol_info: ^ElnaSymbolInfo)) + else + declaration_error := elna_error_duplicate_declaration_create(parser_node^.position, parser_node^.name); + elna_list_append(error_list, cast(declaration_error: ^ElnaListNode)) + end +return + +proc elna_declaration_module_declaration*(parser_node: ^ElnaTreeModuleDeclaration; error_list: ^ElnaList) +var + current_type: ^ElnaTreeDeclaration + current_proc: ^ElnaTreeDeclaration +begin + current_type := parser_node^.types; + while current_type <> nil do + elna_declaration_type_declaration(cast(current_type: ^ElnaTreeTypeDeclaration), error_list); + current_type := current_type^.next + end; + + current_proc := cast(parser_node^.procedures: ^ElnaTreeDeclaration); + while current_proc <> nil do + elna_declaration_procedure_declaration(cast(current_proc: ^ElnaTreeProcedureDeclaration), error_list); + current_proc := current_proc^.next + end +return + +proc elna_name_module_declaration*(parser_node: ^ElnaTreeModuleDeclaration; error_list: ^ElnaList) +var + current_type: ^ElnaTreeDeclaration + current_global: ^ElnaTreeVariableDeclaration + current_proc: ^ElnaTreeProcedureDeclaration +begin + current_type := parser_node^.types; + while current_type <> nil do + elna_name_type_declaration(cast(current_type: ^ElnaTreeTypeDeclaration), error_list); + current_type := current_type^.next + end; + + current_global := parser_node^.globals; + while current_global <> nil do + elna_name_procedure_temporary(current_global, symbol_table_global, error_list); + current_global := cast(current_global^.next: ^ElnaTreeVariableDeclaration) + end; + + current_proc := parser_node^.procedures; + while current_proc <> nil do + elna_name_procedure_declaration(current_proc, error_list); + current_proc := cast(current_proc^.next: ^ElnaTreeProcedureDeclaration) + end; + + if parser_node^.body <> nil then + elna_name_program_body(parser_node^.body) + end +return + +end. diff --git a/source/parser.elna b/source/parser.elna new file mode 100644 index 0000000..30f79f8 --- /dev/null +++ b/source/parser.elna @@ -0,0 +1,1162 @@ +(* 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/. *) +module +import common, cstdlib, lexer, ast, diagnostic + +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, 1u); + parser_error^.expected[1] := expected; + elna_list_append(error_list, cast(parser_error: ^ElnaListNode)) + end +return token + +proc elna_parser_escape*(current_position: ^const Word8; result: ^Word8) -> Word +var + parsed_length: Word + next_character: Word8 + pos: ^const Word8 +begin + pos := current_position; + next_character := pos^; + + if next_character = '\\' then + parsed_length := 2u; + pos := pos + 1u; + next_character := pos^; + + if next_character = '\\' then + result^ := 92u8 + elsif next_character = 'n' then + result^ := 10u8 + elsif next_character = 't' then + result^ := 9u8 + elsif next_character = 'f' then + result^ := 12u8 + elsif next_character = 'r' then + result^ := 13u8 + elsif next_character = 'v' then + result^ := 11u8 + elsif next_character = '"' then + result^ := 34u8 + elsif next_character = '\'' then + result^ := 39u8 + elsif next_character = '0' then + result^ := 0u8 + else + result^ := next_character + end + else + parsed_length := 1u; + result^ := next_character + end +return parsed_length + +proc elna_parser_integer_literal*(cursor: ^ElnaLexerCursor) -> ^ElnaTreeIntegerLiteral +var + token: ^ElnaLexerToken + result: ^ElnaTreeIntegerLiteral + i: Word := 1u + val: Word := 0u +begin + result := malloc#[ElnaTreeIntegerLiteral](#size(ElnaTreeIntegerLiteral)); + token := elna_lexer_read(cursor); + result^.kind := ElnaTreeKind.integer_literal; + result^.type_decoration := nil; + result^.position := token^.position; + + while i <= token^.start.length do + val := val * 10u + cast(token^.start[i] - '0': Word); + i := i + 1u + end; + result^.value := val +return result + +proc elna_parser_boolean_literal*(cursor: ^ElnaLexerCursor) -> ^ElnaTreeBooleanLiteral +var + token: ^ElnaLexerToken + result: ^ElnaTreeBooleanLiteral +begin + token := elna_lexer_read(cursor); + result := malloc#[ElnaTreeBooleanLiteral](#size(ElnaTreeBooleanLiteral)); + result^.kind := ElnaTreeKind.boolean_literal; + result^.value := token^.start = "true"; + result^.type_decoration := nil; + result^.position := token^.position +return result + +proc elna_parser_nil_literal*(cursor: ^ElnaLexerCursor) -> ^ElnaTreeNilLiteral +var + token: ^ElnaLexerToken + result: ^ElnaTreeNilLiteral +begin + token := elna_lexer_read(cursor); + result := malloc#[ElnaTreeNilLiteral](#size(ElnaTreeNilLiteral)); + result^.kind := ElnaTreeKind.null; + result^.type_decoration := nil; + result^.position := token^.position +return result + +proc elna_parser_character_literal*(cursor: ^ElnaLexerCursor) -> ^ElnaTreeCharacterLiteral +var + result: ^ElnaTreeCharacterLiteral + token: ^ElnaLexerToken +begin + result := malloc#[ElnaTreeCharacterLiteral](#size(ElnaTreeCharacterLiteral)); + token := elna_lexer_read(cursor); + result^.kind := ElnaTreeKind.character_literal; + result^.position := token^.position; + result^.type_decoration := nil; + elna_parser_escape(token^.start.ptr + 1u, @result^.value) +return result + +proc elna_parser_variable_expression*(cursor: ^ElnaLexerCursor) -> ^ElnaTreeVariableExpression +var + result: ^ElnaTreeVariableExpression + token: ^ElnaLexerToken +begin + result := malloc#[ElnaTreeVariableExpression](#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 + +proc elna_parser_string_literal*(cursor: ^ElnaLexerCursor) -> ^ElnaTreeStringLiteral +var + result: ^ElnaTreeStringLiteral + token: ^ElnaLexerToken + current_position: ^const Word8 + parsed_length: Word + parsed_total: Word + target_start, target_position: ^Word8 +begin + result := malloc#[ElnaTreeStringLiteral](#size(ElnaTreeStringLiteral)); + token := elna_lexer_read(cursor); + target_start := malloc#[Word8](token^.start.length); + target_position := target_start; + current_position := token^.start.ptr + 1u; + parsed_total := 2u; + + result^.kind := ElnaTreeKind.string_literal; + result^.position := token^.position; + result^.type_decoration := nil; + + while parsed_total < token^.start.length do + 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 + 1u + end; + result^.value := target_start[1 to cast(target_position - target_start: Word)] +return result + +proc elna_parser_trait_expression*(cursor: ^ElnaLexerCursor; error_list: ^ElnaList) -> ^ElnaTreeTraitExpression +var + result: ^ElnaTreeTraitExpression + token: ^ElnaLexerToken +begin + result := malloc#[ElnaTreeTraitExpression](#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) + elsif elna_parser_expect(cursor, ElnaLexerKind.right_paren, error_list) = nil then + result := free_and_nil(result) + end + else + result := free_and_nil(result) + end +return result + +proc elna_parser_cast_expression*(cursor: ^ElnaLexerCursor; error_list: ^ElnaList) -> ^ElnaTreeCastExpression +var + result: ^ElnaTreeCastExpression := nil + token: ^ElnaLexerToken + start_location: ElnaLocation +begin + token := elna_lexer_read(cursor); + start_location := token^.position.start_location; + + if elna_parser_expect(cursor, ElnaLexerKind.left_paren, error_list) <> nil then + result := malloc#[ElnaTreeCastExpression](#size(ElnaTreeCastExpression)); + result^.kind := ElnaTreeKind._cast; + result^.position.start_location := 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) + elsif elna_parser_expect(cursor, ElnaLexerKind.colon, error_list) = nil then + result := free_and_nil(result) + else + result^.type_expression := elna_parser_type_expression(cursor, error_list); + if result^.type_expression = nil then + result := free_and_nil(result) + else + token := elna_parser_expect(cursor, ElnaLexerKind.right_paren, error_list); + if token = nil then + result := free_and_nil(result) + else + result^.position.end_location := token^.position.end_location + end + end + end + end +return result + +proc elna_parser_simple_expression*(cursor: ^ElnaLexerCursor; error_list: ^ElnaList) -> ^ElnaTreeExpression +var + token: ^ElnaLexerToken + result: ^ElnaTreeExpression := nil +begin + token := elna_lexer_peek(cursor); + case token^.kind of + ElnaLexerKind.character: + result := cast(elna_parser_character_literal(cursor): ^ElnaTreeExpression) + | ElnaLexerKind.integer: + result := cast(elna_parser_integer_literal(cursor): ^ElnaTreeExpression) + | ElnaLexerKind.string: + result := cast(elna_parser_string_literal(cursor): ^ElnaTreeExpression) + | ElnaLexerKind.boolean: + result := cast(elna_parser_boolean_literal(cursor): ^ElnaTreeExpression) + | ElnaLexerKind.null: + result := cast(elna_parser_nil_literal(cursor): ^ElnaTreeExpression) + | ElnaLexerKind._cast: + result := cast(elna_parser_cast_expression(cursor, error_list): ^ElnaTreeExpression) + | ElnaLexerKind.trait: + result := cast(elna_parser_trait_expression(cursor, error_list): ^ElnaTreeExpression) + | ElnaLexerKind.identifier: + result := cast(elna_parser_variable_expression(cursor): ^ElnaTreeExpression) + else + end +return result + +proc elna_parser_dereference_expression*(cursor: ^ElnaLexerCursor; + simple_expression: ^ElnaTreeExpression) -> ^ElnaTreeDereferenceExpression +var + result: ^ElnaTreeDereferenceExpression + token: ^ElnaLexerToken +begin + token := elna_lexer_read(cursor); + result := malloc#[ElnaTreeDereferenceExpression](#size(ElnaTreeDereferenceExpression)); + result^.kind := ElnaTreeKind.dereference_expression; + result^.pointer := simple_expression; + result^.type_decoration := nil; + result^.position := token^.position +return result + +proc elna_parser_field_access_expression*(cursor: ^ElnaLexerCursor; + aggregate: ^ElnaTreeExpression) -> ^ElnaTreeFieldAccessExpression +var + result: ^ElnaTreeFieldAccessExpression + token: ^ElnaLexerToken +begin + token := elna_lexer_read(cursor); + result := malloc#[ElnaTreeFieldAccessExpression](#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 + +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#[ElnaTreeArrayAccessExpression](#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 + +proc elna_parser_call*(cursor: ^ElnaLexerCursor; callee: ^ElnaTreeExpression; error_list: ^ElnaList) -> ^ElnaTreeCall +var + result: ^ElnaTreeCall + argument_entry: ^ElnaTreeExpressionList + token: ^ElnaLexerToken + parser_error: ^ElnaErrorUnexpectedToken + reading_args: Bool := true +begin + result := malloc#[ElnaTreeCall](#size(ElnaTreeCall)); + result^.kind := ElnaTreeKind.call; + result^.type_decoration := nil; + result^.arguments := nil; + result^.count := 0u; + result^.callee := cast(callee: ^ElnaTreeVariableExpression); + + 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); + result^.position.end_location := token^.position.end_location + else + while reading_args do + if result^.arguments = nil then + result^.arguments := malloc#[ElnaTreeExpressionList](#size(ElnaTreeExpressionList)); + argument_entry := result^.arguments + else + argument_entry^.next := malloc#[ElnaTreeExpressionList](#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); + reading_args := false + else + result^.count := result^.count + 1u; + token := elna_lexer_peek(cursor); + if token^.kind = ElnaLexerKind.comma then + elna_lexer_read(cursor) + elsif token^.kind = ElnaLexerKind.right_paren then + token := elna_lexer_read(cursor); + result^.position.end_location := token^.position.end_location; + reading_args := false + else + parser_error := elna_error_unexpected_token_create(cursor, 2u); + parser_error^.expected[1] := ElnaLexerKind.comma; + parser_error^.expected[2] := ElnaLexerKind.right_paren; + elna_list_append(error_list, cast(parser_error: ^ElnaListNode)); + result := free_and_nil(result); + reading_args := false + end + end + end + end +return result + +proc elna_parser_designator*(cursor: ^ElnaLexerCursor; error_list: ^ElnaList) -> ^ElnaTreeExpression +var + simple_expression: ^ElnaTreeExpression + token: ^ElnaLexerToken + continue_loop: Bool := true +begin + simple_expression := elna_parser_simple_expression(cursor, error_list); + if simple_expression <> nil then + while continue_loop do + token := elna_lexer_peek(cursor); + if token^.kind = ElnaLexerKind.hat then + simple_expression := cast(elna_parser_dereference_expression(cursor, simple_expression): ^ElnaTreeExpression) + elsif token^.kind = ElnaLexerKind.dot then + simple_expression := cast(elna_parser_field_access_expression(cursor, simple_expression): ^ElnaTreeExpression) + elsif token^.kind = ElnaLexerKind.left_square then + simple_expression := cast(elna_parser_array_access_expression(cursor, simple_expression, error_list): ^ElnaTreeExpression); + if simple_expression = nil then + continue_loop := false + end + elsif token^.kind = ElnaLexerKind.left_paren then + simple_expression := cast(elna_parser_call(cursor, simple_expression, error_list): ^ElnaTreeExpression); + if simple_expression = nil then + continue_loop := false + end + else + continue_loop := false + end + end + end +return simple_expression + +proc elna_parser_unary_expression*(cursor: ^ElnaLexerCursor; error_list: ^ElnaList) -> ^ElnaTreeExpression +var + unary_result: ^ElnaTreeUnaryExpression + result: ^ElnaTreeExpression + op_kind: ElnaLexerKind + has_op: Bool := false + token: ^ElnaLexerToken +begin + token := elna_lexer_peek(cursor); + if token^.kind = ElnaLexerKind.at or token^.kind = ElnaLexerKind.minus or token^.kind = ElnaLexerKind.not then + op_kind := token^.kind; + has_op := true; + elna_lexer_read(cursor) + end; + result := elna_parser_designator(cursor, error_list); + if result <> nil & has_op then + unary_result := malloc#[ElnaTreeUnaryExpression](#size(ElnaTreeUnaryExpression)); + unary_result^.kind := ElnaTreeKind.unary_expression; + unary_result^.operand := result; + unary_result^.operator := op_kind; + unary_result^.position := token^.position; + unary_result^.type_decoration := nil; + result := cast(unary_result: ^ElnaTreeExpression) + end +return result + +proc elna_parser_binary_expression*(cursor: ^ElnaLexerCursor; error_list: ^ElnaList) -> ^ElnaTreeExpression +var + lhs_node: ^ElnaTreeExpression + rhs_node: ^ElnaTreeExpression := nil + bin_result: ^ElnaTreeBinaryExpression + token: ^ElnaLexerToken +begin + lhs_node := elna_parser_unary_expression(cursor, error_list); + token := elna_lexer_peek(cursor); + + case token^.kind of + ElnaLexerKind.plus, + ElnaLexerKind.minus, + ElnaLexerKind.multiplication, + ElnaLexerKind.and, + ElnaLexerKind._or, + ElnaLexerKind._xor, + ElnaLexerKind.equals, + ElnaLexerKind.remainder, + ElnaLexerKind.division, + ElnaLexerKind.less_than, + ElnaLexerKind.greater_than, + ElnaLexerKind.less_equal, + ElnaLexerKind.not_equal, + ElnaLexerKind.greater_equal: + elna_lexer_read(cursor); + rhs_node := elna_parser_unary_expression(cursor, error_list) + else + end; + + if rhs_node <> nil then + bin_result := malloc#[ElnaTreeBinaryExpression](#size(ElnaTreeBinaryExpression)); + bin_result^.kind := ElnaTreeKind.binary_expression; + bin_result^.lhs := lhs_node; + bin_result^.rhs := rhs_node; + bin_result^.operator := token^.kind; + bin_result^.position := token^.position; + bin_result^.type_decoration := nil; + lhs_node := cast(bin_result: ^ElnaTreeExpression) + end +return lhs_node + +proc elna_parser_label_declaration*(cursor: ^ElnaLexerCursor; error_list: ^ElnaList) -> ^ElnaTreeLabelDeclaration +var + result: ^ElnaTreeLabelDeclaration + token: ^ElnaLexerToken +begin + token := elna_lexer_read(cursor); + result := malloc#[ElnaTreeLabelDeclaration](#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 + +proc elna_parser_assign_statement*(cursor: ^ElnaLexerCursor; assignee: ^ElnaTreeExpression; error_list: ^ElnaList) -> ^ElnaTreeAssignStatement +var + token: ^ElnaLexerToken + result: ^ElnaTreeAssignStatement +begin + result := malloc#[ElnaTreeAssignStatement](#size(ElnaTreeAssignStatement)); + result^.kind := ElnaTreeKind.assign_statement; + result^.next := nil; + result^.assignee := assignee; + result^.assignment := nil; + + 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 + +proc elna_parser_return_statement*(cursor: ^ElnaLexerCursor; error_list: ^ElnaList) -> ^ElnaTreeReturnStatement +var + token: ^ElnaLexerToken + result: ^ElnaTreeReturnStatement +begin + token := elna_lexer_read(cursor); + result := malloc#[ElnaTreeReturnStatement](#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 + +proc elna_parser_conditional_statements*(cursor: ^ElnaLexerCursor; error_list: ^ElnaList; + block_keyword: ElnaLexerKind) -> ^ElnaTreeConditionalStatements +var + result: ^ElnaTreeConditionalStatements +begin + result := malloc#[ElnaTreeConditionalStatements](#size(ElnaTreeConditionalStatements)); + elna_lexer_read(cursor); + result^.condition := elna_parser_binary_expression(cursor, error_list); + if result^.condition = nil then + result := free_and_nil(result) + else + 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 + +proc elna_parser_if_statement*(cursor: ^ElnaLexerCursor; error_list: ^ElnaList) -> ^ElnaTreeIfStatement +var + result: ^ElnaTreeIfStatement + previous_conditional: ^ElnaTreeConditionalStatements + next_conditional: ^ElnaTreeConditionalStatements + token: ^ElnaLexerToken + reading_elsif: Bool := true +begin + token := elna_lexer_peek(cursor); + result := malloc#[ElnaTreeIfStatement](#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; + + while reading_elsif do + 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 + elsif token^.kind = ElnaLexerKind._else then + elna_lexer_read(cursor); + result^._else := elna_parser_statements(cursor, error_list); + reading_elsif := false + else + result^._else := nil; + reading_elsif := false + end + end; + elna_parser_expect(cursor, ElnaLexerKind._end, error_list) +return result + +proc elna_parser_statement*(cursor: ^ElnaLexerCursor; error_list: ^ElnaList) -> ^ElnaTreeStatement +var + result: ^ElnaTreeStatement := nil + call_result: ^ElnaTreeCallStatement + designator: ^ElnaTreeExpression + token: ^ElnaLexerToken +begin + token := elna_lexer_peek(cursor); + if token^.kind = ElnaLexerKind._if then + result := cast(elna_parser_if_statement(cursor, error_list): ^ElnaTreeStatement) + elsif token^.kind = ElnaLexerKind._return then + result := cast(elna_parser_return_statement(cursor, error_list): ^ElnaTreeStatement) + elsif token^.kind = ElnaLexerKind.dot then + result := cast(elna_parser_label_declaration(cursor, error_list): ^ElnaTreeStatement) + elsif token^.kind = ElnaLexerKind.identifier then + designator := elna_parser_designator(cursor, error_list); + if designator <> nil then + if designator^.kind <> ElnaTreeKind.call then + result := cast(elna_parser_assign_statement(cursor, designator, error_list): ^ElnaTreeStatement) + else + call_result := malloc#[ElnaTreeCallStatement](#size(ElnaTreeCallStatement)); + call_result^.kind := ElnaTreeKind.call_statement; + call_result^.next := nil; + call_result^.call := cast(designator: ^ElnaTreeCall); + call_result^.position := designator^.position; + result := cast(call_result: ^ElnaTreeStatement) + end + end + end +return result + +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 + token := elna_lexer_peek(cursor); + while token^.kind = ElnaLexerKind.semicolon & elna_list_empty(error_list) do + 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; + token := elna_lexer_peek(cursor) + end + end; + elna_lexer_skip_empty_lines(cursor) +return first_statement + +proc elna_parser_named_type_expression*(cursor: ^ElnaLexerCursor) -> ^ElnaTreeNamedTypeExpression +var + result: ^ElnaTreeNamedTypeExpression + token: ^ElnaLexerToken +begin + result := malloc#[ElnaTreeNamedTypeExpression](#size(ElnaTreeNamedTypeExpression)); + token := elna_lexer_read(cursor); + result^.kind := ElnaTreeKind.named_type_expression; + result^.name := token^.start; + result^.position := token^.position +return result + +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#[ElnaTreePointerTypeExpression](#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 + +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#[ElnaTreeArrayTypeExpression](#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 + +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 + reading_members: Bool := true +begin + token := elna_lexer_read(cursor); + result := malloc#[ElnaTreeRecordTypeExpression](#size(ElnaTreeRecordTypeExpression)); + result^.kind := ElnaTreeKind.record_type_expression; + result^.members := nil; + result^.length := 0u; + 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); + reading_members := false + else + result^.parent := token^.start; + if elna_parser_expect(cursor, ElnaLexerKind.right_paren, error_list) = nil then + result := free_and_nil(result); + reading_members := false + end + end + end; + + while reading_members & result <> nil do + token := elna_lexer_read(cursor); + if token^.kind = ElnaLexerKind._end then + reading_members := false + elsif token^.kind <> ElnaLexerKind.identifier then + parser_error := elna_error_unexpected_token_create(cursor, 2u); + parser_error^.expected[1] := ElnaLexerKind._end; + parser_error^.expected[2] := ElnaLexerKind.identifier; + elna_list_append(error_list, cast(parser_error: ^ElnaListNode)); + result := free_and_nil(result); + reading_members := false + else + entry := malloc#[ElnaTreeField](#size(ElnaTreeField)); + result^.length := result^.length + 1u; + entry^.name := token^.start; + if elna_parser_expect(cursor, ElnaLexerKind.colon, error_list) = nil then + result := free_and_nil(result); + reading_members := false + else + entry^.type_expression := elna_parser_type_expression(cursor, error_list); + if entry^.type_expression = nil then + result := free_and_nil(result); + reading_members := false + else + 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 + (* continue *) + elsif token^.kind = ElnaLexerKind._end then + reading_members := false + else + parser_error := elna_error_unexpected_token_create(cursor, 2u); + parser_error^.expected[1] := ElnaLexerKind._end; + parser_error^.expected[2] := ElnaLexerKind.semicolon; + elna_list_append(error_list, cast(parser_error: ^ElnaListNode)); + reading_members := false + end + end + end + end + end +return result + +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 + reading_members: Bool := true +begin + token := elna_lexer_read(cursor); + result := malloc#[ElnaTreeEnumerationTypeExpression](#size(ElnaTreeEnumerationTypeExpression)); + result^.kind := ElnaTreeKind.enumeration_type_expression; + result^.members := nil; + result^.length := 0u; + result^.position.start_location := token^.position.start_location; + + while reading_members & result <> nil do + token := elna_parser_expect(cursor, ElnaLexerKind.identifier, error_list); + if token = nil then + result := free_and_nil(result); + reading_members := false + else + entry := malloc#[ElnaTreeEnumeration](#size(ElnaTreeEnumeration)); + result^.length := result^.length + 1u; + 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) + elsif token^.kind = ElnaLexerKind.right_paren then + token := elna_lexer_read(cursor); + result^.position.end_location := token^.position.end_location; + reading_members := false + else + parser_error := elna_error_unexpected_token_create(cursor, 2u); + parser_error^.expected[1] := ElnaLexerKind.comma; + parser_error^.expected[2] := ElnaLexerKind.right_paren; + elna_list_append(error_list, cast(parser_error: ^ElnaListNode)); + result := free_and_nil(result); + reading_members := false + end + end + end +return result + +proc elna_parser_type_expression*(cursor: ^ElnaLexerCursor; error_list: ^ElnaList) -> ^ElnaTreeTypeExpression +var + result: ^ElnaTreeTypeExpression := nil + token: ^ElnaLexerToken + parser_error: ^ElnaErrorUnexpectedToken +begin + token := elna_lexer_peek(cursor); + if token^.kind = ElnaLexerKind.identifier then + result := cast(elna_parser_named_type_expression(cursor): ^ElnaTreeTypeExpression) + elsif token^.kind = ElnaLexerKind.left_paren then + result := cast(elna_parser_enumeration_type_expression(cursor, error_list): ^ElnaTreeTypeExpression) + elsif token^.kind = ElnaLexerKind._record then + result := cast(elna_parser_record_type_expression(cursor, error_list): ^ElnaTreeTypeExpression) + elsif token^.kind = ElnaLexerKind.hat then + result := cast(elna_parser_pointer_type_expression(cursor, error_list): ^ElnaTreeTypeExpression) + elsif token^.kind = ElnaLexerKind.left_square then + result := cast(elna_parser_array_type_expression(cursor, error_list): ^ElnaTreeTypeExpression) + else + parser_error := elna_error_unexpected_token_create(cursor, 5u); + 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, cast(parser_error: ^ElnaListNode)) + end +return result + +proc elna_parser_variable_declaration*(cursor: ^ElnaLexerCursor; error_list: ^ElnaList) -> ^ElnaTreeVariableDeclaration +var + var_type: ^ElnaTreeTypeExpression + result: ^ElnaTreeVariableDeclaration := nil + token: ^ElnaLexerToken +begin + token := elna_parser_expect(cursor, ElnaLexerKind.identifier, error_list); + if token <> nil then + if elna_parser_expect(cursor, ElnaLexerKind.colon, error_list) <> nil then + var_type := elna_parser_type_expression(cursor, error_list); + if var_type <> nil then + result := malloc#[ElnaTreeVariableDeclaration](#size(ElnaTreeVariableDeclaration)); + result^.kind := ElnaTreeKind.variable_declaration; + result^.next := nil; + result^.name := token^.start; + result^.type_expression := var_type; + result^.position := token^.position + end + end + end +return result + +proc elna_parser_parameters*(cursor: ^ElnaLexerCursor; error_list: ^ElnaList) -> ^ElnaTreeVariableDeclaration +var + parameters: ^ElnaTreeVariableDeclaration := nil + token: ^ElnaLexerToken + current_declaration: ^ElnaTreeVariableDeclaration + next_declaration: ^ElnaTreeVariableDeclaration + reading: Bool := true +begin + token := elna_lexer_peek(cursor); + if token^.kind <> ElnaLexerKind.right_paren then + while reading do + next_declaration := elna_parser_variable_declaration(cursor, error_list); + if next_declaration = nil then + parameters := free_and_nil(parameters); + reading := false + else + if parameters = nil then + parameters := next_declaration + else + current_declaration^.next := cast(next_declaration: ^ElnaTreeDeclaration) + end; + current_declaration := next_declaration; + + token := elna_lexer_peek(cursor); + if token^.kind = ElnaLexerKind.comma or token^.kind = ElnaLexerKind.semicolon then + elna_lexer_read(cursor) + else + reading := false + end + end + end + end +return parameters + +proc elna_parser_procedure_declaration*(cursor: ^ElnaLexerCursor; error_list: ^ElnaList) -> ^ElnaTreeProcedureDeclaration +var + result: ^ElnaTreeProcedureDeclaration + token: ^ElnaLexerToken +begin + token := elna_lexer_read(cursor); + result := malloc#[ElnaTreeProcedureDeclaration](#size(ElnaTreeProcedureDeclaration)); + result^.kind := ElnaTreeKind.procedure_declaration; + result^.next := nil; + result^.position := token^.position; + + token := elna_parser_expect(cursor, ElnaLexerKind.identifier, error_list); + if token = nil then + result := free_and_nil(result) + else + result^.name := token^.start; + + if elna_parser_expect(cursor, ElnaLexerKind.left_paren, error_list) = nil then + result := free_and_nil(result) + else + result^.parameters := elna_parser_parameters(cursor, error_list); + if elna_list_empty(error_list) = false then + result := free_and_nil(result) + elsif elna_parser_expect(cursor, ElnaLexerKind.right_paren, error_list) = nil then + result := free_and_nil(result) + else + 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) + end + else + result^.return_type := nil + end; + + if result <> nil then + 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) + else + 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) + elsif elna_parser_expect(cursor, ElnaLexerKind._end, error_list) = nil then + result := free_and_nil(result) + end + elsif token^.kind = ElnaLexerKind._return then + result^.body := cast(elna_parser_return_statement(cursor, error_list): ^ElnaTreeStatement); + if result^.body = nil then + result := free_and_nil(result) + end + end + end + end + end + end + end + end +return result + +proc elna_parser_procedures*(cursor: ^ElnaLexerCursor; error_list: ^ElnaList) -> ^ElnaTreeProcedureDeclaration +var + parser_node: ^ElnaTreeProcedureDeclaration + result: ^ElnaTreeProcedureDeclaration := nil + current_declaration: ^ElnaTreeProcedureDeclaration + token: ^ElnaLexerToken + reading: Bool := true +begin + while reading do + 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 := cast(parser_node: ^ElnaTreeDeclaration) + end; + current_declaration := parser_node + else + reading := false + end + else + reading := false + end + end +return result + +proc elna_parser_type_declaration*(cursor: ^ElnaLexerCursor; error_list: ^ElnaList) -> ^ElnaTreeTypeDeclaration +var + result: ^ElnaTreeTypeDeclaration + token: ^ElnaLexerToken +begin + token := elna_lexer_read(cursor); + result := malloc#[ElnaTreeTypeDeclaration](#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 + +proc elna_parser_type_part*(cursor: ^ElnaLexerCursor; error_list: ^ElnaList) -> ^ElnaTreeDeclaration +var + parser_node: ^ElnaTreeDeclaration + result: ^ElnaTreeDeclaration := nil + current_declaration: ^ElnaTreeDeclaration + token: ^ElnaLexerToken + reading: Bool := true +begin + elna_lexer_skip_empty_lines(cursor); + token := elna_lexer_peek(cursor); + if token^.kind = ElnaLexerKind._type then + elna_lexer_read(cursor); + while reading do + elna_lexer_skip_empty_lines(cursor); + token := elna_lexer_peek(cursor); + if token^.kind = ElnaLexerKind.identifier then + parser_node := cast(elna_parser_type_declaration(cursor, error_list): ^ElnaTreeDeclaration); + if parser_node <> nil then + if result = nil then + result := parser_node + else + current_declaration^.next := parser_node + end; + current_declaration := parser_node; + token := elna_lexer_peek(cursor); + if token^.kind = ElnaLexerKind.semicolon then + elna_lexer_read(cursor) + end + else + reading := false + end + else + reading := false + end + end + end +return result + +proc elna_parser_var_part*(cursor: ^ElnaLexerCursor; error_list: ^ElnaList) -> ^ElnaTreeVariableDeclaration +var + result: ^ElnaTreeVariableDeclaration := nil + variable_node: ^ElnaTreeVariableDeclaration + current_declaration: ^ElnaTreeVariableDeclaration + token: ^ElnaLexerToken + reading: Bool := true +begin + token := elna_lexer_peek(cursor); + if token^.kind = ElnaLexerKind._var then + elna_lexer_read(cursor); + while reading do + 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 variable_node <> nil then + if result = nil then + result := variable_node + else + current_declaration^.next := cast(variable_node: ^ElnaTreeDeclaration) + end; + current_declaration := variable_node; + token := elna_lexer_peek(cursor); + if token^.kind = ElnaLexerKind.semicolon then + elna_lexer_read(cursor) + end + else + reading := false + end + else + reading := false + end + end + end +return result + +proc elna_parser_program_body*(cursor: ^ElnaLexerCursor; error_list: ^ElnaList) -> ^ElnaTreeStatement +var + result: ^ElnaTreeStatement := nil + token: ^ElnaLexerToken +begin + elna_lexer_skip_empty_lines(cursor); + token := elna_lexer_peek(cursor); + if token^.kind = ElnaLexerKind._begin then + elna_lexer_read(cursor); + result := elna_parser_statements(cursor, error_list); + if elna_parser_expect(cursor, ElnaLexerKind._end, error_list) = nil then + result := free_and_nil(result) + elsif elna_parser_expect(cursor, ElnaLexerKind.dot, error_list) = nil then + result := free_and_nil(result) + end + elsif token^.kind = ElnaLexerKind._end then + elna_lexer_read(cursor); + if elna_parser_expect(cursor, ElnaLexerKind.dot, error_list) = nil then + result := free_and_nil(result) + end + end +return result + +proc elna_parser_module_declaration*(cursor: ^ElnaLexerCursor; error_list: ^ElnaList) -> ^ElnaTreeModuleDeclaration +var + result: ^ElnaTreeModuleDeclaration +begin + result := malloc#[ElnaTreeModuleDeclaration](#size(ElnaTreeModuleDeclaration)); + result^.kind := ElnaTreeKind.module_declaration; + result^.position.start_location := ElnaLocation{ line: 1u, column: 1u }; + 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); + if elna_list_empty(error_list) = false then + result := free_and_nil(result) + end + end; + + if result <> nil then + result^.procedures := elna_parser_procedures(cursor, error_list); + if elna_list_empty(error_list) = false then + result := free_and_nil(result) + end + end; + + if result <> nil then + result^.body := elna_parser_program_body(cursor, error_list); + if elna_list_empty(error_list) = false then + result := free_and_nil(result) + end + end +return result + +end. diff --git a/source/qbe.elna b/source/qbe.elna new file mode 100644 index 0000000..0a5a45b --- /dev/null +++ b/source/qbe.elna @@ -0,0 +1,635 @@ +(* 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/. *) +module +import common, cstdlib, cstdio, cstring, lexer, ast, symbol, tac + +var + qbe_unique_id: Word := 0u + +proc qbe_write_slice(file: ^FILE; text: []const Word8) +begin + fwrite#[Word8](text.ptr, 1u, text.length, file) +return + +proc qbe_write_str(file: ^FILE; str: ^const Word8) +begin + fwrite#[Word8](str, 1u, strlen(str), file) +return + +proc qbe_write_word(file: ^FILE; val: Word) +var + buf: [32]Word8 + len: Int +begin + len := sprintf(@buf[1], "%u\0".ptr, val); + fwrite#[Word8](@buf[1], 1u, cast(len: Word), file) +return + +proc is_global(globals: ^ElnaTacStaticVariable; name: []const Word8) -> Bool +var + current: ^ElnaTacStaticVariable + found: Bool := false +begin + current := globals; + while current <> nil & ~found do + if current^.name = name then + found := true + else + current := current^.next + end + end +return found + +proc is_string_constant(strings: ^ElnaTacStringConstant; name: []const Word8) -> Bool +var + current: ^ElnaTacStringConstant + found: Bool := false +begin + current := strings; + while current <> nil & ~found do + if current^.name = name then + found := true + else + current := current^.next + end + end +return found + +proc is_pointer_type(_type: ^ElnaType) -> Bool +var + result: Bool := false +begin + if _type <> nil then + if _type^.kind = ElnaTypeKind.pointer then + result := true + elsif _type = pointer_type then + result := true + end + end +return result + +proc get_procedure_return_type(proc_name: []const Word8) -> ^ElnaType +var + symbol_info: ^ElnaSymbolInfo + procedure_info: ^ElnaSymbolProcedureInfo + result: ^ElnaType := nil +begin + symbol_info := elna_symbol_table_lookup(symbol_table_global, proc_name); + if symbol_info <> nil & symbol_info^.kind = ElnaSymbolInfoKind.procedure_info then + procedure_info := cast(symbol_info: ^ElnaSymbolProcedureInfo); + if procedure_info^.procedure_type <> nil then + result := procedure_info^.procedure_type^.return_type + end + end +return result + +proc get_param_type(sym_table: ^ElnaSymbolTable; param_name: []const Word8) -> ^ElnaType +var + symbol_info: ^ElnaSymbolInfo + temp_info: ^ElnaSymbolTemporaryInfo + result: ^ElnaType := nil +begin + symbol_info := elna_symbol_table_lookup(sym_table, param_name); + if symbol_info <> nil & symbol_info^.kind = ElnaSymbolInfoKind.temporary_info then + temp_info := cast(symbol_info: ^ElnaSymbolTemporaryInfo); + result := temp_info^.variable_type + end +return result + +proc is_pointer_operand(op: ^ElnaTacOperand; sym_table: ^ElnaSymbolTable; + globals: ^ElnaTacStaticVariable; strings: ^ElnaTacStringConstant) -> Bool +var + var_type: ^ElnaType + result: Bool := false +begin + if op^.kind = ElnaTacKind.variable then + if is_global(globals, op^.name) or is_string_constant(strings, op^.name) then + result := true + else + var_type := get_param_type(sym_table, op^.name); + if is_pointer_type(var_type) then + result := true + end + end + end +return result + +proc qbe_emit_operand(file: ^FILE; op: ^ElnaTacOperand; + globals: ^ElnaTacStaticVariable; strings: ^ElnaTacStringConstant) +begin + case op^.kind of + ElnaTacKind.constant: + qbe_write_word(file, op^.constant) + | ElnaTacKind.variable: + if is_global(globals, op^.name) or is_string_constant(strings, op^.name) then + qbe_write_str(file, "$\0".ptr) + else + qbe_write_str(file, "%\0".ptr) + end; + qbe_write_slice(file, op^.name) + | ElnaTacKind.label: + qbe_write_str(file, "@\0".ptr); + qbe_write_slice(file, op^.name) + else + end +return + +proc var_needs_stack_alloc(instructions: ^ElnaList; sym_table: ^ElnaSymbolTable; name: []const Word8) -> Bool +var + node: ^ElnaListNode + inst: ^ElnaTacInstruction + var_type: ^ElnaType + result: Bool := false +begin + var_type := get_param_type(sym_table, name); + if var_type <> nil then + if var_type^.kind = ElnaTypeKind._record or var_type^.kind = ElnaTypeKind.array then + result := true + end + end; + + node := instructions^.first; + while node <> nil & ~result do + inst := cast(node: ^ElnaTacInstruction); + if inst^.operator = ElnaTacOperator.get_address & inst^.operands[1].name = name then + result := true + elsif inst^.operator = ElnaTacOperator.copy_to_offset & inst^.operands[2].name = name then + result := true + elsif inst^.operator = ElnaTacOperator.copy_from_offset & inst^.operands[1].name = name then + result := true + end; + node := node^.next + end +return result + +proc qbe_emit_procedure(file: ^FILE; proc_node: ^ElnaTacProcedure; + globals: ^ElnaTacStaticVariable; strings: ^ElnaTacStringConstant) +var + node: ^ElnaListNode + inst: ^ElnaTacInstruction + ret_type: ^ElnaType + param_idx: Word := 0u + param_name: []const Word8 + param_type: ^ElnaType + entry: ^ElnaSymbolEntry + temp_info: ^ElnaSymbolTemporaryInfo + sym_idx: Word := 0u + alloc_size: Word + last_operator: ElnaTacOperator := ElnaTacOperator.nop + tid: Word + arg_i: Word + arg_op: ^ElnaTacOperand + callee_ret: ^ElnaType + scaled: Word +begin + qbe_write_str(file, "export function \0".ptr); + ret_type := get_procedure_return_type(proc_node^.name); + + if proc_node^.name = "main" then + qbe_write_str(file, "w \0".ptr) + elsif ret_type <> nil then + if ret_type = bool_type then + qbe_write_str(file, "w \0".ptr) + else + qbe_write_str(file, "l \0".ptr) + end + end; + + qbe_write_str(file, "$\0".ptr); + qbe_write_slice(file, proc_node^.name); + qbe_write_str(file, "(\0".ptr); + + while param_idx < proc_node^.count do + param_name := (proc_node^.parameters + param_idx)^; + param_type := get_param_type(proc_node^.symbol_table, param_name); + if param_type = bool_type then + qbe_write_str(file, "w %\0".ptr) + else + qbe_write_str(file, "l %\0".ptr) + end; + qbe_write_slice(file, param_name); + if param_idx + 1u < proc_node^.count then + qbe_write_str(file, ", \0".ptr) + end; + param_idx := param_idx + 1u + end; + + qbe_write_str(file, ") {\n@start\n\0".ptr); + + (* Stack allocate variables needing memory address *) + if proc_node^.symbol_table <> nil then + while sym_idx < proc_node^.symbol_table^.count do + entry := proc_node^.symbol_table^.symbols + sym_idx; + if entry^.name.length > 0u & entry^.symbol_info <> nil then + if entry^.symbol_info^.kind = ElnaSymbolInfoKind.temporary_info then + temp_info := cast(entry^.symbol_info: ^ElnaSymbolTemporaryInfo); + if var_needs_stack_alloc(@proc_node^.body, proc_node^.symbol_table, entry^.name) then + alloc_size := 8u; + if temp_info^.variable_type <> nil & temp_info^.variable_type^.size > 8u then + alloc_size := (temp_info^.variable_type^.size + 7u) / 8u * 8u + end; + qbe_write_str(file, "\t%\0".ptr); + qbe_write_slice(file, entry^.name); + qbe_write_str(file, " =l alloc8 \0".ptr); + qbe_write_word(file, alloc_size); + qbe_write_str(file, "\n\0".ptr) + end + end + end; + sym_idx := sym_idx + 1u + end + end; + + (* Emit TAC instructions *) + node := proc_node^.body.first; + while node <> nil do + inst := cast(node: ^ElnaTacInstruction); + last_operator := inst^.operator; + + case inst^.operator of + ElnaTacOperator.get_address: + qbe_write_str(file, "\t%\0".ptr); + qbe_write_slice(file, inst^.operands[2].name); + qbe_write_str(file, " =l copy \0".ptr); + if is_global(globals, inst^.operands[1].name) or is_string_constant(strings, inst^.operands[1].name) then + qbe_write_str(file, "$\0".ptr) + else + qbe_write_str(file, "%\0".ptr) + end; + qbe_write_slice(file, inst^.operands[1].name); + qbe_write_str(file, "\n\0".ptr) + | ElnaTacOperator.copy: + qbe_write_str(file, "\t%\0".ptr); + qbe_write_slice(file, inst^.operands[2].name); + qbe_write_str(file, " =l copy \0".ptr); + qbe_emit_operand(file, @inst^.operands[1], globals, strings); + qbe_write_str(file, "\n\0".ptr) + | ElnaTacOperator.add: + qbe_write_str(file, "\t%\0".ptr); + qbe_write_slice(file, inst^.operands[3].name); + qbe_write_str(file, " =l add \0".ptr); + qbe_emit_operand(file, @inst^.operands[1], globals, strings); + qbe_write_str(file, ", \0".ptr); + qbe_emit_operand(file, @inst^.operands[2], globals, strings); + qbe_write_str(file, "\n\0".ptr) + | ElnaTacOperator.subtract: + qbe_write_str(file, "\t%\0".ptr); + qbe_write_slice(file, inst^.operands[3].name); + qbe_write_str(file, " =l sub \0".ptr); + qbe_emit_operand(file, @inst^.operands[1], globals, strings); + qbe_write_str(file, ", \0".ptr); + qbe_emit_operand(file, @inst^.operands[2], globals, strings); + qbe_write_str(file, "\n\0".ptr) + | ElnaTacOperator.multiply: + qbe_write_str(file, "\t%\0".ptr); + qbe_write_slice(file, inst^.operands[3].name); + qbe_write_str(file, " =l mul \0".ptr); + qbe_emit_operand(file, @inst^.operands[1], globals, strings); + qbe_write_str(file, ", \0".ptr); + qbe_emit_operand(file, @inst^.operands[2], globals, strings); + qbe_write_str(file, "\n\0".ptr) + | ElnaTacOperator.divide: + qbe_write_str(file, "\t%\0".ptr); + qbe_write_slice(file, inst^.operands[3].name); + qbe_write_str(file, " =l div \0".ptr); + qbe_emit_operand(file, @inst^.operands[1], globals, strings); + qbe_write_str(file, ", \0".ptr); + qbe_emit_operand(file, @inst^.operands[2], globals, strings); + qbe_write_str(file, "\n\0".ptr) + | ElnaTacOperator.remainder: + qbe_write_str(file, "\t%\0".ptr); + qbe_write_slice(file, inst^.operands[3].name); + qbe_write_str(file, " =l rem \0".ptr); + qbe_emit_operand(file, @inst^.operands[1], globals, strings); + qbe_write_str(file, ", \0".ptr); + qbe_emit_operand(file, @inst^.operands[2], globals, strings); + qbe_write_str(file, "\n\0".ptr) + | ElnaTacOperator._or: + qbe_write_str(file, "\t%\0".ptr); + qbe_write_slice(file, inst^.operands[3].name); + qbe_write_str(file, " =l or \0".ptr); + qbe_emit_operand(file, @inst^.operands[1], globals, strings); + qbe_write_str(file, ", \0".ptr); + qbe_emit_operand(file, @inst^.operands[2], globals, strings); + qbe_write_str(file, "\n\0".ptr) + | ElnaTacOperator._xor: + qbe_write_str(file, "\t%\0".ptr); + qbe_write_slice(file, inst^.operands[3].name); + qbe_write_str(file, " =l xor \0".ptr); + qbe_emit_operand(file, @inst^.operands[1], globals, strings); + qbe_write_str(file, ", \0".ptr); + qbe_emit_operand(file, @inst^.operands[2], globals, strings); + qbe_write_str(file, "\n\0".ptr) + | ElnaTacOperator.and: + qbe_write_str(file, "\t%\0".ptr); + qbe_write_slice(file, inst^.operands[3].name); + qbe_write_str(file, " =l and \0".ptr); + qbe_emit_operand(file, @inst^.operands[1], globals, strings); + qbe_write_str(file, ", \0".ptr); + qbe_emit_operand(file, @inst^.operands[2], globals, strings); + qbe_write_str(file, "\n\0".ptr) + | ElnaTacOperator.equal: + qbe_write_str(file, "\t%\0".ptr); + qbe_write_slice(file, inst^.operands[3].name); + qbe_write_str(file, " =w ceql \0".ptr); + qbe_emit_operand(file, @inst^.operands[1], globals, strings); + qbe_write_str(file, ", \0".ptr); + qbe_emit_operand(file, @inst^.operands[2], globals, strings); + qbe_write_str(file, "\n\0".ptr) + | ElnaTacOperator.not_equal: + qbe_write_str(file, "\t%\0".ptr); + qbe_write_slice(file, inst^.operands[3].name); + qbe_write_str(file, " =w cnew \0".ptr); + qbe_emit_operand(file, @inst^.operands[1], globals, strings); + qbe_write_str(file, ", \0".ptr); + qbe_emit_operand(file, @inst^.operands[2], globals, strings); + qbe_write_str(file, "\n\0".ptr) + | ElnaTacOperator.less_than: + qbe_write_str(file, "\t%\0".ptr); + qbe_write_slice(file, inst^.operands[3].name); + qbe_write_str(file, " =w csltl \0".ptr); + qbe_emit_operand(file, @inst^.operands[1], globals, strings); + qbe_write_str(file, ", \0".ptr); + qbe_emit_operand(file, @inst^.operands[2], globals, strings); + qbe_write_str(file, "\n\0".ptr) + | ElnaTacOperator.greater_than: + qbe_write_str(file, "\t%\0".ptr); + qbe_write_slice(file, inst^.operands[3].name); + qbe_write_str(file, " =w csgtl \0".ptr); + qbe_emit_operand(file, @inst^.operands[1], globals, strings); + qbe_write_str(file, ", \0".ptr); + qbe_emit_operand(file, @inst^.operands[2], globals, strings); + qbe_write_str(file, "\n\0".ptr) + | ElnaTacOperator.less_or_equal: + qbe_write_str(file, "\t%\0".ptr); + qbe_write_slice(file, inst^.operands[3].name); + qbe_write_str(file, " =w cslel \0".ptr); + qbe_emit_operand(file, @inst^.operands[1], globals, strings); + qbe_write_str(file, ", \0".ptr); + qbe_emit_operand(file, @inst^.operands[2], globals, strings); + qbe_write_str(file, "\n\0".ptr) + | ElnaTacOperator.greater_or_equal: + qbe_write_str(file, "\t%\0".ptr); + qbe_write_slice(file, inst^.operands[3].name); + qbe_write_str(file, " =w csgel \0".ptr); + qbe_emit_operand(file, @inst^.operands[1], globals, strings); + qbe_write_str(file, ", \0".ptr); + qbe_emit_operand(file, @inst^.operands[2], globals, strings); + qbe_write_str(file, "\n\0".ptr) + | ElnaTacOperator.negate: + qbe_write_str(file, "\t%\0".ptr); + qbe_write_slice(file, inst^.operands[2].name); + qbe_write_str(file, " =l neg \0".ptr); + qbe_emit_operand(file, @inst^.operands[1], globals, strings); + qbe_write_str(file, "\n\0".ptr) + | ElnaTacOperator.complement: + qbe_write_str(file, "\t%\0".ptr); + qbe_write_slice(file, inst^.operands[2].name); + qbe_write_str(file, " =l xor \0".ptr); + qbe_emit_operand(file, @inst^.operands[1], globals, strings); + qbe_write_str(file, ", -1\n\0".ptr) + | ElnaTacOperator.load: + qbe_write_str(file, "\t%\0".ptr); + qbe_write_slice(file, inst^.operands[2].name); + qbe_write_str(file, " =l loadl \0".ptr); + qbe_emit_operand(file, @inst^.operands[1], globals, strings); + qbe_write_str(file, "\n\0".ptr) + | ElnaTacOperator.store: + qbe_write_str(file, "\tstorel \0".ptr); + qbe_emit_operand(file, @inst^.operands[1], globals, strings); + qbe_write_str(file, ", \0".ptr); + qbe_emit_operand(file, @inst^.operands[2], globals, strings); + qbe_write_str(file, "\n\0".ptr) + | ElnaTacOperator.copy_to_offset: + if inst^.operands[3].constant = 0u then + qbe_write_str(file, "\tstorel \0".ptr); + qbe_emit_operand(file, @inst^.operands[1], globals, strings); + qbe_write_str(file, ", \0".ptr); + qbe_emit_operand(file, @inst^.operands[2], globals, strings); + qbe_write_str(file, "\n\0".ptr) + else + qbe_unique_id := qbe_unique_id + 1u; + tid := qbe_unique_id; + qbe_write_str(file, "\t%qbe_off_\0".ptr); + qbe_write_word(file, tid); + qbe_write_str(file, " =l add \0".ptr); + qbe_emit_operand(file, @inst^.operands[2], globals, strings); + qbe_write_str(file, ", \0".ptr); + qbe_write_word(file, inst^.operands[3].constant); + qbe_write_str(file, "\n\tstorel \0".ptr); + qbe_emit_operand(file, @inst^.operands[1], globals, strings); + qbe_write_str(file, ", %qbe_off_\0".ptr); + qbe_write_word(file, tid); + qbe_write_str(file, "\n\0".ptr) + end + | ElnaTacOperator.copy_from_offset: + if inst^.operands[2].constant = 0u then + qbe_write_str(file, "\t%\0".ptr); + qbe_write_slice(file, inst^.operands[3].name); + qbe_write_str(file, " =l loadl \0".ptr); + qbe_emit_operand(file, @inst^.operands[1], globals, strings); + qbe_write_str(file, "\n\0".ptr) + else + qbe_unique_id := qbe_unique_id + 1u; + tid := qbe_unique_id; + qbe_write_str(file, "\t%qbe_off_\0".ptr); + qbe_write_word(file, tid); + qbe_write_str(file, " =l add \0".ptr); + qbe_emit_operand(file, @inst^.operands[1], globals, strings); + qbe_write_str(file, ", \0".ptr); + qbe_write_word(file, inst^.operands[2].constant); + qbe_write_str(file, "\n\t%\0".ptr); + qbe_write_slice(file, inst^.operands[3].name); + qbe_write_str(file, " =l loadl %qbe_off_\0".ptr); + qbe_write_word(file, tid); + qbe_write_str(file, "\n\0".ptr) + end + | ElnaTacOperator.add_ptr: + qbe_unique_id := qbe_unique_id + 1u; + tid := qbe_unique_id; + if inst^.operands[2].kind = ElnaTacKind.constant then + if inst^.operands[3].constant = 1u then + qbe_write_str(file, "\t%\0".ptr); + qbe_write_slice(file, inst^.operands[4].name); + qbe_write_str(file, " =l add \0".ptr); + qbe_emit_operand(file, @inst^.operands[1], globals, strings); + qbe_write_str(file, ", \0".ptr); + qbe_write_word(file, inst^.operands[2].constant); + qbe_write_str(file, "\n\0".ptr) + else + scaled := inst^.operands[2].constant * inst^.operands[3].constant; + qbe_write_str(file, "\t%\0".ptr); + qbe_write_slice(file, inst^.operands[4].name); + qbe_write_str(file, " =l add \0".ptr); + qbe_emit_operand(file, @inst^.operands[1], globals, strings); + qbe_write_str(file, ", \0".ptr); + qbe_write_word(file, scaled); + qbe_write_str(file, "\n\0".ptr) + end + else + qbe_write_str(file, "\t%qbe_ext_\0".ptr); + qbe_write_word(file, tid); + qbe_write_str(file, " =l extuw \0".ptr); + qbe_emit_operand(file, @inst^.operands[2], globals, strings); + qbe_write_str(file, "\n\0".ptr); + + if inst^.operands[3].constant = 1u then + qbe_write_str(file, "\t%\0".ptr); + qbe_write_slice(file, inst^.operands[4].name); + qbe_write_str(file, " =l add \0".ptr); + qbe_emit_operand(file, @inst^.operands[1], globals, strings); + qbe_write_str(file, ", %qbe_ext_\0".ptr); + qbe_write_word(file, tid); + qbe_write_str(file, "\n\0".ptr) + else + qbe_write_str(file, "\t%qbe_s_\0".ptr); + qbe_write_word(file, tid); + qbe_write_str(file, " =l mul %qbe_ext_\0".ptr); + qbe_write_word(file, tid); + qbe_write_str(file, ", \0".ptr); + qbe_write_word(file, inst^.operands[3].constant); + qbe_write_str(file, "\n\t%\0".ptr); + qbe_write_slice(file, inst^.operands[4].name); + qbe_write_str(file, " =l add \0".ptr); + qbe_emit_operand(file, @inst^.operands[1], globals, strings); + qbe_write_str(file, ", %qbe_s_\0".ptr); + qbe_write_word(file, tid); + qbe_write_str(file, "\n\0".ptr) + end + end + | ElnaTacOperator.proc_call: + callee_ret := get_procedure_return_type(inst^.operands[1].name); + if inst^.operands[3].kind = ElnaTacKind.ignore then + qbe_write_str(file, "\tcall $\0".ptr) + else + qbe_write_str(file, "\t%\0".ptr); + qbe_write_slice(file, inst^.operands[3].name); + if callee_ret = bool_type then + qbe_write_str(file, " =w call $\0".ptr) + else + qbe_write_str(file, " =l call $\0".ptr) + end + end; + qbe_write_slice(file, inst^.operands[1].name); + qbe_write_str(file, "(\0".ptr); + + arg_i := 0u; + while arg_i < inst^.operands[2].length do + arg_op := inst^.operands[2].list_operands + arg_i; + qbe_write_str(file, "l \0".ptr); + qbe_emit_operand(file, arg_op, globals, strings); + if arg_i + 1u < inst^.operands[2].length then + qbe_write_str(file, ", \0".ptr) + end; + arg_i := arg_i + 1u + end; + qbe_write_str(file, ")\n\0".ptr) + | ElnaTacOperator.jump: + qbe_write_str(file, "\tjmp @\0".ptr); + qbe_write_slice(file, inst^.operands[1].name); + qbe_write_str(file, "\n\0".ptr) + | ElnaTacOperator.jump_if_zero: + qbe_unique_id := qbe_unique_id + 1u; + tid := qbe_unique_id; + qbe_write_str(file, "\tjnz \0".ptr); + qbe_emit_operand(file, @inst^.operands[1], globals, strings); + qbe_write_str(file, ", @qbe_ft_\0".ptr); + qbe_write_word(file, tid); + qbe_write_str(file, ", @\0".ptr); + qbe_write_slice(file, inst^.operands[2].name); + qbe_write_str(file, "\n@qbe_ft_\0".ptr); + qbe_write_word(file, tid); + qbe_write_str(file, "\n\0".ptr) + | ElnaTacOperator.jump_if_not_zero: + qbe_unique_id := qbe_unique_id + 1u; + tid := qbe_unique_id; + qbe_write_str(file, "\tjnz \0".ptr); + qbe_emit_operand(file, @inst^.operands[1], globals, strings); + qbe_write_str(file, ", @\0".ptr); + qbe_write_slice(file, inst^.operands[2].name); + qbe_write_str(file, ", @qbe_ft_\0".ptr); + qbe_write_word(file, tid); + qbe_write_str(file, "\n@qbe_ft_\0".ptr); + qbe_write_word(file, tid); + qbe_write_str(file, "\n\0".ptr) + | ElnaTacOperator.label: + qbe_write_str(file, "@\0".ptr); + qbe_write_slice(file, inst^.operands[1].name); + qbe_write_str(file, "\n\0".ptr) + | ElnaTacOperator._return: + if inst^.operands[1].kind = ElnaTacKind.ignore then + qbe_write_str(file, "\tret\n\0".ptr) + else + qbe_write_str(file, "\tret \0".ptr); + qbe_emit_operand(file, @inst^.operands[1], globals, strings); + qbe_write_str(file, "\n\0".ptr) + end + else + end; + node := node^.next + end; + + (* Function terminator if not terminated *) + if last_operator <> ElnaTacOperator._return & last_operator <> ElnaTacOperator.jump then + if proc_node^.name = "main" then + qbe_write_str(file, "\tret 0\n\0".ptr) + elsif ret_type = nil then + qbe_write_str(file, "\tret\n\0".ptr) + else + qbe_write_str(file, "\tret 0\n\0".ptr) + end + end; + + qbe_write_str(file, "}\n\n\0".ptr) +return + +proc elna_qbe_emit*(instruction_module: ^ElnaInstructionModule; out_file: ^FILE) +var + current_string: ^ElnaTacStringConstant + current_global: ^ElnaTacStaticVariable + current_proc: ^ElnaTacProcedure + i: Word + byte_val: Word +begin + (* Emit strings *) + current_string := instruction_module^.strings; + while current_string <> nil do + qbe_write_str(out_file, "data $\0".ptr); + qbe_write_slice(out_file, current_string^.name); + qbe_write_str(out_file, " = { \0".ptr); + + i := 0u; + while i < current_string^.value.length do + qbe_write_str(out_file, "b \0".ptr); + byte_val := cast((current_string^.value.ptr + i)^: Word); + qbe_write_word(out_file, byte_val); + qbe_write_str(out_file, ", \0".ptr); + i := i + 1u + end; + qbe_write_str(out_file, "b 0 }\n\0".ptr); + + current_string := current_string^.next + end; + + (* Emit global data *) + current_global := instruction_module^.data; + while current_global <> nil do + qbe_write_str(out_file, "export data $\0".ptr); + qbe_write_slice(out_file, current_global^.name); + qbe_write_str(out_file, " = { z \0".ptr); + qbe_write_word(out_file, current_global^.size); + qbe_write_str(out_file, " }\n\0".ptr); + + current_global := current_global^.next + end; + + (* Emit procedures *) + current_proc := instruction_module^.code; + while current_proc <> nil do + qbe_emit_procedure(out_file, current_proc, instruction_module^.data, instruction_module^.strings); + current_proc := current_proc^.next + end +return + +end. diff --git a/source/symbol.elna b/source/symbol.elna new file mode 100644 index 0000000..531f58c --- /dev/null +++ b/source/symbol.elna @@ -0,0 +1,200 @@ +(* 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/. *) +module +import cstdlib, common, ast + +type + ElnaSymbolInfoKind* = (type_info, temporary_info, procedure_info) + ElnaSymbolInfo* = record + kind: ElnaSymbolInfoKind + end + ElnaSymbolTypeInfo* = record(ElnaSymbolInfo) + _type: ^ElnaType + end + ElnaSymbolTemporaryInfo* = record(ElnaSymbolInfo) + attr: Word; + variable_type: ^ElnaType + end + ElnaSymbolProcedureInfo* = record(ElnaSymbolInfo) + symbol_table: ^ElnaSymbolTable; + procedure_type: ^ElnaTypeProcedure; + is_extern: Bool + end + + ElnaSymbolEntry* = record + name: []const Word8; + symbol_info: ^ElnaSymbolInfo + end + ElnaSymbolTable* = record + count: Word; + capacity: Word; + parent: ^ElnaSymbolTable; + symbols: ^ElnaSymbolEntry + end + +var + symbol_table_global*: ^ElnaSymbolTable + word_type*: ^ElnaType + int_type*: ^ElnaType + pointer_type*: ^ElnaType + bool_type*: ^ElnaType + char_type*: ^ElnaType + string_type*: ^ElnaTypeRecord + +proc elna_symbol_type_info_create*(type_representation: ^ElnaType) -> ^ElnaSymbolTypeInfo +var + result: ^ElnaSymbolTypeInfo +begin + result := malloc#[ElnaSymbolTypeInfo](#size(ElnaSymbolTypeInfo)); + result^.kind := ElnaSymbolInfoKind.type_info; + result^._type := type_representation +return result + +proc elna_symbol_temporary_info_create*(attr: Word; temporary_type: ^ElnaType) -> ^ElnaSymbolTemporaryInfo +var + result: ^ElnaSymbolTemporaryInfo +begin + result := malloc#[ElnaSymbolTemporaryInfo](#size(ElnaSymbolTemporaryInfo)); + result^.kind := ElnaSymbolInfoKind.temporary_info; + result^.variable_type := temporary_type; + result^.attr := attr +return result + +proc elna_symbol_procedure_info_create*(is_extern: Bool) -> ^ElnaSymbolProcedureInfo +var + result: ^ElnaSymbolProcedureInfo +begin + result := malloc#[ElnaSymbolProcedureInfo](#size(ElnaSymbolProcedureInfo)); + result^.kind := ElnaSymbolInfoKind.procedure_info; + result^.procedure_type := nil; + result^.symbol_table := nil; + result^.is_extern := is_extern +return result + +proc elna_symbol_table_create*(parent: ^ElnaSymbolTable) -> ^ElnaSymbolTable +var + new_symbol_table: ^ElnaSymbolTable +begin + new_symbol_table := malloc#[ElnaSymbolTable](#size(ElnaSymbolTable)); + new_symbol_table^.capacity := 64u; + new_symbol_table^.symbols := malloc#[ElnaSymbolEntry](new_symbol_table^.capacity * #size(ElnaSymbolEntry)); + new_symbol_table^.count := 0u; + new_symbol_table^.parent := parent +return new_symbol_table + +proc elna_symbol_table_enter*(symbol_table: ^ElnaSymbolTable; symbol_name: []const Word8; symbol: ^ElnaSymbolInfo) +var + entry: ^ElnaSymbolEntry +begin + if symbol_table^.count >= symbol_table^.capacity then + symbol_table^.capacity := symbol_table^.capacity * 2u; + symbol_table^.symbols := realloc#[ElnaSymbolEntry](symbol_table^.symbols, symbol_table^.capacity * #size(ElnaSymbolEntry)) + end; + entry := symbol_table^.symbols + symbol_table^.count; + entry^.name := symbol_name; + entry^.symbol_info := symbol; + symbol_table^.count := symbol_table^.count + 1u +return + +proc elna_symbol_table_lookup_local*(symbol_table: ^ElnaSymbolTable; symbol_name: []const Word8) -> ^ElnaSymbolInfo +var + i: Word := 0u + entry: ^ElnaSymbolEntry + result: ^ElnaSymbolInfo := nil +begin + while i < symbol_table^.count & result = nil do + entry := symbol_table^.symbols + i; + if entry^.name = symbol_name then + result := entry^.symbol_info + end; + i := i + 1u + end +return result + +proc elna_symbol_table_lookup*(symbol_table: ^ElnaSymbolTable; symbol_name: []const Word8) -> ^ElnaSymbolInfo +var + current: ^ElnaSymbolTable + found: ^ElnaSymbolInfo := nil +begin + current := symbol_table; + while current <> nil & found = nil do + found := elna_symbol_table_lookup_local(current, symbol_name); + current := current^.parent + end +return found + +proc elna_symbol_string_build() +var + current_field: ^ElnaTypeField + char_pointer: ^ElnaTypePointer +begin + string_type := malloc#[ElnaTypeRecord](#size(ElnaTypeRecord)); + string_type^.kind := ElnaTypeKind._record; + string_type^.size := 16u; + string_type^.alignment := 8u; + string_type^.members := malloc#[ElnaTypeField](2u * #size(ElnaTypeField)); + string_type^.length := 2u; + + char_pointer := malloc#[ElnaTypePointer](#size(ElnaTypePointer)); + char_pointer^.kind := ElnaTypeKind.pointer; + char_pointer^.size := 8u; + char_pointer^.alignment := 8u; + char_pointer^.base := char_type; + + current_field := string_type^.members; + current_field^.name := "ptr"; + current_field^.field_type := cast(char_pointer: ^ElnaType); + + current_field := current_field + 1u; + current_field^.name := "length"; + current_field^.field_type := word_type +return + +proc elna_symbol_table_build*() +var + current_info: ^ElnaSymbolTypeInfo +begin + symbol_table_global := elna_symbol_table_create(nil); + + word_type := malloc#[ElnaType](#size(ElnaType)); + word_type^.kind := ElnaTypeKind.primitive; + word_type^.size := 8u; + word_type^.alignment := 8u; + current_info := elna_symbol_type_info_create(word_type); + elna_symbol_table_enter(symbol_table_global, "Word", cast(current_info: ^ElnaSymbolInfo)); + + int_type := malloc#[ElnaType](#size(ElnaType)); + int_type^.kind := ElnaTypeKind.primitive; + int_type^.size := 8u; + int_type^.alignment := 8u; + current_info := elna_symbol_type_info_create(int_type); + elna_symbol_table_enter(symbol_table_global, "Int", cast(current_info: ^ElnaSymbolInfo)); + + pointer_type := malloc#[ElnaType](#size(ElnaType)); + pointer_type^.kind := ElnaTypeKind.primitive; + pointer_type^.size := 8u; + pointer_type^.alignment := 8u; + current_info := elna_symbol_type_info_create(pointer_type); + elna_symbol_table_enter(symbol_table_global, "Pointer", cast(current_info: ^ElnaSymbolInfo)); + + bool_type := malloc#[ElnaType](#size(ElnaType)); + bool_type^.kind := ElnaTypeKind.primitive; + bool_type^.size := 1u; + bool_type^.alignment := 1u; + current_info := elna_symbol_type_info_create(bool_type); + elna_symbol_table_enter(symbol_table_global, "Bool", cast(current_info: ^ElnaSymbolInfo)); + + char_type := malloc#[ElnaType](#size(ElnaType)); + char_type^.kind := ElnaTypeKind.primitive; + char_type^.size := 1u; + char_type^.alignment := 1u; + current_info := elna_symbol_type_info_create(char_type); + elna_symbol_table_enter(symbol_table_global, "Char", cast(current_info: ^ElnaSymbolInfo)); + + elna_symbol_string_build(); + current_info := elna_symbol_type_info_create(cast(string_type: ^ElnaType)); + elna_symbol_table_enter(symbol_table_global, "String", cast(current_info: ^ElnaSymbolInfo)) +return + +end. diff --git a/source/tac.elna b/source/tac.elna new file mode 100644 index 0000000..7b05ab2 --- /dev/null +++ b/source/tac.elna @@ -0,0 +1,1074 @@ +(* 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/. *) +module +import common, cstdlib, cstdio, cstring, lexer, ast, symbol, diagnostic + +type + 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) + + ElnaTacOperand* = record + kind: ElnaTacKind; + name: []const Word8; + constant: Word; + length: Word; + list_operands: ^ElnaTacOperand + end + + ElnaTacInstruction* = record(ElnaListNode) + operator: ElnaTacOperator; + operands: [4]ElnaTacOperand + end + + ElnaTacProcedure* = record + next: ^ElnaTacProcedure; + name: []const Word8; + body: ElnaList; + parameters: ^[]const Word8; + count: Word; + symbol_table: ^ElnaSymbolTable + end + + ElnaTacStaticVariable* = record + next: ^ElnaTacStaticVariable; + name: []const Word8; + size: Word + end + + ElnaTacStringConstant* = record + next: ^ElnaTacStringConstant; + name: []const Word8; + value: []const Word8 + end + + ElnaInstructionModule* = record + strings: ^ElnaTacStringConstant; + data: ^ElnaTacStaticVariable; + code: ^ElnaTacProcedure + end + + ElnaTacOperandType = (plain_object, dereferenced_pointer, sub_object) + + ElnaTacOperandResult = record + kind: ElnaTacOperandType; + offset: Word + end + +var + pseudo_counter: Word := 0u + label_counter: Word := 0u + string_counter: Word := 0u + module_strings_first: ^ElnaTacStringConstant := nil + module_strings_last: ^ElnaTacStringConstant := nil + +proc elna_tac_instruction_create*(operator: ElnaTacOperator) -> ^ElnaTacInstruction +var + result: ^ElnaTacInstruction +begin + result := malloc#[ElnaTacInstruction](#size(ElnaTacInstruction)); + result^.next := nil; + result^.operator := operator; + result^.operands[1].kind := ElnaTacKind.ignore; + result^.operands[2].kind := ElnaTacKind.ignore; + result^.operands[3].kind := ElnaTacKind.ignore; + result^.operands[4].kind := ElnaTacKind.ignore +return result + +proc elna_tac_instruction_set_operand*(this: ^ElnaTacInstruction; n: Word; + kind: ElnaTacKind; name: []const Word8; constant: Word; length: Word) +begin + this^.operands[n].kind := kind; + this^.operands[n].name := name; + this^.operands[n].constant := constant; + this^.operands[n].length := length; + this^.operands[n].list_operands := nil +return + +proc elna_tac_instruction_set_op*(this: ^ElnaTacInstruction; n: Word; op: ^ElnaTacOperand) +begin + this^.operands[n] := op^ +return + +proc elna_tac_instruction_set_const*(this: ^ElnaTacInstruction; n: Word; value: Word; length: Word) +begin + this^.operands[n].kind := ElnaTacKind.constant; + this^.operands[n].name := ""; + this^.operands[n].constant := value; + this^.operands[n].length := length; + this^.operands[n].list_operands := nil +return + +proc elna_tac_instruction_set_label*(this: ^ElnaTacInstruction; n: Word; label_name: []const Word8) +begin + this^.operands[n].kind := ElnaTacKind.label; + this^.operands[n].name := label_name; + this^.operands[n].constant := 0u; + this^.operands[n].length := label_name.length; + this^.operands[n].list_operands := nil +return + +proc elna_tac_make_variable*(operand: ^ElnaTacOperand; symbol_table: ^ElnaSymbolTable; variable_type: ^ElnaType) +var + buffer: ^Word8 + name_slice: []const Word8 + temporary_info: ^ElnaSymbolTemporaryInfo + len: Int +begin + pseudo_counter := pseudo_counter + 1u; + buffer := malloc#[Word8](16u); + len := sprintf(buffer, "t%u\0".ptr, pseudo_counter); + + name_slice := buffer[1u to cast(len: Word)]; + + operand^.kind := ElnaTacKind.variable; + operand^.name := name_slice; + operand^.constant := 0u; + operand^.length := name_slice.length; + operand^.list_operands := nil; + + temporary_info := elna_symbol_temporary_info_create(1u, variable_type); + elna_symbol_table_enter(symbol_table, name_slice, cast(temporary_info: ^ElnaSymbolInfo)) +return + +proc elna_tac_label*() -> []const Word8 +var + buffer: ^Word8 + result: []const Word8 + len: Int +begin + label_counter := label_counter + 1u; + buffer := malloc#[Word8](16u); + len := sprintf(buffer, "l%u\0".ptr, label_counter); + result := buffer[1u to cast(len: Word)] +return result + +proc elna_tac_integer_literal(integer_literal_node: ^ElnaTreeIntegerLiteral; operand: ^ElnaTacOperand) +begin + operand^.kind := ElnaTacKind.constant; + operand^.name := ""; + operand^.constant := integer_literal_node^.value; + operand^.length := word_type^.size; + operand^.list_operands := nil +return + +proc elna_tac_boolean_literal(boolean_literal_node: ^ElnaTreeBooleanLiteral; operand: ^ElnaTacOperand) +begin + operand^.kind := ElnaTacKind.constant; + operand^.name := ""; + if boolean_literal_node^.value then + operand^.constant := 1u + else + operand^.constant := 0u + end; + operand^.length := bool_type^.size; + operand^.list_operands := nil +return + +proc elna_tac_nil_literal(operand: ^ElnaTacOperand) +begin + operand^.kind := ElnaTacKind.constant; + operand^.name := ""; + operand^.constant := 0u; + operand^.length := 8u; + operand^.list_operands := nil +return + +proc elna_tac_character_literal(character_literal_node: ^ElnaTreeCharacterLiteral; operand: ^ElnaTacOperand) +begin + operand^.kind := ElnaTacKind.constant; + operand^.name := ""; + operand^.constant := cast(character_literal_node^.value: Word); + operand^.length := char_type^.size; + operand^.list_operands := nil +return + +proc elna_tac_variable_expression(variable_expression: ^ElnaTreeVariableExpression; operand: ^ElnaTacOperand) +begin + operand^.kind := ElnaTacKind.variable; + operand^.name := variable_expression^.name; + operand^.constant := 0u; + operand^.length := variable_expression^.name.length; + operand^.list_operands := nil +return + +proc elna_tac_trait_expression(trait_node: ^ElnaTreeTraitExpression; operand: ^ElnaTacOperand) +var + symbol_info: ^ElnaSymbolInfo + type_info: ^ElnaSymbolTypeInfo + parser_node: ^ElnaTreeNamedTypeExpression +begin + parser_node := cast(trait_node^.argument: ^ElnaTreeNamedTypeExpression); + symbol_info := elna_symbol_table_lookup(symbol_table_global, parser_node^.name); + + operand^.kind := ElnaTacKind.constant; + operand^.name := ""; + operand^.length := 8u; + operand^.list_operands := nil; + if symbol_info <> nil & symbol_info^.kind = ElnaSymbolInfoKind.type_info then + type_info := cast(symbol_info: ^ElnaSymbolTypeInfo); + operand^.constant := type_info^._type^.size + else + operand^.constant := 0u + end +return + +proc elna_tac_string_literal(instructions: ^ElnaList; string_literal_node: ^ElnaTreeStringLiteral; + symbol_table: ^ElnaSymbolTable; operand: ^ElnaTacOperand) +var + string_entry: ^ElnaTacStringConstant + label_buf: ^Word8 + label_slice: []const Word8 + label_len: Int + instruction: ^ElnaTacInstruction + address: ElnaTacOperand +begin + string_counter := string_counter + 1u; + label_buf := malloc#[Word8](16u); + label_len := sprintf(label_buf, "str_%u\0".ptr, string_counter); + label_slice := label_buf[1u to cast(label_len: Word)]; + + string_entry := malloc#[ElnaTacStringConstant](#size(ElnaTacStringConstant)); + string_entry^.next := nil; + string_entry^.name := label_slice; + string_entry^.value := string_literal_node^.value; + + if module_strings_first = nil then + module_strings_first := string_entry + else + module_strings_last^.next := string_entry + end; + module_strings_last := string_entry; + + elna_tac_make_variable(operand, symbol_table, cast(string_type: ^ElnaType)); + elna_tac_make_variable(@address, symbol_table, pointer_type); + + instruction := elna_tac_instruction_create(ElnaTacOperator.get_address); + elna_tac_instruction_set_operand(instruction, 1u, ElnaTacKind.variable, label_slice, 0u, label_slice.length); + elna_tac_instruction_set_op(instruction, 2u, @address); + elna_list_append(instructions, cast(instruction: ^ElnaListNode)); + + instruction := elna_tac_instruction_create(ElnaTacOperator.copy_to_offset); + elna_tac_instruction_set_op(instruction, 1u, @address); + elna_tac_instruction_set_op(instruction, 2u, operand); + elna_tac_instruction_set_const(instruction, 3u, 0u, 8u); + elna_list_append(instructions, cast(instruction: ^ElnaListNode)); + + instruction := elna_tac_instruction_create(ElnaTacOperator.copy_to_offset); + elna_tac_instruction_set_const(instruction, 1u, string_literal_node^.value.length, 8u); + elna_tac_instruction_set_op(instruction, 2u, operand); + elna_tac_instruction_set_const(instruction, 3u, 8u, 8u); + elna_list_append(instructions, cast(instruction: ^ElnaListNode)) +return + +proc elna_tac_copy_address(instructions: ^ElnaList; operand_result: ^ElnaTacOperandResult; from, dest: ^ElnaTacOperand) +var + instruction: ^ElnaTacInstruction +begin + if operand_result^.kind = ElnaTacOperandType.dereferenced_pointer then + dest^ := from^ + elsif operand_result^.kind = ElnaTacOperandType.sub_object then + instruction := elna_tac_instruction_create(ElnaTacOperator.get_address); + elna_tac_instruction_set_op(instruction, 1u, from); + elna_tac_instruction_set_op(instruction, 2u, dest); + elna_list_append(instructions, cast(instruction: ^ElnaListNode)); + + instruction := elna_tac_instruction_create(ElnaTacOperator.add); + elna_tac_instruction_set_const(instruction, 1u, operand_result^.offset, 4u); + elna_tac_instruction_set_op(instruction, 2u, dest); + elna_tac_instruction_set_op(instruction, 3u, dest); + elna_list_append(instructions, cast(instruction: ^ElnaListNode)) + else + instruction := elna_tac_instruction_create(ElnaTacOperator.get_address); + elna_tac_instruction_set_op(instruction, 1u, from); + elna_tac_instruction_set_op(instruction, 2u, dest); + elna_list_append(instructions, cast(instruction: ^ElnaListNode)) + end +return + +proc elna_tac_simple_expression(instructions: ^ElnaList; parser_node: ^ElnaTreeExpression; + symbol_table: ^ElnaSymbolTable; operand: ^ElnaTacOperand) +begin + case parser_node^.kind of + ElnaTreeKind.integer_literal: + elna_tac_integer_literal(cast(parser_node: ^ElnaTreeIntegerLiteral), operand) + | ElnaTreeKind.character_literal: + elna_tac_character_literal(cast(parser_node: ^ElnaTreeCharacterLiteral), operand) + | ElnaTreeKind.string_literal: + elna_tac_string_literal(instructions, cast(parser_node: ^ElnaTreeStringLiteral), symbol_table, operand) + | ElnaTreeKind.boolean_literal: + elna_tac_boolean_literal(cast(parser_node: ^ElnaTreeBooleanLiteral), operand) + | ElnaTreeKind.null: + elna_tac_nil_literal(operand) + | ElnaTreeKind.variable_expression: + elna_tac_variable_expression(cast(parser_node: ^ElnaTreeVariableExpression), operand) + | ElnaTreeKind.trait_expression: + elna_tac_trait_expression(cast(parser_node: ^ElnaTreeTraitExpression), operand) + | ElnaTreeKind._cast: + elna_tac_binary_expression(instructions, (cast(parser_node: ^ElnaTreeCastExpression))^.expression, symbol_table, operand) + else + end +return + +proc elna_tac_unary_expression(instructions: ^ElnaList; parser_node: ^ElnaTreeExpression; + symbol_table: ^ElnaSymbolTable; operand: ^ElnaTacOperand) +var + operator: ElnaLexerKind + unary_operand: ^ElnaTreeExpression + unary_node: ^ElnaTreeUnaryExpression + operand_result: ElnaTacOperandResult + instruction: ^ElnaTacInstruction + base: ElnaTacOperand + has_unary: Bool := false +begin + if parser_node^.kind = ElnaTreeKind.unary_expression then + unary_node := cast(parser_node: ^ElnaTreeUnaryExpression); + operator := unary_node^.operator; + unary_operand := unary_node^.operand; + has_unary := true + else + unary_operand := parser_node + end; + elna_tac_designator(instructions, unary_operand, symbol_table, @operand_result, @base); + + if has_unary & operator = ElnaLexerKind.at then + elna_tac_make_variable(operand, symbol_table, word_type); + elna_tac_copy_address(instructions, @operand_result, @base, operand) + elsif has_unary & operator = ElnaLexerKind.minus then + elna_tac_make_variable(operand, symbol_table, parser_node^.type_decoration); + instruction := elna_tac_instruction_create(ElnaTacOperator.negate); + elna_tac_instruction_set_op(instruction, 1u, @base); + elna_tac_instruction_set_op(instruction, 2u, operand); + elna_list_append(instructions, cast(instruction: ^ElnaListNode)) + elsif has_unary & operator = ElnaLexerKind.not then + elna_tac_make_variable(operand, symbol_table, parser_node^.type_decoration); + instruction := elna_tac_instruction_create(ElnaTacOperator.complement); + elna_tac_instruction_set_op(instruction, 1u, @base); + elna_tac_instruction_set_op(instruction, 2u, operand); + elna_list_append(instructions, cast(instruction: ^ElnaListNode)) + 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_op(instruction, 1u, @base); + elna_tac_instruction_set_op(instruction, 2u, operand); + elna_list_append(instructions, cast(instruction: ^ElnaListNode)) + 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_op(instruction, 1u, @base); + elna_tac_instruction_set_const(instruction, 2u, operand_result.offset, 4u); + elna_tac_instruction_set_op(instruction, 3u, operand); + elna_list_append(instructions, cast(instruction: ^ElnaListNode)) + else + operand^ := base + end +return + +proc elna_tac_add_pointer(parser_node: ^ElnaTreeExpression; lhs, rhs: ^ElnaTacOperand; + symbol_table: ^ElnaSymbolTable; operand: ^ElnaTacOperand) -> ^ElnaTacInstruction +var + instruction: ^ElnaTacInstruction + pointer_type_node: ^ElnaTypePointer + elem_size: Word := 1u +begin + if parser_node^.type_decoration <> nil & parser_node^.type_decoration^.kind = ElnaTypeKind.pointer then + pointer_type_node := cast(parser_node^.type_decoration: ^ElnaTypePointer); + if pointer_type_node^.base <> nil then + elem_size := pointer_type_node^.base^.size + end + end; + instruction := elna_tac_instruction_create(ElnaTacOperator.add_ptr); + elna_tac_make_variable(operand, symbol_table, word_type); + elna_tac_instruction_set_op(instruction, 1u, lhs); + elna_tac_instruction_set_op(instruction, 2u, rhs); + elna_tac_instruction_set_const(instruction, 3u, elem_size, 4u); + elna_tac_instruction_set_op(instruction, 4u, operand) +return instruction + +proc elna_tac_binary_create(instructions: ^ElnaList; operator: ElnaTacOperator; + lhs, rhs: ^ElnaTacOperand; symbol_table: ^ElnaSymbolTable; operand: ^ElnaTacOperand) +var + instruction: ^ElnaTacInstruction + lhs_symbol: ^ElnaSymbolInfo + temp_info: ^ElnaSymbolTemporaryInfo + variable_type: ^ElnaType := word_type +begin + if lhs^.kind = ElnaTacKind.variable then + lhs_symbol := elna_symbol_table_lookup(symbol_table, lhs^.name); + if lhs_symbol <> nil & lhs_symbol^.kind = ElnaSymbolInfoKind.temporary_info then + temp_info := cast(lhs_symbol: ^ElnaSymbolTemporaryInfo); + variable_type := temp_info^.variable_type + end + end; + elna_tac_make_variable(operand, symbol_table, variable_type); + + instruction := elna_tac_instruction_create(operator); + elna_tac_instruction_set_op(instruction, 1u, lhs); + elna_tac_instruction_set_op(instruction, 2u, rhs); + elna_tac_instruction_set_op(instruction, 3u, operand); + elna_list_append(instructions, cast(instruction: ^ElnaListNode)) +return + +proc elna_tac_subtract_create(instructions: ^ElnaList; parser_node: ^ElnaTreeBinaryExpression; + lhs, rhs: ^ElnaTacOperand; symbol_table: ^ElnaSymbolTable; operand: ^ElnaTacOperand) +var + instruction: ^ElnaTacInstruction + lhs_is_pointer: Bool := false + rhs_is_not_pointer: Bool := true +begin + if parser_node^.lhs^.type_decoration <> nil & parser_node^.lhs^.type_decoration^.kind = ElnaTypeKind.pointer then + lhs_is_pointer := true + end; + if parser_node^.rhs^.type_decoration <> nil & parser_node^.rhs^.type_decoration^.kind = ElnaTypeKind.pointer then + rhs_is_not_pointer := false + end; + + if lhs_is_pointer & rhs_is_not_pointer then + instruction := elna_tac_instruction_create(ElnaTacOperator.negate); + elna_tac_instruction_set_op(instruction, 1u, rhs); + elna_tac_instruction_set_op(instruction, 2u, operand); + elna_list_append(instructions, cast(instruction: ^ElnaListNode)); + + instruction := elna_tac_add_pointer(parser_node^.lhs, lhs, operand, symbol_table, operand); + elna_list_append(instructions, cast(instruction: ^ElnaListNode)) + else + elna_tac_binary_create(instructions, ElnaTacOperator.subtract, lhs, rhs, symbol_table, operand) + end +return + +proc elna_tac_binary_expression(instructions: ^ElnaList; parser_node: ^ElnaTreeExpression; + symbol_table: ^ElnaSymbolTable; operand: ^ElnaTacOperand) +var + binary_node: ^ElnaTreeBinaryExpression + 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 + binary_node := cast(parser_node: ^ElnaTreeBinaryExpression); + elna_tac_unary_expression(instructions, binary_node^.lhs, symbol_table, @lhs); + elna_tac_unary_expression(instructions, binary_node^.rhs, symbol_table, @rhs); + + case binary_node^.operator of + ElnaLexerKind.plus: + if binary_node^.lhs^.type_decoration <> nil & binary_node^.lhs^.type_decoration^.kind = ElnaTypeKind.pointer then + instruction := elna_tac_add_pointer(binary_node^.lhs, @lhs, @rhs, symbol_table, operand); + elna_list_append(instructions, cast(instruction: ^ElnaListNode)) + elsif binary_node^.rhs^.type_decoration <> nil & binary_node^.rhs^.type_decoration^.kind = ElnaTypeKind.pointer then + instruction := elna_tac_add_pointer(binary_node^.rhs, @rhs, @lhs, symbol_table, operand); + elna_list_append(instructions, cast(instruction: ^ElnaListNode)) + else + elna_tac_binary_create(instructions, ElnaTacOperator.add, @lhs, @rhs, symbol_table, operand) + end + | ElnaLexerKind.minus: + elna_tac_subtract_create(instructions, binary_node, @lhs, @rhs, symbol_table, operand) + | ElnaLexerKind.multiplication: + elna_tac_binary_create(instructions, ElnaTacOperator.multiply, @lhs, @rhs, symbol_table, operand) + | ElnaLexerKind.division: + elna_tac_binary_create(instructions, ElnaTacOperator.divide, @lhs, @rhs, symbol_table, operand) + | ElnaLexerKind.remainder: + elna_tac_binary_create(instructions, ElnaTacOperator.remainder, @lhs, @rhs, symbol_table, operand) + | ElnaLexerKind.and: + elna_tac_binary_create(instructions, ElnaTacOperator.and, @lhs, @rhs, symbol_table, operand) + | ElnaLexerKind._or: + elna_tac_binary_create(instructions, ElnaTacOperator._or, @lhs, @rhs, symbol_table, operand) + | ElnaLexerKind._xor: + elna_tac_binary_create(instructions, ElnaTacOperator._xor, @lhs, @rhs, symbol_table, operand) + | ElnaLexerKind.equals: + elna_tac_binary_create(instructions, ElnaTacOperator.equal, @lhs, @rhs, symbol_table, operand) + | ElnaLexerKind.not_equal: + elna_tac_binary_create(instructions, ElnaTacOperator.not_equal, @lhs, @rhs, symbol_table, operand) + | ElnaLexerKind.less_than: + elna_tac_binary_create(instructions, ElnaTacOperator.less_than, @lhs, @rhs, symbol_table, operand) + | ElnaLexerKind.greater_than: + elna_tac_binary_create(instructions, ElnaTacOperator.greater_than, @lhs, @rhs, symbol_table, operand) + | ElnaLexerKind.less_equal: + elna_tac_binary_create(instructions, ElnaTacOperator.less_or_equal, @lhs, @rhs, symbol_table, operand) + | ElnaLexerKind.greater_equal: + elna_tac_binary_create(instructions, ElnaTacOperator.greater_or_equal, @lhs, @rhs, symbol_table, operand) + else + end + end +return + +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 + symbol_info: ^ElnaSymbolInfo + procedure_info: ^ElnaSymbolProcedureInfo + i: Word := 0u +begin + parsed_expression := parsed_call^.callee; + arguments_operand := malloc#[ElnaTacOperand](parsed_call^.count * #size(ElnaTacOperand)); + symbol_info := elna_symbol_table_lookup(symbol_table, parsed_expression^.name); + + call_instruction := elna_tac_instruction_create(ElnaTacOperator.proc_call); + elna_tac_instruction_set_label(call_instruction, 1u, parsed_expression^.name); + + call_instruction^.operands[2].kind := ElnaTacKind.list; + call_instruction^.operands[2].list_operands := arguments_operand; + call_instruction^.operands[2].length := parsed_call^.count; + + if symbol_info <> nil & symbol_info^.kind = ElnaSymbolInfoKind.procedure_info then + procedure_info := cast(symbol_info: ^ElnaSymbolProcedureInfo); + if procedure_info^.procedure_type^.return_type = nil then + call_instruction^.operands[3].kind := ElnaTacKind.ignore + else + elna_tac_make_variable(operand, symbol_table, procedure_info^.procedure_type^.return_type); + elna_tac_instruction_set_op(call_instruction, 3u, operand) + end + else + call_instruction^.operands[3].kind := ElnaTacKind.ignore + end; + + argument_entry := parsed_call^.arguments; + while argument_entry <> nil & i < parsed_call^.count do + elna_tac_binary_expression(instructions, argument_entry^.expression, symbol_table, arguments_operand + i); + argument_entry := argument_entry^.next; + i := i + 1u + end; + elna_list_append(instructions, cast(call_instruction: ^ElnaListNode)) +return + +proc elna_tac_goto_statement(instructions: ^ElnaList; parser_node: ^ElnaTreeGotoStatement) +var + instruction: ^ElnaTacInstruction +begin + instruction := elna_tac_instruction_create(ElnaTacOperator.jump); + elna_tac_instruction_set_label(instruction, 1u, parser_node^.label); + elna_list_append(instructions, cast(instruction: ^ElnaListNode)) +return + +proc elna_tac_label_declaration(instructions: ^ElnaList; parser_node: ^ElnaTreeLabelDeclaration) +var + result: ^ElnaTacInstruction +begin + result := elna_tac_instruction_create(ElnaTacOperator.label); + elna_tac_instruction_set_label(result, 1u, parser_node^.label); + elna_list_append(instructions, cast(result: ^ElnaListNode)) +return + +proc elna_tac_enumeration_value(field_access_expression: ^ElnaTreeFieldAccessExpression; operand: ^ElnaTacOperand) +var + enumeration_type: ^ElnaTypeEnumeration + members: ^[]const Word8 + members_length: Word + symbol_info: ^ElnaSymbolInfo + type_info: ^ElnaSymbolTypeInfo + counter: Word := 1u + found: Bool := false + aggregate_tree: ^ElnaTreeVariableExpression +begin + aggregate_tree := cast(field_access_expression^.aggregate: ^ElnaTreeVariableExpression); + symbol_info := elna_symbol_table_lookup(symbol_table_global, aggregate_tree^.name); + + if symbol_info <> nil & symbol_info^.kind = ElnaSymbolInfoKind.type_info then + type_info := cast(symbol_info: ^ElnaSymbolTypeInfo); + if type_info^._type^.kind = ElnaTypeKind.enumeration then + enumeration_type := cast(type_info^._type: ^ElnaTypeEnumeration); + members := enumeration_type^.members; + members_length := enumeration_type^.length; + + while members_length > 0u & ~found do + if members^ = field_access_expression^.field then + found := true; + operand^.kind := ElnaTacKind.constant; + operand^.constant := counter; + operand^.length := 4u; + operand^.name := ""; + operand^.list_operands := nil + else + members_length := members_length - 1u; + members := members + 1u; + counter := counter + 1u + end + end + end + end +return + +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_op(load_instruction, 1u, @intermediate); + elna_tac_instruction_set_op(load_instruction, 2u, operand); + elna_list_append(instructions, cast(load_instruction: ^ElnaListNode)) + 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_op(load_instruction, 1u, @intermediate); + elna_tac_instruction_set_const(load_instruction, 2u, operand_result.offset, 4u); + elna_tac_instruction_set_op(load_instruction, 3u, operand); + elna_list_append(instructions, cast(load_instruction: ^ElnaListNode)) + end +return + +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 := 0u + base: ElnaTacOperand + found: Bool := false +begin + designator_base := field_access_expression^.aggregate; + aggregate_type := cast(designator_base^.type_decoration: ^ElnaTypeRecord); + + elna_tac_designator(instructions, designator_base, symbol_table, operand_result, @base); + + if aggregate_type <> nil & aggregate_type^.kind = ElnaTypeKind._record then + field_count := aggregate_type^.length; + current_field := aggregate_type^.members; + + while field_count > 0u & ~found do + if current_field^.name = field_access_expression^.field then + found := true + else + field_type := current_field^.field_type; + field_count := field_count - 1u; + field_offset := field_offset + field_type^.size; + current_field := current_field + 1u + end + end + 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_op(instruction, 1u, @base); + elna_tac_instruction_set_const(instruction, 2u, field_offset, 4u); + elna_tac_instruction_set_op(instruction, 3u, operand); + elna_list_append(instructions, cast(instruction: ^ElnaListNode)) + elsif operand_result^.kind = ElnaTacOperandType.sub_object then + operand^ := base; + operand_result^.offset := operand_result^.offset + field_offset + else + operand^ := base; + operand_result^.kind := ElnaTacOperandType.sub_object; + operand_result^.offset := field_offset + end +return + +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 + elem_size: Word := 1u +begin + designator_base := array_access_expression^.array; + if designator_base^.type_decoration <> nil & designator_base^.type_decoration^.kind = ElnaTypeKind.array then + aggregate_type := cast(designator_base^.type_decoration: ^ElnaTypeArray); + element_type := aggregate_type^.base; + if element_type <> nil then + elem_size := element_type^.size + end + end; + + elna_tac_binary_expression(instructions, array_access_expression^.index, symbol_table, @inter_operand); + elna_tac_make_variable(@index_operand, symbol_table, word_type); + + (* In Elna arrays are 1-based, subtract 1 for 0-based index *) + instruction := elna_tac_instruction_create(ElnaTacOperator.subtract); + elna_tac_instruction_set_op(instruction, 1u, @inter_operand); + elna_tac_instruction_set_const(instruction, 2u, 1u, 4u); + elna_tac_instruction_set_op(instruction, 3u, @index_operand); + elna_list_append(instructions, cast(instruction: ^ElnaListNode)); + + 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_op(instruction, 1u, operand); + elna_tac_instruction_set_op(instruction, 2u, @index_operand); + elna_tac_instruction_set_const(instruction, 3u, elem_size, 4u); + elna_tac_instruction_set_op(instruction, 4u, operand); + elna_list_append(instructions, cast(instruction: ^ElnaListNode)) +return + +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 := 0u; + + case parser_node^.kind of + ElnaTreeKind.dereference_expression: + elna_tac_dereference_expression(instructions, cast(parser_node: ^ElnaTreeDereferenceExpression), symbol_table, operand); + operand_result^.kind := ElnaTacOperandType.dereferenced_pointer + | ElnaTreeKind.field_access_expression: + field_access_expression := cast(parser_node: ^ElnaTreeFieldAccessExpression); + 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 + | ElnaTreeKind.array_access_expression: + elna_tac_array_access_expression(instructions, cast(parser_node: ^ElnaTreeArrayAccessExpression), symbol_table, operand); + operand_result^.kind := ElnaTacOperandType.dereferenced_pointer + | ElnaTreeKind.call: + elna_tac_call(instructions, cast(parser_node: ^ElnaTreeCall), symbol_table, operand) + else + elna_tac_simple_expression(instructions, parser_node, symbol_table, operand) + end +return + +proc elna_tac_assign_statement(instructions: ^ElnaList; parser_tree: ^ElnaTreeAssignStatement; symbol_table: ^ElnaSymbolTable) +var + operand_result: ElnaTacOperandResult + instruction: ^ElnaTacInstruction + assignment_operand: ElnaTacOperand + assignee: ElnaTacOperand +begin + elna_tac_designator(instructions, parser_tree^.assignee, symbol_table, @operand_result, @assignee); + 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_op(instruction, 1u, @assignment_operand); + elna_tac_instruction_set_op(instruction, 2u, @assignee) + elsif operand_result.kind = ElnaTacOperandType.sub_object then + instruction := elna_tac_instruction_create(ElnaTacOperator.copy_to_offset); + elna_tac_instruction_set_op(instruction, 1u, @assignment_operand); + elna_tac_instruction_set_op(instruction, 2u, @assignee); + elna_tac_instruction_set_const(instruction, 3u, operand_result.offset, 4u) + else + instruction := elna_tac_instruction_create(ElnaTacOperator.copy); + elna_tac_instruction_set_op(instruction, 1u, @assignment_operand); + elna_tac_instruction_set_op(instruction, 2u, @assignee) + end; + elna_list_append(instructions, cast(instruction: ^ElnaListNode)) +return + +proc elna_tac_return_statement(instructions: ^ElnaList; parser_node: ^ElnaTreeReturnStatement; symbol_table: ^ElnaSymbolTable) +var + instruction: ^ElnaTacInstruction + operand: ElnaTacOperand +begin + instruction := elna_tac_instruction_create(ElnaTacOperator._return); + if parser_node^.returned <> nil then + elna_tac_binary_expression(instructions, parser_node^.returned, symbol_table, @operand); + elna_tac_instruction_set_op(instruction, 1u, @operand) + else + instruction^.operands[1].kind := ElnaTacKind.ignore + end; + elna_list_append(instructions, cast(instruction: ^ElnaListNode)) +return + +proc elna_tac_conditional_statements(instructions: ^ElnaList; parser_node: ^ElnaTreeConditionalStatements; + after_end_label: []const Word8; symbol_table: ^ElnaSymbolTable) +var + condition_label: []const Word8 + instruction: ^ElnaTacInstruction + operand: ElnaTacOperand +begin + elna_tac_binary_expression(instructions, parser_node^.condition, symbol_table, @operand); + condition_label := elna_tac_label(); + + instruction := elna_tac_instruction_create(ElnaTacOperator.jump_if_zero); + elna_tac_instruction_set_op(instruction, 1u, @operand); + elna_tac_instruction_set_label(instruction, 2u, condition_label); + elna_list_append(instructions, cast(instruction: ^ElnaListNode)); + + elna_tac_statements(instructions, parser_node^.statements, symbol_table); + + instruction := elna_tac_instruction_create(ElnaTacOperator.jump); + elna_tac_instruction_set_label(instruction, 1u, after_end_label); + elna_list_append(instructions, cast(instruction: ^ElnaListNode)); + + instruction := elna_tac_instruction_create(ElnaTacOperator.label); + elna_tac_instruction_set_label(instruction, 1u, condition_label); + elna_list_append(instructions, cast(instruction: ^ElnaListNode)) +return + +proc elna_tac_if_statement(instructions: ^ElnaList; parser_node: ^ElnaTreeIfStatement; symbol_table: ^ElnaSymbolTable) +var + current_node: ^ElnaTreeConditionalStatements + after_end_label: []const Word8 + instruction: ^ElnaTacInstruction +begin + after_end_label := elna_tac_label(); + current_node := parser_node^.conditionals; + + while current_node <> nil do + elna_tac_conditional_statements(instructions, current_node, after_end_label, symbol_table); + current_node := current_node^.next + end; + + 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_label(instruction, 1u, after_end_label); + elna_list_append(instructions, cast(instruction: ^ElnaListNode)) +return + +proc elna_tac_statement(instructions: ^ElnaList; parser_node: ^ElnaTreeStatement; symbol_table: ^ElnaSymbolTable) +var + operand: ElnaTacOperand + call_statement: ^ElnaTreeCallStatement +begin + case parser_node^.kind of + ElnaTreeKind.goto_statement: + elna_tac_goto_statement(instructions, cast(parser_node: ^ElnaTreeGotoStatement)) + | ElnaTreeKind.if_statement: + elna_tac_if_statement(instructions, cast(parser_node: ^ElnaTreeIfStatement), symbol_table) + | ElnaTreeKind.return_statement: + elna_tac_return_statement(instructions, cast(parser_node: ^ElnaTreeReturnStatement), symbol_table) + | ElnaTreeKind.label_declaration: + elna_tac_label_declaration(instructions, cast(parser_node: ^ElnaTreeLabelDeclaration)) + | ElnaTreeKind.call_statement: + call_statement := cast(parser_node: ^ElnaTreeCallStatement); + elna_tac_call(instructions, call_statement^.call, symbol_table, @operand) + | ElnaTreeKind.assign_statement: + elna_tac_assign_statement(instructions, cast(parser_node: ^ElnaTreeAssignStatement), symbol_table) + else + end +return + +proc elna_tac_statements(instructions: ^ElnaList; current_statement: ^ElnaTreeStatement; symbol_table: ^ElnaSymbolTable) +var + current: ^ElnaTreeStatement +begin + current := current_statement; + while current <> nil do + elna_tac_statement(instructions, current, symbol_table); + current := current^.next + end +return + +proc elna_tac_parameters(ast_list: ^ElnaTreeDeclaration; parameter_count: ^Word) -> ^[]const Word8 +var + ast_parameter: ^ElnaTreeDeclaration + parameter_list: ^[]const Word8 + count: Word := 0u + i: Word := 0u +begin + ast_parameter := ast_list; + while ast_parameter <> nil do + count := count + 1u; + ast_parameter := ast_parameter^.next + end; + parameter_count^ := count; + + parameter_list := malloc#[[]const Word8](count * #size([]const Word8)); + ast_parameter := ast_list; + while i < count do + (parameter_list + i)^ := ast_parameter^.name; + i := i + 1u; + ast_parameter := ast_parameter^.next + end +return parameter_list + +proc elna_tac_procedure_declaration(parser_node: ^ElnaTreeProcedureDeclaration) -> ^ElnaTacProcedure +var + symbol_info: ^ElnaSymbolInfo + procedure_info: ^ElnaSymbolProcedureInfo + result: ^ElnaTacProcedure + parameter_count: Word := 0u +begin + result := malloc#[ElnaTacProcedure](#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); + if symbol_info <> nil & symbol_info^.kind = ElnaSymbolInfoKind.procedure_info then + procedure_info := cast(symbol_info: ^ElnaSymbolProcedureInfo); + result^.symbol_table := procedure_info^.symbol_table + else + result^.symbol_table := symbol_table_global + end; + + result^.parameters := elna_tac_parameters(parser_node^.parameters, @parameter_count); + result^.count := parameter_count; + pseudo_counter := 0u; + + elna_tac_statements(@result^.body, parser_node^.body, result^.symbol_table) +return result + +proc elna_tac_procedures(parser_node: ^ElnaTreeProcedureDeclaration) -> ^ElnaTacProcedure +var + result: ^ElnaTacProcedure + current_procedure: ^ElnaTacProcedure := nil + first_procedure: ^ElnaTacProcedure := nil + current_node: ^ElnaTreeProcedureDeclaration +begin + current_node := parser_node; + while current_node <> nil do + if ~current_node^.is_extern then + result := elna_tac_procedure_declaration(current_node); + if first_procedure = nil then + first_procedure := result + else + current_procedure^.next := result + end; + current_procedure := result + end; + current_node := cast(current_node^.next: ^ElnaTreeProcedureDeclaration) + end +return first_procedure + +proc elna_tac_variable_declaration(parser_tree: ^ElnaTreeVariableDeclaration) -> ^ElnaTacStaticVariable +var + result: ^ElnaTacStaticVariable + symbol_info: ^ElnaSymbolInfo + temp_info: ^ElnaSymbolTemporaryInfo +begin + result := malloc#[ElnaTacStaticVariable](#size(ElnaTacStaticVariable)); + result^.next := nil; + result^.name := parser_tree^.name; + result^.size := 4u; + + symbol_info := elna_symbol_table_lookup(symbol_table_global, parser_tree^.name); + if symbol_info <> nil & symbol_info^.kind = ElnaSymbolInfoKind.temporary_info then + temp_info := cast(symbol_info: ^ElnaSymbolTemporaryInfo); + if temp_info^.variable_type <> nil then + result^.size := temp_info^.variable_type^.size + end + end +return result + +proc elna_tac_var_part(parser_node: ^ElnaTreeDeclaration) -> ^ElnaTacStaticVariable +var + node: ^ElnaTacStaticVariable + current_variable: ^ElnaTacStaticVariable := nil + first_variable: ^ElnaTacStaticVariable := nil + current_node: ^ElnaTreeDeclaration +begin + current_node := parser_node; + while current_node <> nil do + node := elna_tac_variable_declaration(cast(current_node: ^ElnaTreeVariableDeclaration)); + if first_variable = nil then + first_variable := node + else + current_variable^.next := node + end; + current_variable := node; + current_node := current_node^.next + end +return first_variable + +proc elna_tac_program_body(parser_node: ^ElnaTreeStatement) -> ^ElnaTacProcedure +var + result: ^ElnaTacProcedure + symbol_info: ^ElnaSymbolInfo + procedure_info: ^ElnaSymbolProcedureInfo +begin + result := malloc#[ElnaTacProcedure](#size(ElnaTacProcedure)); + result^.next := nil; + elna_list_initialize(@result^.body); + result^.name := "main"; + + symbol_info := elna_symbol_table_lookup(symbol_table_global, result^.name); + if symbol_info <> nil & symbol_info^.kind = ElnaSymbolInfoKind.procedure_info then + procedure_info := cast(symbol_info: ^ElnaSymbolProcedureInfo); + result^.symbol_table := procedure_info^.symbol_table + else + result^.symbol_table := symbol_table_global + end; + + result^.parameters := nil; + result^.count := 0u; + pseudo_counter := 0u; + + elna_tac_statements(@result^.body, parser_node, result^.symbol_table) +return result + +proc elna_tac_module_declaration*(parser_node: ^ElnaTreeModuleDeclaration) -> ^ElnaInstructionModule +var + result: ^ElnaInstructionModule + last_proc: ^ElnaTacProcedure + body_proc: ^ElnaTacProcedure +begin + result := malloc#[ElnaInstructionModule](#size(ElnaInstructionModule)); + result^.strings := module_strings_first; + result^.data := elna_tac_var_part(parser_node^.globals); + result^.code := elna_tac_procedures(parser_node^.procedures); + + if parser_node^.body <> nil then + body_proc := elna_tac_program_body(parser_node^.body); + if result^.code = nil then + result^.code := body_proc + else + last_proc := result^.code; + while last_proc^.next <> nil do + last_proc := last_proc^.next + end; + last_proc^.next := body_proc + end + end; + result^.strings := module_strings_first +return result + +end. diff --git a/source/type_check.elna b/source/type_check.elna new file mode 100644 index 0000000..8edc30d --- /dev/null +++ b/source/type_check.elna @@ -0,0 +1,315 @@ +(* 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/. *) +module +import common, lexer, ast, symbol, diagnostic + +proc elna_type_is_aggregate*(_type: ^ElnaType) -> Bool +var + result: Bool := false +begin + if _type <> nil then + result := _type^.kind = ElnaTypeKind._record or _type^.kind = ElnaTypeKind.array + end +return result + +proc elna_type_character_literal(parser_node: ^ElnaTreeCharacterLiteral) +begin + parser_node^.type_decoration := char_type +return + +proc elna_type_integer_literal(parser_node: ^ElnaTreeIntegerLiteral) +begin + parser_node^.type_decoration := word_type +return + +proc elna_type_string_literal(parser_node: ^ElnaTreeStringLiteral) +begin + parser_node^.type_decoration := cast(string_type: ^ElnaType) +return + +proc elna_type_boolean_literal(parser_node: ^ElnaTreeBooleanLiteral) +begin + parser_node^.type_decoration := bool_type +return + +proc elna_type_nil_literal(parser_node: ^ElnaTreeNilLiteral) +begin + parser_node^.type_decoration := pointer_type +return + +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); + if variable_info <> nil then + if variable_info^.kind = ElnaSymbolInfoKind.temporary_info then + temporary_info := cast(variable_info: ^ElnaSymbolTemporaryInfo); + parser_node^.type_decoration := temporary_info^.variable_type + elsif variable_info^.kind = ElnaSymbolInfoKind.procedure_info then + procedure_info := cast(variable_info: ^ElnaSymbolProcedureInfo); + parser_node^.type_decoration := cast(procedure_info^.procedure_type: ^ElnaType) + end + end +return + +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) +return + +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); + if parser_node^.callee^.type_decoration <> nil & parser_node^.callee^.type_decoration^.kind = ElnaTypeKind.procedure then + procedure_type := cast(parser_node^.callee^.type_decoration: ^ElnaTypeProcedure); + parser_node^.type_decoration := procedure_type^.return_type + end; + + while argument_tree <> nil do + elna_type_binary_expression(argument_tree^.expression, symbol_table, error_list); + argument_tree := argument_tree^.next + end +return + +proc elna_type_dereference_expression(parser_node: ^ElnaTreeDereferenceExpression; symbol_table: ^ElnaSymbolTable; + error_list: ^ElnaList) +var + base_type: ^ElnaType := nil + pointer_type_node: ^ElnaTypePointer +begin + elna_type_designator(parser_node^.pointer, symbol_table, error_list); + + if parser_node^.pointer^.type_decoration <> nil then + base_type := parser_node^.pointer^.type_decoration; + if base_type^.kind = ElnaTypeKind.pointer then + pointer_type_node := cast(base_type: ^ElnaTypePointer); + base_type := pointer_type_node^.base + end + end; + parser_node^.type_decoration := base_type +return + +proc elna_type_field_access_expression(parser_node: ^ElnaTreeFieldAccessExpression; symbol_table: ^ElnaSymbolTable; + error_list: ^ElnaList) +var + variable_expression: ^ElnaTreeVariableExpression + base_type: ^ElnaType := nil + type_kind: ^ElnaSymbolTypeInfo + symbol_info: ^ElnaSymbolInfo + aggregate_type: ^ElnaTypeRecord + field_count: Word + current_field: ^ElnaTypeField +begin + if parser_node^.aggregate^.kind = ElnaTreeKind.variable_expression then + variable_expression := cast(parser_node^.aggregate: ^ElnaTreeVariableExpression); + symbol_info := elna_symbol_table_lookup(symbol_table_global, variable_expression^.name); + if symbol_info <> nil & symbol_info^.kind = ElnaSymbolInfoKind.type_info then + type_kind := cast(symbol_info: ^ElnaSymbolTypeInfo); + base_type := type_kind^._type + end + end; + + if base_type = nil then + elna_type_designator(parser_node^.aggregate, symbol_table, error_list); + if parser_node^.aggregate^.type_decoration <> nil & parser_node^.aggregate^.type_decoration^.kind = ElnaTypeKind._record then + aggregate_type := cast(parser_node^.aggregate^.type_decoration: ^ElnaTypeRecord); + field_count := aggregate_type^.length; + current_field := aggregate_type^.members; + + while field_count > 0u & base_type = nil do + if current_field^.name = parser_node^.field then + base_type := current_field^.field_type + else + field_count := field_count - 1u; + current_field := current_field + 1u + end + end + end + end; + + parser_node^.type_decoration := base_type +return + +proc elna_type_array_access_expression(parser_node: ^ElnaTreeArrayAccessExpression; symbol_table: ^ElnaSymbolTable; + error_list: ^ElnaList) +var + aggregate_type: ^ElnaTypeArray +begin + elna_type_designator(parser_node^.array, symbol_table, error_list); + elna_type_binary_expression(parser_node^.index, symbol_table, error_list); + + if parser_node^.array^.type_decoration <> nil & parser_node^.array^.type_decoration^.kind = ElnaTypeKind.array then + aggregate_type := cast(parser_node^.array^.type_decoration: ^ElnaTypeArray); + parser_node^.type_decoration := aggregate_type^.base + end +return + +proc elna_type_simple_expression(parser_node: ^ElnaTreeExpression; symbol_table: ^ElnaSymbolTable; error_list: ^ElnaList) +begin + case parser_node^.kind of + ElnaTreeKind.integer_literal: + elna_type_integer_literal(cast(parser_node: ^ElnaTreeIntegerLiteral)) + | ElnaTreeKind.character_literal: + elna_type_character_literal(cast(parser_node: ^ElnaTreeCharacterLiteral)) + | ElnaTreeKind.string_literal: + elna_type_string_literal(cast(parser_node: ^ElnaTreeStringLiteral)) + | ElnaTreeKind.boolean_literal: + elna_type_boolean_literal(cast(parser_node: ^ElnaTreeBooleanLiteral)) + | ElnaTreeKind.null: + elna_type_nil_literal(cast(parser_node: ^ElnaTreeNilLiteral)) + | ElnaTreeKind._cast: + elna_type_cast_expression(cast(parser_node: ^ElnaTreeCastExpression), symbol_table, error_list) + | ElnaTreeKind.variable_expression: + elna_type_variable_expression(cast(parser_node: ^ElnaTreeVariableExpression), symbol_table) + else + end +return + +proc elna_type_designator(parser_node: ^ElnaTreeExpression; symbol_table: ^ElnaSymbolTable; error_list: ^ElnaList) +begin + case parser_node^.kind of + ElnaTreeKind.dereference_expression: + elna_type_dereference_expression(cast(parser_node: ^ElnaTreeDereferenceExpression), symbol_table, error_list) + | ElnaTreeKind.field_access_expression: + elna_type_field_access_expression(cast(parser_node: ^ElnaTreeFieldAccessExpression), symbol_table, error_list) + | ElnaTreeKind.array_access_expression: + elna_type_array_access_expression(cast(parser_node: ^ElnaTreeArrayAccessExpression), symbol_table, error_list) + | ElnaTreeKind.call: + elna_type_call(cast(parser_node: ^ElnaTreeCall), symbol_table, error_list) + else + elna_type_simple_expression(parser_node, symbol_table, error_list) + end +return + +proc elna_type_unary_expression(parser_node: ^ElnaTreeExpression; symbol_table: ^ElnaSymbolTable; + error_list: ^ElnaList) +var + unary_node: ^ElnaTreeUnaryExpression +begin + if parser_node^.kind = ElnaTreeKind.unary_expression then + unary_node := cast(parser_node: ^ElnaTreeUnaryExpression); + elna_type_designator(unary_node^.operand, symbol_table, error_list); + parser_node^.type_decoration := unary_node^.operand^.type_decoration + else + elna_type_designator(parser_node, symbol_table, error_list) + end +return + +proc elna_type_binary_expression(parser_node: ^ElnaTreeExpression; symbol_table: ^ElnaSymbolTable; + error_list: ^ElnaList) +var + binary_node: ^ElnaTreeBinaryExpression +begin + if parser_node <> nil then + if parser_node^.kind = ElnaTreeKind.binary_expression then + binary_node := cast(parser_node: ^ElnaTreeBinaryExpression); + elna_type_unary_expression(binary_node^.rhs, symbol_table, error_list); + elna_type_unary_expression(binary_node^.lhs, symbol_table, error_list); + parser_node^.type_decoration := binary_node^.lhs^.type_decoration + else + elna_type_unary_expression(parser_node, symbol_table, error_list) + end + end +return + +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) +return + +proc elna_type_conditional_statements(parser_node: ^ElnaTreeConditionalStatements; symbol_table: ^ElnaSymbolTable; + error_list: ^ElnaList) +var + current: ^ElnaTreeConditionalStatements +begin + current := parser_node; + while current <> nil do + elna_type_binary_expression(current^.condition, symbol_table, error_list); + elna_type_statements(current^.statements, symbol_table, error_list); + current := current^.next + end +return + +proc elna_type_if_statement(parser_node: ^ElnaTreeIfStatement; symbol_table: ^ElnaSymbolTable; error_list: ^ElnaList) +begin + elna_type_conditional_statements(parser_node^.conditionals, symbol_table, error_list); + if parser_node^._else <> nil then + elna_type_statements(parser_node^._else, symbol_table, error_list) + end +return + +proc elna_type_return_statement(parser_node: ^ElnaTreeReturnStatement; symbol_table: ^ElnaSymbolTable; error_list: ^ElnaList) +begin + if parser_node^.returned <> nil then + elna_type_binary_expression(parser_node^.returned, symbol_table, error_list) + end +return + +proc elna_type_statement(parser_node: ^ElnaTreeStatement; symbol_table: ^ElnaSymbolTable; error_list: ^ElnaList) +var + call_statement: ^ElnaTreeCallStatement +begin + case parser_node^.kind of + ElnaTreeKind.if_statement: + elna_type_if_statement(cast(parser_node: ^ElnaTreeIfStatement), symbol_table, error_list) + | ElnaTreeKind.return_statement: + elna_type_return_statement(cast(parser_node: ^ElnaTreeReturnStatement), symbol_table, error_list) + | ElnaTreeKind.call_statement: + call_statement := cast(parser_node: ^ElnaTreeCallStatement); + elna_type_call(call_statement^.call, symbol_table, error_list) + | ElnaTreeKind.assign_statement: + elna_type_assign_statement(cast(parser_node: ^ElnaTreeAssignStatement), symbol_table, error_list) + else + end +return + +proc elna_type_statements(parser_node: ^ElnaTreeStatement; symbol_table: ^ElnaSymbolTable; error_list: ^ElnaList) +var + current: ^ElnaTreeStatement +begin + current := parser_node; + while current <> nil do + elna_type_statement(current, symbol_table, error_list); + current := current^.next + end +return + +proc elna_type_procedure_declaration(parser_node: ^ElnaTreeProcedureDeclaration; error_list: ^ElnaList) +var + procedure_info: ^ElnaSymbolProcedureInfo + symbol_info: ^ElnaSymbolInfo +begin + symbol_info := elna_symbol_table_lookup(symbol_table_global, parser_node^.name); + if symbol_info <> nil & symbol_info^.kind = ElnaSymbolInfoKind.procedure_info then + procedure_info := cast(symbol_info: ^ElnaSymbolProcedureInfo); + elna_type_statements(parser_node^.body, procedure_info^.symbol_table, error_list) + end +return + +proc elna_type_module_declaration*(parser_node: ^ElnaTreeModuleDeclaration; error_list: ^ElnaList) +var + current_proc: ^ElnaTreeProcedureDeclaration +begin + current_proc := parser_node^.procedures; + while current_proc <> nil do + elna_type_procedure_declaration(current_proc, error_list); + current_proc := cast(current_proc^.next: ^ElnaTreeProcedureDeclaration) + end; + if parser_node^.body <> nil then + elna_type_statements(parser_node^.body, symbol_table_global, error_list) + end +return + +end. |