ink/lib.c

#include "include/ink.h"
#ifndef NOSTDLIB
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <ctype.h>
#ifdef INSTRUMENTATION
#include <time.h>
#endif
#endif

#define INK_RESERVED (-1)
#define INK_FUNCTION_KW (-2)
#define INK_DO_KW (-3)
#define INK_END_KW (-4)
#define INK_LABEL (-5)
#define INK_RETURN (-6)

#define _KEYWORD_INK_FUNCTION "fn"
#define _KEYWORD_INK_DO "do"
#define _KEYWORD_INK_END "end"
#define _KEYWORD_INK_RETURN "return"

#define INK_ARRAY_FLAG_PROTECTED 1

#define min(x, y) ((x) > (y) ? (y) : (x))
#define max(x, y) ((x) < (y) ? (y) : (x))

struct label {
    int active;
    int dest;
    char* name;
};

#ifdef NOSTDLIB

static size_t strlen(const char* c) {
	size_t j;
	j = 0;
	while(*(c++)) {
		j++;
	}
	return j;
}

static void* memcpy(void* _dest, const void* _src, size_t sz) {
	char* dest;
	const char* src;
	dest = _dest;
	src = _src;
	while(sz--) {
		*(dest++) = *(src++);
	}
	return dest;
}

static int strcmp(const char* dest, const char* src) {
	while(*dest != 0 && *src != 0) {
		if(*(dest++) != *(src++)) {
			return 1;
		}
	}
	return 0;
}

static void* memmove(void* _dest, const void* _src, size_t sz) {
	char* dest;
	const char* src;
	dest = _dest;
	src = _src;
	if (src < dest) {
		src += sz;
		dest += sz;
		while (sz-- > 0) {
			*--dest = *--src;
		}
	} else {
		while (sz-- > 0) {
			*dest++ = *src++;
		}
	}
	return dest;
}

static void* memset(void* _dest, int src, size_t sz) {
	char* dest;
	dest = _dest;
	while(sz--) {
		*(dest++) = src++;
	}
	return dest;
}

static int isspace(int d) {
	return d == ' ' || d == '\t' || d == '\n';
}

static int isdigit(int d) {
	return  '0' <= d && d <= '9';
}

static int atoi(const char* c) {
	int ret;
	ret = 0;
	while(*c) {
		ret *= 10;
		ret += *c - '0';
		++c;
	}
	return ret;
}

#endif

int ink_add_native(struct context* ctx, const char* name, void(*value)(struct context*)) {
    int len;
    char* copy;
    if(ctx->native_words == NULL) {
        ctx->native_words = ctx->inner_malloc(ctx, sizeof(struct native_fn) * 8);
        ctx->native_words_top = 0;
        ctx->native_words_capacity = 8;
    } else if(ctx->native_words_top == ctx->native_words_capacity) {
        int new_count;
        void* renewed;
        new_count = (ctx->native_words_capacity + ctx->native_words_capacity/2);
        renewed = ctx->inner_realloc(ctx, ctx->native_words, sizeof(struct native_fn) * new_count);
        if(renewed == NULL) {
            return -3;
        } else {
            ctx->native_words = renewed;
            ctx->native_words_capacity = new_count;
        }
    }
    len = strlen(name);
    copy = ctx->inner_malloc(ctx, len+1);
    if(copy == NULL) {
        return -4;
    }
    memcpy(copy, name, len);
    copy[len] = 0;
    ctx->native_words[ctx->native_words_top].value = value;
    ctx->native_words[ctx->native_words_top].name = copy;
    ctx->native_words_top++;
    return 0;
}

static int ink_add_indigenous(struct context* ctx, const char* name, struct elem* m, size_t count) {
    int len, i;
    char* copy;

    if(ctx->words == NULL) {
        ctx->words = ctx->malloc(ctx, sizeof(struct fn) * 8);
        ctx->words_top = 0;
        ctx->words_capacity = 8;
    } else if(ctx->words_top == ctx->words_capacity) {
        int new_count;
        void* renewed;
        new_count = (ctx->words_capacity + ctx->words_capacity/2);
        renewed = ctx->realloc(ctx, ctx->words, sizeof(struct fn) * new_count);
        if(renewed == NULL) {
            return -1;
        } else {
            ctx->words = renewed;
            ctx->words_capacity = new_count;
        }
    }
    for(i = 0; i < ctx->words_top; ++i) {
        if(strcmp(name, ctx->words[i].name) == 0) {
            if(ctx->words[i].things != NULL) ctx->free(ctx, ctx->words[i].things);
            ctx->words[i].things = ctx->malloc(ctx, sizeof(struct elem) * count);
            memcpy(ctx->words[i].things, m, sizeof(struct elem) * count);
            ctx->words[i].size = count;
            return i;
        }
    }
    len = strlen(name);
    copy = ctx->malloc(ctx, len+1);
    if(copy == NULL) {
        return -2;
    }
    memcpy(copy, name, len);
    copy[len] = 0;
    ctx->words[ctx->words_top].things = ctx->malloc(ctx, sizeof(struct elem) * count);
    memcpy(ctx->words[ctx->words_top].things, m, sizeof(struct elem) * count);
    ctx->words[ctx->words_top].size = count;
    ctx->words[ctx->words_top].name = copy;
    return ctx->words_top++;
}

/**
 *
 * @param ctx The context
 * @param name The name to add
 * @internal add a lexed string to the parser
 * @return the id of the string in the list
 */
static int ink_add_lex_string(struct context* ctx, const char* name) {
    int i;
    int len;
    if(ctx->lex_reserved_words == NULL) {
        ctx->lex_reserved_words = ctx->inner_malloc(ctx, sizeof(char*) * 8);
        ctx->lex_reserved_words_top = 0;
        ctx->lex_reserved_words_capacity = 8;
    } else if(ctx->lex_reserved_words_top == ctx->lex_reserved_words_capacity) {
        int new_count;
        void* renewed;
        new_count = (ctx->lex_reserved_words_capacity + ctx->lex_reserved_words_capacity/2);
        renewed = ctx->inner_realloc(ctx, ctx->lex_reserved_words, sizeof(struct native_fn) * new_count);
        if(renewed == NULL) {
            return -5;
        } else {
            ctx->lex_reserved_words = renewed;
            ctx->lex_reserved_words_capacity = new_count;
        }
    }
    for(i = 0; i < ctx->lex_reserved_words_top; i++) {
        if(strcmp(ctx->lex_reserved_words[i], name) == 0) {
            return i;
        }
    }
    len = strlen(name);
    i = ctx->lex_reserved_words_top;
    ctx->lex_reserved_words[i] = ctx->malloc(ctx, len+1);
    memcpy(ctx->lex_reserved_words[i], name, len);
    ctx->lex_reserved_words[i][len] = 0;
    ctx->lex_reserved_words_top++;
    return i;
}

int ink_push(struct context* ctx, struct elem value) {
    struct ink_routine* current;
    if(ctx->routine_current >= ctx->routines_top) return -65;
    current = ctx->routines + ctx->routine_current;
    if(current->stack == NULL) {
        current->stack = ctx->malloc(ctx, sizeof(struct elem) * 8);
        current->top = 0;
        current->capacity = 8;
    } else if(current->top == current->capacity) {
        int new_count;
        void* renewed;
        new_count = (current->capacity + current->capacity/2);
        renewed = ctx->realloc(ctx, current->stack, sizeof(struct elem) * new_count);
        if(renewed == NULL) {
            return -18;
        } else {
            current->stack = renewed;
            current->capacity = new_count;
        }
    }
    current->stack[current->top] = value;
    current->top++;
    return 0;
}

int ink_push_fn(struct context* ctx, struct stack_frame value) {
    struct ink_routine* current;

    if(ctx->routine_current >= ctx->routines_top) return -55;
    current = ctx->routines + ctx->routine_current;
    if(current->panic) return -56;
    if(current->function_stack == NULL) {
        current->function_stack = ctx->malloc(ctx, sizeof(struct stack_frame) * 8);
        current->function_stack_top = 0;
        current->function_stack_capacity = 8;
    } else if(current->function_stack_top == current->function_stack_capacity) {
        int new_count;
        void* renewed;
        new_count = (current->function_stack_capacity + current->function_stack_capacity/2);
        renewed = ctx->realloc(ctx, current->function_stack, sizeof(struct stack_frame) * new_count);
        if(renewed == NULL) {
            return -9;
        } else {
            current->function_stack = renewed;
            current->function_stack_capacity = new_count;
        }
    }
    current->function_stack[current->function_stack_top] = value;
    current->function_stack_top++;
    return 0;
}

void ink_pop_fn(struct context* ctx) {
    if(ctx->routine_current >= ctx->routines_top) return;
    if(ctx->routines[ctx->routine_current].panic) return;
    if(ctx->routines[ctx->routine_current].function_stack == NULL) return;
    if(ctx->routines[ctx->routine_current].function_stack_top == 0) return;
    ctx->routines[ctx->routine_current].function_stack_top--;
}

