| 1 | #!/usr/bin/perl |
| 2 | use v5.14; |
| 3 | use warnings; |
| 4 | |
| 5 | use lib '/home/marius/git/app-scheme79asm/lib/'; |
| 6 | use lib '/home/marius/git/data-dump-sexp/lib/'; |
| 7 | use lib 'app-scheme79asm/lib/'; |
| 8 | |
| 9 | use App::Scheme79asm; |
| 10 | use App::Scheme79asm::Compiler; |
| 11 | use Data::Dump::Sexp; |
| 12 | use Device::SerialPort; |
| 13 | use IPC::Open3; |
| 14 | use Term::ReadLine; |
| 15 | |
| 16 | my $addr_mask = ((1 << 13) - 1); |
| 17 | |
| 18 | sub princ; |
| 19 | |
| 20 | sub princ { |
| 21 | my ($compiler, $memref, $index) = @_; |
| 22 | if ($index == 0) { |
| 23 | print 'NIL'; |
| 24 | } elsif ($index == 2) { |
| 25 | print 'T'; |
| 26 | } else { |
| 27 | my $addr = $memref->[$index] & $addr_mask; |
| 28 | my $type = $memref->[$index] >> 13; |
| 29 | |
| 30 | # say "mem[$index] is TYPE: $type, ADDR: $addr"; |
| 31 | |
| 32 | if ($type == 1) { |
| 33 | print $compiler->{symbols}[$addr]; |
| 34 | } elsif ($type == 3) { |
| 35 | print '<CLOSURE>'; |
| 36 | } elsif ($type == 0 && $addr == 0) { |
| 37 | print 'NIL'; |
| 38 | } elsif ($type == 0) { |
| 39 | print '('; |
| 40 | my $cdr = $memref->[$addr]; |
| 41 | my $car = $addr + 1; |
| 42 | while ($car > 1) { |
| 43 | princ $compiler, $memref, $car; |
| 44 | if ($cdr >> 13) { # improper list |
| 45 | print ' . '; |
| 46 | princ $compiler, $memref, $addr; |
| 47 | last |
| 48 | } |
| 49 | $car = $cdr + 1; |
| 50 | $cdr = $memref->[$cdr]; |
| 51 | print ' ' if $car > 1; |
| 52 | } |
| 53 | print ')'; |
| 54 | } else { |
| 55 | print '<TYPE ', $type, '>'; |
| 56 | } |
| 57 | } |
| 58 | } |
| 59 | |
| 60 | my $term; |
| 61 | |
| 62 | if (-t) { |
| 63 | $term = Term::ReadLine->new('YULE REPL'); |
| 64 | say "YULE REPL\n"; |
| 65 | } |
| 66 | |
| 67 | my $port = Device::SerialPort->new($ARGV[0] // '/dev/ttyUSB1') or die "$!"; |
| 68 | #$port->baudrate(19200); |
| 69 | $port->baudrate(4000000); |
| 70 | $port->parity('none'); |
| 71 | $port->databits(8); |
| 72 | $port->stopbits(1); |
| 73 | $port->handshake('none'); |
| 74 | $port->read_const_time(50); |
| 75 | |
| 76 | $port->write_settings or die "$!"; |
| 77 | |
| 78 | while () { |
| 79 | my $sexp; |
| 80 | if (-t) { |
| 81 | $sexp = $term->readline('* '); |
| 82 | } else { |
| 83 | $sexp = <>; |
| 84 | exit unless defined $sexp; |
| 85 | chomp $sexp; |
| 86 | next unless $sexp; |
| 87 | say "* $sexp"; |
| 88 | } |
| 89 | exit unless defined $sexp; |
| 90 | next unless $sexp; |
| 91 | my $compiler = App::Scheme79asm::Compiler->new; |
| 92 | my $compiler_out = $compiler->compile_string($sexp); |
| 93 | |
| 94 | # say 'Compiler says: ', dump_sexp($compiler_out); |
| 95 | |
| 96 | my $asm = App::Scheme79asm->new(addr_bits => 13); |
| 97 | my $asm_output; |
| 98 | open my $asm_fh, '>', \$asm_output; |
| 99 | $asm->process($compiler_out); |
| 100 | $asm->finish; |
| 101 | $asm->print_binary16($asm_fh); |
| 102 | close $asm_fh; |
| 103 | |
| 104 | # say "Writing: ", join ' ', uc join ' ', unpack '(H2)*', $asm_output; |
| 105 | my $bytes_written = $port->write($asm_output); |
| 106 | my $bytes_to_write = length $asm_output; |
| 107 | die "Only wrote $bytes_written instead of $bytes_to_write" unless $bytes_written == $bytes_to_write; |
| 108 | |
| 109 | my ($count_in, $string_in) = $port->read(5000); |
| 110 | my @memory = unpack 'n*', $string_in; |
| 111 | # say 'Received: ', uc join ' ', unpack '(H2)*', $string_in; |
| 112 | unshift @memory, 0, 0, (1<<13), (1<<13); |
| 113 | princ $compiler, \@memory, 6; |
| 114 | say ''; |
| 115 | } |