Add diagrams and pictures

[clump.git] / repl.pl

#!/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('YULE REPL');
	say "YULE REPL\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 '';
}