lib/App/Scheme79asm.pm

   1 package App::Scheme79asm;
   2
   3 use 5.014000;
   4 use strict;
   5 use warnings;
   6
   7 use Data::SExpression qw/consp scalarp/;
   8 use Scalar::Util qw/looks_like_number/;
   9
  10 our $VERSION = '0.001';
  11
  12 our %TYPES = (
  13         LIST => 0,
  14         SYMBOL => 1,
  15         VAR => 2,
  16         VARIABLE => 2,
  17         CLOSURE => 3,
  18         PROC => 4,
  19         PROCEDURE => 4,
  20         COND => 5,
  21         CONDITIONAL => 5,
  22         CALL => 6,
  23         FUNCALL => 6,
  24         QUOTE => 7,
  25         QUOTED => 7,
  26 );
  27
  28 *consp = *Data::SExpression::consp;
  29 *scalarp = *Data::SExpression::scalarp;
  30
  31 sub process {
  32         my ($self, $sexp) = @_;
  33         die "Toplevel is not a cons: $sexp\n " unless consp($sexp);
  34         my $type = $sexp->car;
  35         my $addr = $sexp->cdr;
  36
  37         die "Type of toplevel is not atom: $type\n" unless scalarp($type);
  38         $addr = $self->process($addr) if consp($addr);
  39         die "Addr of toplevel is not atom: $addr\n" unless scalarp($addr);
  40
  41         die "Computed addr is not a number: $addr\n" unless looks_like_number $addr;
  42
  43         if (ref $type eq 'Data::SExpression::Symbol') {
  44                 die "No such type: $type\n" unless exists $TYPES{$type};
  45                 $type = $TYPES{$type};
  46         } elsif (!looks_like_number $type) {
  47                 die "Type is not a number or symbol: $type\n"
  48         }
  49
  50         die "Type too large: $type\n" unless $type < (1 << $self->{type_bits});
  51         die "Addr too large: $addr\n" unless $addr < (1 << $self->{addr_bits});
  52         my $result = ($type << $self->{addr_bits}) + $addr;
  53         $self->{freeptr}++;
  54         $self->{memory}[$self->{freeptr}] = $result;
  55         $self->{freeptr}
  56 }
  57
  58 sub parse {
  59         my ($self, $string) = @_;
  60         my $ds = Data::SExpression->new({symbol_case => 'up', use_symbol_class => 1, fold_lists => 0});
  61
  62         my $sexp;
  63         while () {
  64                 last if $string =~ /^\s*$/;
  65                 ($sexp, $string) = $ds->read($string);
  66                 $self->process($sexp)
  67         }
  68 }
  69
  70 sub finish {
  71         my ($self) = @_;
  72         $self->{memory}[5] = $self->{memory}[$self->{freeptr}];
  73         $self->{memory}[4] = $self->{freeptr};
  74         delete $self->{memory}[$self->{freeptr}]
  75 }
  76
  77 sub new {
  78         my ($class, %args) = @_;
  79         $args{type_bits} //= 3;
  80         $args{addr_bits} //= 8;
  81         $args{freeptr} //= 6;
  82         $args{memory} //= [0, 0, (1<<$args{addr_bits}), (1<<$args{addr_bits}), 0, 0, 0];
  83         bless \%args, $class
  84 }
  85
  86 sub print {
  87         my ($self, $fh) = @_;
  88         $fh //= \*STDOUT;
  89
  90         my $bits = $self->{type_bits} + $self->{addr_bits};
  91         for my $index (0 .. $#{$self->{memory}}) {
  92                 my $val = $self->{memory}[$index];
  93                 if ($index == 4) {
  94                         $val = "${bits}'d$val"
  95                 } else {
  96                         $val = $val ? sprintf "%d'b%0${bits}b", $bits, $val : '0';
  97                 }
  98                 say $fh "mem[$index] <= $val;"
  99         }
 100 }
 101
 102 sub parse_and_print {
 103         my ($self, $string, $fh) = @_;
 104         $self->parse($string);
 105         $self->finish;
 106         $self->print($fh);
 107 }
 108
 109 1;
 110 __END__
 111
 112 =encoding utf-8
 113
 114 =head1 NAME
 115
 116 App::Scheme79asm - assemble sexp to Verilog ROM for SIMPLE processor
 117
 118 =head1 SYNOPSIS
 119
 120   use App::Scheme79asm;
 121   my $asm = App::Scheme79asm->new(type_bits => 3, addr_bits => 5);
 122   $asm->parse_and_print('(number . 70)');
 123
 124 =head1 DESCRIPTION
 125
 126 B<NOTE:> this module does not do much at the moment.
 127
 128 SIMPLE is a LISP processor defined in the 1979
 129 B<Design of LISP-Based Processors> paper by Steele and Sussman.
 130
 131 The SIMPLE processor expects input in a particular tagged-pointer
 132 format. This module takes a string containing a sequence of
 133 S-expressions of the form C<(tag . value)> representing a tagged
 134 pointer. Here the tag is either a number or one of several predefined
 135 values (see the source for a full list), and the value is either a
 136 number or another tagged pointer. These values are laid out in memory
 137 and a block of verilog code assigning the memory contents to an array
 138 named C<mem> is printed.
 139
 140 More documentation and features to follow.
 141
 142 =head1 SEE ALSO
 143
 144 L<http://repository.readscheme.org/ftp/papers/ai-lab-pubs/AIM-514.pdf>
 145
 146 =head1 AUTHOR
 147
 148 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
 149
 150 =head1 COPYRIGHT AND LICENSE
 151
 152 Copyright (C) 2018 by Marius Gavrilescu
 153
 154 This library is free software; you can redistribute it and/or modify
 155 it under the same terms as Perl itself, either Perl version 5.24.3 or,
 156 at your option, any later version of Perl 5 you may have available.
 157
 158
 159 =cut