From 61a16fa6d7988ba5ae3c570dbd27d6bf32342a1a Mon Sep 17 00:00:00 2001 From: Marius Gavrilescu 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 ''; + } 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 ''; + } + } +} + +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