void ink_pop(struct context* ctx) {
    if(ctx->routine_current >= ctx->routines_top) return;
    if(ctx->routines[ctx->routine_current].panic) return;
    if(ctx->routines[ctx->routine_current].stack == NULL) return;
    if(ctx->routines[ctx->routine_current].top == 0) return;
    ctx->routines[ctx->routine_current].top--;
}

struct context* ink_make_context(void*(*malloc)(struct context*, size_t), void*(*realloc)(struct context*, void*, size_t), void(*free)(struct context*, void*), int(*putchar)(struct context*, int)) {
    struct context* ctx;
    ctx = (struct context*)malloc(NULL, sizeof(struct context));
    ctx->malloc = malloc;
    ctx->realloc = realloc;
    ctx->free = free;
    ctx->inner_malloc = malloc;
    ctx->inner_realloc = realloc;
    ctx->inner_free = free;
    ctx->putchar = putchar;
    ctx->panic = 0;
    ctx->routines = NULL;
    ctx->routines_capacity = 0;
    ctx->routines_top = 0;
    ctx->types = NULL;
    ctx->types_capacity = 0;
    ctx->types_top = 0;
    ctx->native_words = NULL;
    ctx->native_words_capacity = 0;
    ctx->native_words_top = 0;
    ctx->words = NULL;
    ctx->words_capacity = 0;
    ctx->words_top = 0;
    ctx->lex_reserved_words = NULL;
    ctx->lex_reserved_words_capacity = 0;
    ctx->lex_reserved_words_top = 0;
    ctx->collections = 0;
    ctx->steps = 0;
    return ctx;
}

void ink_make_context_inplace(struct context* location, void*(*malloc)(struct context*, size_t), void*(*realloc)(struct context*, void*, size_t), void(*free)(struct context*, void*), int(*putchar)(struct context*, int)) {
    struct context* ctx = location;
    ctx->malloc = malloc;
    ctx->realloc = realloc;
    ctx->free = free;
    ctx->inner_malloc = malloc;
    ctx->inner_realloc = realloc;
    ctx->inner_free = free;
    ctx->putchar = putchar;
    ctx->panic = 0;
    ctx->routines = NULL;
    ctx->routines_capacity = 0;
    ctx->routines_top = 0;
    ctx->types = NULL;
    ctx->types_capacity = 0;
    ctx->types_top = 0;
    ctx->native_words = NULL;
    ctx->native_words_capacity = 0;
    ctx->native_words_top = 0;
    ctx->words = NULL;
    ctx->words_capacity = 0;
    ctx->words_top = 0;
    ctx->lex_reserved_words = NULL;
    ctx->lex_reserved_words_capacity = 0;
    ctx->lex_reserved_words_top = 0;
    ctx->collections = 0;
    ctx->steps = 0;
}

/**
 * Allocates a string that contains the integer
 * @param _ context (used to allocate)
 * @param cpy the value
 * @return the allocated string, needs to be freed by ctx->free
 * @internal this function is slightly cursed
 */
static char* ink_itoa(struct context* _, int cpy) {
    char* n;
    char* it;
    n = _->malloc(_, 16);
    n[15] = 0;
    it = n+15;
    do {
        it--;
        *it = (cpy % 10) + '0';
        cpy = cpy / 10;
    } while(cpy);
    memmove(n, it, 16 - (it-n));
    return n;
}

#ifndef NOSTDLIB
static void* ink_malloc(struct context* _, size_t sz) {
    _=_;
    return malloc(sz);
}
static void* ink_realloc(struct context* _, void* ptr, size_t sz) {
    _=_;
    return realloc(ptr, sz);
}
static void ink_free(struct context* _, void* ptr) {
    _=_;
    printf("%p\n", ptr);
    free(ptr);
}
static int ink_putchar(struct context* _, int c) {
    _=_;
    return putchar(c);
}

struct context* ink_make_default_context(void) {
    struct context* ctx;
    ctx = ink_make_context(ink_malloc, ink_realloc, ink_free, ink_putchar);
    ink_std_library(ctx);
    return ctx;
}
#endif

#ifndef NOSTRINGLITERALS
static void new_protected_array(struct context* ctx);
#endif

static int ink_consume_one(int* end, struct context* pContext, char* r, int is_str) {
    int i;
    int done;
    struct elem value;
    int err;
#ifndef NOSTRINGLITERALS
    if(is_str) {
        struct ink_routine* routine = pContext->routines + pContext->routine_current;
        struct ink_array* ary;
        int it = 0;
        new_protected_array(pContext);
        if(routine->top < 1) {
            pContext->panic = -1;
            return -8746;
        }
        value = routine->stack[routine->top - 1];
        ary = ink_get_value(pContext, value);
        if(ary == NULL) {
            pContext->panic = -1;
            return -8747;
        }
        for(;it != *end;++it) {
            struct elem character;
            character.type = INK_INTEGER;
            /* TODO: codepoint conversion and coalescence is required here */
            character.value = r[it];
            array_push(pContext, routine, ary, character);
        }
        *end = 0;
        return 0;
    }
#endif
    is_str = is_str;
    if(*end == 0) {
        return 0;
    }
    r[*end] = 0;
    done = 0;
    if (strcmp(r, _KEYWORD_INK_FUNCTION) == 0) {
        value.value = 0;
        value.type = INK_FUNCTION_KW;
        done = 1;
    }
    if (!done && strcmp(r, _KEYWORD_INK_DO) == 0) {
        value.value = 0;
        value.type = INK_DO_KW;
        done = 1;
    }
    if (!done && strcmp(r, _KEYWORD_INK_END) == 0) {
        value.value = 0;
        value.type = INK_END_KW;
        done = 1;
    }
    if (!done && strcmp(r, _KEYWORD_INK_RETURN) == 0) {
        value.value = 0;
        value.type = INK_RETURN;
        done = 1;
    }
    if(done) {
        err = ink_push(pContext, value);
        if(err < 0) {
            return -19;
        }
    }
    if (!done) {
        for (i = 0; i < pContext->words_top; ++i) {
            if (strcmp(r, pContext->words[i].name) == 0) {
                value.value = i;
                value.type = INK_FUNCTION;
                err = ink_push(pContext, value);
                if(err < 0) {
                    return -20;
                }
                done = 1;
                break;
            }
        }
    }
    if (!done) {
        for (i = 0; i < pContext->native_words_top; ++i) {
            if (strcmp(r, pContext->native_words[i].name) == 0) {
                value.value = i;
                value.type = INK_NATIVE_FUNCTION;
                err = ink_push(pContext, value);
                if(err < 0) {
                    return -21;
                }
                done = 1;
                break;
            }
        }
    }
    if (!done) {
        for(i = (r[0] == '-'); i < *end; i++) {
            if(!isdigit(r[i])){
                goto not_an_int;
            }
        }
        value.value = atoi(r);
        value.type = INK_INTEGER;
        err = ink_push(pContext, value);
        if(err < 0) {
            return -22;
        }
        done = 1;
    }
    not_an_int:
    if (!done) {
        i = ink_add_lex_string(pContext, r);
        if(i < 0) {
            pContext->panic = 1;
            return -7;
        }
        value.value = i;
        if(r[strlen(r) - 1] == ':') {
            value.type = INK_LABEL;
        } else {
            value.type = INK_RESERVED;
        }
        err = ink_push(pContext, value);
        if(err < 0) {
            return -23;
        }
    }
    *end = 0;
    return 0;
}

static int ink_lex(struct context *pContext, const char* buffer) {
    /* Limits the token size to 127 chars */
    char r[128];
    int end;
    int err;
#ifndef NOSTRINGLITERALS
    int parses_string;
#endif
    end = 0;
    restart_after_comment:
#ifndef NOSTRINGLITERALS
    parses_string = 0;
#endif
    while(*buffer != 0) {
#ifndef NOSTRINGLITERALS
        if(parses_string) {
            switch(*buffer) {
                case '"': {
                    if(*(buffer+1) == 0 || isspace(*(buffer+1))) {
                        err = ink_consume_one(&end, pContext, r, 1);
                        if(err < 0) {
                            pContext->panic = 1;
                            return -995;
                        }
                        parses_string = 0;
                    } else if(*(buffer+1) == '"') {
                        r[end] = *buffer;
                        ++end;
                        ++buffer;
                    } else if(*(buffer+1) == '/' && *(buffer+2) == '"') {
                        r[end] = '\n';
                        ++end;
                        ++buffer;
                        ++buffer;
                    } else {
                        pContext->panic = 1;
                        return -994;
                    }
                }break;
                default:
                    r[end] = *buffer;
                    ++end;
            }
        } else /* ... */
#endif
        if(isspace(*buffer)) {
            if(end == 1 && r[0] == '#') {
                while(*buffer != '\n' && *buffer != 0) {
                    ++buffer;
                }
                end = 0;
                goto restart_after_comment;
            }
            err = ink_consume_one(&end, pContext, r, 0);
            if(err < 0) {
                pContext->panic = 1;
                return -8;
            }
        } else /* ... */
#ifndef NOSTRINGLITERALS
        if(end == 0 && *buffer == '"' && !parses_string) {
            parses_string = 1;
        } else /* ... */
#endif
        {
            r[end] = *buffer;
            ++end;
        }
        ++buffer;
    }
    err = ink_consume_one(&end, pContext, r, 0);
    if(err < 0) {
        pContext->panic = 1;
        return -9;
    }
    return 0;
}

