[stupid-crypto] 24 new revisions pushed by ben@links.org on 2010-05-29 20:01 GMT

2 views

Skip to first unread message

stupid...@googlecode.com

unread,

May 29, 2010, 4:02:28 PM5/29/10

to stupi...@googlegroups.com

24 new revisions:

Revision: 040c71a0ed
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 08:41:06 2010
Log: First experiment with bitwidth stuff.
http://code.google.com/p/stupid-crypto/source/detail?r=040c71a0ed

Revision: 6df0e5ff4b
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 08:43:03 2010
Log: Ready for next test.
http://code.google.com/p/stupid-crypto/source/detail?r=6df0e5ff4b

Revision: 3807c5a504
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 08:44:59 2010
Log: Test passes.
http://code.google.com/p/stupid-crypto/source/detail?r=3807c5a504

Revision: 2b58540a36
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 08:45:59 2010
Log: Next test.
http://code.google.com/p/stupid-crypto/source/detail?r=2b58540a36

Revision: 8249a25ff7
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 08:48:45 2010
Log: Test passes.
http://code.google.com/p/stupid-crypto/source/detail?r=8249a25ff7

Revision: 992173f9a2
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 08:49:47 2010
Log: Next test.
http://code.google.com/p/stupid-crypto/source/detail?r=992173f9a2

Revision: e2b58a49b6
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 08:54:14 2010
Log: Test passed.
http://code.google.com/p/stupid-crypto/source/detail?r=e2b58a49b6

Revision: 3cc7053200
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 08:55:06 2010
Log: Add next test.
http://code.google.com/p/stupid-crypto/source/detail?r=3cc7053200

Revision: ac97fa9a70
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 09:04:46 2010
Log: Test passed.
http://code.google.com/p/stupid-crypto/source/detail?r=ac97fa9a70

Revision: 920fcd4c9f
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 09:05:54 2010
Log: Next test.
http://code.google.com/p/stupid-crypto/source/detail?r=920fcd4c9f

Revision: e3886667e0
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 09:08:19 2010
Log: Test passed.
http://code.google.com/p/stupid-crypto/source/detail?r=e3886667e0

Revision: f8f50aed80
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 09:09:42 2010
Log: Next test.
http://code.google.com/p/stupid-crypto/source/detail?r=f8f50aed80

Revision: 97d9f59284
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 09:13:21 2010
Log: Add ability to run a single test.
http://code.google.com/p/stupid-crypto/source/detail?r=97d9f59284

Revision: 18c0147282
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 09:18:40 2010
Log: Test passes.
http://code.google.com/p/stupid-crypto/source/detail?r=18c0147282

Revision: 381ede171b
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 09:20:01 2010
Log: Next test.
http://code.google.com/p/stupid-crypto/source/detail?r=381ede171b

Revision: a586c777dd
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 09:23:47 2010
Log: Test passes.
http://code.google.com/p/stupid-crypto/source/detail?r=a586c777dd

Revision: 254bb56d7e
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 09:25:08 2010
Log: Next test.
http://code.google.com/p/stupid-crypto/source/detail?r=254bb56d7e

Revision: ed7d943626
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 09:26:01 2010
Log: Test passed.
http://code.google.com/p/stupid-crypto/source/detail?r=ed7d943626

Revision: 20d653fa6e
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 09:26:46 2010
Log: Next test.
http://code.google.com/p/stupid-crypto/source/detail?r=20d653fa6e

Revision: 68dd266a8a
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 09:28:22 2010
Log: Next test.
http://code.google.com/p/stupid-crypto/source/detail?r=68dd266a8a

Revision: c67ff27a35
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 09:29:21 2010
Log: Test passed.
http://code.google.com/p/stupid-crypto/source/detail?r=c67ff27a35

Revision: 1b73385136
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 09:30:02 2010
Log: Next test.
http://code.google.com/p/stupid-crypto/source/detail?r=1b73385136

Revision: 5ed15ac814
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 12:46:57 2010
Log: Test passes.
http://code.google.com/p/stupid-crypto/source/detail?r=5ed15ac814

Revision: 71f7862274
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 12:59:33 2010
Log: Another test passes.
http://code.google.com/p/stupid-crypto/source/detail?r=71f7862274

==============================================================================
Revision: 040c71a0ed
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 08:41:06 2010
Log: First experiment with bitwidth stuff.
http://code.google.com/p/stupid-crypto/source/detail?r=040c71a0ed

Added:
/src/Stupid2/C.pm
/src/grammar2.y
/src/stupid2.pl
/test2/Makefile
/test2/array-small.stupid
/test2/build-C.sh
/test2/test-wrapper.c
/test2/test.pl
Modified:
/.hgignore
/src/Makefile

