mbc.nqp

my $buf := nqp::newtype(nqp::null(), 'VMArray');
nqp::composetype($buf, nqp::hash('array', nqp::hash('type', uint8)));
nqp::setmethcache($buf, nqp::hash(
    'new', method () {
        nqp::create($buf)
    },
    'push', method (uint8 $value) {
        nqp::push_i(self, $value)
    }
));

class MoarVM::Frame {
    has str $!cuuid;
    has uint32 $!cuuid-idx;
    has str $!name;
    has uint32 $!name-idx;
    method BUILD(:$cuuid, :$name) {
        $!cuuid := $cuuid;
        $!name  := $name;
    }
    method cuuid() { $!cuuid }
    method name() { $!name }
    method cuuid-idx() { $!cuuid-idx }
    method name-idx() { $!name-idx }
    method add-strings-to-heap($string-heap) {
        $!cuuid-idx := $string-heap.add($!cuuid);
        $!name-idx  := $string-heap.add($!name);
    }
}

class MoarVM::StringHeap {
    has @!strings;
    method BUIILD() {
        @!strings := list();
    }
    method add(str $s) {
        my $encoded := nqp::encode($s, 'utf8', nqp::create($buf));
        nqp::push(@!strings, $encoded);
        my $pad := nqp::elems($encoded) % 4;
        $encoded.push(0) while $pad--;
        nqp::elems(@!strings) - 1
    }
    method size() {
        my uint32 $size := 0;
        for @!strings {
            $size := $size + 4 + nqp::elems($_);
        }
        $size
    }
    method elems() {
        nqp::elems(@!strings)
    }
    method strings() {
        @!strings
    }
}

class MoarVM::BytecodeWriter {
    has $!mbc;
    has $!string-heap;
    has @!frames;
    has $!bytecode;
    method BUILD() {
        $!mbc := $buf.new;
        $!string-heap := MoarVM::StringHeap.new;
        @!frames := nqp::list;
    }
    method add-string(str $s) {
        $!string-heap.add($s);
    }
    method add-frame(MoarVM::Frame $f) {
        nqp::push(@!frames, $f);
        $f.add-strings-to-heap($!string-heap);
    }
    method write_s(str $s) {
        my @subbuf := nqp::encode($s, 'utf8', nqp::create($buf));
        self.write_buf(@subbuf);
    }
    method write_uint32(uint32 $i) {
        self.write($i +& 0xFF);
        self.write($i +& 0xFF00);
        self.write($i +& 0xFF0000);
        self.write($i +& 0xFF000000);
    }
    method write_uint16(uint16 $i) {
        self.write($i +& 0xFF);
        self.write($i +& 0xFF00);
    }
    method write_buf(@buf) {
        for @buf {
            self.write($_);
        }
    }
    method write(uint8 $b) {
        $!mbc.push($b);
    }
    method write_header() {
        # 92 bytes
        my uint32 $header_size := 8 + 21 * 4;
        my uint32 $frames := 1;
        my $hll := self.add-string('perl6');
        self.write_s("MOARVM\r\n");
        self.write_uint32(5); # Version
        self.write_uint32(0); # Offset of SC dependencies table
        self.write_uint32(0); # Number of entries in SC dependencies table
        self.write_uint32(0); # Offset of extension ops table
        self.write_uint32(0); # Number of entries in extension ops table
        self.write_uint32($header_size); # Offset of frames segment
        self.write_uint32($frames); # Number of frames
        self.write_uint32(0); # Offset of callsites segment
        self.write_uint32(0); # Number of callsites
        self.write_uint32($header_size + 50 * $frames); # Offset of strings heap
        self.write_uint32($!string-heap.elems); # Number of strings in heap
        self.write_uint32(0); # Offset of SC data segment
        self.write_uint32(0); # Number of entries in SC data segment
        my uint32 $bytecode_offset := $header_size + 50 * $frames + $!string-heap.size;
        self.write_uint32($bytecode_offset); # Offset of bytecode segment
        self.write_uint32(2); # Length of bytecode segment
        self.write_uint32(0); # Offset of annotation segment
        self.write_uint32(0); # Length of annotation segment
        self.write_uint32($hll); # HLL Name
        self.write_uint32(0); # Main entry point frame index + 1
        self.write_uint32(0); # Library load frame index + 1
        self.write_uint32(0); # Deserialization frame index + 1
    }
    method write_frame(MoarVM::Frame $f) {
        # 11 * 4 + 3 * 2 = 50
        self.write_uint32(0); # Bytecode segment offset
        self.write_uint32(2); # Bytecode length in bytes
        self.write_uint32(1); # Number of locals/registers
        self.write_uint32(0); # Number of lexicals
        self.write_uint32($f.cuuid-idx); # Compilation unit unique ID (string heap index)
        self.write_uint32($f.name-idx); # Name (string heap index)
        self.write_uint16(0); # Outer
        self.write_uint32(0); # Annotation segment offset
        self.write_uint32(0); # Number of annotations
        self.write_uint32(0); # Number of handlers
        self.write_uint16(0); # Frame flag bits
        self.write_uint16(0); # Number of entries in static lexical values table
        self.write_uint32(0); # Code object SC dependency index + 1
        self.write_uint32(0); # SC object index
    }
    method write_string_heap() {
        for $!string-heap.strings {
            self.write_uint32(nqp::elems($_) * 2 + 1); # LSB is UTF-8 flag
            self.write_buf($_);
        }
    }
    method dump() {
        note(nqp::elems($!mbc) ~ " bytes");
        for $!mbc {
            note($_);
        }
    }
    proto method write_instruction($i) { * }
    multi method write_instruction(MAST::Op $i) {
        self.write_uint16($i.op);
        for $i.operands -> $o {
            self.write_operand($o);
        }
    }
    multi method write_instruction($i) {
        note("Instruction " ~ $i.HOW.name($i) ~ " NYI");
        note($i.dump);
    }
    proto method write_operand($o) { * }
    multi method write_operand(MAST::IVal $o) {
        self.write_uint16(nqp::getattr($o, MAST::IVal, '$!value'));
    }
    multi method write_operand($o) {
        note("Operand " ~ $o.HOW.name($o) ~ " NYI");
        note($o.dump);
    }
    method assemble() {
        self.write_header;
        for @!frames {
            self.write_frame($_);
        }
        self.write_string_heap;
    }
    method save($filename) {
        my $io := nqp::open($filename, 'w');
        nqp::writefh($io, $!mbc);
        nqp::closefh($io);
    }
}

my $compiler := nqp::getcomp('nqp');
my @stages := $compiler.stages;
my $result := '1';
my %adverbs := nqp::hash;
%adverbs<target> := 'mbc';
%adverbs<compunit_ok> := 1;
my %*COMPILING<%?OPTIONS> := %adverbs;
my $lineposcache := nqp::hash;
my $*LINEPOSCACHE := $lineposcache;
for @stages {
    last if $_ eq 'mbc';
    $result := $compiler.execute_stage($_, $result, %adverbs);
}
my @frames := nqp::getattr($result, MAST::CompUnit, '@!frames');

my $writer := MoarVM::BytecodeWriter.new;
my $frame := MoarVM::Frame.new(:cuuid(@frames[0].cuuid), :name(@frames[0].name));
$writer.add-frame($frame);
$writer.assemble;
for @frames[0].instructions -> $i {
    $writer.write_instruction($i);
}
$writer.write_uint16(55); # return
$writer.write_uint16(0);  # 0th register
$writer.save('test.mbc');
#note(@frames[0].dump);