static int lblcmp(const char* label, const char* other, size_t label_sz) {
    while (label_sz != 1) {
        if(*other == 0) return 1;
        if(*label != *other) return 1;
        ++label;
        ++other;
        label_sz--;
    }
    return 0;
}

int ink_make_routine(struct context* ctx) {
    struct ink_routine* it;
    struct ink_routine* end;

    /* Allocate space if needed */
    if(ctx->routines == NULL) {
        ctx->routines = ctx->inner_malloc(ctx, sizeof(struct ink_routine) * 8);
        ctx->routines_top = 0;
        ctx->routines_capacity = 8;
        it = ctx->routines;
        end = ctx->routines + 8;
        for(;it != end;++it) {
            it->stack = NULL;
            it->function_stack = NULL;
            it->panic = INK_ROUTINE_CAN_REUSE;
            it->parse_error.is_set = 0;
            it->runtime_error.is_set = 0;
        }
    } else if(ctx->routines_top == ctx->routines_capacity) {
        int new_count;
        void* renewed;
        new_count = (ctx->routines_capacity + ctx->routines_capacity/2);
        renewed = ctx->inner_realloc(ctx, ctx->routines, sizeof(struct ink_routine) * new_count);
        if(renewed == NULL) {
            return -99;
        } else {
            ctx->routines = renewed;
            it = ctx->routines + ctx->routines_capacity;
            end = ctx->routines + new_count;
            for(;it != end;++it) {
                it->stack = NULL;
                it->function_stack = NULL;
                it->panic = INK_ROUTINE_CAN_REUSE;
                it->parse_error.is_set = 0;
                it->runtime_error.is_set = 0;
            }
            ctx->routines_capacity = new_count;
        }
    }

    it = ctx->routines;
    end = ctx->routines + ctx->routines_capacity;
    /* Looks for a reusable routine space then uses it */
    for(;it != end;++it) {
        if(it->panic == INK_ROUTINE_CAN_REUSE) {
            int idx;
            it->panic = 0;
            it->top = 0;
            it->function_stack_top = 0;

            idx = it - ctx->routines;
            if(idx >= ctx->routines_top) {
                ctx->routines_top = idx + 1;
            }
            return idx;
        }
    }
    /* FIXME: Maybe we need to abort here, this seems like quite an unsteady state */
    return -758;
}

int ink_kill_routine(struct context* ctx, int routine){
    struct ink_routine* curr;
    if(routine < 0 || routine >= ctx->routines_top) {
        return 0;
    }
    curr = ctx->routines + routine;
    if(curr->panic == INK_ROUTINE_CAN_REUSE) {
        return 0;
    }
    if(curr->stack != NULL) {
        ctx->free(ctx, curr->stack);
        curr->stack = NULL;
    }
    if(curr->function_stack != NULL) {
        ctx->free(ctx, curr->function_stack);
        curr->function_stack = NULL;
    }
    curr->panic = INK_ROUTINE_CAN_REUSE;
    return 1;
}

/**
 *
 * @param pContext
 * @param executable_buffer
 * @param executable_buffer_top
 * @internal Loop from hell
 */
static int ink_parse(struct context* pContext, struct elem* executable_buffer, int* executable_buffer_top) {
    struct ink_routine* currentRoutine;
    int i, function_buffer_top, function_name, mode;
    int err;
#define LABEL_BUFFER 128
#define FUNCTION_BUFFER 256
    struct label labels[LABEL_BUFFER];
    struct elem function_buffer[FUNCTION_BUFFER];
    /* TODO: add checks for overflows in these arrays */
    currentRoutine = pContext->routines + pContext->routine_current;
    function_buffer_top = 0;
    function_name = -1;
#define MODE_EXECUTABLE 0
#define MODE_FUNCTION 1
#define MODE_DO 2
    mode = MODE_EXECUTABLE;
    memset(labels, 0, sizeof(struct label)*LABEL_BUFFER);

    /* Loop from hell, good luck, pro-tip: leave the parser alone */
    for(i = 0; i < currentRoutine->top; ++i) {
        struct elem current;
        current = currentRoutine->stack[i];
        switch (mode) {
            case MODE_EXECUTABLE:
                switch(current.type) {
                    case INK_FUNCTION_KW:
                        mode = MODE_FUNCTION;
                        function_name = -1;
                        goto next_token;
                    case INK_DO_KW:
                        currentRoutine->parse_error.is_set = 1;
                        currentRoutine->parse_error.error_message = "Found start of function body unexpectedly";
                        currentRoutine->parse_error.offset= i;
                        return -26;
                    case INK_END_KW:
                        currentRoutine->parse_error.is_set = 1;
                        currentRoutine->parse_error.error_message = "Found end of function unexpectedly";
                        currentRoutine->parse_error.offset= i;
                        return -26;
                    default:
                        executable_buffer[*executable_buffer_top] = current;
                        *executable_buffer_top += 1;
                }
                break;
            case MODE_FUNCTION:
                if(current.type == INK_DO_KW) {
                    if(function_name == -1) {
                        currentRoutine->parse_error.is_set = 1;
                        currentRoutine->parse_error.error_message = "Found start of function body before the name of the function was provided";
                        currentRoutine->parse_error.offset= i;
                        return -27;
                    } else {
                        mode = MODE_DO;
                        memset(labels, 0, sizeof(struct label)*128);
                        goto next_token;
                    }
                }
                if(function_name != -1) {
                    currentRoutine->parse_error.is_set = 1;
                    currentRoutine->parse_error.error_message = "Function name was not found";
                    currentRoutine->parse_error.offset= i;
                    return -28;
                }
                if(current.type != INK_RESERVED) {
                    currentRoutine->parse_error.is_set = 1;
                    currentRoutine->parse_error.error_message = "Expected special token";
                    currentRoutine->parse_error.offset= i;
                    return -29;
                }
                function_name = current.value;
                break;
            case MODE_DO:
                if(current.type == INK_END_KW) {
                    int j;
                    for(j = 0; j < function_buffer_top; j++) {
                        struct elem pt;
                        pt =  function_buffer[j];
                        if(pt.type == INK_LABEL) {
                            int k;
                            for(k = 0; k < LABEL_BUFFER; k++) {
                                if(labels[k].active) {
                                    if(strcmp(labels[k].name, pContext->lex_reserved_words[pt.value]) == 0) {
                                        labels[k].dest = j;
                                        currentRoutine->parse_error.is_set = 1;
                                        currentRoutine->parse_error.error_message = "Label duplicate label in function";
                                        currentRoutine->parse_error.offset= i;
                                        return -30;
                                        break;
                                    }
                                } else {
                                    labels[k].active = 1;
                                    labels[k].name = pContext->lex_reserved_words[pt.value];
                                    labels[k].dest = j;
                                    memcpy(function_buffer+j, function_buffer+j+1, sizeof(struct elem)*(function_buffer_top-j-1));
                                    function_buffer_top--;
                                    j--;
                                    break;
                                }
                            }
                        }
                    }
                    for(j = 0; j < function_buffer_top; j++) {
                        struct elem pt;
                        pt =  function_buffer[j];
                        if(pt.type == INK_RESERVED) {
                            int k;
                            for(k = 0; k < LABEL_BUFFER; k++) {
                                if(labels[k].active) {
                                    int label_sz;
                                    const char* lbl;
                                    lbl = labels[k].name;
                                    label_sz = strlen(lbl);
                                    if(lblcmp(labels[k].name, pContext->lex_reserved_words[pt.value], label_sz) == 0) {
                                        function_buffer[j].type = INK_INTEGER;
                                        function_buffer[j].value = labels[k].dest - j;
                                        break;
                                    }
                                } else break;
                            }
                        }
                    }
                    err = ink_add_indigenous(pContext, pContext->lex_reserved_words[function_name], function_buffer, function_buffer_top);
                    if(err < 0) {
                        pContext->panic = 1;
                        return -33;
                    }
                    function_buffer_top = 0;
                    mode = MODE_EXECUTABLE;
                    goto next_token;
                }
                function_buffer[function_buffer_top] = current;
                function_buffer_top += 1;
                break;
        }
        next_token: i=i;
    }
    if(mode == MODE_FUNCTION || mode == MODE_DO) {
        currentRoutine->parse_error.is_set = 1;
        currentRoutine->parse_error.error_message = "Expected a function to be complete";
        currentRoutine->parse_error.offset= i;
        return -32;
    }
    return 0;
#undef MODE_EXECUTABLE
#undef MODE_FUNCTION
#undef MODE_DO

#undef LABEL_BUFFER
#undef FUNCTION_BUFFER
}

