[app-scheme79asm.git] / lib / App / Scheme79asm.pm

package App::Scheme79asm;

use 5.014000;
use strict;
use warnings;

use Data::Dumper qw/Dumper/;
use Data::SExpression qw/consp scalarp/;
use Scalar::Util qw/looks_like_number/;

our $VERSION = '0.004';

our %TYPES = (
	LIST => 0,
	SYMBOL => 1,
	NUMBER => 1,
	VAR => 2,
	VARIABLE => 2,
	CLOSURE => 3,
	PROC => 4,
	PROCEDURE => 4,
	IF => 5,
	COND => 5,
	CONDITIONAL => 5,
	CALL => 6,
	QUOTE => 7,
	QUOTED => 7,

	MORE => 0,
	CAR => 1,
	CDR => 2,
	CONS => 3,
	ATOM => 4,
	PROGN => 5,
	'REVERSE-LIST' => 6,
	FUNCALL => 7,
);

*consp = *Data::SExpression::consp;
*scalarp = *Data::SExpression::scalarp;

sub process {
	my ($self, $sexp, $location) = @_;
	die 'Toplevel is not a list: ', Dumper($sexp), "\n" unless ref $sexp eq 'ARRAY';
	my ($type, @addrs) = @$sexp;
	my $addr;

	die 'Type of toplevel is not atom: '. Dumper($type), "\n" unless scalarp($type);

	if (@addrs > 1) {
		$addr = $self->{freeptr} + 1;
		$self->{freeptr} += @addrs;
		$self->process($addrs[$_], $addr + $_) for 0 .. $#addrs;
	} else {
		$addr = $addrs[0];
	}

	$addr = $self->process($addr) if ref $addr eq 'ARRAY';
	die 'Addr of toplevel is not atom: ', Dumper($addr), "\n" unless scalarp($addr);
	my ($comment_type, $comment_addr) = ($type, $addr);
	die 'Computed addr is not a number: ', Dumper($addr), "\n" unless looks_like_number $addr;

	if (!looks_like_number $type) {
		die "No such type: $type\n" unless exists $TYPES{$type};
		$type = $TYPES{$type};
	}

	$addr += (1 << $self->{addr_bits}) if $addr < 0;
	die "Type too large: $type\n" unless $type < (1 << $self->{type_bits});
	die "Addr too large: $addr\n" unless $addr < (1 << $self->{addr_bits});
	my $result = ($type << $self->{addr_bits}) + $addr;
	unless ($location) {
		$self->{freeptr}++;
		$location = $self->{freeptr}
	}
	$self->{memory}[$location] = $result;
	$self->{comment}[$location] = "$comment_type $comment_addr";
	$location
}

sub parse {
	my ($self, $string) = @_;
	my $ds = Data::SExpression->new({symbol_case => 'up', use_symbol_class => 1, fold_lists => 1});

	my $sexp;
	while () {
		last if $string =~ /^\s*$/;
		($sexp, $string) = $ds->read($string);
		$self->process($sexp)
	}
}

sub finish {
	my ($self) = @_;
	$self->{memory}[5] = $self->{memory}[$self->{freeptr}];
	$self->{comment}[5] = $self->{comment}[$self->{freeptr}];
	$self->{memory}[4] = $self->{freeptr};
	delete $self->{memory}[$self->{freeptr}]
}

sub new {
	my ($class, %args) = @_;
	$args{type_bits} //= 3;
	$args{addr_bits} //= 8;
	$args{freeptr} //= 6;
	$args{memory} //= [0, 0, (1<<$args{addr_bits}), (1<<$args{addr_bits}), 0, 0, 0];
	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)');
	for (0 .. $#default_comments) {
		$args{comment}[$_] = $default_comments[$_]
	}
	bless \%args, $class
}

sub print_binary16 {
	my ($self, $fh) = @_;
	$fh //= \*STDOUT; # uncoverable condition right

	die "addr_bits + type_bits >= 16\n"if $self->{addr_bits} + $self->{type_bits} > 16;

	my $length = @{$self->{memory}};
	print $fh pack('n', $length);
	for (@{$self->{memory}}) {
		print $fh pack('n', $_)
	}
}

sub print_verilog {
	my ($self, $fh) = @_;
	$fh //= \*STDOUT; # uncoverable condition right

	my $bits = $self->{type_bits} + $self->{addr_bits};
	my $index_length = length $#{$self->{memory}};
	my $index_format = '%' . $index_length . 'd';
	for my $index (0 .. $#{$self->{memory}}) {
		my $val = $self->{memory}[$index];
		my $comment = $self->{comment}[$index];
		if ($index == 4) {
			$val = "${bits}'d$val"
		} else {
			$val = $val ? sprintf "%d'b%0${bits}b", $bits, $val : '0';
		}
		my $spaces = ' ' x ($bits + 5 - (length $val));
		$index = sprintf $index_format, $index;

		print $fh "mem[$index] <= $val;";
		print $fh "$spaces // $comment" if defined $comment;
		print $fh "\n";
	}

}
sub parse_and_print_binary16 {
	my ($self, $string, $fh) = @_;
	$self->parse($string);
	$self->finish;
	$self->print_binary16($fh);
}

