From: Marius Gavrilescu <marius@ieval.ro>
Date: Sat, 10 Feb 2018 18:05:45 +0000 (+0000)
Subject: Actually make assembler work
X-Git-Tag: 0.001001~5
X-Git-Url: http://git.ieval.ro/?a=commitdiff_plain;h=4a9c3fa907cbf1473f82ddeda2186a0fca3959fe;p=app-scheme79asm.git

Actually make assembler work
---

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
 }