#include "compile.h" #include "ds.h" #include "value.h" #include "vm.h" #include "util.h" /* During compilation, FormOptions are passed to ASTs * as configuration options to allow for some optimizations. */ typedef struct FormOptions FormOptions; struct FormOptions { /* The location the returned Slot must be in. Can be ignored * if either canDrop or canChoose is true */ uint16_t target; /* If the result of the value being compiled is not going to * be used, some forms can simply return a nil slot and save * copmutation */ uint16_t resultUnused : 1; /* Allows the sub expression to evaluate into a * temporary slot of it's choice. A temporary Slot * can be allocated with GstCompilerGetLocal. */ uint16_t canChoose : 1; /* True if the form is in the tail position. This allows * for tail call optimization. If a helper receives this * flag, it is free to return a returned slot and generate bytecode * for a return, including tail calls. */ uint16_t isTail : 1; }; /* A Slot represent a location of a local variable * on the stack. Also contains some meta information. */ typedef struct Slot Slot; struct Slot { /* The index of the Slot on the stack. */ uint16_t index; /* A nil Slot should not be expected to contain real data. (ignore index). * Forms that have side effects but don't evaulate to * anything will try to return nil slots. */ uint16_t isNil : 1; /* A temp Slot is a Slot on the stack that does not * belong to a named local. They can be freed whenever, * and so are used in intermediate calculations. */ uint16_t isTemp : 1; /* Flag indicating if byteCode for returning this slot * has been written to the buffer. Should only ever be true * when the isTail option is passed */ uint16_t hasReturned : 1; }; /* A SlotTracker provides a handy way to keep track of * Slots on the stack and free them in bulk. */ typedef struct SlotTracker SlotTracker; struct SlotTracker { Slot *slots; uint32_t count; uint32_t capacity; }; /* A GstScope is a lexical scope in the program. It is * responsible for aliasing programmer facing names to * Slots and for keeping track of literals. It also * points to the parent GstScope, and its current child * GstScope. */ struct GstScope { uint32_t level; uint16_t nextLocal; uint16_t frameSize; uint32_t heapCapacity; uint32_t heapSize; uint16_t *freeHeap; GstObject *literals; GstArray *literalsArray; GstObject *locals; GstScope *parent; }; /* Provides default FormOptions */ static FormOptions form_options_default() { FormOptions opts; opts.canChoose = 1; opts.isTail = 0; opts.resultUnused = 0; opts.target = 0; return opts; } /* Create some helpers that allows us to push more than just raw bytes * to the byte buffer. This helps us create the byte code for the compiled * functions. */ BUFFER_DEFINE(i32, int32_t) BUFFER_DEFINE(number, GstNumber) BUFFER_DEFINE(u16, uint16_t) BUFFER_DEFINE(i16, int16_t) /* If there is an error during compilation, * jump back to start */ static void c_error(GstCompiler *c, const char *e) { c->error = e; longjmp(c->onError, 1); } /* Push a new scope in the compiler and return * a pointer to it for configuration. There is * more configuration that needs to be done if * the new scope is a function declaration. */ static GstScope *compiler_push_scope(GstCompiler *c, int sameFunction) { GstScope *scope = gst_alloc(c->vm, sizeof(GstScope)); scope->locals = gst_object(c->vm, 10); scope->freeHeap = gst_alloc(c->vm, 10 * sizeof(uint16_t)); scope->heapSize = 0; scope->heapCapacity = 10; scope->parent = c->tail; scope->frameSize = 0; if (c->tail) { scope->level = c->tail->level + (sameFunction ? 0 : 1); } else { scope->level = 0; } if (sameFunction) { if (!c->tail) { c_error(c, "cannot inherit scope when root scope"); } scope->nextLocal = c->tail->nextLocal; scope->literals = c->tail->literals; scope->literalsArray = c->tail->literalsArray; } else { scope->nextLocal = 0; scope->literals = gst_object(c->vm, 10); scope->literalsArray = gst_array(c->vm, 10); } c->tail = scope; return scope; } /* Remove the inner most scope from the compiler stack */ static void compiler_pop_scope(GstCompiler *c) { GstScope *last = c->tail; if (last == NULL) { c_error(c, "no scope to pop"); } else { if (last->nextLocal > last->frameSize) { last->frameSize = last->nextLocal; } c->tail = last->parent; if (c->tail) { if (last->frameSize > c->tail->frameSize) { c->tail->frameSize = last->frameSize; } } } } /* Get the next stack position that is open for * a variable */ static uint16_t compiler_get_local(GstCompiler *c, GstScope *scope) { if (scope->heapSize == 0) { if (scope->nextLocal + 1 == 0) { c_error(c, "too many local variables"); } return scope->nextLocal++; } else { return scope->freeHeap[--scope->heapSize]; } return 0; } /* Free a slot on the stack for other locals and/or * intermediate values */ static void compiler_free_local(GstCompiler *c, GstScope *scope, uint16_t slot) { /* Ensure heap has space */ if (scope->heapSize >= scope->heapCapacity) { uint32_t newCap = 2 * scope->heapSize; uint16_t *newData = gst_alloc(c->vm, newCap * sizeof(uint16_t)); gst_memcpy(newData, scope->freeHeap, scope->heapSize * sizeof(uint16_t)); scope->freeHeap = newData; scope->heapCapacity = newCap; } scope->freeHeap[scope->heapSize++] = slot; } /* Initializes a SlotTracker. SlotTrackers * are used during compilation to free up slots on the stack * after they are no longer needed. */ static void tracker_init(GstCompiler *c, SlotTracker *tracker) { tracker->slots = gst_alloc(c->vm, 10 * sizeof(Slot)); tracker->count = 0; tracker->capacity = 10; } /* Free up a slot if it is a temporary slot (does not * belong to a named local). If the slot does belong * to a named variable, does nothing. */ static void compiler_drop_slot(GstCompiler *c, GstScope *scope, Slot slot) { if (!slot.isNil && slot.isTemp) { compiler_free_local(c, scope, slot.index); } } /* Helper function to return a slot. Useful for compiling things that return * nil. (set, while, etc.). Use this to wrap compilation calls that need * to return things. */ static Slot compiler_return(GstCompiler *c, Slot slot) { Slot ret; ret.hasReturned = 1; ret.isNil = 1; if (slot.hasReturned) { /* Do nothing */ } else if (slot.isNil) { /* Return nil */ gst_buffer_push_u16(c->vm, c->buffer, GST_OP_RTN); } else { /* Return normal value */ gst_buffer_push_u16(c->vm, c->buffer, GST_OP_RET); gst_buffer_push_u16(c->vm, c->buffer, slot.index); } return ret; } /* Gets a temporary slot for the bottom-most scope. */ static Slot compiler_get_temp(GstCompiler *c) { GstScope *scope = c->tail; Slot ret; ret.isTemp = 1; ret.isNil = 0; ret.hasReturned = 0; ret.index = compiler_get_local(c, scope); return ret; } /* Return a slot that is the target Slot given some FormOptions. Will * Create a temporary slot if needed, so be sure to drop the slot after use. */ static Slot compiler_get_target(GstCompiler *c, FormOptions opts) { if (opts.canChoose) { return compiler_get_temp(c); } else { Slot ret; ret.isTemp = 0; ret.isNil = 0; ret.hasReturned = 0; ret.index = opts.target; return ret; } } /* If a slot is a nil slot, create a slot that has * an actual location on the stack. */ static Slot compiler_realize_slot(GstCompiler *c, Slot slot) { if (slot.isNil) { slot = compiler_get_temp(c); gst_buffer_push_u16(c->vm, c->buffer, GST_OP_NIL); gst_buffer_push_u16(c->vm, c->buffer, slot.index); } return slot; } /* Helper to get a nil slot */ static Slot nil_slot() { Slot ret; ret.isNil = 1; ret.hasReturned = 0; return ret; } /* Writes all of the slots in the tracker to the compiler */ static void compiler_tracker_write(GstCompiler *c, SlotTracker *tracker, int reverse) { uint32_t i; GstBuffer *buffer = c->buffer; for (i = 0; i < tracker->count; ++i) { Slot s; if (reverse) s = tracker->slots[tracker->count - 1 - i]; else s = tracker->slots[i]; if (s.isNil) c_error(c, "trying to write nil slot"); gst_buffer_push_u16(c->vm, buffer, s.index); } } /* Free the tracker after creation. This unlocks the memory * that was allocated by the GC an allows it to be collected. Also * frees slots that were tracked by this tracker in the given scope. */ static void compiler_tracker_free(GstCompiler *c, GstScope *scope, SlotTracker *tracker) { uint32_t i; /* Free in reverse order */ for (i = tracker->count - 1; i < tracker->count; --i) { compiler_drop_slot(c, scope, tracker->slots[i]); } } /* Add a new Slot to a slot tracker. */ static void compiler_tracker_push(GstCompiler *c, SlotTracker *tracker, Slot slot) { if (tracker->count >= tracker->capacity) { uint32_t newCap = 2 * tracker->count; Slot *newData = gst_alloc(c->vm, newCap * sizeof(Slot)); gst_memcpy(newData, tracker->slots, tracker->count * sizeof(Slot)); tracker->slots = newData; tracker->capacity = newCap; } tracker->slots[tracker->count++] = slot; } /* Registers a literal in the given scope. If an equal literal is found, uses * that one instead of creating a new literal. This allows for some reuse * of things like string constants.*/ static uint16_t compiler_add_literal(GstCompiler *c, GstScope *scope, GstValue x) { GstValue checkDup = gst_object_get(scope->literals, x); uint16_t literalIndex = 0; if (checkDup.type != GST_NIL) { /* An equal literal is already registered in the current scope */ return (uint16_t) checkDup.data.number; } else { /* Add our literal for tracking */ GstValue valIndex; valIndex.type = GST_NUMBER; literalIndex = scope->literalsArray->count; valIndex.data.number = literalIndex; gst_object_put(c->vm, scope->literals, x, valIndex); gst_array_push(c->vm, scope->literalsArray, x); } return literalIndex; } /* Declare a symbol in a given scope. */ static uint16_t compiler_declare_symbol(GstCompiler *c, GstScope *scope, GstValue sym) { GstValue x; uint16_t target; if (sym.type != GST_STRING) c_error(c, "expected symbol"); target = compiler_get_local(c, scope); x.type = GST_NUMBER; x.data.number = target; gst_object_put(c->vm, scope->locals, sym, x); return target; } /* Try to resolve a symbol. If the symbol can be resovled, return true and * pass back the level and index by reference. */ static int symbol_resolve(GstScope *scope, GstValue x, uint16_t *level, uint16_t *index) { uint32_t currentLevel = scope->level; while (scope) { GstValue check = gst_object_get(scope->locals, x); if (check.type != GST_NIL) { *level = currentLevel - scope->level; *index = (uint16_t) check.data.number; return 1; } scope = scope->parent; } return 0; } /* Forward declaration */ /* Compile a value and return it stack location after loading. * If a target > 0 is passed, the returned value must be equal * to the targtet. If target < 0, the GstCompiler can choose whatever * slot location it likes. If, for example, a symbol resolves to * whatever is in a given slot, it makes sense to use that location * to 'return' the value. For other expressions, like function * calls, the compiler will just pick the lowest free slot * as the location on the stack. */ static Slot compile_value(GstCompiler *c, FormOptions opts, GstValue x); /* Compile a structure that evaluates to a literal value. Useful * for objects like strings, or anything else that cannot be instatiated else { break; } * from bytecode and doesn't do anything in the AST. */ static Slot compile_literal(GstCompiler *c, FormOptions opts, GstValue x) { GstScope *scope = c->tail; GstBuffer *buffer = c->buffer; Slot ret; uint16_t literalIndex; if (opts.resultUnused) return nil_slot(); ret = compiler_get_target(c, opts); literalIndex = compiler_add_literal(c, scope, x); gst_buffer_push_u16(c->vm, buffer, GST_OP_CST); gst_buffer_push_u16(c->vm, buffer, ret.index); gst_buffer_push_u16(c->vm, buffer, literalIndex); return ret; } /* Compile boolean, nil, and number values. */ static Slot compile_nonref_type(GstCompiler *c, FormOptions opts, GstValue x) { GstBuffer *buffer = c->buffer; Slot ret; if (opts.resultUnused) return nil_slot(); ret = compiler_get_target(c, opts); if (x.type == GST_NIL) { gst_buffer_push_u16(c->vm, buffer, GST_OP_NIL); gst_buffer_push_u16(c->vm, buffer, ret.index); } else if (x.type == GST_BOOLEAN) { gst_buffer_push_u16(c->vm, buffer, x.data.boolean ? GST_OP_TRU : GST_OP_FLS); gst_buffer_push_u16(c->vm, buffer, ret.index); } else if (x.type == GST_NUMBER) { GstNumber number = x.data.number; int32_t int32Num = (int32_t) number; if (number == (GstNumber) int32Num) { if (int32Num <= 32767 && int32Num >= -32768) { int16_t int16Num = (int16_t) number; gst_buffer_push_u16(c->vm, buffer, GST_OP_I16); gst_buffer_push_u16(c->vm, buffer, ret.index); gst_buffer_push_i16(c->vm, buffer, int16Num); } else { gst_buffer_push_u16(c->vm, buffer, GST_OP_I32); gst_buffer_push_u16(c->vm, buffer, ret.index); gst_buffer_push_i32(c->vm, buffer, int32Num); } } else { gst_buffer_push_u16(c->vm, buffer, GST_OP_F64); gst_buffer_push_u16(c->vm, buffer, ret.index); gst_buffer_push_number(c->vm, buffer, number); } } else { c_error(c, "expected boolean, nil, or number type"); } return ret; } /* Compile a symbol. Resolves any kind of symbol. */ static Slot compile_symbol(GstCompiler *c, FormOptions opts, GstValue sym) { GstBuffer * buffer = c->buffer; GstScope * scope = c->tail; uint16_t index = 0; uint16_t level = 0; Slot ret; if (opts.resultUnused) return nil_slot(); if (!symbol_resolve(scope, sym, &level, &index)) c_error(c, "undefined symbol"); if (level > 0) { /* We have an upvalue */ ret = compiler_get_target(c, opts); gst_buffer_push_u16(c->vm, buffer, GST_OP_UPV); gst_buffer_push_u16(c->vm, buffer, ret.index); gst_buffer_push_u16(c->vm, buffer, level); gst_buffer_push_u16(c->vm, buffer, index); } else { /* Local variable on stack */ ret.isTemp = 0; ret.isNil = 0; ret.hasReturned = 0; if (opts.canChoose) { ret.index = index; } else { /* We need to move the variable. This * would occur in a simple assignment like a = b. */ ret.index = opts.target; gst_buffer_push_u16(c->vm, buffer, GST_OP_MOV); gst_buffer_push_u16(c->vm, buffer, ret.index); gst_buffer_push_u16(c->vm, buffer, index); } } return ret; } /* Compile values in an array sequentail and track the returned slots. * If the result is unused, immediately drop slots we don't need. Can * also ignore the end of an array. */ static void tracker_init_array(GstCompiler *c, FormOptions opts, SlotTracker *tracker, GstArray *array, uint32_t start, uint32_t fromEnd) { GstScope *scope = c->tail; FormOptions subOpts = form_options_default(); uint32_t i; /* Calculate sub flags */ subOpts.resultUnused = opts.resultUnused; /* Compile all of the arguments */ tracker_init(c, tracker); /* Nothing to compile */ if (array->count <= fromEnd) return; /* Compile body of array */ for (i = start; i < (array->count - fromEnd); ++i) { Slot slot = compile_value(c, subOpts, array->data[i]); if (subOpts.resultUnused) compiler_drop_slot(c, scope, slot); else compiler_tracker_push(c, tracker, compiler_realize_slot(c, slot)); } } /* Compile a special form in the form of an operator. There * are four choices for opcodes - when the operator is called * with 0, 1, 2, or n arguments. When the operator form is * called with n arguments, the number of arguments is written * after the op code, followed by those arguments. * * This makes a few assumptions about the operators. One, no side * effects. With this assumptions, if the result of the operator * is unused, it's calculation can be ignored (the evaluation of * its argument is still carried out, but their results can * also be ignored). */ static Slot compile_operator(GstCompiler *c, FormOptions opts, GstArray *form, int16_t op0, int16_t op1, int16_t op2, int16_t opn, int reverseOperands) { GstScope *scope = c->tail; GstBuffer *buffer = c->buffer; Slot ret; SlotTracker tracker; /* Compile operands */ tracker_init_array(c, opts, &tracker, form, 1, 0); /* Free up space */ compiler_tracker_free(c, scope, &tracker); if (opts.resultUnused) { ret = nil_slot(); } else { ret = compiler_get_target(c, opts); /* Write the correct opcode */ if (form->count < 2) { if (op0 < 0) { if (opn < 0) c_error(c, "this operator does not take 0 arguments"); goto opn; } else { gst_buffer_push_u16(c->vm, buffer, op0); gst_buffer_push_u16(c->vm, buffer, ret.index); } } else if (form->count == 2) { if (op1 < 0) { if (opn < 0) c_error(c, "this operator does not take 1 argument"); goto opn; } else { gst_buffer_push_u16(c->vm, buffer, op1); gst_buffer_push_u16(c->vm, buffer, ret.index); } } else if (form->count == 3) { if (op2 < 0) { if (opn < 0) c_error(c, "this operator does not take 2 arguments"); goto opn; } else { gst_buffer_push_u16(c->vm, buffer, op2); gst_buffer_push_u16(c->vm, buffer, ret.index); } } else { opn: if (opn < 0) c_error(c, "this operator does not take n arguments"); gst_buffer_push_u16(c->vm, buffer, opn); gst_buffer_push_u16(c->vm, buffer, ret.index); gst_buffer_push_u16(c->vm, buffer, form->count - 1); } } /* Write the location of all of the arguments */ compiler_tracker_write(c, &tracker, reverseOperands); return ret; } /* Math specials */ static Slot compile_addition(GstCompiler *c, FormOptions opts, GstArray *form) { return compile_operator(c, opts, form, -1, -1, GST_OP_ADD, -1, 0); } static Slot compile_subtraction(GstCompiler *c, FormOptions opts, GstArray *form) { return compile_operator(c, opts, form, -1, -1, GST_OP_SUB, -1, 0); } static Slot compile_multiplication(GstCompiler *c, FormOptions opts, GstArray *form) { return compile_operator(c, opts, form, -1, -1, GST_OP_MUL, -1, 0); } static Slot compile_division(GstCompiler *c, FormOptions opts, GstArray *form) { return compile_operator(c, opts, form, -1, -1, GST_OP_DIV, -1, 0); } static Slot compile_equals(GstCompiler *c, FormOptions opts, GstArray *form) { return compile_operator(c, opts, form, -1, -1, GST_OP_EQL, -1, 0); } static Slot compile_lt(GstCompiler *c, FormOptions opts, GstArray *form) { return compile_operator(c, opts, form, -1, -1, GST_OP_LTN, -1, 0); } static Slot compile_lte(GstCompiler *c, FormOptions opts, GstArray *form) { return compile_operator(c, opts, form, -1, -1, GST_OP_LTE, -1, 0); } static Slot compile_gt(GstCompiler *c, FormOptions opts, GstArray *form) { return compile_operator(c, opts, form, -1, -1, GST_OP_LTN, -1, 1); } static Slot compile_gte(GstCompiler *c, FormOptions opts, GstArray *form) { return compile_operator(c, opts, form, -1, -1, GST_OP_LTE, -1, 1); } static Slot compile_not(GstCompiler *c, FormOptions opts, GstArray *form) { return compile_operator(c, opts, form, -1, GST_OP_NOT, -1, -1, 0); } static Slot compile_get(GstCompiler *c, FormOptions opts, GstArray *form) { return compile_operator(c, opts, form, -1, -1, GST_OP_GET, -1, 0); } static Slot compile_array(GstCompiler *c, FormOptions opts, GstArray *form) { return compile_operator(c, opts, form, -1, -1, -1, GST_OP_ARR, 0); } static Slot compile_object(GstCompiler *c, FormOptions opts, GstArray *form) { if ((form->count % 2) == 0) { c_error(c, "dictionary literal requires an even number of arguments"); return nil_slot(); } else { return compile_operator(c, opts, form, -1, -1, -1, GST_OP_DIC, 0); } } /* Associative set */ static Slot compile_set(GstCompiler *c, FormOptions opts, GstArray *form) { GstBuffer *buffer = c->buffer; FormOptions subOpts = form_options_default(); Slot ds, key, val; if (form->count != 4) c_error(c, "set expects 4 arguments"); if (opts.resultUnused) { ds = compiler_realize_slot(c, compile_value(c, subOpts, form->data[1])); } else { subOpts = opts; subOpts.isTail = 0; ds = compiler_realize_slot(c, compile_value(c, subOpts, form->data[1])); subOpts = form_options_default(); } key = compiler_realize_slot(c, compile_value(c, subOpts, form->data[2])); val = compiler_realize_slot(c, compile_value(c, subOpts, form->data[3])); gst_buffer_push_u16(c->vm, buffer, GST_OP_SET); gst_buffer_push_u16(c->vm, buffer, ds.index); gst_buffer_push_u16(c->vm, buffer, key.index); gst_buffer_push_u16(c->vm, buffer, val.index); compiler_drop_slot(c, c->tail, key); compiler_drop_slot(c, c->tail, val); if (opts.resultUnused) { compiler_drop_slot(c, c->tail, ds); return nil_slot(); } else { return ds; } } /* Compile an assignment operation */ static Slot compile_assign(GstCompiler *c, FormOptions opts, GstValue left, GstValue right) { GstScope *scope = c->tail; GstBuffer *buffer = c->buffer; FormOptions subOpts; uint16_t target = 0; uint16_t level = 0; Slot slot; subOpts.isTail = 0; subOpts.resultUnused = 0; if (symbol_resolve(scope, left, &level, &target)) { /* Check if we have an up value. Otherwise, it's just a normal * local variable */ if (level != 0) { subOpts.canChoose = 1; /* Evaluate the right hand side */ slot = compiler_realize_slot(c, compile_value(c, subOpts, right)); /* Set the up value */ gst_buffer_push_u16(c->vm, buffer, GST_OP_SUV); gst_buffer_push_u16(c->vm, buffer, slot.index); gst_buffer_push_u16(c->vm, buffer, level); gst_buffer_push_u16(c->vm, buffer, target); } else { /* Local variable */ subOpts.canChoose = 0; subOpts.target = target; slot = compile_value(c, subOpts, right); } } else { /* We need to declare a new symbol */ subOpts.target = compiler_declare_symbol(c, scope, left); subOpts.canChoose = 0; slot = compile_value(c, subOpts, right); } if (opts.resultUnused) { compiler_drop_slot(c, scope, slot); return nil_slot(); } else { return slot; } } /* Compile series of expressions. This compiles the meat of * function definitions and the inside of do forms. */ static Slot compile_block(GstCompiler *c, FormOptions opts, GstArray *form, uint32_t startIndex) { GstScope *scope = c->tail; FormOptions subOpts = form_options_default(); uint32_t current = startIndex; /* Check for empty body */ if (form->count <= startIndex) return nil_slot(); /* Compile the body */ subOpts.resultUnused = 1; subOpts.isTail = 0; subOpts.canChoose = 1; while (current < form->count - 1) { compiler_drop_slot(c, scope, compile_value(c, subOpts, form->data[current])); ++current; } /* Compile the last expression in the body */ return compile_value(c, opts, form->data[form->count - 1]); } /* Extract the last n bytes from the buffer and use them to construct * a function definition. */ static GstFuncDef *compiler_gen_funcdef(GstCompiler *c, uint32_t lastNBytes, uint32_t arity) { GstScope *scope = c->tail; GstBuffer *buffer = c->buffer; GstFuncDef *def = gst_alloc(c->vm, sizeof(GstFuncDef)); /* Create enough space for the new byteCode */ if (lastNBytes > buffer->count) c_error(c, "trying to extract more bytes from buffer than in buffer"); uint8_t * byteCode = gst_alloc(c->vm, lastNBytes); def->byteCode = (uint16_t *)byteCode; def->byteCodeLen = lastNBytes / 2; /* Copy the last chunk of bytes in the buffer into the new * memory for the function's byteCOde */ gst_memcpy(byteCode, buffer->data + buffer->count - lastNBytes, lastNBytes); /* Remove the byteCode from the end of the buffer */ buffer->count -= lastNBytes; /* Create the literals used by this function */ if (scope->literalsArray->count) { def->literals = gst_alloc(c->vm, scope->literalsArray->count * sizeof(GstValue)); gst_memcpy(def->literals, scope->literalsArray->data, scope->literalsArray->count * sizeof(GstValue)); } else { def->literals = NULL; } def->literalsLen = scope->literalsArray->count; /* Delete the sub scope */ compiler_pop_scope(c); /* Initialize the new FuncDef */ def->locals = scope->frameSize; def->arity = arity; return def; } /* Compile a function from a function literal */ static Slot compile_function(GstCompiler *c, FormOptions opts, GstArray *form) { GstScope *scope = c->tail; GstBuffer *buffer = c->buffer; uint32_t current = 1; uint32_t i; uint32_t sizeBefore; /* Size of buffer before compiling function */ GstScope *subGstScope; GstArray *params; FormOptions subOpts = form_options_default(); Slot ret; if (opts.resultUnused) return nil_slot(); ret = compiler_get_target(c, opts); subGstScope = compiler_push_scope(c, 0); /* Check for function documentation - for now just ignore. */ if (form->data[current].type == GST_STRING) ++current; /* Define the function parameters */ if (form->data[current].type != GST_ARRAY) c_error(c, "expected function arguments"); params = form->data[current++].data.array; for (i = 0; i < params->count; ++i) { GstValue param = params->data[i]; if (param.type != GST_STRING) c_error(c, "function parameters should be symbols"); /* The compiler puts the parameter locals * in the right place by default - at the beginning * of the stack frame. */ compiler_declare_symbol(c, subGstScope, param); } /* Mark where we are on the stack so we can * return to it later. */ sizeBefore = buffer->count; /* Compile the body in the subscope */ subOpts.isTail = 1; compiler_return(c, compile_block(c, subOpts, form, current)); /* Create a new FuncDef as a constant in original scope by splicing * out the relevant code from the buffer. */ { GstValue newVal; uint16_t literalIndex; GstFuncDef *def = compiler_gen_funcdef(c, buffer->count - sizeBefore, params->count); /* Add this FuncDef as a literal in the outer scope */ newVal.type = GST_NIL; newVal.data.pointer = def; literalIndex = compiler_add_literal(c, scope, newVal); gst_buffer_push_u16(c->vm, buffer, GST_OP_CLN); gst_buffer_push_u16(c->vm, buffer, ret.index); gst_buffer_push_u16(c->vm, buffer, literalIndex); } return ret; } /* Branching special */ static Slot compile_if(GstCompiler *c, FormOptions opts, GstArray *form) { GstScope *scope = c->tail; GstBuffer *buffer = c->buffer; FormOptions condOpts = opts; FormOptions branchOpts = opts; Slot left, right, condition; uint32_t countAtJumpIf; uint32_t countAtJump; uint32_t countAfterFirstBranch; /* Check argument count */ if (form->count < 3 || form->count > 4) c_error(c, "if takes either 2 or 3 arguments"); /* Compile the condition */ condOpts.isTail = 0; condOpts.resultUnused = 0; condition = compile_value(c, condOpts, form->data[1]); /* If the condition is nil, just compile false path */ if (condition.isNil) { if (form->count == 4) { return compile_value(c, opts, form->data[3]); } return condition; } /* Mark where the buffer is now so we can write the jump * length later */ countAtJumpIf = buffer->count; buffer->count += sizeof(int32_t) + 2 * sizeof(uint16_t); /* Configure branch form options */ branchOpts.canChoose = 0; branchOpts.target = condition.index; /* Compile true path */ left = compile_value(c, branchOpts, form->data[2]); if (opts.isTail) { compiler_return(c, left); } else { /* If we need to jump again, do so */ if (form->count == 4) { countAtJump = buffer->count; buffer->count += sizeof(int32_t) + sizeof(uint16_t); } } compiler_drop_slot(c, scope, left); /* Reinsert jump with correct index */ countAfterFirstBranch = buffer->count; buffer->count = countAtJumpIf; gst_buffer_push_u16(c->vm, buffer, GST_OP_JIF); gst_buffer_push_u16(c->vm, buffer, condition.index); gst_buffer_push_i32(c->vm, buffer, (countAfterFirstBranch - countAtJumpIf) / 2); buffer->count = countAfterFirstBranch; /* Compile false path */ if (form->count == 4) { right = compile_value(c, branchOpts, form->data[3]); if (opts.isTail) compiler_return(c, right); compiler_drop_slot(c, scope, right); } else if (opts.isTail) { compiler_return(c, condition); } /* Reset the second jump length */ if (!opts.isTail && form->count == 4) { countAfterFirstBranch = buffer->count; buffer->count = countAtJump; gst_buffer_push_u16(c->vm, buffer, GST_OP_JMP); gst_buffer_push_i32(c->vm, buffer, (countAfterFirstBranch - countAtJump) / 2); buffer->count = countAfterFirstBranch; } if (opts.isTail) condition.hasReturned = 1; return condition; } /* Special to throw an error */ static Slot compile_error(GstCompiler *c, FormOptions opts, GstArray *form) { GstBuffer *buffer = c->buffer; Slot ret; GstValue x; if (form->count != 2) c_error(c, "error takes exactly 1 argument"); x = form->data[1]; ret = compiler_realize_slot(c, compile_value(c, opts, x)); gst_buffer_push_u16(c->vm, buffer, GST_OP_ERR); gst_buffer_push_u16(c->vm, buffer, ret.index); return nil_slot(); } /* Try catch special */ static Slot compile_try(GstCompiler *c, FormOptions opts, GstArray *form) { GstScope *scope = c->tail; GstBuffer *buffer = c->buffer; Slot body; uint16_t errorIndex; uint32_t countAtTry, countTemp, countAtJump; /* Check argument count */ if (form->count < 3 || form->count > 4) c_error(c, "try takes either 2 or 3 arguments"); /* Check for symbol to bind error to */ if (form->data[1].type != GST_STRING) c_error(c, "expected symbol at start of try"); /* Add subscope for error variable */ GstScope *subScope = compiler_push_scope(c, 1); errorIndex = compiler_declare_symbol(c, subScope, form->data[1]); /* Leave space for try instruction */ countAtTry = buffer->count; buffer->count += sizeof(uint32_t) + 2 * sizeof(uint16_t); /* Compile the body */ body = compile_value(c, opts, form->data[2]); if (opts.isTail) { compiler_return(c, body); } else { /* If we need to jump over the catch, do so */ if (form->count == 4) { countAtJump = buffer->count; buffer->count += sizeof(int32_t) + sizeof(uint16_t); } } /* Reinsert try jump with correct index */ countTemp = buffer->count; buffer->count = countAtTry; gst_buffer_push_u16(c->vm, buffer, GST_OP_TRY); gst_buffer_push_u16(c->vm, buffer, errorIndex); gst_buffer_push_i32(c->vm, buffer, (countTemp - countAtTry) / 2); buffer->count = countTemp; /* Compile catch path */ if (form->count == 4) { Slot catch; countAtJump = buffer->count; catch = compile_value(c, opts, form->data[3]); if (opts.isTail) compiler_return(c, catch); compiler_drop_slot(c, scope, catch); } else if (opts.isTail) { compiler_return(c, nil_slot()); } /* Reset the second jump length */ if (!opts.isTail && form->count == 4) { countTemp = buffer->count; buffer->count = countAtJump; gst_buffer_push_u16(c->vm, buffer, GST_OP_JMP); gst_buffer_push_i32(c->vm, buffer, (countTemp - countAtJump) / 2); buffer->count = countTemp; } /* Untry */ gst_buffer_push_u16(c->vm, buffer, GST_OP_UTY); /* Pop the error scope */ compiler_pop_scope(c); if (opts.isTail) body.hasReturned = 1; return body; } /* While special */ static Slot compile_while(GstCompiler *c, FormOptions opts, GstArray *form) { Slot cond; uint32_t countAtStart = c->buffer->count; uint32_t countAtJumpDelta; uint32_t countAtFinish; FormOptions defaultOpts = form_options_default(); compiler_push_scope(c, 1); /* Compile condition */ cond = compile_value(c, defaultOpts, form->data[1]); /* Assert that cond is a real value - otherwise do nothing (nil is false, * so loop never runs.) */ if (cond.isNil) return cond; /* Leave space for jump later */ countAtJumpDelta = c->buffer->count; c->buffer->count += sizeof(uint16_t) * 2 + sizeof(int32_t); /* Compile loop body */ defaultOpts.resultUnused = 1; compiler_drop_slot(c, c->tail, compile_block(c, defaultOpts, form, 2)); /* Jump back to the loop start */ countAtFinish = c->buffer->count; gst_buffer_push_u16(c->vm, c->buffer, GST_OP_JMP); gst_buffer_push_i32(c->vm, c->buffer, (int32_t)(countAtFinish - countAtStart) / -2); countAtFinish = c->buffer->count; /* Set the jump to the correct length */ c->buffer->count = countAtJumpDelta; gst_buffer_push_u16(c->vm, c->buffer, GST_OP_JIF); gst_buffer_push_u16(c->vm, c->buffer, cond.index); gst_buffer_push_i32(c->vm, c->buffer, (int32_t)(countAtFinish - countAtJumpDelta) / 2); /* Pop scope */ c->buffer->count = countAtFinish; compiler_pop_scope(c); /* Return nil */ if (opts.resultUnused) return nil_slot(); else return cond; } /* Do special */ static Slot compile_do(GstCompiler *c, FormOptions opts, GstArray *form) { Slot ret; compiler_push_scope(c, 1); ret = compile_block(c, opts, form, 1); compiler_pop_scope(c); return ret; } /* Quote special - returns its argument as is. */ static Slot compile_quote(GstCompiler *c, FormOptions opts, GstArray *form) { GstScope *scope = c->tail; GstBuffer *buffer = c->buffer; Slot ret; uint16_t literalIndex; if (form->count != 2) c_error(c, "quote takes exactly 1 argument"); GstValue x = form->data[1]; if (x.type == GST_NIL || x.type == GST_BOOLEAN || x.type == GST_NUMBER) { return compile_nonref_type(c, opts, x); } if (opts.resultUnused) return nil_slot(); ret = compiler_get_target(c, opts); literalIndex = compiler_add_literal(c, scope, x); gst_buffer_push_u16(c->vm, buffer, GST_OP_CST); gst_buffer_push_u16(c->vm, buffer, ret.index); gst_buffer_push_u16(c->vm, buffer, literalIndex); return ret; } /* Assignment special */ static Slot compile_var(GstCompiler *c, FormOptions opts, GstArray *form) { if (form->count != 3) c_error(c, "assignment expects 2 arguments"); return compile_assign(c, opts, form->data[1], form->data[2]); } /* Define a function type for Special Form helpers */ typedef Slot (*SpecialFormHelper) (GstCompiler *c, FormOptions opts, GstArray *form); /* Dispatch to a special form */ static SpecialFormHelper get_special(GstArray *form) { uint8_t *name; if (form->count < 1 || form->data[0].type != GST_STRING) return NULL; name = form->data[0].data.string; /* If we have a symbol with a zero length name, we have other * problems. */ if (gst_string_length(name) == 0) return NULL; /* One character specials. Mostly math. */ if (gst_string_length(name) == 1) { switch(name[0]) { case '+': return compile_addition; case '-': return compile_subtraction; case '*': return compile_multiplication; case '/': return compile_division; case '>': return compile_gt; case '<': return compile_lt; case '=': return compile_equals; default: break; } } /* Multi character specials. Mostly control flow. */ switch (name[0]) { case '>': { if (gst_string_length(name) == 2 && name[1] == '=') { return compile_gte; } } break; case '<': { if (gst_string_length(name) == 2 && name[1] == '=') { return compile_lte; } } break; case 'a': { if (gst_string_length(name) == 5 && name[1] == 'r' && name[2] == 'r' && name[3] == 'a' && name[4] == 'y') { return compile_array; } } case 'e': { if (gst_string_length(name) == 5 && name[1] == 'r' && name[2] == 'r' && name[3] == 'o' && name[4] == 'r') { return compile_error; } } case 'g': { if (gst_string_length(name) == 3 && name[1] == 'e' && name[2] == 't') { return compile_get; } } case 'd': { if (gst_string_length(name) == 2 && name[1] == 'o') { return compile_do; } } break; case 'i': { if (gst_string_length(name) == 2 && name[1] == 'f') { return compile_if; } } break; case 'f': { if (gst_string_length(name) == 2 && name[1] == 'n') { return compile_function; } } break; case 'n': { if (gst_string_length(name) == 3 && name[1] == 'o' && name[2] == 't') { return compile_not; } } break; case 'o': { if (gst_string_length(name) == 3 && name[1] == 'b' && name[2] == 'j') { return compile_object; } } case 'q': { if (gst_string_length(name) == 5 && name[1] == 'u' && name[2] == 'o' && name[3] == 't' && name[4] == 'e') { return compile_quote; } } break; case 's': { if (gst_string_length(name) == 3 && name[1] == 'e' && name[2] == 't') { return compile_set; } } break; case 't': { if (gst_string_length(name) == 3 && name[1] == 'r' && name[2] == 'y') { return compile_try; } } case 'w': { if (gst_string_length(name) == 5 && name[1] == 'h' && name[2] == 'i' && name[3] == 'l' && name[4] == 'e') { return compile_while; } } break; case ':': { if (gst_string_length(name) == 2 && name[1] == '=') { return compile_var; } } break; default: break; } return NULL; } /* Compile a form. Checks for special forms and macros. */ static Slot compile_form(GstCompiler *c, FormOptions opts, GstArray *form) { GstScope *scope = c->tail; GstBuffer *buffer = c->buffer; SpecialFormHelper helper; /* Empty forms evaluate to nil. */ if (form->count == 0) { GstValue temp; temp.type = GST_NIL; return compile_nonref_type(c, opts, temp); } /* Check and handle special forms */ helper = get_special(form); if (helper != NULL) { return helper(c, opts, form); } else { Slot ret, callee; SlotTracker tracker; FormOptions subOpts = form_options_default(); uint32_t i; tracker_init(c, &tracker); /* Compile function to be called */ callee = compiler_realize_slot(c, compile_value(c, subOpts, form->data[0])); /* Compile all of the arguments */ for (i = 1; i < form->count; ++i) { Slot slot = compile_value(c, subOpts, form->data[i]); compiler_tracker_push(c, &tracker, slot); } /* Free up some slots */ compiler_drop_slot(c, scope, callee); compiler_tracker_free(c, scope, &tracker); /* If this is in tail position do a tail call. */ if (opts.isTail) { gst_buffer_push_u16(c->vm, buffer, GST_OP_TCL); gst_buffer_push_u16(c->vm, buffer, callee.index); ret.hasReturned = 1; ret.isNil = 1; } else { ret = compiler_get_target(c, opts); gst_buffer_push_u16(c->vm, buffer, GST_OP_CAL); gst_buffer_push_u16(c->vm, buffer, callee.index); gst_buffer_push_u16(c->vm, buffer, ret.index); } gst_buffer_push_u16(c->vm, buffer, form->count - 1); /* Write the location of all of the arguments */ compiler_tracker_write(c, &tracker, 0); return ret; } } /* Recursively compile any value or form */ static Slot compile_value(GstCompiler *c, FormOptions opts, GstValue x) { switch (x.type) { case GST_NIL: case GST_BOOLEAN: case GST_NUMBER: return compile_nonref_type(c, opts, x); case GST_STRING: return compile_symbol(c, opts, x); case GST_ARRAY: return compile_form(c, opts, x.data.array); default: return compile_literal(c, opts, x); } } /* Initialize a GstCompiler struct */ void gst_compiler(GstCompiler *c, Gst *vm) { c->vm = vm; c->buffer = gst_buffer(vm, 128); c->env = gst_array(vm, 10); c->tail = NULL; c->error = NULL; compiler_push_scope(c, 0); } /* Register a global for the compilation environment. */ void gst_compiler_add_global(GstCompiler *c, const char *name, GstValue x) { GstValue sym = gst_load_cstring(c->vm, name); sym.type = GST_STRING; compiler_declare_symbol(c, c->tail, sym); gst_array_push(c->vm, c->env, x); } /* Register a global c function for the compilation environment. */ void gst_compiler_add_global_cfunction(GstCompiler *c, const char *name, GstCFunction f) { GstValue func; func.type = GST_CFUNCTION; func.data.cfunction = f; gst_compiler_add_global(c, name, func); } /* Compile interface. Returns a function that evaluates the * given AST. Returns NULL if there was an error during compilation. */ GstFunction *gst_compiler_compile(GstCompiler *c, GstValue form) { FormOptions opts = form_options_default(); GstFuncDef *def; if (setjmp(c->onError)) { /* Clear all but root scope */ if (c->tail) c->tail->parent = NULL; return NULL; } /* Create a scope */ opts.isTail = 1; compiler_push_scope(c, 0); compiler_return(c, compile_value(c, opts, form)); def = compiler_gen_funcdef(c, c->buffer->count, 0); { uint32_t envSize = c->env->count; GstFuncEnv *env = gst_alloc(c->vm, sizeof(GstFuncEnv)); GstFunction *func = gst_alloc(c->vm, sizeof(GstFunction)); if (envSize) { env->values = gst_alloc(c->vm, sizeof(GstValue) * envSize); gst_memcpy(env->values, c->env->data, envSize * sizeof(GstValue)); } else { env->values = NULL; } env->stackOffset = envSize; env->thread = NULL; func->parent = NULL; func->def = def; func->env = env; return func; } } /* Macro expansion. Macro expansion happens prior to the compilation process * and is completely separate. This allows the compilation to not have to worry * about garbage collection and other issues that would complicate both the * runtime and the compilation. */ int gst_macro_expand(Gst *vm, GstValue x, GstObject *macros, GstValue *out) { while (x.type == GST_ARRAY) { GstArray *form = x.data.array; GstValue sym, macroFn; if (form->count == 0) break; sym = form->data[0]; macroFn = gst_object_get(macros, sym); if (macroFn.type != GST_FUNCTION && macroFn.type != GST_CFUNCTION) break; gst_load(vm, macroFn); if (gst_start(vm)) { /* We encountered an error during parsing */ return 1; } else { x = vm->ret; } } *out = x; return 0; }