User:Nthern/archive

Archive for User:nthern

/// interpreter in perl
Here is my perl interpreter of /// and its sister language itflabtijtslwi. I use this almost exclusively for debugging. Debug mode uses colored highlighting to help show matches and output.

slashes.pl # # # # use Term::ANSIColor; use Term::Cap; use strict; use Getopt::Std; my $t = Term::Cap->Tgetent({ OSPEED => 9600 }); our $opt_d; our $opt_i; getopts('di'); $| = 1; $_ = join '', <>; while (1) { if ($opt_i && s!^GG((?:[^/\\]|\\.)*?)GG!!s) { my $s = $1; my $d = getc; $d = "" unless defined $d; debug2($s, $d, $_); $s =~ s/\\(.)/$1/gs; no warnings; while ($s eq "") { }; while (s/\Q$s\E/$d/) { }  } elsif (s!^([^/\\]+)!! or s!^\\(.)!!s) { print($1); print "\n", color('white on_blue'), "[", color('reset'), $_, color('white on_blue'), "]", color('reset'), "\n", color('red on_white'), "---", color('reset'), "\n" if $opt_d; } else { my $s = ""; my $d = ""; s#^/## or last; $s .= $& while s#^(?:[^/\\]+|(?:\\.)+)##s; s#^/## or last; $d .= $& while s#^(?:[^/\\]+|(?:\\.)+)##s; s#^/## or last; debug1($s, $d, $_); $s =~ s/\\(.)/$1/gs; $d =~ s/\\(.)/$1/gs; while ($s eq "") { }; while (s/\Q$s\E/$d/) { } } } sub debug1 { if ($opt_d) { my $s = shift; my $d = shift; my @c = ; my $r = shift; my $s3 = $s; my $d3 = $d; $s3 =~ s/\\(.)/$1/gs; #$d3 =~ s/\\(.)/$1/gs; for my $fg (qw/black red green yellow blue magenta cyan white/) { push @c, []; for my $bg (map { "on_$_" }                  qw/black red green yellow blue magenta cyan white/) { push @{$c[-1]}, color("$fg $bg"); }    }     my $s4 = $c[1][0]. $s3. color('reset'); $s4 =~ s/ \n / color('reset'). $t->Tputs("ce"). "\n". $c[1][0] /gexs; my $m = ($r =~ s/\Q$s3\E/$s4/gs); my $sc = $c[7][4]; my $s2 = $sc. $s; $s2 =~ s/ \n / color('reset'). $t->Tputs("ce"). "\n". $sc /gexs; my $dc = $c[5][4]; my $d2 = $dc. $d; $d2 =~ s/ \n / color('reset'). $t->Tputs("ce"). " \n". $dc /gexs; print(($m ? $c[0][2] : $c[0][1] ) . "/$s2$c[4][7]/$d2$c[4][5]/"); print color('reset'), "$r\n", $c[1][7], "---", color('reset'), "\n"; } } sub debug2 { if ($opt_d) { my $s = shift; my $d = shift; my @c = ; my $r = shift; my $s3 = $s; my $d3 = $d; $s3 =~ s/\\(.)/$1/gs; for my $fg (qw/black red green yellow blue magenta cyan white/) { push @c, []; for my $bg (map { "on_$_" }                  qw/black red green yellow blue magenta cyan white/) { push @{$c[-1]}, color("$fg $bg"); }    }     my $s4 = $c[1][0]. $s3. color('reset'); $s4 =~ s/ \n / color('reset'). $t->Tputs("ce"). "\n". $c[1][0] /gexs; my $m = ($r =~ s/\Q$s3\E/$s4/gs); my $sc = $c[7][4]; my $s2 = $sc. $s; $s2 =~ s/ \n / color('reset'). $t->Tputs("ce"). "\n". $sc /gexs; my $dc = $c[5][4]; my $d2 = $dc. $d; $d2 =~ s/ \n / color('reset'). $t->Tputs("ce"). " \n". $dc /gexs; print(($m ? $c[0][2] : $c[0][1] ) . "GG$s2$c[4][7]GG$d2$c[4][5]GG"); print color('reset'), "$r\n", $c[1][7], "---", color('reset'), "\n"; } }
 * 1) !/usr/bin/perl -w
 * 2) /// (a.k.a. "Slashes") interpreter
 * 3) by Nathan Thern
 * 1) see http://esolangs.org/wiki/Slashes for more information about ///
 * 1) options:
 * 1) -d = debug mode
 * 2) -i = itflabtijtslwi mode - implement character input extension
 * 1) license: Public Domain

/// interpreter in C
Here is my C interpreter of /// (and itflabtijtslwi). It uses the glib library, which has dynamically re-sized strings and regular expressions. Compile it like this:

$ gcc -o slashes slashes.c $(pkg-config --cflags --libs glib-2.0)

slashes.c /* /// (a.k.a. "Slashes") interpreter by Nathan Thern see http://esolangs.org/wiki/Slashes for more information about /// license: Public Domain */ int main (int argc, char** argv) { GString *data; GString *src; GString *dest; GRegex *inp_regex; GMatchInfo *match_info; int itf; /* if invoked with -h, print help & exit */ if (argc > 1 && !strcmp(*(argv+1), "-h")) { fprintf(stdout, "Rudimentary /// (a.k.a. \"Slashes\") interpreter.\n"); fprintf(stdout, "Usage: %s [-i] [file]\n", *argv); fprintf(stdout, "Options:\n"); fprintf(stdout, " -h\tthis help\n"); fprintf(stdout, " -i\titflabtijtslwi mode: implement character input extension\n"); exit(EXIT_SUCCESS); }  itf = 0; /* check for itflabtijtslwi mode */ if (argc > 1 && !strcmp(*(argv+1), "-i")) { argv++; argc--; itf = 1; /* the regex to look for input */ inp_regex = g_regex_new("^GG((?:[^/\\\\]|\\\\.)*?)GG(.*)$",                            G_REGEX_DOTALL | G_REGEX_DOLLAR_ENDONLY |                             G_REGEX_OPTIMIZE, 0, NULL); }  {     gchar *contents; gsize len; GError *error = NULL; /* read in the source */ if (argc > 1 && strcmp(*(++argv), "-")) { g_file_get_contents(*argv, &contents, &len, &error); } else { g_io_channel_read_to_end(g_io_channel_unix_new(0),                               &contents, &len, &error); }    data = g_string_new(contents); }  /* initialize the src and dest gstrings */ src = g_string_new(""); dest = g_string_new(""); for { if (data->len < 1) { break; } else if (data->str[0] == '/') { /*        this is the bulk of the interpreter: parsing out the "source" & "destination" and then performing the substitutions */      gsize data_i, src_size, dest_size; gchar *last_char, *src_p, *dest_p, *match; gssize match_loc; /* parse to the end of the "source" */ data_i = 1; src_size = 0; src_p = (last_char = data->str + 1); while (data_i < data->len && data->str[data_i] != '/') { src_size++; if (data->str[data_i] == '\\') { data_i++; }        /*           for every \ that has been found in the source the subsequent source characters must be shifted down by 1 if no \ has been found yet, the only thing this line accomplishes is the variable increments */        *last_char++ = data->str[data_i++]; }      if (++data_i >= data->len) { break; }      *last_char = '\0'; /* parse to the end of the "destination" */ /* essentially a repeat of the code above */ dest_p = (last_char = data->str + data_i); dest_size = 0; while (data_i < data->len && data->str[data_i] != '/') { dest_size++; if (data->str[data_i] == '\\') { data_i++; }        *last_char++ = data->str[data_i++]; }      if (data_i >= data->len) { break; }      *last_char = '\0'; /*        src_p and dest_p point to \0 terminated strings within "data". extract them out and shift data down */      g_string_assign(src, src_p); g_string_assign(dest, dest_p); g_string_erase(data, (gssize) 0, (gssize) (data_i + 1)); if (src_size != 0) { gsize src_size2 = src_size - 1; /*          since these operations are expensive and constitute the majority of the work done in this program, pick which operation set to use before entering the substitution loop */        match_loc = 0; if (src_size == dest_size) { /* simply overwrite source with destination */ while ((match = strstr(data->str + match_loc, src->str)) != NULL) { match_loc = match - data->str; g_string_overwrite(data, match_loc, dest->str); /* backtrack src_size-1 characters */ match_loc = match_loc > src_size2 ? match_loc - src_size2 : 0; }        } else if (src_size > dest_size) { /* squeeze out the extra characters in source, then overwrite the rest with destination */ gsize size_diff = src_size - dest_size; while ((match = strstr(data->str + match_loc, src->str)) != NULL) { match_loc = match - data->str; g_string_erase(data, match_loc, (gssize) size_diff); g_string_overwrite(data, match_loc, dest->str); /* backtrack src_size-1 characters */ match_loc = match_loc > src_size2 ? match_loc - src_size2 : 0; }        } else { /* insert characters into data to make room for the extra characters in destination */ gchar *insert_chars = dest->str + src_size; while ((match = strstr(data->str + match_loc, src->str)) != NULL) { match_loc = match - data->str; g_string_insert(data, match_loc, insert_chars); g_string_overwrite(data, match_loc, dest->str); /* backtrack src_size-1 characters */ match_loc = match_loc > src_size2 ? match_loc - src_size2 : 0; }        }       }     } else if (data->str[0] == '\\') { /* un-escape backslashed output */ if (data->len < 2) { break; }      putchar(data->str[1]); fflush(stdout); g_string_erase(data, (gssize) 0, (gssize) 2); } else if (itf && data->len > 1 &&               data->str[0] == 'G' && data->str[1] == 'G' &&                g_regex_match(inp_regex, data->str, 0, &match_info)) { /* itflabtijtslwi-style input */ char ch; if (!feof(stdin)) { ch = getchar; }      if (!feof(stdin)) { g_string_printf(data, "/%s/\\%c/%s",                        g_match_info_fetch(match_info, (gint) 1), ch,                         g_match_info_fetch(match_info, (gint) 2)); } else { g_string_printf(data, "/%s//%s",                        g_match_info_fetch(match_info, (gint) 1),                         g_match_info_fetch(match_info, (gint) 2)); }    } else { /* character output */ putchar(data->str[0]); fflush(stdout); g_string_erase(data, (gssize) 0, (gssize) 1); }  } }
 * 1) include 
 * 2) include 
 * 3) include 
 * 4) include 

Thue-to-/// translator
Translates Thue programs to ///. If the Thue program does any input, the translation is into the itflabtijtslwi dialect.

thue2sss.pl use strict; my $b = "\\"; my $b2 = $b x 2; my $b3 = $b x 3; my $b4 = $b x 4; my $b5 = $b x 5; my $b6 = $b x 6; my $b7 = $b x 7; my @rules = ; while (<>) { s/[\r\n]//g; next if(/^\s*$/); next if (/^\s*#/); last if /^\s*::=\s*$/; /::=/;  push @rules, { LHS => $`, RHS => $' }; } my $data = join '', <>; $data =~ s/^\s+//s; chomp $data; my $part4 = ""; my $part4b = ""; my $have_inp = 0; my $post = 1; for (@rules) { $_->{LHS} = "($b" .    join(")($b", map { $_ = /\/|\\/ ? "<$b4>$b7$_" : $_ } split //, $_->{LHS}) . ")"; if ($_->{RHS} =~ /^~/) { $_->{RHS} = "P${b2}OST". $post. "a$b/". ($_->{RHS} eq "~" ? "\n" : substr($_->{RHS}, 1)). "$b/P${b2}OST". $post. "a$b/P${b2}OST". $post. "b$b/". "$b/$b3/1${b4}X$b3/$b3/$b/$b/". "$b/P${b3}OST". $post. "b$b/"; $post++; } elsif ($_->{RHS} eq ":::") { if (!$have_inp) { my $rhs = "P${b}OST${post}a//{}/<$b4>$b6//2${b}Z/{}/1{}Z{}/2{}Z{}/{}/<{}${b}{}${b}>{}${b}{}${b}{}/<{}${b}{}${b}{}${b}{}${b}>{}${b}{}${b}{}${b}{}${b}{}${b}{}${b}{}/{}/{}<{}${b}{}>{}/{}/{}/C{}${b}C{}/B{}${b}B{}/{}/(B{}${b}B){}/P{}${b}P{}${b}{}/{}${b}{}/{}${b}{}${b}{}${b}{}/P{}${b}P{}${b}{}${b}{}${b}{}/({}${b}{}${b}{}${b}{}${b}\n)(C{}${b}C){}${b}{}/{}${b}{}${b}{}${b}{}/2{}${b}Z{}${b}{}${b}{}${b}{}/{}${b}{}${b}{}${b}{}/{}${b}{}${b}{}${b}{}/G{}${b}GA{}${b}{}${b}{}${b}{}${b}{}${b}{}${b}{}${b}{}${b}AG{}${b}G{}${b}{}${b}{}${b}{}/{}${b}{}${b}{}${b}{}/{}${b}{}${b}{}${b}{}/P{}${b}P{}${b}{}${b}{}${b}{}/P{}${b}OST${post}b{}${b}{}${b}{}${b}{}/{}${b}{}${b}{}${b}{}/G{}${b}{}${b}{}${b}{}${b}{}${b}{}${b}{}${b}{}${b}D{}${b}{}${b}{}${b}{}/P{}${b}OST${post}a{}${b}{}/{}${b}{}/P{}${b}P{}${b}{}/({}${b}{}${b}A{}${b}A)(C{}${b}C){}/GGA{}${b}AGG{}/G{}${b}D{}/G{}D{}/{}/{}2{}${b}{}Z{}/{}2{}Z{}/{}1{}Z//1${b}Z/2Z//<$b2>$b2/<$b4>$b6//<${b}>///G${b}D/(CC)//2${b}Z/2Z/1Z/${b}/1${b2}X${b}/${b}////P${b}OST${post}b/"; $rhs =~ s/(\/|\\)/\\$1/sg; $rhs =~ s/\{\}/\{\\\}/sg; $rhs =~ s/([12])Z/$1\\Z/sg; $rhs =~ s/CC/C\\C/sg; $part4b = "[[ /(I${b}N${b}P0)/$rhs/\n";      $have_inp = 1;     }     $_->{RHS} = <<"PART4INP"; [[ (I${b}NP$post)P${b}OST${post}a/ [[ /(I${b2}NP/(WAIT/ [[ /P${b}OST${post}a/P${b}OST${post}b/ [[ /\\\/1\\\\X\\\/\\\/// [[ /P${b}OST${post}b/ PART4INP     $_->{RHS} =~ s/(\/|\\)/\\$1/sg;     $_->{RHS} =~ s/\n$//s;     $part4 .= "[[ /$_->{LHS}/$_->{RHS}/\n";     $part4 .= "[[ /(W${b}AIT$post)/$_->{LHS}/\n";     $part4 .= "[[ /I${b}N${b}P$post/I${b}N${b}P0/\n";     $post++;     next;   } else {     $_->{RHS} = "($b" .       join(")($b", map { $_ = /\/|\\/ ? "<$b4>$b6$b$_" : $_ }            split //, $_->{RHS}) . ")" .              "P${b2}OST" . $post . "a$b/" .                "$b/P${b2}OST" . $post . "a$b/P${b2}OST" . $post . "b$b/" .                  "$b/$b3/1${b4}X$b3/$b3/$b/$b/" .                    "$b/P${b3}OST" . $post . "b$b/";     $post++;   }   $part4 .= "[[ /$_->{LHS}/$_->{RHS}/\n"; } $part4 = $part4 . $part4b; my $part1 = <<'PART1'; / [[ // [[ /./<\\\\>\\\\\\/ [[ /2X/ [[ ./1.\X./2.X./ [[ ./<.\.\>.\.\./<.\.\.\.\>.\.\.\.\.\.\./ [[ ./<.\>././ PART1 my $part2 = $part4; my $qs = "."; if ($part4 =~ /\Q$qs\E/) {   $qs = "<>"; } $part2 =~ s/(\\|\/)/$qs$1/gs; my $part3 = <<'PART3'; [[ ./D.\ATA./D.ATA./ [[ ./1.\X././ [[ ./2.\X./2.X./ [[ 1.X [[ / [[ /1\X/2X/ [[ /<\\>\\/<\\\\>\\\\\\/ [[ /<\>// PART3 $part1 =~ s/\./$qs/gs; $part3 =~ s/\./$qs/gs; my $part5 = "[[ /D\\ATA/\n"; my $part6 = "[[ (" . join(")(", split //, $data) . ")\n"; my $part7 = <<'PART7'; [[ / [[ /1\X// [[ /2\X/2X/ [[ 1X PART7 chomp $part7; print "$part1$part2$part3$part4$part5$part6$part7";
 * 1) !/usr/bin/perl
 * 1) Thue to /// (a.k.a. "Slashes") translator
 * 2) The resultant /// program is deterministic, regardless of whether
 * 3)  the source Thue program is deterministic or not. Most useful Thue
 * 4)  programs are deterministic (or converge on deterministic results)
 * 1) read in the rules
 * 1) read in the data
 * 1) print $part4;exit;

BCT interpreter in ///
This version of BCT in /// prints 0's & 1's instead of / & \:

nbct.sss /PROGRAM/00111//DATA/101//] [//] [/./<\\\\>\\\\\\/] [/,/{\\\\}\\\\\\/] [/] [2X] [/] [./.1.X./.2.X./] [./.<.\.\.>.\.\./.<.\.\.\.\.>.\.\.\.\.\.\./] [./.<.\.>././] [./.D.\.D.E.S.T./.D.D.E.S.T./] [./.D.\.D.2./.D,D.E.S.T./] [./.{.\.\.}.\.\./.{.\.\.\.\.}.\.\.\.\.\.\./] [./.{.\.}././] [./.\./.D.\.A.T.A.E.\.N.D.D.A.T./] [.\./.\./.1.\.X.\.\.\./.\./.Z.\.Z.\.\.\./.\./] [.\./.1.\.\.X.\./.\./] [./] [./.D.A.\.T.A./././.E.N.\.D.D.A.T./. ./] [.D,D.2] [./.P.\.R.O.G.0./] [.\./.G.\.O.R.P.\./.0.G.\.\.\.\.O.R.P.\./] [.\./.A.\.T.A.0.\./.A.\.\.\.\.T.A.\./] [.\./.A.\.T.A.1.\./.A.\.\.\.\.T.A.\./] [.\./.P.\.D.E.S.T.\./.P.\.\.R.O.G] [./] [./.P.\.R.O.G.1.0./] [.\./.G.\.O.R.P.\./.1.0.G.\.\.\.\.O.R.P.\./] [.\./.D.\.I.E.1.\./.E.\.N.D.\.\.\./.0.E.\.\.\.\.\.\.\.\.N.D.\.\.\./.\.\.\./] [.K.I.L.L.\./] [.\./.P.\.D.E.S.T.\./.P.\.\.R.O.G] [./] [./.P.\.R.O.G.1.1./] [.\./.G.\.O.R.P.\./.1.1.G.\.\.\.\.O.R.P.\./] [.\./.D.\.I.E.1.\./.E.\.N.D.\.\.\./.1.E.\.\.\.\.\.\.\.\.N.D.\.\.\./.\.\.\./] [.K.I.L.L.\./] [.\./.P.\.D.E.S.T.\./.P.\.\.R.O.G] [./] [.P.D.E.S.T./] [./.D.I.E.D,D.2././] [./.2.\.X./.2.X./] [.1.X] [/] [/1X/2X/] [/<\\>\\/<\\\\>\\\\\\/] [/<\>//] [/D\DEST/D,ATADATAEND,DAT/] [/D\D2/DDEST/] [/{\\}\\/{\\\\}\\\\\\/] [/{\}//] [/\/D\ATAE\NDDAT/] [\/\/1\X\\\/\/Z\Z\\\/\/] [\/1\\X\/\/] [/] [/DA\TA///EN\DDAT/ /] [DD2] [/P\ROG0/] [\/G\ORP\/0G\\\\ORP\/] [\/A\TA0\/A\\\\TA\/] [\/A\TA1\/A\\\\TA\/] [\/P\DEST\/P\\ROG] [/] [/P\ROG10/] [\/G\ORP\/10G\\\\ORP\/] [\/D\IE1\/E\ND\\\/0E\\\\\\\\ND\\\/\\\/KILL\/] [\/P\DEST\/P\\ROG] [/] [/P\ROG11/] [\/G\ORP\/11G\\\\ORP\/] [\/D\IE1\/E\ND\\\/1E\\\\\\\\ND\\\/\\\/KILL\/] [\/P\DEST\/P\\ROG] [/] [PROGPROGRAMGORP/] [/DIEDD2//] [/2\X/2X/] [1X

BCT interpreter in itflabtijtslwi 1
I modified my BCT interpreter in /// to accept input:

