User:Nthern/archive

/// and itflabtijtslwi

/// 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

#!/usr/bin/perl -w
# /// (a.k.a. "Slashes") interpreter
# by Nathan Thern
#
# see http://esolangs.org/wiki/Slashes for more information about ///
#
# options:
#
# -d = debug mode
# -i = itflabtijtslwi mode - implement character input extension
#
# license: Public Domain

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";
  }
}

/// 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
*/

#include <glib.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>

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);
    }
  }
}

Thue-to-/// translator

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

thue2sss.pl

#!/usr/bin/perl

# Thue to /// (a.k.a. "Slashes") translator
# The resultant /// program is deterministic, regardless of whether
#  the source Thue program is deterministic or not. Most useful Thue
#  programs are deterministic (or converge on deterministic results)

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 = ();

#read in the rules
while (<>) {
  s/[\r\n]//g;
  next if(/^\s*$/);
  next if (/^\s*#/);
  last if /^\s*::=\s*$/;
  /::=/;
  push @rules, { LHS => $`, RHS => $' };
}

# read in the data
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;

#print $part4;exit;

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";

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)

Befunge(-93) interpreter in perl with bignums

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

bigbef.pl

#! /usr/bin/perl

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 (<F>) {
  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(<STDIN> + 0); },
	'~' => sub { local $/ = \1; spush(Math::BigInt->new(ord <STDIN>)); },
	'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;
}

Befunge(-93) interpreter in C with bignums

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

bigbef_me.pl

#include <stdio.h>
#include <stdlib.h>
#include <time.h>
#include <gmp.h>

#define W		80
#define H		25
#define STACKSIZE	10000

#define	pcell_t		signed char
#define	scell_t		mpz_t
#define	scell_fmt	"%Zd"

pcell_t	page[H * W];
scell_t	stack[STACKSIZE];
int	x, y, dx, dy, strmode;
unsigned long stackptr;
int	isdebug = 0;

#define POS(y,x)	((y) * W + (x))
#define CUR		page[POS (y, x)]

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 */
}

#define PUSH(val)                               \
  if (stackptr < STACKSIZE)                     \
    mpz_set(stack[stackptr++], (val));          \
  else                                          \
    error ("stack overflow")

#define PUSHINT(val)                            \
  if (stackptr < STACKSIZE)                     \
    mpz_set_si(stack[stackptr++], (val));       \
  else                                          \
    error ("stack overflow")                    \

#define POP(val)                                \
  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;
}

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

<v+**44\_v        v88\+*<v:\!-".":\!-",":\!-">":\!-"<":\!-"-":\!-"+":\!-"!":~<+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**\`#
# <            >884**%       >>            >        >     >\888* * *+^ +***888\ 
 $\: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                          
#v_\1-:#v_$/8>\44*/:0`#v_$>\0`  #v_v       ^*44:    \_\44**+:1\:4>4*%:5`!#v_6`! 
\<   \-1<    ^  +8**44\<  ^+8**44< +                             ^ 4:/*44$< 0\+1
^                         \0\p80*84<

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

#!perl -p

# converts brainfuck instructions into instructions that can handle
# natural numbers of arbitrary size

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';

Bub-to-brainfuck translator

Not just a one-for-one translator. Read the comments.

bub2bf.pl

#!/usr/bin/perl -w
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);
}

# read in the program
my $prog = join , <>;

# filter out comments
$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;
}

# number the commands
$prog[$_]{"id"} = $_ for 0..$#prog;

# identify the operator
my @ops = ( "<X", ">X", "+", "-", ",", ".", "[", "]", "" );
(($_->{"cmd"} =~ /\d$/) && ($_->{"op"} = $ops[$&])) for @prog;

# find all jump destinations
for (grep { $_->{"op"} =~ /[][]/ } @prog) {
  $_->{"cmd"} =~ /^(\d+)(\d)$/;
  $_->{"jmp"} = [ $1 <= $_->{"id"}, $2 == 7,  $1 ];
  $prog[$1]{"dest"} = 1;
}

# group the operators
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;

# find the group destination of each jump
$_->{"jmp"}[3] = $prog[$_->{"jmp"}[2]]{"grp"}
  for (grep { $_->{"jmp"} } @prog);

# find the group heads & anchors
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 "<X") {
      print "<" x $group;
    } elsif ($_->{"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;

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

Bub interpreter

bub.pl

#!/usr/bin/perl -w
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 , <>;
}
# filter out header comments
$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);
}

brainfuck-to-Bub translator

bf2bub.pl

#!/usr/bin/perl -w
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;
               }
  );

# This one line does the real work of parsing brainfuck code
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;

"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

#!/usr/bin/perl -w
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;

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

# assume first two characters are spaces
>>>+>>,,<
# read a possible space & subtract 32
a: +>, > ++++++++ l1: <---->- l1! <
# goto a if it's a space, then subtract 15 & move it over 2
a@>+++++ l2: <--->- l2! < l3: >>+<<- l3!
# add up the spaces (less 1)
l4: < l4! >->> l5: < l6: ->+< l6! >> l5! >>>>+<<<<<

# main program reading routine
a3:->>a4:>a4! > a5@ - a1: > a1! + a5: > a5! + a2: < a2! <
# read in next token & subtract "!" (33).
# if the character is a "!", then it's not a token,
# but the end of the program
,>++++++++ l8: <---->- l8! <-
# jump to b if it's 0 otherwise subtract 14 (means a "0" will be 1)
b@ >+++++++ l9: <-->- l9!
# check if next token
l10:<l10!<<a3!
# get ready for next token
>a6:>a6!>>a6! <<<< a8: > a7:-<+>a7! << a8! <
# check if last was a jump
-aa1@-aa2@-aa3@-aa4@-aa5@-aa6@-aa7@-aa8@-aa9@
# restore non-jumps
aa9:+++aa6:+aa5:+aa4:+aa3:+aa2:+aa1:+>>a3!
# make room to dup addresses in jumps
aa7: +++++++ ab5:<ab1@>ab2:>>ab2! ab4:<ab5!<ab3:>+<-ab3! ab4@
ab1:>ab6@>+ab1! ab6:<-<<->a3!
aa8: ++++++++ ab5!

b: >>-<+<<<<b1:-b1!<
# mark first instruction
b2:<b2!<<<<b2!>>>+rb!
#>>b3:>b3!>>b3!+rb!
r2: r1:

# go to current instruction
r: <rc:<r! rd:<<<ra:<ra!<rd@ rb:>re:>re!>>+
# 0=< 1=> 2=+ 3=- 4=, 5=. 6=[ 7=] 8=STOP
<<< - 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: +++++++
# check cell
o1:>o1!>>>>o1!>o2:>>o2!<rc!
# go to jump counter
<o3:<<o3! o4:<<<o5:<o5!<o4@

# prepare for jump counter decrement
++++++<<<-------q1:<q1!<-q2:>q3@-q3:>q2!<<
q4:->+>+<<q4!<<q4!>>>q5:<+>-q5!>q5!<of:<
# decrement jump counter
o8:-o6!+<<o7@ o8! o6:>>o9@+++++++++o6!
# go to jump indicator & increment to next instruction
o9:<oa:<oa!<<ob!<<og@ oa! ob:>>og:>og!>og!+>>od:>od!>>od!>oe:>oe! of@
# no more decrements, so restore command
o7:>o7!>>>oh:<<<+>>>-oh!
# set instruction
>oi:<oi!<<<<oi!>om:>oj@->ok!+ok:>ol:>ol! om@
# clear all old instructions
oj:>oq!+oq:>or:>or! os:>>rd@->op:>op! os@

# ]
p: ++++++++
# check cell
p1:>p1!>>>>p1!>p2:>>p2!<rc@
# go to jump counter
<p3:<<p3! p4:<<<p5:<p5!<p4@
# prepare for jump counter decrement
+++++++<<<--------q1@

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

SMITH interpreter in perl

nsmith.pl

#!/usr/bin/perl -w
# 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.

### Nate's SMITH Interpreter ###

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

### GLOBALS ###

# @mem is an array which contains all program instructions.
my @mem = ();

# @reg is an array which contains all machine registers.
# The value of R0 is stored in $reg[0].
my @reg = ();

# $debug is a flag indicating whether we want debugging messages
# to appear during loadtime and runtime.  By default off, it can
# be turned on by giving the command line option -d or --debug.
my $debug;

# flag to continue after error
my $cont;

# flag to be quiet
my $quiet;

# flag to pause during debugging
# only works when input is from terminal! :-)
my $pause;

# debugging lines
my @debug_lines = ();

# storage for : macros
my %macros = ();

# Math::BigInt flag
my $bigint;

# memory-crunching flag and variables
my $memory = -1;
my @originals;

# flag to suppress registers in debug mode
my $suppress;

# flag to dump expansion and exit
my $expand;

# flag to implement COR "bug" of reference implementation
my $goofy;

# specify # of registers in debug mode
my $registers;

### PARSING SUBROUTINES ###

# load_program loads the program into the @mem array.  Handles the
# REP directive and ":" macro definitions. All "@" instances are
# also expanded at this stage
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;
}

# expand_program expands all "##" and "*" macros
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;
  }
}

# compile_program converts each @mem line into an anonymous
# subroutine. In other words, string matching is only performed
# once, which results in a significant speed increase over the
# reference implementation.
#
# As an added bonus, the @mem array now consists of references
# to a limited number of values. As a long-running SMITH program
# executes, the @mem array is filled with an ever increasing
# number of pointers to the same set of data, as opposed to an
# ever increasing number of copies of strings. This significantly
# increases the number of total instructions which can be executed
# before memory is exhausted ... in theory.
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;
  }
}

### MAIN PROGRAM SUBROUTINES ###

# run_program sequentially executes the subroutines in @mem
# using the registers stored in @reg to handle values.
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);
    }
  }
}

# memory_run is identical to run_program except that
# @mem is now a list of indices into @originals.
# @originals is a list of the actual functions.
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();
  }
}

### INITIALIZATION, MESSAGES and DIAGNOSTICS ###

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;

### MAIN ###

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;
}

# load the program
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]);

# expand the program
print "  Expanding..." if not $quiet;
expand_program();

# compile the program
print "  Compiling..." if not $quiet;
compile_program();

# run the program
print "  Running...\n" if not $quiet;
if ($memory == 3) {
  memory_run();
} else {
  run_program();
}

exit 0;

### SMM ###

package SMM1;
# SMITH Memory Management 1
# Tie an array to a reference array with an
# index offset. Retain only the last 100,000
# values of the array in memory.

# Only one instance of this class is created, so
#  a many principles of class construction are
#  violated below.

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;
# SMITH Memory Management 2
# Tie an array to two reference arrays
# The reference arrays hold the first 100,000
# and last 100,000 values of the array
# The in-between values are discarded

# keeps two arrays in memory:
#  1 - the first 100,000 values
#  2 - the last 100,000 to 200,000 values
# It is expected that a SMITH program will either
# access the very first section of instructions or
# the recent instruction history when copying code
# forward.

# Only one instance of this class is created, so
#  a many principles of class construction are
#  violated below.

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;
# SMITH Memory Management 3
# Transparently manage a HUGE and GROWING array of
# non-negative integers using the tie mechanism

# Only one instance of this class is created, so
#  a many principles of class construction are
#  violated below.

# keeps two arrays in memory:
#  1 - the first 100,000 values
#  2 - the last 100,000 to 200,000 values
# The values in between are stored to a temporary
# file. If there is a gzip executable in the path,
# the file is gzipped to save disk space. It is
# expected that a SMITH program will either access
# the very first section of instructions or the
# recent instruction history when copying code
# forward. The in-between instruction history may
# be accessed for reading and writing, but such
# access is _very_ slow.

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$$");
}

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

SMITHb interpreter in perl

smithb.pl

#!/usr/bin/perl -w
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 @stack = ();
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;

# stage 0: raw source
$_ = ( 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 "";
}

# we're done if all we want is the source printout
print(join(" ", map { $_->{val} } @source), $opt_b ? "!" : ""), exit if $opt_c;

# stage 5
# populate the stack array

my @stack = map { $_->{val} eq "*" ? undef : $_->{val} } @source;

# clear up some memory
@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;

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
*/

#include <gmp.h>
#include <stdio.h>
#include <stdlib.h>

#define STACK_INIT 1024

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");
}

brainfuck-to-SMITHb translator

bf2smithb.pl

#!/usr/bin/perl -w
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";
#$tst1 = "";

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; }
  );