int ink_step(struct context *pContext) {
    struct ink_routine* currentRoutine;
    struct stack_frame frame;
    struct stack_frame* top;
    struct elem next;
    int t;

    currentRoutine = pContext->routines + pContext->routine_current;
    pContext->steps++;
    if(currentRoutine->function_stack_top == 0) return 0;
    if(pContext->panic) {
        return -1;
    }
    top = &currentRoutine->function_stack[currentRoutine->function_stack_top-1];
    t = top->executing.type;
    switch(t) {
        case INK_NATIVE_FUNCTION:
            if(top->index != 0) {
                ink_pop_fn(pContext);
            } else {
                top->index++;
                if(pContext->native_words_top <= top->executing.value) {
                    currentRoutine->runtime_error.is_set = 1;
                    currentRoutine->runtime_error.error_message = "Bytecode contained out of bound executable word";
                    pContext->panic = 1;
                    return -1;
                }
                pContext->native_words[top->executing.value].value(pContext);
            }
            break;
        case INK_FUNCTION:
            if(pContext->words_top <= top->executing.value) {
                currentRoutine->runtime_error.is_set = 1;
                currentRoutine->runtime_error.error_message = "Bytecode contained out of bound artificial word";
                pContext->panic = 1;
                return -1;
            }
            if(top->index >= pContext->words[top->executing.value].size) {
                ink_pop_fn(pContext);
            } else {
                next = pContext->words[top->executing.value].things[top->index];
                if(next.type == INK_RETURN) {
                    ink_pop_fn(pContext);
                    return 1;
                }
                frame.executing = next;
                frame.index = 0;
                t = ink_push_fn(pContext, frame);
                if(t < 0) {
                    pContext->panic = 1;
                    currentRoutine->runtime_error.is_set = 1;
                    currentRoutine->runtime_error.error_message = "Instruction pointer underflow";
                    return -11;
                }
                top->index++;
            }
            break;
        default:
            t = ink_push(pContext, top->executing);
            if(t < 0) {
                currentRoutine->runtime_error.is_set = 1;
                currentRoutine->runtime_error.error_message = "Literal token could not be pushed";
                pContext->panic = 1;
                return -25;
            }
            ink_pop_fn(pContext);
            break;
    }
    return 1;
}

int ink_compile(struct context *pContext, const char* buffer) {
    int routine, saved, executable_buffer_top;
    /* Main function has a size limit of 256 (need to know that for REPL */
    struct elem executable_buffer[256];
    struct ink_routine* currentRoutine;
    int err;
    struct stack_frame frame;
    char* integer;
    size_t integer_size;
    char main_fn[32] = "__-MAIN-__";

    routine = ink_make_routine(pContext);
    saved = pContext->routine_current;
    pContext->routine_current = routine;
    currentRoutine = pContext->routines + routine;
    currentRoutine->stack = NULL;
    currentRoutine->top = 0;
    currentRoutine->capacity = 0;
    err = ink_lex(pContext, buffer);
    if(err < 0) {
        if(!currentRoutine->parse_error.is_set) {
            currentRoutine->parse_error.is_set = 1;
            currentRoutine->parse_error.error_message = "Unknown lexer error";
            currentRoutine->parse_error.offset = -1;
        }
        pContext->panic = 1;
        return -1;
    }
    executable_buffer_top = 0;
    err = ink_parse(pContext, executable_buffer, &executable_buffer_top);
    if(err < 0) {
        if(!currentRoutine->parse_error.is_set) {
            currentRoutine->parse_error.is_set = 1;
            currentRoutine->parse_error.error_message = "Unknown parser error";
            currentRoutine->parse_error.offset = -1;
        }
        pContext->panic = 1;
        return -1;
    }
    if(executable_buffer_top != 0) {
        integer = ink_itoa(pContext, routine);
        integer_size = strlen(integer);
        memcpy(main_fn + 10, integer, integer_size);
        pContext->free(pContext, integer);
        integer = NULL;
        main_fn[10 + integer_size] = 0;
        frame.executing.value = ink_add_indigenous(pContext, main_fn, executable_buffer, executable_buffer_top);
        if (frame.executing.value < 0) {
            if(!currentRoutine->parse_error.is_set) {
                currentRoutine->parse_error.is_set = 1;
                currentRoutine->parse_error.error_message = "Could not start execution: no valid way to create a frame";
                currentRoutine->parse_error.offset = -1;
            }
            pContext->panic = 1;
            return -1;
        }
        frame.executing.type = INK_FUNCTION;
        frame.index = 0;
        err = ink_push_fn(pContext, frame);
        pContext->routines[pContext->routine_current].top = 0;
        if (err < 0) {
            if(!currentRoutine->parse_error.is_set) {
                currentRoutine->parse_error.is_set = 1;
                currentRoutine->parse_error.error_message = "Could not push any executable frame: push failed";
                currentRoutine->parse_error.offset = -1;
            }
            pContext->panic = 1;
            return -1;
        }
    } else {
        pContext->routines[pContext->routine_current].panic = INK_ROUTINE_SUCCESS;
    }

    pContext->routine_current = saved;
    return routine;
}

int ink_can_run(struct context* pContext) {
    int it;
    if(pContext->panic) return 0;
    if(pContext->routines_top == 0) return 0;
    for(it = 0; it < pContext->routines_top; ++it) {
        if(
                pContext->routines[it].panic == 0
                && !pContext->routines[it].parse_error.is_set
                && !pContext->routines[it].runtime_error.is_set
                ) {
            return 1;
        }
    }
    return 0;
}

int ink_step_everyone(struct context* pContext) {
    int out;
    pContext->routine_current = -1;
    for(;;) {
        /* Increment to next runnable routine */
        do{
            ++(pContext->routine_current);
        } while(
                pContext->routine_current < pContext->routines_top
                && pContext->routines[pContext->routine_current].panic != 0
                && pContext->routines[pContext->routine_current].parse_error.is_set
                && pContext->routines[pContext->routine_current].runtime_error.is_set
                );
        /* Exit condition */
        if(pContext->routine_current >= pContext->routines_top) break;

        /* Kill? */
        if(pContext->routines[pContext->routine_current].panic == INK_ROUTINE_SUCCESS) {
            ink_kill_routine(pContext, pContext->routine_current);
        }

        /* Step! */
        out = ink_step(pContext);
        if(out == 0) {
            pContext->routines[pContext->routine_current].panic = INK_ROUTINE_SUCCESS;
        } else if(out < 0) {
            pContext->routines[pContext->routine_current].panic = out;
        }
    }
    return 0;
}

int ink_new_type(
        struct context* ctx,
        const char* type_name,
        int size,
        void (*collect)(struct context*,void*),
        struct ink_collection_list (*gc)(struct context*,void*)
) {
    if(ctx->panic) return -128;
    /* Resize for push */
    if(ctx->types == NULL) {
        ctx->types = ctx->inner_malloc(ctx, sizeof(struct ink_type) * 8);
        ctx->types_top = 0;
        ctx->types_capacity = 8;
    } else if(ctx->types_top == ctx->types_capacity) {
        int new_count;
        void* renewed;
        new_count = (ctx->types_capacity + ctx->types_capacity/2);
        renewed = ctx->inner_realloc(ctx, ctx->types, sizeof(struct ink_type) * new_count);
        if(renewed == NULL) {
            return -129;
        } else {
            ctx->types = renewed;
            ctx->types_capacity = new_count;
        }
    }

    /* Push */
    ctx->types[ctx->types_top].name = type_name;
    ctx->types[ctx->types_top].element_size = size;
    ctx->types[ctx->types_top].elements = NULL;
    ctx->types[ctx->types_top].elements_top = 0;
    ctx->types[ctx->types_top].elements_capacity = 0;
    ctx->types[ctx->types_top].collect = collect;
    ctx->types[ctx->types_top].gc = gc;

    ctx->types_top++;
    /* Satisfying the minimal value requirement */
    return ctx->types_top - 1 + 16;
}

static struct element_slab* ink_get_value_link(struct context* ctx, struct elem ref) {
    int type_id;
    if(ref.type < 16) return NULL;
    type_id = ref.type - 16;
    if(type_id >= ctx->types_top) return NULL;
    if(ctx->types[type_id].element_size == 0) return NULL;
    if(ref.value < 0) return NULL;
    if(ref.value >= ctx->types[type_id].elements_top) return NULL;
    if(! ctx->types[type_id].elements[ref.value].in_use) return NULL;
    return ctx->types[type_id].elements + ref.value;
}

void* ink_get_value(struct context* ctx, struct elem ref) {
    struct element_slab* s;
    s = ink_get_value_link(ctx, ref);
    if(s == NULL) return NULL;
    return s->data;
}

struct elem ink_make_native_unsafe(struct context* ctx, int type, void* ptr, int is_protected) {
    int type_id;
    struct elem ret;
    int g, i;

    if(type < 16) {
        ret.type = 0;
        ret.value = -130;
        return ret;
    }

    /* Apply invariant of the user defined types */
    type_id = type - 16;
    if(type_id >= ctx->types_top) {
        ret.type = 0;
        ret.value = -129;
        return ret;
    }

