view release on metacpan or  search on metacpan

lib/App/Scheme79asm.pm  view on Meta::CPAN

		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 or croak "Failed to print memory size: $!"; # uncoverable branch true
	for (@{$self->{memory}}) {
		print $fh pack 'n', $_ or croak "Failed to print memory: $!" # uncoverable branch true
	}
}

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;

		my $string = "mem[$index] <= $val;";
		$string .= "$spaces // $comment" if defined $comment;
		say $fh $string or croak "Failed to print verilog: $!"; # uncoverable branch true
	}

}
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).