# read in the BF code and parse out all non-BF characters
my $BFcode = ( join(, <>) );
$BFcode =~ s/[^-+<>\[\]\.,]//sg;

# collapse up to 27 +'s into a single instruction
# ("A" is 2 +'s, "Z" is 27 +'s)
# create the operations for these characters on the fly
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});
  }
}

# collapse up to 27 -'s into a single instruction
# ("a" is 2 -'s, "z" is 27 -'s)
# create the operations for these characters on the fly
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});
  }
}

# collapse up to 11 <'s into a single instruction
# ("0" is 2 <'s, "9" is 11 <'s)
# create the operations for these characters on the fly
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;

# This one line does the real work of parsing brainfuck code
defined($ops{$_}) && $ops{$_}->() for @BFcode;
$SMBcode .= "STOP STOP STOP 0 -2\n";

print "$SMBcode\n";

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

Thue

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

Whirl

brainfuck to Whirl translator

bf2whirl.pl

#!/usr/bin/perl -w
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;

User:Nthern/archive

Contents

/// and itflabtijtslwi

/// interpreter in perl

/// interpreter in C

Thue-to-/// translator

BCT interpreter in ///

BCT interpreter in itflabtijtslwi 1

BCT interpreter in itflabtijtslwi 2

BCT interpreter in itflabtijtslwi 3

