aboutsummaryrefslogtreecommitdiff
path: root/interpreter
diff options
context:
space:
mode:
Diffstat (limited to 'interpreter')
-rw-r--r--interpreter/Elymas.pm3
-rw-r--r--interpreter/ElymasAsm.pm41
-rw-r--r--interpreter/ElymasGlobal.pm71
-rw-r--r--interpreter/ElymasSys.pm2
-rw-r--r--interpreter/Makefile8
5 files changed, 100 insertions, 25 deletions
diff --git a/interpreter/Elymas.pm b/interpreter/Elymas.pm
index 6bfe4cf..0749443 100644
--- a/interpreter/Elymas.pm
+++ b/interpreter/Elymas.pm
@@ -52,7 +52,7 @@ sub arrayAccess {
my $i = pop @$data or die "Stack underflow";
die "array index must be int" unless $i->[1] eq 'int';
- push @$data, $array->[0]->[$i->[0]];
+ push @$data, $array->[0]->[$i->[0] % @{$array->[0]}];
}
sub interpretCode {
@@ -109,6 +109,7 @@ sub typeEqual {
if($a->[0] eq 'range') {
return $a->[1] == $b->[1] && $a->[2] == $b->[2];
} elsif($a->[0] eq 'array' or $a->[0] eq 'func') {
+ return 0 if(not defined $a->[2] or not defined $b->[2]);
return 0 if(@{$a->[2]} != @{$b->[2]});
return 0 if(@{$a->[3]} != @{$b->[3]});
diff --git a/interpreter/ElymasAsm.pm b/interpreter/ElymasAsm.pm
index 63b7803..2bf2295 100644
--- a/interpreter/ElymasAsm.pm
+++ b/interpreter/ElymasAsm.pm
@@ -6,25 +6,40 @@ use warnings;
use Elymas;
use ACME::Bare::Metal;
+sub constructBlock {
+ my ($block, $size) = @_;
+
+ my $scope; $scope = \{
+ 'base' => [$block, 'int', 'passive'],
+ 'size' => [$size, 'int', 'passive'],
+ 'free' => [sub {
+ my ($data) = @_;
+
+ ACME::Bare::Metal::deallocate($$scope->{'base'}->[0], $$scope->{'size'}->[0]);
+ }, ['func', 'sys .asm .free'], 'active'],
+ };
+
+ return $$scope;
+}
+
our $asm = {
'alloc' => [sub {
- my ($data) = @_;
+ my ($data) = @_;
- my $size = popInt($data);
- my $block = ACME::Bare::Metal::allocate($size);
+ my $size = popInt($data);
+ my $block = ACME::Bare::Metal::allocate($size);
- my $scope; $scope = \{
- 'base' => [$block, 'int', 'passive'],
- 'size' => [$size, 'int', 'passive'],
- 'free' => [sub {
- my ($data) = @_;
+ push @$data, [enstruct(constructBlock($block, $size))];
+ }, ['func', 'sys .asm .alloc'], 'active'],
+ 'allocAt' => [sub {
+ my ($data) = @_;
- ACME::Bare::Metal::deallocate($$scope->{'base'}->[0], $$scope->{'size'}->[0]);
- }, ['func', 'sys .asm .free'], 'active'],
- };
+ my $addr = popInt($data);
+ my $size = popInt($data);
+ my $block = ACME::Bare::Metal::allocateAt($size, $addr);
- push @$data, [enstruct($$scope)];
- }, ['func', 'sys .asm .alloc'], 'active'],
+ push @$data, [enstruct(constructBlock($block, $size))];
+ }, ['func', 'sys .asm .alloc'], 'active'],
'poke' => [sub {
my ($data, $scope) = @_;
diff --git a/interpreter/ElymasGlobal.pm b/interpreter/ElymasGlobal.pm
index 1a72a0e..66fedf1 100644
--- a/interpreter/ElymasGlobal.pm
+++ b/interpreter/ElymasGlobal.pm
@@ -66,6 +66,34 @@ our $global = {
}, ['func', Dumper(\@code)]];
}
}, ['func', '}'], 'quote'],
+ "}'" => [sub {
+ my ($data, $scope) = @_;
+
+ --$quoted;
+
+ my @code;
+ while(1) {
+ my $t = pop @$data or die "Stack underflow";
+ last if($t->[1] eq 'tok' and $t->[0] eq '{');
+
+ unshift @code, $t;
+ };
+
+ if($quoted) {
+ push @$data, [sub {
+ my ($data, $scope) = @_;
+ push @$data, [sub {
+ my ($data) = @_;
+ interpretCode(\@code, $data, $scope);
+ }, ['func', Dumper(\@code)]];
+ }, ['func', 'func-quoted'], \@code];
+ } else {
+ push @$data, [sub {
+ my ($data) = @_;
+ interpretCode(\@code, $data, $scope);
+ }, ['func', Dumper(\@code)]];
+ }
+ }, ['func', '}'], 'quote'],
'quoted' => [sub {
my ($data, $scope) = @_;
push @$data, [$quoted? 1: 0, 'int'];
@@ -142,6 +170,8 @@ our $global = {
# TODO permitted for now
} elsif(ref($type) eq 'ARRAY' and $type->[0] eq 'array') {
# TODO permitted for now
+ } elsif(ref($type) eq 'ARRAY' and $type->[0] eq 'struct') {
+ # TODO permitted for now
} else {
die "mismatched types in array: " . Dumper($type) unless typeEqual($type, $t->[1]);
}
@@ -175,7 +205,7 @@ our $global = {
$member = $member->[0];
die "not a struct during member dereference in $struct" unless $struct->[1]->[0] eq 'struct';
- die "requested member $member is not in fact existent in " . Dumper($struct, $member) unless exists $struct->[1]->[1]->{$member};
+ die Dumper($struct, $member) . "Cannot resolve requested member $member" unless exists $struct->[1]->[1]->{$member};
push @$data, $struct->[0]->{$member};
execute($data, $scope) if($data->[-1]->[2] eq 'active');
@@ -187,7 +217,7 @@ our $global = {
my $struct = pop @$data;
die "not a struct during member dereference in $struct" unless $struct->[1]->[0] eq 'struct';
- die "requested member $member is not in fact existent in " . Dumper($struct, $member) unless exists $struct->[1]->[1]->{$member};
+ die Dumper($struct, $member) . "Cannot resolve requested member $member" unless exists $struct->[1]->[1]->{$member};
push @$data, $struct->[0]->{$member};
}, ['func', '.|'], 'active'],
@@ -362,6 +392,27 @@ our $global = {
my $d = pop @$data or die "Stack underflow";
die Dumper($d); # , $scope);
}, ['func', 'die'], 'active'],
+ 'keys' => [sub {
+ my ($data, $scope) = @_;
+
+ my $s = pop @$data or die "Stack underflow";
+
+ if(ref($s->[1]) eq 'ARRAY' and $s->[1]->[0] eq 'struct') {
+ my @keys = keys %{$s->[1]->[1]};
+
+ push @$data, [[map { [$_, 'string'] } @keys], ['array', '[]', [['range', 0, $#keys]], ['string']]];
+ } else {
+ die "keys not supported on this value: " . Dumper($s);
+ }
+ }, ['func', 'keys'], 'active'],
+ 'strToUTF8Bytes' => [sub {
+ my ($data, $scope) = @_;
+
+ my $str = popString($data);
+
+ my @res = map { [ord, 'int'] } split //, $str;
+ push @$data, [\@res, ['array', 'from strToUTF8Bytes', [['range', 0, $#res]], ['int']]];
+ }, ['func', 'strToUTF8Bytes'], 'active'],
# stuff from J
'sig' => [sub {
@@ -474,7 +525,7 @@ our $global = {
push @$data, $a->[0]->{'dom'};
execute($data, $scope) if($data->[-1]->[2] eq 'active');
} else {
- die "dom not supportde on this value: " . Dumper($a);
+ die "dom not supported on this value: " . Dumper($a);
}
}, ['func', 'dom'], 'active'],
'exe' => [sub {
@@ -535,12 +586,12 @@ installGlobal2IntFunction('xor', sub { return ($_[0] xor $_[1])? 1: 0 });
installGlobal2IntFunction('nxor', sub { return (not ($_[0] xor $_[1]))? 1: 0 });
installGlobal2IntFunction('nor', sub { return (not ($_[0] or $_[1]))? 1: 0 });
-installGlobal2IntFunction('band', sub { return $_[0] & $_[1] });
-installGlobal2IntFunction('bnand', sub { return ~($_[0] & $_[1]) });
-installGlobal2IntFunction('bor', sub { return $_[0] | $_[1] });
-installGlobal2IntFunction('bxor', sub { return $_[0] ^ $_[1] });
-installGlobal2IntFunction('bnxor', sub { return ~($_[0] ^ $_[1]) });
-installGlobal2IntFunction('bnor', sub { return ~($_[0] | $_[1]) });
+installGlobal2IntFunction('band', sub { return (0 + $_[0]) & (0 + $_[1]) });
+installGlobal2IntFunction('bnand', sub { return ~((0 + $_[0]) & (0 + $_[1])) });
+installGlobal2IntFunction('bor', sub { return (0 + $_[0]) | (0 + $_[1]) });
+installGlobal2IntFunction('bxor', sub { return (0 + $_[0]) ^ (0 + $_[1]) });
+installGlobal2IntFunction('bnxor', sub { return ~((0 + $_[0]) ^ (0 + $_[1])) });
+installGlobal2IntFunction('bnor', sub { return ~((0 + $_[0]) | (0 + $_[1])) });
installGlobal2IntFunction('eq', sub { return ($_[0] == $_[1])? 1: 0 });
installGlobal2IntFunction('neq', sub { return ($_[0] != $_[1])? 1: 0 });
@@ -553,7 +604,7 @@ installGlobal2IntFunction('gcd', sub { my ($a, $b) = @_; ($a, $b) = ($b, $a % $b
installGlobal1IntFunction('neg', sub { return -$_[0] });
installGlobal1IntFunction('not', sub { return not $_[0] });
-installGlobal1IntFunction('bnot', sub { return ~$_[0] });
+installGlobal1IntFunction('bnot', sub { return ~(0 + $_[0]) });
installGlobal1IntFunction('abs', sub { return abs $_[0] });
# FIXME: this API is ugly
diff --git a/interpreter/ElymasSys.pm b/interpreter/ElymasSys.pm
index d403bd6..2b7132f 100644
--- a/interpreter/ElymasSys.pm
+++ b/interpreter/ElymasSys.pm
@@ -107,7 +107,7 @@ sub createFile {
die "read failed: $!" unless defined $ret;
push @$data, [$buf, 'string'];
- }, ['func', 'sys .file .writestr'], 'active'],
+ }, ['func', 'sys .file .readstr'], 'active'],
'write' => [sub {
my ($data) = @_;
diff --git a/interpreter/Makefile b/interpreter/Makefile
index 278a9b0..d0b43c1 100644
--- a/interpreter/Makefile
+++ b/interpreter/Makefile
@@ -20,3 +20,11 @@ generate-test:
2> "test/$$f.err.correct" | tee "test/$$f.correct"; \
sleep 1; \
done
+
+generate-test-fast:
+ mkdir -p test
+ for f in $$(ls ../examples/working); do \
+ echo $$f; \
+ echo Input | ( cd ../examples/working; ../../interpreter/elymas "$$f"; echo ) \
+ 2> "test/$$f.err.correct" | tee "test/$$f.correct"; \
+ done
generated by cgit v1.2.3 (git 2.25.1) at 2026-01-16 12:29:25 +0000