=======================================
--- /dev/null
+++ /src/Stupid2/C.pm Sat May 29 08:41:06 2010
@@ -0,0 +1,14 @@
+package Stupid2::C;
+
+use strict;
+use warnings;
+
+sub Stupid2::Type::Int::typeName {
+ my $self = shift;
+
+ my $base = 'uint';
+ $base = 'int' if $self->{width}->isSigned();
+ return $base . $self->{width}->bits();
+}
+
+1;
=======================================
--- /dev/null
+++ /src/grammar2.y Sat May 29 08:41:06 2010
@@ -0,0 +1,209 @@
+%right '='
+
+%%
+
+prog : toplevel_list
+ { $_[1]; }
+ ;
+
+toplevel_list : toplevel_list toplevel
+ { $_[1]->appendTopLevel($_[2]); $_[1]; }
+ | toplevel
+ { my $t = new Stupid::TopLevelList();
+ $t->appendTopLevel($_[1]);
+ $t; }
+ ;
+
+toplevel : comment ';'
+ | function
+ | struct_decl
+ ;
+
+struct_decl : 'struct' WORD '(' abstract_decl_list ')' ';'
+ { new Stupid::Type::Struct($::Context, $_[2], $_[4]); }
+ ;
+
+abstract_decl_list : abstract_decl_list ',' abstract_decl
+ { $_[1]->appendAbstractDecl($_[3]); $_[1]; }
+ | abstract_decl
+ { my $t = new Stupid::AbstractDeclList();
+ $t->appendAbstractDecl($_[1]);
+ $t; }
+ ;
+
+abstract_decl : type vardecl
+ { new Stupid::AbstractDeclare($_[1], $_[2]); }
+ ;
+
+function : 'function' '(' arglist ')' WORD '(' arglist ')'
+ '{' statements '}'
+ { $_[3]->markAsReturn();
+ $_[7]->markAsArgument();
+ new Stupid::Function($::Context, $_[5], $_[3], $_[7], $_[10]); }
+ ;
+
+arglist : arglist ',' arg
+ { $_[1]->appendArg($_[3]); $_[1]; }
+ | arg
+ { my $t1 = new Stupid::ArgList();
+ $t1->appendArg($_[1]);
+ $t1; }
+ |
+ { new Stupid::ArgList(); }
+ ;
+
+arg : type vardecl
+ { new Stupid::Declare($::Context, new Stupid::Variable($_[1],
+ $_[2])); }
+ ;
+
+statements : statements statement
+ { $_[1]->appendStatement($_[2]); $_[1]; }
+ | statement
+ { my $t1 = new Stupid::StatementList();
+ $t1->appendStatement($_[1]);
+ $t1; }
+ |
+ { new Stupid::StatementList(); }
+ ;
+
+statement : decl ';'
+ { $_[1]; }
+ | comment ';'
+ { $_[1]; }
+ | var '=' expr ';'
+ { new Stupid::Statement(new Stupid::Set($_[1], $_[3])); }
+ | 'if' '(' expr ')' '{' statements '}' 'else' '{' statements '}'
+ { new Stupid::If($_[3], $_[6], $_[10]); }
+ | 'while' '(' expr ')' '{' statements '}'
+ { new Stupid::While($_[3], $_[6]); }
+ | call ';'
+ { $_[1]; }
+ ;
+
+expr : expr 'and32' expr
+ { new Stupid::And32($_[1], $_[3]); }
+ | expr 'and8' expr
+ { new Stupid::And8($_[1], $_[3]); }
+ | expr 'band' expr
+ { new Stupid::BAnd($_[1], $_[3]); }
+ | expr 'bor' expr
+ { new Stupid::BOr($_[1], $_[3]); }
+ | expr 'eq32' expr
+ { new Stupid::Eq32($_[1], $_[3]); }
+ | expr 'ge8' expr
+ { new Stupid::Ge8($_[1], $_[3]); }
+ | expr 'le8' expr
+ { new Stupid::Le8($_[1], $_[3]); }
+ | expr 'lshift32' expr
+ { new Stupid::LShift32($_[1], $_[3]); }
+ | expr 'lshift8' expr
+ { new Stupid::LShift8($_[1], $_[3]); }
+ | expr 'minus8' expr
+ { new Stupid::Minus8($_[1], $_[3]); }
+ | expr 'minus32' expr
+ { new Stupid::Minus32($_[1], $_[3]); }
+ | expr 'mod8' expr
+ { new Stupid::Mod8($_[1], $_[3]); }
+ | expr 'mod32' expr
+ { new Stupid::Mod32($_[1], $_[3]); }
+ | expr 'ne32' expr
+ { new Stupid::Ne32($_[1], $_[3]); }
+ | expr 'ne8' expr
+ { new Stupid::Ne8($_[1], $_[3]); }
+ | expr 'or8' expr
+ { new Stupid::Or8($_[1], $_[3]); }
+ | expr 'plus8' expr
+ { new Stupid::Plus8($_[1], $_[3]); }
+ | expr 'plus32' expr
+ { new Stupid::Plus32($_[1], $_[3]); }
+ | expr 'wrapplus32' expr
+ { new Stupid::WrapPlus32($_[1], $_[3]); }
+ | expr 'rrotate32' expr
+ { new Stupid::RRotate32($_[1], $_[3]); }
+ | expr 'rshift32' expr
+ { new Stupid::RShift32($_[1], $_[3]); }
+ | expr 'xor32' expr
+ { new Stupid::XOr32($_[1], $_[3]); }
+ | 'mask32to8' expr
+ { new Stupid::Mask32To8($_[2]); }
+ | 'not32' expr
+ { new Stupid::Not32($_[2]); }
+ | 'not8' expr
+ { new Stupid::Not8($_[2]); }
+ | 'widen8to32' expr
+ { new Stupid::Widen8To32($_[2]); }
+ | '(' expr ')'
+ { $_[2]; }
+ | var
+ { $_[1]; }
+ | value
+ ;
+
+exprlist: exprlist ',' expr
+ { $_[1]->appendExpr($_[3]); $_[1]; }
+ | expr
+ { my $t = new Stupid::ExprList(); $t->appendExpr($_[1]); $t; }
+ |
+ { new Stupid::ExprList(); }
+ ;
+
+var : WORD
+ { $::Context->findSymbol($_[1]); }
+ | var '[' expr ']'
+ { new Stupid::ArrayRef($_[1], $_[3]); }
+ | expr '.' WORD
+ { new Stupid::MemberRef($_[1], $_[3]); }
+ | call
+ ;
+
+call: | expr '(' exprlist ')'
+ { new Stupid::FunctionCall($_[1], $_[3]); }
+ ;
+
+decl : type vardecl '=' expr
+ { new Stupid::Declare($::Context,
+ new Stupid::Variable($_[1], $_[2]), $_[4]); }
+ ;
+
+type : 'int' '_' bitwidth
+ { new Stupid2::Type::Int($_[3]); }
+ | 'ostream'
+ { new Stupid::Type::OStream(); }
+ | 'array' '(' type ',' VALUE ')'
+ { new Stupid::Type::Array($_[3], $_[5]); }
+ | 'struct' WORD
+ { new Stupid::Type::StructInstance($::Context, $_[2]); }
+ ;
+
+bitwidth : VALUE
+ { new Stupid2::Bitwidth($_[1], 1); }
+ | UVALUE
+ { new Stupid2::Bitwidth($_[1], 0); }
+ ;
+
+arrayval : '[' val_list ']'
+ { $_[2]; }
+ ;
+
+val_list : val_list ',' expr
+ { $_[1]->append($_[3]); $_[1]; }
+ | expr
+ { my $t = new Stupid::ArrayValue(); $t->append($_[1]); $t; }
+ | STRING
+ { Stupid::ArrayFromString($_[1]); }
+ ;
+
+value : arrayval
+ | VALUE
+ | CHAR
+ ;
+
+vardecl : WORD
+ ;
+
+comment : STRING
+ { new Stupid::Comment($_[1]); }
+ ;
+
+%%
=======================================
--- /dev/null
+++ /src/stupid2.pl Sat May 29 08:41:06 2010
@@ -0,0 +1,1627 @@
+#!/bin/sh
+eval 'exec perl -x -w $0 ${1+"$@"}'
+
+#!perl actually starts here.
+
+use strict;
+
+use grammar2;
+use File::Slurp;
+use Carp;
+use Getopt::Long;
+
+$| = 1;
+
+my $language;
+our $debug;
+
+croak if !GetOptions("language=s" => \$language,
+ "debug" => \$debug);
+croak "Must specify an output language" if !$language;
+
+my $sourceFile = shift;
+
+my $code = read_file($sourceFile);
+
+our @keywords;
+initLexer();
+$::Context = new Stupid::Context();
+
+my $parser = new grammar2();
+$parser->YYData->{code} = $code;
+my $ptree = $parser->YYParse(yylex => \&lexer,
+ yyerror => \&yyerror,
+ yydebug => $debug ? 6 : 0);
+
+use Data::Dumper; $Data::Dumper::Indent=1; print STDERR
Data::Dumper->Dump([\$ptree]) if $debug;
+
+#$ptree->value();
+#$::Context->dumpSymbols();
+
+my $wrapped = new Stupid::LanguageWrapper($ptree);
+$wrapped->{sourceFile} = $sourceFile;
+
+eval "use Stupid::$language";
+croak $@ if $@;
+
+eval "use Stupid2::$language";
+croak $@ if $@;
+
+$wrapped->emitCode();
+
+exit 0;
+
+sub initLexer {
+ @keywords = qw(int array ostream
+ function struct if else while);
+}
+
+sub lexer {
+ my $parser = shift;
+
+ my $code = $parser->YYData->{code};
+
+ # skip newlines
+ while(substr($code, 0, 1) eq "\n") {
+ $code = substr($code, 1);
+ }
+
+ # remove leading whitespace
+ $code =~ s/^\s*//s;
+
+# use Data::Dumper; print Data::Dumper->Dump([\$code]);
+ # EOF
+ return ('',undef) if $code eq '';
+
+ my ($type, $value);
+ # Punctuation
+ if($code =~ /^($|$|\[|\]|{|}|,|;|=|\.|_)(.*)$/s) {
+ $type = $1;
+ $value = undef;
+ $code = $2;
+ # STRING
+ } elsif($code =~ /^"([^"]+)"(.*)$/s) {
+ $type = 'STRING';
+ $value = $1;
+ $code = $2;
+ # hex VALUE
+ } elsif($code =~ /^0x([0-9a-f]+)(.*)$/s) {
+ $type = 'VALUE';
+ $value = new Stupid::HexValue($1);
+ $code = $2;
+ # decimal UVALUE
+ } elsif($code =~ /^([0-9]+)u(.*)$/s) {
+ $type = 'UVALUE';
+ $value = new Stupid::DecimalValue($1);
+ $code = $2;
+ # decimal VALUE
+ } elsif($code =~ /^([0-9]+)(.*)$/s) {
+ $type = 'VALUE';
+ $value = new Stupid::DecimalValue($1);
+ $code = $2;
+ } elsif($code =~ /^'(.)'(.*)$/s) {
+ $type = 'CHAR';
+ $value = new Stupid::DecimalValue(ord($1));
+ $code = $2;
+ # WORD
+ } elsif($code =~ /^([A-Za-z][A-Za-z0-9]*)(.*)$/s) {
+ $value = $1;
+ # Keyword
+ if(grep { $_ eq $value } @keywords) {
+ $type = $value;
+ $value = undef;
+ } else {
+ $type = 'WORD';
+ }
+ $code = $2;
+ # FAIL!!!
+ } else {
+ error($parser, "Can't parse");
+ }
+
+ if($debug) {
+ print STDERR "type = $type";
+ print STDERR " value = $value" if defined $value;
+ print STDERR "\n";
+ }
+
+ $parser->YYData->{code} = $code;
+ return ($type, $value);
+}
+
+sub yyerror {
+ my $parser = shift;
+
+ $parser->YYData->{code} =~ /(.*)$/m;
+ print STDERR "Failed at $1\n";
+ print STDERR '(', $parser->YYData->{code}, ')';
+}
+
+sub error {
+ my $parser = shift;
+ my $error = shift;
+
+ $parser->YYData->{code} =~ /(.*)$/m;
+ croak "$error: $1\n";
+}
+
+package Stupid2::Bitwidth;
+
+sub new {
+ my $class = shift;
+ my $width = shift;
+ my $signed = shift;
+
+ my $self = {};
+ bless $self, $class;
+
+ $self->{width} = $width;
+ $self->{signed} = $signed;
+
+ return $self;
+}
+
+sub isSigned {
+ my $self = shift;
+
+ return $self->{signed};
+}
+
+sub bits {
+ my $self = shift;
+
+ return $self->{width}->value();
+}
+
+package Stupid2::Type::Int;
+
+sub new {
+ my $class = shift;
+ my $width = shift;
+
+ my $self = {};
+ bless $self, $class;
+
+ $self->{width} = $width;
+
+ return $self;
+}
+
+package Stupid;
+
+use strict;
+
+sub ArrayFromString {
+ my $str = shift;
+
+ my $t = new Stupid::ArrayValue();
+ foreach my $c (split //, $str) {
+ $t->append(new Stupid::DecimalValue(ord($c)));
+ }
+
+ return $t;
+}
+
+package Stupid::LanguageWrapper;
+
+use strict;
+
+sub new {
+ my $class = shift;
+ my $tree = shift;
+
+ my $self = {};
+ bless $self, $class;
+
+ $self->{tree} = $tree;
+
+ return $self;
+}
+
+package Stupid::Context;
+
+use strict;
+use Carp;
+
+sub new {
+ my $class = shift;
+
+ my $self = {};
+ bless $self, $class;
+
+ return $self;
+}
+
+sub addSymbol {
+ my $self = shift;
+ my $symbol = shift;
+
+ $self->{symbols}->{$symbol->name()} = $symbol;
+}
+
+sub findSymbol {
+ my $self = shift;
+ my $name = shift;
+
+ my $symbol = $self->{symbols}->{$name};
+ croak "Can't find symbol $name" if !$symbol;
+ return $symbol
+}
+
+sub addStruct {
+ my $self = shift;
+ my $struct = shift;
+
+ $self->{structs}->{$struct->{name}} = $struct;
+}
+
+sub findStruct {
+ my $self = shift;
+ my $name = shift;
+
+ my $struct = $self->{structs}->{$name};
+ croak "Can't find struct $name" if !$struct;
+ return $struct;
+}
+
+sub dumpSymbols {
+ my $self = shift;
+
+ print "Symbol Dump\n";
+ print "===========\n";
+ foreach my $name (keys %{$self->{symbols}}) {
+ print "$name = ",
$self->asString($self->{symbols}->{$name}->value()), "\n";
+ }
+}
+
+sub asString {
+ my $self = shift;
+ my $thing = shift;
+
+#use Data::Dumper; print Data::Dumper->Dump([\$thing], ['thing']);
+ my $str = '';
+ if(ref $thing eq 'ARRAY') {
+ $str = join(', ', map { $self->asString($_) } @$thing);
+ } elsif(ref $thing eq 'Math::BigInt') {
+ $str = 'BigInt: '.$thing->as_hex();
+ } else {
+ $str = ref($thing).': '.$thing->value()->as_hex();
+ }
+
+ return $str;
+}
+
+package Stupid::Function;
+
+use strict;
+
+sub new {
+ my $class = shift;
+ my $context = shift;
+ my $name = shift;
+ my $returns = shift;
+ my $args = shift;
+ my $body = shift;
+
+ my $self = {};
+ bless $self, $class;
+
+ $self->{name} = $name;
+ $self->{returns} = $returns;
+ $self->{args} = $args;
+ $self->{body} = $body;
+
+ $context->addSymbol($self);
+
+ return $self;
+}
+
+sub name {
+ my $self = shift;
+
+ return $self->{name};
+}
+
+package Stupid::TopLevelList;
+
+# FIXME: topl-level classes should inherit from a TopLevel class.
+
+use strict;
+
+sub new {
+ my $class = shift;
+
+ my $self = {};
+ bless $self, $class;
+
+ $self->{topLevels} = [];
+
+ return $self;
+}
+
+sub appendTopLevel {
+ my $self = shift;
+ my $tl = shift;
+
+ push @{$self->{topLevels}}, $tl;
+}
+
+package Stupid::Type::Struct;
+
+use strict;
+
+sub new {
+ my $class = shift;
+ my $context = shift;
+ my $name = shift;
+ my $decls = shift;
+
+ my $self = {};
+ bless $self, $class;
+
+ $self->{name} = $name;
+ $self->{decls} = $decls;
+
+ $context->addStruct($self);
+
+ return $self;
+}
+
+sub findMember {
+ my $self = shift;
+ my $name = shift;
+
+ return $self->{decls}->findDeclaration($name);
+}
+
+package Stupid::Type::StructInstance;
+
+use strict;
+
+sub new {
+ my $class = shift;
+ my $context = shift;
+ my $name = shift;
+
+ my $self = {};
+ bless $self, $class;
+
+ $self->{struct} = $context->findStruct($name);
+
+ return $self;
+}
+
+sub findMember {
+ my $self = shift;
+ my $name = shift;
+
+ return $self->{struct}->findMember($name);
+}
+
+package Stupid::AbstractDeclare;
+
+use strict;
+
+sub new {
+ my $class = shift;
+ my $type = shift;
+ my $name = shift;
+
+ my $self = {};
+ bless $self, $class;
+
+ $self->{type} = $type;
+ $self->{name} = $name;
+
+ return $self;
+}
+
+package Stupid::AbstractDeclList;
+
+use strict;
+
+use Carp;
+
+sub new {
+ my $class = shift;
+
+ my $self = {};
+ bless $self, $class;
+
+ $self->{decls} = [];
+
+ return $self;
+}
+
+sub appendAbstractDecl {
+ my $self = shift;
+ my $decl = shift;
+
+ push @{$self->{decls}}, $decl;
+}
+
+sub findDeclaration {
+ my $self = shift;
+ my $name = shift;
+
+ foreach my $decl (@{$self->{decls}}) {
+ return $decl if $decl->{name} eq $name;
+ }
+ croak "Can't find declaration of $name";
+}
+
+package Stupid::ExprList;
+
+use strict;
+
+sub new {
+ my $class = shift;
+
+ my $self = {};
+ bless $self, $class;
+
+ $self->{expressions} = [];
+
+ return $self;
+}
+
+sub appendExpr {
+ my $self = shift;
+ my $expr = shift;
+
+ push @{$self->{expressions}}, $expr;
+}
+
+sub isEmpty {
+ my $self = shift;
+
+ return $#{$self->{expressions}} == -1;
+}
+
+package Stupid::FunctionCall;
+
+use strict;
+
+sub new {
+ my $class = shift;
+ my $function = shift;
+ my $args = shift;
+
+ my $self = {};
+ bless $self, $class;
+
+ $self->{function} = $function;
+ $self->{args} = $args;
+
+ return $self;
+}
+
+package Stupid::MemberRef;
+
+use strict;
+
+sub new {
+ my $class = shift;
+ my $owner = shift;
+ my $member = shift;
+
+ my $self = {};
+ bless $self, $class;
+
+ $self->{owner} = $owner;
+ $self->{member} = $self->{owner}->findMember($member);
+
+ return $self;
+}
+
+package Stupid::Comment;
+
+use strict;
+
+sub new {
+ my $class = shift;
+ my $comment = shift;
+
+ my $self = {};
+ bless $self, $class;
+
+ $self->{comment} = $comment;
+
+ return $self;
+}
+
+sub value {
+ my $self = shift;
+
+ print "# $self->{comment}\n";
+ return undef;
+}
+
+package Stupid::ArgList;
+
+use strict;
+
+sub new {
+ my $class = shift;
+
+ my $self = {};
+ bless $self, $class;
+
+ $self->{args} = [];
+
+ return $self;
+}
+
+sub appendArg {
+ my $self = shift;
+ my $arg = shift;
+
+ push @{$self->{args}}, $arg;
+}
+
+sub markAsReturn {
+ my $self = shift;
+
+ for my $a (@{$self->{args}}) {
+ $a->markAsReturn();
+ }
+}
+
+sub markAsArgument {
+ my $self = shift;
+
+ for my $a (@{$self->{args}}) {
+ $a->markAsArgument();
+ }
+}
+
+package Stupid::ArrayRef;
+
+use strict;
+
+# A followed by B (as in two statements). No value.
+
+sub new {
+ my $class = shift;
+ my $array = shift;
+ my $offset = shift;
+
+ my $self = {};
+ bless $self, $class;
+
+ $self->{array} = $array;
+ $self->{offset} = $offset;
+
+ return $self;
+}
+
+sub value {
+ my $self = shift;
+
+ # FIXME range checking
+ return $self->{array}->value()->[$self->{offset}->value()];
+}
+
+sub setValue {
+ my $self = shift;
+ my $value = shift;
+
+ # FIXME range checking
+ return $self->{array}->value()->[$self->{offset}->value()] = $value;
+}
+
+package Stupid::StatementList;
+
+use strict;
+
+sub new {
+ my $class = shift;
+
+ my $self = {};
+ bless $self, $class;
+
+ $self->{statements} = [];
+
+ return $self;
+}
+
+sub appendStatement {
+ my $self = shift;
+ my $statement = shift;
+
+ push @{$self->{statements}}, $statement;
+}
+
+sub value {
+ my $self = shift;
+
+ for my $s (@{$self->{statements}}) {
+ $s->value();
+ }
+
+ return undef;
+}
+
+package Stupid::Statement;
+
+use strict;
+
+sub new {
+ my $class = shift;
+ my $expr = shift;
+
+ my $self = {};
+ bless $self, $class;
+
+ $self->{expr} = $expr;
+
+ return $self;
+}
+
+package Stupid::If;
+
+use strict;
+
+sub new {
+ my $class = shift;
+ my $cond = shift;
+ my $then = shift;
+ my $else = shift;
+
+ my $self = {};
+ bless $self, $class;
+
+ $self->{cond} = $cond;
+ $self->{then} = $then;
+ $self->{else} = $else;
+
+ return $self;
+}
+
+package Stupid::While;
+
+use strict;
+
+sub new {
+ my $class = shift;
+ my $cond = shift;
+ my $body = shift;
+
+ my $self = {};
+ bless $self, $class;
+
+ $self->{cond} = $cond;
+ $self->{body} = $body;
+
+ return $self;
+}
+
+package Stupid::Set;
+
+use strict;
+
+# A = B
+
+sub new {
+ my $class = shift;
+ my $l = shift;
+ my $r = shift;
+
+ my $self = {};
+ bless $self, $class;
+
+ $self->{left} = $l;
+ $self->{right} = $r;
+
+ return $self;
+}
+
+sub value {
+ my $self = shift;
+
+ return $self->{left}->setValue($self->{right}->value());
+}
+
+package Stupid::And32;
+
+use strict;
+
+# Unsigned decimal value, any length
+
+sub new {
+ my $class = shift;
+ my $l = shift;
+ my $r = shift;
+
+ my $self = {};
+ bless $self, $class;
+
+ $self->{left} = $l;
+ $self->{right} = $r;
+
+ return $self;
+}
+
+package Stupid::And8;
+
+use strict;
+
+# Unsigned decimal value, any length
+
+sub new {
+ my $class = shift;
+ my $l = shift;
+ my $r = shift;
+
+ my $self = {};
+ bless $self, $class;
+
+ $self->{left} = $l;
+ $self->{right} = $r;
+
+ return $self;
+}
+
+package Stupid::BAnd;
+
+use strict;
+
+# Unsigned decimal value, any length
+
+sub new {
+ my $class = shift;
+ my $l = shift;
+ my $r = shift;
+
+ my $self = {};
+ bless $self, $class;
+
+ $self->{left} = $l;
+ $self->{right} = $r;
+
+ return $self;
+}
+
+
+package Stupid::BOr;
+
+use strict;
+
+# Unsigned decimal value, any length
+
+sub new {
+ my $class = shift;
+ my $l = shift;
+ my $r = shift;
+
+ my $self = {};
+ bless $self, $class;
+
+ $self->{left} = $l;
+ $self->{right} = $r;
+
+ return $self;
+}
+
+package Stupid::Eq32;
+
+use strict;
+
+# Unsigned decimal value, any length
+
+sub new {
+ my $class = shift;
+ my $l = shift;
+ my $r = shift;
+
+ my $self = {};
+ bless $self, $class;
+
+ $self->{left} = $l;
+ $self->{right} = $r;
+
+ return $self;
+}
+
+package Stupid::Le8;
+
+use strict;
+
+# Unsigned decimal value, any length
+
+sub new {
+ my $class = shift;
+ my $l = shift;
+ my $r = shift;
+
+ my $self = {};
+ bless $self, $class;
+
+ $self->{left} = $l;
+ $self->{right} = $r;
+
+ return $self;
+}
+
+
+package Stupid::Ge8;
+
+use strict;
+
+# Unsigned decimal value, any length
+
+sub new {
+ my $class = shift;
+ my $l = shift;
+ my $r = shift;
+
+ my $self = {};
+ bless $self, $class;
+
+ $self->{left} = $l;
+ $self->{right} = $r;
+
+ return $self;
+}
+
+
+package Stupid::LShift32;
+
+use strict;
+
+# Unsigned decimal value, any length
+
+sub new {
+ my $class = shift;
+ my $l = shift;
+ my $r = shift;
+
+ my $self = {};
+ bless $self, $class;
+
+ $self->{left} = $l;
+ $self->{right} = $r;
+
+ return $self;
+}
+
+package Stupid::LShift8;
+
+use strict;
+
+# Unsigned decimal value, any length
+
+sub new {
+ my $class = shift;
+ my $l = shift;
+ my $r = shift;
+
+ my $self = {};
+ bless $self, $class;
+
+ $self->{left} = $l;
+ $self->{right} = $r;
+
+ return $self;
+}
+
+sub value {
+ my $self = shift;
+
+ # FIXME type checking
+ return $self->{left}->value()->blsft($self->{right}->value());
+}
+
+package Stupid::Minus8;
+
+use strict;
+
+# Unsigned decimal value, any length
+
+sub new {
+ my $class = shift;
+ my $l = shift;
+ my $r = shift;
+
+ my $self = {};
+ bless $self, $class;
+
+ $self->{left} = $l;
+ $self->{right} = $r;
+
+ return $self;
+}
+
+sub value {
+ my $self = shift;
+
+ # FIXME type and underflow checking
+ return $self->{left}->value()->bsub($self->{right}->value());
+}
+
+package Stupid::Minus32;
+
+use strict;
+
+# Unsigned decimal value, any length
+
+sub new {
+ my $class = shift;
+ my $l = shift;
+ my $r = shift;
+
+ my $self = {};
+ bless $self, $class;
+
+ $self->{left} = $l;
+ $self->{right} = $r;
+
+ return $self;
+}
+
+sub value {
+ my $self = shift;
+
+ # FIXME type and underflow checking
+ return $self->{left}->value()->bsub($self->{right}->value());
+}
+
+
+package Stupid::Mod8;
+
+use strict;
+
+# Unsigned decimal value, any length
+
+sub new {
+ my $class = shift;
+ my $l = shift;
+ my $r = shift;
+
+ my $self = {};
+ bless $self, $class;
+
+ $self->{left} = $l;
+ $self->{right} = $r;
+
+ return $self;
+}
+
+sub value {
+ my $self = shift;
+
+ # FIXME type checking
+ return $self->{left}->value()->bmod($self->{right}->value());
+}
+
+
+package Stupid::Mod32;
***The diff for this file has been truncated for email.***
=======================================
--- /dev/null
+++ /test2/Makefile Sat May 29 08:41:06 2010
@@ -0,0 +1,25 @@
+CFLAGS = -Wall -Werror -g
+
+test: testC testH
+
+generated-dirs:
+ mkdir -p generated/C
+ mkdir -p generated/Haskell
+ mkdir -p generated/Java
+
+testC: generated-dirs
+ ./test.pl -language=C
+
+testH: generated-dirs
+ ./test.pl -language=Haskell
+
+testJ: generated-dirs
+ ./test.pl -language=Java
+
+generated/C/sha256.c: sha256.stupid ../src/stupid.pl ../src/Stupid/C.pm
+ ./build-C.sh sha256
+
+test_sha256.o: test_sha256.c generated/C/sha256.c
+
+test_sha256: test_sha256.o
+ $(CC) $(CFLAGS) -o test_sha256 test_sha256.o
=======================================
--- /dev/null
+++ /test2/array-small.stupid Sat May 29 08:41:06 2010
@@ -0,0 +1,8 @@
+"EXPECT:C";
+
+function (ostream o) test() {
+
+array(int_8u, 3) k = [65,66,67];
+
+o.put(k[2]);
+}
=======================================
--- /dev/null
+++ /test2/build-C.sh Sat May 29 08:41:06 2010
@@ -0,0 +1,9 @@
+#!/usr/bin/env bash
+
+set -e
+#set -x
+
+TARGET=$1
+
+PERLLIB=../src ../src/stupid2.pl --debug --language=C ${TARGET}.stupid >
generated/C/${TARGET}.c
+gcc -Wall -Werror -o generated/C/${TARGET} test-wrapper.c
generated/C/${TARGET}.c
=======================================
--- /dev/null
+++ /test2/test-wrapper.c Sat May 29 08:41:06 2010
@@ -0,0 +1,35 @@
+#include <stdio.h>
+
+#include <sys/types.h>
+
+#ifdef __APPLE__
+typedef u_int32_t uint32;
+typedef u_int8_t uint8;
+#else
+typedef uint32_t uint32;
+typedef uint8_t uint8;
+#endif
+
+
+typedef struct
+ {
+ void (*put)(void *info, uint8 ch);
+ void *info;
+ } stupid_ostream;
+
+void test(stupid_ostream *out);
+
+void put(void *info, uint8 ch)
+ {
+ putchar(ch);
+ }
+
+int main(int argc, char **argv)
+ {
+ stupid_ostream t;
+
+ t.put = put;
+ test(&t);
+
+ return 0;
+ }
=======================================
--- /dev/null
+++ /test2/test.pl Sat May 29 08:41:06 2010
@@ -0,0 +1,75 @@
+#!/bin/sh
+eval 'exec perl -x -w $0 ${1+"$@"}'
+
+#!perl actually starts here.
+
+use strict;
+
+use Getopt::Long;
+use Carp;
+use File::Slurp;
+use IPC::Run qw(run);
+
+$| = 1;
+
+my $language;
+my $quietbuild;
+
+croak if !GetOptions("language=s" => \$language,
+ "quietbuild" => \$quietbuild);
+
+opendir(D, '.') || croak "Can't open .: $!";
+my @tests = sort grep { /\.stupid$/ } readdir(D);
+closedir(D);
+
+my $failed = 0;
+my $skipped = 0;
+my $ran = 0;
+my $passed = 0;
+for my $test (@tests) {
+ ++$ran;
+ my($base) = $test =~ /^(.*)\.stupid$/;
+ print "$base...";
+ my $code = read_file("$test");
+ if($code =~ /^"EXPECT([^:]*):([^"]*)"/m) {
+ my $expect_status = $1;
+ my $expect_output = $2;
+ my $status;
+ my $output;
+ my $buildredirect="";
+ if($quietbuild) {
+ $buildredirect=">/dev/null 2>/dev/null";
+ }
+ if(system("./build-$language.sh $base $buildredirect")) {
+ $status = '-BUILD-FAIL';
+ $output = '';
+ } else {
+ my @cmd;
+ $cmd[0] = "generated/$language/$base";
+ my $err;
+ my $ok = run \@cmd, \undef, \$output, \$err;
+ if($ok) {
+ $status = '';
+ } else {
+ $status = '-RUN-FAIL';
+ $output = $err;
+ }
+ }
+ if($expect_status ne $status) {
+ print "FAIL (expected status $expect_status, got $status with output
$output)";
+ ++$failed;
+ } elsif($expect_output ne $output) {
+ print "FAIL (expected '$expect_output', got '$output')";
+ ++$failed;
+ } else {
+ print 'OK';
+ ++$passed;
+ }
+ } else {
+ print 'skip';
+ ++$skipped;
+ }
+ print "\n";
+}
+
+print "Ran $ran tests, $passed passed, $failed failed, $skipped
skipped.\n";
=======================================
--- /.hgignore Sat Feb 13 04:20:10 2010
+++ /.hgignore Sat May 29 08:41:06 2010
@@ -2,6 +2,8 @@
.*\.hi
.*\.o
src/grammar\.pm
+src/grammar2\.pm
src/stupid\.tgz
test/generated/.*
test/test_sha256
+test2/generated/.*
=======================================
--- /src/Makefile Sun Feb 7 06:16:11 2010
+++ /src/Makefile Sat May 29 08:41:06 2010
@@ -1,3 +1,6 @@
+grammar2.pm: grammar2.y
+ yapp -v grammar2.y
+
grammar.pm: grammar.y
yapp -v grammar.y

