2025-01-11 13:32:37 +01:00
|
|
|
type
|
2025-01-21 20:18:27 +01:00
|
|
|
TokenValue = union
|
|
|
|
intValue: Int;
|
2025-01-28 11:21:02 +01:00
|
|
|
stringValue: pointer to Char
|
2025-01-17 10:11:40 +01:00
|
|
|
end,
|
2025-01-21 20:18:27 +01:00
|
|
|
Token = record
|
|
|
|
kind: Int;
|
|
|
|
value: TokenValue
|
2025-01-20 21:46:03 +01:00
|
|
|
end,
|
2025-01-21 20:18:27 +01:00
|
|
|
FILE = record
|
|
|
|
dummy: Int
|
2025-01-11 13:32:37 +01:00
|
|
|
end;
|
|
|
|
|
2025-01-22 20:19:26 +01:00
|
|
|
const
|
2025-01-28 11:21:02 +01:00
|
|
|
SEEK_SET = 0, SEEK_CUR = 1, SEEK_END = 2,
|
|
|
|
POINTER_SIZE = 8, TOKEN_SIZE = 16,
|
|
|
|
TOKEN_IDENTIFIER = 1;
|
2025-01-22 20:19:26 +01:00
|
|
|
|
2025-01-25 19:50:36 +01:00
|
|
|
--
|
|
|
|
-- External procedures.
|
|
|
|
--
|
|
|
|
proc fopen(pathname: String, mode: String): pointer to FILE; extern;
|
|
|
|
proc fclose(stream: pointer to FILE): Int; extern;
|
|
|
|
proc fseek(stream: pointer to FILE, off: Int, whence: Int): Int; extern;
|
|
|
|
proc ftell(stream: pointer to FILE): Int; extern;
|
|
|
|
proc fread(ptr: pointer to Char, size: Int, nmemb: Int, stream: pointer to FILE): Int; extern;
|
|
|
|
proc write(fd: Int, buf: pointer to Char, count: Int): Int; extern;
|
|
|
|
|
|
|
|
proc malloc(size: Int): pointer to Char; extern;
|
|
|
|
proc free(ptr: pointer to Char); extern;
|
|
|
|
proc calloc(nmemb: Int, size: Int): pointer to Char; extern;
|
2025-01-28 11:21:02 +01:00
|
|
|
proc realloc(ptr: pointer to Char, size: Int): pointer to Char; extern;
|
2025-01-25 19:50:36 +01:00
|
|
|
|
|
|
|
proc memset(ptr: pointer to Char, c: Int, n: Int): pointer to Char; extern;
|
|
|
|
|
2025-01-28 11:21:02 +01:00
|
|
|
proc strncmp(s1: pointer to Char, s2: pointer to Char, n: Word): Int; extern;
|
|
|
|
proc strncpy(dst: pointer to Char, src: pointer to Char, dsize: Word): pointer to Char; extern;
|
|
|
|
proc strncpy(dst: pointer to Char, src: pointer to Char, dsize: Word): pointer to Char; extern;
|
2025-01-25 19:50:36 +01:00
|
|
|
proc strlen(ptr: pointer to Char): Word; extern;
|
|
|
|
|
|
|
|
proc exit(code: Int); extern;
|
|
|
|
|
|
|
|
--
|
|
|
|
-- Standard procedures.
|
|
|
|
--
|
|
|
|
proc write_s(value: String);
|
|
|
|
begin
|
|
|
|
write(0, value, strlen(value))
|
|
|
|
end;
|
|
|
|
|
|
|
|
proc write_b(value: Bool);
|
|
|
|
begin
|
|
|
|
if value then
|
|
|
|
write_s("true")
|
|
|
|
else
|
|
|
|
write_s("false")
|
|
|
|
end
|
|
|
|
end;
|
|
|
|
|
|
|
|
proc write_c(value: Char);
|
|
|
|
begin
|
|
|
|
write(0, @value, 1)
|
|
|
|
end;
|
|
|
|
|
2025-01-27 01:16:27 +01:00
|
|
|
proc write_i(value: Int);
|
|
|
|
var
|
|
|
|
digit: Int, n: Int,
|
|
|
|
buffer: array 10 of Char;
|
2025-01-11 13:32:37 +01:00
|
|
|
begin
|
2025-01-27 01:16:27 +01:00
|
|
|
n := 9;
|
|
|
|
buffer[9] := '0';
|
2025-01-11 13:32:37 +01:00
|
|
|
|
2025-01-27 01:16:27 +01:00
|
|
|
while value /= 0 do
|
|
|
|
digit := value % 10;
|
|
|
|
value := value / 10;
|
2025-01-11 13:32:37 +01:00
|
|
|
|
2025-01-28 11:21:02 +01:00
|
|
|
buffer[n] := cast(cast('0' as Int) + digit as Char);
|
2025-01-27 01:16:27 +01:00
|
|
|
n := n - 1
|
|
|
|
end;
|
|
|
|
while n < 10 do
|
|
|
|
n := n + 1;
|
|
|
|
write_c(buffer[n])
|
2025-01-11 13:32:37 +01:00
|
|
|
end
|
|
|
|
end;
|
|
|
|
|
2025-01-27 01:16:27 +01:00
|
|
|
proc write_u(value: Word);
|
|
|
|
begin
|
|
|
|
write_i(value)
|
|
|
|
end;
|
|
|
|
|
2025-01-28 11:21:02 +01:00
|
|
|
proc is_digit(c: Char): Bool;
|
|
|
|
begin
|
|
|
|
return cast(c as Int) >= cast('0' as Int) and cast(c as Int) <= cast('9' as Int)
|
|
|
|
end;
|
|
|
|
|
|
|
|
proc is_alpha(c: Char): Bool;
|
|
|
|
begin
|
|
|
|
return cast(c as Int) >= cast('A' as Int) and cast(c as Int) <= cast('z' as Int)
|
|
|
|
end;
|
|
|
|
|
|
|
|
proc is_alnum(c: Char): Bool;
|
|
|
|
begin
|
|
|
|
return is_digit(c) or is_alpha(c)
|
|
|
|
end;
|
|
|
|
|
|
|
|
proc is_space(c: Char): Bool;
|
|
|
|
begin
|
|
|
|
return c = ' ' or c = '\n'
|
|
|
|
end;
|
|
|
|
|
2025-01-27 01:16:27 +01:00
|
|
|
--
|
|
|
|
-- End of standard procedures.
|
|
|
|
--
|
|
|
|
|
2025-01-11 13:32:37 +01:00
|
|
|
proc test_record();
|
2025-01-21 20:18:27 +01:00
|
|
|
var r: Token;
|
2025-01-11 13:32:37 +01:00
|
|
|
begin
|
2025-01-27 01:16:27 +01:00
|
|
|
write_s("\nTest record:\n");
|
2025-01-11 13:32:37 +01:00
|
|
|
|
2025-01-21 20:18:27 +01:00
|
|
|
r.kind := 4;
|
|
|
|
r.value.intValue := 8;
|
2025-01-11 13:32:37 +01:00
|
|
|
|
2025-01-27 01:16:27 +01:00
|
|
|
write_i(r.value.intValue)
|
2025-01-17 10:11:40 +01:00
|
|
|
end;
|
|
|
|
|
2025-01-11 23:20:23 +01:00
|
|
|
proc test_primitive();
|
2025-01-11 13:32:37 +01:00
|
|
|
begin
|
2025-01-27 01:16:27 +01:00
|
|
|
write_s("\nTest primitives:\n");
|
|
|
|
write_u(25u);
|
|
|
|
write_c('\n');
|
2025-01-11 23:20:23 +01:00
|
|
|
|
2025-01-27 01:16:27 +01:00
|
|
|
write_i(8);
|
|
|
|
write_c('\n');
|
2025-01-15 01:48:09 +01:00
|
|
|
|
2025-01-27 01:16:27 +01:00
|
|
|
write_b(true);
|
|
|
|
write_c('\n')
|
2025-01-20 21:46:03 +01:00
|
|
|
end;
|
|
|
|
|
2025-01-21 20:18:27 +01:00
|
|
|
proc read_source(filename: String): pointer to Char;
|
2025-01-20 21:46:03 +01:00
|
|
|
var
|
|
|
|
input_file: pointer to FILE,
|
2025-01-21 20:18:27 +01:00
|
|
|
source_size: Int,
|
|
|
|
input: pointer to Char;
|
2025-01-20 21:46:03 +01:00
|
|
|
begin
|
2025-01-21 20:18:27 +01:00
|
|
|
input_file := fopen(filename, "rb");
|
2025-01-20 21:46:03 +01:00
|
|
|
|
2025-01-21 20:18:27 +01:00
|
|
|
fseek(input_file, 0, SEEK_END);
|
2025-01-20 21:46:03 +01:00
|
|
|
source_size := ftell(input_file);
|
2025-01-21 20:18:27 +01:00
|
|
|
fseek(input_file, 0, SEEK_SET);
|
2025-01-20 21:46:03 +01:00
|
|
|
|
2025-01-22 20:19:26 +01:00
|
|
|
input := calloc(source_size + 1, 1);
|
2025-01-21 20:18:27 +01:00
|
|
|
fread(input, source_size, 1, input_file);
|
|
|
|
|
|
|
|
fclose(input_file);
|
|
|
|
|
|
|
|
return input
|
|
|
|
end;
|
|
|
|
|
2025-01-28 11:21:02 +01:00
|
|
|
proc skip_spaces(input: pointer to Char): pointer to Char;
|
|
|
|
begin
|
|
|
|
while is_space(input^) do
|
|
|
|
input := input + 1
|
|
|
|
end;
|
|
|
|
return input
|
|
|
|
end;
|
|
|
|
|
|
|
|
proc lex_identifier(input: pointer to Char): pointer to Char;
|
|
|
|
begin
|
|
|
|
while is_alnum(input^) or input^ = '_' do
|
|
|
|
input := input + 1
|
|
|
|
end;
|
|
|
|
return input
|
|
|
|
end;
|
|
|
|
|
2025-01-21 20:18:27 +01:00
|
|
|
proc compile();
|
|
|
|
var
|
|
|
|
input: pointer to Char,
|
2025-01-28 11:21:02 +01:00
|
|
|
input_pointer: pointer to Char,
|
|
|
|
token_end: pointer to Char,
|
|
|
|
token_length: Int,
|
|
|
|
tokens: pointer to Token,
|
|
|
|
current_token: pointer to Token,
|
|
|
|
tokens_size: Int,
|
|
|
|
i: Int;
|
2025-01-21 20:18:27 +01:00
|
|
|
begin
|
2025-01-28 11:21:02 +01:00
|
|
|
tokens_size := 0;
|
|
|
|
tokens := cast(0 as pointer to Token);
|
|
|
|
|
2025-01-21 20:18:27 +01:00
|
|
|
input := read_source("example.elna");
|
|
|
|
|
2025-01-28 11:21:02 +01:00
|
|
|
input_pointer := skip_spaces(input);
|
|
|
|
|
2025-01-22 20:19:26 +01:00
|
|
|
while input_pointer^ /= '\0' do
|
2025-01-28 11:21:02 +01:00
|
|
|
if is_alpha(input_pointer^) or input_pointer^ = '_' then
|
|
|
|
token_end := lex_identifier(input_pointer + 1);
|
|
|
|
token_length := cast(token_end as Int) - cast(input_pointer as Int);
|
|
|
|
|
|
|
|
tokens := cast(realloc(tokens, tokens_size + TOKEN_SIZE) as pointer to Token);
|
|
|
|
current_token := tokens + tokens_size;
|
|
|
|
|
|
|
|
current_token^.kind := TOKEN_IDENTIFIER;
|
|
|
|
current_token^.value.stringValue := cast(calloc(token_length + 1, 1) as pointer to Char);
|
|
|
|
strncpy(current_token^.value.stringValue, input_pointer, token_length);
|
|
|
|
|
|
|
|
tokens_size := tokens_size + TOKEN_SIZE;
|
|
|
|
|
|
|
|
input_pointer := token_end
|
|
|
|
else
|
|
|
|
input_pointer := input_pointer + 1
|
|
|
|
end
|
|
|
|
end;
|
|
|
|
|
|
|
|
i := 0;
|
|
|
|
while i < tokens_size do
|
|
|
|
current_token := tokens + i;
|
|
|
|
|
|
|
|
write_s(current_token^.value.stringValue);
|
|
|
|
write_c('\n');
|
|
|
|
|
|
|
|
i := i + TOKEN_SIZE
|
2025-01-21 20:18:27 +01:00
|
|
|
end;
|
2025-01-20 21:46:03 +01:00
|
|
|
|
2025-01-21 20:18:27 +01:00
|
|
|
free(input)
|
2025-01-20 21:46:03 +01:00
|
|
|
end;
|
|
|
|
|
2025-01-11 23:20:23 +01:00
|
|
|
begin
|
2025-01-20 21:46:03 +01:00
|
|
|
compile();
|
2025-01-16 15:09:58 +01:00
|
|
|
|
2025-01-27 01:16:27 +01:00
|
|
|
test_record();
|
|
|
|
test_primitive();
|
|
|
|
|
2025-01-16 15:09:58 +01:00
|
|
|
exit(0)
|
2025-01-11 13:32:37 +01:00
|
|
|
end.
|