X-Git-Url: http://git.ieval.ro/?a=blobdiff_plain;f=lib%2FApp%2FScheme79asm.pm;h=fb99ee33ef5a51fc4bd05ddbaf25896fdde4a929;hb=1756f22980afffd139ded7742af489196f928c1a;hp=0333b700dd9361da79b962c70a0ca48b073c016c;hpb=744f5c2a92054cb2a39b5766042f6f44373e2401;p=app-scheme79asm.git diff --git a/lib/App/Scheme79asm.pm b/lib/App/Scheme79asm.pm index 0333b70..fb99ee3 100644 --- a/lib/App/Scheme79asm.pm +++ b/lib/App/Scheme79asm.pm @@ -3,6 +3,8 @@ package App::Scheme79asm; use 5.014000; use strict; use warnings; +use re '/s'; +use Carp qw/croak/; use Data::Dumper qw/Dumper/; use Data::SExpression qw/consp scalarp/; @@ -66,8 +68,8 @@ sub process { } $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}); + die "Type too large: $type\n" if $type >= (1 << $self->{type_bits}); + die "Addr too large: $addr\n" if $addr >= (1 << $self->{addr_bits}); my $result = ($type << $self->{addr_bits}) + $addr; unless ($location) { $self->{freeptr}++; @@ -104,7 +106,10 @@ sub new { $args{addr_bits} //= 8; $args{freeptr} //= 6; $args{memory} //= [0, 0, (1<<$args{addr_bits}), (1<<$args{addr_bits}), 0, 0, 0]; - $args{comment} = ['(cdr part of NIL)', '(car part of NIL)', '(cdr part of T)', '(car part of T)', '(free storage pointer)', '', '(result of computation)']; + 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 } @@ -115,9 +120,9 @@ sub print_binary16 { die "addr_bits + type_bits >= 16\n"if $self->{addr_bits} + $self->{type_bits} > 16; my $length = @{$self->{memory}}; - print $fh pack('n', $length); + print $fh pack 'n', $length or croak "Failed to print memory size: $!"; for (@{$self->{memory}}) { - print $fh pack('n', $_) + print $fh pack 'n', $_ or croak "Failed to print memory: $!" } } @@ -139,9 +144,9 @@ sub print_verilog { 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"; + my $string = "mem[$index] <= $val;"; + $string .= "$spaces // $comment" if defined $comment; + say $fh $string or croak "Failed to print verilog: $!"; } } @@ -185,7 +190,7 @@ 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). +reference). The value must be a number. C<(tag list)>, where C is of one of these three types, represents a tagged pointer. In this case, C is (recursively) @@ -268,7 +273,7 @@ are the possible keys: A word is made of a type and an address, with the type occupying the most significant C (default 3) bits, and the address occupying the least significant C (default 8) bits. -Therefore the word size is C (default 13). +Therefore the word size is C (default 11). =item freeptr @@ -284,7 +289,11 @@ C. =item comment The initial comments for memory entries. C<< $comment->[$i] >> is the -comment for C<< $memory->[$i] >>. +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