From 4a9c3fa907cbf1473f82ddeda2186a0fca3959fe Mon Sep 17 00:00:00 2001 From: Marius Gavrilescu Date: Sat, 10 Feb 2018 18:05:45 +0000 Subject: [PATCH] Actually make assembler work --- lib/App/Scheme79asm.pm | 60 +++++++++++++++++++++++++++++++++--------- 1 file changed, 47 insertions(+), 13 deletions(-) diff --git a/lib/App/Scheme79asm.pm b/lib/App/Scheme79asm.pm index ec0ada3..e0bec36 100644 --- a/lib/App/Scheme79asm.pm +++ b/lib/App/Scheme79asm.pm @@ -4,6 +4,7 @@ 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/; @@ -12,33 +13,60 @@ our $VERSION = '0.001'; 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, - FUNCALL => 6, QUOTE => 7, QUOTED => 7, + + MORE => 0, + CAR => 1, + CDR => 2, + CONS => 3, + ATOM => 4, + PROGN => 5, + MAKELIST => 6, + FUNCALL => 7, ); *consp = *Data::SExpression::consp; *scalarp = *Data::SExpression::scalarp; sub process { - my ($self, $sexp) = @_; - die "Toplevel is not a cons: $sexp\n " unless consp($sexp); - my $type = $sexp->car; - my $addr = $sexp->cdr; + 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); - die "Type of toplevel is not atom: $type\n" unless scalarp($type); - $addr = $self->process($addr) if consp($addr); - die "Addr of toplevel is not atom: $addr\n" unless scalarp($addr); + unless (looks_like_number $addr) { # is symbol + unless (exists $self->{symbols}{$addr}) { + $self->{symbols}{$addr} = $self->{nsymbols}; + $self->{nsymbols}++; + } + $addr = $self->{symbols}{$addr} + } - die "Computed addr is not a number: $addr\n" unless looks_like_number $addr; + die 'Computed addr is not a number: ', Dumper($addr), "\n" unless looks_like_number $addr; if (ref $type eq 'Data::SExpression::Symbol') { die "No such type: $type\n" unless exists $TYPES{$type}; @@ -50,14 +78,17 @@ sub process { 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; - $self->{freeptr}++; - $self->{memory}[$self->{freeptr}] = $result; - $self->{freeptr} + unless ($location) { + $self->{freeptr}++; + $location = $self->{freeptr} + } + $self->{memory}[$location] = $result; + $location } sub parse { my ($self, $string) = @_; - my $ds = Data::SExpression->new({symbol_case => 'up', use_symbol_class => 1, fold_lists => 0}); + my $ds = Data::SExpression->new({symbol_case => 'up', use_symbol_class => 1, fold_lists => 1}); my $sexp; while () { @@ -80,6 +111,9 @@ 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{symbols}{NIL} = 0; + $args{symbols}{T} = 1; + $args{nsymbols} = 2; bless \%args, $class } -- 2.39.2