]>
Commit | Line | Data |
---|---|---|
61a16fa6 MG |
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) { | |
67d929ce MG |
63 | $term = Term::ReadLine->new('YULE REPL'); |
64 | say "YULE REPL\n"; | |
61a16fa6 MG |
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 | ||
67d929ce | 94 | # say 'Compiler says: ', dump_sexp($compiler_out); |
61a16fa6 MG |
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 | ||
67d929ce | 104 | # say "Writing: ", join ' ', uc join ' ', unpack '(H2)*', $asm_output; |
61a16fa6 MG |
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; | |
67d929ce | 111 | # say 'Received: ', uc join ' ', unpack '(H2)*', $string_in; |
61a16fa6 MG |
112 | unshift @memory, 0, 0, (1<<13), (1<<13); |
113 | princ $compiler, \@memory, 6; | |
114 | say ''; | |
115 | } |