ilo-vm/source/ilo.ha

// ilo.ha, an ilo in hare

use bufio;
use fmt;
use fs;
use io;
use math;
use os;

let ds: [33]i32 = [0...];
let rs: [257]i32 = [0...];
let m: [65536]i32 = [0...];
let sp: i32 = 0;
let rp: i32 = 0;
let ip: i32 = 0;
let a: i32 = 0;
let b: i32 = 0;
let c: i32 = 0;

fn initialize() void = {
  sp = 0;
  rp = 0;
  ip = 0;
  load();
};

fn load() void = {
  const input = match (os::open("ilo.rom")) {
    case let file: io::file =>
      yield file;
    case let err: fs::error =>
      fmt::fatalf("Error opening {}: {}",
        os::args[1], fs::strerror(err));
  };
  defer io::close(input)!;
  let rdbuf: [os::BUFSZ]u8 = [0...];
  let input = &bufio::init(input, rdbuf, []);
  let i = 0;
  let buf: [4]u8 = [0, 0, 0, 0];
  for (!(io::read(input, buf)! is io::EOF)) {
    let x: u32 = m[i]:u32;
    x = x + (buf[3]:u32 << 24);
    x = x + (buf[2]:u32 << 16);
    x = x + (buf[1]:u32 << 8);
    x = x + (buf[0]:u32 << 0);
    m[i] = x:i32;
    i = i + 1;
  };
};

fn read_block(block:i32, buffer:i32) void = {
  const block_store = match (os::open("ilo.blocks")) {
    case let file: io::file =>
      yield file;
    case let err: fs::error =>
      fmt::fatalf("Error opening {}: {}",
        "ilo.blocks", fs::strerror(err));
  };
  defer io::close(block_store)!;

  let rdbuf: [os::BUFSZ]u8 = [0...];
  let block_store = &bufio::init(block_store, rdbuf, []);

  let i: i32 = 0;
  let buf: [4096]u8 = [0...];

  // this is not an optimal way, need to figure out
  // io::seek
  // io::seek(block_store, block * 4096, io::whence::SET)!;
  let za:i32 = 0;
  for (za < block) {
    io::read(block_store, buf)!;
    za = za + 1;
  };

  let cell: [4]u8 = [0...];

  // read in the block
  for (i < 1024) {
    io::read(block_store, cell)!;
    let x: u32 = 0;
    x = x + (cell[3]:u32 << 24);
    x = x + (cell[2]:u32 << 16);
    x = x + (cell[1]:u32 << 8);
    x = x + (cell[0]:u32 << 0);
    let t:i32 = buffer + i;
    m[t] = x:i32;
    i = i + 1;
  };
};

fn write_block(block:i32, buffer:i32) void = {
  const block_store = match (os::open("ilo.blocks", fs::flag::RDWR)) {
    case let file: io::file =>
      yield file;
    case let err: fs::error =>
      fmt::fatalf("Error opening {}: {}",
        "ilo.blocks", fs::strerror(err));
  };
  defer io::close(block_store)!;

  let rdbuf: [os::BUFSZ]u8 = [0...];
  let wrbuf: [os::BUFSZ]u8 = [0...];
  let block_store = &bufio::init(block_store, rdbuf, wrbuf);

  let i: i32 = 0;
  let buf: [4096]u8 = [0...];

  let za:i32 = 0;
  for (za < block) {
    io::read(block_store, buf)!;
    za = za + 1;
  };

  let cell: [4]u8 = [0...];

  // read in the block
  for (i < 1024) {
    let t:i32 = buffer + i;
    let x: u32 = m[t]:u32;
    cell[3] = ((x >> 24) & 0xFF):u8;
    cell[2] = ((x >> 16) & 0xFF):u8;
    cell[1] = ((x >> 8) & 0xFF):u8;
    cell[0] = ((x >> 0) & 0xFF):u8;
    io::write(block_store, cell)!;
    i = i + 1;
  };
  io::close(block_store)!;
};

fn push(v: i32) void = { sp = sp + 1; ds[sp] = v; };
fn pop() i32 = { sp = sp - 1; return ds[sp + 1]; };
fn save_ip() void = { rp = rp + 1; rs[rp] = ip; };

