msullivan

-- Exploration of pre monadic IO facilities and how they relate to
-- each other and with monadic IO.
-- See: http://research.microsoft.com/en-us/um/people/simonpj/papers/history-of-haskell/
-- and http://cpsc.yale.edu/sites/default/files/files/tr665.pdf

import System.IO
import System.IO.Unsafe
import System.IO.Error
import System.Exit
import Data.Functor

msullivan

// Adapated from some code at
// http://stackoverflow.com/questions/3948479/integer-overflow-and-undefined-behavior

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

// gcc starts optimizing the branch out at -O2; clang never does
void f(int a, int b) {
    if (a > 0 && b > 0) {
        if (a + b <= 0) {

msullivan

(* Third order function for imperatively building sequences in safe way,
 * even if the underlying implementation uses unsafety.
 *
 * Type is:
 *   build : (('a -> unit) -> 'b) -> 'a list * 'b
 *
 * "build f" calls "f push", where push is a function that adds its argument
 * to the sequence being built under the hood.
 *
 * Inliner needs to be pretty good for this to own.

msullivan

typedef int fixed_t;

#define SIGN(n) ((n) < 0 ? -1 : 1)

#define FRACTIONAL_BITS 24 // Number of fixed point fractional bits

// A bunch of macros for constructing fixed point numbers.
#define INT_TO_FIXED(n) ((n) << FRACTIONAL_BITS)
#define FRAC_TO_FIXED(n, d) ((fixed_t)(INT_TO_FIXED((long long)(n)) / (d)))
#define IMPROPER_TO_FIXED(i, n, d) FRAC_TO_FIXED((i)*(d) + SIGN(i)*(n), (d))

msullivan

/*!
 * @file mandelbrot.c
 *
 * @brief A very cool, fractal test.
 *
 * Written by Keith Bare sometime aeons ago, improved by sully
 * to support panning and zooming in Spring 2014.
 *
 * This version compromises on some of the original behaviors of mandelbrot
 * in order to get panning/zooming to perform better in simics.

msullivan

	// setcontext pushes the return address onto the stack in order to
	// restore it by running ret. It would be bad if we wrote to the
	// parent's thread stack, for obvious reasons. Instead we set up
	// our own stack for it to go on and we generate code that restores
	// the real %esp and then does a jmp to the real %eip.
	size_t bullshit_ministack[2];
	bullshit_ministack[1] = ctx.uc_mcontext.gregs[REG_ESP];

	char ret_code[6] = { 0x5c /* pop %esp */, 0xe9 /* jmp rel32 */ };
	uint32_t target_eip = ctx.uc_mcontext.gregs[REG_EIP] + 2; // skip the int

msullivan

// Safe implementation based on the existential power of closures.
mod ClosureUniversal {
    // A value of universal type is a pair of functions.  store will
    // write the underlying value into the associated tag, while clear
    // will erase the data in the tag to prevent space leaks.
    pub struct Univ {
        priv store: @fn(),
        priv clear: @fn()
    }

msullivan

(* A slightly different take on http://mlton.org/UniversalType *)

(* Our interface uses an explicit tag object instead of pairs of
 * injection/projection function. This is maybe more intuitive for
 * some people, and it makes the lambda based implementation nicer,
 * at the expense of the exn based one. *)
signature UNIVERSAL_TYPE =
sig
    type 'a tag
    type t

msullivan

struct Command<'self> {
    cmd: &'self str,
    usage_line: &'self str,
}

static COMMANDS: &'static [Command<'static>] = &[
    Command{
        cmd: "build",
        usage_line: "compile rust source files",
    }

msullivan

    // XXX: this is *completely* bad and wrong. I feel bad.  Handling
    // of vtables is currently bogus for default methods, and changing
    // to an unflattented representation of vtables causes this to
    // show up in cases that it did not previously. We need to make
    // the vtables list be the same length as the substs.
    // This is nothing right about this. I really need to emphasize just
    // how wrong it is: it is completely wrong.
    // XXX: bad. -sully
    let vtables = do vtables.map |vtbls| {
        if vtbls.len() < substs.tps.len() {