diff options
Diffstat (limited to 'cl.elna')
| -rw-r--r-- | cl.elna | 6185 |
1 files changed, 0 insertions, 6185 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. |