cradle-compiler

1
#! /usr/bin/perl
2

3
## Basic single-char syntax analyzer
4

5
use strict;
6
use warnings;
7

8
my $look;
9

10
# entry point
11
sub main {
12
	&init();
13
	&expression();
14
	# if ($look ne "\r\n") {
15
	# 	&expected("New line");
16
	# }
17
}
18

19
sub init {
20
	&get_char();
21
}
22

23
## Lexer
24

25
# Следующий символ
26
sub get_char {
27
	$look = getc STDIN;
28
}
29

30
# Идентификатор
31
sub get_name {
32
	if (!&is_alpha($look)) {
33
		&expected("Name");
34
	}
35
	
36
	my $result = uc $look;
37
	&get_char();
38
	$result;
39
}
40

41
# Число
42
sub get_num {
43
	if (!&is_digit($look)) {
44
		&expected("Integer");
45
	}
46
	
47
	my $result = uc $look;
48
	&get_char();
49
	$result;
50
}
51

52
## Правила грамматики
53

54
sub ident {
55
	my $name = &get_name();
56
	if ($look eq "(") {
57
		&match("(");
58
		&match(")");
59
		&emitln("BSR ${name}");
60
	} else {
61
		&emitln("MOVE " . &get_name() . "(PC),D0");
62
	}
63
}
64

65
sub factor {
66
	if ($look eq "(") {
67
		&match("(");
68
		&expression();
69
		&match(")");
70
	} elsif (&is_alpha($look)) {
71
		&ident();
72
	} else {
73
		&emitln("MOVE #" . &get_num() . ",D0");
74
	}	
75
}
76

77
sub term {
78
	&factor();
79
	while ($look =~ /[*\/]/) {
80
		&emitln("MOVE D0,-(SP)");
81
		if ($look eq "*") {
82
			&multiply();
83
		} elsif ($look eq "/") {
84
			&divide();
85
		} else {
86
			&expected("Mulop");
87
		}
88
	}
89
}
90

91
sub expression {
92
	if (&is_addop($look)) {
93
		&emitln("CLR D0"); # - вставить 0 в начало выражения для эмуляции унарных + -
94
	} else {
95
		&term();
96
	}
97
	
98
	while (&is_addop($look)) {
99
		&emitln("MOVE D0,-(SP)");
100
		if ($look eq "+") {
101
			&add(); 
102
		} elsif ($look eq "-") {
103
			&subtract();
104
		} else {
105
			&expected("Addop");
106
		}			
107
	}
108
}
109

110
sub add {
111
	&match("+");
112
	&term();
113
	&emitln("ADD (SP)+,D0");
114
}
115

116
sub subtract {
117
	&match("-");
118
	&term();
119
	&emitln("SUB (SP)+,D0");
120
	&emitln("NEG D0");
121
}
122

123
sub multiply {
124
	&match("*");
125
	&factor();
126
	&emitln("MULS (SP)+,D0");
127
}
128

129
sub divide {
130
	&match("/");
131
	&factor();
132
	&emitln("MOVE (SP)+,D1");
133
	&emitln("DIVS D1,D0");
134
}
135

136
## Обработка ошибок
137

138
sub expected {
139
	&abort("$_[0] Expected");
140
}
141

142
sub abort {
143
	&error($_[0]);
144
	exit 1;
145
}
146

147
sub error {
148
	print "\n[ERROR] $_[0].\n";
149
}
150

151
## private
152

153
# Проверка обязательного символа
154
sub match {
155
	my $x = $_[0];
156
	if ($look eq $x) {
157
		&get_char();
158
	} else {
159
		&expected("'${x}'");
160
	}
161
}
162

163
sub is_alpha {
164
	$_[0] =~ m/[A-Z]/i;
165
}
166

167
sub is_digit {
168
	$_[0] =~ /[0-9]/i;
169
}
170

171
sub is_addop {
172
	$_[0] =~ /[+-]/
173
}
174

175
#  Возврат сформированной команды
176
sub emit {
177
	print "\t $_[0]";
178
}
179

180
sub emitln {
181
	print "\t $_[0]\n";
182
}
183

184
## Script body
185

186
main();
187
1;
188