==============================================================================
Revision: 6df0e5ff4b
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 08:43:03 2010
Log: Ready for next test.
http://code.google.com/p/stupid-crypto/source/detail?r=6df0e5ff4b

Added:
/test2/array-write.stupid

=======================================
--- /dev/null
+++ /test2/array-write.stupid Sat May 29 08:43:03 2010
@@ -0,0 +1,12 @@
+"EXPECT:BAB";
+
+function (ostream o) test() {
+
+array(uint8, 3) k = [ 66, 66, 66 ];
+
+k[1] = 65;
+
+o.put(k[0]);
+o.put(k[1]);
+o.put(k[2]);
+}

==============================================================================
Revision: 3807c5a504
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 08:44:59 2010
Log: Test passes.
http://code.google.com/p/stupid-crypto/source/detail?r=3807c5a504

Modified:
/test2/array-write.stupid

=======================================
--- /test2/array-write.stupid Sat May 29 08:43:03 2010
+++ /test2/array-write.stupid Sat May 29 08:44:59 2010
@@ -2,7 +2,7 @@

function (ostream o) test() {

-array(uint8, 3) k = [ 66, 66, 66 ];
+array(int_8u, 3) k = [ 66, 66, 66 ];

k[1] = 65;

==============================================================================
Revision: 2b58540a36
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 08:45:59 2010
Log: Next test.
http://code.google.com/p/stupid-crypto/source/detail?r=2b58540a36

Added:
/test2/bug-context.stupid

=======================================
--- /dev/null
+++ /test2/bug-context.stupid Sat May 29 08:45:59 2010
@@ -0,0 +1,12 @@
+"EXPECT-BUILD-FAIL:";
+
+function() f1() {
+ uint32 x = 0;
+
+ x = 1;
+}
+
+function() f2() {
+ "error: not declared in this context";
+ x = 2;
+}

==============================================================================
Revision: 8249a25ff7
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 08:48:45 2010
Log: Test passes.
http://code.google.com/p/stupid-crypto/source/detail?r=8249a25ff7

Modified:
/src/Stupid2/C.pm
/test2/bug-context.stupid

=======================================
--- /src/Stupid2/C.pm Sat May 29 08:41:06 2010
+++ /src/Stupid2/C.pm Sat May 29 08:48:45 2010
@@ -10,5 +10,12 @@
$base = 'int' if $self->{width}->isSigned();
return $base . $self->{width}->bits();
}
+
+sub Stupid2::Type::Int::emitDeclaration {
+ my $self = shift;
+ my $name = shift;
+
+ print $self->typeName(), " $name";
+}