    if(ctx->panic) {
        ret.type = 0;
        ret.value = -135;
        return ret;
    }

    /* Resize for push of value in store */
    if(ctx->types[type_id].elements == NULL) {
        ctx->types[type_id].elements = ctx->inner_malloc(ctx, sizeof(struct element_slab) * 8);
        ctx->types[type_id].elements_top = 0;
        ctx->types[type_id].elements_capacity = 8;
        memset(ctx->types[type_id].elements + ctx->types[type_id].elements_top, 0, sizeof(struct element_slab)*(ctx->types[type_id].elements_capacity - ctx->types[type_id].elements_top));
    } else if(ctx->types[type_id].elements_top == ctx->types[type_id].elements_capacity) {
        int new_count;
        void* renewed;
        new_count = (ctx->types[type_id].elements_capacity + ctx->types[type_id].elements_capacity/2);
        renewed = ctx->inner_realloc(ctx, ctx->types[type_id].elements, sizeof(struct element_slab) * new_count);
        if(renewed == NULL) {
            ret.type = 0;
            ret.value = -129;
            return ret;
        } else {
            ctx->types[type_id].elements = renewed;
            ctx->types[type_id].elements_capacity = new_count;
            memset(ctx->types[type_id].elements + ctx->types[type_id].elements_top, 0, sizeof(struct element_slab)*(ctx->types[type_id].elements_capacity - ctx->types[type_id].elements_top));
        }
    }

    /* Push value in store */
    g = ctx->types[type_id].elements_capacity;
    for(i = 0; i < g; ++i) {
        if(! ctx->types[type_id].elements[i].in_use) {
            ctx->types[type_id].elements[i].in_use = 1;
            ctx->types[type_id].elements[i].uses = 1;
            ctx->types[type_id].elements[i].is_protected = is_protected;
            if(ctx->types[type_id].element_size < 0) {
                ctx->types[type_id].elements[i].data = ptr;
            } else {
                void* new_ptr = ctx->malloc(ctx, ctx->types[type_id].element_size);
                if(new_ptr == NULL) {
                    ret.type = 0;
                    ret.value = -139;
                    return ret;
                }
                memcpy(new_ptr, ptr, ctx->types[type_id].element_size);
                ctx->types[type_id].elements[i].data = new_ptr;
            }
            ctx->types[type_id].elements_top = max(ctx->types[type_id].elements_top, i+1);
            ret.type = type;
            ret.value = i;
            return ret;
        }
    }
    ret.type = 0;
    ret.value = -140;
    return ret;
}

struct elem ink_make_native(struct context* ctx, int type, void* ptr) {
    return ink_make_native_unsafe(ctx, type, ptr, 0);
}

void ink_clean_routines(struct context* ctx) {
    int i, j;
    struct elem null;

    null.value = 0;
    null.type = INK_INTEGER;
    for(i = 0; i < ctx->routines_top; ++i) {
        if(ctx->routines[i].panic == INK_ROUTINE_CAN_REUSE || ctx->routines[i].panic == INK_ROUTINE_SUCCESS) {
            if(ctx->routines[i].stack != NULL) {
                for (j = 0; j < ctx->routines[i].top; ++j) {
                    ctx->routines[i].stack[j] = null;
                }
            }
            if(ctx->routines[i].function_stack != NULL) {
                for (j = 0; j < ctx->routines[i].function_stack_top; ++j) {
                    ctx->routines[i].function_stack[j].executing = null;
                    ctx->routines[i].function_stack[j].index = 0;
                }
            }
            ctx->routines[i].top = 0;
            ctx->routines[i].function_stack_top = 0;
        }
    }
}

void ink_gc(struct context* ctx) {
    int i, j, k;
    int marked;
    struct element_slab* v;

    for(i = 0; i < ctx->types_top; ++i) {
        for(j = 0; j < ctx->types[i].elements_top; ++j) {
            ctx->types[i].elements[j].uses = 0;
        }
    }

    /* Start by marking the roots of the routines, Clear the routines if possible */
    for(i = 0; i < ctx->routines_top; ++i) {
        if(ctx->routines[i].panic == INK_ROUTINE_SUCCESS) {
            if(ctx->routines[i].stack != NULL) {
                ctx->free(ctx, ctx->routines[i].stack);
                ctx->routines[i].stack = NULL;
            }
            if(ctx->routines[i].function_stack != NULL) {
                ctx->free(ctx, ctx->routines[i].function_stack);
                ctx->routines[i].function_stack = NULL;
            }
            ctx->routines[i].panic = INK_ROUTINE_CAN_REUSE;
        }
        if(ctx->routines[i].panic == INK_ROUTINE_CAN_REUSE) {
            continue;
        }
        for(j = 0; j < ctx->routines[i].top; ++j) {
            v = ink_get_value_link(ctx, ctx->routines[i].stack[j]);
            if(v != NULL) ++v->uses;
        }
    }

    /* TODO: Mark objects contained within function code */

    /* Mark the rest of the data */
    do {
        marked = 0;
        for (i = 0; i < ctx->types_top; ++i) {
            for (j = 0; j < ctx->types[i].elements_top; ++j) {
                /* Only mark from things that are active and detected as in use */
                if (ctx->types[i].elements[j].in_use && ctx->types[i].elements[j].is_protected && ctx->types[i].elements[j].uses) {
                    struct ink_collection_list c;
                    c = ctx->types[i].gc(ctx, ctx->types[i].elements[j].data);
                    for (k = 0; k < c.count; ++k) {
                        v = ink_get_value_link(ctx, c.elements[k]);
                        /* Never mark twice to avoid infinite loops with e.g. arrays that contain themselves */
                        if (v != NULL && !v->uses) {
                            ++v->uses;
                            marked = 1;
                        }
                    }
                    if (c.elements != NULL) {
                        ctx->inner_free(ctx, c.elements);
                        c.elements = NULL;
                    }
                }
            }
        }
    } while(marked);

    /* Sweep phase: explore any allocated data and sweep the unused away */
    for(i = 0; i < ctx->types_top; ++i) {
        for(j = 0; j < ctx->types[i].elements_top; ++j) {
            if(ctx->types[i].elements[j].uses == 0 && ctx->types[i].elements[j].in_use && ctx->types[i].elements[j].is_protected == 0) {
                ctx->collections++;
                ctx->types[i].collect(ctx, ctx->types[i].elements[j].data);
                if(ctx->types[i].element_size > 0 && ctx->types[i].elements[j].data != NULL) {
                    ctx->free(ctx, ctx->types[i].elements[j].data);
                }
                ctx->types[i].elements[j].data = NULL;
                ctx->types[i].elements[j].uses = 0;
                ctx->types[i].elements[j].in_use = 0;
            }
        }
    }
}

/**********************************************************************************************************************/

static void print_stacktrace(struct context* _) {
    int i;
    struct ink_routine* currentRoutine;
    currentRoutine = _->routines + _->routine_current;

    for(i = 0; i < currentRoutine->function_stack_top; ++i) {
        struct elem thing;
        char *n;
        thing = currentRoutine->function_stack[i].executing;
        switch(thing.type) {
            case INK_NATIVE_FUNCTION: {
                n = _->native_words[thing.value].name;
                while (*n) {
                    _->putchar(_, *n);
                    ++n;
                }
                _->putchar(_, 10);
                break;
            }
            case INK_FUNCTION:{
                n = _->words[thing.value].name;
                while (*n) {
                    _->putchar(_, *n);
                    ++n;
                }
                _->putchar(_, ':');
                n = ink_itoa(_, currentRoutine->function_stack[i].index);
                while (*n) {
                    _->putchar(_, *n);
                    ++n;
                }
                _->putchar(_, 10);
                break;
            }
            default:
                break;
        }
    }
}

static void add_int(struct context* ctx) {
    struct ink_routine* currentRoutine;
    struct elem a;
    struct elem b;
    currentRoutine = ctx->routines + ctx->routine_current;
    if(currentRoutine->top < 2) {
        currentRoutine->panic = -1;
        return;
    }
    a =  currentRoutine->stack[currentRoutine->top-1];
    b =  currentRoutine->stack[currentRoutine->top-2];
    if(!(a.type == INK_INTEGER && b.type == INK_INTEGER)) {
        ctx->panic = 1;
        return;
    }
    ink_pop(ctx);
    currentRoutine->stack[currentRoutine->top-1].value = a.value + b.value;
}

static void sub_int(struct context* ctx) {
    struct ink_routine* currentRoutine;
    struct elem a;
    struct elem b;
    currentRoutine = ctx->routines + ctx->routine_current;
    if(currentRoutine->top < 2) {
        currentRoutine->panic = -1;
        return;
    }
    a =  currentRoutine->stack[currentRoutine->top-1];
    b =  currentRoutine->stack[currentRoutine->top-2];
    if(!(a.type == INK_INTEGER && b.type == INK_INTEGER)) {
        currentRoutine->panic = -1;
        return;
    }
    ink_pop(ctx);
    currentRoutine->stack[currentRoutine->top-1].value = b.value - a.value;
}

