]>
Commit | Line | Data |
---|---|---|
509643aa MG |
1 | #!/usr/bin/perl |
2 | use strict; | |
3 | use warnings; | |
4 | ||
744f5c2a | 5 | use Test::More tests => 17; |
509643aa MG |
6 | BEGIN { use_ok('App::Scheme79asm') }; |
7 | ||
8 | sub run_test { | |
744f5c2a MG |
9 | my ($args, $input, $expected_verilog, $expected_binary16, $name) = @_; |
10 | my ($actual, $fh, $asm); | |
11 | open $fh, '>', \$actual; | |
12 | $asm = App::Scheme79asm->new(%$args); | |
13 | $asm->parse_and_print_binary16($input, $fh); | |
14 | close $fh; | |
15 | $actual = uc join ' ', unpack '(H2)*', $actual; | |
16 | is $actual, $expected_binary16, "print_binary16 $name"; | |
17 | ||
18 | open $fh, '>', \$actual; | |
19 | $asm = App::Scheme79asm->new(%$args); | |
3aa76f51 | 20 | $asm->parse_and_print_verilog($input, $fh); |
509643aa | 21 | close $fh; |
744f5c2a | 22 | is $actual, $expected_verilog, "print_verilog $name"; |
509643aa MG |
23 | } |
24 | ||
744f5c2a MG |
25 | my $expbin; |
26 | ||
27 | $expbin = '00 07 00 00 00 00 01 00 01 00 00 07 01 03 00 00'; | |
28 | ||
29 | run_test {}, '(number 3)', <<'EOF', $expbin, '3'; | |
30 | mem[0] <= 0; // (cdr part of NIL) | |
31 | mem[1] <= 0; // (car part of NIL) | |
32 | mem[2] <= 11'b00100000000; // (cdr part of T) | |
33 | mem[3] <= 11'b00100000000; // (car part of T) | |
34 | mem[4] <= 11'd7; // (free storage pointer) | |
35 | mem[5] <= 11'b00100000011; // NUMBER 3 | |
36 | mem[6] <= 0; // (result of computation) | |
37 | EOF | |
38 | ||
39 | $expbin = '00 08 00 00 00 00 00 20 00 20 00 08 00 E7 00 00 00 25'; | |
40 | ||
41 | run_test {addr_bits => 5}, '(quoted (symbol 5))', <<'EOF', $expbin, '(QUOTE 5)'; | |
f71b3492 MG |
42 | mem[0] <= 0; // (cdr part of NIL) |
43 | mem[1] <= 0; // (car part of NIL) | |
44 | mem[2] <= 8'b00100000; // (cdr part of T) | |
45 | mem[3] <= 8'b00100000; // (car part of T) | |
46 | mem[4] <= 8'd8; // (free storage pointer) | |
47 | mem[5] <= 8'b11100111; // QUOTED 7 | |
48 | mem[6] <= 0; // (result of computation) | |
49 | mem[7] <= 8'b00100101; // SYMBOL 5 | |
4e527493 | 50 | EOF |
f71b3492 | 51 | |
744f5c2a MG |
52 | $expbin = '00 0C 00 00 00 00 20 00 20 00 00 0C C0 07 00 00 00 09 20 05 E0 00 80 0B 5F FE'; |
53 | run_test {addr_bits => 13}, '(call (more (funcall 0) (proc (var -2))) (number 5))', <<'EOF', $expbin, '((LAMBDA ID (X) X) 5)'; | |
f71b3492 MG |
54 | mem[ 0] <= 0; // (cdr part of NIL) |
55 | mem[ 1] <= 0; // (car part of NIL) | |
56 | mem[ 2] <= 16'b0010000000000000; // (cdr part of T) | |
57 | mem[ 3] <= 16'b0010000000000000; // (car part of T) | |
58 | mem[ 4] <= 16'd12; // (free storage pointer) | |
59 | mem[ 5] <= 16'b1100000000000111; // CALL 7 | |
60 | mem[ 6] <= 0; // (result of computation) | |
61 | mem[ 7] <= 16'b0000000000001001; // MORE 9 | |
62 | mem[ 8] <= 16'b0010000000000101; // NUMBER 5 | |
3aa76f51 | 63 | mem[ 9] <= 16'b1110000000000000; // FUNCALL 0 |
f71b3492 | 64 | mem[10] <= 16'b1000000000001011; // PROC 11 |
3aa76f51 | 65 | mem[11] <= 16'b0101111111111110; // VAR -2 |
4e527493 | 66 | EOF |
744f5c2a MG |
67 | |
68 | my %test = ( | |
69 | addr_bits => 13, | |
70 | type_bits => 3, | |
71 | memory => [0, 1, 2, 3, 4, 5, 6, 7, 8, 9], | |
72 | freeptr => 9 | |
73 | ); | |
74 | ||
75 | $expbin = '00 0E 00 00 00 01 00 02 00 03 00 0E C0 0A 00 06 00 07 00 08 00 09 00 0C 20 0A 60 00 20 0B'; | |
76 | ||
77 | run_test \%test, '(call (more (cons 0) (number 11)) (number 10))', <<'EOF', $expbin, '(CONS 10 11)'; | |
78 | mem[ 0] <= 0; // (cdr part of NIL) | |
79 | mem[ 1] <= 16'b0000000000000001; // (car part of NIL) | |
80 | mem[ 2] <= 16'b0000000000000010; // (cdr part of T) | |
81 | mem[ 3] <= 16'b0000000000000011; // (car part of T) | |
82 | mem[ 4] <= 16'd14; // (free storage pointer) | |
83 | mem[ 5] <= 16'b1100000000001010; // CALL 10 | |
84 | mem[ 6] <= 16'b0000000000000110; // (result of computation) | |
85 | mem[ 7] <= 16'b0000000000000111; | |
86 | mem[ 8] <= 16'b0000000000001000; | |
87 | mem[ 9] <= 16'b0000000000001001; | |
88 | mem[10] <= 16'b0000000000001100; // MORE 12 | |
89 | mem[11] <= 16'b0010000000001010; // NUMBER 10 | |
90 | mem[12] <= 16'b0110000000000000; // CONS 0 | |
91 | mem[13] <= 16'b0010000000001011; // NUMBER 11 | |
92 | EOF | |
93 | ||
94 | sub expect_error_like (&$) { | |
95 | my ($block, $error_re) = @_; | |
96 | my $name = "test error like /$error_re/"; | |
97 | my $result = eval { $block->(); 1 }; | |
98 | if ($result) { | |
99 | note 'Block did not throw an exception, failing test'; | |
100 | fail $name; | |
101 | } else { | |
102 | like $@, qr/$error_re/, $name; | |
103 | } | |
104 | } | |
105 | ||
106 | expect_error_like { run_test {}, 'symbol' } 'Toplevel is not a list'; | |
107 | expect_error_like { run_test {}, '((type is a list) 5)'} 'Type of toplevel is not atom'; | |
108 | expect_error_like { run_test {}, '(badtype 5)'} 'No such type'; | |
109 | expect_error_like { run_test {}, '(number)'} 'Computed addr is not a number'; | |
110 | expect_error_like { run_test {}, '(70000 5)'} 'Type too large'; | |
111 | expect_error_like { run_test {}, '(5 700000)'} 'Addr too large'; | |
112 | expect_error_like { run_test {addr_bits => 20}, '(list 0)' } 'addr_bits '; | |
113 | expect_error_like { App::Scheme79asm->new->process([5, {}]) } 'Addr of toplevel is not atom'; |