Befunge(-93)

Befunge(-93) interpreter in perl with bignums

Befunge(-93) interpreter in C with bignums

Befunge(-93) interpreter of brainfuck

brainfuck

natural number brainfuck to 8-bit brainfuck converter

Bub-to-brainfuck translator

Bub interpreter in brainfuck

Bub interpreter in brainfuck 2

Bub

Bub interpreter

brainfuck-to-Bub translator

"Extended brainfuck" (Bub) parser

BCT interpreter in Bub 1

Bub interpreter in Bub 1

Bub interpreter in Bub 2

brainfuck interpreter in Bub (DBFI)

SMITH

SMITH interpreter in perl

brainfuck interpreter in SMITH

SMITHb

SMITHb interpreter in perl

SMITHb interpreter in C

brainfuck-to-SMITHb translator

brainfuck interpreter in SMITHb

Thue

BCT in Thue

Whirl

brainfuck to Whirl translator

Navigation menu

User:Nthern/archive

/// and itflabtijtslwi

/// interpreter in perl

/// interpreter in C

Thue-to-/// translator

BCT interpreter in ///

BCT interpreter in itflabtijtslwi 1

BCT interpreter in itflabtijtslwi 2

BCT interpreter in itflabtijtslwi 3

Befunge(-93)

Befunge(-93) interpreter in perl with bignums

Befunge(-93) interpreter in C with bignums

Befunge(-93) interpreter of brainfuck

brainfuck

natural number brainfuck to 8-bit brainfuck converter

Bub-to-brainfuck translator

Bub interpreter in brainfuck

Bub interpreter in brainfuck 2

Bub

Bub interpreter

brainfuck-to-Bub translator

"Extended brainfuck" (Bub) parser

BCT interpreter in Bub 1

Bub interpreter in Bub 1

Bub interpreter in Bub 2

brainfuck interpreter in Bub (DBFI)

SMITH

SMITH interpreter in perl

brainfuck interpreter in SMITH

SMITHb

SMITHb interpreter in perl

SMITHb interpreter in C

brainfuck-to-SMITHb translator

brainfuck interpreter in SMITHb

Thue

BCT in Thue

Whirl

brainfuck to Whirl translator

Navigation menu

Search