static void mult_int(struct context* ctx) {
    struct ink_routine* currentRoutine;
    struct elem a;
    struct elem b;
    currentRoutine = ctx->routines + ctx->routine_current;
    if(currentRoutine->top < 2) {
        currentRoutine->panic = -1;
        return;
    }
    a =  currentRoutine->stack[currentRoutine->top-1];
    b =  currentRoutine->stack[currentRoutine->top-2];
    if(!(a.type == INK_INTEGER && b.type == INK_INTEGER)) {
        currentRoutine->panic = -1;
        return;
    }
    ink_pop(ctx);
    currentRoutine->stack[currentRoutine->top-1].value = b.value * a.value;
}

static void div_int(struct context* ctx) {
    struct ink_routine* currentRoutine;
    struct elem a;
    struct elem b;
    currentRoutine = ctx->routines + ctx->routine_current;
    if(currentRoutine->top < 2) {
        currentRoutine->panic = -1;
        return;
    }
    a =  currentRoutine->stack[currentRoutine->top-1];
    b =  currentRoutine->stack[currentRoutine->top-2];
    if(!(a.type == INK_INTEGER && b.type == INK_INTEGER)) {
        currentRoutine->panic = -1;
        return;
    }
    ink_pop(ctx);
    currentRoutine->stack[currentRoutine->top-1].value = b.value / a.value;
}

static void is_equal(struct context* ctx) {
    struct ink_routine* currentRoutine;
    struct elem a;
    struct elem b;
    struct elem ret;
    currentRoutine = ctx->routines + ctx->routine_current;
    if(currentRoutine->top < 2) {
        currentRoutine->panic = -1;
        return;
    }
    a =  currentRoutine->stack[currentRoutine->top-1];
    b =  currentRoutine->stack[currentRoutine->top-2];
    ink_pop(ctx);
    ink_pop(ctx);
    ret.type = INK_INTEGER;
    ret.value = a.value == b.value && a.type == b.type;
    ink_push(ctx, ret);
}

static void is_different(struct context* ctx) {
    struct ink_routine* currentRoutine;
    struct elem a;
    struct elem b;
    struct elem ret;
    currentRoutine = ctx->routines + ctx->routine_current;
    if(currentRoutine->top < 2) {
        currentRoutine->panic = -1;
        return;
    }
    a =  currentRoutine->stack[currentRoutine->top-1];
    b =  currentRoutine->stack[currentRoutine->top-2];
    ink_pop(ctx);
    ink_pop(ctx);
    ret.type = INK_INTEGER;
    ret.value = !(a.value == b.value && a.type == b.type);
    ink_push(ctx, ret);
}

#ifndef NOEXTRAARITHMETIC

static void rem_int(struct context* ctx) {
    struct ink_routine* currentRoutine;
    struct elem a;
    struct elem b;
    currentRoutine = ctx->routines + ctx->routine_current;
    if(currentRoutine->top < 2) {
        currentRoutine->panic = -1;
        return;
    }
    a =  currentRoutine->stack[currentRoutine->top-1];
    b =  currentRoutine->stack[currentRoutine->top-2];
    if(!(a.type == INK_INTEGER && b.type == INK_INTEGER)) {
        currentRoutine->panic = -1;
        return;
    }
    ink_pop(ctx);
    currentRoutine->stack[currentRoutine->top-1].value = b.value % a.value;
}

static void xor_int(struct context* ctx) {
    struct ink_routine* currentRoutine;
    struct elem a;
    struct elem b;
    currentRoutine = ctx->routines + ctx->routine_current;
    if(currentRoutine->top < 2) {
        currentRoutine->panic = -1;
        return;
    }
    a =  currentRoutine->stack[currentRoutine->top-1];
    b =  currentRoutine->stack[currentRoutine->top-2];
    if(!(a.type == INK_INTEGER && b.type == INK_INTEGER)) {
        currentRoutine->panic = -1;
        return;
    }
    ink_pop(ctx);
    currentRoutine->stack[currentRoutine->top-1].value = b.value ^ a.value;
}

static void gt_int(struct context* ctx) {
    struct ink_routine* currentRoutine;
    struct elem a;
    struct elem b;
    currentRoutine = ctx->routines + ctx->routine_current;
    if(currentRoutine->top < 2) {
        currentRoutine->panic = -1;
        return;
    }
    a =  currentRoutine->stack[currentRoutine->top-1];
    b =  currentRoutine->stack[currentRoutine->top-2];
    if(!(a.type == INK_INTEGER && b.type == INK_INTEGER)) {
        currentRoutine->panic = -1;
        return;
    }
    ink_pop(ctx);
    currentRoutine->stack[currentRoutine->top-1].value = b.value > a.value;
}

static void gte_int(struct context* ctx) {
    struct ink_routine* currentRoutine;
    struct elem a;
    struct elem b;
    currentRoutine = ctx->routines + ctx->routine_current;
    if(currentRoutine->top < 2) {
        currentRoutine->panic = -1;
        return;
    }
    a =  currentRoutine->stack[currentRoutine->top-1];
    b =  currentRoutine->stack[currentRoutine->top-2];
    if(!(a.type == INK_INTEGER && b.type == INK_INTEGER)) {
        currentRoutine->panic = -1;
        return;
    }
    ink_pop(ctx);
    currentRoutine->stack[currentRoutine->top-1].value = b.value >= a.value;
}

static void lte_int(struct context* ctx) {
    struct ink_routine* currentRoutine;
    struct elem a;
    struct elem b;
    currentRoutine = ctx->routines + ctx->routine_current;
    if(currentRoutine->top < 2) {
        currentRoutine->panic = -1;
        return;
    }
    a =  currentRoutine->stack[currentRoutine->top-1];
    b =  currentRoutine->stack[currentRoutine->top-2];
    if(!(a.type == INK_INTEGER && b.type == INK_INTEGER)) {
        currentRoutine->panic = -1;
        return;
    }
    ink_pop(ctx);
    currentRoutine->stack[currentRoutine->top-1].value = b.value <= a.value;
}

#endif /* NOEXTRAARITHMETIC */

static void lt_int(struct context* ctx) {
    struct ink_routine* currentRoutine;
    struct elem a;
    struct elem b;
    currentRoutine = ctx->routines + ctx->routine_current;
    if(currentRoutine->top < 2) {
        currentRoutine->panic = -1;
        return;
    }
    a =  currentRoutine->stack[currentRoutine->top-1];
    b =  currentRoutine->stack[currentRoutine->top-2];
    if(!(a.type == INK_INTEGER && b.type == INK_INTEGER)) {
        currentRoutine->panic = -1;
        return;
    }
    ink_pop(ctx);
    currentRoutine->stack[currentRoutine->top-1].value = b.value < a.value;
}

static void dupe_elem(struct context* ctx) {
    struct ink_routine* currentRoutine;
    struct elem a;
    int err;
    currentRoutine = ctx->routines + ctx->routine_current;
    if(currentRoutine->top < 1) {
        ctx->panic = 1;
        return;
    }
    a =  currentRoutine->stack[currentRoutine->top-1];
    err = ink_push(ctx, a);
    if(err < 0) ctx->panic = 1;
}

static void drop_elem(struct context* ctx) {
    struct ink_routine* currentRoutine;
    currentRoutine = ctx->routines + ctx->routine_current;
    if(currentRoutine->top < 1) {
        ctx->panic = 1;
        return;
    }
    ink_pop(ctx);
}

static void pluck_elem(struct context* ctx) {
    struct ink_routine* currentRoutine;
    struct elem a;
    int position, err;
    currentRoutine = ctx->routines + ctx->routine_current;
    if(currentRoutine->top < 1) {
        currentRoutine->panic = -1;
        return;
    }
    a =  currentRoutine->stack[currentRoutine->top-1];
    if(a.type != INK_INTEGER) {
        ctx->panic = 1;
        return;
    }
    position = currentRoutine->top - (a.value + 1);
    if(position >= currentRoutine->top || position < 0) {
        ctx->panic = 1;
        return;
    }
    ink_pop(ctx);
    err = ink_push(ctx, currentRoutine->stack[position]);
    if(err < 0) ctx->panic = 1;
}

static void swap_elem(struct context* ctx) {
    struct ink_routine* currentRoutine;
    struct elem a;
    struct elem b;
    currentRoutine = ctx->routines + ctx->routine_current;
    if(currentRoutine->top < 2) {
        currentRoutine->panic = -1;
        return;
    }
    a =  currentRoutine->stack[currentRoutine->top-1];
    b =  currentRoutine->stack[currentRoutine->top-2];
    currentRoutine->stack[currentRoutine->top-2] = a;
    currentRoutine->stack[currentRoutine->top-1] = b;
}

static void return_if(struct context* ctx) {
    struct ink_routine* currentRoutine;
    struct elem a;
    currentRoutine = ctx->routines + ctx->routine_current;
    if(currentRoutine->top < 1) {
        ctx->panic = -1;
        return;
    }
    a =  currentRoutine->stack[currentRoutine->top-1];
    if(a.type != INK_INTEGER) {
        ctx->panic = 1;
        return;
    }
    if(a.value) {
        ink_pop_fn(ctx);
        ink_pop_fn(ctx);
    }
    ink_pop(ctx);
    return;
}