1;
=======================================
--- /test2/bug-context.stupid Sat May 29 08:45:59 2010
+++ /test2/bug-context.stupid Sat May 29 08:48:45 2010
@@ -1,7 +1,7 @@
"EXPECT-BUILD-FAIL:";

function() f1() {
- uint32 x = 0;
+ int_32u x = 0;

x = 1;
}

==============================================================================
Revision: 992173f9a2
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 08:49:47 2010
Log: Next test.
http://code.google.com/p/stupid-crypto/source/detail?r=992173f9a2

Added:
/test2/bug-double-declaration.stupid

=======================================
--- /dev/null
+++ /test2/bug-double-declaration.stupid Sat May 29 08:49:47 2010
@@ -0,0 +1,10 @@
+"EXPECT-BUILD-FAIL:";
+
+function(ostream out) test() {
+ out.put(65);
+}
+
+function (uint8 i) broken (uint8 x) {
+"this second declaration of i should cause an error";
+uint8 i = 0;
+}

==============================================================================
Revision: e2b58a49b6
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 08:54:14 2010
Log: Test passed.
http://code.google.com/p/stupid-crypto/source/detail?r=e2b58a49b6

Modified:
/src/Stupid2/C.pm
/test2/bug-double-declaration.stupid

=======================================
--- /src/Stupid2/C.pm Sat May 29 08:48:45 2010
+++ /src/Stupid2/C.pm Sat May 29 08:54:14 2010
@@ -17,5 +17,20 @@

print $self->typeName(), " $name";
}
+
+sub Stupid2::Type::Int::emitReturnDecl {
+ my $self = shift;
+ my $name = shift;
+
+ print $self->typeName(), " *$name";
+}
+
+sub Stupid2::Type::Int::emitArg {
+ my $self = shift;
+ my $name = shift;
+
+ print 'const ';
+ $self->emitDeclaration($name);
+}

1;
=======================================
--- /test2/bug-double-declaration.stupid Sat May 29 08:49:47 2010
+++ /test2/bug-double-declaration.stupid Sat May 29 08:54:14 2010
@@ -4,7 +4,7 @@
out.put(65);
}

-function (uint8 i) broken (uint8 x) {
+function (int_8u i) broken (int_8u x) {
"this second declaration of i should cause an error";
-uint8 i = 0;
-}
+int_8u i = 0;
+}

==============================================================================
Revision: 3cc7053200
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 08:55:06 2010
Log: Add next test.
http://code.google.com/p/stupid-crypto/source/detail?r=3cc7053200

Added:
/test2/bug-ostream-input.stupid

=======================================
--- /dev/null
+++ /test2/bug-ostream-input.stupid Sat May 29 08:55:06 2010
@@ -0,0 +1,11 @@
+"EXPECT-BUILD-FAIL:";
+
+function() test(ostream out) {
+ array(uint8, 13) hello = [ "Hello, world!" ];
+ uint32 n = 0;
+
+ while(n ne32 13) {
+ out.put(hello[n]);
+ n = n plus32 1;
+ }
+}

==============================================================================
Revision: ac97fa9a70
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 09:04:46 2010
Log: Test passed.
http://code.google.com/p/stupid-crypto/source/detail?r=ac97fa9a70

Modified:
/src/grammar2.y
/src/stupid2.pl
/test2/bug-ostream-input.stupid

=======================================
--- /src/grammar2.y Sat May 29 08:41:06 2010
+++ /src/grammar2.y Sat May 29 09:04:46 2010
@@ -107,16 +107,12 @@
{ new Stupid::Mod8($_[1], $_[3]); }
| expr 'mod32' expr
{ new Stupid::Mod32($_[1], $_[3]); }
- | expr 'ne32' expr
- { new Stupid::Ne32($_[1], $_[3]); }
- | expr 'ne8' expr
- { new Stupid::Ne8($_[1], $_[3]); }
+ | expr '!=' expr
+ { new Stupid2::Ne($_[1], $_[3]); }
| expr 'or8' expr
{ new Stupid::Or8($_[1], $_[3]); }
- | expr 'plus8' expr
- { new Stupid::Plus8($_[1], $_[3]); }
- | expr 'plus32' expr
- { new Stupid::Plus32($_[1], $_[3]); }
+ | expr '+' expr
+ { new Stupid2::Plus($_[1], $_[3]); }
| expr 'wrapplus32' expr
{ new Stupid::WrapPlus32($_[1], $_[3]); }
| expr 'rrotate32' expr
=======================================
--- /src/stupid2.pl Sat May 29 08:41:06 2010
+++ /src/stupid2.pl Sat May 29 09:04:46 2010
@@ -75,7 +75,7 @@