nbct.itf /] [//] [/./<\\\\>\\\\\\/] [/2A/.G.G.b.b.G.G] [./.0.c.c./.\./.G.O.R.P.\./.0.g.o.r.p.\././] [./.1.c.c./.\./.G.O.R.P.\./.1.g.o.r.p.\././] [./. .c.c./.\./.1.\.A.\.\.\./.2.\./.\.\.\./.z.z.\.\.\./.\.\.\./.\.\.\./.2.\././] [.b.b.c.c./.g.o.r.p./.G.\.O.R.P./] [./.1.A./.2.A././.<.\.\.>.\.\./.<.\.\.\.\.>.\.\.\.\.\.\./] [./.<.\.>./././.2.\.A./.2.A./.1.A/] [GGbbGG/0cc/\/GORP\/0gorp\///1cc/\/GORP\/1gorp\/// cc/\/1\A\\\/2\/\\\/zz\\\/\\\/\\\/2\//bbcc/gorp/G\ORP//1A/2A/] [/<\\>\\/<\\\\>\\\\\\//<\>///2\A/2A/1A] [/2B/.G.G.d.d.G.G./.0.e.e./.\./.E.N.D.,.\./.0.e.,.n.,.d.\././] [./.1.e.e./.\./.E.N.D.,.\./.1.e.,.n.,.d.\./././. .e.e./.\./.1.\.B.\.\.\./.,.\./.\.\.\./.y.y.\.\.\./.\.\.\./.\.\.\./.,.\././] [.d.d.e.e./.e.,.n.,.d./.E.\.N.D.,././.1.B./.2.B./] [./.<.\.\.>.\.\./.<.\.\.\.\.>.\.\.\.\.\.\././.<.\.>./././.2.\.B./.2.B./.1.B/] [GGddGG/0ee/\/END,\/0e,n,d\///1ee/\/END,\/1e,n,d\/// ee/\/1\B\\\/,\/\\\/yy\\\/\\\/\\\/,\//ddee/e,n,d/E\ND,//1B/2B/] [/<\\>\\/<\\\\>\\\\\\//<\>///2\B/2B/1B] [/,/{\\\\}\\\\\\/] [/2X/] [./.1.X./.2.X./] [./.<.\.\.>.\.\./.<.\.\.\.\.>.\.\.\.\.\.\./] [./.<.\.>././] [./.D.\.D.E.S.T./.D.D.E.S.T./] [./.D.\.D.2./.D,D.E.S.T./] [./.{.\.\.}.\.\./.{.\.\.\.\.}.\.\.\.\.\.\./] [./.{.\.}././] [./.\./.D.\.A.T.A.E.\.N.D.D.A.T./] [.\./.\./.1.\.X.\.\.\./.\./.Z.\.Z.\.\.\./.\./] [.\./.1.\.\.X.\./.\./] [./] [./.D.A.\.T.A./././.E.N.\.D.D.A.T./. ./] [.D,D.2] [./.P.\.R.O.G.0./] [.\./.G.\.O.R.P.\./.0.G.\.\.\.\.O.R.P.\./] [.\./.A.\.T.A.0.\./.A.\.\.\.\.T.A.\./] [.\./.A.\.T.A.1.\./.A.\.\.\.\.T.A.\./] [.\./.P.\.D.E.S.T.\./.P.\.\.R.O.G] [./] [./.P.\.R.O.G.1.0./] [.\./.G.\.O.R.P.\./.1.0.G.\.\.\.\.O.R.P.\./] [.\./.D.\.I.E.1.\./.E.\.N.D.\.\.\./.0.E.\.\.\.\.\.\.\.\.N.D.\.\.\./.\.\.\./] [.K.I.L.L.\./] [.\./.P.\.D.E.S.T.\./.P.\.\.R.O.G] [./] [./.P.\.R.O.G.1.1./] [.\./.G.\.O.R.P.\./.1.1.G.\.\.\.\.O.R.P.\./] [.\./.D.\.I.E.1.\./.E.\.N.D.\.\.\./.1.E.\.\.\.\.\.\.\.\.N.D.\.\.\./.\.\.\./] [.K.I.L.L.\./] [.\./.P.\.D.E.S.T.\./.P.\.\.R.O.G] [./] [.P.D.E.S.T./] [./.D.I.E.D,D.2././] [./.2.\.X./.2.X./] [.1.X] [/] [/1X/2X/] [/<\\>\\/<\\\\>\\\\\\/] [/<\>//] [/D\DEST/D,ATADATAEND,DAT/] [/D\D2/DDEST/] [/{\\}\\/{\\\\}\\\\\\/] [/{\}//] [/\/D\ATAE\NDDAT/] [\/\/1\X\\\/\/Z\Z\\\/\/] [\/1\\X\/\/] [/] [/DA\TA///EN\DDAT/ /] [DD2] [/P\ROG0/] [\/G\ORP\/0G\\\\ORP\/] [\/A\TA0\/A\\\\TA\/] [\/A\TA1\/A\\\\TA\/] [\/P\DEST\/P\\ROG] [/] [/P\ROG10/] [\/G\ORP\/10G\\\\ORP\/] [\/D\IE1\/E\ND\\\/0E\\\\\\\\ND\\\/\\\/KILL\/] [\/P\DEST\/P\\ROG] [/] [/P\ROG11/] [\/G\ORP\/11G\\\\ORP\/] [\/D\IE1\/E\ND\\\/1E\\\\\\\\ND\\\/\\\/KILL\/] [\/P\DEST\/P\\ROG] [/] [PROGGORP/] [/DIEDD2//] [/2\X/2X/] [1X

BCT interpreter in itflabtijtslwi 2
Create bct_thue.itf with this command: $ wget http://yiap.nfshost.com/esoteric/thue/bct.t $ perl thue2sss.pl bct.t > bct_thue.itf Run it like this: $ echo -e 00111\\n101 | ./slashes -i bct_thue.itf

BCT interpreter in itflabtijtslwi 3
Create nbct_thue.itf from nbct.t with this command: $ perl thue2sss.pl nbct.t > nbct_thue.itf Run it like this: $ echo -e 00111\\n101 | ./slashes -i nbct_thue.itf

Befunge(-93) interpreter in perl with bignums
I copied somebody's perl Befunge(-93) interpreter and added bignums to make this

bigbef.pl use strict; use warnings 'all'; use integer; use Math::BigInt; my $W = 80; my $H = 25; my @page; my @stack; my $x = 0; my $y = 0; my $dx = 1; my $dy = 0; my $strmode = 0; my $DEBUG = 0; sub	debug { 	print "Debug: x=$x y=$y dir='", qw(^ < > v)[($dx + 3 * $dy + 3) / 2], "' cmd='", defined $page[$y][$x] ? (chr $page[$y][$x]). "'($page[$y][$x])" : "undef'", " stack=|", (join '|', @stack, ""), "\n"; } sub	error { print "Error: @_\n"; debug; exit 1; } sub	check { my ($x, $y) = @_; error "$x:$y is out of page" if $x < 0 || $x >= $W || $y < 0 || $y >= $H; } sub	spop { $#stack < 0 ? Math::BigInt->new(0) : pop @stack; } sub	spush { push @stack, @_; } open F, $ARGV[0]	or die "error open $ARGV[0]: $!"; while () { s/[\r\n]+//; error "line $. too long"	if length > $W; push @page, [ map { ord } split // ]; error "too many lines"		if @page > $H; } close F or die "error close $ARGV[0]: $!"; my %cmd = ( ' ' => sub {}, 	'>' => sub { $dx = 1; $dy =  0; }, 	'<' => sub { $dx = -1; $dy =  0; }, 	'^' => sub { $dx =  0; $dy = -1; }, 	'v' => sub { $dx =  0; $dy =  1; }, 	'|' => sub { $dx = 0; $dy = spop ? -1 : 1; }, 	'_' => sub { $dx = spop ? -1 : 1; $dy = 0; }, 	'+' => sub { spush spop + spop; }, 	'-' => sub { my $a = spop; spush spop - $a; }, 	'*' => sub { spush spop * spop; }, 	'/' => sub { my $a = spop;                  $a or error "divide by zero"; spush spop / $a; }, 	'%' => sub { my $a = spop;                  $a or error "module by zero"; spush spop % $a; }, 	'\\'=> sub { my ($a, $b) = (spop, spop); spush $a, $b; }, 	'.' => sub { print spop, " "; }, 	',' => sub { print chr(spop); }, 	'"' => sub { $strmode = !$strmode; },     ':' => sub { my $a = spop; spush $a, $a; },     '!' => sub { spush(Math::BigInt->new(spop == 0 ? 1 : 0)); }, 	'`' => sub { my $a = spop; spush(Math::BigInt->new(spop > $a ? 1 : 0)); }, 	'#' => sub { $x += $dx; $y += $dy; }, '$' => sub { spop; }, '?' => sub { ($dx, $dy) = @{ ([1,0], [-1,0], [0,1], [0,-1])[rand 4] }; }, '&' => sub { spush Math::BigInt->new( + 0); }, '~' => sub { local $/ = \1; spush(Math::BigInt->new(ord )); }, 'g' => sub { my ($y, $x) = (spop, spop); check $x, $y; spush defined $page[$y][$x] ? Math::BigInt->new($page[$y][$x]) : Math::BigInt->new(0); }, 	'p' => sub { my ($y, $x, $z) = (spop, spop, spop); check $x, $y; die "p error!\n" if $z >= 256 or $z < 0; $page[$y][$x] = $z; }, 	'@' => sub { exit; }, ); for { 	debug	if $DEBUG; 	$_ = $page[$y][$x]; 	$_ = defined && $_ ? chr $_ : ' '; 	if ($strmode && $_ ne '"') { 		spush(Math::BigInt->new(ord $_)); 	} elsif (/\d/) { 		spush(Math::BigInt->new($_)); 	} elsif (exists $cmd{$_}) { 		$cmd{$_} ; 	} else { 		error "unknown command"; 	} 	$x = ($x + $dx + $W) % $W; 	$y = ($y + $dy + $H) % $H; }
 * 1) ! /usr/bin/perl

Befunge(-93) interpreter in C with bignums
I copied somebody's C Befunge(-93) interpreter and added gmp to make this

bigbef_me.pl pcell_t	page[H * W]; scell_t	stack[STACKSIZE]; int	x, y, dx, dy, strmode; unsigned long stackptr; int	isdebug = 0; void	debug (void) {  int	i; printf ("\nDebug: x=%d y=%d dir='%c' cmd='%c'(%d) stack=|", x, y,          "^<>v"[(dx + dy * 3 + 3) >> 1], CUR, (int)CUR); for (i = 0; i < stackptr; i++) gmp_printf (scell_fmt "|", stack[i]); } void	error (char *msg) {  printf ("\nError: %s", msg); debug ; printf ("\n"); exit (1); /* UNREACH */ }  if (stackptr < STACKSIZE)                     \ mpz_set(stack[stackptr++], (val));         \ else                                         \ error ("stack overflow") if (stackptr < STACKSIZE)                    \ mpz_set_si(stack[stackptr++], (val));      \ else                                         \ error ("stack overflow")                   \ if (stackptr)                                \ mpz_set((val), stack[--stackptr]);         \ else                                         \ mpz_set_ui((val), 0) int	main (int argc, char **argv) {  FILE	*f; scell_t	a, b;  int	c, d, ch; if (argc < 2) { printf ("Usage:\n\t%s befunge-source\n", argv[0]); return 1; }  f = fopen (argv[1], "r"); if (!f) error ("couldn't open input file"); for (y = 0; y < H; y++) for (x = 0; x < W; x++) CUR = ' '; x = y = 0; for { ch = fgetc (f); if (ch == EOF) break; if (ch == '\n') { x = 0; ++y; } else { if (y >= H)        error ("too many lines"); if (x >= W)        error ("line too long"); CUR = ch; x++; }  }   fclose (f); for (stackptr = 0; stackptr < STACKSIZE; stackptr++) mpz_init(stack[stackptr]); mpz_init(a); mpz_init(b); srand (time (0)); x = y = dy = strmode = stackptr = 0; dx = 1; while (CUR != '@' || strmode) { if (isdebug) debug ; if (strmode && CUR != '"')      PUSHINT (CUR);     else       switch (CUR) {       case '0': case '1': case '2': case '3': case '4':       case '5': case '6': case '7': case '8': case '9':         PUSHINT (CUR - '0'); break;       case ' ': break;       case '>': dx =  1; dy =  0; break;       case '<': dx = -1; dy =  0; break;       case '^': dx =  0; dy = -1; break;       case 'v': dx =  0; dy =  1; break;       case '|':         dx = 0;         POP(a);         dy = mpz_cmp_si(a, 0) ? -1 : 1;         break;       case '_':         POP(a);         dx = mpz_cmp_si(a, 0) ? -1 : 1;         dy = 0;         break;       case '+':         POP(a);         POP(b);         mpz_add(stack[stackptr++], a, b);         break;       case '-':         POP(a);         POP(b);         mpz_sub(stack[stackptr++], b, a);         break;       case '*':         POP(a);         POP(b);         mpz_mul(stack[stackptr++], a, b); break; case '/': POP(a); if (!mpz_cmp_si(a, 0)) error ("divide by zero"); POP(b); mpz_tdiv_q(stack[stackptr++], b, a); break; case '%': POP(a); if(!mpz_cmp_si(a, 0)) error ("modulo by zero"); POP(b); mpz_mod(stack[stackptr++], b, a); break; case '\\': POP(a); POP(b); mpz_set(stack[stackptr++], a); mpz_set(stack[stackptr++], b); break; case '.': POP(a); gmp_printf (scell_fmt " ", a); break; case ',': POP(a); printf ("%c", (char) mpz_get_si(a)); break; case '"': strmode = !strmode; break;      case ':': POP(a); PUSH (a); PUSH (a); break;       case '!':         POP(a);         mpz_set_ui(stack[stackptr++], mpz_cmp_si(a, 0) ? 0 : 1);         break;       case '`':         POP(a);         POP(b);         mpz_set_ui(stack[stackptr++], mpz_cmp(b, a) > 0 ? 1 : 0);         break;       case '#': x += dx; y += dy; break;       case '$': POP(a); break;       case '?':         switch ((rand  >> 5) & 3) {         case 0: dx =  1; dy =  0; break;         case 1: dx = -1; dy =  0; break;         case 2: dx =  0; dy = -1; break;         case 3: dx =  0; dy =  1; break;         }         break;       case '&': scanf (scell_fmt, &a); PUSH (a); break;       case '~': PUSHINT (fgetc (stdin)); break;       case 'g': case 'p':         POP(a);         POP(b);         c = (int)mpz_get_ui(a); d = (int)mpz_get_ui(b);         c = POS (c, d);         if (c < 0 || c >= W * H)           error ("out of page"); if (CUR == 'g') PUSHINT (page[c]); else { POP(a); page[c] = (pcell_t)mpz_get_si(a); }        break; case '{': isdebug = 1; break; case '}': isdebug = 0; break; default : error ("unknown command"); }    x = (x + dx + W) % W;     y = (y + dy + H) % H;   } return 0; }
 * 1) include 
 * 2) include 
 * 3) include 
 * 4) include 
 * 1) define W		80
 * 2) define H		25
 * 3) define STACKSIZE	10000
 * 1) define	pcell_t		signed char
 * 2) define	scell_t		mpz_t
 * 3) define	scell_fmt	"%Zd"
 * 1) define POS(y,x)	((y) * W + (x))
 * 2) define CUR		page[POS (y, x)]
 * 1) define PUSH(val)                              \
 * 1) define PUSHINT(val)                           \
 * 1) define POP(val)                               \

Befunge(-93) interpreter of brainfuck
This program runs on a modified Befunge(-93) interpreter that implements bignums on the stack. Without bignums, I don't think it will run even a small brainfuck program.

brainfuck.bef ":\!-"<":\!-"-":\!-"+":\!-"!":~<+8 0> \:7`!^        >4**-v*>"["-!\"]"-!#v_  #v_  #v_  #v_  #v_  #v_  #v_  #v_!#^_ v    \0$<             #*             >1+\$>1+\$>1+\$>1+\$>1+\$>1+\$>1+\$>   ^ >0\:44*>/\44*%:7`#v_:00p8+\44**>+\:1`#v_$\0\:888**/\888>**%:884**\`!#v_       v \      ^ *44:_@#:\<    #^88\$< ^ **44\<                ^ 888\/**888:\<         0 $00g1-:0\`#v_1-:0\`#v_1-:0\`#^_1-:0\`#v_1-:0\`#v_1-:0\`#v_1-0\`#v_v           > v_v       >$1+v -1$< $>      v+**488$<    v~$$<    v,:$<            >\:884**\`# $\:0\:44*/\>44*%:7`#v_\44*>*+\:1`v       ^  p80+**562<0_^#!:  < :            v ^           ^ \/*44:\<     ^*44\-8_$\0\:44*>/\44*%:7`v ^2_^#      <            $ `#v_8>+\1`#v_v                           ^*44:    \_$$$1\:7>6+`!#v_77+`#v_1-:0 -1< ^8**44< +                                              ^ 7:\$<1  <+1<      ^     0\p80*84< $\:0\:44*>/\44*%:7`#v_\44*>*+\:1`v                                           > ^ *44:   \<     ^*44\-8_$\0\:44*>/\44*%:7`v \<  \-1<    ^  +8**44\<  ^+8**44< +                             ^ 4:/*44$< 0\+1 ^                         \0\p80*84<
 * 1) <            >884**%       >>            >        >     >\888* * *+^ +***888\
 * 1) v_\1-:#v_$/8>\44*/:0`#v_$>\0` #v_v       ^*44:    \_\44**+:1\:4>4*%:5`!#v_6`!

natural number brainfuck to 8-bit brainfuck converter
This perl program converts a natural number brainfuck program into an 8-bit brainfuck program. IOW, after conversion a BF program that expects to be able to grow the value of any cell to any natural number will run on an interpreter that limits cell size to 8 bits. The resultant program stores virtual cells as base-256 numbers and does not rely on wrap-around. Naturally, any program that only uses cell values of 0-255 (and does not wrap-around) will run unchanged after conversion - just much slower.

make_big_bf.pl s/[^-+\[\]<>,\.]//g; %a = ("[" => "A",      "]" => "B",       ">" => "C",       "<" => "D",       "+" => "E",       "-" => "F",       "." => "G",       "," => "H"; s/[-+\[\]<>,\.]/$a{$&}/g; %b = ( A => '[', B => ']', C => '>>>>[-]+[>>]>>', D => '<<<<[<<]<<', E => '[-]+>>>>[-]<<<<[>+++++[->++++++++++<]>+[-<+++++>]>>[>>]>[-<<<[<'. '<]<->>+>[>>]>]<<<[<<]>[->[>>]>+<<<[<<]>]<<-]>>>[>>]+>+<[<<]>]<[>>>' .       '>[>>]>>[[>>]>]<[>>>>>>>[[>>]>>>>>>]<<<<<<<<[[->[->>+<<]>+<<<<]<<[>>+' .        '<<-]<<<<]>>]<<[<<]+>[-]>[-]<<[<<]<]<]<[>]<',        F => '>>>>-<<<<[>>>>[>>]>[-<<<[<<]<+>>+>[>>]>]<<<[<<]<[->>>[>>]>+<<<[' .        '<<]<]>>[[-]<]<<[>>>>[>>]>-<+[<<<[>>>>[>>]>+++++[-<++++++++++>]<+[-' .        '>+++++<]>>-<<+[<<]]>>[<<]<<]<->>>>[>[<[<<]<<[-]+>>]>]<<[<<]>>[<]<<<',        G => '>>>>>.<<<<< H >>>>[>>]<<[->[-]<<<]>>+>,<<<<<' ); s/[A-G]/$b{$&}/g';
 * 1) !perl -p
 * 1) converts brainfuck instructions into instructions that can handle
 * 2) natural numbers of arbitrary size

Bub-to-brainfuck translator
Not just a one-for-one translator. Read the comments.

bub2bf.pl my $usage = <<EOU; bub2bf.pl convert Bub to brainfuck see http://esolangs.org/wiki/Bub for more information on Bub. options: -w N    Ignore whitespace and set width of each command to N digits default is -w 4 if Bub source contains no spaces -b      Append a bang ("!") character (instead of a newline) at the end -s      "stupid" mode: one-for-one translation -o name Output to file "name" instead of STDOUT license: Public Domain Notes: 1) Everything from a "#" through a newline is interpreted as a comment and is   filtered out before any other processing is done on the input code 2) Unless -w is used, this translator tries to match the input to one of three strategies for formatting Bub code: First, if the Bub code contains absolutely no whitespace (other than a newline at the end), then the code is assumed to have 4 digits per command. Next, if the Bub code contains no   whitespace other than N spaces at the beginning, then the code is assumed to    have N digits per command. Otherwise, commands are assumed to be separated by whitespace. 3) The canonical usage for Bub is a one-for-one translation from brainfuck. The   -s flag forces the converter to perform a stupid one-for-one translation    back to brainfuck and to not even check jump direction or destination. 4) Otherwise, the translation is not at all "one-for-one" Bub to brainfuck. Rather, it uses canned rules to jump from one section of code to another, according to the Bub jump-if-(non)zero directives. Thus it is a translator for arbitrary Bub code. The resulting brainfuck code has nearly 10 times more instructions than the original Bub code. Furthermore, the memory (tape) used by the brainfuck code is increased by a factor approximately equivalent to the number of jumps in the Bub code. EOU use strict; use integer; use vars qw/ $opt_h $opt_b $opt_s $opt_o $opt_w /; use Getopt::Std; use Data::Dumper; getopts('hbso:w:'); print $usage && exit 0 if $opt_h; if ($opt_o) { open(OUT, ">$opt_o"); select(OUT); } my $prog = join '', <>; $prog =~ s/^\s*#.*$//mg; if ($opt_s) { my @ops = ( "<", ">", "+", "-", ",", ".", "[", "]", "" ); if ($opt_w || ($prog =~ /^( +)\S+\s*$/s && ($opt_w = length($1))) ||      ($prog =~ /^\s*\S+\s*$/s && ($opt_w = 4))) { $prog =~ s/\s+//sg; $opt_w --; print $ops[$1] while $prog =~ s/\d{$opt_w}(\d)//; } else { $prog =~ s/^\s*(\d.*\d)\s*$/$1/s; print map { /(\d+)(\d)/ && $ops[$2] } (split /\s+/, $prog); }  print "\n"; exit; } my @prog; if ($opt_w || ($prog =~ /^( +)\S+\s*$/s && ($opt_w = length($1))) ||    ($prog =~ /^\s*\S+\s*$/s && ($opt_w = 4))) { $prog =~ s/\s+//sg; push(@prog, { "cmd" => $& } ) while $prog =~ s/\d{$opt_w}//; } else { $prog =~ s/^\s*(\d.*\d)\s*$/$1/s; @prog = map { { "cmd" => $_ } } split /\s+/, $prog; } $prog[$_]{"id"} = $_ for 0..$#prog; my @ops = ( "X", "+", "-", ",", ".", "[", "]", "" ); (($_->{"cmd"} =~ /\d$/) && ($_->{"op"} = $ops[$&])) for @prog; for (grep { $_->{"op"} =~ /[][]/ } @prog) { $_->{"cmd"} =~ /^(\d+)(\d)$/; $_->{"jmp"} = [ $1 <= $_->{"id"}, $2 == 7, $1 ]; $prog[$1]{"dest"} = 1; } my $group = 0; $prog[0]{"grp"} = 0; for (1..$#prog) { if ($prog[$_-1]{"jmp"}) { $group++; if ($prog[$_-1]{"jmp"}[0]) { # a jump backward requires a second group increment $group++; }  } elsif ($prog[$_-1]{"op"} eq "" or $prog[$_]{"dest"}) { $group++; }  $prog[$_]{"grp"} = $group; } $group += 2; $_->{"jmp"}[3] = $prog[$_->{"jmp"}[2]]{"grp"} for (grep { $_->{"jmp"} } @prog); for my $grp (0..$prog[-1]{"grp"}) { # find the start command of each group for (@prog) { if ($_->{"grp"} == $grp) { $_->{"grpstrt"} = 1; last; }  }   # find the end command of each group for (reverse(@prog)) { if ($_->{"grp"} == $grp) { $_->{"grpend"} = 1; last; }  } } print ">" x $group, "+ <+ "; print "[ " for grep { $_->{"jmp"} && $_->{"jmp"}[0] } @prog; print "-"; for (@prog) { # the "enter group" prefix if ($_->{"grpstrt"}) { print "> [ -> "; }  if ($_->{"jmp"}) { # jumps always anchor a group if ($_->{"jmp"}[0]) { # jump backward if ($_->{"jmp"}[1]) { # jump if non-zero print " [<<<<+>>>]<+<<[->>->+<", "<" x $_->{"jmp"}[3], "+<] ] > ] "; } else { # jump if zero print " <+<+>>[<-]<[<]>->[<<+>>-]+<<[-", "<" x ($_->{"jmp"}[3] - 1), "+<] ] > ] "; }    } else { # jump forward if ($_->{"jmp"}[1]) { # jump if non-zero print "[<<<+>>]<+<[->->+", "<" x ($_->{"jmp"}[3] - $_->{"grp"}), "] ] "; } else { # jump if zero print "<+<+>>[<-]<[<]>->[<+>-]+<[-", "<" x ($_->{"jmp"}[3] - $_->{"grp"} - 1), "] ] "; }    }   } elsif ($_->{"op"} eq "" and $_->{"id"} != $#prog) { # an "end of program" that's not at the end is essentially # an unconditional jump to the end print " ", "<" x ($prog[-1]{"grp"} - 1), " ] "; } else { if ($_->{"op"} eq "{"op"} eq ">X") { print ">" x $group; } else { print $_->{"op"}; }    # the "exit group" prefix (only if the group isn't anchored by a jump) if ($_->{"grpend"}) { print " <+< ] "; }  } } print $opt_b ? "!" : "\n"; exit;
 * 1) !/usr/bin/perl -w
 * 1) read in the program
 * 1) filter out comments
 * 1) number the commands
 * 1) identify the operator
 * 1) find all jump destinations
 * 1) group the operators
 * 1) find the group destination of each jump
 * 1) find the group heads & anchors

Bub interpreter in brainfuck
This interpreter assumes that the Bub code is of the form where N spaces precede the digits, where N is the number of digits per command. All the digits then follow with no whitespace between them. The Bub code must be followed by a "!" and then any input.