fn no() void = { return; };
fn li() void = { ip = ip + 1; push(m[ip]); };
fn du() void = { push(ds[sp]); };
fn dr() void = { pop(); };
fn sw() void = { a = pop(); b = pop(); push(a); push(b); };
fn pu() void = { rp = rp + 1; rs[rp] = pop(); };
fn po() void = { push(rs[rp]); rp = rp - 1; };
fn ju() void = { ip = pop() - 1; };
fn ca() void = { save_ip(); ip = pop() - 1; };
fn cc() void = { a = pop(); if (pop() != 0) { save_ip(); ip = a - 1; }; };
fn cj() void = { a = pop(); if (pop() != 0) { ip = a - 1; }; };
fn re() void = { ip = rs[rp]; rp = rp - 1; };
fn eq() void = { a = pop(); b = pop();
                 if (a == b) { push(-1); } else { push(0); }; };
fn ne() void = { a = pop(); b = pop();
                 if (a != b) { push(-1); } else { push(0); }; };
fn lt() void = { a = pop(); b = pop();
                 if (b < a) { push(-1); } else { push(0); }; };
fn gt() void = { a = pop(); b = pop();
                 if (b > a) { push(-1); } else { push(0); }; };
fn fe() void = { ds[sp] = m[ds[sp]]; };
fn st() void = { m[ds[sp]] = ds[sp - 1]; sp = sp - 2; };
fn ad() void = { ds[sp - 1] = ds[sp - 1] + ds[sp]; pop(); };
fn su() void = { ds[sp - 1] = ds[sp - 1] - ds[sp]; pop(); };
fn mu() void = { ds[sp - 1] = ds[sp - 1] * ds[sp]; pop(); };
fn di() void = { a = ds[sp]; b = ds[sp - 1];
                 ds[sp] = b / a; ds[sp - 1] = b % a; };
fn an() void = { ds[sp - 1] = ds[sp - 1] & ds[sp]; pop(); };
fn or() void = { ds[sp - 1] = ds[sp - 1] | ds[sp]; pop(); };
fn xo() void = { ds[sp - 1] = ds[sp - 1] ^ ds[sp]; pop(); };
fn sl() void = { ds[sp - 1] = ds[sp - 1] << ds[sp]; pop(); };
fn sr() void = { ds[sp - 1] = ds[sp - 1] >> ds[sp]; pop(); };
fn cp() void = {
  a = pop(); b = pop(); c = pop(); push(-1);
  for (a > 0; a = a - 1) {
    if (m[b] != m[c]) { ds[sp] = 0; };
    b = b + 1;
    c = c + 1;
  };
};
fn cy() void = {
  a = pop(); b = pop(); c = pop();
  for (a > 0; a = a - 1) {
    m[b] = m[c];
    b = b + 1;
    c = c + 1;
  };
};
fn io() void = {
  switch (pop()) {
    case => return;
    case 0 => fmt::printf("{}", pop():rune)!; return;
    case 1 => let buf: [1]u8 = [0];
              io::read(os::stdin, buf)!;
              let z:i32 = buf[0]:i32;
              push(z); return;
    case 2 => let buf = pop(); let blk = pop();
              read_block(blk, buf);
              return;
    case 3 => let buf = pop(); let blk = pop();
              write_block(blk, buf);
              return;
    case 4 => return;
    case 5 => initialize(); ip = -1; return;
    case 6 => fmt::fatal("BYE!");
    case 7 => push(sp); push(rp); return;
  };
};

fn process(o: i32) void = {
  switch (o) {
    case => return;
    case  0 => return;         case  1 => return li();
    case  2 => return du();    case  3 => return dr();
    case  4 => return sw();    case  5 => return pu();
    case  6 => return po();    case  7 => return ju();
    case  8 => return ca();    case  9 => return cc();
    case 10 => return cj();    case 11 => return re();
    case 12 => return eq();    case 13 => return ne();
    case 14 => return lt();    case 15 => return gt();
    case 16 => return fe();    case 17 => return st();
    case 18 => return ad();    case 19 => return su();
    case 20 => return mu();    case 21 => return di();
    case 22 => return an();    case 23 => return or();
    case 24 => return xo();    case 25 => return sl();
    case 26 => return sr();    case 27 => return cp();
    case 28 => return cy();    case 29 => return io();
  };
};

fn execute() void = {
  for (ip < 65536) {
    let opcode = m[ip];
    process(opcode & 0xFF);
    process((opcode >> 8) & 0xFF);
    process((opcode >> 16) & 0xFF);
    process((opcode >> 24) & 0xFF);
    ip = ip + 1;
  };
};

export fn main() void = {
  initialize();
  execute();
};