sub parse_and_print_verilog {
	my ($self, $string, $fh) = @_;
	$self->parse($string);
	$self->finish;
	$self->print_verilog($fh);
}

1;
__END__

=encoding utf-8

=head1 NAME

App::Scheme79asm - assemble sexp to Verilog ROM for SIMPLE processor

=head1 SYNOPSIS

  use App::Scheme79asm;
  my $asm = App::Scheme79asm->new(type_bits => 3, addr_bits => 5);
  $asm->parse_and_print_verilog('(number 70)');

=head1 DESCRIPTION

SIMPLE is a LISP processor defined in the 1979
B<Design of LISP-Based Processors> paper by Steele and Sussman.

The SIMPLE processor expects input in a particular tagged-pointer
format. This module takes a string containing a sequence of
S-expressions. Each S-expression is a list of one of three types:

C<(tag value)>, for example C<(symbol 2)>, represents a value to be
put in memory (for example a number, or a symbol, or a variable
reference). The value must be a number.

C<(tag list)>, where C<list> is of one of these three types,
represents a tagged pointer. In this case, C<list> is (recursively)
laid out in memory as per these rules, and a pointer to that location
(and tagged C<tag>) is put somewhere in memory.

C<(tag list1 list2)>, where C<list1> and C<list2> are of one of these
three types (not necessarily the same type). In this case, C<list1>
and C<list2> are (recursively) laid out in memory such that C<list1>
is at position X and C<list2> is at position X+1, and a pointer of
type tag and value X is put somewhere in memory.

After this process the very last pointer placed in memory is moved to
the special location 5 (which is where SIMPLE expects to find the
expression to be evaluated).

In normal use a single S-expression will be supplied, representing an
entire program.

The C<tag> is either a number, a type, or a primitive.
The available types are:

=over

=item LIST

=item SYMBOL (syn. NUMBER)

=item VAR (syn. VARIABLE)

=item CLOSURE

=item PROC (syn. PROCEDURE)

=item IF (syn. COND, CONDITIONAL)

=item CALL

=item QUOTE (syn. QUOTED)

=back

The available primitives are:

=over

=item MORE

=item CAR

=item CDR

=item CONS

=item ATOM

=item PROGN

=item REVERSE-LIST

=item FUNCALL

=back

The following methods are available:

=over

=item App::Scheme79asm->B<new>([key => value, key => value, ...])

Create a new assembler object. Takes a list of keys and values, here
are the possible keys:

=over

=item type_bits

=item address_bits

A word is made of a type and an address, with the type occupying the
most significant C<type_bits> (default 3) bits, and the address
occupying the least significant C<address_bits> (default 8) bits.
Therefore the word size is C<type_bits + address_bits> (default 11).

=item freeptr

A pointer to the last used byte in memory (default 6). The program
will be laid out starting with location C<freeptr + 1>.

=item memory

The initial contents of the memory. Note that locations 4, 5, 6 will
be overwritten, as will every location larger than the value of
C<freeptr>.

=item comment

The initial comments for memory entries. C<< $comment->[$i] >> is the
comment for C<< $memory->[$i] >>. Note that the first 7 entries of
this array will be overwritten with the default comments. This is
useful when using custom initial memory contents and freeptr, because
this key can be used to provide comments for the extra reserved
locations in memory.

=back

=item $asm->B<parse>(I<$string>)

Parse a sequence of S-expressions and lay it out in memory.
Can be called multiple times to lay out multiple sequences of
S-expressions one after another.

=item $asm->B<process>(I<$sexp>)

Given an already-parsed sexp (meaning a
L<Data::SExpression> object), lay it out in memory.
Can be called multiple times to lay out multiple sequences of
S-expressions one after another.

=item $asm->B<finish>

Move the last pointer to position 5, and put the free pointer at
position 4. After all sequences of S-expressions have been given to
B<parse>, this method should be called.

=item $asm->B<print_binary16>([I<$fh>])

Print the length of the memory (as a big-endian 16-bit value),
followed by the memory contents as a sequence of big-endian 16-bit
values to the given filehandle (default STDOUT). Dies if
C<addr_bits + type_bits> is more than 16.

Big-endian 16-bit values can be decoded with C<unpack 'n', $value>.

=item $asm->B<print_verilog>([I<$fh>])

Print a block of Verilog code assigning the memory contents to an
array named C<mem> to the given filehandle (default STDOUT).

=item $asm->B<parse_and_print_binary16>(I<$string>[, I<$fh>])

Convenience method that calls B<parse>($string), B<finish>, and then
B<print_binary16>($fh).

=item $asm->B<parse_and_print_verilog>(I<$string>[, I<$fh>])

Convenience method that calls B<parse>($string), B<finish>, and then
B<print_verilog>($fh).

=back

=head1 SEE ALSO

L<http://repository.readscheme.org/ftp/papers/ai-lab-pubs/AIM-514.pdf>

=head1 AUTHOR

Marius Gavrilescu, E<lt>marius@ieval.roE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2018 by Marius Gavrilescu

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.24.3 or,
at your option, any later version of Perl 5 you may have available.


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