(* * 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 15 compiler. *) type LexerAction = (none, accumulate, skip, single, eof, finalize, composite, key_id, integer, delimited); (** * Classification table assigns each possible character to a group (class). All * characters of the same group a handled equivalently. * * Transition = record * action: TransitionAction; * next_state: TransitionState * end; *) LexerClass = ( invalid, digit, alpha, space, colon, equals, left_paren, right_paren, asterisk, backslash, single, hex, zero, x, eof, dot, minus, single_quote, double_quote, greater, less, other ); LexerState = ( start, colon, identifier, decimal, leading_zero, greater, minus, left_paren, less, dot, comment, closing_comment, character, character_escape, string, string_escape, finish ); LexerTokenKind = ( identifier, _const, _var, _proc, _type, _begin, _end, _if, _then, _else, _elsif, _while, _do, _extern, _record, _union, _true, _false, null, and, _or, _xor, pipe, not, _return, _module, _program, _import, _cast, _defer, _case, _of, trait, left_paren, right_paren, left_square, right_square, shift_left, shift_right, greater_equal, less_equal, greater_than, less_than, not_equal, equals, semicolon, dot, comma, plus, arrow, minus, multiplication, division, remainder, assignment, colon, hat, at, comment, string, character, integer, word, _goto, eof ); NodeKind := ( integer_literal, string_literal, character_literal ); const symbol_builtin_name_int := "Int"; symbol_builtin_name_word := "Word"; symbol_builtin_name_pointer := "Pointer"; symbol_builtin_name_char := "Char"; symbol_builtin_name_array := "Array"; (* Every type info starts with a word describing what type it is. PRIMITIVE_TYPE = 1 ENUMERATION_TYPE = 2 Primitive types have only type size. *) symbol_builtin_type_int := S(1, 4); symbol_builtin_type_word := S(1, 4); symbol_builtin_type_pointer := S(1, 4); symbol_builtin_type_char := S(1, 1); symbol_builtin_type_array := S(1, 4); (* Info objects start with a word describing its type. TYPE_INFO = 1 PARAMETER_INFO = 2 TEMPORARY_INFO = 3 Type info has the type it belongs to. *) symbol_type_info_int := S(1, @symbol_builtin_type_int); symbol_type_info_word := S(1, @symbol_builtin_type_word); symbol_type_info_pointer := S(1, @symbol_builtin_type_pointer); symbol_type_info_char := S(1, @symbol_builtin_type_char); symbol_type_info_array := S(1, @symbol_builtin_type_array); var source_code: Array; compiler_strings: Array; symbol_table_global: Array; symbol_table_local: Array; classification: Array; (* To reserve memory just add the value of needed bytes to the memory_free_pointer_variable. *) memory: Array; compiler_strings_position: Pointer := @compiler_strings; compiler_strings_length: Word := 0; label_counter: Word := 0; (* Points to a segment of free memory. *) memory_free_pointer: Word := @memory; (** * Calculates and returns the string token length between quotes, including the * escaping slash characters. * * Parameters: * string - String token pointer. * * Returns the length in a0. *) proc _string_length(string: Word); var counter: Word; begin (* Reset the counter. *) counter := 0; .string_length_loop; string := string + 1; if _load_byte(string) <> '"' then counter := counter + 1; goto string_length_loop end; return counter end; (** * Adds a string to the global, read-only string storage. * * Parameters: * string - String token. * * Returns the offset from the beginning of the storage to the new string in a0. *) proc _add_string(string: Word); var contents: Word; result: Word; current_byte: Word; begin contents := string + 1; result := compiler_strings_length; .add_string_loop; if _load_byte(contents) <> '"' then current_byte := _load_byte(contents); _store_byte(current_byte, compiler_strings_position); compiler_strings_position := compiler_strings_position + 1; contents := contents + 1; if current_byte <> '\\' then compiler_strings_length := compiler_strings_length + 1 end; goto add_string_loop end; return result end; (** * Reads standard input into a buffer. * * Parameters: * buffer - Buffer pointer. * size - Buffer size. * * Returns the amount of bytes written in a0. *) proc _read_file(buffer: Word, size: Word); return _syscall(0, buffer, size, 0, 0, 0, 63) end; (** * Writes to the standard output. * * Parameters: * buffer - Buffer. * size - Buffer length. *) proc _write_s(buffer: Word, size: Word); begin _syscall(1, buffer, size, 0, 0, 0, 64) end; (** * Writes a number to a string buffer. * * Parameters: * number - Whole number. * output_buffer - Buffer pointer. * * Sets a0 to the length of the written number. *) proc _print_i(number: Word, output_buffer: Word); var local_buffer: Word; is_negative: Word; current_character: Word; result: Word; begin local_buffer := @result + 11; if number >= 0 then is_negative := 0 else number = -number; is_negative := 1 end; .print_i_digit10; current_character := number % 10; _store_byte(current_character + '0', local_buffer); number := number / 10; local_buffer := local_buffer - 1; if number <> 0 then goto print_i_digit10 end; if is_negative = 1 then _store_byte('-', local_buffer); local_buffer := local_buffer - 1 end; result := @result + 11; result := result - local_buffer; _memcpy(output_buffer, local_buffer + 1, result); return result end; (** * Writes a number to the standard output. * * Parameters: * number - Whole number. *) proc _write_i(number: Word); var local_buffer: Word; length: Word; begin length := _print_i(number, @local_buffer); _write_s(@local_buffer, length) end; (** * Writes a character from a0 into the standard output. * * Parameters: * character - Character to write. *) proc _write_c(character: Word); begin _write_s(@character, 1) end; (** * Write null terminated string. * * Parameters: * string - String. *) proc _write_z(string: Word); var next_byte: Word; begin (* Check for 0 character. *) next_byte := _load_byte(string); if next_byte <> 0 then (* Print a character. *) _write_c(next_byte); (* Advance the input string by one byte. *) _write_z(string + 1) end end; (** * Detects if a0 is an uppercase character. Sets a0 to 1 if so, otherwise to 0. *) proc _is_upper(character: Word); var lhs: Word; rhs: Word; begin lhs := character >= 'A'; rhs := character <= 'Z'; return lhs & rhs end; (** * Detects if a0 is an lowercase character. Sets a0 to 1 if so, otherwise to 0. *) proc _is_lower(character: Word); var lhs: Word; rhs: Word; begin lhs := character >= 'a'; rhs := character <= 'z'; return lhs & rhs end; (** * Detects if the passed character is a 7-bit alpha character or an underscore. * * Paramters: * character - Tested character. * * Sets a0 to 1 if the character is an alpha character or underscore, sets it to 0 otherwise. *) proc _is_alpha(character: Word); var is_upper_result: Word; is_lower_result: Word; is_alpha_result: Word; is_underscore: Word; begin is_upper_result := _is_upper(character); is_lower_result := _is_lower(character); is_underscore := character = '_'; is_alpha_result := is_lower_result or is_upper_result; return is_alpha_result or is_underscore end; (** * Detects whether the passed character is a digit (a value between 0 and 9). * * Parameters: * character - Exemined value. * * Sets a0 to 1 if it is a digit, to 0 otherwise. *) proc _is_digit(character: Word); var lhs: Word; rhs: Word; begin lhs := character >= '0'; rhs := character <= '9'; return lhs & rhs end; proc _is_alnum(character: Word); var lhs: Word; rhs: Word; begin lhs := _is_alpha(character); rhs := _is_digit(character); return lhs or rhs end; (** * Parameters: * lhs - First pointer. * rhs - Second pointer. * count - The length to compare. * * Returns 0 if memory regions are equal. *) proc _memcmp(lhs: Word, rhs: Word, count: Word); var lhs_byte: Word; rhs_byte: Word; result: Word; begin result := 0; .memcmp_loop; if count <> 0 then lhs_byte := _load_byte(lhs); rhs_byte := _load_byte(rhs); result := lhs_byte - rhs_byte; lhs := lhs + 1; rhs := rhs + 1; count := count - 1; if result = 0 then goto memcmp_loop end end; return result end; (** * Copies memory. * * Parameters: * destination - Destination. * source - Source. * count - Size. * * Returns the destination. *) proc _memcpy(destination: Word, source: Word, count: Word); var current_byte: Word; begin .memcpy_loop; if count <> 0 then current_byte := _load_byte(source); _store_byte(current_byte, destination); destination := destination + 1; source := source + 1; count := count - 1; goto memcpy_loop end; return destination end; proc _node_get_kind(this: Word); return this^ end; proc _node_set_kind(this: Word, kind: Word); begin this^ := kind end; proc _integer_literal_node_size(); return 12 end; proc _integer_literal_node_get_value(this: Word); return _load_word(this + 4) end; proc _integer_literal_node_set_value(this: Word, value: Word); begin _store_word(value, this + 4) end; proc _integer_literal_node_get_length(this: Word); return _load_word(this + 8) end; proc _integer_literal_node_set_length(this: Word, value: Word); begin _store_word(value, this + 8) end; proc _parse_integer_literal(); var integer_token: Word; integer_length: Word; result: Word; begin result := memory_free_pointer; memory_free_pointer := memory_free_pointer + 12; integer_token := _lexer_global_get_start(); integer_length := _lexer_global_get_end() - integer_token; _lexer_skip_token(); _node_set_kind(result, NodeKind.integer_literal); _integer_literal_node_set_value(result, integer_token); _integer_literal_node_set_length(result, integer_length); return result end; proc _compile_integer_literal(integer_literal_node: Word); var integer_token: Word; integer_length: Word; token_kind: Word; begin _write_z("\tli t0, \0"); integer_token := _integer_literal_node_get_value(integer_literal_node); integer_length := _integer_literal_node_get_length(integer_literal_node); _write_s(integer_token, integer_length); _write_c('\n') end; proc _character_literal_node_get_value(this: Word); return _load_word(this + 4) end; proc _character_literal_node_set_value(this: Word, value: Word); begin _store_word(value, this + 4) end; proc _character_literal_node_get_length(this: Word); return _load_word(this + 8) end; proc _character_literal_node_set_length(this: Word, value: Word); begin _store_word(value, this + 8) end; proc _parse_character_literal(); var character: Word; character_length: Word; result: Word; begin result := memory_free_pointer; memory_free_pointer := memory_free_pointer + 12; character := _lexer_global_get_start(); character_length := _lexer_global_get_end() - character; _lexer_skip_token(); _node_set_kind(result, NodeKind.character_literal); _integer_literal_node_set_value(result, character); _integer_literal_node_set_length(result, character_length); return result end; proc _compile_character_literal(character_literal_node: Word); var character: Word; character_length: Word; begin character := _character_literal_node_get_value(character_literal_node); character_length := _character_literal_node_get_length(character_literal_node);; _write_z("\tli t0, \0"); _write_s(character, character_length); _write_c('\n'); end; proc _compile_variable_expression(); var name: Word; lookup_result: Word; name_token: Word; begin name := _lexer_global_get_start(); name_token := _lexer_global_get_end() - name; lookup_result := _symbol_table_lookup(@symbol_table_global, name, name_token); if lookup_result <> 0 then _compile_enumeration_value(lookup_result) else _compile_designator(); _write_z("\tlw t0, (t0)\n\0") end end; (** * Compiled take address expression, starting with an "@" sign. *) proc _compile_address_expression(); begin _lexer_skip_token(); _compile_designator() end; (** * Compile unary negation, "-" sign. *) proc _compile_negate_expression(); begin _lexer_skip_token(); _compile_term(); _write_z("\tneg t0, t0\n\0") end; (* Compile unary negation, "~" sign. *) proc _compile_not_expression(); var token_kind: Word; begin _lexer_read_token(@token_kind); _lexer_skip_token(); _compile_term(); _write_z("\tnot t0, t0\n\0") end; proc _string_literal_node_size(); return 12 end; proc _string_literal_node_get_value(this: Word); return _load_word(this + 4) end; proc _string_literal_node_set_value(this: Word, value: Word); begin _store_word(value, this + 4) end; proc _string_literal_node_get_length(this: Word); return _load_word(this + 8) end; proc _string_literal_node_set_length(this: Word, value: Word); begin _store_word(value, this + 8) end; proc _parse_string_literal(); var length: Word; token_start: Word; result: Word; begin result := memory_free_pointer; memory_free_pointer := memory_free_pointer + _string_literal_node_size(); token_start := _lexer_global_get_start(); length := _string_length(token_start); _lexer_skip_token(); _string_literal_node_set_value(result, token_start); _string_literal_node_set_length(result, length); return result end; proc _compile_string_literal(string_literal_node: Word); var token_start: Word; length: Word; offset: Word; begin token_start := _string_literal_node_get_value(string_literal_node); length := _string_literal_node_get_length(string_literal_node); offset := _add_string(token_start); _write_z("\tla t0, strings\n\0"); _write_z("\tli t1, \0"); _write_i(offset); _write_c('\n'); _write_z("\tadd t0, t0, t1\n\0") end; proc _compile_term(); var current_character: Word; token_kind: Word; parser_node: Word; begin _lexer_read_token(@token_kind); if token_kind = LexerTokenKind.character then parser_node := _parse_character_literal(); _compile_character_literal(parser_node) elsif token_kind = LexerTokenKind.string then parser_node := _parse_string_literal(); _compile_string_literal(parser_node) elsif token_kind = LexerTokenKind.integer then parser_node := _parse_integer_literal(); _compile_integer_literal(parser_node) elsif token_kind = LexerTokenKind.at then _compile_address_expression() elsif token_kind = LexerTokenKind.minus then _compile_negate_expression() elsif token_kind = LexerTokenKind.not then _compile_not_expression() elsif token_kind = LexerTokenKind.identifier then current_character := _lexer_global_get_start(); current_character := _load_byte(current_character); (* This is a call if the statement starts with an underscore. *) if current_character = '_' then _compile_call(); _write_z("\tmv t0, a0\n\0") else _compile_variable_expression() end end end; proc _compile_binary_rhs(); begin (* Save the value of the left expression on the stack. *) _write_z("\tsw t0, 64(sp)\n\0"); _compile_term(); (* Load the left expression from the stack; *) _write_z("\tlw t1, 64(sp)\n\0") end; proc _compile_expression(); var token_kind: Word; begin _compile_term(); _lexer_read_token(@token_kind); if token_kind = LexerTokenKind.plus then _lexer_skip_token(); _compile_binary_rhs(); (* Execute the operation. *) _write_z("\tadd t0, t0, t1\n\0") elsif token_kind = LexerTokenKind.minus then _lexer_skip_token(); _compile_binary_rhs(); (* Execute the operation. *) _write_z("\tsub t0, t1, t0\n\0"); elsif token_kind = LexerTokenKind.multiplication then _lexer_skip_token(); _compile_binary_rhs(); (* Execute the operation. *) _write_z("\tmul t0, t0, t1\n\0") elsif token_kind = LexerTokenKind.and then _lexer_skip_token(); _compile_binary_rhs(); (* Execute the operation. *) _write_z("\tand t0, t0, t1\n\0") elsif token_kind = LexerTokenKind._or then _lexer_skip_token(); _compile_binary_rhs(); (* Execute the operation. *) _write_z("\tor t0, t0, t1\n\0") elsif token_kind = LexerTokenKind._xor then _lexer_skip_token(); _compile_binary_rhs(); (* Execute the operation. *) _write_z("\txor t0, t0, t1\n\0") elsif token_kind = LexerTokenKind.equals then _lexer_skip_token(); _compile_binary_rhs(); (* Execute the operation. *) _write_z("\txor t0, t0, t1\n\tseqz t0, t0\n\0") elsif token_kind = LexerTokenKind.remainder then _lexer_skip_token(); _compile_binary_rhs(); (* Execute the operation. *) _write_z("\trem t0, t1, t0\n\0") elsif token_kind = LexerTokenKind.division then _lexer_skip_token(); _compile_binary_rhs(); (* Execute the operation. *) _write_z("\tdiv t0, t1, t0\n\0") elsif token_kind = LexerTokenKind.less_than then _lexer_skip_token(); _compile_binary_rhs(); (* Execute the operation. *) _write_z("\tslt t0, t1, t0\n\0") elsif token_kind = LexerTokenKind.greater_than then _lexer_skip_token(); _compile_binary_rhs(); (* Execute the operation. *) _write_z("\tslt t0, t0, t1\n\0") elsif token_kind = LexerTokenKind.less_equal then _lexer_skip_token(); _compile_binary_rhs(); (* Execute the operation. *) _write_z("\tslt t0, t0, t1\n\txori t0, t0, 1\n\0") elsif token_kind = LexerTokenKind.not_equal then _lexer_skip_token(); _compile_binary_rhs(); (* Execute the operation. *) _write_z("\txor t0, t0, t1\n\tsnez t0, t0\n\0") elsif token_kind = LexerTokenKind.greater_equal then _lexer_skip_token(); _compile_binary_rhs(); (* Execute the operation. *) _write_z("\tslt t0, t1, t0\n\txori t0, t0, 1\n\0") end; .compile_expression_end; end; proc _compile_call(); var name_length: Word; name: Word; argument_count: Word; stack_offset: Word; token_kind: Word; begin _lexer_read_token(@token_kind); name := _lexer_global_get_start(); name_length := _lexer_global_get_end() - name; argument_count := 0; (* Skip the identifier and left paren. *) _lexer_skip_token(); _lexer_read_token(@token_kind); _lexer_skip_token(); _lexer_read_token(@token_kind); if token_kind = LexerTokenKind.right_paren then goto compile_call_finalize end; .compile_call_loop; _compile_expression(); (* Save the argument on the stack. *) _write_z("\tsw t0, \0"); (* Calculate the stack offset: 116 - (4 * argument_counter) *) stack_offset := argument_count * 4; _write_i(116 - stack_offset); _write_z("(sp)\n\0"); (* Add one to the argument counter. *) argument_count := argument_count + 1; _lexer_read_token(@token_kind); if token_kind <> LexerTokenKind.comma then goto compile_call_finalize end; _lexer_skip_token(); goto compile_call_loop; .compile_call_finalize; (* Load the argument from the stack. *) if argument_count <> 0 then (* Decrement the argument counter. *) argument_count := argument_count - 1; _write_z("\tlw a\0"); _write_i(argument_count); _write_z(", \0"); (* Calculate the stack offset: 116 - (4 * argument_counter) *) stack_offset := argument_count * 4; _write_i(116 - stack_offset); _write_z("(sp)\n\0"); goto compile_call_finalize end; .compile_call_end; _write_z("\tcall \0"); _write_s(name, name_length); _write_c('\n'); (* Skip the right paren. *) _lexer_read_token(@token_kind); _lexer_skip_token() end; proc _compile_goto(); var next_token: Word; next_length: Word; token_kind: Word; begin _lexer_skip_token(); _lexer_read_token(@token_kind); if token_kind = LexerTokenKind.dot then _lexer_skip_token(); _lexer_read_token(@token_kind) end; next_token := _lexer_global_get_start(); next_length := _lexer_global_get_end() - next_token; _write_z("\tj .\0"); _write_s(next_token, next_length); _lexer_skip_token() end; proc _compile_local_designator(symbol: Word); var variable_offset: Word; begin _write_z("\taddi t0, sp, \0"); variable_offset := _parameter_info_get_offset(symbol); _write_i(variable_offset); _write_c('\n'); _lexer_skip_token() end; proc _compile_global_designator(); var name: Word; token_kind: Word; token_length: Word; begin _write_z("\tla t0, \0"); _lexer_read_token(@token_kind); name := _lexer_global_get_start(); token_length := _lexer_global_get_end() - name; _write_s(name, token_length); _lexer_skip_token(); _write_c('\n') end; proc _compile_enumeration_value(symbol: Word); var enumeration_type: Word; members: Word; members_length: Word; token_type: Word; value_name: Word; name_length: Word; member_name: Word; member_length: Word; counter: Word; begin enumeration_type := _type_info_get_type(symbol); members := _enumeration_type_get_members(enumeration_type); members_length := _enumeration_type_get_length(enumeration_type); (* Skip enumeration type name and dot. Read the enumeration value. *) _lexer_skip_token(); _lexer_read_token(@token_type); _lexer_skip_token(); _lexer_read_token(@token_type); value_name := _lexer_global_get_start(); name_length := _lexer_global_get_end() - value_name; _lexer_skip_token(); counter := 1; .compile_enumeration_value_members; if members_length > 0 then member_name := members^; member_length := _load_word(members + 4); if _lexer_compare_keyword(value_name, name_length, member_name, member_length) = 0 then members_length := members_length - 1; members := members + 8; counter := counter + 1; goto compile_enumeration_value_members end; _write_z("\tli t0, \0"); _write_i(counter); _write_c('\n') end end; proc _compile_designator(); var name_token: Word; lookup_result: Word; token_kind: Word; name: Word; begin _lexer_read_token(@token_kind); name := _lexer_global_get_start(); name_token := _lexer_global_get_end() - name; lookup_result := _symbol_table_lookup(@symbol_table_local, name, name_token); if lookup_result <> 0 then _compile_local_designator(lookup_result) else _compile_global_designator() end; _lexer_read_token(@token_kind); if token_kind = LexerTokenKind.hat then _lexer_skip_token(); _write_z("\tlw t0, (t0)\n\0") end end; proc _compile_assignment(); var token_kind: Word; begin _compile_designator(); (* Save the assignee address on the stack. *) _write_z("\tsw t0, 60(sp)\n\0"); (* Skip the assignment sign (:=) with surrounding whitespaces. *) _lexer_read_token(@token_kind); _lexer_skip_token(); (* Compile the assignment. *) _compile_expression(); _write_z("\tlw t1, 60(sp)\n\tsw t0, (t1)\n\0") end; proc _compile_return_statement(); var token_kind: Word; begin (* Skip "return" keyword and whitespace after it. *) _lexer_read_token(@token_kind); _lexer_skip_token(); _compile_expression(); _write_z("\tmv a0, t0\n\0") end; (** * Writes a label, .Ln, where n is a unique number. * * Parameters: * counter - Label counter. *) proc _write_label(counter: Word); begin _write_z(".L\0"); _write_i(counter) end; proc _compile_condition(after_end_label: Word); var condition_label: Word; token_kind: Word; begin (* Compile condition. *) _compile_expression(); (* Skip " then" with newline. *) _lexer_read_token(@token_kind); _lexer_skip_token(); (* condition_label is the label in front of the next elsif condition or end. *) condition_label := label_counter; label_counter := label_counter + 1; _write_z("\tbeqz t0, \0"); _write_label(condition_label); _write_c('\n'); _compile_statement_list(); _write_z("\tj \0"); _write_label(after_end_label); _write_c('\n'); _write_label(condition_label); _write_z(":\n\0") end; proc _compile_if(); var after_end_label: Word; condition_label: Word; token_kind: Word; begin (* Skip "if ". *) _lexer_read_token(@token_kind); _lexer_skip_token(); after_end_label := label_counter; label_counter := label_counter + 1; _compile_condition(after_end_label); .compile_if_loop; _lexer_read_token(@token_kind); if token_kind = LexerTokenKind._else then _lexer_skip_token(); _compile_statement_list() elsif token_kind = LexerTokenKind._elsif then _lexer_skip_token(); _compile_condition(after_end_label); goto compile_if_loop end; _lexer_skip_token(); _write_label(after_end_label); _write_z(":\n\0") end; proc _compile_label_declaration(); var label_token: Word; token_kind: Word; name: Word; begin (* Skip the dot. *) _lexer_skip_token(); _lexer_read_token(@token_kind); name := _lexer_global_get_start(); label_token := _lexer_global_get_end() - name; _write_c('.'); _write_s(name, label_token); _write_z(":\n\0"); _lexer_skip_token() end; proc _compile_statement(); var current_byte: Word; token_kind: Word; begin _lexer_read_token(@token_kind); if token_kind = LexerTokenKind._goto then _compile_goto() elsif token_kind = LexerTokenKind._if then _compile_if() elsif token_kind = LexerTokenKind._return then _compile_return_statement() elsif token_kind = LexerTokenKind.dot then _compile_label_declaration() elsif token_kind = LexerTokenKind.identifier then current_byte := _lexer_global_get_start(); current_byte := _load_byte(current_byte); (* This is a call if the statement starts with an underscore. *) if current_byte = '_' then _compile_call() else _compile_assignment() end end; _write_c('\n') end; proc _compile_statement_list(); var token_kind: Word; begin _skip_empty_lines(); _compile_statement(); _lexer_read_token(@token_kind); if token_kind = LexerTokenKind.semicolon then _lexer_skip_token(); _compile_statement_list() end; _skip_empty_lines() 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(register_character); _write_c(register_number + '0') end; proc _type_get_kind(this: Word); return this^ end; proc _type_set_kind(this: Word, value: Word); begin _store_word(value, this) end; proc _type_get_size(this: Word); return _load_word(this + 4) end; proc _type_set_size(this: Word, value: Word); begin _store_word(value, this + 4) end; proc _enumeration_type_get_members(this: Word); return _load_word(this + 8) end; proc _enumeration_type_set_members(this: Word, value: Word); begin _store_word(value, this + 8) end; proc _enumeration_type_get_length(this: Word); return _load_word(this + 12) end; proc _enumeration_type_set_length(this: Word, value: Word); begin _store_word(value, this + 12) end; (** * Reads and creates enumeration type representation. * * record * type_kind: Word; * size: Word; * members: StringArray; * length: Word * end; * * Returns enumeration type description. *) proc _read_type_enumeration(); var token_kind: Word; enumeration_name: Word; name_length: Word; memory_start: Word; member_count: Word; result: Word; begin _lexer_skip_token(); memory_start := memory_free_pointer; member_count := 0; _lexer_read_token(@token_kind); if token_kind = LexerTokenKind.right_paren then goto read_type_enumeration_end end; .read_type_enumeration_loop; member_count := member_count + 1; enumeration_name := _lexer_global_get_start(); name_length := _lexer_global_get_end() - enumeration_name; _store_word(enumeration_name, memory_free_pointer); memory_free_pointer := memory_free_pointer + 4; _store_word(name_length, memory_free_pointer); memory_free_pointer := memory_free_pointer + 4; (* Skip the identifier. *) _lexer_skip_token(); _lexer_read_token(@token_kind); if token_kind = LexerTokenKind.comma then _lexer_skip_token(); _lexer_read_token(@token_kind); goto read_type_enumeration_loop end; .read_type_enumeration_end; _lexer_skip_token(); (* The resulting structure is 16 bytes long. *) result := memory_free_pointer; memory_free_pointer := memory_free_pointer + 16; (* ENUMERATION_TYPE is 2. *) _type_set_kind(result, 2); _type_set_size(result, 4); _enumeration_type_set_members(result, memory_start); _enumeration_type_set_length(result, member_count); return _type_info_create(result) end; proc _read_type_expression(); var token_kind: Word; type_name: Word; name_length: Word; result: Word; begin result := 0; _lexer_read_token(@token_kind); if token_kind = LexerTokenKind.identifier then (* Named type. *) type_name := _lexer_global_get_start(); name_length := _lexer_global_get_end() - type_name; result := _symbol_table_lookup(@symbol_table_global, type_name, name_length); result := _type_info_get_type(result); _lexer_skip_token() elsif token_kind = LexerTokenKind.left_paren then result := _read_type_enumeration() end; return result end; proc _type_info_get_type(this: Word); return _load_word(this + 4) end; (** * Parameters: * parameter_index - Parameter index. *) proc _parameter_info_create(parameter_index: Word); var offset: Word; current_word: Word; result: Word; begin result := memory_free_pointer; current_word := result; (* 2 is INFO_PARAMETER *) _store_word(2, current_word); current_word := current_word + 4; (* Calculate the stack offset: 88 - (4 * parameter_counter) *) offset := parameter_index * 4; _store_word(88 - offset, current_word); memory_free_pointer := current_word + 4; return result end; proc _parameter_info_get_offset(this: Word); begin this := this + 4; return this^ end; proc _type_info_create(type_representation: Word); var result: Word; current_word: Word; begin result := memory_free_pointer; current_word := result; (* 1 is INFO_TYPE *) _store_word(1, current_word); current_word := current_word + 4; _store_word(type_representation, current_word); memory_free_pointer := current_word + 4; return result end; (** * Parameters: * temporary_index - Parameter index. *) proc _temporary_info_create(temporary_index: Word); var offset: Word; current_word: Word; result: Word; begin result := memory_free_pointer; current_word := result; (* 3 is INFO_TEMPORARY *) _store_word(3, current_word); current_word := current_word + 4; (* Calculate the stack offset: 4 * variable_counter. *) _store_word(temporary_index * 4, current_word); memory_free_pointer := current_word + 4; return result end; proc _temporary_info_get_offset(this: Word); begin this := this + 4; return this^ end; (** * Parameters: * parameter_index - Parameter index. *) proc _read_procedure_parameter(parameter_index: Word); var name_length: Word; info: Word; name_position: Word; token_kind: Word; begin (* Read the parameter name. *) _lexer_read_token(@token_kind); name_position := _lexer_global_get_start(); name_length := _lexer_global_get_end() - name_position; _lexer_skip_token(); (* Skip colon and space in front of the type expression. *) _lexer_read_token(@token_kind); _lexer_skip_token(); _read_type_expression(); _write_z("\tsw a\0"); _write_i(parameter_index); _write_z(", \0"); info := _parameter_info_create(parameter_index); _symbol_table_enter(@symbol_table_local, name_position, name_length, info); info := _parameter_info_get_offset(info); _write_i(info); _write_z("(sp)\n\0") end; proc _read_procedure_parameters(); var parameter_counter: Word; token_kind: Word; begin (* Skip open paren. *) _lexer_read_token(@token_kind); _lexer_skip_token(); parameter_counter := 0; .compile_procedure_prologue_skip; _lexer_read_token(@token_kind); if token_kind <> LexerTokenKind.right_paren then _read_procedure_parameter(parameter_counter); parameter_counter := parameter_counter + 1; _lexer_read_token(@token_kind); if token_kind = LexerTokenKind.comma then _lexer_skip_token(); goto compile_procedure_prologue_skip end end; (* Skip close paren. *) _lexer_skip_token() end; (** * Parameters: * variable_index - Variable index. *) proc _read_procedure_temporary(variable_index: Word); var name_length: Word; info: Word; name_position: Word; token_kind: Word; begin _lexer_read_token(@token_kind); name_position := _lexer_global_get_start(); name_length := _lexer_global_get_end() - name_position; _lexer_skip_token(); (* Read and skip variable name, colon and the space *) _lexer_read_token(@token_kind); _lexer_skip_token(); _read_type_expression(); info := _temporary_info_create(variable_index); _symbol_table_enter(@symbol_table_local, name_position, name_length, info); (* Skip semicolon and newline after the variable declaration *) _lexer_read_token(@token_kind); _lexer_skip_token() end; proc _read_procedure_temporaries(); var temporary_counter: Word; token_kind: Word; begin _lexer_read_token(@token_kind); if token_kind = LexerTokenKind._var then _lexer_skip_token(); temporary_counter := 0; .read_local_variables_loop; _lexer_read_token(@token_kind); if token_kind = LexerTokenKind.identifier then _read_procedure_temporary(temporary_counter); temporary_counter := temporary_counter + 1; goto read_local_variables_loop end end end; proc _compile_procedure(); var name_pointer: Word; name_length: Word; token_kind: Word; begin (* Skip "proc ". *) _lexer_read_token(@token_kind); _lexer_skip_token(); (* Clear local symbol table. *) _store_word(0, @symbol_table_local); _lexer_read_token(@token_kind); name_pointer := _lexer_global_get_start(); name_length := _lexer_global_get_end() - name_pointer; (* Write .type _procedure_name, @function. *) _write_z(".type \0"); _write_s(name_pointer, name_length); _write_z(", @function\n\0"); (* Write procedure label, _procedure_name: *) _write_s(name_pointer, name_length); _write_z(":\n\0"); (* Skip procedure name. *) _lexer_skip_token(); _write_z("\taddi sp, sp, -128\n\tsw ra, 124(sp)\n\tsw s0, 120(sp)\n\taddi s0, sp, 128\n\0"); _read_procedure_parameters(); (* Skip semicolon and newline. *) _lexer_read_token(@token_kind); _lexer_skip_token(); _read_procedure_temporaries(); (* Skip semicolon, "begin" and newline. *) _lexer_read_token(@token_kind); if token_kind = LexerTokenKind._begin then _lexer_skip_token(); _compile_statement_list() elsif token_kind = LexerTokenKind._return then _compile_return_statement() end; (* Write the epilogue. *) _write_z("\tlw ra, 124(sp)\n\tlw s0, 120(sp)\n\taddi sp, sp, 128\n\tret\n\0"); (* Skip the "end" keyword, semicolon and newline. *) _lexer_read_token(@token_kind); _lexer_skip_token(); _lexer_read_token(@token_kind); _lexer_skip_token() end; (** * Skips comments. *) proc _skip_empty_lines(); var token_kind: Word; begin .skip_empty_lines_rerun; _lexer_read_token(@token_kind); if token_kind = LexerTokenKind.comment then _lexer_skip_token(); goto skip_empty_lines_rerun end end; (** * Compile global variable initializer. *) proc _compile_global_initializer(); var current_byte: Word; length: Word; token_kind: Word; token_start: Word; begin _lexer_read_token(@token_kind); token_start := _lexer_global_get_start(); current_byte := _load_byte(token_start); if token_kind = LexerTokenKind.string then _write_z("\n\t.word strings + \0"); length := _string_length(token_start); _add_string(token_start); _write_i(); (* Skip the quoted string. *) _lexer_skip_token(); goto compile_global_initializer_end elsif current_byte = 'S' then (* Skip "S(". *) _lexer_skip_token(); _lexer_read_token(@token_kind); _lexer_skip_token(); _lexer_read_token(@token_kind); if token_kind = LexerTokenKind.right_paren then goto compile_global_initializer_closing end; goto compile_global_initializer_loop elsif token_kind = LexerTokenKind.at then (* Skip @. *) _lexer_skip_token(); _write_z("\n\t.word \0"); _lexer_read_token(@token_kind); token_start := _lexer_global_get_start(); _write_s(token_start, _lexer_global_get_end() - token_start); _lexer_skip_token(); goto compile_global_initializer_end elsif token_kind = LexerTokenKind.integer then _write_z("\n\t.word \0"); _write_s(token_start, _lexer_global_get_end() - token_start); _lexer_skip_token(); goto compile_global_initializer_end end; .compile_global_initializer_loop; _compile_global_initializer(); _lexer_read_token(@token_kind); if token_kind <> LexerTokenKind.right_paren then (* Skip comma and whitespace after it. *) _lexer_skip_token(); goto compile_global_initializer_loop end; .compile_global_initializer_closing; (* Skip ")" *) _lexer_skip_token(); .compile_global_initializer_end end; proc _compile_constant_declaration(); var name: Word; name_length: Word; token_kind: Word; begin name := _lexer_global_get_start(); name_length := _lexer_global_get_end() - name; _write_z(".type \0"); _write_s(name, name_length); _write_z(", @object\n\0"); _write_s(name, name_length); _write_c(':'); (* Skip the constant name with assignment sign and surrounding whitespaces. *) _lexer_skip_token(); _lexer_read_token(@token_kind); _lexer_skip_token(); _compile_global_initializer(); (* Skip semicolon and newline. *) _lexer_read_token(@token_kind); _lexer_skip_token(); _write_c('\n') end; proc _compile_type_declaration(); var token_kind: Word; type_name: Word; name_length: Word; type_info: Word; begin type_name := _lexer_global_get_start(); name_length := _lexer_global_get_end() - type_name; _lexer_skip_token(); _lexer_read_token(@token_kind); _lexer_skip_token(); type_info := _read_type_expression(); _symbol_table_enter(@symbol_table_global, type_name, name_length, type_info); _lexer_read_token(@token_kind); _lexer_skip_token() end; proc _compile_type_part(); var token_kind: Word; begin _skip_empty_lines(); _lexer_read_token(@token_kind); if token_kind <> LexerTokenKind._type then goto compile_type_part_end end; _lexer_skip_token(); .compile_type_part_loop; _skip_empty_lines(); _lexer_read_token(@token_kind); if token_kind = LexerTokenKind.identifier then _compile_type_declaration(); goto compile_type_part_loop end; .compile_type_part_end end; proc _compile_const_part(); var token_kind: Word; begin _skip_empty_lines(); _lexer_read_token(@token_kind); if token_kind <> LexerTokenKind._const then goto compile_const_part_end end; (* Skip "const" with the newline after it. *) _lexer_skip_token(); _write_z(".section .rodata # Compiled from const section.\n\n\0"); .compile_const_part_loop; _skip_empty_lines(); (* If the character at the line beginning is not indentation, it is probably the next code section. *) _lexer_read_token(@token_kind); if token_kind = LexerTokenKind.identifier then _compile_constant_declaration(); goto compile_const_part_loop end; .compile_const_part_end end; proc _compile_variable_declaration(); var name: Word; name_length: Word; token_kind: Word; begin _lexer_read_token(@token_kind); name := _lexer_global_get_start(); name_length := _lexer_global_get_end() - name; _write_z(".type \0"); _write_s(name, name_length); _write_z(", @object\n\0"); _write_s(name, name_length); _write_c(':'); (* Skip the variable name and colon with space before the type. *) _lexer_skip_token(); _lexer_read_token(@token_kind); _lexer_skip_token(); _read_type_expression(); _lexer_read_token(@token_kind); if token_kind <> LexerTokenKind.assignment then (* Else we assume this is a zeroed 81920 bytes big array. *) _write_z(" .zero 81920\0") else (* Skip the assignment sign with surrounding whitespaces. *) _lexer_skip_token(); _compile_global_initializer(); _lexer_read_token(@token_kind) end; (* Skip semicolon and newline. *) _lexer_read_token(@token_kind); _lexer_skip_token(); _write_c('\n') end; proc _compile_var_part(); var token_kind: Word; begin _lexer_read_token(@token_kind); if token_kind <> LexerTokenKind._var then goto compile_var_part_end end; (* Skip "var" and newline. *) _lexer_skip_token(); _write_z(".section .data\n\0"); .compile_var_part_loop; _skip_empty_lines(); _lexer_read_token(@token_kind); if token_kind = LexerTokenKind.identifier then _compile_variable_declaration(); goto compile_var_part_loop end; .compile_var_part_end end; (** * Process the source code and print the generated code. *) proc _compile_module(); var token_kind: Word; begin _compile_type_part(); _compile_const_part(); _skip_empty_lines(); _compile_var_part(); _write_z(".section .text\n\n\0"); _write_z(".type _syscall, @function\n_syscall:\n\tmv a7, a6\n\tecall\n\tret\n\n\0"); _write_z(".type _load_byte, @function\n_load_byte:\n\tlb a0, (a0)\nret\n\n\0"); _write_z(".type _load_word, @function\n_load_word:\n\tlw a0, (a0)\nret\n\n\0"); _write_z(".type _store_byte, @function\n_store_byte:\n\tsb a0, (a1)\nret\n\n\0"); _write_z(".type _store_word, @function\n_store_word:\n\tsw a0, (a1)\nret\n\n\0"); .compile_module_loop; _skip_empty_lines(); _lexer_read_token(@token_kind); if token_kind = LexerTokenKind._proc then _compile_procedure(); goto compile_module_loop end end; proc _compile(); var compiler_strings_copy: Word; compiler_strings_end: Word; current_byte: Word; begin _write_z(".globl _start\n\n\0"); _compile_module(); _write_z(".section .rodata\n.type strings, @object\nstrings: .ascii \0"); _write_c('"'); compiler_strings_copy := @compiler_strings; compiler_strings_end := compiler_strings_position; .compile_loop; if compiler_strings_copy < compiler_strings_end then current_byte := _load_byte(compiler_strings_copy); compiler_strings_copy := compiler_strings_copy + 1; _write_c(current_byte); goto compile_loop end; _write_c('"'); _write_c('\n') end; (** * Terminates the program. a0 contains the return code. * * Parameters: * a0 - Status code. *) proc _exit(); begin _syscall(0, 0, 0, 0, 0, 0, 93) 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 0 in a0. *) proc _symbol_table_lookup(symbol_table: Word, symbol_name: Word, name_length: Word); var result: Word; symbol_table_length: Word; current_name: Word; current_length: Word; begin result := 0; (* The first word in the symbol table is its length, get it. *) symbol_table_length := symbol_table^; (* Go to the first symbol position. *) symbol_table := symbol_table + 4; .symbol_table_lookup_loop; if symbol_table_length = 0 then goto symbol_table_lookup_end end; (* Symbol name pointer and length. *) current_name := symbol_table^; current_length := _load_word(symbol_table + 4); (* If lengths don't match, exit and return nil. *) if name_length <> current_length then goto symbol_table_lookup_repeat end; (* If names don't match, exit and return nil. *) if _memcmp(symbol_name, current_name, name_length) <> 0 then goto symbol_table_lookup_repeat end; (* Otherwise, the symbol is found. *) result := _load_word(symbol_table + 8); goto symbol_table_lookup_end; .symbol_table_lookup_repeat; symbol_table := symbol_table + 12; symbol_table_length := symbol_table_length - 1; goto symbol_table_lookup_loop; .symbol_table_lookup_end; return result 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 _symbol_table_enter(symbol_table: Word, symbol_name: Word, name_length: Word, symbol: Word); var table_length: Word; symbol_pointer: Word; begin (* The first word in the symbol table is its length, get it. *) table_length := symbol_table^; (* Calculate the offset for the new symbol. *) symbol_pointer := table_length * 12; symbol_pointer := symbol_pointer + 4; symbol_pointer := symbol_table + symbol_pointer; _store_word(symbol_name, symbol_pointer); symbol_pointer := symbol_pointer + 4; _store_word(name_length, symbol_pointer); symbol_pointer := symbol_pointer + 4; _store_word(symbol, symbol_pointer); (* Increment the symbol table length. *) table_length := table_length + 1; _store_word(table_length, symbol_table) end; proc _symbol_table_build(); begin (* Set the table length to 0. *) _store_word(0, @symbol_table_global); (* Enter built-in symbols. *) _symbol_table_enter(@symbol_table_global, symbol_builtin_name_int, 3, @symbol_type_info_int); _symbol_table_enter(@symbol_table_global, symbol_builtin_name_word, 4, @symbol_type_info_word); _symbol_table_enter(@symbol_table_global, symbol_builtin_name_pointer, 7, @symbol_type_info_pointer); _symbol_table_enter(@symbol_table_global, symbol_builtin_name_char, 4, @symbol_type_info_char); _symbol_table_enter(@symbol_table_global, symbol_builtin_name_array, 5, @symbol_type_info_array) end; (** * Assigns some value to at array index. * * Parameters: * array - Array pointer. * index - Index (word offset into the array). * data - Data to assign. *) proc _assign_at(array: Word, index: Word, data: Word); var target: Word; begin target := index - 1; target := target * 4; target := array + target; _store_word(data, target) end; proc _get_at(array: Word, index: Word); var target: Word; begin target := index - 1; target := target * 4; target := array + target; return target^ end; (** * Initializes the array with character classes. *) proc _lexer_classifications(); var code: Word; begin _assign_at(@classification, 1, LexerClass.eof); _assign_at(@classification, 2, LexerClass.invalid); _assign_at(@classification, 3, LexerClass.invalid); _assign_at(@classification, 4, LexerClass.invalid); _assign_at(@classification, 5, LexerClass.invalid); _assign_at(@classification, 6, LexerClass.invalid); _assign_at(@classification, 7, LexerClass.invalid); _assign_at(@classification, 8, LexerClass.invalid); _assign_at(@classification, 9, LexerClass.invalid); _assign_at(@classification, 10, LexerClass.space); _assign_at(@classification, 11, LexerClass.space); _assign_at(@classification, 12, LexerClass.invalid); _assign_at(@classification, 13, LexerClass.invalid); _assign_at(@classification, 14, LexerClass.space); _assign_at(@classification, 15, LexerClass.invalid); _assign_at(@classification, 16, LexerClass.invalid); _assign_at(@classification, 17, LexerClass.invalid); _assign_at(@classification, 18, LexerClass.invalid); _assign_at(@classification, 19, LexerClass.invalid); _assign_at(@classification, 20, LexerClass.invalid); _assign_at(@classification, 21, LexerClass.invalid); _assign_at(@classification, 22, LexerClass.invalid); _assign_at(@classification, 23, LexerClass.invalid); _assign_at(@classification, 24, LexerClass.invalid); _assign_at(@classification, 25, LexerClass.invalid); _assign_at(@classification, 26, LexerClass.invalid); _assign_at(@classification, 27, LexerClass.invalid); _assign_at(@classification, 28, LexerClass.invalid); _assign_at(@classification, 29, LexerClass.invalid); _assign_at(@classification, 30, LexerClass.invalid); _assign_at(@classification, 31, LexerClass.invalid); _assign_at(@classification, 32, LexerClass.invalid); _assign_at(@classification, 33, LexerClass.space); _assign_at(@classification, 34, LexerClass.single); _assign_at(@classification, 35, LexerClass.double_quote); _assign_at(@classification, 36, LexerClass.other); _assign_at(@classification, 37, LexerClass.other); _assign_at(@classification, 38, LexerClass.single); _assign_at(@classification, 39, LexerClass.single); _assign_at(@classification, 40, LexerClass.single_quote); _assign_at(@classification, 41, LexerClass.left_paren); _assign_at(@classification, 42, LexerClass.right_paren); _assign_at(@classification, 43, LexerClass.asterisk); _assign_at(@classification, 44, LexerClass.single); _assign_at(@classification, 45, LexerClass.single); _assign_at(@classification, 46, LexerClass.minus); _assign_at(@classification, 47, LexerClass.dot); _assign_at(@classification, 48, LexerClass.single); _assign_at(@classification, 49, LexerClass.zero); _assign_at(@classification, 50, LexerClass.digit); _assign_at(@classification, 51, LexerClass.digit); _assign_at(@classification, 52, LexerClass.digit); _assign_at(@classification, 53, LexerClass.digit); _assign_at(@classification, 54, LexerClass.digit); _assign_at(@classification, 55, LexerClass.digit); _assign_at(@classification, 56, LexerClass.digit); _assign_at(@classification, 57, LexerClass.digit); _assign_at(@classification, 58, LexerClass.digit); _assign_at(@classification, 59, LexerClass.colon); _assign_at(@classification, 60, LexerClass.single); _assign_at(@classification, 61, LexerClass.less); _assign_at(@classification, 62, LexerClass.equals); _assign_at(@classification, 63, LexerClass.greater); _assign_at(@classification, 64, LexerClass.other); _assign_at(@classification, 65, LexerClass.single); _assign_at(@classification, 66, LexerClass.alpha); _assign_at(@classification, 67, LexerClass.alpha); _assign_at(@classification, 68, LexerClass.alpha); _assign_at(@classification, 69, LexerClass.alpha); _assign_at(@classification, 70, LexerClass.alpha); _assign_at(@classification, 71, LexerClass.alpha); _assign_at(@classification, 72, LexerClass.alpha); _assign_at(@classification, 73, LexerClass.alpha); _assign_at(@classification, 74, LexerClass.alpha); _assign_at(@classification, 75, LexerClass.alpha); _assign_at(@classification, 76, LexerClass.alpha); _assign_at(@classification, 77, LexerClass.alpha); _assign_at(@classification, 78, LexerClass.alpha); _assign_at(@classification, 79, LexerClass.alpha); _assign_at(@classification, 80, LexerClass.alpha); _assign_at(@classification, 81, LexerClass.alpha); _assign_at(@classification, 82, LexerClass.alpha); _assign_at(@classification, 83, LexerClass.alpha); _assign_at(@classification, 84, LexerClass.alpha); _assign_at(@classification, 85, LexerClass.alpha); _assign_at(@classification, 86, LexerClass.alpha); _assign_at(@classification, 87, LexerClass.alpha); _assign_at(@classification, 88, LexerClass.alpha); _assign_at(@classification, 89, LexerClass.alpha); _assign_at(@classification, 90, LexerClass.alpha); _assign_at(@classification, 91, LexerClass.alpha); _assign_at(@classification, 92, LexerClass.single); _assign_at(@classification, 93, LexerClass.backslash); _assign_at(@classification, 94, LexerClass.single); _assign_at(@classification, 95, LexerClass.single); _assign_at(@classification, 96, LexerClass.alpha); _assign_at(@classification, 97, LexerClass.other); _assign_at(@classification, 98, LexerClass.hex); _assign_at(@classification, 99, LexerClass.hex); _assign_at(@classification, 100, LexerClass.hex); _assign_at(@classification, 101, LexerClass.hex); _assign_at(@classification, 102, LexerClass.hex); _assign_at(@classification, 103, LexerClass.hex); _assign_at(@classification, 104, LexerClass.alpha); _assign_at(@classification, 105, LexerClass.alpha); _assign_at(@classification, 106, LexerClass.alpha); _assign_at(@classification, 107, LexerClass.alpha); _assign_at(@classification, 108, LexerClass.alpha); _assign_at(@classification, 109, LexerClass.alpha); _assign_at(@classification, 110, LexerClass.alpha); _assign_at(@classification, 111, LexerClass.alpha); _assign_at(@classification, 112, LexerClass.alpha); _assign_at(@classification, 113, LexerClass.alpha); _assign_at(@classification, 114, LexerClass.alpha); _assign_at(@classification, 115, LexerClass.alpha); _assign_at(@classification, 116, LexerClass.alpha); _assign_at(@classification, 117, LexerClass.alpha); _assign_at(@classification, 118, LexerClass.alpha); _assign_at(@classification, 119, LexerClass.alpha); _assign_at(@classification, 120, LexerClass.alpha); _assign_at(@classification, 121, LexerClass.x); _assign_at(@classification, 122, LexerClass.alpha); _assign_at(@classification, 123, LexerClass.alpha); _assign_at(@classification, 124, LexerClass.other); _assign_at(@classification, 125, LexerClass.single); _assign_at(@classification, 126, LexerClass.other); _assign_at(@classification, 127, LexerClass.single); _assign_at(@classification, 128, LexerClass.invalid); code := 129; (* Set the remaining 129 - 256 bytes to transitionClassOther. *) .create_classification_loop; _assign_at(@classification, code, LexerClass.other); code := code + 1; if code < 257 then goto create_classification_loop end end; proc _lexer_get_transition(current_state: Word, character_class: Word); var transition_table: Word; row_position: Word; column_position: Word; target: Word; begin (* Each state is 8 bytes long (2 words: action and next state). There are 22 character classes, so a transition row 8 * 22 = 176 bytes long. *) row_position := current_state - 1; row_position := row_position * 176; column_position := character_class - 1; column_position := column_position * 8; target := _lexer_get_transition_table() + row_position; return target + column_position end; (** * Parameters: * current_state - First index into transitions table. * character_class - Second index into transitions table. * action - Action to assign. * next_state - Next state to assign. *) proc _lexer_set_transition(current_state: Word, character_class: Word, action: Word, next_state: Word); var transition: Word; begin transition := _lexer_get_transition(current_state, character_class); _lexer_transition_set_action(transition, action); _lexer_transition_set_state(transition, next_state) end; (* Sets same action and state transition for all character classes in one transition row. *) (** * Parameters: * current_state - Current state (Transition state enumeration). * default_action - Default action (Callback). * next_state - Next state (Transition state enumeration). *) proc _lexer_default_transition(current_state: Word, default_action: Word, next_state: Word); begin _lexer_set_transition(current_state, LexerClass.invalid, default_action, next_state); _lexer_set_transition(current_state, LexerClass.digit, default_action, next_state); _lexer_set_transition(current_state, LexerClass.alpha, default_action, next_state); _lexer_set_transition(current_state, LexerClass.space, default_action, next_state); _lexer_set_transition(current_state, LexerClass.colon, default_action, next_state); _lexer_set_transition(current_state, LexerClass.equals, default_action, next_state); _lexer_set_transition(current_state, LexerClass.left_paren, default_action, next_state); _lexer_set_transition(current_state, LexerClass.right_paren, default_action, next_state); _lexer_set_transition(current_state, LexerClass.asterisk, default_action, next_state); _lexer_set_transition(current_state, LexerClass.backslash, default_action, next_state); _lexer_set_transition(current_state, LexerClass.single, default_action, next_state); _lexer_set_transition(current_state, LexerClass.hex, default_action, next_state); _lexer_set_transition(current_state, LexerClass.zero, default_action, next_state); _lexer_set_transition(current_state, LexerClass.x, default_action, next_state); _lexer_set_transition(current_state, LexerClass.eof, default_action, next_state); _lexer_set_transition(current_state, LexerClass.dot, default_action, next_state); _lexer_set_transition(current_state, LexerClass.minus, default_action, next_state); _lexer_set_transition(current_state, LexerClass.single_quote, default_action, next_state); _lexer_set_transition(current_state, LexerClass.double_quote, default_action, next_state); _lexer_set_transition(current_state, LexerClass.greater, default_action, next_state); _lexer_set_transition(current_state, LexerClass.less, default_action, next_state); _lexer_set_transition(current_state, LexerClass.other, default_action, next_state) end; (** * The transition table describes transitions from one state to another, given * a symbol (character class). * * The table has m rows and n columns, where m is the amount of states and n is * the amount of classes. So given the current state and a classified character * the table can be used to look up the next state. *) proc _lexer_transitions(); begin (* Start state. *) _lexer_set_transition(LexerState.start, LexerClass.invalid, LexerAction.none, LexerState.finish); _lexer_set_transition(LexerState.start, LexerClass.digit, LexerAction.accumulate, LexerState.decimal); _lexer_set_transition(LexerState.start, LexerClass.alpha, LexerAction.accumulate, LexerState.identifier); _lexer_set_transition(LexerState.start, LexerClass.space, LexerAction.skip, LexerState.start); _lexer_set_transition(LexerState.start, LexerClass.colon, LexerAction.accumulate, LexerState.colon); _lexer_set_transition(LexerState.start, LexerClass.equals, LexerAction.single, LexerState.finish); _lexer_set_transition(LexerState.start, LexerClass.left_paren, LexerAction.accumulate, LexerState.left_paren); _lexer_set_transition(LexerState.start, LexerClass.right_paren, LexerAction.single, LexerState.finish); _lexer_set_transition(LexerState.start, LexerClass.asterisk, LexerAction.single, LexerState.finish); _lexer_set_transition(LexerState.start, LexerClass.backslash, LexerAction.none, LexerState.finish); _lexer_set_transition(LexerState.start, LexerClass.single, LexerAction.single, LexerState.finish); _lexer_set_transition(LexerState.start, LexerClass.hex, LexerAction.accumulate, LexerState.identifier); _lexer_set_transition(LexerState.start, LexerClass.zero, LexerAction.accumulate, LexerState.leading_zero); _lexer_set_transition(LexerState.start, LexerClass.x, LexerAction.accumulate, LexerState.identifier); _lexer_set_transition(LexerState.start, LexerClass.eof, LexerAction.eof, LexerState.finish); _lexer_set_transition(LexerState.start, LexerClass.dot, LexerAction.single, LexerState.finish); _lexer_set_transition(LexerState.start, LexerClass.minus, LexerAction.accumulate, LexerState.minus); _lexer_set_transition(LexerState.start, LexerClass.single_quote, LexerAction.accumulate, LexerState.character); _lexer_set_transition(LexerState.start, LexerClass.double_quote, LexerAction.accumulate, LexerState.string); _lexer_set_transition(LexerState.start, LexerClass.greater, LexerAction.accumulate, LexerState.greater); _lexer_set_transition(LexerState.start, LexerClass.less, LexerAction.accumulate, LexerState.less); _lexer_set_transition(LexerState.start, LexerClass.other, LexerAction.none, LexerState.finish); (* Colon state. *) _lexer_default_transition(LexerState.colon, LexerAction.finalize, LexerState.finish); _lexer_set_transition(LexerState.colon, LexerClass.equals, LexerAction.composite, LexerState.finish); (* Identifier state. *) _lexer_default_transition(LexerState.identifier, LexerAction.key_id, LexerState.finish); _lexer_set_transition(LexerState.identifier, LexerClass.digit, LexerAction.accumulate, LexerState.identifier); _lexer_set_transition(LexerState.identifier, LexerClass.alpha, LexerAction.accumulate, LexerState.identifier); _lexer_set_transition(LexerState.identifier, LexerClass.hex, LexerAction.accumulate, LexerState.identifier); _lexer_set_transition(LexerState.identifier, LexerClass.zero, LexerAction.accumulate, LexerState.identifier); _lexer_set_transition(LexerState.identifier, LexerClass.x, LexerAction.accumulate, LexerState.identifier); (* Decimal state. *) _lexer_default_transition(LexerState.decimal, LexerAction.integer, LexerState.finish); _lexer_set_transition(LexerState.decimal, LexerClass.digit, LexerAction.accumulate, LexerState.decimal); _lexer_set_transition(LexerState.decimal, LexerClass.alpha, LexerAction.none, LexerState.finish); _lexer_set_transition(LexerState.decimal, LexerClass.hex, LexerAction.none, LexerState.finish); _lexer_set_transition(LexerState.decimal, LexerClass.zero, LexerAction.accumulate, LexerState.decimal); _lexer_set_transition(LexerState.decimal, LexerClass.x, LexerAction.none, LexerState.finish); (* Leading zero. *) _lexer_default_transition(LexerState.leading_zero, LexerAction.integer, LexerState.finish); _lexer_set_transition(LexerState.leading_zero, LexerClass.digit, LexerAction.none, LexerState.finish); _lexer_set_transition(LexerState.leading_zero, LexerClass.alpha, LexerAction.none, LexerState.finish); _lexer_set_transition(LexerState.leading_zero, LexerClass.hex, LexerAction.none, LexerState.finish); _lexer_set_transition(LexerState.leading_zero, LexerClass.zero, LexerAction.none, LexerState.finish); _lexer_set_transition(LexerState.leading_zero, LexerClass.x, LexerAction.none, LexerState.dot); (* Greater state. *) _lexer_default_transition(LexerState.greater, LexerAction.finalize, LexerState.finish); _lexer_set_transition(LexerState.greater, LexerClass.equals, LexerAction.composite, LexerState.finish); (* Minus state. *) _lexer_default_transition(LexerState.minus, LexerAction.finalize, LexerState.finish); _lexer_set_transition(LexerState.minus, LexerClass.greater, LexerAction.composite, LexerState.finish); (* Left paren state. *) _lexer_default_transition(LexerState.left_paren, LexerAction.finalize, LexerState.finish); _lexer_set_transition(LexerState.left_paren, LexerClass.asterisk, LexerAction.accumulate, LexerState.comment); (* Less state. *) _lexer_default_transition(LexerState.less, LexerAction.finalize, LexerState.finish); _lexer_set_transition(LexerState.less, LexerClass.equals, LexerAction.composite, LexerState.finish); _lexer_set_transition(LexerState.less, LexerClass.greater, LexerAction.composite, LexerState.finish); (* Hexadecimal after 0x. *) _lexer_default_transition(LexerState.dot, LexerAction.finalize, LexerState.finish); _lexer_set_transition(LexerState.dot, LexerClass.dot, LexerAction.composite, LexerState.finish); (* Comment. *) _lexer_default_transition(LexerState.comment, LexerAction.accumulate, LexerState.comment); _lexer_set_transition(LexerState.comment, LexerClass.asterisk, LexerAction.accumulate, LexerState.closing_comment); _lexer_set_transition(LexerState.comment, LexerClass.eof, LexerAction.none, LexerState.finish); (* Closing comment. *) _lexer_default_transition(LexerState.closing_comment, LexerAction.accumulate, LexerState.comment); _lexer_set_transition(LexerState.closing_comment, LexerClass.invalid, LexerAction.none, LexerState.finish); _lexer_set_transition(LexerState.closing_comment, LexerClass.right_paren, LexerAction.delimited, LexerState.finish); _lexer_set_transition(LexerState.closing_comment, LexerClass.asterisk, LexerAction.accumulate, LexerState.closing_comment); _lexer_set_transition(LexerState.closing_comment, LexerClass.eof, LexerAction.none, LexerState.finish); (* Character. *) _lexer_default_transition(LexerState.character, LexerAction.accumulate, LexerState.character); _lexer_set_transition(LexerState.character, LexerClass.invalid, LexerAction.none, LexerState.finish); _lexer_set_transition(LexerState.character, LexerClass.eof, LexerAction.none, LexerState.finish); _lexer_set_transition(LexerState.character, LexerClass.single_quote, LexerAction.delimited, LexerState.finish); _lexer_set_transition(LexerState.character, LexerClass.backslash, LexerAction.accumulate, LexerState.character_escape); (* Escape sequence in a character. *) _lexer_default_transition(LexerState.character_escape, LexerAction.accumulate, LexerState.character); _lexer_set_transition(LexerState.character_escape, LexerClass.invalid, LexerAction.none, LexerState.finish); _lexer_set_transition(LexerState.character_escape, LexerClass.eof, LexerAction.none, LexerState.finish); (* String. *) _lexer_default_transition(LexerState.string, LexerAction.accumulate, LexerState.string); _lexer_set_transition(LexerState.string, LexerClass.invalid, LexerAction.none, LexerState.finish); _lexer_set_transition(LexerState.string, LexerClass.eof, LexerAction.none, LexerState.finish); _lexer_set_transition(LexerState.string, LexerClass.double_quote, LexerAction.delimited, LexerState.finish); _lexer_set_transition(LexerState.string, LexerClass.backslash, LexerAction.accumulate, LexerState.string_escape); (* Escape sequence in a string. *) _lexer_default_transition(LexerState.string_escape, LexerAction.accumulate, LexerState.string); _lexer_set_transition(LexerState.string_escape, LexerClass.invalid, LexerAction.none, LexerState.finish); _lexer_set_transition(LexerState.string_escape, LexerClass.eof, LexerAction.none, LexerState.finish) end; (** * Transition table is saved after character classification table. * Each character entry is 1 word long and there are 256 characters. * 1024 = 256 * 4 *) proc _lexer_get_transition_table(); return @classification + 1024 end; (** * Lexer state is saved after the transition tables. * Each transition table entry is 8 bytes long. The table has 16 rows (transition states) * and 22 columns (character classes), so 2992 = 8 * 17 * 22. *) proc _lexer_global_state(); return _lexer_get_transition_table() + 2992 end; (** * Gets pointer to the token start. *) proc _lexer_global_get_start(); var target: Word; begin target := _lexer_global_state() + 4; return target^ end; (** * Sets pointer to the token start. *) proc _lexer_global_set_start(new_start: Word); var target: Word; begin target := _lexer_global_state() + 4; _store_word(new_start, target) end; (** * Gets pointer to the token end. *) proc _lexer_global_get_end(); var target: Word; begin target := _lexer_global_state() + 8; return target^ end; (** * Sets pointer to the token end. *) proc _lexer_global_set_end(new_start: Word); var target: Word; begin target := _lexer_global_state() + 8; _store_word(new_start, target) end; proc _lexer_transition_get_action(transition: Word); return transition^ end; proc _lexer_transition_set_action(transition: Word, action: Word); begin _store_word(action, transition) end; proc _lexer_transition_get_state(transition: Word); return _load_word(transition + 4) end; proc _lexer_transition_set_state(transition: Word, state: Word); begin _store_word(state, transition + 4) end; (** * Resets the lexer state for reading the next token. *) proc _lexer_reset(); var state: Word; begin (* Transition start state is 1. *) state := _lexer_global_state(); _store_word(LexerState.start, state); state := _lexer_global_get_start(); _lexer_global_set_end(state) end; (** * One time lexer initialization. *) proc _lexer_initialize(); begin _lexer_classifications(); _lexer_transitions(); _lexer_global_set_start(@source_code); _lexer_global_set_end(@source_code) end; proc _lexer_next_transition(); var current_character: Word; character_class: Word; current_state: Word; begin current_character := _lexer_global_get_end(); current_character := _load_byte(current_character); character_class := _get_at(@classification, current_character + 1); current_state := _lexer_global_state(); current_state := current_state^; return _lexer_get_transition(current_state, character_class) end; proc _lexer_compare_keyword(lhs_pointer: Word, lhs_length: Word, rhs_pointer: Word, rhs_length: Word); var result: Word; begin result := 0; if lhs_length = rhs_length then result := _memcmp(lhs_pointer, rhs_pointer, lhs_length) = 0 end; return result end; proc _lexer_classify_keyword(position_start: Word, position_end: Word); var result: Word; token_length: Word; begin result := LexerTokenKind.identifier; token_length := position_end - position_start; if _lexer_compare_keyword(position_start, token_length, "const", 5) = 1 then result := LexerTokenKind._const elsif _lexer_compare_keyword(position_start, token_length, "var", 3) = 1 then result := LexerTokenKind._var elsif _lexer_compare_keyword(position_start, token_length, "proc", 4) = 1 then result := LexerTokenKind._proc elsif _lexer_compare_keyword(position_start, token_length, "type", 4) = 1 then result := LexerTokenKind._type elsif _lexer_compare_keyword(position_start, token_length, "begin", 5) = 1 then result := LexerTokenKind._begin elsif _lexer_compare_keyword(position_start, token_length, "end", 3) = 1 then result := LexerTokenKind._end elsif _lexer_compare_keyword(position_start, token_length, "return", 6) = 1 then result := LexerTokenKind._return elsif _lexer_compare_keyword(position_start, token_length, "goto", 4) = 1 then result := LexerTokenKind._goto elsif _lexer_compare_keyword(position_start, token_length, "if", 2) = 1 then result := LexerTokenKind._if elsif _lexer_compare_keyword(position_start, token_length, "while", 5) = 1 then result := LexerTokenKind._while elsif _lexer_compare_keyword(position_start, token_length, "then", 4) = 1 then result := LexerTokenKind._then elsif _lexer_compare_keyword(position_start, token_length, "else", 4) = 1 then result := LexerTokenKind._else elsif _lexer_compare_keyword(position_start, token_length, "elsif", 5) = 1 then result := LexerTokenKind._elsif elsif _lexer_compare_keyword(position_start, token_length, "or", 2) = 1 then result := LexerTokenKind._or elsif _lexer_compare_keyword(position_start, token_length, "xor", 2) = 1 then result := LexerTokenKind._xor end; return result end; proc _lexer_classify_finalize(start_position: Word); var character: Word; result: Word; begin result := 0; character := _load_byte(start_position); if character = ':' then result := LexerTokenKind.colon elsif character = '.' then result := LexerTokenKind.dot elsif character = '(' then result := LexerTokenKind.left_paren elsif character = '-' then result := LexerTokenKind.minus elsif character = '<' then result := LexerTokenKind.less_than elsif character = '>' then result := LexerTokenKind.greater_than end; return result end; proc _lexer_classify_single(start_position: Word); var character: Word; result: Word; begin result := 0; character := _load_byte(start_position); if character = ';' then result := LexerTokenKind.semicolon elsif character = ',' then result := LexerTokenKind.comma elsif character = ')' then result := LexerTokenKind.right_paren elsif character = '@' then result := LexerTokenKind.at elsif character = '~' then result := LexerTokenKind.not elsif character = '&' then result := LexerTokenKind.and elsif character = '+' then result := LexerTokenKind.plus elsif character = '*' then result := LexerTokenKind.multiplication elsif character = '=' then result := LexerTokenKind.equals elsif character = '%' then result := LexerTokenKind.remainder elsif character = '/' then result := LexerTokenKind.division elsif character = '.' then result := LexerTokenKind.dot elsif character = '^' then result := LexerTokenKind.hat end; return result end; proc _lexer_classify_composite(start_position: Word, one_before_last: Word); var first_character: Word; last_character: Word; result: Word; begin first_character := _load_byte(start_position); last_character := _load_byte(one_before_last); if first_character = ':' then result := LexerTokenKind.assignment elsif first_character = '<' then if last_character = '=' then result := LexerTokenKind.less_equal elsif last_character = '>' then result := LexerTokenKind.not_equal end elsif first_character = '>' then if last_character = '=' then result := LexerTokenKind.greater_equal end end; return result end; proc _lexer_classify_delimited(start_position: Word, end_position: Word); var token_length: Word; delimiter: Word; result: Word; begin token_length := end_position - start_position; delimiter := _load_byte(start_position); if delimiter = '(' then result := LexerTokenKind.comment elsif delimiter = '\'' then result := LexerTokenKind.character elsif delimiter = '"' then result := LexerTokenKind.string end; return result end; proc _lexer_classify_integer(start_position: Word, end_position: Word); begin return LexerTokenKind.integer end; proc _lexer_execute_action(action_to_perform: Word, kind: Word); var position_start: Word; position_end: Word; intermediate: Word; begin position_start := _lexer_global_get_start(); position_end := _lexer_global_get_end(); if action_to_perform = LexerAction.none then elsif action_to_perform = LexerAction.accumulate then _lexer_global_set_end(position_end + 1) elsif action_to_perform = LexerAction.skip then _lexer_global_set_start(position_start + 1); _lexer_global_set_end(position_end + 1) elsif action_to_perform = LexerAction.single then _lexer_global_set_end(position_end + 1); intermediate := _lexer_classify_single(position_start); _store_word(intermediate, kind) elsif action_to_perform = LexerAction.eof then intermediate := LexerTokenKind.eof; _store_word(intermediate, kind) elsif action_to_perform = LexerAction.finalize then intermediate := _lexer_classify_finalize(position_start); _store_word(intermediate, kind) elsif action_to_perform = LexerAction.composite then _lexer_global_set_end(position_end + 1); intermediate := _lexer_classify_composite(position_start, position_end); _store_word(intermediate, kind) elsif action_to_perform = LexerAction.key_id then intermediate := _lexer_classify_keyword(position_start, position_end); _store_word(intermediate, kind) elsif action_to_perform = LexerAction.integer then intermediate := _lexer_classify_integer(position_start, position_end); _store_word(intermediate, kind) elsif action_to_perform = LexerAction.delimited then _lexer_global_set_end(position_end + 1); intermediate := _lexer_classify_delimited(position_start, position_end + 1); _store_word(intermediate, kind) end; end; proc _lexer_execute_transition(kind: Word); var next_transition: Word; next_state: Word; global_state: Word; action_to_perform: Word; begin next_transition := _lexer_next_transition(); next_state := _lexer_transition_get_state(next_transition); action_to_perform := _lexer_transition_get_action(next_transition); global_state := _lexer_global_state(); _store_word(next_state, global_state); _lexer_execute_action(action_to_perform, kind); return next_state end; proc _lexer_advance_token(kind: Word); begin if _lexer_execute_transition(kind) <> LexerState.finish then _lexer_advance_token(kind) end end; (** * Reads the next token and writes its type into the address in the kind parameter. *) proc _lexer_read_token(kind: Word); begin _lexer_reset(); _lexer_advance_token(kind) end; (** * Advances the token stream past the last read token. *) proc _lexer_skip_token(); var old_end: Word; begin old_end := _lexer_global_get_end(); _lexer_global_set_start(old_end) end; (* * Entry point. *) proc _start(); var last_read: Word; offset: Word; begin _lexer_initialize(); _symbol_table_build(); (* Read the source from the standard input. *) offset := @source_code; .start_read; (* Second argument is buffer size. Modifying update the source_code definition. *) last_read := _read_file(offset, 81920); if last_read > 0 then offset := offset + last_read; goto start_read end; _compile(); _exit(0) end;