bub.b read in first 2 spaces into pos 3&5 >>>,>>, go to pos 7 >> fake 1 to start reading + read in until no more spaces [- read in third char into pos 6 <, copy to 7 and 8 [->+>+<<] put 32 in 9 >>>>+++++[<++++++>-]<++ subtract 9 from 8 [-<->] put not(8) in 9 +<[[-]>-<] continue reading if last read was a space >] move the first digit over 3 <<[->>>+<<<] change 32s to 1s <<[[-]+<<] sum the spaces >>>>[<<[->>+<<]>>>>] fake 1 to start reading >>>>+ read in the code looking for a bang after every spc digits [[-] go to spc count <[[<]<<]<< dup it [->+>>>+<<<<]>[-<+>]>>> read in spc chars [[[>]>>]<<,[[<]<<]>>>-] duplicate last char >[[>]>>]<<< [->>+>+<<<]>>>> put 3 right after it +++ subtract 33 (ascii bang) from last char [-<--->]< continue the loop if the last char was gt 33 ] kill the last 33 <[-] subtract 47 from read in code <<<[[---<]<<] go to start of code >>> will loop on this digit [ go to current command [[>]>]<< move command out with copy [[[<]<]<+<+>>>>[[>]>]<<-] move command back +[[<]<]< [>>>[[>]>]<<+[[<]<]<-] >>>[[>]>]< this plus advances the command counter +<- go to the copy of the command [[<]<]<+< -[   -[     -[       -[         -[           -[             -[               -[ stop ->->>>[-]<<<<                ]>[ jump if nonzero -                   go to the digit on the tape                   >>>[[>]>>]>[>>]+>>+<                   if it is nonzero                   [                    move command counter back one                    <[<<]<<[[<]<<]>>>[[>]>]<<[<]<-                    get the number of digits to grab                    <[[<]<]<<<-                    [>+>+<<-]+>[<+>-]>                    copy destination digits                    [<<[<]+<+[>>]>[[>]>]<<<                    copy ones digit                    [[[<]<]<<+<[<]>+[>]>>[[>]>]<<<-]                    move all digits up                    <[[>+<-]<]>+                    copy digit back to last place                    [[<]<]<<[->>>>[[>]>]<<[<]>+[[<]<]<<]                    make way for the next digit                    >-]                    fix copied digits                    >>>[[>]>]<<<[-<]                    strip code location                    <[-<[<]<]<                    decrement the digits by 2                    <<<[<--<]>>[>>]                    make sure there are an even number of 1s                    <<[<<[-]+<<]>>[>>]<<                    multiply every other                    [<<-<[>>++++++++++<<-]+<]>>>>[>>>>]<<<<                    loop on first digit                    [                    mark zeros                    [-<<[-]+<[-]>>[<-<+>]>[>]+<<<<]                    remove trailing zeros                    >>[->>->>]>>[>>>>]<<<<                    multiply down where necessary                    [<<<<]>>>>[<<[+++++++++[->++++++++++<]<+<<->>>]>>>>>>]                    <<<<<                    increment code location                    [>>>>>>>[[>]>]<+[[<]<]<<<<<-]>                    ]                    go to head of tape                    >>>>>>>[[>]>>]                   ]                   >[>>]<<-<<-<<[<<]<<[[<]<<]                  ]<              ]>[ jump if zero -                 put a decision 1 before the tape                 >>>[[>]>>]+                 go to the digit on the tape                 >[>>]+>>+<                 not the decision 1                 [<[<<]>-]                 go to the decision 1                 >[>>]<<[<<]>                 [-                  move command counter back one                  <[<<]<<[[<]<<]>>>>]>]<<[<]<-                  get the number of digits to grab                  <[[<]<]<<<-                  [>+>+<<-]+>[<+>-]>                  copy destination digits                  [<<[<]+<+[>>]>[[>]>]<<<                  copy ones digit                  [[[<]<]<<+<[<]>+[>]>>[[>]>]<<<-]                  move all digits up                  <[[>+<-]<]>+                  copy digit back to last place                  [[<]<]<<[->>>>[[>]>]<<[<]>+[[<]<]<<]                  make way for the next digit                  >-]                  fix copied digits                  >>>[[>]>]<<<[-<]                  strip code location                  <[-<[<]<]<                  decrement the digits by 2                  <<<[<--<]>>[>>]                  make sure there are an even number of 1s                  <<[<<[-]+<<]>>[>>]<<                  multiply every other                  [<<-<[>>++++++++++<<-]+<]>>>>[>>>>]<<<<                  loop on first digit                  [                  mark zeros                  [-<<[-]+<[-]>>[<-<+>]>[>]+<<<<]                  remove trailing zeros                  >>[->>->>]>>[>>>>]<<<<                  multiply down where necessary                  [<<<<]>>>>[<<[+++++++++[->++++++++++<]<+<<->>>]>>>>>>]                  <<<<<                  increment code location                  [>>>>>>>[[>]>]<+[[<]<]<<<<<-]>                  ]                  go to head of tape                  >>>>>>>[[>]>>]                 ]                 >[>>]<<-<<-<<[<<]>[-]<<<[[<]<<]                ]<            ]>[ output ->>>[[>]>>]>[>>]>.<<<[<<]<<[[<]<<<          ]>[ input ->>>>]>>]>[>>]>,<<<[<<]<<[[<]<<<        ]>[ minus ->>>>]>>]>[>>]>-<<<[<<]<<[[<]<<<      ]>[ plus ->>>>]>>]>[>>]>+<<<[<<]<<[[<]<<<    ]>[ Rshft ->>>>]>>]>[>>]+[<<]<<[[<]<<<  ]>[ Lshft ->>>>]>>]>[>>]<<-<<[<<]<<[[<]<< >>> ]

Bub interpreter in brainfuck 2
Conversion of the Bub interpreter in pure Bub. Create bub_from_bub.bf with this command: $ ./bub2bf.pl bub_pure.bub > bub_from_bub.bf Run it like this: $ echo '++++++[>++++++<-]>+.' | ./bf2bub.pl -pb | ./brainfuck bub_from_bub.bf % $ ./bf2bub.pl -pb hello.b | ./brainfuck bub_from_bub.bf Hello World!

Bub interpreter
bub.pl my $usage = <<EOU; bub.pl interpreter for the "Bub" variant of brainfuck see http://esolangs.org/wiki/Bub for more information on Bub options: -b     Byte mode: tape values are between 0 and 255, rollovers allowed -d     simple debug mode -e     process source code only up to first "!" (source on STDIN only) use the rest of STDIN as STDIN to the program -w N   ignore whitespace and set width of each command to N digits -s     like -w, but use initial spaces to determine N When given neither -s nor -w N and the Bub source contains no spaces, this interpreter will default to -w 4 Comment lines beginning with # are supported at the top of the Bub source only. Everything from the # through (and including) the newline is stripped before source processing begins license: Public Domain EOU use strict; use integer; use vars qw/ $opt_h $opt_b $opt_d $opt_e $opt_s $opt_w /; use Getopt::Std; getopts('hbdesw:'); print($usage) && exit 0 if $opt_h; die "Options -s and -w are mutually exclusive\n" if (($opt_s||0) + ($opt_w||0)) > 1; die "can't use -e with a filename argument\n" if $opt_e and @ARGV; my $prog; my @prog; if ($opt_e) { $prog .= $_ while (defined($_ = getc) && $_ ne "!"); } else { $prog = join '', <>; } $prog = $' while $prog =~ /^\s*#[^\n]*\n/s; if ($opt_w) { $prog =~ s/\s+//sg; push(@prog, $&) while $prog =~ s/\d{$opt_w}//; } elsif ($opt_s) { $opt_s = 0; $opt_s++ while $prog =~ s/^\s//; $prog =~ s/\s+//sg; push(@prog, $&) while $prog =~ s/\d{$opt_s}//; } else { $prog =~ s/^(\s*)(\d.*\d)\s*$/$2/s; my $i_sp = length($1); @prog = split /\s+/, $prog; if ($#prog == 0) { my $w = $i_sp || 4; @prog = ; push(@prog, $&) while $prog =~ s/\d{$w}//; } } $prog = 0; my $tape = 0; my @tape = (0); my @ops = ( sub { $tape-- },    sub { $tape++; $tape[$tape] = 0 if $tape > $#tape },     $opt_b ? sub { $tape[$tape]++; $tape[$tape] = 0 if $tape[$tape] == 256 }     : sub { $tape[$tape]++ },     $opt_b ?     sub { if ($tape[$tape]) { $tape[$tape]-- } else { $tape[$tape] = 255 } }     : sub { $tape[$tape] && $tape[$tape]-- },     sub { $_ = getc; $tape[$tape] = defined($_) ? ord($_) : 0 },     sub { print(chr($tape[$tape])) },     sub { $prog = $_[0] unless $tape[$tape] },     sub { $prog = $_[0] if $tape[$tape] },     sub { exit 0 }   ); while (1) { if ($opt_d) { printf "%5d %s: ", $prog, $prog[$prog]; print join(" ", map { defined($_) ? $_ : 0 } @tape[0..$tape]), "@", join(" ", map { defined($_) ? $_ : 0 } @tape[($tape+1)..$#tape]), "\n" }  $prog[$prog++] =~ /(\d+)(\d)/; $ops[$2]->($1); }
 * 1) !/usr/bin/perl -w
 * 1) filter out header comments

brainfuck-to-Bub translator
bf2bub.pl my $usage =<<EOU; bf2bub.pl - converts brainfuck to Bub see http://esolangs.org/wiki/Bub for more information on Bub Default output is to put a space between each command options: -h     This help -0     fill ignored digits with "0"s instead of instruction count -9     fill ignored digits with "9"s instead of instruction count -b     Append a bang ("!") character at the end -f N   Force at least N digits per command -c     Compact: no whitespace between commands. No newline at the end -l     Lines: put a newline instead of a space between each instruction -p     Prefix the output with N spaces, where N is the number of digits in each command. Implies -c license: Public Domain EOU use strict; use vars qw/ $opt_h $opt_0 $opt_9 $opt_b $opt_c $opt_l $opt_p $opt_f /; use Getopt::Std; getopts('h09bclpf:'); print($usage), exit 0 if $opt_h; die "Options -c/-p and -l are mutually exclusive\n" if (($opt_c||$opt_p||0) + ($opt_l||0)) > 1; die "Options -0, and -9 are mutually exclusive\n" if (($opt_0||0) + ($opt_9||0)) > 1; $opt_c = 1 if $opt_p; if ($opt_f && $opt_f > 1) { $opt_f = $opt_f - 1; } else { $opt_f = 1; } my $prog = join '', <>; my @prog = split '', $prog; my @loc; my @destn; my @instr; my $fill = sub { $#instr }; $fill = sub { "" } if ($opt_0 || $opt_9); my %ops = ( "<" => sub { push(@instr, 0); push(@destn, $fill->) },    ">" => sub { push(@instr, 1); push(@destn, $fill->) },     "+" => sub { push(@instr, 2); push(@destn, $fill->) },     "-" => sub { push(@instr, 3); push(@destn, $fill->) },     "," => sub { push(@instr, 4); push(@destn, $fill->) },     "." => sub { push(@instr, 5); push(@destn, $fill->) },     "[" => sub { push(@instr, 6); push(@destn, ""); push(@loc, $#instr) },     "]" => sub { push(@instr, 7); push(@destn, $loc[-1] + 1);                  $destn[pop(@loc)] = $#destn + 1;                  $opt_f = length($#instr) if length($#instr) > $opt_f;                }   ); defined($ops{$_}) && $ops{$_}-> for @prog; push @instr, 8; push(@destn, $fill->); push @destn, ""; print " " x ($opt_f + 1) if $opt_p; for (0 .. $#instr) { $destn[$_] = "9" x $opt_f if ($destn[$_] eq "" and $opt_9); print(("0" x ($opt_f - length($destn[$_]))), $destn[$_]); print $instr[$_]; print "\n" if $opt_l; print " " unless $opt_c or $opt_l or $_ == $#instr; } print('!', $opt_l ? "\n" : "") if $opt_b; print "\n" unless $opt_c or $opt_l;
 * 1) !/usr/bin/perl -w
 * 1) This one line does the real work of parsing brainfuck code

"Extended brainfuck" (Bub) parser
This will convert any ordinary brainfuck program into Bub. However, it also implements a syntax for GOTOs and GOTO labels. You should probably strip any comments out of a normal brainfuck program before conversion, just to be safe (or use the converter above). Read the comments near the top of this program for the details about GOTOs and GOTO labels.

parsebub.pl my $usage =<<EOU; parsebub.pl - converts extended (*) brainfuck to Bub see http://esolangs.org/wiki/Bub for more information on Bub Default output is to put a space between each command options: -h     This help -0     fill ignored digits with "0"s instead of instruction count -9     fill ignored digits with "9"s instead of instruction count -b     Append a bang ("!") character at the end -f N   Force at least N digits per command -c     Compact: no whitespace between commands. No newline at the end -l     Lines: put a newline instead of a space between each instruction -p     Prefix the output with N spaces, where N is the number of digits in each command. Implies -c license: Public Domain * "Extended brainfuck" adds Bub-style explicit destination labels and explicit "jump-if-0" and "jump-if-not-0" statements to ordinary brainfuck code. Follow these rules: a) Destination labels precede the destination command and are an alphanumeric   sequence followed by a ":". b) The "jump-if-0" command is an alphanumeric sequence followed by an "@". c) The "jump-if-not-0" command is an alphanumeric sequence followed by an "!". d) The alphanumeric sequence preceding a "@" or "!" designates the destination label to jump to. e) A "$" character is a Bub "end-of-program" directive. f) "[" and "]" will pair up poperly, regardless of the extended syntax used between them. g) Although any characters that don't match the syntax will be ignored, all   characters from a "#" to the end of the line will be stripped, so that is    the safest way to insert comments. EOU use strict; use vars qw/ $opt_h $opt_0 $opt_9 $opt_b $opt_c $opt_l $opt_p $opt_f /; use Getopt::Std; use POSIX; use integer; getopts('h09bclpf:'); print($usage), exit 0 if $opt_h; die "Options -c/-p and -l are mutually exclusive\n"   if (($opt_c||$opt_p||0) + ($opt_l||0)) > 1; die "Options -0, and -9 are mutually exclusive\n"   if (($opt_0||0) + ($opt_9||0)) > 1; $opt_c = 1 if $opt_p; $opt_f = 2 unless defined $opt_f; my $prog = ""; while (<>) {   chomp;   s/#.*$//;   $prog .= $_; } my @loc; my @instr; my @destn; my @jumps; my $label = ""; my %labels; my $fill = sub { $#instr }; if ($opt_0) {   $fill = sub { 0 }; } elsif ($opt_9) {   $fill = sub { "" }; } my %ops =   ( "<" => sub { push(@instr, 0); push(@destn, $fill->) }, ">" => sub { push(@instr, 1); push(@destn, $fill->) }, "+" => sub { push(@instr, 2); push(@destn, $fill->) }, "-" => sub { push(@instr, 3); push(@destn, $fill->) }, "," => sub { push(@instr, 4); push(@destn, $fill->) }, "." => sub { push(@instr, 5); push(@destn, $fill->) }, "[" => sub { push(@instr, 6); push(@destn, ""); push(@loc, $#instr) }, "]" => sub { push(@instr, 7); push(@destn, $loc[-1] + 1); $destn[pop(@loc)] = $#destn + 1; $opt_f = length($#instr) if length($#instr) > $opt_f; },    ":" => sub { $labels{$label} = $#instr + 1; }, "!" => sub { push(@instr, 7); push(@destn, undef); push(@jumps, [ $label, $#instr ] ) }, "@" => sub { push(@instr, 6); push(@destn, undef); push(@jumps, [ $label, $#instr ] ) }, "\$" => sub { push @instr, 8; push(@destn, $fill->) } ); for (split '', $prog) {  if (/\w/) {     $label .= $_;     next;   } elsif (! /[:!@]/) {    $label = "";   }   defined($ops{$_}) && $ops{$_}->; } for (@jumps) {   $destn[$_->[1]] = $labels{$_->[0]}; } if ($instr[-1] != 8 ) {   push @instr, 8;   push(@destn, $fill->); } my $width = POSIX::floor(log($#instr) / log(10)) + 2; $opt_f = defined($opt_f) && $opt_f > $width ? $opt_f : $width; print " " x $opt_f if $opt_p; $opt_f -= 1; my $format = "\%0" . $opt_f . "d\%1d" . ($opt_l ? "\n" : ""); for (0 .. $#instr) {  $destn[$_] = "9" x $opt_f if $destn[$_] eq "";   printf($format, $destn[$_], $instr[$_]);   print " " unless $opt_c or $opt_l or $_ == $#instr; } print('!', $opt_l ? "\n" : "") if $opt_b; print "\n" unless $opt_b or $opt_c or $opt_l;
 * 1) !/usr/bin/perl -w

BCT interpreter in Bub 1
Create bct.bub with this command: $ perl bf2bub.pl bct.b > bct.bub Run it like this: $ echo -ne "00111\n101\n" | perl bub.pl bct.bub Or do it all at once like this: $ { perl bf2bub.pl -b0p bct.b; echo -ne "00111\n101\n"; } | perl bub.pl -se

Bub interpreter in Bub 1
Create bub_from_bf.bub with this command: $ ./bf2bub.pl bub.b > bub_from_bf.bub Run it like this: $ echo '++++++[>++++++<-]>+.!' | ./bf2bub.pl -pb | ./bub.pl bub_from_bf.bub % $ ./bf2bub.pl -pb hello.b | ./bub.pl bub_from_bf.bub Hello World!

Bub interpreter in Bub 2
This is a Bub interpreter in pure Bub. It is written using Bub macros as implemented in parsebub.pl. It assumes that the Bub code is of the form where N spaces precede the digits, where N is the number of digits per command. All the digits then follow with no whitespace between them. The Bub code must be followed by a "!" and then any input.

Create bub_pure.bub with this command: $ ./parsebub.pl bub_pure.bubm > bub_pure.bub Run it like this: $ echo '++++++[>++++++<-]>+.!' | ./bf2bub.pl -pb | ./bub.pl bub_pure.bub % $ ./bf2bub.pl -pb hello.b | ./bub.pl bub_pure.bub Hello World!

bub_pure.bubm >>>+>>,,< a: +>, > ++++++++ l1: <>- l1! < a@>+++++ l2: <--->- l2! < l3: >>+<<- l3! l4: < l4! >->> l5: < l6: ->+< l6! >> l5! >>>>+<<<<< a3:->>a4:>a4! > a5@ - a1: > a1! + a5: > a5! + a2: < a2! < ,>++++++++ l8: <>- l8! <- b@ >+++++++ l9: <-->- l9! l10:a6:>a6!>>a6! <<<< a8: > a7:-<+>a7! << a8! < -aa1@-aa2@-aa3@-aa4@-aa5@-aa6@-aa7@-aa8@-aa9@ aa9:+++aa6:+aa5:+aa4:+aa3:+aa2:+aa1:+>>a3! aa7: +++++++ ab5:ab2:>>ab2! ab4:<ab5!<ab3:>+<-ab3! ab4@ ab1:>ab6@>+ab1! ab6:<-<<->a3! aa8: ++++++++ ab5! b: >>-<+<<<<b1:-b1!< b2:<b2!<<<<b2!>>>+rb! r2: r1: r: <rc:<r! rd:<<<ra:<ra!<rd@ rb:>re:>re!>>+ <<< - h@ - i@ - j@ - k@ - m@ - n@ - o@ - p@ $ # < h: + l29:>l29!>>>>l29!>l30:>>l30!<<-r@ # > i: ++ l23:>l23!>>>>l23!>l27:>>l27!+r! # + j: +++ l24:>l24!>>>>l24!>l26:>>l26!<+<r! # - k: ++++ l32:>l32!>>>>l32!>l33:>>l33!<-<r! #, m: +++++ l35:>l35!>>>>l35!>l36:>>l36!<,<r! # . n: ++++++ l38:>l38!>>>>l38!>l39:>>l39!<.<r! # [ o: +++++++ o1:>o1!>>>>o1!>o2:>>o2!<rc! <o3:<<o3! o4:<<<o5:<o5!<o4@ ++++++<<<---q1:<q1!<-q2:>q3@-q3:>q2!<< q4:->+>+<<q4!<<q4!>>>q5:<+>-q5!>q5!<of:< o8:-o6!+<<o7@ o8! o6:>>o9@+++++++++o6! o9:<oa:<oa!<<ob!<<og@ oa! ob:>>og:>og!>og!+>>od:>od!>>od!>oe:>oe! of@ o7:>o7!>>>oh:<<<+>>>-oh! >oi:<oi!<<<<oi!>om:>oj@->ok!+ok:>ol:>ol! om@ oj:>oq!+oq:>or:>or! os:>>rd@->op:>op! os@ # ] p: ++++++++ p1:>p1!>>>>p1!>p2:>>p2!<rc@ <p3:<<p3! p4:<<<p5:<p5!<p4@ +++++++<<<q1@
 * 1) assume first two characters are spaces
 * 1) read a possible space & subtract 32
 * 1) goto a if it's a space, then subtract 15 & move it over 2
 * 1) add up the spaces (less 1)
 * 1) main program reading routine
 * 1) read in next token & subtract "!" (33).
 * 2) if the character is a "!", then it's not a token,
 * 3) but the end of the program
 * 1) jump to b if it's 0 otherwise subtract 14 (means a "0" will be 1)
 * 1) check if next token
 * 1) get ready for next token
 * 1) check if last was a jump
 * 1) restore non-jumps
 * 1) make room to dup addresses in jumps
 * 1) mark first instruction
 * 1) >>b3:>b3!>>b3!+rb!
 * 1) go to current instruction
 * 1) 0=< 1=> 2=+ 3=- 4=, 5=. 6=[ 7=] 8=STOP
 * 1) check cell
 * 1) go to jump counter
 * 1) prepare for jump counter decrement
 * 1) decrement jump counter
 * 1) go to jump indicator & increment to next instruction
 * 1) no more decrements, so restore command
 * 1) set instruction
 * 1) clear all old instructions
 * 1) check cell
 * 1) go to jump counter
 * 1) prepare for jump counter decrement

brainfuck interpreter in Bub (DBFI)
Create dbfi.bub with this command: $ perl bf2bub.pl dbfi.b > dbfi.bub Run it like this: $ { cat primes.b; echo '!100'; } | ./bub.pl dbfi.bub