my ($type, $value);
# Punctuation
- if($code =~ /^($|$|\[|\]|{|}|,|;|=|\.|_)(.*)$/s) {
+ if($code =~ /^($|$|\[|\]|{|}|,|;|=|\.|_|!=|\+)(.*)$/s) {
$type = $1;
$value = undef;
$code = $2;
@@ -1022,25 +1022,7 @@
return $self->{left}->value()->bmod($self->{right}->value());
}

-package Stupid::Ne32;
-
-use strict;
-
-sub new {
- my $class = shift;
- my $l = shift;
- my $r = shift;
-
- my $self = {};
- bless $self, $class;
-
- $self->{left} = $l;
- $self->{right} = $r;
-
- return $self;
-}
-
-package Stupid::Ne8;
+package Stupid2::Ne;

use strict;

@@ -1157,12 +1139,10 @@
return $self->{left}->value()->bior($self->{right}->value());
}

-package Stupid::Plus8;
+package Stupid2::Plus;

use strict;

-# Unsigned decimal value, any length
-
sub new {
my $class = shift;
my $l = shift;
@@ -1176,39 +1156,6 @@

return $self;
}
-
-sub value {
- my $self = shift;
-
- # FIXME type and overflow checking
- $self->{left}->value()->badd($self->{right}->value());
-}
-
-
-package Stupid::Plus32;
-
-use strict;
-
-sub new {
- my $class = shift;
- my $l = shift;
- my $r = shift;
-
- my $self = {};
- bless $self, $class;
-
- $self->{left} = $l;
- $self->{right} = $r;
-
- return $self;
-}
-
-sub value {
- my $self = shift;
-
- # FIXME type and overflow checking
- $self->{left}->value()->badd($self->{right}->value());
-}

package Stupid::WrapPlus32;

=======================================
--- /test2/bug-ostream-input.stupid Sat May 29 08:55:06 2010
+++ /test2/bug-ostream-input.stupid Sat May 29 09:04:46 2010
@@ -1,11 +1,11 @@
"EXPECT-BUILD-FAIL:";