static void jump_if(struct context* ctx) {
    struct ink_routine* currentRoutine;
    struct elem label;
    struct elem condition;
    currentRoutine = ctx->routines + ctx->routine_current;
    if(currentRoutine->top < 2) {
        ctx->panic = -1;
        return;
    }
    label =  currentRoutine->stack[currentRoutine->top-1];
    condition = currentRoutine->stack[currentRoutine->top-2];
    if(label.type != INK_INTEGER || condition.type != INK_INTEGER) {
        ctx->panic = -1;
        return;
    }
    ink_pop(ctx);
    ink_pop(ctx);
    ink_pop_fn(ctx);
    if(condition.value) {
        currentRoutine->function_stack[currentRoutine->function_stack_top - 1].index += label.value - 2;
    }

    return;
}

static void print_int(struct context* ctx) {
    struct ink_routine* currentRoutine;
    struct elem a;
    char* n;
    char* str;
    currentRoutine = ctx->routines + ctx->routine_current;
    if(currentRoutine->top < 1 || currentRoutine->stack[currentRoutine->top-1].type != INK_INTEGER) {
        currentRoutine->panic = -1;
        return;
    }
    a =  currentRoutine->stack[currentRoutine->top-1];
    ink_pop(ctx);
    n = ink_itoa(ctx, a.value);
    str = n;
    while (*str) {
        ctx->putchar(ctx, *str);
        ++str;
    }
    ctx->free(ctx, n);
    n = NULL;
}

static void print_as_utf8(struct context* ctx) {
    struct ink_routine* currentRoutine;
    struct elem a;
    currentRoutine = ctx->routines + ctx->routine_current;
    if(currentRoutine->top < 1 || currentRoutine->stack[currentRoutine->top-1].type != INK_INTEGER) {
        ctx->panic = -1;
        return;
    }
    a =  currentRoutine->stack[currentRoutine->top-1];
    if(a.value <= 0x7F) {
        ctx->putchar(ctx, a.value);
    } else if(a.value <= 0x7FF) {
        ctx->putchar(ctx, ((a.value & 0xFC0) >> 6) | 192);
        ctx->putchar(ctx, (a.value  & 0x3F) | 128);
    } else if(a.value <= 0xFFFF) {
        ctx->putchar(ctx, ((a.value & 0x3F000) >> 12) | 224);
        ctx->putchar(ctx, ((a.value & 0xFC0) >> 6) | 128);
        ctx->putchar(ctx, (a.value  & 0x3F) | 128);
    } else if(a.value <= 0x10FFFF) {
        ctx->putchar(ctx, ((a.value & 0x3C0000) >> 18)  | 240);
        ctx->putchar(ctx, ((a.value & 0x3F000) >> 12) | 128);
        ctx->putchar(ctx, ((a.value & 0xFC0) >> 6) | 128);
        ctx->putchar(ctx, (a.value  & 0x3F) | 128);
    } else {
        ctx->panic = -1;
        return;
    }
    ink_pop(ctx);
}

int get_type_by_name(struct context* ctx, const char* name) {
    int i;
    for(i = 0; i < ctx->types_top; ++i) {
        if(strcmp(ctx->types[i].name, name) == 0) {
            return i + 16;
        }
    }
    return -1;
}

static void run_gc(struct context* ctx) {
    ink_gc(ctx);
}

static void clear_stack(struct context* ctx) {
    struct ink_routine* currentRoutine;
    currentRoutine = ctx->routines + ctx->routine_current;
    while (currentRoutine->top >= 1) {
        ink_pop(ctx);
    }
    return;
}

static void dump_stack(struct context* ctx) {
    struct ink_routine* currentRoutine;
    int index;
    char* idx;
    char* type;
    char* value;
    char* it;
    currentRoutine = ctx->routines + ctx->routine_current;
    index = currentRoutine->top;
    while (index) {
        --index;
        idx = ink_itoa(ctx,index);
        type = ink_itoa(ctx, currentRoutine->stack[index].type);
        value = ink_itoa(ctx,currentRoutine->stack[index].value);
        for(it = idx; *it; ++it) ctx->putchar(ctx, *it);
        ctx->putchar(ctx, ' ');ctx->putchar(ctx, '|');ctx->putchar(ctx, ' ');
        for(it = type; *it; ++it) ctx->putchar(ctx, *it);
        ctx->putchar(ctx, ' ');ctx->putchar(ctx, '|');ctx->putchar(ctx, ' ');
        for(it = value; *it; ++it) ctx->putchar(ctx, *it);
        ctx->putchar(ctx, '\n');
        if(value != NULL) ctx->free(ctx, value);
        if(type != NULL) ctx->free(ctx, type);
        if(idx != NULL) ctx->free(ctx, idx);
        value = type = idx = NULL;
    }
    return;
}

static void collect_noop() {}

static struct ink_collection_list gc_noop() {
    struct ink_collection_list c;
    c.elements = NULL;
    c.count = 0;
    return c;
}

#ifndef NOARRAYLIB

static void collect_array(struct context* ctx, void* array) {
    struct ink_array* ary;
    ary = array;
    if(ary->elements != NULL) {
        ctx->free(ctx, ary->elements);
        ary->elements = NULL;
    }
}

static struct ink_collection_list gc_array(struct context* ctx, void* array) {
    struct ink_array* ary;
    struct ink_collection_list c;
    ary = array;
    c.elements = ctx->inner_malloc(ctx, sizeof(struct elem)*ary->top);
    c.count = ary->top;
    memcpy(c.elements, ary->elements, sizeof(struct elem)*ary->top);
    return c;
}

static void new_array(struct context* ctx) {
    int tid;
    struct elem e;
    struct ink_array ary;
    tid =  get_type_by_name(ctx, "array");
    ary.elements = NULL;
    ary.top = 0;
    ary.capacity = 0;
    ary.flags = 0;
    e = ink_make_native(ctx, tid, &ary);
    ink_push(ctx, e);
}

#ifndef NOSTRINGLITERALS
static void new_protected_array(struct context* ctx) {
    int tid;
    struct elem e;
    struct ink_array ary;
    tid =  get_type_by_name(ctx, "array");
    ary.elements = NULL;
    ary.top = 0;
    ary.capacity = 0;
    e = ink_make_native_unsafe(ctx, tid, &ary, 1);
    ink_push(ctx, e);
}
#endif

static void push_array_stack_delim(struct context* ctx) {
    int tid;
    struct elem e;
    tid =  get_type_by_name(ctx, "array_marker");
    e.type = tid;
    e.value = 0;
    ink_push(ctx, e);
}

int array_push_s(struct context* ctx, struct ink_array* ary, struct elem value) {
    if(ary->elements == NULL) {
        ary->elements = ctx->malloc(ctx, sizeof(struct elem) * 8);
        ary->top = 0;
        ary->capacity = 8;
    } else if(ary->top == ary->capacity) {
        int new_count;
        void* renewed;
        new_count = (ary->capacity + ary->capacity/2);
        renewed = ctx->realloc(ctx, ary->elements, sizeof(struct elem) * new_count);
        if(renewed == NULL) {
            return 1;
        } else {
            ary->elements = renewed;
            ary->capacity = new_count;
        }
    }
    ary->elements[ary->top] = value;
    ary->top++;
    return 0;
}

void array_push(struct context* ctx, struct ink_routine* currentRoutine, struct ink_array* ary, struct elem value) {
    if(array_push_s(ctx, ary, value)) {
        currentRoutine->panic = -1;
    }
}

static void push_array(struct context* ctx) {
    int tid;
    struct elem a;
    struct ink_routine* currentRoutine;
    struct ink_array* ary;
    tid =  get_type_by_name(ctx, "array");
    currentRoutine = ctx->routines + ctx->routine_current;
    if(currentRoutine->top < 2 || currentRoutine->stack[currentRoutine->top-1].type != tid) {
        currentRoutine->panic = -1;
        return;
    }
    a = currentRoutine->stack[currentRoutine->top-1];
    ary= ink_get_value(ctx, a);
    if(ary == NULL) {
        currentRoutine->panic = -1;
        return;
    }
    ink_pop(ctx);
    array_push(ctx, currentRoutine, ary, currentRoutine->stack[currentRoutine->top-1]);
    ink_pop(ctx);
}

