--- /dev/null
+#!/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 '';
+}