function() test(ostream out) {
- array(uint8, 13) hello = [ "Hello, world!" ];
- uint32 n = 0;
-
- while(n ne32 13) {
+ array(int_8u, 13) hello = [ "Hello, world!" ];
+ int_32u n = 0;
+
+ while(n != 13) {
out.put(hello[n]);
- n = n plus32 1;
+ n = n + 1;
}
}

==============================================================================
Revision: 920fcd4c9f
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 09:05:54 2010
Log: Next test.
http://code.google.com/p/stupid-crypto/source/detail?r=920fcd4c9f

Added:
/test2/bug-struct-decl-without-initialisation.stupid

=======================================
--- /dev/null
+++ /test2/bug-struct-decl-without-initialisation.stupid Sat May 29
09:05:54 2010
@@ -0,0 +1,10 @@
+"EXPECT-BUILD-FAIL:";
+
+struct test (
+ uint32 a,
+ uint32 b
+);
+
+function(ostream out) test() {
+ struct test s;
+}

==============================================================================
Revision: e3886667e0
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 09:08:19 2010
Log: Test passed.
http://code.google.com/p/stupid-crypto/source/detail?r=e3886667e0

Modified:
/test2/bug-struct-decl-without-initialisation.stupid

=======================================
--- /test2/bug-struct-decl-without-initialisation.stupid Sat May 29
09:05:54 2010
+++ /test2/bug-struct-decl-without-initialisation.stupid Sat May 29
09:08:19 2010
@@ -1,8 +1,8 @@
"EXPECT-BUILD-FAIL:";

struct test (
- uint32 a,
- uint32 b
+ int_32u a,
+ int_32u b
);

function(ostream out) test() {

==============================================================================
Revision: f8f50aed80
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 09:09:42 2010
Log: Next test.
http://code.google.com/p/stupid-crypto/source/detail?r=f8f50aed80

Added:
/test2/if.stupid

=======================================
--- /dev/null
+++ /test2/if.stupid Sat May 29 09:09:42 2010
@@ -0,0 +1,9 @@
+"EXPECT:B";
+
+function(ostream out) test() {
+ if(1 eq32 2) {
+ out.put(67);
+ } else {
+ out.put(66);
+ }
+}

==============================================================================
Revision: 97d9f59284
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 09:13:21 2010
Log: Add ability to run a single test.
http://code.google.com/p/stupid-crypto/source/detail?r=97d9f59284

Modified:
/test2/Makefile
/test2/test.pl

=======================================
--- /test2/Makefile Sat May 29 08:41:06 2010
+++ /test2/Makefile Sat May 29 09:13:21 2010
@@ -7,6 +7,9 @@
mkdir -p generated/Haskell
mkdir -p generated/Java

+singleC:
+ ./test.pl -language=C $(SINGLE)
+
testC: generated-dirs
./test.pl -language=C

=======================================
--- /test2/test.pl Sat May 29 08:41:06 2010
+++ /test2/test.pl Sat May 29 09:13:21 2010
@@ -18,9 +18,14 @@
croak if !GetOptions("language=s" => \$language,
"quietbuild" => \$quietbuild);

-opendir(D, '.') || croak "Can't open .: $!";
-my @tests = sort grep { /\.stupid$/ } readdir(D);
-closedir(D);
+my @tests;
+if($#ARGV >= 0) {
+ @tests = @ARGV;
+} else {
+ opendir(D, '.') || croak "Can't open .: $!";
+ @tests = sort grep { /\.stupid$/ } readdir(D);
+ closedir(D);
+}

my $failed = 0;
my $skipped = 0;

==============================================================================
Revision: 18c0147282
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 09:18:40 2010
Log: Test passes.
http://code.google.com/p/stupid-crypto/source/detail?r=18c0147282

Modified:
/src/Stupid2/C.pm
/src/grammar2.y
/src/stupid2.pl
/test2/if.stupid

=======================================
--- /src/Stupid2/C.pm Sat May 29 08:54:14 2010
+++ /src/Stupid2/C.pm Sat May 29 09:18:40 2010
@@ -33,4 +33,15 @@
$self->emitDeclaration($name);
}

+sub Stupid2::Equals::emitCode {
+ my $self = shift;
+
+ print '(';
+ $self->{left}->emitCode();
+ print ' == ';
+ $self->{right}->emitCode();
+ print ')';
+}
+
+
1;
=======================================
--- /src/grammar2.y Sat May 29 09:04:46 2010
+++ /src/grammar2.y Sat May 29 09:18:40 2010
@@ -89,8 +89,8 @@
{ new Stupid::BAnd($_[1], $_[3]); }
| expr 'bor' expr
{ new Stupid::BOr($_[1], $_[3]); }
- | expr 'eq32' expr
- { new Stupid::Eq32($_[1], $_[3]); }
+ | expr '==' expr
+ { new Stupid2::Equals($_[1], $_[3]); }
| expr 'ge8' expr
{ new Stupid::Ge8($_[1], $_[3]); }
| expr 'le8' expr
=======================================
--- /src/stupid2.pl Sat May 29 09:04:46 2010
+++ /src/stupid2.pl Sat May 29 09:18:40 2010
@@ -75,7 +75,7 @@

my ($type, $value);
# Punctuation
- if($code =~ /^($|$|\[|\]|{|}|,|;|=|\.|_|!=|\+)(.*)$/s) {
+ if($code =~ /^($|$|\[|\]|{|}|,|;|\.|_|==|!=|\+|=)(.*)$/s) {
$type = $1;
$value = undef;
$code = $2;
@@ -803,7 +803,7 @@
return $self;
}

-package Stupid::Eq32;
+package Stupid2::Equals;

use strict;

=======================================
--- /test2/if.stupid Sat May 29 09:09:42 2010
+++ /test2/if.stupid Sat May 29 09:18:40 2010
@@ -1,7 +1,7 @@
"EXPECT:B";

function(ostream out) test() {
- if(1 eq32 2) {
+ if(1 == 2) {
out.put(67);
} else {
out.put(66);

==============================================================================
Revision: 381ede171b
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 09:20:01 2010
Log: Next test.
http://code.google.com/p/stupid-crypto/source/detail?r=381ede171b

Added:
/test2/ostream-funccall.stupid

=======================================
--- /dev/null
+++ /test2/ostream-funccall.stupid Sat May 29 09:20:01 2010
@@ -0,0 +1,11 @@
+"EXPECT:A";
+
+function (uint8 l)k() {
+ l=65;
+}
+
+function (ostream o) test() {
+ uint8 x=k();
+ o.put(x);
+}
+

==============================================================================
Revision: a586c777dd
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 09:23:47 2010
Log: Test passes.
http://code.google.com/p/stupid-crypto/source/detail?r=a586c777dd

Modified:
/src/Stupid2/C.pm
/test2/ostream-funccall.stupid

=======================================
--- /src/Stupid2/C.pm Sat May 29 09:18:40 2010
+++ /src/Stupid2/C.pm Sat May 29 09:23:47 2010
@@ -32,6 +32,23 @@
print 'const ';
$self->emitDeclaration($name);
}
+
+sub Stupid2::Type::Int::dereference {
+ my $self = shift;
+
+ print '*';
+}
+
+sub Stupid2::Type::Int::emitPointer {
+ my $self = shift;
+
+ print '&';
+}
+
+# FIXME: bad name for this function
+sub Stupid2::Type::Int::emitParameter {
+ my $self = shift;
+}

sub Stupid2::Equals::emitCode {
my $self = shift;
=======================================
--- /test2/ostream-funccall.stupid Sat May 29 09:20:01 2010
+++ /test2/ostream-funccall.stupid Sat May 29 09:23:47 2010
@@ -1,11 +1,11 @@
"EXPECT:A";

-function (uint8 l)k() {
+function (int_8u l) k() {
l=65;
}

function (ostream o) test() {
- uint8 x=k();
+ int_8u x=k();
o.put(x);
}

==============================================================================
Revision: 254bb56d7e
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 09:25:08 2010
Log: Next test.
http://code.google.com/p/stupid-crypto/source/detail?r=254bb56d7e

Added:
/test2/ostream-funccall2.stupid

=======================================
--- /dev/null
+++ /test2/ostream-funccall2.stupid Sat May 29 09:25:08 2010
@@ -0,0 +1,12 @@
+"EXPECT:A";
+
+function (uint8 l)k() {
+ l=65;
+}
+
+function (ostream o) test() {
+ uint8 x=0;
+ x=k();
+ o.put(x);
+}
+

==============================================================================
Revision: ed7d943626
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 09:26:01 2010
Log: Test passed.
http://code.google.com/p/stupid-crypto/source/detail?r=ed7d943626

Modified:
/test2/ostream-funccall2.stupid

=======================================
--- /test2/ostream-funccall2.stupid Sat May 29 09:25:08 2010
+++ /test2/ostream-funccall2.stupid Sat May 29 09:26:01 2010
@@ -1,11 +1,11 @@
"EXPECT:A";

-function (uint8 l)k() {
+function (int_8u l)k() {
l=65;
}

function (ostream o) test() {
- uint8 x=0;
+ int_8u x=0;
x=k();
o.put(x);
}

==============================================================================
Revision: 20d653fa6e
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 09:26:46 2010
Log: Next test.
http://code.google.com/p/stupid-crypto/source/detail?r=20d653fa6e

Added:
/test2/ostream-singlechar.stupid

=======================================
--- /dev/null
+++ /test2/ostream-singlechar.stupid Sat May 29 09:26:46 2010
@@ -0,0 +1,5 @@
+"EXPECT:C";
+
+function(ostream out) test() {
+ out.put(67);
+}

==============================================================================
Revision: 68dd266a8a
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 09:28:22 2010
Log: Next test.
http://code.google.com/p/stupid-crypto/source/detail?r=68dd266a8a

Added:
/test2/ostream-variable.stupid

=======================================
--- /dev/null
+++ /test2/ostream-variable.stupid Sat May 29 09:28:22 2010
@@ -0,0 +1,7 @@
+"EXPECT:A";
+
+function (ostream o) test() {
+ uint8 x=65;
+ o.put(x);
+}
+

==============================================================================
Revision: c67ff27a35
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 09:29:21 2010
Log: Test passed.
http://code.google.com/p/stupid-crypto/source/detail?r=c67ff27a35

Modified:
/test2/ostream-variable.stupid

=======================================
--- /test2/ostream-variable.stupid Sat May 29 09:28:22 2010
+++ /test2/ostream-variable.stupid Sat May 29 09:29:21 2010
@@ -1,7 +1,7 @@
"EXPECT:A";

function (ostream o) test() {
- uint8 x=65;
+ int_8u x=65;
o.put(x);
}

==============================================================================
Revision: 1b73385136
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 09:30:02 2010
Log: Next test.
http://code.google.com/p/stupid-crypto/source/detail?r=1b73385136

Added:
/test2/ostream.stupid

=======================================
--- /dev/null
+++ /test2/ostream.stupid Sat May 29 09:30:02 2010
@@ -0,0 +1,11 @@
+"EXPECT:Hello, world!";
+
+function(ostream out) test() {
+ array(uint8, 13) hello = [ "Hello, world!" ];
+ uint32 n = 0;
+
+ while(n ne32 13) {
+ out.put(hello[n]);
+ n = n plus32 1;
+ }
+}

==============================================================================
Revision: 5ed15ac814
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 12:46:57 2010
Log: Test passes.
http://code.google.com/p/stupid-crypto/source/detail?r=5ed15ac814

Modified:
/src/Stupid2/C.pm
/src/grammar2.y
/src/stupid2.pl
/test2/ostream-variable.stupid
/test2/ostream.stupid

=======================================
--- /src/Stupid2/C.pm Sat May 29 09:23:47 2010
+++ /src/Stupid2/C.pm Sat May 29 12:46:57 2010
@@ -3,12 +3,121 @@
use strict;
use warnings;

+sub Stupid2::TopLevelList::emitCode {
+ my $self = shift;
+
+ for my $f (@{$self->{topLevels}}) {
+ $f->emitCode();
+ }
+}
+
+sub Stupid2::Comment::emitCode {
+ my $self = shift;
+
+ print "/* $self->{comment} */\n";
+}
+
+sub Stupid2::Function::emitCode {
+ my $self = shift;
+
+ print 'void ', $self->{name}, '(';
+ my $first = $self->{returns}->emitReturnDecls();
+ $self->{args}->emitArgs($first);
+ print ") {\n";
+ $self->{body}->emitCode();
+ print "}\n";
+}
+
+sub Stupid2::StatementList::emitCode {
+ my $self = shift;
+
+ for my $s (@{$self->{statements}}) {
+# use Data::Dumper; $Data::Dumper::Indent=1; print "/*\n",
Data::Dumper->Dump([$s]), " */\n";
+ $s->emitCode();
+ }
+}
+
+sub Stupid2::Statement::emitCode {
+ my $self = shift;
+
+ $self->{expr}->emitCode();
+ print ";\n";
+}
+
+sub Stupid2::ExprList::emitParameters {
+ my $self = shift;
+
+ my $first = 1;
+ for my $expr (@{$self->{expressions}}) {
+ print ', ' if !$first;
+ $first = 0;
+ $expr->emitParameter();
+ }
+}
+
+sub Stupid2::Declare::emitReturnDecl {
+ my $self = shift;
+
+ $self->{var}->emitReturnDecl();
+}
+
+sub Stupid2::Declare::emitCode {
+ my $self = shift;
+
+ $self->{var}->emitDeclaration($self->{init});
+ print ";\n";
+}
+
+sub Stupid2::Set::emitCode {
+ my $self = shift;
+
+ # special case ... clearly we could do this in full generality,
+ # e.g f()[8] or f().foo or (a, b) = (c, d) or (a, b) = (b, a)
+ # [hmmm]
+ if(ref($self->{right}) eq 'Stupid::FunctionCall') {
+ $self->{right}->emitCallWithLValue($self->{left});
+ return;
+ }
+
+ $self->{left}->emitLValue();
+ print ' = ';
+ $self->{right}->emitCode();
+}
+
+sub Stupid2::FunctionCall::emitCode {
+ my $self = shift;
+
+ $self->{function}->emitCall();
+ print '(';
+ $self->{function}->maybeAddSelf();
+ $self->{args}->emitParameters();
+ print ");\n";
+}
+
+sub Stupid2::While::emitCode {
+ my $self = shift;
+
+ print 'while (';
+ $self->{cond}->emitCode();
+ print ") {\n";
+ $self->{body}->emitCode();
+ print "}\n";
+}
+
+sub Stupid2::Type::Array::emitDeclaration {
+ my $self = shift;
+ my $name = shift;
+
+ print $self->{type}->typeName(), ' ', $name,
+ '[', $self->{size}->value(), ']';
+}
+
sub Stupid2::Type::Int::typeName {
my $self = shift;

my $base = 'uint';
- $base = 'int' if $self->{width}->isSigned();
- return $base . $self->{width}->bits();
+ $base = 'int' if $self->signed();
+ return $base . $self->bits();
}

sub Stupid2::Type::Int::emitDeclaration {
@@ -50,8 +159,99 @@
my $self = shift;
}

-sub Stupid2::Equals::emitCode {
+sub Stupid2::Variable::emitDeclaration {
my $self = shift;
+ my $init = shift;
+
+ $self->{type}->emitDeclaration($self->{name});
+
+ # special case ... clearly we could do this in full generality,
+ # e.g f()[8] or f().foo or (a, b) = (c, d) or (a, b) = (b, a)
+ # [hmmm]
+ if(ref($init) eq 'Stupid::FunctionCall') {
+ print ";\n";
+ $init->emitCallWithLValue($self);
+ return;
+ }
+
+ print ' = ';
+ $init->emitCode();
+}
+
+sub Stupid2::Variable::emitReturnDecl {
+ my $self = shift;
+
+ $self->{type}->emitReturnDecl($self->{name});
+}
+
+sub Stupid2::Variable::emitCode {
+ my $self = shift;
+
+ print '(';
+ $self->{type}->dereference() if $self->{isReturn};
+ $self->{type}->derefArgument() if $self->{isArgument};
+ print $self->{name};
+ print ')';
+}
+
+sub Stupid2::Variable::emitMemberRef {
+ my $self = shift;
+ my $member = shift;
+
+ print '.';
+ print $member->{name};
+}
+
+sub Stupid2::Variable::maybeAddSelf {
+ my $self = shift;
+
+ print "$self->{name}, " if $self->{type}->needsSelf();
+}
+
+sub Stupid2::Variable::emitLValue {
+ my $self = shift;
+
+ $self->{type}->dereference() if $self->{isReturn};
+ print $self->{name};
+}
+
+sub Stupid2::ArrayRef::emitParameter {
+ my $self = shift;
+
+ $self->emitLValue();
+}
+
+sub Stupid2::ArrayRef::emitLValue {
+ my $self = shift;
+
+ $self->{array}->emitCode();
+ print '[';
+ $self->{offset}->emitCode();
+ print ']';
+}
+
+sub Stupid2::ArrayValue::emitCode {
+ my $self = shift;
+
+ print '{ ';
+ my $first = 1;
+ foreach my $v (@{$self->values()}) {
+ print ', ' if !$first;
+ $v->emitCode();
+ $first = 0;
+ }
+ print ' }';
+}
+
+sub Stupid2::DecimalValue::emitCode {
+ my $self = shift;
+
+ print $self->{value};
+ print 'U' if !$self->signed();
+}
+
+sub Stupid2::Eq::emitCode {
+ my $self = shift;

print '(';
$self->{left}->emitCode();
@@ -60,5 +260,25 @@
print ')';
}

+sub Stupid2::Ne::emitCode {
+ my $self = shift;
+
+ print '(';
+ $self->{left}->emitCode();
+ print ' != ';
+ $self->{right}->emitCode();
+ print ')';
+}
+
+# FIXME: deal with sign.
+sub Stupid2::Plus::emitCode {
+ my $self = shift;
+
+ print 'plus', $self->bits(), '(';
+ $self->{left}->emitCode();
+ print ', ';
+ $self->{right}->emitCode();
+ print ')';
+}

1;
=======================================
--- /src/grammar2.y Sat May 29 09:18:40 2010
+++ /src/grammar2.y Sat May 29 12:46:57 2010
@@ -9,7 +9,7 @@
toplevel_list : toplevel_list toplevel
{ $_[1]->appendTopLevel($_[2]); $_[1]; }
| toplevel
- { my $t = new Stupid::TopLevelList();
+ { my $t = new Stupid2::TopLevelList();
$t->appendTopLevel($_[1]);
$t; }
;
@@ -39,7 +39,7 @@
'{' statements '}'
{ $_[3]->markAsReturn();
$_[7]->markAsArgument();
- new Stupid::Function($::Context, $_[5], $_[3], $_[7], $_[10]); }
+ new Stupid2::Function($::Context, $_[5], $_[3], $_[7], $_[10]); }
;

arglist : arglist ',' arg
@@ -53,18 +53,18 @@
;

arg : type vardecl
- { new Stupid::Declare($::Context, new Stupid::Variable($_[1],
- $_[2])); }
+ { new Stupid2::Declare($::Context, new Stupid2::Variable($_[1],
+ $_[2])); }
;

statements : statements statement
{ $_[1]->appendStatement($_[2]); $_[1]; }
| statement
- { my $t1 = new Stupid::StatementList();
+ { my $t1 = new Stupid2::StatementList();
$t1->appendStatement($_[1]);
$t1; }
|
- { new Stupid::StatementList(); }
+ { new Stupid2::StatementList(); }
;

statement : decl ';'
@@ -72,11 +72,11 @@
| comment ';'
{ $_[1]; }
| var '=' expr ';'
- { new Stupid::Statement(new Stupid::Set($_[1], $_[3])); }
+ { new Stupid2::Statement(new Stupid2::Set($_[1], $_[3])); }
| 'if' '(' expr ')' '{' statements '}' 'else' '{' statements '}'
{ new Stupid::If($_[3], $_[6], $_[10]); }
| 'while' '(' expr ')' '{' statements '}'
- { new Stupid::While($_[3], $_[6]); }
+ { new Stupid2::While($_[3], $_[6]); }
| call ';'
{ $_[1]; }
;
@@ -90,7 +90,7 @@
| expr 'bor' expr
{ new Stupid::BOr($_[1], $_[3]); }
| expr '==' expr
- { new Stupid2::Equals($_[1], $_[3]); }
+ { new Stupid2::Eq($_[1], $_[3]); }
| expr 'ge8' expr
{ new Stupid::Ge8($_[1], $_[3]); }
| expr 'le8' expr
@@ -139,27 +139,28 @@
exprlist: exprlist ',' expr
{ $_[1]->appendExpr($_[3]); $_[1]; }
| expr
- { my $t = new Stupid::ExprList(); $t->appendExpr($_[1]); $t; }
+ { my $t = new Stupid2::ExprList(); $t->appendExpr($_[1]); $t; }
|
- { new Stupid::ExprList(); }
+ { new Stupid2::ExprList(); }
;

var : WORD
{ $::Context->findSymbol($_[1]); }
| var '[' expr ']'
- { new Stupid::ArrayRef($_[1], $_[3]); }
+ { new Stupid2::ArrayRef($_[1], $_[3]); }
| expr '.' WORD
{ new Stupid::MemberRef($_[1], $_[3]); }
| call
;

call: | expr '(' exprlist ')'
- { new Stupid::FunctionCall($_[1], $_[3]); }
+ { new Stupid2::FunctionCall($_[1], $_[3]); }
;

decl : type vardecl '=' expr
- { new Stupid::Declare($::Context,
- new Stupid::Variable($_[1], $_[2]), $_[4]); }
+ { new Stupid2::Declare($::Context,
+ new Stupid2::Variable($_[1], $_[2]),
+ $_[4]); }
;

type : 'int' '_' bitwidth
@@ -167,7 +168,7 @@
| 'ostream'
{ new Stupid::Type::OStream(); }
| 'array' '(' type ',' VALUE ')'
- { new Stupid::Type::Array($_[3], $_[5]); }
+ { new Stupid2::Type::Array($_[3], $_[5]); }
| 'struct' WORD
{ new Stupid::Type::StructInstance($::Context, $_[2]); }
;
@@ -185,7 +186,7 @@
val_list : val_list ',' expr
{ $_[1]->append($_[3]); $_[1]; }
| expr
- { my $t = new Stupid::ArrayValue(); $t->append($_[1]); $t; }
+ { my $t = new Stupid2::ArrayValue(); $t->append($_[1]); $t; }
| STRING
{ Stupid::ArrayFromString($_[1]); }
;
@@ -199,7 +200,7 @@
;

comment : STRING
- { new Stupid::Comment($_[1]); }
+ { new Stupid2::Comment($_[1]); }
;

%%
=======================================
--- /src/stupid2.pl Sat May 29 09:18:40 2010
+++ /src/stupid2.pl Sat May 29 12:46:57 2010
@@ -38,6 +38,8 @@
#$ptree->value();
#$::Context->dumpSymbols();

+$ptree->deduceWidth();
+
my $wrapped = new Stupid::LanguageWrapper($ptree);
$wrapped->{sourceFile} = $sourceFile;

@@ -92,16 +94,16 @@
# decimal UVALUE
} elsif($code =~ /^([0-9]+)u(.*)$/s) {
$type = 'UVALUE';
- $value = new Stupid::DecimalValue($1);
+ $value = new Stupid2::DecimalValue($1);
$code = $2;
# decimal VALUE
} elsif($code =~ /^([0-9]+)(.*)$/s) {
$type = 'VALUE';
- $value = new Stupid::DecimalValue($1);
+ $value = new Stupid2::DecimalValue($1);
$code = $2;
} elsif($code =~ /^'(.)'(.*)$/s) {
$type = 'CHAR';
- $value = new Stupid::DecimalValue(ord($1));
+ $value = new Stupid2::DecimalValue(ord($1));
$code = $2;
# WORD
} elsif($code =~ /^([A-Za-z][A-Za-z0-9]*)(.*)$/s) {
@@ -161,7 +163,7 @@
return $self;
}

-sub isSigned {
+sub signed {
my $self = shift;

return $self->{signed};
@@ -172,9 +174,99 @@

return $self->{width}->value();
}
+
+package Stupid2::ArrayWidth;
+
+use strict;
+
+sub new {
+ my $class = shift;
+ my $count = shift;
+ my $width = shift;
+
+ my $self = {};
+ bless $self, $class;
+
+ $self->{count} = $count;
+ $self->{width} = $width;
+
+ return $self;
+}
+
+package Stupid2::HasWidth;
+
+# A base class for things with a width, intended for multiple
+# inheritance Anything that inherits from this should be able to
+# figure out its width from its children. If any of its children do
+# not have a width set, then it should be set after
+# deduction. Children should also be checked for consistency.
+
+use strict;
+use Carp;
+
+sub width {
+ my $self = shift;
+
+ confess if !defined $self->{width};
+ return $self->{width};
+}
+
+sub maybeWidth {
+ my $self = shift;
+
+ return $self->{width};
+}
+
+sub bits {
+ my $self = shift;
+
+ return $self->width()->bits();
+}
+
+sub signed {
+ my $self = shift;
+
+ return $self->width()->signed();
+}
+
+sub setWidth {
+ my $self = shift;
+ my $width = shift;
+
+ if(!defined $self->{width}) {
+ $self->{width} = $width;
+ return;
+ } else {
+ croak "Widths don't match" if !$self->{width}->equals($width);
+ }
+ $self->setChildrensWidth($width);
+}
+
+sub maybeSetWidth {
+ my $self = shift;
+ my $width = shift;
+
+ return if !defined $width;
+ $self->setWidth($width);
+}
+
+package Stupid2::HasWidthWithoutDeduction;
+
+# A base class for things with a width that cannot dedice their width
+# from their children. Width should be set from on high.
+
+use strict;
+use base qw(Stupid2::HasWidth);
+
+sub deduceWidth {
+ # can't!
+}

package Stupid2::Type::Int;

+use strict;
+use base qw(Stupid2::HasWidth);
+
sub new {
my $class = shift;
my $width = shift;
@@ -194,9 +286,10 @@
sub ArrayFromString {
my $str = shift;

- my $t = new Stupid::ArrayValue();
+ my $t = new Stupid2::ArrayValue();
foreach my $c (split //, $str) {
- $t->append(new Stupid::DecimalValue(ord($c)));
+ $t->append(new Stupid2::DecimalValue(ord($c),
+ new Stupid2::Bitwidth(8, 0)));
}

return $t;
@@ -291,7 +384,7 @@
return $str;
}

-package Stupid::Function;
+package Stupid2::Function;

use strict;

@@ -322,9 +415,15 @@
return $self->{name};
}

-package Stupid::TopLevelList;
-
-# FIXME: topl-level classes should inherit from a TopLevel class.
+sub deduceWidth {
+ my $self = shift;
+
+ $self->{body}->deduceWidth();
+}
+
+package Stupid2::TopLevelList;
+
+# FIXME: top-level classes should inherit from a TopLevel class.

use strict;

@@ -345,6 +444,14 @@

push @{$self->{topLevels}}, $tl;
}
+
+sub deduceWidth {
+ my $self = shift;
+
+ foreach my $tl (@{$self->{topLevels}}) {
+ $tl->deduceWidth();
+ }
+}

package Stupid::Type::Struct;

@@ -450,7 +557,7 @@
croak "Can't find declaration of $name";
}

-package Stupid::ExprList;
+package Stupid2::ExprList;

use strict;

@@ -478,7 +585,15 @@
return $#{$self->{expressions}} == -1;
}

-package Stupid::FunctionCall;
+sub deduceWidth {
+ my $self = shift;
+
+ foreach my $expr (@{$self->{expressions}}) {
+ $expr->deduceWidth();
+ }
+}
+
+package Stupid2::FunctionCall;

use strict;

@@ -495,6 +610,14 @@

return $self;
}
+
+sub deduceWidth {
+ my $self = shift;
+
+# Don't need to do the function, since that should be done where it is
+# declared.
+ $self->{args}->deduceWidth();
+}

package Stupid::MemberRef;

@@ -514,7 +637,7 @@
return $self;
}

-package Stupid::Comment;
+package Stupid2::Comment;

use strict;

@@ -530,11 +653,7 @@
return $self;
}

-sub value {
- my $self = shift;
-
- print "# $self->{comment}\n";
- return undef;
+sub deduceWidth {
}

package Stupid::ArgList;
@@ -575,11 +694,10 @@
}
}

-package Stupid::ArrayRef;
+package Stupid2::ArrayRef;

use strict;
-
-# A followed by B (as in two statements). No value.
+use base qw(Stupid2::HasWidth);

sub new {
my $class = shift;
@@ -595,22 +713,14 @@
return $self;
}

-sub value {
+sub deduceWidth {
my $self = shift;

- # FIXME range checking
- return $self->{array}->value()->[$self->{offset}->value()];
+ $self->{offset}->deduceWidth();
+ $self->maybeSetWidth($self->{array}->memberWidth());
}

-sub setValue {
- my $self = shift;
- my $value = shift;
-
- # FIXME range checking
- return $self->{array}->value()->[$self->{offset}->value()] = $value;
-}
-
-package Stupid::StatementList;
+package Stupid2::StatementList;

use strict;

@@ -632,17 +742,17 @@
push @{$self->{statements}}, $statement;
}

-sub value {
+sub deduceWidth {
my $self = shift;

for my $s (@{$self->{statements}}) {
- $s->value();
+ $s->deduceWidth();
}

return undef;
}

-package Stupid::Statement;
+package Stupid2::Statement;

use strict;

@@ -657,6 +767,12 @@

return $self;
}
+
+sub deduceWidth {
+ my $self = shift;
+
+ $self->{expr}->deduceWidth();
+}

package Stupid::If;

@@ -678,7 +794,7 @@
return $self;
}

-package Stupid::While;
+package Stupid2::While;

use strict;

@@ -696,11 +812,18 @@
return $self;
}