static void push_delimited_array(struct context* ctx) {
    int tid, idx, counter, i;
    struct elem a;
    struct ink_routine* currentRoutine;
    struct ink_array* ary;
    tid =  get_type_by_name(ctx, "array_marker");
    currentRoutine = ctx->routines + ctx->routine_current;
    if(currentRoutine->top < 1) {
        currentRoutine->panic = -1;
        return;
    }
    new_array(ctx);
    a = currentRoutine->stack[currentRoutine->top-1];
    ink_pop(ctx);
    ary= ink_get_value(ctx, a);

    for(idx = 1; idx <= currentRoutine->top; ++idx) {
        if(currentRoutine->stack[currentRoutine->top-idx].type == tid) {
            break;
        }
    }
    /* Save for cleanup */
    counter = idx;

    /* Don't copy the delimiter */
    idx -= 1;

    ary->elements = malloc(sizeof(struct elem) * idx);
    if(ary->elements == NULL) {
        currentRoutine->panic = -541;
        return;
    }
    ary->capacity = idx;
    ary->top = 0;

    /* Copy the data */
    for(i = currentRoutine->top - idx; i < currentRoutine->top; ++i) {
        ary->elements[ary->top] = currentRoutine->stack[i];
        ++(ary->top);
    }

    /* Cleanup */
    while(counter--) {
        ink_pop(ctx);
    }

    /* Put value in place */
    ink_push(ctx, a);
}

static void index_array(struct context* ctx) {
    int tid;
    struct ink_routine *currentRoutine;
    struct elem a;
    struct ink_array *ary;
    struct elem idx;

    tid = get_type_by_name(ctx, "array");
    currentRoutine = ctx->routines + ctx->routine_current;
    if (currentRoutine->top < 2 || currentRoutine->stack[currentRoutine->top - 1].type != tid || currentRoutine->stack[currentRoutine->top - 2].type != INK_INTEGER) {
        currentRoutine->panic = -1;
        return;
    }
    a = currentRoutine->stack[currentRoutine->top - 1];
    ary = ink_get_value(ctx, a);
    if (ary == NULL) {
        currentRoutine->panic = -1;
        return;
    }
    ink_pop(ctx);

    idx = currentRoutine->stack[currentRoutine->top - 1];
    ink_pop(ctx);

    if(ary->top <= idx.value) {
        currentRoutine->panic = -1;
        return;
    }

    ink_push(ctx, ary->elements[idx.value]);
}

static void set_array(struct context* ctx) {
    int tid;
    struct ink_routine *currentRoutine;
    struct elem a;
    struct ink_array *ary;
    struct elem idx;
    struct elem value;

    tid = get_type_by_name(ctx, "array");
    currentRoutine = ctx->routines + ctx->routine_current;
    if (currentRoutine->top < 3 || currentRoutine->stack[currentRoutine->top - 1].type != tid || currentRoutine->stack[currentRoutine->top - 2].type != INK_INTEGER) {
        currentRoutine->panic = -1;
        return;
    }
    a = currentRoutine->stack[currentRoutine->top - 1];
    ary = ink_get_value(ctx, a);
    if (ary == NULL) {
        currentRoutine->panic = -1;
        return;
    }

    idx = currentRoutine->stack[currentRoutine->top - 2];
    value = currentRoutine->stack[currentRoutine->top - 3];

    if(ary->top <= idx.value) {
        currentRoutine->panic = -1;
        return;
    }
    ink_pop(ctx);
    ink_pop(ctx);
    ink_pop(ctx);

    ary->elements[idx.value] = value;

}

static void get_size_array(struct context* ctx) {
    int tid;
    struct ink_routine *currentRoutine;
    struct elem a;
    struct ink_array *ary;
    struct elem sz;

    tid = get_type_by_name(ctx, "array");
    currentRoutine = ctx->routines + ctx->routine_current;
    if (currentRoutine->top < 1 || currentRoutine->stack[currentRoutine->top - 1].type != tid) {
        currentRoutine->panic = -1;
        return;
    }
    a = currentRoutine->stack[currentRoutine->top - 1];
    ary = ink_get_value(ctx, a);
    if (ary == NULL) {
        currentRoutine->panic = -1;
        return;
    }
    ink_pop(ctx);

    sz.type = INK_INTEGER;
    sz.value = ary->top;

    ink_push(ctx, sz);
}

static void is_array(struct context* ctx) {
    int tid;
    struct ink_routine *currentRoutine;
    struct elem a;

    tid = get_type_by_name(ctx, "array");
    currentRoutine = ctx->routines + ctx->routine_current;
    if (currentRoutine->top < 1) {
        currentRoutine->panic = -1;
        return;
    }
    a.type = INK_INTEGER;
    a.value = currentRoutine->stack[currentRoutine->top - 1].type == tid;
    ink_pop(ctx);

    ink_push(ctx, a);
}

static void is_int(struct context* ctx) {
    struct ink_routine *currentRoutine;
    struct elem a;

    currentRoutine = ctx->routines + ctx->routine_current;
    if (currentRoutine->top < 1) {
        currentRoutine->panic = -1;
        return;
    }
    a.type = INK_INTEGER;
    a.value = currentRoutine->stack[currentRoutine->top - 1].type == INK_INTEGER;
    ink_pop(ctx);

    ink_push(ctx, a);
}

static void print_array_of_codepoints(struct context* ctx) {
    int tid, i;
    struct ink_routine *currentRoutine;
    struct elem a;
    struct ink_array *ary;

    tid = get_type_by_name(ctx, "array");
    currentRoutine = ctx->routines + ctx->routine_current;
    if (currentRoutine->top < 1 || currentRoutine->stack[currentRoutine->top - 1].type != tid) {
        currentRoutine->panic = -1;
        return;
    }
    a = currentRoutine->stack[currentRoutine->top - 1];
    ary = ink_get_value(ctx, a);

    for(i = 0; i < ary->top; ++i) {
        if(ary->elements[i].type != INK_INTEGER) {
            currentRoutine->panic = -1;
            return;
        }
    }
    ink_pop(ctx);
    for(i = 0; i < ary->top; ++i) {
        ink_push(ctx, ary->elements[i]);
        print_as_utf8(ctx);
    }
}

static void arrayify_stack(struct context* ctx) {
    struct ink_routine* currentRoutine;
    struct elem array_ref;
    struct ink_array* ary;
    int idx;
    currentRoutine = ctx->routines + ctx->routine_current;
    new_array(ctx);
    if(currentRoutine->panic < 0) return;
    array_ref = currentRoutine->stack[currentRoutine->top - 1];
    ary = ink_get_value(ctx, array_ref);
    if(ary == NULL) {
        currentRoutine->panic = -717;
        return;
    }
    ink_pop(ctx);
    for(idx = 0; idx < currentRoutine->top; ++idx) {
        array_push(ctx, currentRoutine, ary, currentRoutine->stack[idx]);
    }
    while (currentRoutine->top > 0) {
        ink_pop(ctx);
    }
    ink_push(ctx, array_ref);
    return;
}

#endif /* NOARRAYLIB */

int ink_std_library(struct context* ctx) {
    int v;
    v = 0;
    v += ink_add_native(ctx, "sys.trace", print_stacktrace);
    v += ink_add_native(ctx, "sys.gc", run_gc);
    v += ink_add_native(ctx, "print_int", print_int);
    v += ink_add_native(ctx, "print_utf8", print_as_utf8);
    v += ink_add_native(ctx, "+", add_int);
    v += ink_add_native(ctx, "-", sub_int);
    v += ink_add_native(ctx, "*", mult_int);
    v += ink_add_native(ctx, "/", div_int);
    v += ink_add_native(ctx, "==", is_equal);
    v += ink_add_native(ctx, "!=", is_different);
    v += ink_add_native(ctx, "<", lt_int);
    v += ink_add_native(ctx, "swap", swap_elem);
    v += ink_add_native(ctx, "dup", dupe_elem);
    v += ink_add_native(ctx, "drop", drop_elem);
    v += ink_add_native(ctx, "stack.clear", clear_stack);
    v += ink_add_native(ctx, "stack.dump", dump_stack);
    v += ink_add_native(ctx, "pluck", pluck_elem);
    v += ink_add_native(ctx, "return_if", return_if);
    v += ink_add_native(ctx, "jump_if", jump_if);
    v += ink_add_native(ctx, "is.int", is_int);
#ifndef NOEXTRAARITHMETIC
    v += ink_add_native(ctx, ">", gt_int);
    v += ink_add_native(ctx, ">=", gte_int);
    v += ink_add_native(ctx, "=<", lte_int);
    v += ink_add_native(ctx, "%", rem_int);
    v += ink_add_native(ctx, "int.xor", xor_int);
#endif /* NOEXTRAARITHMETIC */
#ifndef NOARRAYLIB
    ink_new_type(ctx, "array", sizeof(struct ink_array), collect_array, gc_array);
    ink_new_type(ctx, "array_marker", 0, collect_noop, gc_noop);
    v += ink_add_native(ctx, "[", push_array_stack_delim);
    v += ink_add_native(ctx, "]", push_delimited_array);
    v += ink_add_native(ctx, "array.new", new_array);
    v += ink_add_native(ctx, "array.push", push_array);
    v += ink_add_native(ctx, "array.index", index_array);
    v += ink_add_native(ctx, "array.set", set_array);
    v += ink_add_native(ctx, "array.size", get_size_array);
    v += ink_add_native(ctx, "array.print_utf8", print_array_of_codepoints);
    v += ink_add_native(ctx, "is.array", is_array);
    v += ink_add_native(ctx, "stack.to_array", arrayify_stack);
#endif /* NOARRAYLIB */

    return v;
}