From 61a16fa6d7988ba5ae3c570dbd27d6bf32342a1a Mon Sep 17 00:00:00 2001
From: Marius Gavrilescu <marius@ieval.ro>
Date: Thu, 17 May 2018 14:11:04 +0300
Subject: [PATCH] Add REPL and expressions.t

---
 expressions.t |  27 ++++++++++++
 repl.pl       | 115 ++++++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 142 insertions(+)
 create mode 100644 expressions.t
 create mode 100644 repl.pl

diff --git a/expressions.t b/expressions.t
new file mode 100644
index 0000000..dc2cabd
--- /dev/null
+++ b/expressions.t
@@ -0,0 +1,27 @@
+'(1 2 3)
+5
+((lambda id (x) x) 5)
+((lambda id (x) x) '(1 2 3))
+(car '(2 3))
+(car (cdr '(4 5 6)))
+((lambda snd (x y) y) 'first 'second)
+
+(cons '(1 2) '(7))
+(car (cons '(1 2) '(7)))
+(cdr (cons '(1 2) '(7)))
+
+((lambda rev (xs) ((lambda reverse-acc (xs acc) (if xs (reverse-acc (cdr xs) (cons (car xs) acc)) acc)) xs '())) '(4 5 6 7))
+
+(atom nil)
+(atom t)
+(atom 'symbol)
+(atom 5)
+
+(reverse-list 9 8 7 6 5 4)
+
+(atom '())
+(atom '(1 2 3))
+(atom '((1 2) (3 4)))
+(atom (cons 1 '(2)))
+
+(progn 4 5 6 7 8)
diff --git a/repl.pl b/repl.pl
new file mode 100644
index 0000000..83b1704
--- /dev/null
+++ b/repl.pl
@@ -0,0 +1,115 @@
+#!/usr/bin/perl
+use v5.14;
+use warnings;
+
+use lib '/home/marius/git/app-scheme79asm/lib/';
+use lib '/home/marius/git/data-dump-sexp/lib/';
+use lib 'app-scheme79asm/lib/';
+
+use App::Scheme79asm;
+use App::Scheme79asm::Compiler;
+use Data::Dump::Sexp;
+use Device::SerialPort;
+use IPC::Open3;
+use Term::ReadLine;
+
+my $addr_mask = ((1 << 13) - 1);
+
+sub princ;
+
+sub princ {
+	my ($compiler, $memref, $index) = @_;
+	if ($index == 0) {
+		print 'NIL';
+	} elsif ($index == 2) {
+		print 'T';
+	} else {
+		my $addr = $memref->[$index] & $addr_mask;
+		my $type = $memref->[$index] >> 13;
+
+#		say "mem[$index] is TYPE: $type, ADDR: $addr";
+
+		if ($type == 1) {
+			print $compiler->{symbols}[$addr];
+		} elsif ($type == 3) {
+			print '<CLOSURE>';
+		} elsif ($type == 0 && $addr == 0) {
+			print 'NIL';
+		} elsif ($type == 0) {
+			print '(';
+			my $cdr = $memref->[$addr];
+			my $car = $addr + 1;
+			while ($car > 1) {
+				princ $compiler, $memref, $car;
+				if ($cdr >> 13) { # improper list
+					print ' . ';
+					princ $compiler, $memref, $addr;
+					last
+				}
+				$car = $cdr + 1;
+				$cdr = $memref->[$cdr];
+				print ' ' if $car > 1;
+			}
+			print ')';
+		} else {
+			print '<TYPE ', $type, '>';
+		}
+	}
+}
+
+my $term;
+
+if (-t) {
+	$term = Term::ReadLine->new('DECEL REPL');
+	say "DECEL PRE-RELEASE\n";
+}
+
+my $port = Device::SerialPort->new($ARGV[0] // '/dev/ttyUSB1') or die "$!";
+#$port->baudrate(19200);
+$port->baudrate(4000000);
+$port->parity('none');
+$port->databits(8);
+$port->stopbits(1);
+$port->handshake('none');
+$port->read_const_time(50);
+
+$port->write_settings or die "$!";
+
+while () {
+	my $sexp;
+	if (-t) {
+		$sexp = $term->readline('* ');
+	} else {
+		$sexp = <>;
+		exit unless defined $sexp;
+		chomp $sexp;
+		next unless $sexp;
+		say "* $sexp";
+	}
+	exit unless defined $sexp;
+	next unless $sexp;
+	my $compiler = App::Scheme79asm::Compiler->new;
+	my $compiler_out = $compiler->compile_string($sexp);
+
+	say 'Compiler says: ', dump_sexp($compiler_out);
+
+	my $asm = App::Scheme79asm->new(addr_bits => 13);
+	my $asm_output;
+	open my $asm_fh, '>', \$asm_output;
+	$asm->process($compiler_out);
+	$asm->finish;
+	$asm->print_binary16($asm_fh);
+	close $asm_fh;
+
+	say "Writing: ", join ' ', uc join ' ', unpack '(H2)*', $asm_output;
+	my $bytes_written = $port->write($asm_output);
+	my $bytes_to_write = length $asm_output;
+	die "Only wrote $bytes_written instead of $bytes_to_write" unless $bytes_written == $bytes_to_write;
+
+	my ($count_in, $string_in) = $port->read(5000);
+	my @memory = unpack 'n*', $string_in;
+	say 'Received: ', uc join ' ', unpack '(H2)*', $string_in;
+	unshift @memory, 0, 0, (1<<13), (1<<13);
+	princ $compiler, \@memory, 6;
+	say '';
+}
-- 
2.39.2