-package Stupid::Set;
-
-use strict;
-
-# A = B
+sub deduceWidth {
+ my $self = shift;
+
+ $self->{cond}->deduceWidth();
+ $self->{body}->deduceWidth();
+}
+
+package Stupid2::Binary;
+
+use strict;
+use base qw(Stupid2::HasWidth);
+use Carp;

sub new {
my $class = shift;
@@ -716,17 +839,26 @@
return $self;
}

-sub value {
+sub deduceWidth {
my $self = shift;

- return $self->{left}->setValue($self->{right}->value());
+ $self->{left}->deduceWidth();
+ $self->{right}->deduceWidth();
+
+ $self->{left}->maybeSetWidth($self->{right}->maybeWidth());
+ $self->{right}->maybeSetWidth($self->{left}->maybeWidth());
}

-package Stupid::And32;
+package Stupid2::Set;
+
+# A = B

use strict;
-
-# Unsigned decimal value, any length
+use base qw(Stupid2::Binary);
+
+package Stupid::And32;
+
+use strict;

sub new {
my $class = shift;
@@ -746,8 +878,6 @@

use strict;

-# Unsigned decimal value, any length
-
sub new {
my $class = shift;
my $l = shift;
@@ -766,8 +896,6 @@

use strict;

-# Unsigned decimal value, any length
-
sub new {
my $class = shift;
my $l = shift;
@@ -787,8 +915,6 @@

use strict;

-# Unsigned decimal value, any length
-
sub new {
my $class = shift;
my $l = shift;
@@ -803,12 +929,10 @@
return $self;
}

-package Stupid2::Equals;
+package Stupid2::Eq;

use strict;

-# Unsigned decimal value, any length
-
sub new {
my $class = shift;
my $l = shift;
@@ -827,8 +951,6 @@

use strict;

-# Unsigned decimal value, any length
-
sub new {
my $class = shift;
my $l = shift;
@@ -848,8 +970,6 @@

use strict;

-# Unsigned decimal value, any length
-
sub new {
my $class = shift;
my $l = shift;
@@ -869,8 +989,6 @@

use strict;

-# Unsigned decimal value, any length
-
sub new {
my $class = shift;
my $l = shift;
@@ -889,8 +1007,6 @@

use strict;

-# Unsigned decimal value, any length
-
sub new {
my $class = shift;
my $l = shift;
@@ -916,8 +1032,6 @@

use strict;

-# Unsigned decimal value, any length
-
sub new {
my $class = shift;
my $l = shift;
@@ -943,8 +1057,6 @@

use strict;

-# Unsigned decimal value, any length
-
sub new {
my $class = shift;
my $l = shift;
@@ -971,8 +1083,6 @@

use strict;

-# Unsigned decimal value, any length
-
sub new {
my $class = shift;
my $l = shift;
@@ -999,8 +1109,6 @@

use strict;

-# Unsigned decimal value, any length
-
sub new {
my $class = shift;
my $l = shift;
@@ -1025,27 +1133,12 @@
package Stupid2::Ne;

use strict;
-
-sub new {
- my $class = shift;
- my $l = shift;
- my $r = shift;
-
- my $self = {};
- bless $self, $class;
-
- $self->{left} = $l;
- $self->{right} = $r;
-
- return $self;
-}
+use base qw(Stupid2::Binary);

package Stupid::Mask32To8;

use strict;

-# Unsigned decimal value, any length
-
sub new {
my $class = shift;
my $operand = shift;
@@ -1062,8 +1155,6 @@

use strict;

-# Unsigned decimal value, any length
-
sub new {
my $class = shift;
my $operand = shift;
@@ -1080,8 +1171,6 @@

use strict;

-# Unsigned decimal value, any length
-
sub new {
my $class = shift;
my $operand = shift;
@@ -1098,8 +1187,6 @@

use strict;

-# Unsigned decimal value, any length
-
sub new {
my $class = shift;
my $operand = shift;
@@ -1116,8 +1203,6 @@

use strict;

-# Unsigned decimal value, any length
-
sub new {
my $class = shift;
my $l = shift;
@@ -1142,20 +1227,7 @@
package Stupid2::Plus;

package Stupid::WrapPlus32;

@@ -1204,8 +1276,6 @@

use strict;

-# Unsigned decimal value, any length
-
sub new {
my $class = shift;
my $l = shift;
@@ -1231,8 +1301,6 @@

use strict;

-# Unsigned decimal value, any length
-
sub new {
my $class = shift;
my $l = shift;
@@ -1247,9 +1315,10 @@
return $self;
}

-package Stupid::Declare;
+package Stupid2::Declare;

use strict;
+use base qw(Stupid2::HasWidth);

# declaration of a variable

@@ -1293,6 +1362,14 @@

return $self->{var}->findMember($member);
}
+
+sub deduceWidth {
+ my $self = shift;
+
+ $self->{var}->deduceWidth();
+ $self->{var}->maybeSetWidth($self->{init}->maybeWidth());
+ $self->{init}->maybeSetWidth($self->{var}->maybeWidth());
+}

package Stupid::Type::OStream::Put;

@@ -1394,7 +1471,7 @@
return $self->{value};
}

-package Stupid::Type::Array;
+package Stupid2::Type::Array;

use strict;
use Carp;
@@ -1421,9 +1498,22 @@
# FIXME check size and type of each value
}

-package Stupid::Variable;
+sub memberWidth {
+ my $self = shift;
+
+ return $self->{type}->width();
+}
+
+sub width {
+ my $self = shift;
+
+ return new Stupid2::ArrayWidth($self->{size}, $self->{type}->width());
+}
+
+package Stupid2::Variable;

use strict;
+use base qw(Stupid2::HasWidth);
use Carp;

# A variable of some type
@@ -1442,27 +1532,12 @@

return $self;
}
-
-sub setValue {
- my $self = shift;
- my $value = shift;
-
- confess "value is null" if !defined $value;
- $self->{type}->checkValue($value);
- $self->{value} = $value;
-}

sub name {
my $self = shift;

return $self->{name};
}
-
-sub value {
- my $self = shift;
-
- return $self->{value};
-}

sub markAsReturn {
my $self = shift;
@@ -1482,6 +1557,19 @@

return $self->{type}->findMember($member);
}
+
+sub deduceWidth {
+ my $self = shift;
+
+ $self->{width} = $self->{type}->width();
+ croak if !defined $self->{width};
+}
+
+sub memberWidth {
+ my $self = shift;
+
+ return $self->{type}->memberWidth();
+}

package Stupid::HexValue;

@@ -1517,21 +1605,22 @@
return $self->{value}->bior($right);
}

-package Stupid::DecimalValue;
+package Stupid2::DecimalValue;

use strict;
+use base qw(Stupid2::HasWidthWithoutDeduction);
use Math::BigInt;

-# Unsigned decimal value, any length
-
sub new {
my $class = shift;
my $value = shift;
+ my $width = shift;

my $self = {};
bless $self, $class;

$self->{value} = new Math::BigInt($value);
+ $self->{width} = $width;

return $self;
}
@@ -1542,13 +1631,12 @@
return $self->{value};
}

-package Stupid::ArrayValue;
+package Stupid2::ArrayValue;

use strict;
+use base qw(Stupid2::HasWidth);
use Math::BigInt;

-# Unsigned decimal value, any length
-
sub new {
my $class = shift;

@@ -1567,7 +1655,7 @@
push @{$self->{values}}, $value;
}

-sub value {
+sub values {
my $self = shift;

return $self->{values};
=======================================
--- /test2/ostream-variable.stupid Sat May 29 09:29:21 2010
+++ /test2/ostream-variable.stupid Sat May 29 12:46:57 2010
@@ -4,4 +4,3 @@
int_8u x=65;
o.put(x);
}
-
=======================================
--- /test2/ostream.stupid Sat May 29 09:30:02 2010
+++ /test2/ostream.stupid Sat May 29 12:46:57 2010
@@ -1,11 +1,11 @@
"EXPECT:Hello, world!";

function(ostream out) test() {
- array(uint8, 13) hello = [ "Hello, world!" ];
- uint32 n = 0;
-
- while(n ne32 13) {
+ array(int_8u, 13) hello = [ "Hello, world!" ];
+ int_32u n = 0;
+
+ while(n != 13) {
out.put(hello[n]);
- n = n plus32 1;
+ n = n + 1;
}
}

==============================================================================
Revision: 71f7862274
Author: Ben Laurie <b...@links.org>
Date: Sat May 29 12:59:33 2010
Log: Another test passes.
http://code.google.com/p/stupid-crypto/source/detail?r=71f7862274

Modified:
/src/Stupid2/C.pm
/src/grammar2.y
/src/stupid2.pl
/test2/if.stupid

=======================================
--- /src/Stupid2/C.pm Sat May 29 12:46:57 2010
+++ /src/Stupid2/C.pm Sat May 29 12:59:33 2010
@@ -93,6 +93,18 @@
$self->{args}->emitParameters();
print ");\n";
}
+
+sub Stupid2::If::emitCode {
+ my $self = shift;
+
+ print 'if (';
+ $self->{cond}->emitCode();
+ print ") {\n";
+ $self->{then}->emitCode();
+ print "} else {\n";
+ $self->{else}->emitCode();
+ print "}\n";
+}

sub Stupid2::While::emitCode {
my $self = shift;
@@ -249,6 +261,12 @@
print $self->{value};
print 'U' if !$self->signed();
}
+
+sub Stupid2::DecimalValue::emitParameter {
+ my $self = shift;
+
+ $self->emitCode();
+}

sub Stupid2::Eq::emitCode {
my $self = shift;
=======================================
--- /src/grammar2.y Sat May 29 12:46:57 2010
+++ /src/grammar2.y Sat May 29 12:59:33 2010
@@ -74,7 +74,7 @@
| var '=' expr ';'
{ new Stupid2::Statement(new Stupid2::Set($_[1], $_[3])); }
| 'if' '(' expr ')' '{' statements '}' 'else' '{' statements '}'
- { new Stupid::If($_[3], $_[6], $_[10]); }
+ { new Stupid2::If($_[3], $_[6], $_[10]); }
| 'while' '(' expr ')' '{' statements '}'
{ new Stupid2::While($_[3], $_[6]); }
| call ';'
@@ -193,6 +193,8 @@

value : arrayval
| VALUE
+ | VALUE '_' bitwidth
+ { $_[1]->setWidth($_[3]); $_[1]; }
| CHAR
;

=======================================
--- /src/stupid2.pl Sat May 29 12:46:57 2010
+++ /src/stupid2.pl Sat May 29 12:59:33 2010
@@ -774,7 +774,7 @@
$self->{expr}->deduceWidth();
}

-package Stupid::If;
+package Stupid2::If;

use strict;

@@ -793,6 +793,14 @@

return $self;
}
+
+sub deduceWidth {
+ my $self = shift;
+
+ $self->{cond}->deduceWidth();
+ $self->{then}->deduceWidth();
+ $self->{else}->deduceWidth();
+}

package Stupid2::While;

@@ -932,20 +940,7 @@
package Stupid2::Eq;

package Stupid::Le8;

=======================================
--- /test2/if.stupid Sat May 29 09:18:40 2010
+++ /test2/if.stupid Sat May 29 12:59:33 2010
@@ -1,9 +1,11 @@
"EXPECT:B";

function(ostream out) test() {
- if(1 == 2) {
- out.put(67);
+ int_8u x = 1;
+
+ if(x == 2) {
+ out.put(67_8u);
} else {
- out.put(66);
+ out.put(66_8u);
}
}

Reply all

Reply to author

Forward

0 new messages