SMITH interpreter in perl
nsmith.pl use strict; use integer; use Getopt::Long; Getopt::Long::Configure ("bundling"); my $VERSION = "0.90"; my $TITLE = "Nate's SMITH Interpreter"; =pod nsmith.pl - Nate's SMITH Interpreter An interpreter for: SMITH - Self Modifying Indecent Turing Hack, v2007.0722 Copyright (c)2000-2007, Chris Pressey, Cat's Eye Technologies. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notices, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notices, this list of conditions, and the following disclaimer in    the documentation and/or other materials provided with the distribution. 3. Neither the names of the copyright holders nor the names of their contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. An extensive modification of Chris Pressey's SMITH Interpreter v2007.0722 by Nathan Thern, circa July & August 2007 1. Pre-compile each source-code line into an anonymous subroutine. This results in about a 3-fold speed increase. This speed increase is gobsmackingly small and speaks to both the remarkable efficiency of perl's regex engine and the remarkable inefficiency of perl's   implementation of closures. 2. Modified parsing regexp's to be more forgiving of number formats when immediate integers are used as arguments. MOV, SUB and MUL can have signed (hence, negative) immediate arguments. The sign is   optional for the immediate arguments to COR and BLA. 3. Added -e, -f, -h, -m, -r, -s & -u flags. See the help text. Converted to Getopt::Long handling 4. Changed header documentation to pod format. 5. Enabled source input on STDIN. 6. Created two modes for really long running smith programs. This addresses the problem that the entire instruction history of   a SMITH program in process must be accessible at any time. 7. Use strict and integer pragmas. Unfortunately, the bigint pragma REALLY slows this program down, so I don't use it. 8. Implemented ":", "@" and "##" macros. See the --usage text. =cut my @mem = ; my @reg = ; my $debug; my $cont; my $quiet; my $pause; my @debug_lines = ; my %macros = ; my $bigint; my $memory = -1; my @originals; my $suppress; my $expand; my $goofy; my $registers; sub load_program { my $filename = shift; my $line = ''; my $i = 0; open INPUTFILE, $filename; while(defined($line = <INPUTFILE>)) {    # get rid of pre and post whitespace $line = $' if $line =~ /^\s*/; $line = $` if $line =~ /\s*$/; # get rid of comments $line =~ s/\s*;.*?$//; # expand "@" $line =~ s/@/$i/ge; # bind any ":" macro definitions while ($line =~ s/^:([^\s=]+)(=([-+]?\d+))?\s*//) { $macros{$1} = defined($3) ? 0 + $3 : $i; }    # skip this line if it has no instruction next unless $line =~ /^\S+/; my $reps = 1; # detect the REP directive if ($line =~ /^REP\s+\+?(\d+)\s+/) { $line = $'; $reps = $1 + 0; }    for (my $j = 0; $j < $reps; $j++) { $mem[$i] = $line; $i++; }  }   close INPUTFILE; } sub expand_program { for my $i (0 .. $#mem) { # expand all "##" directives while ($mem[$i] =~ /#([^#]*)#/) { my $expr = $1; # expand ":" macros only inside the "##" $expr =~ s/\Q$_/$macros{$_}/ge for keys(%macros); # evaluate what's between the #'s as a mathematical expression $mem[$i] =~ s/#[^#]*#/eval("$expr+0")/e }    # perform "*" expansion $mem[$i] =~ s/\*/$i/ge; }  # process the -e flag if ($expand) { print "\n" unless $quiet; print "$_\n" for @mem; exit 0; } } # sub compile_program { # NOP and STOP subroutines my %subs = (NOP => sub { },              STOP => sub { exit 0 }); # An important hash for the BLA command my %subs2 = %subs; %subs2 = ( NOP => $#mem + 1, STOP => $#mem + 2 ) if $memory == 3; # the core of COR my $copy_sub = sub { @mem[$_[0] .. ($_[0] + $reg[$_[2]] - 1)] = @mem[$_[1] .. ($_[1] + $reg[$_[2]] - 1)]; };  if ($goofy) { # COR with the same behavior as the original implementation if ($debug) { # COR with goofy and debug $copy_sub = sub { my ($dst, $src, $lrg) = (shift, shift, $reg[shift]); print "Copy $lrg Instructions from $src to $dst\n"; do_pause; for (my $i = 0; $i < $lrg; $i++) { $mem[$dst+$i] = $mem[$src+$i]; $debug_lines[$dst+$i] = $debug_lines[$src+$i]; printf(" %d = %d = %s\n", $dst + $i, $src + $i,                  $debug_lines[$dst + $i],); }        do_pause; };    } else { # COR with goofy $copy_sub = sub { my ($dst, $src, $lrg) = (shift, shift, $reg[shift]); for (my $i = 0; $i < $lrg; $i++) { $mem[$dst+$i] = $mem[$src+$i]; }      };     }   } elsif ($debug) { # COR with debug $copy_sub = sub { my ($dst, $src, $lrg) = (shift, shift, $reg[shift]); my @instructions = @mem[$src .. ($src + $lrg - 1)]; my @new_debug_lines = @debug_lines[$src .. ($src + $lrg - 1)]; print "Copy $lrg Instructions from $src to $dst\n"; do_pause; for (my $i = 0; $i < $lrg; $i++) { $mem[$dst] = $instructions[$i]; $debug_lines[$dst] = $new_debug_lines[$i]; printf(" %d = %d = %s\n", $dst, $src++, $debug_lines[$dst]); $dst++; }      do_pause; };  }   # compile each line for my $i (0 .. $#mem) { my $line = $mem[$i]; $debug_lines[$i] = $line if $debug; my ($reg1, $reg2, $val); # MOV reg, imm if ($line =~ /^MOV\s*R(\d+)\s*,\s*([-+]?\d+)$/) { ($reg1, $val) = ($1, $bigint ? Math::BigInt->new($2) : $2); $mem[$i] = sub { $reg[$reg1] = $val }; }    # MOV reg, reg elsif ($line =~ /^MOV\s*R(\d+)\s*,\s*R(\d+)$/) { ($reg1, $reg2) = ($1, $2); $mem[$i] = sub { $reg[$reg1] = $reg[$reg2] }; }    # MOV [reg], reg elsif ($line =~ /^MOV\s*R\[R(\d+)\]\s*,\s*R(\d+)$/) { ($reg1, $reg2) = ($1, $2); $mem[$i] = sub { $reg[$reg[$reg1]] = $reg[$reg2] }; }    # MOV reg, [reg] elsif ($line =~ /^MOV\s*R(\d+)\s*,\s*R\[R(\d+)\]$/) { ($reg1, $reg2) = ($1, $2); $mem[$i] = sub { $reg[$reg1] = $reg[$reg[$reg2]] }; }    # MOV [reg], "string" elsif ($line =~ /^MOV\s*R\[R(\d+)\]\s*,\s*\"(.*?)\"$/) { ($reg1, $val) = ($1, $2); my @vals = map { $bigint ? Math::BigInt->new(ord($_)) : ord($_) } split('', $val); $mem[$i] = sub { my $j = $reg[$reg1]; $reg[$j++] = $_ for @vals; };    }     # MOV reg, PC     elsif ($line =~ /^MOV\s*R(\d+)\s*,\s*PC$/) { $reg1 = $1; $mem[$i] = $bigint ? sub { $reg[$reg1] = Math::BigInt->new(shift) } : sub { $reg[$reg1] = shift }; $memory = 2 if $memory == 0; }    # MOV TTY, reg elsif ($line =~ /^MOV\s*TTY\s*,\s*R(\d+)$/) { $reg1 = $1; $mem[$i] = sub { print chr($reg[$reg1]) }; }    # MOV TTY, [reg] elsif ($line =~ /^MOV\s*TTY\s*,\s*R\[R(\d+)\]$/) { $reg1 = $1; $mem[$i] = sub { print chr($reg[$reg[$reg1]]) }; }    # MOV reg, TTY elsif ($line =~ /^MOV\s*R(\d+)\s*,\s*TTY$/) { $reg1 = $1; $mem[$i] = $bigint ? sub { $reg[$reg1] = read(STDIN, $reg[$reg1], 1) ? Math::BigInt->new(ord($reg[$reg1])) : Math::BigInt->new(0); } : sub { $reg[$reg1] = read(STDIN, $reg[$reg1], 1) ? ord($reg[$reg1]) : 0; };    }     # MOV [reg], TTY elsif ($line =~ /^MOV\s*R\[R(\d+)\]\s*,\s*TTY$/) { $reg1 = $1; $mem[$i] = $bigint ? sub { $reg[$reg[$reg1]] = read(STDIN, $reg[$reg[$reg1]], 1) ? Math::BigInt->new(ord($reg[$reg[$reg1]])) : Math::BigInt->new(0); } : sub { $reg[$reg[$reg1]] = read(STDIN, $reg[$reg[$reg1]], 1) ? ord($reg[$reg[$reg1]]) : 0; };    }     # SUB reg, imm elsif ($line =~ /^SUB\s*R(\d+)\s*,\s*([-+]?\d+)$/) { ($reg1, $val) = ($1, $bigint ? Math::BigInt->new($2) : $2); $mem[$i] = sub { $reg[$reg1] -= $val }; }    # SUB reg, reg elsif ($line =~ /^SUB\s*R(\d+)\s*,\s*R(\d+)$/) { ($reg1, $reg2) = ($1, $2); $mem[$i] = sub { $reg[$reg1] -= $reg[$reg2] }; }    # MUL reg, imm elsif ($line =~ /^MUL\s*R(\d+)\s*,\s*([-+]?\d+)$/) { ($reg1, $val) = ($1, $bigint ? Math::BigInt->new($2) : $2); $mem[$i] = sub { $reg[$reg1] *= $val }; }    # MUL reg, reg elsif ($line =~ /^MUL\s*R(\d+)\s*,\s*R(\d+)$/) { ($reg1, $reg2) = ($1, $2); $mem[$i] = sub { $reg[$reg1] *= $reg[$reg2] }; }    # NOT reg elsif ($line =~ /^NOT\s*R(\d+)$/) { $reg1 = $1; $mem[$i] = $bigint ? sub { $reg[$reg1] = $reg[$reg1] == 0 ? Math::BigInt->new(1) : Math::BigInt->new(0); } : sub { $reg[$reg1] = $reg[$reg1] == 0 ? 1 : 0;        };     }     # COR imm, imm, reg elsif ($line =~ /^COR\s*([-+]?\d+)\s*,\s*([-+]?\d+)\s*,\s*R(\d+)\s*$/) { ($reg1, $reg2, $val) = (0 + $1, 0 + $2, 0 + $3); $mem[$i] = sub { $copy_sub->($_[0] + $reg1, $_[0] + $reg2, $val) }; }    # COR imm, reg, reg elsif ($line =~ /^COR\s*([-+]?\d+)\s*,\s*R(\d+)\s*,\s*R(\d+)\s*$/) { ($reg1, $reg2, $val) = (0 + $1, 0 + $2, 0 + $3); $mem[$i] = sub { $copy_sub->($_[0] + $reg1, $_[0] + $reg[$reg2], $val) }; }    # BLA imm, OPC, reg elsif ($line =~ /^BLA\s*([-+]?\d+)\s*,\s*(\w+)\s*,\s*R(\d+)\s*$/) { ($reg1, $reg2, $val) = (0 + $1, $2, 0 + $3); my $src = $subs2{$reg2}; $mem[$i] = $debug ? sub { my $dst = shift + $reg1; print "Copy $reg[$val] $reg2 Instructions into $dst\n"; do_pause; for (my $i = 0; $i < $reg[$val]; $i++) { $mem[$dst+$i] = $src; $debug_lines[$dst+$i] = $reg2; }        } : sub { my ($dst, $count) = (shift + $reg1, $reg[$val]); @mem[$dst..($dst + $count - 1)] = ($src) x $count; };    }     # NOP and STOP elsif ($line =~ /^NOP|STOP$/) { $mem[$i] = $subs{$&}; }    else { warn "Invalid instruction $line!\n"; if ($cont) { warn "Substituting NOP at line $i\n"; $mem[$i] = $subs{NOP}; $debug_lines[$i] = "NOP" if $debug; } else { die "at line $i\n"; }    }   } # end compile # handle --memory options if ($memory == 0 or $memory == 1) { print "\nLoading Memory Mode 1..." unless $quiet; tie @mem, 'SMM1', @mem; } elsif ($memory == 2) { print "\nLoading Memory Mode 2..." unless $quiet; tie @mem, 'SMM2', @mem; } elsif ($memory == 3) { # In memory 3 mode, the @mem array is tied to the SMM3 class # it behaves like an array of indices to a master list print "\nLoading Memory Mode 3..." unless $quiet; @originals = (@mem, $subs{NOP}, $subs{STOP}); tie @mem, 'SMM3', 0 .. $#mem; } } sub run_program { my $pc = $bigint ? Math::BigInt->new(-1) : -1; # test for $debug once rather than every cycle if ($debug) { while(defined($mem[++$pc])) { display_debug($pc); $mem[$pc]->($pc); }  } else { while(defined($mem[++$pc])) { $mem[$pc]->($pc); }  } } sub memory_run { my $pc = $bigint ? Math::BigInt->new(-1) : -1; while(defined($mem[++$pc])) { display_debug($pc) if $debug; $originals[$mem[$pc]]->($pc); } } sub display_debug { unless ($suppress) { print "Registers: "; my $s = 0; my $last = $registers || (defined($registers) && $#reg) || 100; defined $reg[$_] && print($s++ ? "  " : "", "R$_ = $reg[$_]") for (0 .. $last); print "\n"; }  print "Execute $_[0] = $debug_lines[$_[0]]\n"; do_pause; } sub do_pause { return unless $pause; my $c; read(STDIN, $c, 1); if ($c eq "d") { defined($debug_lines[$_]) && printf("%4d %s\n", $_, $debug_lines[$_]) for 0..$#debug_lines; do_pause; } } sub homage { print <<EOHOMAGE; $TITLE is an extensive modification of Chris Pressey's excellent SMITH Interpreter V2007.0722, written in perl. Chris Pressey is also the author of the SMITH spec to which this interpreter adheres. This interpreter is released under the same BSD license as SMITH V2007.0722. This implementation duplicates the behavior of Chris' interpreter while attempting to speed things up a bit, addressing some memory issues, and adding an extension to the SMITH syntax (see --usage). EOHOMAGE exit 0; } sub usage { print <<EOUSAGE; $TITLE Version $VERSION memory mode and macro usage information Memory Mode (--memory [num]) num may be omitted or num may be 1, 2 or 3. If omitted, num=1 is the default for programs that have no absolute address (a.k.a. "MOV register, PC") instructions. Otherwise num defaults to 2. The memory modes are as follows: 1 Retain only the last 100,000 instructions. This is sufficient for almost any program that doesn't use absolute addressing. 2 Retain only the first and last 100,000 instructions. This is sufficient for almost any program that does use absolute addressing. 3 Retain the first and last 100,000 instructions in immediate memory. Store all instructions in between to a file saved on disk. Since a SMITH program can, in theory, access its ENTIRE instruction history at any time (regardless of whether it uses absolute addressing or not), this is the only memory mode which offers true full SMITH. However, this mode is VERY SLOW. Macro Usage This is an extension to the original SMITH spec; However, any program can be macro expanded into standard SMITH code and dumped using the -e flag. Three macro constructs are defined. They are "@" instances, ":" definitions, and "##" expressions Any line starting with ":MAC" defines a macro "MAC". "MAC" is tied by default to the line number of the next command, but ":MAC=N" ties "MAC" to the integer N. No whitespace is allowed around the "=". "MAC" may be any character sequence without whitespace or "=". A ":" definition can be on its own line or precede a command on the same line, or precede another ":" definition. Any instance of "@" is expanded to the line number of the current command (this includes instances of "@" in ":" definitions). Any instance of "#expr#" where an integer is expected (including immediately following an "R") will evaluate "expr" as a numerical expression. "expr" should return an integer. "@" and ":" macros will be substituted before the expression is evaluated. "#expr#" expansion is only performed after the entire program is read in, so ":" definitions that occur anywhere in the source code will be substituted properly. ":" macros, unlike "@", are expanded into integers only inside of "##" instances. Pretty much any identifier with no whitespace (or "@" or "=") will work as a ":" identifier, even words like "MOV" or "+_*&". The order of macro substitution is undefined. If you define silly macros like ":A=1 :B=2 :1B=3 :1B+3=7", then expanding ":AB+3 - 7:" might not give you the result you were expecting. Everything inside the "##"s is simply eval'd as a perl expression, so things like #(Pa - Pb) > 6 ? ord("%") : 12# are permissible. Just remember that "use integer" is in effect. Here is an example of SMITH code expansion: MOV R0, #2*A + 13# :A=-2 SUB R0, #@ + 3 + LOC2# :N@ REP 2 NOP :LOC2 MUL R0, R#N2 - 1# ==>  MOV R0, 9 SUB R0, 8 NOP NOP MUL R0, R1 "*" retains its original macro meaning, but is only expanded after all "@", ":" and "##" expansion is complete (thus, "*" means "times" inside a "##" macro). EOUSAGE exit 0; } my $help = <<EOHELP; Usage: [ perl ] nsmith.pl [ -cdefghmpqrsu ] [ - | program.smt ] Options: -h, --help        Print this help -c, --continue    Don't break program on compiler error -d, --debug       Run in Debugging Mode -e, --expand      Macro expand program and dump to STDOUT -f, --fixnum      Use Math::BigInt for program counter and register values. This slows things down fourfold. -g, --goofy       Duplicate "goofy" COR behavior of earlier SMITH implementations -m [num], --memory [num] Use memory techniques that allow essentially unbounded runlength. See the --usage text for more information -m1               Synonym for --memory 1 -m2               Synonym for --memory 2 -m3               Synonym for --memory 3 -p, --pause       Pause (in conjunction with --debug) d<ENTER> will dump full instruction state when paused -q, --quiet       Quiet (Don't display messages on startup) -r [num], --registers [num] Specify maximum number of registers to display in                      debug mode (0 = unlimited). Default is 0 when num is                      omitted. Default is 100 when -r is not specified. -s, --suppress    Suppress Register values when in Debugging Mode --usage      Print instructions on memory mode and macro extension usage --homage     Credit where credit is due EOHELP GetOptions('help|h' => sub {             print "$TITLE Version $VERSION\n$help";              exit 0; },            'continue|c' => \$cont,            'debug|d' => \$debug,            'expand|e' => \$expand,            'fixnum|f' => \$bigint,            'goofy|g' => \$goofy,            'memory|m:i' => \$memory,            'pause|p' => \$pause,            'quiet|q' => \$quiet,            'registers|r:i' => \$registers,            'suppress|s' => \$suppress,            'usage' => \&usage,            'homage' => \&homage) or die $help; require Math::BigInt if $bigint; if (not $quiet) { my $modes = ''; print "$TITLE Version $VERSION\n"; $modes .= " goofy" if $goofy; $modes .= " continue" if $cont; $modes .= " debug" if $debug; $modes .= " fixnum" if $bigint; $modes .= " memory" if $memory != -1; $modes .= " pause" if $pause; $modes .= " suppress" if $suppress; print "Modes:$modes\n" if $modes; } if (!defined($ARGV[0]) or $ARGV[0] eq '' or $ARGV[0] eq '-') { $ARGV[0] = '-'; print "Loading program from STDIN..." if not $quiet; } else { die "Can't find/read file '$ARGV[0]'" if not -r $ARGV[0]; print "Loading $ARGV[0] ..." if not $quiet; } load_program($ARGV[0]); print " Expanding..." if not $quiet; expand_program; print " Compiling..." if not $quiet; compile_program; print " Running...\n" if not $quiet; if ($memory == 3) { memory_run; } else { run_program; } exit 0; package SMM1; use strict; use integer; my @SMM1_vals; my $SMM1_offset; my $SMM1_val_count; my $SMM1_val_count2; sub TIEARRAY { my $pkg = shift; @SMM1_vals = @_; $SMM1_offset = $main::bigint ? Math::BigInt->new(0) : 0; $SMM1_val_count = $main::bigint ? Math::BigInt->new(100000) : 100000; $SMM1_val_count2 = 2 * $SMM1_val_count; bless [], $pkg; } sub FETCH { return $SMM1_vals[$_[1] - $SMM1_offset]; } sub STORE { $SMM1_vals[$_[1] - $SMM1_offset] = $_[2]; if ($#SMM1_vals > $SMM1_val_count2) { @SMM1_vals = @SMM1_vals[$SMM1_val_count .. $#SMM1_vals]; $SMM1_offset += $SMM1_val_count; }  return $_[2]; } package SMM2; use strict; use integer; my @SMM2_first_vals; my @SMM2_last_vals; my $SMM2_last_vals_0; my $SMM2_val_count; my $SMM2_val_count2; sub TIEARRAY { my $pkg = shift; @SMM2_first_vals = @_; $SMM2_val_count = $main::bigint ? Math::BigInt->new(100000) : 100000; $SMM2_val_count2 = 2 * $SMM2_val_count; if ($#SMM2_first_vals > $SMM2_val_count) { @SMM2_last_vals = @SMM2_first_vals[$SMM2_val_count .. $#SMM2_first_vals]; @SMM2_first_vals = @SMM2_first_vals[0..($SMM2_val_count-1)]; }  $SMM2_last_vals_0 = $SMM2_val_count; bless [], $pkg; } sub FETCH { my $index = $_[1]; if ($index < $SMM2_val_count) { return($SMM2_first_vals[$index]); } elsif ($index >= $SMM2_last_vals_0) { return($SMM2_last_vals[$index - $SMM2_last_vals_0]); } else { return undef; } } sub STORE { my ($index, $val) = @_[1,2]; if ($index < $SMM2_val_count) { return $SMM2_first_vals[$index] = $val; } elsif ($index >= $SMM2_last_vals_0) { $SMM2_last_vals[$index - $SMM2_last_vals_0] = $val; if ($#SMM2_last_vals > $SMM2_val_count2) { @SMM2_last_vals = @SMM2_last_vals[$SMM2_val_count .. $#SMM2_last_vals]; $SMM2_last_vals_0 += $SMM2_val_count; }    return $val; } else { return undef; } } package SMM3; use strict; use integer; my @SMM3_first_vals; my @SMM3_last_vals; my $SMM3_last_vals_0; my $SMM3_val_count; my %SMM3_tmp_file; my $SMM3_file_handle; my @SMM3_compress; sub TIEARRAY { local *MIDVALS; my $pkg = shift; @SMM3_first_vals = @_; $SMM3_val_count = $main::bigint ? Math::BigInt->new(100000) : 100000; %SMM3_tmp_file = ( "SMITH_tempA$$" => "SMITH_tempB$$",                "SMITH_tempB$$" => "SMITH_tempA$$",                 CURRENT => "SMITH_tempA$$" ); @SMM3_compress = ("| gzip -c >", q/gzip -d < %s |/); system("gzip -h > SMITH_tempA$$ 2> SMITH_tempB$$") == 0 or @SMM3_compress = (">", q/<%s/); unlink("SMITH_tempA$$", "SMITH_tempB$$"); open(MIDVALS, $SMM3_compress[0] . $SMM3_tmp_file{CURRENT}) || die("can't open temporary file: $!"); $SMM3_file_handle = *MIDVALS; if ($#SMM3_first_vals > $SMM3_val_count) { @SMM3_last_vals = @SMM3_first_vals[$SMM3_val_count .. $#SMM3_first_vals]; @SMM3_first_vals = @SMM3_first_vals[0..($SMM3_val_count-1)]; }  $SMM3_last_vals_0 = $SMM3_val_count; bless [], $pkg; } sub FETCH { my $index = $_[1]; if ($index < $SMM3_val_count) { return($SMM3_first_vals[$index]); } elsif ($index >= $SMM3_last_vals_0) { return($SMM3_last_vals[$index - $SMM3_last_vals_0]); } else { my $val; local *MIDVALS; close $SMM3_file_handle; open(MIDVALS, sprintf($SMM3_compress[1], $SMM3_tmp_file{CURRENT})) || die("can't open temporary file: $!"); $index -= $SMM3_val_count; $val = <MIDVALS> for 0 .. $index; close MIDVALS; open(MIDVALS, $SMM3_compress[0] . ">" . $SMM3_tmp_file{CURRENT}) || die("can't open temporary file: $!"); $SMM3_file_handle = *MIDVALS; return($val eq '' ? undef : $val + 0); } } sub STORE { my ($index, $val) = @_[1,2]; if ($index < $SMM3_val_count) { $SMM3_first_vals[$index] = $val; } elsif ($index >= $SMM3_last_vals_0) { $SMM3_last_vals[$index - $SMM3_last_vals_0] = $val; if ($#SMM3_last_vals > 2 * $SMM3_val_count) { print( $SMM3_file_handle join("\n", map { defined($_) ? $_ : '' }                                    @SMM3_last_vals[0..($SMM3_val_count-1)]),              "\n"); @SMM3_last_vals = @SMM3_last_vals[$SMM3_val_count .. $#SMM3_last_vals]; $SMM3_last_vals_0 += $SMM3_val_count; }  } else { # I wish I knew a better way to do this in perl 5.005 # without requiring users to install something from # CPAN local (*MVIN, *MVOUT); close $SMM3_file_handle; open(MVIN, sprintf($SMM3_compress[1], $SMM3_tmp_file{CURRENT})) || die("can't open temporary file: $!"); open(MVOUT, $SMM3_compress[0] . $SMM3_tmp_file{$SMM3_tmp_file{CURRENT}}) || die("can't open temporary file: $!"); $index -= $SMM3_val_count; for (1 .. $index) { print MVOUT scalar(<MVIN>); }    <MVIN>; print MVOUT "$val\n"; print MVOUT $_ while <MVIN>; close MVIN; unlink $SMM3_tmp_file{CURRENT}; $SMM3_file_handle = *MVOUT; $SMM3_tmp_file{CURRENT} = $SMM3_tmp_file{$SMM3_tmp_file{CURRENT}}; }  return $val; } sub DESTROY { close $SMM3_file_handle; unlink("SMITH_tempA$$", "SMITH_tempB$$"); }
 * 1) !/usr/bin/perl -w
 * 2) nsmith.pl
 * 1) Nate's SMITH Interpreter ###
 * 1) GLOBALS ###
 * 1) @mem is an array which contains all program instructions.
 * 1) @reg is an array which contains all machine registers.
 * 2) The value of R0 is stored in $reg[0].
 * 1) $debug is a flag indicating whether we want debugging messages
 * 2) to appear during loadtime and runtime.  By default off, it can
 * 3) be turned on by giving the command line option -d or --debug.
 * 1) flag to continue after error
 * 1) flag to be quiet
 * 1) flag to pause during debugging
 * 2) only works when input is from terminal! :-)
 * 1) debugging lines
 * 1) storage for : macros
 * 1) Math::BigInt flag
 * 1) memory-crunching flag and variables
 * 1) flag to suppress registers in debug mode
 * 1) flag to dump expansion and exit
 * 1) flag to implement COR "bug" of reference implementation
 * 1) specify # of registers in debug mode
 * 1) PARSING SUBROUTINES ###
 * 1) load_program loads the program into the @mem array.  Handles the
 * 2) REP directive and ":" macro definitions. All "@" instances are
 * 3) also expanded at this stage
 * 1) expand_program expands all "##" and "*" macros
 * 1) compile_program converts each @mem line into an anonymous
 * 2) subroutine. In other words, string matching is only performed
 * 3) once, which results in a significant speed increase over the
 * 4) reference implementation.
 * 1) As an added bonus, the @mem array now consists of references
 * 2) to a limited number of values. As a long-running SMITH program
 * 3) executes, the @mem array is filled with an ever increasing
 * 4) number of pointers to the same set of data, as opposed to an
 * 5) ever increasing number of copies of strings. This significantly
 * 6) increases the number of total instructions which can be executed
 * 7) before memory is exhausted ... in theory.
 * 1) MAIN PROGRAM SUBROUTINES ###
 * 1) run_program sequentially executes the subroutines in @mem
 * 2) using the registers stored in @reg to handle values.
 * 1) memory_run is identical to run_program except that
 * 2) @mem is now a list of indices into @originals.
 * 3) @originals is a list of the actual functions.
 * 1) INITIALIZATION, MESSAGES and DIAGNOSTICS ###
 * 1) MAIN ###
 * 1) load the program
 * 1) expand the program
 * 1) compile the program
 * 1) run the program
 * 1) SMM ###
 * 1) SMITH Memory Management 1
 * 2) Tie an array to a reference array with an
 * 3) index offset. Retain only the last 100,000
 * 4) values of the array in memory.
 * 1) Only one instance of this class is created, so
 * 2)  a many principles of class construction are
 * 3)  violated below.
 * 1) SMITH Memory Management 2
 * 2) Tie an array to two reference arrays
 * 3) The reference arrays hold the first 100,000
 * 4) and last 100,000 values of the array
 * 5) The in-between values are discarded
 * 1) keeps two arrays in memory:
 * 2)  1 - the first 100,000 values
 * 3)  2 - the last 100,000 to 200,000 values
 * 4) It is expected that a SMITH program will either
 * 5) access the very first section of instructions or
 * 6) the recent instruction history when copying code
 * 7) forward.
 * 1) Only one instance of this class is created, so
 * 2)  a many principles of class construction are
 * 3)  violated below.
 * 1) SMITH Memory Management 3
 * 2) Transparently manage a HUGE and GROWING array of
 * 3) non-negative integers using the tie mechanism
 * 1) Only one instance of this class is created, so
 * 2)  a many principles of class construction are
 * 3)  violated below.
 * 1) keeps two arrays in memory:
 * 2)  1 - the first 100,000 values
 * 3)  2 - the last 100,000 to 200,000 values
 * 4) The values in between are stored to a temporary
 * 5) file. If there is a gzip executable in the path,
 * 6) the file is gzipped to save disk space. It is
 * 7) expected that a SMITH program will either access
 * 8) the very first section of instructions or the
 * 9) recent instruction history when copying code
 * 10) forward. The in-between instruction history may
 * 11) be accessed for reading and writing, but such
 * 12) access is _very_ slow.

brainfuck interpreter in SMITH
brainfuck.smt ; Nate's brainfuck interpreter in SMITH ; Run in nsmith.pl like this: ; { cat brainfuck_code.b; echo '!BF_input'; } | perl nsmith.pl brainfuck.smt ; In classic brainfuck interpreter style, all input after the ; first "!" character is provided as input to the brainfuck program. ; This code uses macro extensions to the original SMITH syntax. It ; will not run under Chris Pressey's smith.pl interpreter, but the ; command "perl nsmith.pl -e brainfuck.smt" will expand all the macros ; and print out standard SMITH code that will run on both nsmith.pl ;  and Chris' interpreter. ;Define up front which registers to use ; the +1 and -1 registers :pos_one=0 :neg_one=1 ; start point for processed code :code_start=20 ; code position register :code_pos=2 ; brainfuck data tape management ; tape start register :tape_start=3 ; tape position register :tape_pos=4 ; tape end register :tape_end=5 ; temporary registers for source processing :ptmp1=3 :p_this_loop=4 :p_TTY=5 :p_offset=6 :p_code_len=7 :p_+=8 :p_-=9 :p_.=10 :p_,=11 :p_<=12 :p_>=13 :p_[=14 :p_]=15 ; temporary registers for source interpreting :i_code_len=6 :itmp1=7 ;initialize +1 & -1 registers MOV R#pos_one#, 1 MOV R#neg_one#, 0 SUB R#neg_one#, 1 ; This code builds the code that will process brainfuck ; source. The input character will index which instruction to ; grab. Any non-brainfuck character will grab an instruction ; which will result the character being ignored. "!" or ; end-of-input will end the source processing. ; instructions for brainfuck characters COR +#IN_OPS + ord("+") - @#, +#+_IN - @#, R#pos_one# COR +#IN_OPS + ord("-") - @#, +#-_IN - @#, R#pos_one# COR +#IN_OPS + ord(".") - @#, +#._IN - @#, R#pos_one# COR +#IN_OPS + ord(",") - @#, +#,_IN - @#, R#pos_one# COR +#IN_OPS + ord("<") - @#, +#<_IN - @#, R#pos_one# COR +#IN_OPS + ord(">") - @#, +#>_IN - @#, R#pos_one# COR +#IN_OPS + ord("[") - @#, +#[_IN - @#, R#pos_one# COR +#IN_OPS + ord("]") - @#, +#]_IN - @#, R#pos_one# ; instructions for "!" and end-of-input COR +#IN_OPS + ord("!") - @#, +#!_IN - @#, R#pos_one# COR +#IN_OPS - @#, +#!_IN - @#, R#pos_one# ; initialize the source code start register and loop register :READ_INIT MOV R#code_pos#, #code_start# MOV R#p_this_loop#, 0 ; initialize constants used in source processing MOV R#p_offset#, 0 SUB R#p_offset#, #IN_OPS - APPLY_OFFSET - 1# MOV R#p_code_len#, #LAST_IN_OP - BEGIN_PROC# MOV R#p_+#, #I_CMD_+ - INTERP_CMD + 1# MOV R#p_-#, #I_CMD_- - INTERP_CMD + 1# MOV R#p_.#, #I_CMD_. - INTERP_CMD + 1# MOV R#p_,#, #I_CMD_, - INTERP_CMD + 1# MOV R#p_<#, #I_CMD_< - INTERP_CMD + 1# MOV R#p_>#, #I_CMD_> - INTERP_CMD + 1# MOV R#p_[#, #I_CMD_[ - INTERP_CMD + 1# MOV R#p_]#, #I_CMD_] - INTERP_CMD + 1# ; begin source processing loop :BEGIN_PROC ; put the move quantity value in R#p_TTY# ; get character from input MOV R#p_TTY#, TTY ; offset the character value to grab the right instruction :APPLY_OFFSET SUB R#p_TTY#, R#p_offset# ; copy the instruction at R#p_TTY# over the NOP below COR +1, R#p_TTY#, R#pos_one# :PROC_CHAR NOP SUB R#code_pos#, R#neg_one# COR +1, #BEGIN_PROC - @#, R#p_code_len# :PROC_[ MOV R[R#code_pos#], R#p_[# SUB R#code_pos#, R#neg_one# MOV R[R#code_pos#], R#p_this_loop# MOV R#p_this_loop#, R#code_pos# SUB R#code_pos#, R#neg_one# COR +1, #BEGIN_PROC - @#, R#p_code_len# :PROC_] MOV R[R#code_pos#], R#p_]# SUB R#code_pos#, R#neg_one# MOV R[R#code_pos#], R#p_this_loop# MOV R#ptmp1#, R[R#p_this_loop#] MOV R[R#p_this_loop#], R#code_pos# MOV R#p_this_loop#, R#ptmp1# SUB R#code_pos#, R#neg_one# COR +1, #BEGIN_PROC - @#, R#p_code_len# :END_PROC ; set up interpreter MOV R#itmp1#, #I_CMD_STOP - INTERP_CMD + 1# MOV R[R#code_pos#], R#itmp1# MOV R#tape_start#, R#code_pos# SUB R#tape_start#, R#neg_one# MOV R#itmp1#, 0 MOV R[R#tape_start#], R#itmp1# MOV R#tape_pos#, R#tape_start# MOV R#tape_end#, R#tape_start# MOV R#code_pos#, #code_start# SUB R#code_pos#, R#pos_one# MOV R#i_code_len#, #END_INTERPRET - BEGIN_INTERPRET# :BEGIN_INTERPRET ; begin interpreter loop ; increment code position SUB R#code_pos#, R#neg_one# ; interpret brainfuck character at R#code_pos# MOV R#itmp1#, R[R#code_pos#] COR +1, R#itmp1#, R#pos_one# :INTERP_CMD NOP :INTERP_+ MOV R#itmp1#, R[R#tape_pos#] SUB R#itmp1#, R#neg_one# MOV R[R#tape_pos#], R#itmp1# COR +1, #BEGIN_INTERPRET - @#, R#i_code_len# :INTERP_- MOV R#itmp1#, R[R#tape_pos#] SUB R#itmp1#, R#pos_one# MOV R[R#tape_pos#], R#itmp1# COR +1, #BEGIN_INTERPRET - @#, R#i_code_len# :INTERP_. MOV TTY, R[R#tape_pos#] COR +1, #BEGIN_INTERPRET - @#, R#i_code_len# :INTERP_, MOV R[R#tape_pos#], TTY COR +1, #BEGIN_INTERPRET - @#, R#i_code_len# :INTERP_< ; currently DOES NOT check for tape underrun! SUB R#tape_pos#, R#pos_one# COR +1, #BEGIN_INTERPRET - @#, R#i_code_len# :INTERP_> MOV R#itmp1#, R#tape_pos# SUB R#itmp1#, R#tape_end# NOT R#itmp1# NOT R#itmp1# MUL R#itmp1#, R#i_code_len# COR #BEGIN_INTERPRET - @ - 3#, #BEGIN_INTERPRET - @#, R#itmp1# SUB R#tape_end#, R#neg_one# MOV R#itmp1#, 0 MOV R[R#tape_end#], R#itmp1# SUB R#tape_pos#, R#neg_one# COR +1, #BEGIN_INTERPRET - @#, R#i_code_len# :INTERP_[ MOV R#itmp1#, R[R#tape_pos#] NOT R#itmp1# NOT R#itmp1# MUL R#itmp1#, R#i_code_len# SUB R#code_pos#, R#neg_one# COR +1, #BEGIN_INTERPRET - @#, R#itmp1# MOV R#code_pos#, R[R#code_pos#] COR +1, #BEGIN_INTERPRET - @#, R#i_code_len# :INTERP_] MOV R#itmp1#, R[R#tape_pos#] NOT R#itmp1# MUL R#itmp1#, R#i_code_len# SUB R#code_pos#, R#neg_one# COR +1, #BEGIN_INTERPRET - @#, R#itmp1# MOV R#code_pos#, R[R#code_pos#] COR +1, #BEGIN_INTERPRET - @#, R#i_code_len# :I_CMD_+ NOP :I_CMD_- COR #BEGIN_INTERPRET - INTERP_- + 1#, #BEGIN_INTERPRET - INTERP_CMD#, R#i_code_len# :I_CMD_. COR #BEGIN_INTERPRET - INTERP_. + 1#, #BEGIN_INTERPRET - INTERP_CMD#, R#i_code_len# :I_CMD_, COR #BEGIN_INTERPRET - INTERP_, + 1#, #BEGIN_INTERPRET - INTERP_CMD#, R#i_code_len# :I_CMD_< COR #BEGIN_INTERPRET - INTERP_< + 1#, #BEGIN_INTERPRET - INTERP_CMD#, R#i_code_len# :I_CMD_> COR #BEGIN_INTERPRET - INTERP_> + 1#, #BEGIN_INTERPRET - INTERP_CMD#, R#i_code_len# :I_CMD_[ COR #BEGIN_INTERPRET - INTERP_[ + 1#, #BEGIN_INTERPRET - INTERP_CMD#, R#i_code_len# :I_CMD_] COR #BEGIN_INTERPRET - INTERP_] + 1#, #BEGIN_INTERPRET - INTERP_CMD#, R#i_code_len# :I_CMD_STOP STOP :END_INTERPRET :IN_OPS REP 128 COR +1, #BEGIN_PROC - PROC_CHAR#, R#p_code_len# :LAST_IN_OP ; these will be copied backward into the 128 MOV's that start ; at #IN_OPS. :+_IN MOV R[R#code_pos#], R#p_+# :-_IN MOV R[R#code_pos#], R#p_-# :._IN MOV R[R#code_pos#], R#p_.# :,_IN MOV R[R#code_pos#], R#p_,# :<_IN MOV R[R#code_pos#], R#p_<# :>_IN MOV R[R#code_pos#], R#p_># :[_IN COR #BEGIN_PROC - PROC_[ + 1#, #BEGIN_PROC - PROC_CHAR#, R#p_code_len# :]_IN COR #BEGIN_PROC - PROC_] + 1#, #BEGIN_PROC - PROC_CHAR#, R#p_code_len# :!_IN COR #BEGIN_PROC - END_PROC + 1#, #BEGIN_PROC - PROC_CHAR#, R#p_code_len#

SMITHb interpreter in perl
smithb.pl my $usage =<<EOU; smithb.pl - SMITHb interpreter in perl see http://esolangs.org/wiki/SMITHb for more information on SMITHb usage: perl smithb.pl [ opts ] program cat program | perl smithb.pl [ opts ] options: -h     This help -c     Compile: process input into raw SMITHb source (numbers and "*"'s)    -v      Verbose: print steps during compilation stage -b     Bang, a dual purpose option: With -c, append a bang ("!") character at the end Otherwise, "!" indicates the end of SMITHb source Further input is considered input to the SMITHb program -d     Debug: print the stack before each operation -l     Language: Information about the language extensions implemented in this interpreter -r     Raw: Only accept "raw" SMITHb source license: Public Domain EOU my $language =<<EOL; SMITHb Language extensions implemented in smithb.pl EXTENSIONS -- Repetitions, Macros, Tags, Calculations, File Inclusions Repetitions: As described on the SMITHb page 2(1 * -1)    => 1 * -1 1 * -1   Macros: Extended version of macros described on the SMITHb page "_" indicates an argument "__" indicates a repetition of the first argument "___" indicates a repetition of the second argument (first "_" indicates an argument; count subsequent "_"s to determine which     argument to repeat) -- examples -- MAC1(* _ 0 _) MAC1 1 2 => * 1 0 2   MAC2(11 _ 22 ___ 33 __ _ * ) MAC2 1 2 ^ --- -- -- -- first argument ^-- -- -- repeat 2nd argument (an "_" followed by 2 "_"s) ^-- -- repeat 1st argument (an "_" followed by 1 "_") ^-- second argument => 11 1 22 2 33 1 2 *   A "+" or "-" as the first or last character in a macro will be converted to an "_". This allows the primitive functions to be macro-ized thusly DUPXY(- -) DELY(* +) SWAP(+ -) and so on  Tags: SMITHb syntax extension Tags precede a SMITHb expression and mark its location (for use in    calculation expressions) A tag may also mark the very end of the SMITHb source Tags that appear multiple times use the first instance -- examples -- a:* 1 b:c: 2 => a=1, b=3, c=3 2(d:* 1 e:2 f:)g: => d:* 1 e:2 f:d:* 1 e:2 f:g: => d=1, e=3, f=4, g=7 Calculations: SMITHb syntax extension Calculations are tokens of the form [ expr ]. Everything inside the [ ] is evaulated as a perl expression after the following substitutions are made: Tags are expanded into their values "@" is expanded to the current position. "@"s that get repeated in repeat groups or unexpanded macros are always expanded to the first value "#" is expanded to the current position. "#"s that get repeated are expanded to a new value at each location -- example -- a:* 2( [2*(@-a)] [b-a-#] b:* ) => a:* [2*(@-a)] [b-a-#] b:* [2*(@-a)] [b-a-#] b:* => a:* [2*(2-1)] [4-1-3] b:* [2*(2-1)] [4-1-6] b:* => * 2 0 * 2 -3 *  File Inclusion: SMITHb syntax extension A token of the form &incfile.smb will insert the text of the file "incfile.smb" into the SMITHb source Macro expansion: Macros are expanded upon their first use. This means that tags in macros will not clash with tags in other macros or tags in the main source. Any calculation expression with an underscore ("_") in it remains unexpanded. All expansion can be suppressed by declaring the macro thus: MAC(? ... ) -- examples -- MAC1(a:* 1 [@-b-a] 2 _ b:*) MAC1 3 MAC1 4 => {* 1 -4 2 _ *} 3 MAC1 4 => * 1 -4 2 3 * MAC1 4 => * 1 -4 2 3 * {* 1 -4 2 _ *} 4    => * 1 -4 2 3 * * 1 -4 2 4 *    MAC2(a:* 1 [@-b-a - _ ] 2 b:*) MAC2 3 MAC2 4 => {* 1 [@-b-a - _ ] 2 *} 3 MAC1 4 => * 1 [@-b-a - 3 ] 2 * MAC1 4 => * 1 -6 2 * MAC1 4 => * 1 -6 2 * {* 1 [@-b-a - _ ] 2 *} 4 => * 1 -6 2 * * 1 [@-b-a - 4 ] 2 * => * 1 -6 2 * * 1 -7 2 *   MAC3(?[q-@] _ *) MAC3 1 2 q:3 MAC3 4 => {[q-@] _ *} 1 2 q:3 MAC3 4 => 4 1 * 2 q:3 MAC3 4 => 4 1 * 2 q:3 {[q-@] _ *} 4 => 4 1 * 2 q:3 -1 4 * EOL use strict; use integer; use bigint; use vars qw/ $opt_h $opt_b $opt_c $opt_d $opt_v $opt_l $opt_r /; use Getopt::Std; use File::Slurp; use Data::Dumper; my @source; my %macro = ; my %loc_tag = ; my %at = ; our $u = "_"; getopts('bcdhvlr'); print($usage), exit 0 if $opt_h; print($language), exit 0 if $opt_l; $_ = ( join('', <>) ); sub pre_proc_source { my $s = $_[0]; # ";" through end of line are comments $s =~ s/;[^\n]*\n/ /sg; # get rid of all the newlines and extra spaces $s =~ s/\s+/ /sg; $s =~ s/(^\s*|\s*$)//g; # uniquely identify all @ signs $u .= "_" while $s =~ s/\@([^_])/\@$u$1/; return $s; } dbg_print; if ($opt_r) { # Bypass compilation stages 1 through 4 # Just split up the source on whitespace # get rid of all newlines and extra spaces s/\s+/ /sg; s/(^\s*|\s*$)//g; my @p = split /\s+/, $_; @source = map { { stage => 4, val => $_ } } @p; } else { # stage 1: source with all the comments and extra whitespace stripped out #         all "@" tokens are uniquely identified $source[0] = { stage => 1, val => pre_proc_source($_) }; # @source is a list of tokens. Some are unprocessed (stage 1) strings # containing 0 or more expressions. This loop continually finds the first # unprocessed string and processes it using proc_expr. Some of the # expressions that proc_expr finds may need processed expressions that # follow. In that case, proc_expr is called recursively. my $last_i = 0; while (defined(my $i = (grep { $source[$_]{stage} == 1 }                          $last_i .. $#source)[0])) { # @source from 0 up to $i is past stage 1, so skip on the next iteration $last_i = $i; proc_expr($i, 0); }  stage_3; stage_4; } sub proc_expr { my $i = shift; my $mac_proc = shift; my $dbg_supp = 0; my $s_ref = $source[$i]; $s_ref->{val} =~ s/^\s*//; my $s = $s_ref->{val}; if ($s =~ /^$/) { # empty source string # delete this entry # shift over any tags to next source element if (keys %{$source[$i]->{tags}}) { if ($i != $#source) { $source[$i+1]{tags}{$_} = 1 for keys %{$source[$i]->{tags}} } else { # if we are at the end of the source then preserve # the tag(s) on the end $source[$i]{stage} = 2; return; }    }     splice @source, $i, 1; $dbg_supp = 1; } elsif ($s =~ s/ ^ ( ( ( [+-]? \d+ | \* ) ( \s+ | $ ) ){1,1000} ) //x) { # numbers and "*"s # take whole sequences of these at once # (this makes parsing code that has already been processed much faster) my $p = $1; splice @source, $i+1, 0, { stage => 1, val => $s }; $p =~ s/\s+$//; my @p = split /\s+/, $p; $source[$i]{val} = shift(@p); $source[$i]{stage} = 2; splice @source, $i+1, 0, map { { stage => 2, val => $_ } } @p; } elsif ($s =~ s/^&(\S+)//) { # file inclusion $source[$i]{val} = pre_proc_source(scalar(read_file($1))); splice @source, $i+1, 0, { stage => 1, val => $s }; } elsif ($s_ref->{val} =~ s/^(\w+):\s*//) { # location tag $source[$i]{tags}{$1} = 1; } elsif ( $s_ref->{val} =~            s/^ \+? (\d++) ( \( ( (?: [^]++ | (?2) )* ) \) )              / "$3 " x (0+$1) /ex ) { # repeat group } elsif ( $s_ref->{val} =~            s/^ (\w++) \s* ( \( ( (?: [^]++ | (?2) )* ) \) ) //x ) { # macro declaration my ($name, $def) = ($1, $3); $def =~ s/^\s*[-+]\s+(\S)\s*$/_ $1/; $def =~ s/^\s*(\S)\s+[-+]\s*$/$1 _/; $macro{$name} = [ undef, $def ]; #pre_proc_macro($name, $def); $dbg_supp = 1; } elsif ($s =~ s/^ ( \[ ( (?: [^][]++ | (?1) )* ) \] ) //x) { # calculation expression # perform the calculation after all the code has been read in     $source[$i]{val} = $1; $source[$i]{stage} = 2; splice @source, $i+1, 0, { stage => 1, val => $s }; } elsif ($s =~ s/^"([^"]++)"//) {    # character     my @chars = map { ord }  split(//, $1);     $source[$i]{val} = shift @chars;     $source[$i]{stage} = 2;     splice @source, $i+1, 0,       ( ( map { { stage => 2, val => $_ } } @chars ),         { stage => 1, val => $s } );   } elsif ($mac_proc && $s =~ s/^_+//) {     # an underscore in a macro     splice @source, $i+1, 0, { stage => 1, val => $s };     $source[$i]{val} = "_";     $source[$i]{stage} = 2;   } elsif ($s =~ s/^(\w+)//) {     # macro invocation     my $name = $1;     splice @source, $i+1, 0, { stage => 1, val => $s };     die "undefined macro $1" unless exists($macro{$name});     pre_proc_macro($name) unless defined($macro{$name}[0]);     proc_macro($i, $mac_proc, $source[$i]{val} = $macro{$name}[0]);   } else {     die "\n................\n" . Dumper(@source) . "\n\ndied";   }   dbg_print unless $dbg_supp; } sub pre_proc_macro { my $m = shift; if ($macro{$m}[1] =~ /^\?/) { $macro{$m}[0] = $macro{$m}[1]; $macro{$m}[0] =~ s/^\?//; return; }  my @tmp_source = @source; @source = ( { stage => 1, val => pre_proc_source($macro{$m}[1]) } ); $source[0]{val} =~ s/^\s*[-+]\s+(\S)\s*$/_ $1/; $source[0]{val} =~ s/^\s*(\S)\s+[-+]\s*$/$1 _/; print "Macro $m:\n" if $opt_v; dbg_print; my $last_i = 0; while (defined(my $i = (grep { $source[$_]{stage} == 1 }                          $last_i .. $#source)[0])) { $last_i = $i; proc_expr($i, 1); }  stage_3; stage_4(1); $_->{tags} = for @source; dbg_print; print "Done Processing Macro $m:\n" if $opt_v; $macro{$m}[0] = join " ", map { $_->{val} } @source; @source = @tmp_source; %loc_tag = ; } sub proc_macro { my $i = shift; my $mac_proc = shift; my $expr = shift; my @u = ; # search for underscores my $p = 0; while ($expr =~ / .{$p} (?: ^ | (?<=\s) ) (_+) (?= (?: \s | $ ) )/x) { my $p2 = length $'; my $ul = length $1; $source[$i]{val} = $expr; # only to make dbg_print nicer dbg_print; if ($ul == 1) { # make sure a processed value is available to put into it      while ($source[$i + 1]{stage} == 1) { proc_expr($i + 1, $mac_proc); }      my $u = splice @source, $i + 1, 1; # save the underscore in @u push @u, join(":", sort(keys %{$u->{tags}}), ""). $u->{val}; }    $expr =~ s/ (.{$p}) (?: ^ | (?<=\s) ) _+ (?= (?: \s | $ ) )/ $1. $u[-1] /ex; $p = length($expr) - $p2; }  $source[$i]{val} = $expr; } sub dbg_print { return unless $opt_v; print join(" ",         map {            # get rid of before & after whitespace            $_->{val} =~ s/^\s+//;            $_->{val} =~ s/\s+$//;            my $x =              # prefix value with tags              join(":", sort(keys %{$_->{tags}}), "")                .                  # surround stage 1 values in single quotes                  ( $_->{stage} > 1 ? $_->{val} : "'". $_->{val}. "'" );           $x =~ s/\@_+/@/g; $x }          grep {            # filter out empty tokens ...            $_->{val} !~ /^\s*$/ ||              # unless they are tagged              scalar(keys %{$_->{tags}}) > 0 } @source), #"\n"; "\n\n"; } sub stage_3 { # stage 3 # determine the location of each tag for my $i (0 .. $#source) { $source[$i]{stage} = 3; for (keys %{$source[$i]{tags}}) { $loc_tag{$_} = $i + 1 unless defined $loc_tag{$_}; }  } } sub stage_4 { # stage 4 # calculate each expression & populate the stack # accomodate macros that have underscores in expressions my $m = shift; for my $i (0 .. $#source) { $source[$i]{stage} = 4; if ($source[$i]{val} =~ /^ ( \[ ( (?: [^][]++ | (?1) )* ) \] ) /x) { my $e = $2; next if $m && $e =~ / (?: ^ | (?<=\s) ) _+ (?= (?: \s | $ ) )/x; $e =~ s/\[/(/g;      $e =~ s/\]/)/g; $e =~ s/#/$i+1/eg; while ($e =~ /(\@_+)/s) { my $m = $1; $at{$m} = $i + 1 unless defined $at{$m}; $e =~ s/$m(?!_)/ $at{$m} /eg; }      $e =~ s/(?<!\w)$_(?!\w)/$loc_tag{$_}/eg for keys %loc_tag; $source[$i]{val} = "[". $e. "]"; dbg_print; #debug $source[$i]{val} = eval($e); dbg_print; }    #push @stack, $source[$i]{val} eq "*" ? undef : $source[$i]{val}; }  # pop any trailing location tags pop @source if $source[-1]{val} eq ""; } print(join(" ", map { $_->{val} } @source), $opt_b ? "!" : ""), exit if $opt_c; my @stack = map { $_->{val} eq "*" ? undef : $_->{val} } @source; @source = ; my %ops; %ops = ( "*" =>    { "*" => # * *       sub { exit 0; },       "0" => # * 0       sub { defined(my $c = getc) or exit 0;             push(@stack, ord($c)); },       "1" => # * +       sub { splice @stack, 0, $_[1]; },       "-1" => # * -       sub { my $Y = $stack[1];             push @stack, reverse(splice(@stack, $_[1], -$_[1])); }     },     "0" =>     { "*" => # 0 *       sub { print chr(pop @stack); },       "0" => # 0 0       sub { my $s = pop @stack;             push @stack, $s ? -$s : defined($s) ? undef : 0; },       "1" => # 0 +       sub { push @stack, ( $stack[-1] ) x $_[1]; },       "-1" => # 0 -       sub { @stack = reverse @stack if !$stack[$_[1]]; }     },     "1" =>     { "*" => # + *       sub { my $a = shift;             splice @stack, -$a, $a, (grep {!defined} @stack[-$a..-1])               ? undef                 : do { my $b =0; $b += $_ for @stack[-$a..-1]; $b }; }, "0" => # + 0      sub { splice @stack, -shift; }, "1" => # + +      sub { my $a = $stack[(shift)-1]; my $b = $stack[(shift)-1]; $ops{defined($a) ? $a <=> 0 : "*"} {defined($b) ? $b <=> 0 : "*"}->($a, $b); }, "-1" => # + -      sub { my $a = (shift)-1; my $b = shift; @stack[$a, $b] = @stack[$b, $a]; } },    "-1" =>     { "*" => # - *       sub { @stack[$_[0], -1] = @stack[-1, $_[0]]; }, "0" => # - 0      sub { splice @stack, shift, 1; }, "1" => # - +      sub { push @stack, ($stack[$_[0]] / $_[1]) + 0; }, "-1" => # - -      sub { my $a = shift; my $b = shift; push @stack, @stack[$a > $b ? reverse($b .. $a) : $a .. $b]; } } ); if ($opt_d) {  $ops{"0"}{"*"} = sub { print "\"", chr(pop @stack), "\"\n"; };   while (@stack) {     print join(" ", map { defined($_) ? $_ : "*" } @stack), "\n";    my ($a, $b) = splice @stack, 0, 2;     $ops{defined($a) ? $a <=> 0 : "*"}{defined($b) ? $b <=> 0 : "*"}->($a, $b);   } } else {   while (@stack) {     my ($a, $b) = splice @stack, 0, 2;     $ops{defined($a) ? $a <=> 0 : "*"}{defined($b) ? $b <=> 0 : "*"}->($a, $b);   } } exit 0;
 * 1) !/usr/bin/perl -w
 * 1) my @stack = ;
 * 1) stage 0: raw source
 * 1) we're done if all we want is the source printout
 * 1) stage 5
 * 2) populate the stack array
 * 1) clear up some memory

SMITHb interpreter in C
smithb.c /* SMITHb interpreter by Nathan Thern see http://esolangs.org/wiki/SMITHb for more information about SMITHb license: Public Domain */ typedef enum { NUL, ZERO, POS, NEG } ops; typedef struct { ops op; mpz_t num; } stk_elem; typedef enum { FALSE, TRUE } TF; void proc_fwd; void proc_rev; void swap_elem(stk_elem* a, stk_elem* b); void set_elem(stk_elem* a, stk_elem* b); void parse(FILE *f, TF opt_b); void add_alloc(unsigned long long count); void bot_alloc(unsigned long long count); void dbg_print; void dbg_print_rev; stk_elem* stack = NULL; stk_elem* st_bot; stk_elem* st_top; unsigned long long st_alloc = 0; TF opt_d = FALSE; int main (int argc, char** argv) { TF opt_b = FALSE; FILE* inp; argv++; while ( argc > 1 ) { if ( !strcmp(*argv, "-h") ) { fprintf(stdout, "Rudimentary SMITHb interpreter.\n"); fprintf(stdout, "Usage: %s [options] [file]\n", *(argv-1)); fprintf(stdout, "Options:\n"); fprintf(stdout, " -h\tthis help\n"); fprintf(stdout, " -d\tdebug mode: print the stack after each operation\n"); fprintf(stdout, " -b\tdesignate the \"!\" character to mean the end of the SMITHb source.\n"); fprintf(stdout, "   \t All subsequent input is input to the program\n"); fprintf(stdout, "   \t Only valid when source is on STDIN\n"); exit(EXIT_SUCCESS); } else if ( !strcmp(*argv, "-b") ) { opt_b = TRUE; argc--; argv++; } else if ( !strcmp(*argv, "-d") ) { opt_d = TRUE; argc--; argv++; } else { break; }  }   // initialize the array st_top = stack; st_bot = stack; add_alloc(1); st_top = stack - 1; st_bot = stack; if ( argc == 1 ) { parse(stdin, opt_b); inp = stdin; } else { if ( !strcmp(*argv, "-") ) { parse(stdin, opt_b); inp = stdin; } else { if (opt_b) { perror ("-b option not valid in conjunction with command line arguments"); exit(EXIT_FAILURE); }      inp = fopen (*argv, "r"); if ( ! inp ) { perror ("Can't open input file"); exit(EXIT_FAILURE); }      parse(inp, opt_b); fclose(inp); }  }   proc_fwd; exit(EXIT_SUCCESS); } void proc_fwd { char ch; unsigned long long a;  unsigned long long b;   stk_elem* st_a; stk_elem* st_b; while (st_top - st_bot >= 1) { dbg_print; switch ((st_bot++)->op) { case NUL: switch ((st_bot++)->op) { case NUL: // * * exit(EXIT_SUCCESS); case ZERO: // * 0 ch = getc(stdin); if ( ch != EOF ) { add_alloc(1); mpz_set_ui((++st_top)->num, ch); st_top->op = ch > 0 ? POS : ZERO; } else { perror("No input available to program"); exit(EXIT_FAILURE); }        break; case POS: // * + st_bot += mpz_get_ui((st_bot-1)->num); break; case NEG: // * - for ( st_a = st_top, st_b = st_top - mpz_get_ui((st_bot-1)->num) + 1;              st_b < st_a; st_b++, st_a-- ) { swap_elem(st_a, st_b); }      }       break; case ZERO: switch (st_bot++->op) { case NUL: // 0 * putc((char) mpz_get_si((st_top--)->num), stdout); if (opt_d) { putc(10, stdout); }        break; case ZERO: // 0 0 switch (st_top->op) { case NUL: st_top->op = ZERO; mpz_set_ui(st_top->num, 0); break; case ZERO: st_top->op = NUL; break; case POS: st_top->op = NEG; mpz_neg(st_top->num, st_top->num); break; case NEG: st_top->op = POS; mpz_neg(st_top->num, st_top->num); }        break; case POS: // 0 + b = mpz_get_ui((st_bot-1)->num); add_alloc(b); st_b = st_top + b;        for (st_top < st_b ; st_top++ ) { set_elem(st_top + 1, st_top); }        break; case NEG: // 0 - if (!mpz_sgn((st_top - mpz_get_ui((st_bot-1)->num) + 1)->num)) { proc_rev; }      }       break; case POS: switch (st_bot++->op) { case NUL: // + * st_a = st_top - mpz_get_ui((st_bot-2)->num) + 1; if ( st_top->op == NUL ) { st_top = st_a; st_top->op = NUL; break; }        while ( st_top > st_a ) { if ( (--st_top)->op == NUL ) { st_top = st_a; st_top->op = NUL; break; }          mpz_add(st_top->num, st_top->num, (st_top+1)->num); }        if ( st_top->op != NUL ) { switch (mpz_sgn(st_top->num)) { case 0: st_top->op = ZERO; break; case 1: st_top->op = POS; break; case -1: st_top->op = NEG; }        }         break; case ZERO: // + 0 st_top -= mpz_get_ui((st_bot-2)->num); break; case POS: // + + st_bot--; set_elem(st_bot, st_bot + mpz_get_ui(st_bot->num)); st_bot--; set_elem(st_bot, st_bot + mpz_get_ui(st_bot->num) + 1); break; case NEG: // + - swap_elem(st_bot + mpz_get_ui((st_bot-2)->num) - 1,                  st_top - mpz_get_ui((st_bot-1)->num) + 1); }      break; case NEG: switch (st_bot++->op) { case NUL: // - * swap_elem(st_top, st_top - mpz_get_ui((st_bot-2)->num) + 1); break; case ZERO: // - 0 for (st_a = st_top-- - mpz_get_ui((st_bot-2)->num) + 1;             st_a <= st_top; st_a++ ) { set_elem(st_a, st_a + 1); }        break; case POS: // - + add_alloc(1); st_top++; mpz_tdiv_q(st_top->num,                   (st_top - mpz_get_ui((st_bot-2)->num))->num,                    (st_bot-1)->num); switch (mpz_sgn(st_top->num)) { case 0: st_top->op = ZERO; break; case 1: st_top->op = POS; break; case -1: st_top->op = NEG; }        break; case NEG: // - - a = mpz_get_ui((st_bot-2)->num); b = mpz_get_ui((st_bot-1)->num); add_alloc(abs(a-b)+1); st_a = st_top - a + 1; st_b = st_top - b + 1; if ( st_a < st_b ) { for (st_a <= st_b ; st_a++ ) { set_elem(++st_top, st_a); }        } else { for (st_a >= st_b ; st_a-- ) { set_elem(++st_top, st_a); }        }       }     }   } } void proc_rev { char ch; unsigned long long a;  unsigned long long b;   stk_elem* st_a; stk_elem* st_b; while (st_top - st_bot >= 1) { dbg_print_rev; switch ((st_top--)->op) { case NUL: switch ((st_top--)->op) { case NUL: // * * exit(EXIT_SUCCESS); case ZERO: // * 0 ch = getc(stdin); if ( ch != EOF ) { bot_alloc(1); mpz_set_ui((--st_bot)->num, ch); st_bot->op = ch > 0 ? POS : ZERO; } else { perror("No input available to program"); exit(EXIT_FAILURE); }        break; case POS: // * + st_top -= mpz_get_ui((st_top+1)->num); break; case NEG: // * - for ( st_a = st_bot, st_b = st_bot + mpz_get_ui((st_top+1)->num) - 1;              st_b > st_a; st_b--, st_a++ ) { swap_elem(st_a, st_b); }      }       break; case ZERO: switch ((st_top--)->op) { case NUL: // 0 * putc((char) mpz_get_si((st_bot++)->num), stdout); if (opt_d) { putc(10, stdout); }        break; case ZERO: // 0 0 switch (st_bot->op) { case NUL: st_bot->op = ZERO; mpz_set_ui(st_bot->num, 0); break; case ZERO: st_bot->op = NUL; break; case POS: st_bot->op = NEG; mpz_neg(st_bot->num, st_bot->num); break; case NEG: st_bot->op = POS; mpz_neg(st_bot->num, st_bot->num); }        break; case POS: // 0 + b = mpz_get_ui((st_top+1)->num); bot_alloc(b); st_b = st_bot - b;        for (st_bot > st_b ; st_bot-- ) { set_elem(st_bot - 1, st_bot); }        break; case NEG: // 0 - if (!mpz_sgn((st_bot + mpz_get_ui((st_top+1)->num) - 1)->num)) { return; }      }       break; case POS: switch ((st_top--)->op) { case NUL: // + * st_a = st_bot + mpz_get_ui((st_top+2)->num) - 1; if ( st_bot->op == NUL ) { st_bot = st_a; st_bot->op = NUL; break; }        while ( st_bot < st_a ) { if ( (++st_bot)->op == NUL ) { st_bot = st_a; st_bot->op = NUL; break; }          mpz_add(st_bot->num, st_bot->num, (st_bot-1)->num); }        if ( st_bot->op != NUL ) { switch (mpz_sgn(st_bot->num)) { case 0: st_bot->op = ZERO; break; case 1: st_bot->op = POS; break; case -1: st_bot->op = NEG; }        }         break; case ZERO: // + 0 st_bot += mpz_get_ui((st_top+2)->num); break; case POS: // + + st_top++; set_elem(st_top, st_top - mpz_get_ui(st_top->num)); st_top++; set_elem(st_top, st_top - mpz_get_ui(st_top->num) - 1); break; case NEG: // + - swap_elem(st_top - mpz_get_ui((st_top+2)->num) + 1,                  st_bot + mpz_get_ui((st_top+1)->num) - 1); }      break; case NEG: switch ((st_top--)->op) { case NUL: // - * swap_elem(st_bot, st_bot + mpz_get_ui((st_top+2)->num) - 1); break; case ZERO: // - 0 for (st_a = st_bot++ + mpz_get_ui((st_top+2)->num) - 1;             st_a >= st_bot; st_a-- ) { set_elem(st_a, st_a - 1); }        break; case POS: // - + bot_alloc(1); st_bot--; mpz_tdiv_q(st_bot->num,                   (st_bot + mpz_get_ui((st_top+2)->num))->num,                    (st_top+1)->num); switch (mpz_sgn(st_bot->num)) { case 0: st_bot->op = ZERO; break; case 1: st_bot->op = POS; break; case -1: st_bot->op = NEG; }        break; case NEG: // - - a = mpz_get_ui((st_top+2)->num); b = mpz_get_ui((st_top+1)->num); bot_alloc(abs(a-b)+1); st_a = st_bot + a - 1; st_b = st_bot + b - 1; if ( st_a > st_b ) { for (st_a >= st_b ; st_a-- ) { set_elem(--st_bot, st_a); }        } else { for (st_a <= st_b ; st_a++ ) { set_elem(--st_bot, st_a); }        }       }     }   } } void parse(FILE *f, TF opt_b) { char ch; int in_digit = 0; while ( (ch = getc (f)) != EOF ) { if ( ch == ' ' || ch == '\n' || ch == '\r' || ch == '\t' ) { in_digit = 0; } else if ( ch == '+' ) { add_alloc(1); st_top++; in_digit = 1; } else if ( ch == '-' ) { add_alloc(1); st_top++; in_digit = -1; } else if ( ch == '*' ) { add_alloc(1); (++st_top)->op = NUL; in_digit = 0; } else if ( ch >= '0' && ch <= '9' ) { switch (in_digit) { case 0: in_digit = 1; st_top++; add_alloc(1); case 1: mpz_mul_ui(st_top->num, st_top->num, 10); mpz_add_ui(st_top->num, st_top->num, ch - '0'); break; case -1: mpz_mul_ui(st_top->num, st_top->num, 10); mpz_sub_ui(st_top->num, st_top->num, ch - '0'); }      switch (mpz_sgn(st_top->num)) { case 0: st_top->op = ZERO; break; case 1: st_top->op = POS; break; case -1: st_top->op = NEG; }    } else if ( opt_b && ch == '!' ) { break; }  } } void add_alloc(unsigned long long count) { // do we need to adjust the stack? if ( ( ( st_top - stack ) + count ) >= st_alloc ) { // should we just shift the stack down? if ( ( st_bot - stack > 2*STACK_INIT ) &&         ( st_alloc - ( st_top - st_bot + STACK_INIT + 1) >= count ) ) { // shift the stack down stk_elem* i = stack + STACK_INIT; stk_elem* j = st_bot; while ( j <= st_top ) { set_elem(i++, j++); }      st_top = i - 1; st_bot = stack + STACK_INIT; } else { unsigned long long st_init = st_alloc; unsigned long long st_bot_tmp = st_bot - stack; unsigned long long st_top_tmp = st_top - stack; st_alloc += ( STACK_INIT >= count ? STACK_INIT : count ); void *_tmp = realloc(stack, (st_alloc * sizeof(stk_elem))); if (!_tmp) { fprintf(stderr, "ERROR: Couldn't realloc memory!\n"); exit(EXIT_FAILURE); }      stack = (stk_elem*)_tmp; st_bot = stack + st_bot_tmp; st_top = stack + st_top_tmp; while ( st_init < st_alloc ) { mpz_init(stack[st_init++].num); }    }   } } void bot_alloc(unsigned long long count) { stk_elem* st_a; if ( st_bot - stack < count ) { count += STACK_INIT; add_alloc(count); for ( st_a = st_top; st_a >= st_bot; st_a-- ) { set_elem(st_a + count, st_a); }    st_bot += count; st_top += count; } } void swap_elem(stk_elem* a, stk_elem* b) { ops tmp_op = a->op; a->op = b->op; b->op = tmp_op; mpz_swap(a->num, b->num); } void set_elem(stk_elem* a, stk_elem* b) { a->op = b->op; mpz_set(a->num, b->num); } void dbg_print { stk_elem* x;  if (!opt_d) { return; }  for ( x = st_bot ; x <= st_top ; x++ ) { if (x->op == NUL ) { printf("*%s", x == st_top ? "" : " "); } else { gmp_printf("%Zd%s", x->num, x == st_top ? "" : " "); }  }   printf("\n"); } void dbg_print_rev { stk_elem* x;  if (!opt_d) { return; }  for ( x = st_top ; x >= st_bot ; x-- ) { if (x->op == NUL ) { printf("*%s", x == st_top ? "" : " "); } else { gmp_printf("%Zd%s", x->num, x == st_top ? "" : " "); }  }   printf("\n"); }
 * 1) include <gmp.h>
 * 2) include <stdio.h>
 * 3) include <stdlib.h>
 * 1) define STACK_INIT 1024

brainfuck-to-SMITHb translator
bf2smithb.pl my $usage =<<EOU; bf2smithb.pl - converts brainfuck to SMITHb see http://esolangs.org/wiki/SMITHb for more information on SMITHb -h     This help The output of this converter is highly macro-ized SMITHb code. Use the -c option of smithb.pl to convert to raw SMITHb code e.g.: ./bf2smithb.pl primes.bf | ./smithb.pl -c > primes.smb Or, to run the code in the C interpreter, which has no macro processing: ./bf2smithb.pl primes.bf | ./smithb.pl -c | ./smithb.exe license: Public Domain EOU use strict; use vars qw/ $opt_h $opt_b /; use Getopt::Std; getopts('hb'); print($usage), exit 0 if $opt_h; my $lc = 0; my @lc = ; my $SMBcode = <<'MACROS'; STOP (* *) PUTC (0 *) GETC (* 0) NEG (0 0) DUPXY(- -) DIV (- +) SWAP (+ -) EXEC (+ +) DELX (+ 0) DEL1 (- 0) SUM (+ *) SWAPX(- *) DUPY (0 +) REV (0 -) DELY (* +) REVY (* -) NOOP(REVY -1) DUP1 (DUPY 1) SUM2 (SUM 2) POP (DELX 1) PUSH(DUP1 SWAP [ A - @ - 1 ] -1 DELY 1 A: _) SWITCH(SWAPX -2) PUSHCMD2(DUPY [(C-B)/2-1]         SWAP B: [C-@+(@-B)/2-1] A: [(A-@)/2-1]          SWAP    [C-@+(@-B)/2-1]    [(A-@)/2-1]          SWAP    [C-@+(@-B)/2-1]    [(A-@)/2-1]          SWAP    [C-@+(@-B)/2-1]    [(A-@)/2-1]          DELY [(C-B)/2-1] C:) NOP2(0 0 0 0) BFADD( DUP1 SWAP [BFI2-@-1] -1 POP EXEC [BFI1-@-1] [BFI1-@+1]       PUSH _ SUM2 BFI1:REVY BFI2:*) BFMANYLEFT(PUSH [0- _ ] SUM2) BFINC(BFADD 1) BFDEC(BFADD -1) BFLEFT(BFMANYLEFT 1) BFRIGHT( DUPY 6 SWAP [a-@-1] -1 SUM2         SWITCH SWAP [b-@-1] -1 SWAP [c-@-1] -3 SWAP [c-@] -4          REV -2 g:DELX 4 SWAP [d-@-1] -1 SUM2 DELY [e-a]          a:2 b:[f-g] c:REV -4 d:1          f:SWAP 2 -1 REVY 0 e: ) BFPUTC( SWAP [BFP1-@] -1 EXEC [BFP1-@-1] [BFP1-@+1] DUP1 PUTC        EXEC [BFP1-@-1] [BFP1-@+1] SWAP [BFP1-@] -1 BFP1:NOOP ) BFGETC( SWAP [BFG1-@] -1 EXEC [BFG1-@-1] [BFG1-@+1] POP GETC        EXEC [BFG1-@-1] [BFG1-@+1] SWAP [BFG1-@] -1 BFG1:NOOP ) MACROS my $tst1 = " NOP2"; my %ops = ( "<" => sub { $SMBcode .= "BFLEFT$tst1\n" },    ">" => sub { $SMBcode .= "BFRIGHT$tst1\n" },     "+" => sub { $SMBcode .= "BFINC$tst1\n" },     "-" => sub { $SMBcode .= "BFDEC$tst1\n" },     "," => sub { $SMBcode .= "BFGETC$tst1\n" },     "." => sub { $SMBcode .= "BFPUTC$tst1\n" },     "[" => sub { push @lc, $lc++; my $lt = $lc[-1]; $SMBcode .= <<OPENLOOP; 2(BFB2_$lt:DUPY 2 SWAP [ BFB4_$lt - @ - 1 ] -1 SUM2 SWAP [ BFB4_$lt - @ - 1 ] -1 POP PUSHCMD2 DELX [ BFB1_$lt - BFB3_$lt + BFB1_$lt - BFB2_$lt ] REV -1 REV BFB4_$lt:-4 BFB3_$lt:DELX 4 OPENLOOP },    "]" => sub { my $lt = $lc[-1]; $SMBcode .= <<CLOSELOOP; PUSHCMD2 DUPXY [ BFB2_$lt - BFB1_$lt ] -1 REV -1 REV -3 BFB1_$lt: ) NOOP CLOSELOOP                 pop @lc; }   ); my $BFcode = ( join('', <>) ); $BFcode =~ s/[^-+<>\[\]\.,]//sg; for my $c (reverse("A".."Z")) { my $l = ord($c) - ord("A") + 2; while ($BFcode =~ s/ \+{$l} / $c /ex) { $ops{$c} = sub { $SMBcode .= "BFADD $l$tst1\n" } unless defined($ops{$c}); } } for my $c (reverse("a".."z")) { my $l = ord($c) - ord("a") + 2; while ($BFcode =~ s/ \-{$l} / $c /ex) { $ops{$c} = sub { $SMBcode .= "BFADD ". (0 - $l). "$tst1\n" } unless defined($ops{$c}); } } for my $c (reverse("0".."9")) { my $l = ord($c) - ord("0") + 2; while ($BFcode =~ s/ <{$l} / $c /ex) { $ops{$c} = sub { $SMBcode .= "BFMANYLEFT $l$tst1\n" } unless defined($ops{$c}); } } my @BFcode = split '', $BFcode; defined($ops{$_}) && $ops{$_}-> for @BFcode; $SMBcode .= "STOP STOP STOP 0 -2\n"; print "$SMBcode\n";
 * 1) !/usr/bin/perl -w
 * 1) $tst1 = "";
 * 1) read in the BF code and parse out all non-BF characters
 * 1) collapse up to 27 +'s into a single instruction
 * 2) ("A" is 2 +'s, "Z" is 27 +'s)
 * 3) create the operations for these characters on the fly
 * 1) collapse up to 27 -'s into a single instruction
 * 2) ("a" is 2 -'s, "z" is 27 -'s)
 * 3) create the operations for these characters on the fly
 * 1) collapse up to 11 <'s into a single instruction
 * 2) ("0" is 2 <'s, "9" is 11 <'s)
 * 3) create the operations for these characters on the fly
 * 1) This one line does the real work of parsing brainfuck code

brainfuck interpreter in SMITHb
Created with the following command $ perl bf2smithb.pl dbfi.bf > dbfi_bf.smb Utilizes Nate Thern's macro extensions to SMITHb. Convert to raw SMITHb with the command $ perl smithb.pl -c dbfi_bf.smb > dbfi_bf_raw.smb

dbfi_bf.smb STOP (* *) PUTC (0 *) GETC (* 0) NEG (0 0) DUPXY(- -) DIV (- +) SWAP (+ -) EXEC (+ +) DELX (+ 0) DEL1 (- 0) SUM (+ *) SWAPX(- *) DUPY (0 +) REV (0 -) DELY (* +) REVY (* -) NOOP(REVY -1) DUP1 (DUPY 1) SUM2 (SUM 2) POP (DELX 1) PUSH(DUP1 SWAP [ A - @ - 1 ] -1 DELY 1 A: _) SWITCH(SWAPX -2) PUSHCMD2(DUPY [(PC2C-PC2B)/2-1]         SWAP PC2B: [PC2C-@+(@-PC2B)/2-1] PC2A: [(PC2A-@)/2-1]          SWAP       [PC2C-@+(@-PC2B)/2-1]       [(PC2A-@)/2-1]          SWAP       [PC2C-@+(@-PC2B)/2-1]       [(PC2A-@)/2-1]          SWAP       [PC2C-@+(@-PC2B)/2-1]       [(PC2A-@)/2-1]          DELY [(PC2C-PC2B)/2-1] PC2C:) NOP2(0 0 0 0) BFADD( DUP1 SWAP [BFI2-@-1] -1 POP EXEC [BFI1-@-1] [BFI1-@+1]       PUSH _ SUM2 BFI1:REVY BFI2:*) BFMANYLEFT(PUSH [0- _ ] SUM2) BFINC(BFADD 1) BFDEC(BFADD -1) BFLEFT(BFMANYLEFT 1) BFRIGHT( DUPY 6 SWAP [a-@-1] -1 SUM2         SWITCH SWAP [b-@-1] -1 SWAP [c-@-1] -3 SWAP [c-@] -4          REV -2 g:DELX 4 SWAP [d-@-1] -1 SUM2 DELY [e-a]          a:2 b:[f-g] c:REV -4 d:1          f:SWAP 2 -1 REVY 0 e: ) BFPUTC( SWAP [BFP1-@] -1 EXEC [BFP1-@-1] [BFP1-@+1] DUP1 PUTC        EXEC [BFP1-@-1] [BFP1-@+1] SWAP [BFP1-@] -1 BFP1:NOOP ) BFGETC( SWAP [BFG1-@] -1 EXEC [BFG1-@-1] [BFG1-@+1] POP GETC        EXEC [BFG1-@-1] [BFG1-@+1] SWAP [BFG1-@] -1 BFG1:NOOP ) BFRIGHT NOP2 BFRIGHT NOP2 BFRIGHT NOP2 BFINC NOP2 2(BFB2_0:DUPY 2 SWAP [ BFB4_0 - @ - 1 ] -1 SUM2 SWAP [ BFB4_0 - @ - 1 ] -1 POP PUSHCMD2 DELX  [ BFB1_0 - BFB3_0 + BFB1_0 - BFB2_0 ] REV -1 REV BFB4_0:-4 BFB3_0:DELX 4   2(BFB2_1:DUPY 2 SWAP [ BFB4_1 - @ - 1 ] -1 SUM2 SWAP [ BFB4_1 - @ - 1 ] -1 POP PUSHCMD2 DELX [ BFB1_1 - BFB3_1 + BFB1_1 - BFB2_1 ] REV -1 REV BFB4_1:-4 BFB3_1:DELX 4 BFDEC NOP2 PUSHCMD2 DUPXY [ BFB2_1 - BFB1_1 ] -1 REV -1 REV -3 BFB1_1: )  NOOP BFRIGHT NOP2 BFRIGHT NOP2   2(BFB2_2:DUPY 2 SWAP [ BFB4_2 - @ - 1 ] -1 SUM2 SWAP [ BFB4_2 - @ - 1 ] -1 POP PUSHCMD2 DELX [ BFB1_2 - BFB3_2 + BFB1_2 - BFB2_2 ] REV -1 REV BFB4_2:-4 BFB3_2:DELX 4 BFDEC NOP2 PUSHCMD2 DUPXY [ BFB2_2 - BFB1_2 ] -1 REV -1 REV -3 BFB1_2: )  NOOP BFADD 2 NOP2 BFRIGHT NOP2 BFINC NOP2 BFRIGHT NOP2 BFADD 7 NOP2   2(BFB2_3:DUPY 2 SWAP [ BFB4_3 - @ - 1 ] -1 SUM2 SWAP [ BFB4_3 - @ - 1 ] -1 POP PUSHCMD2 DELX [ BFB1_3 - BFB3_3 + BFB1_3 - BFB2_3 ] REV -1 REV BFB4_3:-4 BFB3_3:DELX 4 BFLEFT NOP2 BFADD 4 NOP2 BFRIGHT NOP2 BFRIGHT NOP2 BFADD 2 NOP2 BFLEFT NOP2 BFDEC NOP2 PUSHCMD2 DUPXY [ BFB2_3 - BFB1_3 ] -1 REV -1 REV -3 BFB1_3: )  NOOP BFADD 2 NOP2 BFRIGHT NOP2 BFRIGHT NOP2 BFINC NOP2 BFRIGHT NOP2 BFINC NOP2 BFRIGHT NOP2 BFADD 5 NOP2   2(BFB2_4:DUPY 2 SWAP [ BFB4_4 - @ - 1 ] -1 SUM2 SWAP [ BFB4_4 - @ - 1 ] -1 POP PUSHCMD2 DELX [ BFB1_4 - BFB3_4 + BFB1_4 - BFB2_4 ] REV -1 REV BFB4_4:-4 BFB3_4:DELX 4 BFRIGHT NOP2 BFADD 2 NOP2 BFRIGHT NOP2 BFADD 6 NOP2 BFMANYLEFT 2 NOP2 BFDEC NOP2 PUSHCMD2 DUPXY [ BFB2_4 - BFB1_4 ] -1 REV -1 REV -3 BFB1_4: )  NOOP BFINC NOP2 BFRIGHT NOP2 BFRIGHT NOP2 BFRIGHT NOP2 BFGETC NOP2 BFLEFT NOP2 BFADD 2 NOP2   2(BFB2_5:DUPY 2 SWAP [ BFB4_5 - @ - 1 ] -1 SUM2 SWAP [ BFB4_5 - @ - 1 ] -1 POP PUSHCMD2 DELX [ BFB1_5 - BFB3_5 + BFB1_5 - BFB2_5 ] REV -1 REV BFB4_5:-4 BFB3_5:DELX 4 2(BFB2_6:DUPY 2 SWAP [ BFB4_6 - @ - 1 ] -1 SUM2 SWAP [ BFB4_6 - @ - 1 ] -1 POP PUSHCMD2 DELX      [ BFB1_6 - BFB3_6 + BFB1_6 - BFB2_6 ] REV -1 REV BFB4_6:-4 BFB3_6:DELX 4 BFRIGHT NOP2       2(BFB2_7:DUPY 2 SWAP [ BFB4_7 - @ - 1 ] -1 SUM2 SWAP [ BFB4_7 - @ - 1 ] -1 POP PUSHCMD2 DELX [ BFB1_7 - BFB3_7 + BFB1_7 - BFB2_7 ] REV -1 REV BFB4_7:-4 BFB3_7:DELX 4 BFDEC NOP2 BFRIGHT NOP2 BFRIGHT NOP2 PUSHCMD2 DUPXY [ BFB2_7 - BFB1_7 ] -1 REV -1 REV -3 BFB1_7: )      NOOP BFLEFT NOP2       2(BFB2_8:DUPY 2 SWAP [ BFB4_8 - @ - 1 ] -1 SUM2 SWAP [ BFB4_8 - @ - 1 ] -1 POP PUSHCMD2 DELX [ BFB1_8 - BFB3_8 + BFB1_8 - BFB2_8 ] REV -1 REV BFB4_8:-4 BFB3_8:DELX 4 BFRIGHT NOP2 BFRIGHT NOP2 PUSHCMD2 DUPXY [ BFB2_8 - BFB1_8 ] -1 REV -1 REV -3 BFB1_8: )      NOOP BFMANYLEFT 2 NOP2 BFDEC NOP2 PUSHCMD2 DUPXY [ BFB2_6 - BFB1_6 ] -1 REV -1 REV -3 BFB1_6: ) NOOP BFLEFT NOP2 2(BFB2_9:DUPY 2 SWAP [ BFB4_9 - @ - 1 ] -1 SUM2 SWAP [ BFB4_9 - @ - 1 ] -1 POP PUSHCMD2 DELX      [ BFB1_9 - BFB3_9 + BFB1_9 - BFB2_9 ] REV -1 REV BFB4_9:-4 BFB3_9:DELX 4 BFLEFT NOP2 PUSHCMD2 DUPXY       [ BFB2_9 - BFB1_9 ] -1 REV -1 REV -3 BFB1_9: ) NOOP BFLEFT NOP2 BFINC NOP2 BFRIGHT NOP2 BFRIGHT NOP2 2(BFB2_10:DUPY 2 SWAP [ BFB4_10 - @ - 1 ] -1 SUM2 SWAP [ BFB4_10 - @ - 1 ] -1 POP PUSHCMD2 DELX      [ BFB1_10 - BFB3_10 + BFB1_10 - BFB2_10 ] REV -1 REV BFB4_10:-4 BFB3_10:DELX 4 BFRIGHT NOP2 PUSHCMD2 DUPXY       [ BFB2_10 - BFB1_10 ] -1 REV -1 REV -3 BFB1_10: ) NOOP BFRIGHT NOP2 2(BFB2_11:DUPY 2 SWAP [ BFB4_11 - @ - 1 ] -1 SUM2 SWAP [ BFB4_11 - @ - 1 ] -1 POP PUSHCMD2 DELX      [ BFB1_11 - BFB3_11 + BFB1_11 - BFB2_11 ] REV -1 REV BFB4_11:-4 BFB3_11:DELX 4 BFLEFT NOP2 BFINC NOP2       BFRIGHT NOP2 BFDEC NOP2       2(BFB2_12:DUPY 2 SWAP [ BFB4_12 - @ - 1 ] -1 SUM2 SWAP [ BFB4_12 - @ - 1 ] -1 POP PUSHCMD2 DELX [ BFB1_12 - BFB3_12 + BFB1_12 - BFB2_12 ] REV -1 REV BFB4_12:-4 BFB3_12:DELX 4 2(BFB2_13:DUPY 2 SWAP [ BFB4_13 - @ - 1 ] -1 SUM2 SWAP [ BFB4_13 - @ - 1 ] -1 POP PUSHCMD2 DELX          [ BFB1_13 - BFB3_13 + BFB1_13 - BFB2_13 ] REV -1 REV BFB4_13:-4 BFB3_13:DELX 4 BFLEFT NOP2 BFINC NOP2           BFRIGHT NOP2 BFDEC NOP2 PUSHCMD2 DUPXY [ BFB2_13 - BFB1_13 ] -1 REV -1 REV -3 BFB1_13: ) NOOP BFRIGHT NOP2 PUSHCMD2 DUPXY [ BFB2_12 - BFB1_12 ] -1 REV -1 REV -3 BFB1_12: )      NOOP BFLEFT NOP2       2(BFB2_14:DUPY 2 SWAP [ BFB4_14 - @ - 1 ] -1 SUM2 SWAP [ BFB4_14 - @ - 1 ] -1 POP PUSHCMD2 DELX [ BFB1_14 - BFB3_14 + BFB1_14 - BFB2_14 ] REV -1 REV BFB4_14:-4 BFB3_14:DELX 4 2(BFB2_15:DUPY 2 SWAP [ BFB4_15 - @ - 1 ] -1 SUM2 SWAP [ BFB4_15 - @ - 1 ] -1 POP PUSHCMD2 DELX          [ BFB1_15 - BFB3_15 + BFB1_15 - BFB2_15 ] REV -1 REV BFB4_15:-4 BFB3_15:DELX 4           2(BFB2_16:DUPY 2 SWAP [ BFB4_16 - @ - 1 ] -1 SUM2 SWAP [ BFB4_16 - @ - 1 ] -1 POP PUSHCMD2 DELX [ BFB1_16 - BFB3_16 + BFB1_16 - BFB2_16 ] REV -1 REV BFB4_16:-4 BFB3_16:DELX 4 BFDEC NOP2 PUSHCMD2 DUPXY [ BFB2_16 - BFB1_16 ] -1 REV -1 REV -3 BFB1_16: )          NOOP BFLEFT NOP2 PUSHCMD2 DUPXY [ BFB2_15 - BFB1_15 ] -1 REV -1 REV -3 BFB1_15: ) NOOP BFADD 2 NOP2 BFLEFT NOP2 BFDEC NOP2 2(BFB2_17:DUPY 2 SWAP [ BFB4_17 - @ - 1 ] -1 SUM2 SWAP [ BFB4_17 - @ - 1 ] -1 POP PUSHCMD2 DELX          [ BFB1_17 - BFB3_17 + BFB1_17 - BFB2_17 ] REV -1 REV BFB4_17:-4 BFB3_17:DELX 4 BFLEFT NOP2 BFADD 9 NOP2           BFRIGHT NOP2           2(BFB2_18:DUPY 2 SWAP [ BFB4_18 - @ - 1 ] -1 SUM2 SWAP [ BFB4_18 - @ - 1 ] -1 POP PUSHCMD2 DELX [ BFB1_18 - BFB3_18 + BFB1_18 - BFB2_18 ] REV -1 REV BFB4_18:-4 BFB3_18:DELX 4 BFLEFT NOP2 BFDEC NOP2 BFRIGHT NOP2 BFDEC NOP2 PUSHCMD2 DUPXY [ BFB2_18 - BFB1_18 ] -1 REV -1 REV -3 BFB1_18: )          NOOP BFRIGHT NOP2 BFRIGHT NOP2 PUSHCMD2 DUPXY [ BFB2_17 - BFB1_17 ] -1 REV -1 REV -3 BFB1_17: ) NOOP BFRIGHT NOP2 BFRIGHT NOP2 PUSHCMD2 DUPXY [ BFB2_14 - BFB1_14 ] -1 REV -1 REV -3 BFB1_14: )      NOOP PUSHCMD2 DUPXY [ BFB2_11 - BFB1_11 ] -1 REV -1 REV -3 BFB1_11: ) NOOP BFMANYLEFT 2 NOP2 PUSHCMD2 DUPXY [ BFB2_5 - BFB1_5 ] -1 REV -1 REV -3 BFB1_5: )  NOOP BFLEFT NOP2 PUSHCMD2 DUPXY [ BFB2_0 - BFB1_0 ] -1 REV -1 REV -3 BFB1_0: ) NOOP BFLEFT NOP2 2(BFB2_19:DUPY 2 SWAP [ BFB4_19 - @ - 1 ] -1 SUM2 SWAP [ BFB4_19 - @ - 1 ] -1 POP PUSHCMD2 DELX  [ BFB1_19 - BFB3_19 + BFB1_19 - BFB2_19 ] REV -1 REV BFB4_19:-4 BFB3_19:DELX 4   2(BFB2_20:DUPY 2 SWAP [ BFB4_20 - @ - 1 ] -1 SUM2 SWAP [ BFB4_20 - @ - 1 ] -1 POP PUSHCMD2 DELX [ BFB1_20 - BFB3_20 + BFB1_20 - BFB2_20 ] REV -1 REV BFB4_20:-4 BFB3_20:DELX 4 BFLEFT NOP2 PUSHCMD2 DUPXY [ BFB2_20 - BFB1_20 ] -1 REV -1 REV -3 BFB1_20: )  NOOP BFRIGHT NOP2   2(BFB2_21:DUPY 2 SWAP [ BFB4_21 - @ - 1 ] -1 SUM2 SWAP [ BFB4_21 - @ - 1 ] -1 POP PUSHCMD2 DELX [ BFB1_21 - BFB3_21 + BFB1_21 - BFB2_21 ] REV -1 REV BFB4_21:-4 BFB3_21:DELX 4 2(BFB2_22:DUPY 2 SWAP [ BFB4_22 - @ - 1 ] -1 SUM2 SWAP [ BFB4_22 - @ - 1 ] -1 POP PUSHCMD2 DELX      [ BFB1_22 - BFB3_22 + BFB1_22 - BFB2_22 ] REV -1 REV BFB4_22:-4 BFB3_22:DELX 4 BFRIGHT NOP2       PUSHCMD2 DUPXY [ BFB2_22 - BFB1_22 ] -1 REV -1 REV -3 BFB1_22: ) NOOP BFRIGHT NOP2 BFRIGHT NOP2 2(BFB2_23:DUPY 2 SWAP [ BFB4_23 - @ - 1 ] -1 SUM2 SWAP [ BFB4_23 - @ - 1 ] -1 POP PUSHCMD2 DELX      [ BFB1_23 - BFB3_23 + BFB1_23 - BFB2_23 ] REV -1 REV BFB4_23:-4 BFB3_23:DELX 4 BFRIGHT NOP2 BFRIGHT NOP2       PUSHCMD2 DUPXY [ BFB2_23 - BFB1_23 ] -1 REV -1 REV -3 BFB1_23: ) NOOP BFINC NOP2 2(BFB2_24:DUPY 2 SWAP [ BFB4_24 - @ - 1 ] -1 SUM2 SWAP [ BFB4_24 - @ - 1 ] -1 POP PUSHCMD2 DELX      [ BFB1_24 - BFB3_24 + BFB1_24 - BFB2_24 ] REV -1 REV BFB4_24:-4 BFB3_24:DELX 4 BFMANYLEFT 2 NOP2 PUSHCMD2       DUPXY [ BFB2_24 - BFB1_24 ] -1 REV -1 REV -3 BFB1_24: ) NOOP BFLEFT NOP2 2(BFB2_25:DUPY 2 SWAP [ BFB4_25 - @ - 1 ] -1 SUM2 SWAP [ BFB4_25 - @ - 1 ] -1 POP PUSHCMD2 DELX      [ BFB1_25 - BFB3_25 + BFB1_25 - BFB2_25 ] REV -1 REV BFB4_25:-4 BFB3_25:DELX 4 BFLEFT NOP2 PUSHCMD2 DUPXY       [ BFB2_25 - BFB1_25 ] -1 REV -1 REV -3 BFB1_25: ) NOOP BFLEFT NOP2 BFINC NOP2 BFRIGHT NOP2 BFRIGHT NOP2 BFDEC NOP2 PUSHCMD2 DUPXY [ BFB2_21 - BFB1_21 ] -1 REV -1 REV -3 BFB1_21: )  NOOP BFRIGHT NOP2   2(BFB2_26:DUPY 2 SWAP [ BFB4_26 - @ - 1 ] -1 SUM2 SWAP [ BFB4_26 - @ - 1 ] -1 POP PUSHCMD2 DELX [ BFB1_26 - BFB3_26 + BFB1_26 - BFB2_26 ] REV -1 REV BFB4_26:-4 BFB3_26:DELX 4 BFRIGHT NOP2 PUSHCMD2 DUPXY [ BFB2_26 - BFB1_26 ] -1 REV -1 REV -3 BFB1_26: )  NOOP BFINC NOP2   2(BFB2_27:DUPY 2 SWAP [ BFB4_27 - @ - 1 ] -1 SUM2 SWAP [ BFB4_27 - @ - 1 ] -1 POP PUSHCMD2 DELX [ BFB1_27 - BFB3_27 + BFB1_27 - BFB2_27 ] REV -1 REV BFB4_27:-4 BFB3_27:DELX 4 BFDEC NOP2 BFRIGHT NOP2 BFRIGHT NOP2 PUSHCMD2 DUPXY [ BFB2_27 - BFB1_27 ] -1 REV -1 REV -3 BFB1_27: )  NOOP BFMANYLEFT 4 NOP2   2(BFB2_28:DUPY 2 SWAP [ BFB4_28 - @ - 1 ] -1 SUM2 SWAP [ BFB4_28 - @ - 1 ] -1 POP PUSHCMD2 DELX [ BFB1_28 - BFB3_28 + BFB1_28 - BFB2_28 ] REV -1 REV BFB4_28:-4 BFB3_28:DELX 4 2(BFB2_29:DUPY 2 SWAP [ BFB4_29 - @ - 1 ] -1 SUM2 SWAP [ BFB4_29 - @ - 1 ] -1 POP PUSHCMD2 DELX      [ BFB1_29 - BFB3_29 + BFB1_29 - BFB2_29 ] REV -1 REV BFB4_29:-4 BFB3_29:DELX 4 BFMANYLEFT 2 NOP2 PUSHCMD2 DUPXY       [ BFB2_29 - BFB1_29 ] -1 REV -1 REV -3 BFB1_29: ) NOOP BFLEFT NOP2 2(BFB2_30:DUPY 2 SWAP [ BFB4_30 - @ - 1 ] -1 SUM2 SWAP [ BFB4_30 - @ - 1 ] -1 POP PUSHCMD2 DELX      [ BFB1_30 - BFB3_30 + BFB1_30 - BFB2_30 ] REV -1 REV BFB4_30:-4 BFB3_30:DELX 4 BFLEFT NOP2 PUSHCMD2 DUPXY       [ BFB2_30 - BFB1_30 ] -1 REV -1 REV -3 BFB1_30: ) NOOP BFINC NOP2 BFMANYLEFT 2 NOP2 2(BFB2_31:DUPY 2 SWAP [ BFB4_31 - @ - 1 ] -1 SUM2 SWAP [ BFB4_31 - @ - 1 ] -1 POP PUSHCMD2 DELX      [ BFB1_31 - BFB3_31 + BFB1_31 - BFB2_31 ] REV -1 REV BFB4_31:-4 BFB3_31:DELX 4 BFINC NOP2 BFRIGHT NOP2 BFINC NOP2       BFMANYLEFT 2 NOP2 BFDEC NOP2       2(BFB2_32:DUPY 2 SWAP [ BFB4_32 - @ - 1 ] -1 SUM2 SWAP [ BFB4_32 - @ - 1 ] -1 POP PUSHCMD2 DELX [ BFB1_32 - BFB3_32 + BFB1_32 - BFB2_32 ] REV -1 REV BFB4_32:-4 BFB3_32:DELX 4 BFRIGHT NOP2 BFADD -2 NOP2 BFRIGHT NOP2 BFINC NOP2 BFMANYLEFT 2 NOP2 BFDEC NOP2 2(BFB2_33:DUPY 2 SWAP [ BFB4_33 - @ - 1 ] -1 SUM2 SWAP [ BFB4_33 - @ - 1 ] -1 POP PUSHCMD2 DELX          [ BFB1_33 - BFB3_33 + BFB1_33 - BFB2_33 ] REV -1 REV BFB4_33:-4 BFB3_33:DELX 4 BFRIGHT NOP2 BFINC NOP2           BFLEFT NOP2           2(BFB2_34:DUPY 2 SWAP [ BFB4_34 - @ - 1 ] -1 SUM2 SWAP [ BFB4_34 - @ - 1 ] -1 POP PUSHCMD2 DELX [ BFB1_34 - BFB3_34 + BFB1_34 - BFB2_34 ] REV -1 REV BFB4_34:-4 BFB3_34:DELX 4 BFRIGHT NOP2 BFRIGHT NOP2 BFINC NOP2 BFMANYLEFT 2 NOP2 BFDEC NOP2 PUSHCMD2 DUPXY [ BFB2_34 - BFB1_34 ] -1 REV -1 REV -3 BFB1_34: )          NOOP PUSHCMD2 DUPXY [ BFB2_33 - BFB1_33 ] -1 REV -1 REV -3 BFB1_33: ) NOOP PUSHCMD2 DUPXY [ BFB2_32 - BFB1_32 ] -1 REV -1 REV -3 BFB1_32: )      NOOP BFRIGHT NOP2       2(BFB2_35:DUPY 2 SWAP [ BFB4_35 - @ - 1 ] -1 SUM2 SWAP [ BFB4_35 - @ - 1 ] -1 POP PUSHCMD2 DELX [ BFB1_35 - BFB3_35 + BFB1_35 - BFB2_35 ] REV -1 REV BFB4_35:-4 BFB3_35:DELX 4 BFLEFT NOP2 BFINC NOP2 BFRIGHT NOP2 BFDEC NOP2 PUSHCMD2 DUPXY [ BFB2_35 - BFB1_35 ] -1 REV -1 REV -3 BFB1_35: )      NOOP BFLEFT NOP2 PUSHCMD2 DUPXY [ BFB2_31 - BFB1_31 ] -1 REV -1 REV -3 BFB1_31: ) NOOP BFADD 2 NOP2 BFRIGHT NOP2 BFRIGHT NOP2 BFADD -2 NOP2 BFRIGHT NOP2 2(BFB2_36:DUPY 2 SWAP [ BFB4_36 - @ - 1 ] -1 SUM2 SWAP [ BFB4_36 - @ - 1 ] -1 POP PUSHCMD2 DELX      [ BFB1_36 - BFB3_36 + BFB1_36 - BFB2_36 ] REV -1 REV BFB4_36:-4 BFB3_36:DELX 4 BFRIGHT NOP2 PUSHCMD2 DUPXY       [ BFB2_36 - BFB1_36 ] -1 REV -1 REV -3 BFB1_36: ) NOOP BFRIGHT NOP2 BFRIGHT NOP2 2(BFB2_37:DUPY 2 SWAP [ BFB4_37 - @ - 1 ] -1 SUM2 SWAP [ BFB4_37 - @ - 1 ] -1 POP PUSHCMD2 DELX      [ BFB1_37 - BFB3_37 + BFB1_37 - BFB2_37 ] REV -1 REV BFB4_37:-4 BFB3_37:DELX 4 BFRIGHT NOP2 BFRIGHT NOP2       PUSHCMD2 DUPXY [ BFB2_37 - BFB1_37 ] -1 REV -1 REV -3 BFB1_37: ) NOOP PUSHCMD2 DUPXY [ BFB2_28 - BFB1_28 ] -1 REV -1 REV -3 BFB1_28: )  NOOP BFMANYLEFT 2 NOP2   2(BFB2_38:DUPY 2 SWAP [ BFB4_38 - @ - 1 ] -1 SUM2 SWAP [ BFB4_38 - @ - 1 ] -1 POP PUSHCMD2 DELX [ BFB1_38 - BFB3_38 + BFB1_38 - BFB2_38 ] REV -1 REV BFB4_38:-4 BFB3_38:DELX 4 BFRIGHT NOP2 BFRIGHT NOP2 BFINC NOP2 BFLEFT NOP2 2(BFB2_39:DUPY 2 SWAP [ BFB4_39 - @ - 1 ] -1 SUM2 SWAP [ BFB4_39 - @ - 1 ] -1 POP PUSHCMD2 DELX      [ BFB1_39 - BFB3_39 + BFB1_39 - BFB2_39 ] REV -1 REV BFB4_39:-4 BFB3_39:DELX 4       2(BFB2_40:DUPY 2 SWAP [ BFB4_40 - @ - 1 ] -1 SUM2 SWAP [ BFB4_40 - @ - 1 ] -1 POP PUSHCMD2 DELX [ BFB1_40 - BFB3_40 + BFB1_40 - BFB2_40 ] REV -1 REV BFB4_40:-4 BFB3_40:DELX 4 BFLEFT NOP2 PUSHCMD2 DUPXY [ BFB2_40 - BFB1_40 ] -1 REV -1 REV -3 BFB1_40: )      NOOP BFLEFT NOP2 PUSHCMD2 DUPXY [ BFB2_39 - BFB1_39 ] -1 REV -1 REV -3 BFB1_39: ) NOOP BFRIGHT NOP2 2(BFB2_41:DUPY 2 SWAP [ BFB4_41 - @ - 1 ] -1 SUM2 SWAP [ BFB4_41 - @ - 1 ] -1 POP PUSHCMD2 DELX      [ BFB1_41 - BFB3_41 + BFB1_41 - BFB2_41 ] REV -1 REV BFB4_41:-4 BFB3_41:DELX 4       2(BFB2_42:DUPY 2 SWAP [ BFB4_42 - @ - 1 ] -1 SUM2 SWAP [ BFB4_42 - @ - 1 ] -1 POP PUSHCMD2 DELX [ BFB1_42 - BFB3_42 + BFB1_42 - BFB2_42 ] REV -1 REV BFB4_42:-4 BFB3_42:DELX 4 BFMANYLEFT 2 NOP2 PUSHCMD2 DUPXY [ BFB2_42 - BFB1_42 ] -1 REV -1 REV -3 BFB1_42: )      NOOP BFLEFT NOP2       2(BFB2_43:DUPY 2 SWAP [ BFB4_43 - @ - 1 ] -1 SUM2 SWAP [ BFB4_43 - @ - 1 ] -1 POP PUSHCMD2 DELX [ BFB1_43 - BFB3_43 + BFB1_43 - BFB2_43 ] REV -1 REV BFB4_43:-4 BFB3_43:DELX 4 BFLEFT NOP2 PUSHCMD2 DUPXY [ BFB2_43 - BFB1_43 ] -1 REV -1 REV -3 BFB1_43: )      NOOP BFINC NOP2       2(BFB2_44:DUPY 2 SWAP [ BFB4_44 - @ - 1 ] -1 SUM2 SWAP [ BFB4_44 - @ - 1 ] -1 POP PUSHCMD2 DELX [ BFB1_44 - BFB3_44 + BFB1_44 - BFB2_44 ] REV -1 REV BFB4_44:-4 BFB3_44:DELX 4 BFDEC NOP2 BFLEFT NOP2 BFINC NOP2 BFRIGHT NOP2 BFRIGHT NOP2 BFDEC NOP2 2(BFB2_45:DUPY 2 SWAP [ BFB4_45 - @ - 1 ] -1 SUM2 SWAP [ BFB4_45 - @ - 1 ] -1 POP PUSHCMD2 DELX          [ BFB1_45 - BFB3_45 + BFB1_45 - BFB2_45 ] REV -1 REV BFB4_45:-4 BFB3_45:DELX 4 BFMANYLEFT 2 NOP2 BFINC NOP2           BFRIGHT NOP2 BFADD 2 NOP2 BFRIGHT NOP2 BFDEC NOP2           2(BFB2_46:DUPY 2 SWAP [ BFB4_46 - @ - 1 ] -1 SUM2 SWAP [ BFB4_46 - @ - 1 ] -1 POP PUSHCMD2 DELX [ BFB1_46 - BFB3_46 + BFB1_46 - BFB2_46 ] REV -1 REV BFB4_46:-4 BFB3_46:DELX 4 BFLEFT NOP2 BFDEC NOP2 BFRIGHT NOP2 2(BFB2_47:DUPY 2 SWAP [ BFB4_47 - @ - 1 ] -1 SUM2 SWAP [ BFB4_47 - @ - 1 ] -1 POP PUSHCMD2 DELX              [ BFB1_47 - BFB3_47 + BFB1_47 - BFB2_47 ] REV -1 REV BFB4_47:-4 BFB3_47:DELX 4 BFMANYLEFT 2 NOP2               BFINC NOP2 BFRIGHT NOP2 BFRIGHT NOP2 BFDEC NOP2 PUSHCMD2 DUPXY [ BFB2_47 - BFB1_47 ] -1 REV -1               REV -3 BFB1_47: ) NOOP PUSHCMD2 DUPXY [ BFB2_46 - BFB1_46 ] -1 REV -1 REV -3 BFB1_46: )          NOOP PUSHCMD2 DUPXY [ BFB2_45 - BFB1_45 ] -1 REV -1 REV -3 BFB1_45: ) NOOP BFLEFT NOP2 2(BFB2_48:DUPY 2 SWAP [ BFB4_48 - @ - 1 ] -1 SUM2 SWAP [ BFB4_48 - @ - 1 ] -1 POP PUSHCMD2 DELX          [ BFB1_48 - BFB3_48 + BFB1_48 - BFB2_48 ] REV -1 REV BFB4_48:-4 BFB3_48:DELX 4 BFRIGHT NOP2 BFINC NOP2           BFLEFT NOP2 BFDEC NOP2 PUSHCMD2 DUPXY [ BFB2_48 - BFB1_48 ] -1 REV -1 REV -3 BFB1_48: ) NOOP BFRIGHT NOP2 PUSHCMD2 DUPXY [ BFB2_44 - BFB1_44 ] -1 REV -1 REV -3 BFB1_44: )      NOOP BFRIGHT NOP2       2(BFB2_49:DUPY 2 SWAP [ BFB4_49 - @ - 1 ] -1 SUM2 SWAP [ BFB4_49 - @ - 1 ] -1 POP PUSHCMD2 DELX [ BFB1_49 - BFB3_49 + BFB1_49 - BFB2_49 ] REV -1 REV BFB4_49:-4 BFB3_49:DELX 4 BFRIGHT NOP2 PUSHCMD2 DUPXY [ BFB2_49 - BFB1_49 ] -1 REV -1 REV -3 BFB1_49: )      NOOP BFRIGHT NOP2 PUSHCMD2 DUPXY [ BFB2_41 - BFB1_41 ] -1 REV -1 REV -3 BFB1_41: ) NOOP BFRIGHT NOP2 2(BFB2_50:DUPY 2 SWAP [ BFB4_50 - @ - 1 ] -1 SUM2 SWAP [ BFB4_50 - @ - 1 ] -1 POP PUSHCMD2 DELX      [ BFB1_50 - BFB3_50 + BFB1_50 - BFB2_50 ] REV -1 REV BFB4_50:-4 BFB3_50:DELX 4 BFRIGHT NOP2 BFRIGHT NOP2       PUSHCMD2 DUPXY [ BFB2_50 - BFB1_50 ] -1 REV -1 REV -3 BFB1_50: ) NOOP BFRIGHT NOP2 BFRIGHT NOP2 PUSHCMD2 DUPXY [ BFB2_38 - BFB1_38 ] -1 REV -1 REV -3 BFB1_38: )  NOOP BFMANYLEFT 2 NOP2   2(BFB2_51:DUPY 2 SWAP [ BFB4_51 - @ - 1 ] -1 SUM2 SWAP [ BFB4_51 - @ - 1 ] -1 POP PUSHCMD2 DELX [ BFB1_51 - BFB3_51 + BFB1_51 - BFB2_51 ] REV -1 REV BFB4_51:-4 BFB3_51:DELX 4 BFRIGHT NOP2 BFRIGHT NOP2 BFINC NOP2 BFRIGHT NOP2 BFRIGHT NOP2 BFINC NOP2 BFRIGHT NOP2 BFRIGHT NOP2 PUSHCMD2 DUPXY [ BFB2_51 - BFB1_51 ] -1 REV -1 REV -3 BFB1_51: )  NOOP BFMANYLEFT 2 NOP2   2(BFB2_52:DUPY 2 SWAP [ BFB4_52 - @ - 1 ] -1 SUM2 SWAP [ BFB4_52 - @ - 1 ] -1 POP PUSHCMD2 DELX [ BFB1_52 - BFB3_52 + BFB1_52 - BFB2_52 ] REV -1 REV BFB4_52:-4 BFB3_52:DELX 4 BFDEC NOP2 BFRIGHT NOP2 BFRIGHT NOP2 BFRIGHT NOP2 BFRIGHT NOP2 BFRIGHT NOP2 BFRIGHT NOP2 BFRIGHT NOP2 BFRIGHT NOP2 PUSHCMD2 DUPXY [ BFB2_52 - BFB1_52 ] -1 REV -1 REV -3 BFB1_52: )  NOOP BFMANYLEFT 2 NOP2   2(BFB2_53:DUPY 2 SWAP [ BFB4_53 - @ - 1 ] -1 SUM2 SWAP [ BFB4_53 - @ - 1 ] -1 POP PUSHCMD2 DELX [ BFB1_53 - BFB3_53 + BFB1_53 - BFB2_53 ] REV -1 REV BFB4_53:-4 BFB3_53:DELX 4 BFRIGHT NOP2 BFPUTC NOP2 BFRIGHT NOP2 BFRIGHT NOP2 BFRIGHT NOP2 BFRIGHT NOP2 BFRIGHT NOP2 BFRIGHT NOP2 BFRIGHT NOP2 PUSHCMD2 DUPXY [ BFB2_53 - BFB1_53 ] -1 REV -1 REV -3 BFB1_53: )  NOOP BFMANYLEFT 2 NOP2   2(BFB2_54:DUPY 2 SWAP [ BFB4_54 - @ - 1 ] -1 SUM2 SWAP [ BFB4_54 - @ - 1 ] -1 POP PUSHCMD2 DELX [ BFB1_54 - BFB3_54 + BFB1_54 - BFB2_54 ] REV -1 REV BFB4_54:-4 BFB3_54:DELX 4 BFRIGHT NOP2 BFDEC NOP2 BFRIGHT NOP2 BFRIGHT NOP2 BFRIGHT NOP2 BFRIGHT NOP2 BFRIGHT NOP2 PUSHCMD2 DUPXY [ BFB2_54 - BFB1_54 ] -1 REV -1 REV -3 BFB1_54: )  NOOP BFMANYLEFT 2 NOP2   2(BFB2_55:DUPY 2 SWAP [ BFB4_55 - @ - 1 ] -1 SUM2 SWAP [ BFB4_55 - @ - 1 ] -1 POP PUSHCMD2 DELX [ BFB1_55 - BFB3_55 + BFB1_55 - BFB2_55 ] REV -1 REV BFB4_55:-4 BFB3_55:DELX 4 BFRIGHT NOP2 BFGETC NOP2 BFRIGHT NOP2 BFRIGHT NOP2 BFRIGHT NOP2 PUSHCMD2 DUPXY [ BFB2_55 - BFB1_55 ] -1 REV -1 REV -3 BFB1_55: )  NOOP BFMANYLEFT 2 NOP2   2(BFB2_56:DUPY 2 SWAP [ BFB4_56 - @ - 1 ] -1 SUM2 SWAP [ BFB4_56 - @ - 1 ] -1 POP PUSHCMD2 DELX [ BFB1_56 - BFB3_56 + BFB1_56 - BFB2_56 ] REV -1 REV BFB4_56:-4 BFB3_56:DELX 4 BFRIGHT NOP2 BFINC NOP2 BFRIGHT NOP2 PUSHCMD2 DUPXY [ BFB2_56 - BFB1_56 ] -1 REV -1 REV -3 BFB1_56: )  NOOP BFMANYLEFT 2 NOP2   2(BFB2_57:DUPY 2 SWAP [ BFB4_57 - @ - 1 ] -1 SUM2 SWAP [ BFB4_57 - @ - 1 ] -1 POP PUSHCMD2 DELX [ BFB1_57 - BFB3_57 + BFB1_57 - BFB2_57 ] REV -1 REV BFB4_57:-4 BFB3_57:DELX 4 BFINC NOP2 BFMANYLEFT 2 NOP2 PUSHCMD2 DUPXY [ BFB2_57 - BFB1_57 ] -1 REV -1 REV -3 BFB1_57: )  NOOP BFLEFT NOP2 PUSHCMD2 DUPXY [ BFB2_19 - BFB1_19 ] -1 REV -1 REV -3 BFB1_19: ) NOOP 2(BFB2_58:DUPY 2 SWAP [ BFB4_58 - @ - 1 ] -1 SUM2 SWAP [ BFB4_58 - @ - 1 ] -1 POP PUSHCMD2 DELX  [ BFB1_58 - BFB3_58 + BFB1_58 - BFB2_58 ] REV -1 REV BFB4_58:-4 BFB3_58:DELX 4 BFGETC NOP2 BFPUTC NOP2   BFPUTC NOP2 BFPUTC NOP2 PUSHCMD2 DUPXY [ BFB2_58 - BFB1_58 ] -1 REV -1 REV -3 BFB1_58: ) NOOP * * * * * * 0 -2

BCT in Thue
I wanted BCT-in-Thue without all the extraneous output. Instead of modifying the existing interpreter, I just wrote my own. Run the first example on the BCT page like this:

$ echo -e 00111\\n101 | ./thue nbct.t

nbct.t b::=::: 0c::=0defg 1c::=1defg f::=::: e0::=h0 e1::=h1 h0::=0hO h1::=1hI O::=~0 I::=~1 hg::=ijg i::=~ 0j::=j0 1j::=j1 dj::=jd aj0::=ak k0::=0k k1::=1k kd0::=0de kd1::=0de aj10::=am m0::=0m m1::=1m md0::=10dh0 md1::=10dh1m mg::=0g aj11::=ao o0::=0o o1::=1o od0::=11dh0 od1::=11dh1o og::=1g ::= abc

brainfuck to Whirl translator
bf2whirl.pl my $usage =<<EOU; bf2whirl.pl - converts brainfuck to whirl options: -h     This help -b     Append a bang ("!") character at the end license: Public Domain EOU use strict; use vars qw/ $opt_h $opt_b /; use Getopt::Std; getopts('hb'); print($usage), exit 0 if $opt_h; my $prog = join '', <>; my @prog = split '', $prog; my %ops = ( "<" => "110001100111110001000111001110000" .    "111100000111100011100111010000000000011110000111101",     ">" => "1100001111100000000011110000111101",     "+" => "0001100000111110000010000011110000111111000101",     "-" => "00011000001000011110000010000011110000111111000101",     "," => "111000011000011111100001",     "." => "110000011100000111100000111101" ); sub genwhirl { my $code = ""; while (my $char = shift @prog) { return $code if $char eq "]"; if ($char eq "[") { my $restore = "0110011111100010000111001111001111". "00000111100111001110100011110000111101";      my $code2 = $restore. genwhirl; my $jmp = 16; while (1) { my $code3 = mk_mul_8($jmp, 1); if ($jmp < length($code2. $code3)) { $jmp += 8; next; } elsif ($jmp > length($code2. $code3)) { if ($jmp - length($code2. $code3) == 2) { $jmp += 8; next; }          $code .= mk_mul_8($jmp). $code2. substr($code3, 0, -1). ("1" x (($jmp - length($code2. $code3) - 2) / 2)). "0" .              ("1" x (($jmp - length($code2. $code3) - 2) / 2)). "00" .                $restore; last; } else { $code .= mk_mul_8($jmp). $code2. $code3. $restore; last; }      }     } else { next unless $char =~ /[-+<>,.]/; $code .= $ops{$char}; }  }   return $code; } sub mk_mul_8 { my $x = shift; my $back = shift; # assume bf,?,+0+,0,-0+ # -> bf+,8,-4-,8,+2- my $code = "1100100111110001110001111100". ($back ? "0000" : ""). "01111000010000010000011000000000110000";  my @o = ; while ($x>8) { if (($x/8)%8) { push @o, 1; $x-=8; } else { push @o, 0; $x/=8; }  }   my $d = 0; my $p = 2; for (reverse(@o)) { if ($_) { $code .= "01" if $p == 2 or $p == 4; $code .= "0000"; $d = $p == 2 ? 1 : ($p == 4 ? 0 : $d); $p = 3; } else { if ($p == 2) { $code .= "011"; } elsif ($p == 3) { $code .= ($d ? "" : "0"). "1";      }       $code .= "0000"; $p = 4; $d = 1; }  }   # negate, if backward if ($back) { if ($p == 4) { $code .= "01111100"; } else { $code .= ($d ? "0" : ""). "111100";     }   }   # add 1 if ($back) { $code .= "0111000111100"; $p = 3; $d = 1; } else { # strip the last 2 zeros & store a 1 $code = substr($code, 0, -2). "011100";    if ($p == 4) { $code .= "0100"; $p = 3; $d = 0; } else { $code .= "00"; }  }   # move ops to load $code .= "0100"; # store the jump & load in ops $code .= ($d ? "0" : ""). "10000";  # move math to zero & noop ops & store 0 $code .= "01111001111000111100"; # noop ops & noop math & jump $code .= "001110100011111100"; return $code; } print genwhirl, "\n"; exit;
 * 1) !/usr/bin/perl -w