]> iEval git - app-scheme79asm.git/blob - lib/App/Scheme79asm.pm
Bump version and update Changes
[app-scheme79asm.git] / lib / App / Scheme79asm.pm
1 package App::Scheme79asm;
2
3 use 5.014000;
4 use strict;
5 use warnings;
6 use re '/s';
7 use Carp qw/croak/;
8
9 use Data::Dumper qw/Dumper/;
10 use Data::SExpression qw/consp scalarp/;
11 use Scalar::Util qw/looks_like_number/;
12
13 our $VERSION = '1.000';
14
15 our %TYPES = (
16 LIST => 0,
17 SYMBOL => 1,
18 NUMBER => 1,
19 VAR => 2,
20 VARIABLE => 2,
21 CLOSURE => 3,
22 PROC => 4,
23 PROCEDURE => 4,
24 IF => 5,
25 COND => 5,
26 CONDITIONAL => 5,
27 CALL => 6,
28 QUOTE => 7,
29 QUOTED => 7,
30
31 MORE => 0,
32 CAR => 1,
33 CDR => 2,
34 CONS => 3,
35 ATOM => 4,
36 PROGN => 5,
37 'REVERSE-LIST' => 6,
38 FUNCALL => 7,
39 );
40
41 *consp = *Data::SExpression::consp;
42 *scalarp = *Data::SExpression::scalarp;
43
44 sub process {
45 my ($self, $sexp, $location) = @_;
46 die 'Toplevel is not a list: ', Dumper($sexp), "\n" unless ref $sexp eq 'ARRAY';
47 my ($type, @addrs) = @$sexp;
48 my $addr;
49
50 die 'Type of toplevel is not atom: '. Dumper($type), "\n" unless scalarp($type);
51
52 if (@addrs > 1) {
53 $addr = $self->{freeptr} + 1;
54 $self->{freeptr} += @addrs;
55 $self->process($addrs[$_], $addr + $_) for 0 .. $#addrs;
56 } else {
57 $addr = $addrs[0];
58 }
59
60 $addr = $self->process($addr) if ref $addr eq 'ARRAY';
61 die 'Addr of toplevel is not atom: ', Dumper($addr), "\n" unless scalarp($addr);
62 my ($comment_type, $comment_addr) = ($type, $addr);
63 die 'Computed addr is not a number: ', Dumper($addr), "\n" unless looks_like_number $addr;
64
65 if (!looks_like_number $type) {
66 die "No such type: $type\n" unless exists $TYPES{$type};
67 $type = $TYPES{$type};
68 }
69
70 $addr += (1 << $self->{addr_bits}) if $addr < 0;
71 die "Type too large: $type\n" if $type >= (1 << $self->{type_bits});
72 die "Addr too large: $addr\n" if $addr >= (1 << $self->{addr_bits});
73 my $result = ($type << $self->{addr_bits}) + $addr;
74
75 unless ($location) {
76 $self->{freeptr}++;
77 $location = $self->{freeptr}
78 }
79 $self->{memory}[$location] = $result;
80 $self->{comment}[$location] = "$comment_type $comment_addr";
81 $location
82 }
83
84 sub parse {
85 my ($self, $string) = @_;
86 my $ds = Data::SExpression->new({symbol_case => 'up', use_symbol_class => 1, fold_lists => 1});
87
88 my $sexp;
89 while () {
90 last if $string =~ /^\s*$/;
91 ($sexp, $string) = $ds->read($string);
92 $self->process($sexp)
93 }
94 }
95
96 sub finish {
97 my ($self) = @_;
98 $self->{memory}[5] = $self->{memory}[$self->{freeptr}];
99 $self->{comment}[5] = $self->{comment}[$self->{freeptr}];
100 $self->{memory}[4] = $self->{freeptr};
101 delete $self->{memory}[$self->{freeptr}]
102 }
103
104 sub new {
105 my ($class, %args) = @_;
106 $args{type_bits} //= 3;
107 $args{addr_bits} //= 8;
108 $args{freeptr} //= 6;
109 $args{memory} //= [0, 0, (1<<$args{addr_bits}), (1<<$args{addr_bits}), 0, 0, 0];
110 my @default_comments = ('(cdr part of NIL)', '(car part of NIL)', '(cdr part of T)', '(car part of T)', '(free storage pointer)', '', '(result of computation)');
111 for (0 .. $#default_comments) {
112 $args{comment}[$_] = $default_comments[$_]
113 }
114 bless \%args, $class
115 }
116
117 sub print_binary16 {
118 my ($self, $fh) = @_;
119 $fh //= \*STDOUT; # uncoverable condition right
120
121 die "addr_bits + type_bits >= 16\n"if $self->{addr_bits} + $self->{type_bits} > 16;
122
123 my $length = @{$self->{memory}};
124 print $fh pack 'n', $length or croak "Failed to print memory size: $!"; # uncoverable branch true
125 for (@{$self->{memory}}) {
126 print $fh pack 'n', $_ or croak "Failed to print memory: $!" # uncoverable branch true
127 }
128 }
129
130 sub print_verilog {
131 my ($self, $fh) = @_;
132 $fh //= \*STDOUT; # uncoverable condition right
133
134 my $bits = $self->{type_bits} + $self->{addr_bits};
135 my $index_length = length $#{$self->{memory}};
136 my $index_format = '%' . $index_length . 'd';
137 for my $index (0 .. $#{$self->{memory}}) {
138 my $val = $self->{memory}[$index];
139 my $comment = $self->{comment}[$index];
140 if ($index == 4) {
141 $val = "${bits}'d$val"
142 } else {
143 $val = $val ? sprintf "%d'b%0${bits}b", $bits, $val : '0';
144 }
145 my $spaces = ' ' x ($bits + 5 - (length $val));
146 $index = sprintf $index_format, $index;
147
148 my $string = "mem[$index] <= $val;";
149 $string .= "$spaces // $comment" if defined $comment;
150 say $fh $string or croak "Failed to print verilog: $!"; # uncoverable branch true
151 }
152
153 }
154 sub parse_and_print_binary16 {
155 my ($self, $string, $fh) = @_;
156 $self->parse($string);
157 $self->finish;
158 $self->print_binary16($fh);
159 }
160
161 sub parse_and_print_verilog {
162 my ($self, $string, $fh) = @_;
163 $self->parse($string);
164 $self->finish;
165 $self->print_verilog($fh);
166 }
167
168 1;
169 __END__
170
171 =encoding utf-8
172
173 =head1 NAME
174
175 App::Scheme79asm - assemble sexp to Verilog ROM for SIMPLE processor
176
177 =head1 SYNOPSIS
178
179 use App::Scheme79asm;
180 my $asm = App::Scheme79asm->new(type_bits => 3, addr_bits => 5);
181 $asm->parse_and_print_verilog('(number 70)');
182
183 =head1 DESCRIPTION
184
185 SIMPLE is a LISP processor defined in the 1979
186 B<Design of LISP-Based Processors> paper by Steele and Sussman.
187
188 The SIMPLE processor expects input in a particular tagged-pointer
189 format. This module takes a string containing a sequence of
190 S-expressions. Each S-expression is a list of one of three types:
191
192 C<(tag value)>, for example C<(symbol 2)>, represents a value to be
193 put in memory (for example a number, or a symbol, or a variable
194 reference). The value must be a number.
195
196 C<(tag list)>, where C<list> is of one of these three types,
197 represents a tagged pointer. In this case, C<list> is (recursively)
198 laid out in memory as per these rules, and a pointer to that location
199 (and tagged C<tag>) is put somewhere in memory.
200
201 C<(tag list1 list2)>, where C<list1> and C<list2> are of one of these
202 three types (not necessarily the same type). In this case, C<list1>
203 and C<list2> are (recursively) laid out in memory such that C<list1>
204 is at position X and C<list2> is at position X+1, and a pointer of
205 type tag and value X is put somewhere in memory.
206
207 After this process the very last pointer placed in memory is moved to
208 the special location 5 (which is where SIMPLE expects to find the
209 expression to be evaluated).
210
211 In normal use a single S-expression will be supplied, representing an
212 entire program.
213
214 The C<tag> is either a number, a type, or a primitive.
215 The available types are:
216
217 =over
218
219 =item LIST
220
221 =item SYMBOL (syn. NUMBER)
222
223 =item VAR (syn. VARIABLE)
224
225 =item CLOSURE
226
227 =item PROC (syn. PROCEDURE)
228
229 =item IF (syn. COND, CONDITIONAL)
230
231 =item CALL
232
233 =item QUOTE (syn. QUOTED)
234
235 =back
236
237 The available primitives are:
238
239 =over
240
241 =item MORE
242
243 =item CAR
244
245 =item CDR
246
247 =item CONS
248
249 =item ATOM
250
251 =item PROGN
252
253 =item REVERSE-LIST
254
255 =item FUNCALL
256
257 =back
258
259 The following methods are available:
260
261 =over
262
263 =item App::Scheme79asm->B<new>([key => value, key => value, ...])
264
265 Create a new assembler object. Takes a list of keys and values, here
266 are the possible keys:
267
268 =over
269
270 =item type_bits
271
272 =item address_bits
273
274 A word is made of a type and an address, with the type occupying the
275 most significant C<type_bits> (default 3) bits, and the address
276 occupying the least significant C<address_bits> (default 8) bits.
277 Therefore the word size is C<type_bits + address_bits> (default 11).
278
279 =item freeptr
280
281 A pointer to the last used byte in memory (default 6). The program
282 will be laid out starting with location C<freeptr + 1>.
283
284 =item memory
285
286 The initial contents of the memory. Note that locations 4, 5, 6 will
287 be overwritten, as will every location larger than the value of
288 C<freeptr>.
289
290 =item comment
291
292 The initial comments for memory entries. C<< $comment->[$i] >> is the
293 comment for C<< $memory->[$i] >>. Note that the first 7 entries of
294 this array will be overwritten with the default comments. This is
295 useful when using custom initial memory contents and freeptr, because
296 this key can be used to provide comments for the extra reserved
297 locations in memory.
298
299 =back
300
301 =item $asm->B<parse>(I<$string>)
302
303 Parse a sequence of S-expressions and lay it out in memory.
304 Can be called multiple times to lay out multiple sequences of
305 S-expressions one after another.
306
307 =item $asm->B<process>(I<$sexp>)
308
309 Given an already-parsed sexp (meaning a
310 L<Data::SExpression> object), lay it out in memory.
311 Can be called multiple times to lay out multiple sequences of
312 S-expressions one after another.
313
314 =item $asm->B<finish>
315
316 Move the last pointer to position 5, and put the free pointer at
317 position 4. After all sequences of S-expressions have been given to
318 B<parse>, this method should be called.
319
320 =item $asm->B<print_binary16>([I<$fh>])
321
322 Print the length of the memory (as a big-endian 16-bit value),
323 followed by the memory contents as a sequence of big-endian 16-bit
324 values to the given filehandle (default STDOUT). Dies if
325 C<addr_bits + type_bits> is more than 16.
326
327 Big-endian 16-bit values can be decoded with C<unpack 'n', $value>.
328
329 =item $asm->B<print_verilog>([I<$fh>])
330
331 Print a block of Verilog code assigning the memory contents to an
332 array named C<mem> to the given filehandle (default STDOUT).
333
334 =item $asm->B<parse_and_print_binary16>(I<$string>[, I<$fh>])
335
336 Convenience method that calls B<parse>($string), B<finish>, and then
337 B<print_binary16>($fh).
338
339 =item $asm->B<parse_and_print_verilog>(I<$string>[, I<$fh>])
340
341 Convenience method that calls B<parse>($string), B<finish>, and then
342 B<print_verilog>($fh).
343
344 =back
345
346 =head1 SEE ALSO
347
348 L<http://repository.readscheme.org/ftp/papers/ai-lab-pubs/AIM-514.pdf>
349
350 =head1 AUTHOR
351
352 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
353
354 =head1 COPYRIGHT AND LICENSE
355
356 Copyright (C) 2018 by Marius Gavrilescu
357
358 This library is free software; you can redistribute it and/or modify
359 it under the same terms as Perl itself, either Perl version 5.24.3 or,
360 at your option, any later version of Perl 5 you may have available.
361
362
363 =cut
This page took 0.080788 seconds and 5 git commands to generate.