Fun with opcodes

"If I were to implement a language now, I'd write a very minimal core suitable for bootstrapping. ... Think of a handful of ops. Think very low level. (Think something a little higher than the universal Turing machine and the lambda calculus and maybe a little bit more VMmy than a good Forth implementation, and you have it.) If you've come up with something that can replace XS, stop. You're there. Do not continue. That's what you need." (Chromatic, January 2013) 

In September or October I started thinking about that, and began to play with a tiny interpreter written in Perl that processed a rather loose version of Lua opcodes.

Lua includes a register-based virtual machine (VM) and has a uniquely light-and-performant driven view of interpreters.  Using Perl to implement a sort-of Lua VM opcode interpreter let me play with the concepts without having to really write very much, because Perl is nothing if not excellent at tokenizing strings and tearing apart text.

Here's the core loop.


my %R   = (); # registers
my %K   = (); # constants
my %U   = (); # "upvars"
my $PC  = 0;  # program counter
my $FPF = 0; # ???

my @prg = <DATA>;

while( $PC < @prg )
{
   my $line = $prg[ $PC ];
   my ($opcode, $a, $b, $c, $d) = split ' ', $line;

   $PC++;
  
   next unless $opcode;
  
   given( lc $opcode )
   {
      when (/ffd2/)         { print $R{$a}; print " " if $b eq '\s';  print "\n" if $b eq '\n' }
      when (/nl/)            { print "\n" }
     
      when (/clr/)          { $R{$_} = '' for $a .. $b }
      when (/move/)          { $R{$a} = $R{$b} }
      when (/loadk/)         { $R{$a} = $b     }
      when (/loadbool/)        { $R{$a} = $b? 1 : 0; $PC++ if $c }
      when (/loadnil/)        { $R{$_} = 0 for $a..$b }
      when (/getupval/)     { $R{$a} = $U{$b} }
     
      when (/gettabup/)     { $R{$a} = $U{$b}->{ $c } }
      when (/gettable/)     { $R{$a} = $R{$b}->{ $c } }
     
      when (/settabup/)     { $U{$a}->{ $b } = $R{$c} }
      when (/setupval/)     { $U{$b} = $R{$a} }
      when (/settable/)     { $R{$a}->{$b} = $c }
     
      when (/newtable/)     { $R{$a} = {} } # size = B,C
     
      when (/self/)         { $R{$a+1} = $R{$b};
                              $R{$a} = $R{$b}->{$c} }
                       
      when (/inc/)            { $R{$a}++ }
      when (/dec/)            { $R{$a}-- }
      when (/bz/)           { $PC += $b unless $R{$a} }
      when (/bnz/)          { $PC += $b if     $R{$a} }

      when (/add/)          { $R{$a} = $b + $c }
      when (/sub/)          { $R{$a} = $b - $c }
      when (/mul/)          { $R{$a} = $b * $c }
      when (/div/)             { $R{$a} = $b / $c }
      when (/mod/)          { $R{$a} = $b % $c }
      when (/pow/)            { $R{$a} = $b ** $c }
      when (/unm/)          { $R{$a} = -$R{$b} }
      when (/not/)          { $R{$a} = ~$R{$b} }         # ?
      when (/len/)          { $R{$a} = length $R{$b} }  # ...if scalar
                                     # $#R{$b}          # ...if hash
                                   
      when (/concat|cat|join/)    { my $sp = $R{$d}? ' ' : ''; $R{$a} = join( $sp, @R{$b..$c} ) }
           
      when (/ju?mp/)        { $PC += $a; closeAllUpvalues($R{$a}+1) if $a }
      when (/j?eq/)            { $PC++ if ( $b == $c ) != $a }
      when (/j?lt/)            { $PC++ if ( $b < $c ) != $a }
      when (/j?le/)             { $PC++ if ( $b <= $c ) != $a }
     
      when (/test/)         { $PC++ unless $R{$b} <=> $c }
      when (/testset/)        { ( $R{$b} <=> $c )? $R{$a} = $R{$b} : $PC++ }
 
      when (/call/)         { @R{$a..$a+$c-2} = call( @R{$a..$a+$b-1} ) }
     
      when (/tailcall/)     { call(@R{$a..$a+$b-1}) }
     
      when (/return/)       { @R{$a..$a+$b-2} }
     
      when (/forloop/)        { $R{$a} += $R{$a+2};
                              $PC += $b if $R{$a} <= $R{$a+1} }
     
      when (/forprep/)        { $R{$a} -= $R{$a+2}; $PC += $b }
     
      when (/tforcall/)        { @R{$a+3..$a+2+$c} = call( $R{$a..$a+2} ) }
     
      when (/tforloop/)        { if ( $R{$a+1} ) {
                                $R{$a} = $R{$a+1};
                                $PC += $b
                            }}
     
      when (/setlist/)        { $R{$a}->{ ($c-1) * $FPF + $_ } = $R{$a+1}
                                    for 1..$b;
                            }
     
      when (/closure/)        { $R{$a} = closure(proto($b)) }
      when (/vararg/)        { $R{$_} = 'vararg' for $R{$a} .. $R{$a+$b-2} }                   
     
   }; 
}